         SYSTEM   OPTIONS                                                       
         DO       #TJE                                                          
         DEF      A:TEX1                                                        
         DEF      VERACCNT          VERIFY ACCOUNT FORMAT                       
         DEF      OFFVERBG          CONSTRUCT VERBAGE FOR OFF MSG.              
         DEF      ANALYSE           ANALYSE THE ERROR CONDITION                 
         DEF      TEXBUFFR          GET BLK. BUFF. FOR TEX WORKSPACE            
         DEF      ANLYSEXT          EXIT, ERROR ANALYSIS                        
         DEF      OFFMSGEX          EXIT FROM OFF MSG. CONSTRUCT                
         DEF      VERACCEX          EXIT FROM ACCOUNT VERIFICATION              
         DEF      TEXBBRTN          EXIT FROM BUFFER ALLOCATION                 
*                                                                               
*        REF      TESTLOOP                                                      
*        REF      TEXWORKS                                                      
*                                                                               
*                                                                               
**                                                                              
OCEND    EQU      1*16              OC MESSAGE COMPLETION FLAG                  
LOGEND   EQU      2*16              LINE MESSAGES COMPLETE FLAF                 
INITEND  EQU      4*16              INITIALIZATION COMPLETE FLAG                
         PAGE                                                                   
         PSYS     0                                                             
OLAYFLAG EQU      'TEX1'                                                        
         SYSTEM   CPRMON                                                        
         PSYS     1                                                             
         SYSTEM   OLAYBASE                                                      
         PAGE                                                                   
TEXBUFFR RES      0                 CONVERT BUFF.BLK. TO WORKSPACE              
         LI,R3    0                                                             
         BAL,R5   FINDBB            PICKUP BLOCKING BUFFER                      
         B        ERRORBB                                                       
         LW,R3    *R15                                                          
         AND,R3   M17                                                           
         STW,R3   TEXWORKS          SAVE LINK FOR ALL TIME                      
SHFT0    RES      0                                                             
         LI,R1    0                                                             
         LI,R4    255               CLEAR ALL OF WORK AREA                      
         STW,R1   *R3,R4                                                        
         BDR,R4   %-1                                                           
         LI,R1    ENDBLOCK-ABSVAL(WKAREA)-1                                     
         LW,R0    WKAREA,R1         SHIFT WORK AREA STUFF                       
         STW,R0   *R3,R1                                                        
         BDR,R1   %-2                                                           
         LW,R0    WKAREA                                                        
         STW,R0   *R3                                                           
         AW,R0    R1                                                            
         LI,R1    0                 ADJUST TEMPLATE REFS                        
         LI,R6    BA(ENDADRL)-BA(BEGINLST)                                      
SHFT2    LB,R0    BEGINLST,R1       LOAD ADJ. POINTER                           
         BEZ      SHFT3             OUT ON NULL ADDRESS                         
         AW,R0    R3                ADD AERA ADDRESS                            
         LW,R15   *R0               PICK UP DATA WORD                           
         AW,R15   R3                                                            
         STW,R15  *R0               AND RESTORE                                 
SHFT3    AI,R1    1                                                             
         BDR,R6   SHFT2                                                         
         LW,R0    R3                                                            
         AI,R0    DCBLOCKS-1                                                    
         LI,R2    DCBCOUNT          REPLICATE THIS NUMBER OF DBC'S              
         LW,R4    R0                                                            
SHFT4    LI,R1    DCBLKSZ           OF THIS SIZE                                
         LW,R15   *R4,R1                                                        
         STW,R15  *R0,R1                                                        
         BDR,R1   %-2                                                           
         AI,R0    DCBLKSZ                                                       
         BDR,R2   SHFT4                                                         
         LW,R6    TEXWORKS                                                      
TEXBBRTN B        *R11                                                          
*                                                                               
*                                                                               
ERRORBB  RES      0                 BLK. BUFF. NOT AVAILABLE                    
         LCFI     10                                                            
         LM,R5    BBERRMSG                                                      
         CAL1,2   R5                                                            
         CAL1,9   3                 ABORT THE JOB                               
*                                                                               
*                                                                               
BEGINLST RES      0                 LIST OF ADDRESSES FOR ADJUSTMENT            
         DATA,1   TESTING+2,TESTING+3                                           
         DATA,1   OCWRITE                                                       
         DATA,1   RITEFPT+2,RITEFPT+3                                           
         DATA,1   READFPT+2,READFPT+3                                           
         DATA,1   OCWRITE+2,OCWRITE+3                                           
         DATA,1   OCDCB+3,OCDCB+4                                               
         DATA,1   SJOBFPT+5                                                     
         DATA,1   DCBLOCKS+4,DCBLOCKS+5                                         
         BOUND    4                                                             
