CTESTER  DFHEIENT                                                               
         DFHREGS                                                                
         EXEC CICS HANDLE ABEND                                        C        
               LABEL(PGMABND)                                                   
 CALL ASMTDLI,(PCB,PSBNAME,UIBPTR,SYSSERVE),VL,MF=(E,CALLLIST)                  
         EXEC CICS WRITEQ TS QUEUE('DOUGIE') FROM(UIBPTR)                       
         MVC   IOAREA(4),=Y(40,0)                                               
         MVC   IOAREA+4(36),=CL36'/DIS ACTIVE.'                                 
         MVC   AIBID,=CL8'DFSAIB'      INITIALISE ...                           
         MVC   AIBLEN,=A(AIBLL)        .. DFSAIB ...                            
         MVC   AIBOALEN,=A(LIOAREA)    .. CONTROL BLOCK                         
 CALL AIBTDLI,(ICMD,AIB,IOAREA),VL,MF=(E,CALLLIST)                              
         EXEC CICS WRITEQ TS QUEUE('DOUGIE') FROM(IOAREA+4)            X        
               LENGTH(IOAREA)                                                   
LOOP     DS    0H                                                               
 CALL AIBTDLI,(RCMD,AIB,IOAREA),VL,MF=(E,CALLLIST)                              
         L     R15,AIBRETRN                                                     
         LTR   R15,R15                                                          
         BNZ   ENDLOOP                                                          
         EXEC CICS WRITEQ TS QUEUE('DOUGIE') FROM(IOAREA+4)            X        
               LENGTH(IOAREA)                                                   
         B     LOOP                                                             
ENDLOOP  DS    0H                                                               
         EXEC CICS WRITEQ TS QUEUE('DOUGIE') FROM(IOAREA+4)            X        
               LENGTH(IOAREA)                                                   
 CALL ASMTDLI,(TERM),VL,MF=(E,CALLLIST)                                         
         EXEC CICS WRITEQ TS QUEUE('DOUGIE') FROM(TERM)                         
         EXEC CICS RETURN                                                       
PGMABND  DS    0H                                                               
         EXEC CICS ASSIGN                                              C        
               ABCODE(ABNDCODE)                                                 
         EXEC CICS RETURN                                                       
PCB      DC   CL4'PCB'                                                          
ICMD     DC   CL4'ICMD'                                                         
RCMD     DC   CL4'RCMD'                                                         
TERM     DC   CL4'TERM'                                                         
PSBNAME  DC   CL8'DFHDBMP'                                                      
SYSSERVE DC   CL8'IOPCB'                                                        
DFHEISTG DSECT                                                                  
COMMAREA DS    0H                                                               
ABNDCODE DS    CL4                                                              
CALLLIST CALL  ,(,,,,,),MF=L                                                    
UIBPTR   DS    F                                                                
IOAREA   DS    CL(10*80)          ALLOW FOR TEN LINES OF OUTPUT                 
LIOAREA  EQU   *-IOAREA                                                         
AIB      DS    0F                                                               
AIBID    DS    CL8                 EYECATCHER                                   
AIBLEN   DS    F                   DFSAIB ALLOCATED LENGTH                      
AIBSFUNC DS    CL8                 SUBFUNCTION CODE                             
AIBRSNM1 DS    CL8                 RESOURCE NAME 1                              
AIBRSNM2 DS    CL8                 RESOURCE NAME 2                              
         DS    2F                  RESERVED                                     
AIBOALEN DS    F                   OUTPUT AREA LENGTH (MAX)                     
AIBOAUSE DS    F                   OUTPUT AREA LENGTH (USED)                    
         DS    2F                  RESERVED                                     
         DS    H                   RESERVED                                     
         DS    H                   RESERVED                                     
AIBRETRN DS    F                   RETURN CODE                                  
AIBREASN DS    F                   REASON CODE                                  
         DS    F                   RESERVED                                     
AIBRSA1  DS    A                   RESOURCE ADDRESS 1                           
AIBRSA2  DS    A                   RESOURCE ADDRESS 2                           
AIBRSA3  DS    A                   RESOURCE ADDRESS 3                           
         DS    10F                 RESERVED                                     
AIBLL    EQU   *-AIB               DFSAIB LENGTH                                
LCOMAREA EQU   *-COMMAREA                                                       
         DLIUIB                                                                 
         END