         PCC      0                                                             
         SYSTEM   SIG9P                                                         
         SYSTEM   OPTIONS                                                       
         DEF      A:SNAM                                                        
         DO1      (#DEBUG+#TJE)>0                                               
         DEF      BREAK             M:INT CAL PROCESSOR                         
         DEF      SETNAME                                                       
         DEF      SNAMEXIT                                                      
         DEF      SNAMEX01                                                      
         DEF      SNAMEX02                                                      
        DO       #MEDIA                                                         
*                                                                               
*                 M E D I A   C A L   P R O C E S S O R                         
*                                                                               
         DEF      MEDIACAL          ENTRY TO CAL PROCESSOR                      
         DEF      MEDCEXIT          EXIT FROM PROCESSOR                         
*                                                                               
        FIN      #MEDIA                                                         
SNAM     EQU      %                                                             
A:SNAM   EQU      SNAM                                                          
OLAYFLAG EQU      'SNAM'                                                        
         SYSTEM   CPRMON                                                        
         TITLE    '** SNAM - SETNAME CAL PROCESSOR **'                          
SETNAME  EQU      %                                                             
         LI,R7    4                 GET FOUT WORDS OF TEMP SPACE                
         BAL,R8   GETTEMP                                                       
         B        SNAME06A          NO SPACE EXIT                               
         PUSH     R7                SAVE SPACE POINTER FOR EXIT                 
         LI,R15   FPTTNAME          P3 TASK NAME                                
         BAL,R5   GETFPTN           GET FIRST PART OF TASK NAME                 
         B        SNAME10           B FOR CAL ERROR                             
         STW,R15  0,R7              SET IN TEMP WORK TABLE                      
         LI,R15   FPTTNAME+1        P4 PARAMETER                                
         BAL,R5   GETFPTN                                                       
         LW,R15   BLANKS            NOT PRESENT - DEFAULT TO BLANKS             
         STW,R15  1,R7              SET IN TEMP WORK TABLE                      
         LI,R15   6                 P6 IS FIRST PART OF LOAD MODULE NAME        
         BAL,R5   GETFPTN                                                       
         B        SNAME10           NOT PRESENT - BAD CAL                       
         STW,R15  2,R7              SET IN TEMP WORK TABLE                      
         LI,R15   7                 P7 IS SECOND OF LOAD MODULE NAME            
         BAL,R5   GETFPTN                                                       
         LW,R15   BLANKS            NOT PRESENT - DEFAULT TO BLANKS             
         STW,R15  3,R7              SET IN TEMP WORK TABLE                      
         STW,R7   R9                SAVE FOR LATER                              
         BAL,R8   TMGETJID          GET JOB ID                                  
         B        SNAME06           JOB NAME NOT VALID                          
SNAME01  EQU      %                                                             
         DISABLE                                                                
         MTW,1    RENT:SN           ESTABLISH RE-ENTERED COUNT                  
         LW,R14   RENT:SN                                                       
         ENABLE                                                                 
         LW,R12   JCBJPT,R7         GET JPT POINTER                             
         LB,R13   R12               GET LENGTH OF JPT                           
         BEZ      SNAME05           B IF NO  TABLE                              
         SLS,R13  -2                MAKE INTO ENTRY COUNT                       
         LI,R1    2                 OFFSET TO LOAD MODULE NAME                  
         LI,R0    0                 SET FLAG TO  DELETE                         
         LCI      2                                                             
         LM,R10   *R9,R1            GET LOAD  MODULE NAME                       
         CD,R10   BLANKS            IS IT BLANKS - IF SO THEN DELETE            
         BE       SNAME02           B TO DELETE                                 
         LI,R0    2                 FLAG TO  INSERT NEW ENTRY                   
SNAME02  LCI      2                                                             
         LM,R10   *R9               ET TASK NAME                                
SNAME03  PUSH     R13               SAVE ENTRY COUNT                            
         LI,R5    0                 START INDEX                                 
SNAME04  CD,R10   *R12,R5           THIS TASK NAME MATCH                        
         BE       SNAME07           B IF YES                                    
         AI,R5    2                 STEP TO NEXT TASK                           
         BDR,R13  SNAME04           B FOR NEXT ENTRY                            
         PULL     R13               RESTORE  COUNT                              
         CI,R0    2                 ARE WE INSERTING NEW ENTRY                  
         BNE      SNAME05           B IF NO -EITHER DELETE AND NAME NOT         
*                                            FOUND  OR INSERTING AND NO         
*                                            FREE ENTRY                         
         LI,R0    1                 SET FLAG FOR FIND FREE ENTRY                
         LD,R10   ZEROS             SET TO FIND ZERO ENTRY                      
         B        SNAME03                                                       
*                                                                               
SNAME05  EQU      %                                                             
         LI,R15   TYC66             NO SPACE OR UNABLE TO DELETE                
SNAME06  PULL     R7                GET SAVED TEMP SPACE POINTER                
         BAL,R8   RELTEMP           RELEASE SPACE                               
SNAME06A BAL,R8   TMSETERR                                                      
         BAL,R8   TMTYC15           DO END ACTION  POSTING                      
         CI,R15   X'F0'                                                         
         BG       SNAMEX02          B IF BAD - ABORT TASK                       
SNAMEX01 B        CALEXIT           BACK TO CALLER                              
SNAMEX02 B        CALERR                                                        
*                                                                               
SNAME07  EQU      %                                                             
         PULL     R13               RESTORE  STACK                              
         DISABLE                                                                
         CW,R14   RENT:SN           WERE WE REENTERED                           
         BNE      SNAME11           B IF YES                                    
         CI,R0    0                 ARE WE  DELETING  ENTRY                     
         BNE      SNAME08           B  IF  NO                                   
         LD,R10   ZEROS                                                         
         STD,R10  *R12,R5           ZERO TASK NAME                              
         AI,R5    1                 MOVE TO LOAD  MODULE NAME                   
         STD,R10  *R12,R5           ZERO LOAD MODULE NAME                       
SNAME07A EQU      %                                                             
         ENABLE                                                                 
         LI,R15   TYCNORM           NORMAL COMPLETION                           
         B        SNAME06           BACK  TO CALLER                             
*                                                                               
SNAME08  EQU      %                                                             
         CI,R0    1                 FINDING NEW ENTRY                           
         BNE      SNAME09           B IF NO- MUST BE REPLACE                    
         LCI      2                                                             
         LM,R10   *R9               GET TASK NAME                               
         STD,R10  *R12,R5           SET IN UPT                                  
SNAME09  EQU      %                                                             
         LI,R1    2                 INDEX FOR LOAD MODULE NAME                  
         AI,R5    1                 SECOND  DW IN JPT                           
         LCI      2                                                             
         LM,R10   *R9,R1            GET LOAD MODULE NAME                        
         STD,R10  *R12,R5           SET LOAD MODULE NAME                        
         B        SNAME07A                                                      
*                                                                               
SNAME10  EQU      %                                                             
         LI,R15   TYCTRAP           BAD FPT - TRAP 50                           
         B        SNAME06                                                       
*                                                                               
SNAME11  EQU      %                                                             
         ENABLE                                                                 
         B        SNAME01                                                       
*                                                                               
SNAMEXIT EQU      %                                                             
         B        *R8                                                           
         TITLE    '** SNAM - M:INT  CAL PRCESSOR **'                            
*                                                                               
*                                                                               
*                                                                               
*        CAL IS USED TO ESTABLISH BREAK CONTROL                                 
*                                                                               
*                                                                               
*                                                                               
         DO       (#DEBUG+#TJE)>0                                               
BREAK    EQU      %                                                             
         LB,R1    TCBPOINT          SETUP TASK ID                               
         LW,R9    0,R3              GET ADDRESS OF RECEIVER                     
         AND,R9   M17               ISOLATE                                     
         BEZ      BREAK01           B IF REQUEST TO REMOVE CONTROL              
         BAL,R8   TMVADR            VALIDATE THE ADDRESS                        
         B        TRAPX             NO GOOD                                     
         LB,R1    TCBPOINT                                                      
         STB,R1   R9                SET UP BREAK CONTROL WORD                   
BREAK01  LB,R1    STIJID,R1         JOB ID                                      
         LW,R1    SJI1,R1           JCB ADDRESS                                 
         STW,R9   JCBREAK,R1        SET BREAK CONTROL                           
         B        SNAMEX01          RETURN*                                     
         FIN      (#DEBUG+#TJE)>0                                               
*                                                                               
*                                                                               
*                                                                               
         TITLE    '** SNAM - MEDIA CAL PROCESSOR **'                            
         SPACE    2                                                             
        DO       #MEDIA                                                         
*                                                                               
*                                                                               
***********************************************************************         
**                                                                              
**       DEFINE STANDARD EXITS                                                  
**                                                                              
**                                                                              
MEDCEXIT B        CALSTDX           STD EXIT;  R15 HAS TYC CODE                 
**                                                                              
**                                                                              
***********************************************************************         
         PAGE                                                                   
         SPACE    2                                                             
***********************************************************************         
*                                                                     *         
*   M E D I A   C A L   P R O C E S S O R                                       
*                                                                               
*                                                                               
*        PURPOSE:   PROCESS FOREGROUND TASK'S REQUEST TO COPY A RAD             
*                 FILE TO THE MO OPLABEL                                        
*                                                                               
*        HOW:     A SIGNAL IS SENT TO THE MEDIA TASK SPECIFYING                 
*                 A DATA PACKET.  THE PACKET CONTAINS THE NAME OF THE           
*                 FILE AND THE AREA IT IS IN, THE JOB AND TASK NAME             
*                 OF THE CALLING TASK, AND THE OPTIONS REQUESTED IN             
*                 THE CALLER'S FPT.  THE SIGNAL IS GIVEN A CLASS OF             
*                 'MEDCALCL' (X'4000') TO DISTINGUISH IT FROM A                 
*                 KEY-IN REQUEST.                                               
*                                                                               
*                                                                               
*                                                                               
*        INPUTS:  R3 : FPT ADDRESS FROM THE MEDIA CAL                           
*                 R4 : TASK ID OF THE CALLING TASK                              
*                                                                               
*        OUTPUTS: ECB: LINKEDT TO MEDIA TASK'S R-CHAIN AS A SIGNAL ECB          
*                      WITH:   CLASS    = X'4000' = MEDCALCL                    
*                              PRIORITY = AS SPECIFIED OR DEFAULT               
*                              DATA PKT = FILE & OPTIONS AS SPECIFIED           
*                                                                               
*                                                                               
*                                                                               
*        CALLS:   EMGETECB    TO GET AN ECB TO SIGNAL MEDIA TASK WITH           
*                 GETTEMP     TO GET TEMP SPACE FOR DATA PACKET                 
*                 GETFPTN     TO GET AREA & FILE NAMES, PRIORITY                
*                 EMARECB     TO PUT ECB ON MEDIA'S R-CHAIN                     
*                 EMDELECB    TO DELETE ECB IN CASE OF ERRORS                   
*                 START CAL   TO START THE MEDIA TASK IF IDLE                   
*                 DEVICE CAL  TO GET AREA & FILE NAMES FROM A DCB               
*                                                                               
*                                                                               
*        REGISTER USAGE:                                                        
*                                                                               
*                 R0 : TEMP & WORK                                              
*                 R1 : TEMP & WORK  (FOR INDEXING STACK, AREA NAMES)            
*                 R2 : ECB ADDRESS (SET BY EMGETECB)                            
*                 R3 : FPT ADDRESS (SET BY CAL PROCESSOR)                       
*                 R4 : TASK ID     (SET BY CAL PROCESSOR)                       
*                 R5 : LINK TO GETFPTN                                          
*                                                                               
*                 R7 : PARAM TO GETTEMP - ADDR OF DATA PACKET                   
*        R8 : GENERAL LINK REGISTER                                             
*        R9 : SEE BELOW                                                         
*        R10: TYC CODE IF ERRORS IN CALLS                                       
*        R11: AREA NAME (BY MED002 TIME)                                        
*        R12/R13: FILE NAME (BY MED002 TIME)                                    
*        R14/R15: ACCOUNT NAME (BY MED002 TIME)                                 
*                                                                               
*        R8-R15: USED TO MOVE OR CONTAIN FPT'S                                  
*                                                                               
*                                                                               
***********************************************************************         
         PAGE                                                                   
*                                                                               
* MEDIA CAL PROCESSING                                                          
*                                                                               
MEDIACAL EQU      %         PROCESS A MEDIA CAL's fpt                           
         LB,R4    TCBPOINT          SET UP TASK ID AND                          
         LB,R5    STILMID,R4        LOAD MODULE  INDEX                          
         LI,R15   TYC79             SET POSSIBLE ERROR IN FPT                   
         LW,R0    0,R3              TEST IF P0 BIT SET AS REQUIRED              
         CW,R0    XFPTP0            IS IT ON ?                                  
         BAZ      MEDCEXIT            NO, REPORT ERROR                          
*                                                                               
         BAL,R8   EMGETECB          GET AN ECB FOR SERVICE; R2 <= ADDR          
         B        MEDCEXIT            NO SPACE OR OTHER ERROR; REPORT           
*                                                                               
         LI,R0    MEDCALCL          SET CLASS MASK FOR A CAL REQUEST            
         LI,R1    ECBCLASS                                                      
         STH,R0   *R2,R1            AND STORE CLASS INTO THE ECB                
         LW,R0    ECBFPT,R2         SET DELETE ON POST BIT IN ECB'S             
         OR,R0    XECBDP            FLAG BYTE                                   
         STW,R0   ECBFPT,R2                                                     
         LI,R1    ECBT              SET TYPE OF ECB = SIGNAL                    
         LI,R0    ECBTSIG                                                       
         STH,R0   *R2,R1                                                        
         LW,R0    STIPRIO,R4        PICK UP CALLER'S PRIORITY                   
         LH,R8    R0                AND SAVE A DEFAULT IF NOT IN FPT            
         LI,R15   FPTPRIO           PICK UP PRIORITY FROM FPT                   
         BAL,R5   GETFPTN                                                       
         LW,R15   R8                  NOT GIVEN;  USE DEFAULT                   
         LI,R1    ECBPRIO           STORE PRIO INTO THE ECB                     
         STH,R15  *R2,R1                                                        
*                                                                               
* GET TEMP SPACE FOR PACKET AND BEGIN PROCESSING FPT                            
*                                                                               
         LI,R7    MEDPLEN           GET TEMPSPACE FOR DATA PACKET               
         BAL,R8   GETTEMP             IS THERE STILL TEMPSPACE AVAIL ?/         
         B        MED998               NO, DELETE ECB; REPORT ERROR             
*                                                                               
         STW,R7   ECBDATA,R2        LINK IT INTO THE ECB                        
         ENABLE                       GETTEMP RETURNS DISABLED                  
*                                                                               
*                                                                               
*                           BEGIN PROCESSING DATA IN FPT                        
         LI,R15   4                 GET AREA NAME BLOCK ADDRESS                 
         BAL,R5   GETPSII           GET ADDRESS IN R14                          
         B        MED020            NO NAME BLOCK, USE DCB INFO                 
*                                                                               
         LCI      3                                                             
         LM,R11   *R14              LOAD NAME BLOCK                             
         PAGE                                                                   
         SPACE    2                                                             
        DO       #DFACNT                                                        
         LB,R7    TCBPOINT          POINT AT THE JOB'S ACCOUNT NAME             
         LB,R7    STIJID,R7         IN CASE IT IS TO BE DEFAULTED               
         LW,R7    SJI1,R7                                                       
         AI,R7    JCBACCNT                                                      
         LI,R1    1                 TEST FOR IMPLIED PUBLIC AREA                
         LH,R11   R11,R1            DEFAULT TO A PUBLIC AREA ?                  
         BEZ      MED001              YES, USE JOB'S ACNT IF NOT GIVEN          
         CH,R11   BLANKS                                                        
         BE       MED001              BLANKS ALSO A PUBLIC AREA                 
*                                                                               
         LI,R7    SYSACNT           USE SYSTEM ACNT IF AREA GIVEN               
*                                                                               
MED001   RES      0         GET ACCOUNT NAME (OR DEFAULTED NAME)                
         LI,R15   14                GET ADDRESS OF ACCOUNT NAME BLOCK           
         BAL,R5   GETPSII           IF IT IS PRESENT                            
         LW,R14   R7                ABSENT; POINT A DEFAULT BLOCK               
         LCI      2                 GET ACCOUNT NAME FROM SPECIFIED OR          
         LM,R14   *R14              DEFAULTED BLOCK                             
         CD,R14   ZEROS                                                         
         BE       %+3               B IF SPECIFIED ZERO ACNT                    
         CD,R14   BLANKS                                                        
         BNE      MED002            B IF NOT SPECIFIED BLANK ACNT               
         LCI      2                 SPECIFIED ZERO OR BLANKS                    
         LM,R14   *R7               GET DEFAULT INSTEAD                         
        FIN      #DFACNT                                                        
*                                                                               
*                                                                               
*        R11 = AREA NAME; R12,R13 = FILENAME; (R14,R15 = ACCOUNT NAME)          
*                                                                               
MED002   EQU      %         VERIFY AREA AND FILE NAMES AS VALID                 
         LI,R1    1                                                             
         LH,R11   R11,R1            SIGN EXTEND AREA NAME                       
         BEZ      MED006            B IF ZERO (DEFAULT)                         
         CH,R11   BLANKS                                                        
         BE       MED006            B IF BLANKS (DEFAULT)                       
         LB,R1    K:MDNAME          GET NUMBER OF AREA NAMES TO TEST            
*                                                                               
MED004   RES      0                                                             
         CH,R11   *K:MDNAME,R1      SEARCH FOR AREA NAME                        
         BE       MED006              FOUND, IT IS VALID AND OK                 
         BDR,R1   MED004            TRY NEXT                                    
*                                                                               
         CH,R11   *K:MDNAME,R1      SEARCH FOR AREA NAME                        
         BE       MED006              IT WAS, SO OK                             
*                                                                               
MED005   RES      0                                                             
         LI,R15   TYC70               NOT FOUND; ERROR - SET CODE               
         B        MED999            CLEAN UP ECBS, ETC., AND RETURN             
         PAGE                                                                   
*                                                                               
* VERIFY FILE NAME                                                              
*                                                                               
MED006   EQU      %         CHECK FILE NAME; FIX UP AREA NAME                   
         CD,R12   BLANKS            IS FILE NAME ALL BLANKS                     
         BE       MED980             REQUESTING THE ENTIRE AREA ??/             
         CD,R12   ZEROS              IF SO, THIS IS A                           
         BE       MED980               NO-NO, OR ERROR                          
*                                                                               
         LW,R7    ECBDATA,R2        RESTORE PACKET PTR                          
*                                                                               
         AND,R11  M16               CLEAR EXTENDED SIGN ON AREA                 
         LCI      5                                                             
         STM,R11  MEDPICTL,R7       STORE INPUT PARAMETERS IN PACKET            
*                                                                               
         LW,R0    0,R3              PICK UP OPTION BITS USED SPECIFIED          
         AND,R0   Y007                ---  ONLY  ---                            
         SLS,R0   7                 SHIFT TO LOC IN CTRL BYTE                   
         OR,R0    Y8                ADD FILE INDICATOR FLAG                     
         OR,R0    MEDPICTL,R7       ADD THEM IN,                                
         STW,R0   MEDPICTL,R7       AND STORE BACK                              
         LB,R1    STILMID,R4        GET TASK NAME IN EBCDIC                     
         LD,R14   LMINAME,R1                                                    
         LB,R1    STIJID,R4         AND THE JOB NAME ALSO IN EBCDIC             
         LD,R12   SJI2,R1                                                       
         LCI      4                 STORE BOTH IN PACKET IN JOB, TASK           
         STM,R12  MEDPJOBN,R7       NAME ORDER                                  
         DISABLE                                                                
         LB,R0    MEDRMASN          GET, THEN STEP SEQUENCE NUMBER              
         MTB,+1   MEDRMASN          (MEDRMASN IS BYTE 0 OF MEDRCTRL)            
         BNC      %+2                 NO CARRY                                  
         MTB,+1   MEDRMASN          COUNT MOD 256, AND SKIP 0                   
         ENABLE                                                                 
         LI,R1    MEDPMASN          STORE BYTE IN THE PACKET                    
         STB,R0   *R7,R1                                                        
         LI,R15   0                 CLEAR FIRST WORD OF PACKET                  
         STW,R15  *R7                                                           
*                                                                               
* CHAIN ON ECB                                                                  
*                                                                               
         DISABLE                                                                
         LI,R0    MEDALMID          SET MEDIA LMID AND R-CHAIN INDEX            
         LI,R1    ECBRTID           FOR LINKING THE ECB TO THE MEDIA            
         STB,R0   *R2,R1            CHAIN; IT WILL PUT IT IN THE                
         LW,R0    ECBFPT,R2         ADD THE 'IN PROGRESS' INDICATOR             
         OR,R0    XECBINP           TO THE ECB SO IT WON'T VANISH               
         STW,R0   ECBFPT,R2         WHILE LINKING IT TO MEDIA RCHAIN            
         BAL,R8   EMARECB           PROPER PLACE BY PRIORITY                    
         B        MED999              ERROR OF SOME TYPE; REPORT                
         BAL,R8   EMRSECB           REMOVE IT FROM CALLERS S-CHAIN              
         B        MED999            IMPOSSIBLE; ERRORS CRASHED IN SUBR          
         PAGE                                                                   
*                                                                               
* START MEDIA TASK                                                              
*                                                                               
         LCI      MEDSTRT#          SIZE OF START FPT                           
         LM,R8    MEDSFPT           GET FPT                                     
         CAL1,7   R8                START MEDIA TASK                            
*                                                                               
         LI,R1    MEDR#CAL          STEP NUMBER OF CAL REQUESTS                 
         MTB,+1   MEDIARES,R1       THAT ARE QUEUED UP                          
         LI,R15   TYCNORM           SET NORMAL, NO ERROR, EXIT CODE             
*                                                                               
         B        MEDCEXIT          RETURN TO CAL PROCESSOR                     
         PAGE                                                                   
*                                                                               
* GET AREA, FILE NAME AND ACCOUNT FROM USERS DCB                                
*                                                                               
MED020   EQU      %         GET AREA-, FILE- NAME FROM A DCB                    
         LI,R0    MEDEV#            CREATE THE FPT IN THE STACK                 
         LW,R1    *K:RTS            SAVE CURRENT TOP ADDRESS                    
         MSP,R0   *K:RTS            MAKE THE HOLE                               
         LI,R7    MEDEV#            SET LENGTH OF FPT TO COPY                   
*                                                                               
         LW,R8    MEDEVFPT-1,R7     MOVE THE                                    
         STW,R8   *R1,R7             FPT TO                                     
         BDR,R7   %-2                 THE STACK                                 
*                                                                               
         AWM,R1   MEDAR,R1          ADJUST ADDRS OF AREA/FILENAME & ACCNT       
         AWM,R1   MEDACN,R1         RETURN POINTER ADDRESSES                    
*                                                                               
         LW,R7    0,R3              GET DCB ADDRESS FROM FPT                    
         AND,R7   X1FFFF             NO INDIRECTION, NO REGISTERS               
         CAL1,1   1,R1                                                          
*                                                                               
         LCI      MEDCLOS#                                                      
         LM,R8    MEDCLOSE          GET CLOSE FPT IN REGS                       
         CAL1,1   R8                CLOSE DCB                                   
*                                                                               
         LW,R7    ECBDATA,R2        RECOVER ADDRESSES OF PACKET                 
         LCI      5                                                             
         LM,R11   MEDEVDTA-MEDEVFPT+1,R1 GET AREA, FILENAME, AND ACCOUNT        
*                                                                               
         LI,R0    -MEDEV#           POP STACK BACK                              
         MSP,R0   *K:RTS                                                        
         B        MED002            TEST FOR LEGALITY; THEN SET                 
         PAGE                                                                   
*                                                                               
* ERROR PROCESSNG ROUTINES                                                      
*                                                                               
MED980   EQU      %                 ILLEGAL FILE NAME                           
         LI,R15   TYC71             SET ERROR CODE                              
         B        MED999            CLEAN UP ECB, ETC., AND EXIT                
*                                                                               
*                                                                               
MED981   EQU      %         ERROR CLOSING DCB AFTER GETTING FILE INFO           
*                                                                               
*                                                                               
MED982   EQU      %         ERROR IN DEVICE CAL; REPORT ERROR                   
         LCW,R0   R0                POP STACK BY AMOUNT PUSHED                  
         MSP,R0   *K:RTS                                                        
         LB,R15   R10               SET ERROR CODE = DEVICE CAL'S               
*                                                                               
MED998   EQU      %         ERROR GETTING TEMPSPACE                             
*                                                                               
MED999   EQU      %         CLEAN UP AFTER ERROR DETECTED; DELETE ECB           
         BAL,R8   EMDELECB          DELETE THE ECB                              
         NOP      %+1                                                           
         B        MEDCEXIT          EXIT VIA STANDARD EXIT                      
         PAGE                                                                   
*                                                                               
* MEDIA TASK START FPT                                                          
*                                                                               
MEDSFPT  EQU      %         START MEDIA TASK FPT                                
         GEN,8,1,23     X'4A',1,0                                               
         DATA     P3+P4+P10+P11+F7                                              
         TEXT     'MEDIA   '        NAME OF TASK                                
         DATA     0                 TYC                                         
         TEXT     'CPR '            NAME OF JOB                                 
MEDSTRT# EQU      %-MEDSFPT         LENGTH OF THE FPT                           
         SPACE    3                                                             
*                                                                               
* CLOSE FPT                                                                     
*                                                                               
MEDCLOSE GEN,1,7,8,16 1,X'15',0,R7  CLOSE DCB AT LOC IN R7                      
         DATA     P1+P2             ERROR, ABNORMAL ROUTINES GIVEN              
         DATA     MED981                                                        
         DATA     MED981                                                        
MEDCLOS# EQU      %-MEDCLOSE        LENGTH OF DCB                               
         SPACE    2                                                             
*                                                                               
* GET ASSIGN FPT FOR MEDIACAL TO GET ASSIGNMENT FROM USERS DCB                  
*                                                                               
MEDEVFPT EQU      %         DEVICE CAL; GET AREA-, FILE- NAME OF DCB            
         GEN,1,7,1,6,17  1,X'09',1,0,R7                                         
         DATA     P1+P4+P14         ERROR, FILPTR, ACNPTR                       
         DATA     MED982            ERROR ROUTINE                               
MEDEVARA DATA     MEDEVDTA-MEDEVFPT+1   REL LOC OF DATA AREA BELOW              
MEDEVAC  DATA     MEDEVACN-MEDEVFPT+1                                           
*                                                                               
MEDEVDTA DATA     0,0,0             AREA, FILE NAME RETURN SPACE                
MEDEVACN DATA     0,0               ACCOUNT NAME RETURN SPACE                   
*                                                                               
MEDEV#   EQU      %-MEDEVFPT        SPACE NEEDED IN STACK                       
*                                                                               
MEDAR    EQU      MEDEVARA-MEDEVFPT+1  DISPLACEMENTS TO FPT WORDS WITH          
MEDACN   EQU      MEDEVAC-MEDEVFPT+1   ADDRS OF RETURN NAMES                    
        FIN      #MEDIA                                                         
         SPACE    2                                                             
         OLAYEND                                                                
         SPACE    2                                                             
         END                                                                    