ENDADRL  RES      0                                                             
         PAGE                                                                   
ANALYSE  RES      0                                                             
         AND,R8   M16                                                           
         STW,R8   R11               SAVE ERROR INDICATOR                        
         SCS,R8   -12                                                           
         STB,R8   R11                                                           
         LW,R8    R8                                                            
         BGE      %+2                                                           
         LI,R10   0                 NEGATIVE MEANS NO TYC                       
         SLS,R10  -8                                                            
         STB,R8   R10                                                           
         SLS,R8   3                                                             
         SCS,R8   9                                                             
         LI,R1    1                                                             
         STH,R8   R10,R1                                                        
         STW,R10  REGISTR8,R6       ALL INFO IN THE ONE WORD                    
         LB,R12   R11               TEST FOR TESTING FAILURE                    
         CI,R12   13                                                            
         BNE      ANYS0             OUT IF NOT                                  
         LW,R1    TESTING,R6        GET LINE INDEX FROM CONTINUE                
         LW,R7    -1,R1                                                         
         LB,R7    R7                                                            
         LB,R12   *R1                                                           
         CI,R12   X'48'             TEST IF INIT CAL                            
         BNE      ANYS0             NO,                                         
         AW,R11   Y01               YES, MAKE TYPE 14                           
ANYS0    RES      0                                                             
         LD,R12   DCT16,R7          GET TEMINAL ID.                             
         SLD,R12  16                                                            
         OR,R13   ANYS2                                                         
         LI,R1    -8                AND COVERT HEX INFO                         
         LW,R9    REGISTR8,R6                                                   
ANYS1    LI,R8    0                                                             
         SLD,R8   4                                                             
         CI,R8    9                                                             
         BG       %+2                                                           
         AI,R8    X'39'                                                         
         AI,R8    X'B7'                                                         
         STB,R8   16,R1                                                         
         BIR,R1   ANYS1                                                         
         LI,R8    ' '                                                           
         STB,R8   R15                                                           
         STB,R8   R14                                                           
         SCS,R14  16                                                            
         LW,R9    ENDING1,R6        SET FOR RETRY                               
         LB,R0    DCTTJE,R7         TEST IF IN LOGON                            
         CI,R0    TJETEX                                                        
         BANZ     %+2                                                           
         LW,R9    ENDING2,R6        YES RESET RETURN                            
         BAL,8    GETDCB                                                        
         B        ANALYSEX          NO DCB FOR TERMINAL OUTPUT                  
         LI,R2    TIDMSG                                                        
         LI,R3    16                                                            
         LB,R11   R11                                                           
         CI,R11   14                                                            
         BNE      %+3                                                           
         LW,R9    ENDING4,R6        INIT ERROR(UNDER TEST) RELINK               
         B        %+4                                                           
         CI,R11   12                TEST IMMEDIATE ERROR                        
         BNE      ANYSX                                                         
         LW,R9    ENDING3,R6        TEL INIT ERROR FORMAT                       
         LW,R11   R11                                                           
         LW,R13   ANYS3                                                         
         SLS,R14  -16                                                           
         AW,R14   ANYS4                                                         
         AI,R2    1                                                             
         LI,R3    8                                                             
ANYSX    CW,R9    ENDING2,R6        FILTER KILLLINE RETURN                      
         BNE      ANYSY             IF NOT SKIP FORWARD                         
         LI,R9    TJEOFF                                                        
         BAL,R8   TJESET                                                        
         LI,R9    LOGEND            SET TO WAIT ON MESSAGE                      
         BAL,R11  ENDSET                                                        
         LW,R9    ENDING2,R6                                                    
ANYSY    RES      0                                                             
         STB,R7   R9                                                            
         STW,R9   -1,R1             SAVE CONTINUATION WORD                      
         LCFI     4                 PLACE OUTPUT IN DCB                         
         STM,R12  TIDMSG,R1                                                     
         AW,R2    R1                                                            
         LW,R14   ANYS5                                                         
         LI,R15   1                                                             
         CAL1,7   R14               MAKE SURE DCB IS FREE                       
         CAL1,1   RITEFPT,R6        WRITE OUT ERROR MESSAGE                     
ANLYSEXT B        TESTLOOP                                                      
ANYS2    DATA     X'4040'                                                       
ANYS3    TEXT     ' ERR'                                                        
ANYS4    DATA,2   '. ',0                                                        
ANYS5    DATA     X'C7000001'                                                   
         PAGE                                                                   
ANALYSEX STW,R9   OCDCB-1,R6                                                    
         LCFI     4                                                             
         STM,R12  EMERGCY,R6                                                    
         LI,R2    EMERGCY                                                       
         AW,R2    R6                                                            
         LI,R3    16                                                            
         CAL1,1   OCWRITE,R6                                                    
         B        ANLYSEXT                                                      
SEARCHIT RES      0                 SEARCH OUT LINE INDEX IN LIST               
         AW,R0    R6                                                            
         LB,R1    *R0                                                           
         CB,R7    *R0,R1                                                        
         BE       1,R3                                                          
         BDR,R1   %-2                                                           
         B        *R3                                                           
*                                                                               
GETDCB   LI,R0    DCBLIST                                                       
         BAL,R3   SEARCHIT          TEST IF DCB AREADY LINKED                   
         B        *R8               NO - RETURN DISAPOINTMENT                   
         MI,R1    DCBLKSZ           AND CALCULATE THE ADDRESS                   
         AI,R1    DCBLOCKS-DCBLKSZ+1 OF DCB AREA, DCB PER SE                    
         AW,R1    R6                                                            
         AI,R8    1                                                             
         B        *R8               GOT IT RETURN                               
*                                                                               
*                                                                               
         PAGE                                                                   
PURGEQUE RES      0                 PURGE QUEUES OF CURRENT LINE INDEX          
         LB,R4    PURGELST          GET COUNT OF QUEUES TO BE PURGED            
         LI,R5    0                                                             
         LI,R14   0                 SET DEQUEUE REQUIREMENTS NULL               
PQUE1    LB,R0    PURGELST,R4       POINT TO QUEUE TOBE CLEANSED                
         BAL,R8   CLEANQUE                                                      
         B        PQUE2             FORWARD IF CLEANSED                         
         AI,R5    1                                                             
         STB,R4   PURGELST,R5       OTHERWISE SET AS DEQUEUE REQUIREMENT        
         STB,R5   PURGELST                                                      
PQUE2    BDR,R4   PQUE1             LOOP ON ALL QUEUES                          
PURGEOUT B        *R13                                                          
*                                                                               
*                                                                               
PURGELST DATA,1   BA(PURLEND)-BA(PURGELST)                                      
         DATA,1   OCQUEUE                                                       
PURLEND  RES      0                                                             
         BOUND    4                                                             
         PAGE                                                                   
CLEANQUE RES      0                 PURGE QUEUE OF LINE INDEX                   
         AW,R0    R6                                                            
         LB,R1    *R0               GET QUEUE LENGTH                            
         BEZ      CLNQ5             OUT IF EMPTY                                
CLNQ1    STB,R1   *R0                                                           
         LI,R3    1                                                             
CLNQ2    LB,R9    *R0,R3            TEST FOR CURRENT LINE INDEX                 
         CB,R9    R7                                                            
         BNE      CLNQ4                                                         
         CI,R3    1                 TEST IF CURRENT QUEUE ENTRY                 
         BE       CLNQ6             YES - THEN MUST DEQUEUE                     
         AI,R3    1                                                             
CLNQ3    LB,R9    *R0,R3            OTHERWISE COMPRESS QUEUE                    
         AI,R3    -1                                                            
         STB,R9   *R0,R3                                                        
         AI,R3    2                                                             
         BDR,R1   CLNQ3                                                         
         LB,R1    *R0                                                           
         AI,R1    -1                REDUCE QUEUE LENGTH AND                     
         B        CLNQ1             TRY FOR COMPLETE SEARCH                     
CLNQ4    AI,R3    1                                                             
         BDR,R1   CLNQ2                                                         
CLNQ5    B        *R8               IF QUEUE  CLEAN, RETURN                     
CLNQ6    AI,R8    1                 IF DEQUEUE REQUIRED,                        
         B        *R8               RETURN SPECIAL                              
         PAGE                                                                   
VERACCNT RES      0                 VERIFY THE ACCOUNT FORMAT                   
         LI,R2    5                 SHIFT BLANKS UNDER ACCOUNT                  
         LW,R0    BLANK                                                         
         STW,R0   10,R2                                                         
         BDR,R2   %-1                                                           
         LI,R4    0                 PICKUP BYTE POINTER                         
         LI,R2    9                 AND MAX. FIELD COUNT                        
         LW,R9    R1                ACCOUNT READIN ADDRESS                      
         AI,R9    ACCBLK                                                        
         LI,R10   R11               STORE REGISTER                              
         LI,R3     ','              DELIMITER CRITERION                         
VERA1    LI,R5    0                 STORAGE BYTE COUNT                          
         B        %+3                                                           
VERA2    STB,R0   *R10,R5                                                       
         AI,R5    1                                                             
         LB,R0    *R9,R4            GET BYTE                                    
         CW,R0    R3                TEST IF END ITEM                            
         BE       VERA3                                                         
         CI,R0    X'C0'             CHECK ECBDIC QUADRANT                       
         BL       VERA5             OUT ON NO PASS                              
         AI,R4    1                 ADJUST INDICIES                             
         BDR,R2   VERA2                                                         
         B        VERA5             ERROR ON LATE DELIMITER                     
VERA3    CI,R10   R13               TEST IF THRU WITH SCAN                      
         BE       VERA4                                                         
         LI,R10   R13               ADJUST FOR USER NAME                        
         LI,R2    13                                                            
         AI,R4    1                                                             
         LI,R3    X'40'                                                         
         B        VERA1                                                         
VERA4    AI,R8    1                                                             
VERA5    STW,R4   SQTEMP2,R6        SAVE FINAL BYTE COUNT                       
VERACCEX RES      0                                                             
         B        *R8               SUCCESSFUL RETURN                           
BLANK    TEXT     '    '                                                        
         PAGE                                                                   
*                                                                               
*        RECONSTITUTE ACCOUNT,NAME WITH ITS COMMA -- HO,HUM                     
*                                                                               
OFFVERBG RES      0                 CONSTRUCT OFF VERBAGE FOR MESSAGE           
         LI,R0    0                                                             
         STB,R0   DCTTJE,R7         CLEAR TJE LINE FLAGS                        
         LI,R0    INITBLK+2                                                     
         AW,R0    R1                                                            
         LW,R8    JCBPOINT,R1       RESTORE JCB ADDRESS                         
         BNEZ     %+2               TEST IF JOB CREATED                         
         LI,R0    KILL6+2           NO, FAKE IT FOR JOB ACCOUNT                 
         LI,R4    -8                                                            
         LI,R8    ACCBLK                                                        
         AW,R8    R1                                                            
         LI,R3    0                                                             
         LI,R5    KILL4                                                         
*                                                                               
KILL1    LB,R9    *R0,R4            SHIFT PARTS TO DCB WORKSPACE                
         CI,R9    ' '                                                           
         BE       KILL3             OUT ON BLANK                                
KILL2    STB,R9   *R8,R3                                                        
         AI,R3    1                                                             
         BIR,R4   KILL1                                                         
KILL3    B        *R5                                                           
*                                                                               
KILL4    AI,R0    3                 PREPARE TO SHIFT NAME                       
         LI,R4    -13                                                           
         LI,R9    ','               INSERT THE DAMN COMMA                       
         LI,R5    KILL5                                                         
         B        KILL2                                                         
*                                                                               
KILL5    LI,R5    2                 FINALLY GO WRITE OFF MESSAGES               
         LI,R4    -4                                                            
OFFMSGEX B        ONOFFMSG                                                      
*                                                                               
KILL6    TEXT     '            '                                                
         PAGE                                                                   
*                                                                               
*                                                                               
TJESET   RES      0                 MAKE TJE BIT SETTINGS                       
         DISABLE                    COOL IT FOR BIT MANIPULATION                
         LB,R0    DCTTJE,R7                                                     
         LW,R9    R9                                                            
         BLZ      %+3               SKIP FOR RESET                              
         OR,R0    R9                SET APPROPRIATE BIT                         
         B        %+2                                                           
         AND,R0   R9                RESET APPROPRIATE BIT                       
         STB,R0   DCTTJE,R7                                                     
         ENABLE                                                                 
         B        *R8                                                           
*                                                                               
*                                                                               
ENDSET   RES      0                 SET ENDING FLAGS FOR DCB RELEASE            
         LI,R0    JCBPOINT          SET ASYNCHRONOUS ENDING FLAGS               
         AW,R0    R1                                                            
         LB,R10   *R0                                                           
         OR,R9    R10                                                           
         STB,R9   *R0                                                           
         B        *R11                                                          
         PAGE                                                                   
A:TEX1   RES      0                                                             
         OLAYEND                                                                
         FIN      #TJE                                                          
         END                                                                    
