*
* This code deletes terminal-related TS queues when a terminal
* disconnects. It prints ones starting with CEBR first in case a COBOL
* program has placed diagnostic information there, such as from SSRANGE
*
* This also has groups to better handle some "normal" abnormal
* disconnects. It turns off the hex dumps of control blocks. It also
* ensures the terminals are not attempted to be acquired by CICS by
* setting CLSDEST. Cancel task is also set to attempt to purge the
* attached transaction more quickly.
*
         DFHSNEP TYPE=USTOR
LOWER_TWANID DS CL4
TSQLEN   DS    H
TSQNAME  DS    CL8                     TS QUEUE NAME
TSQMESSG DS    CL40
         DFHSNEP TYPE=USTOREND
*
         DFHSNEP TYPE=INITIAL,CS=NO
         EJECT
         DFHSNEP TYPE=ERRPROC,GROUP=11,CODE=(49)
         ST    CSVTBAR,NEPEPRS        SAVE RETURN REGISTER
         LR    R8,EPBAR
         USING NEPROC11,R8
*
*        DELETE ALL TSQUEUES WITH TERMID IN NAME
*
         MVC   TSQMESSG,DELMESSG       SETUP MESSAGE
         MVC   LOWER_TWANID,TWANID     COPY ID
         NI    LOWER_TWANID,X'7F'      MAKE FIRST CHAR LOWER CASE
         EXEC  CICS INQUIRE TSQUEUE START NOHANDLE.
DELLOOP1 EXEC  CICS INQUIRE TSQUEUE(TSQNAME) NEXT NOHANDLE.
         CLC   EIBRESP,=F'0'           DID IT WORK ?
         BNE   DELRETRN
         CLC   TSQNAME(4),TWANID
         BE    DELNEXT3                MATCH ?
         CLC   TSQNAME(4),LOWER_TWANID
         BE    DELNEXT3                MATCH ?
         CLC   TSQNAME+4(4),TWANID
         BE    DELNEXT2                MATCH ?
         B     DELLOOP1
DELNEXT2 CLC   TSQNAME(4),=C'CEBR'     COBOL ERROR MESSAGES ?
         BNE   DELNEXT3                NOPE
DELLOOP2 EXEC  CICS READQ TS QUEUE(TSQNAME) SET(R2) LENGTH(TSQLEN),    *
               NEXT NOHANDLE.
         CLC   EIBRESP,=F'0'           DID IT WORK ?
         BNE   DELNEXT3                NO, GO DELETE IT
         EXEC  CICS WRITEQ TD QUEUE('CSML') FROM(0(,R2)),              *
               LENGTH(TSQLEN) NOHANDLE.
         B     DELLOOP2                GO TRY IT AGAIN
DELNEXT3 EXEC  CICS DELETEQ TS QUEUE(TSQNAME) NOHANDLE.
         MVC   TSQMESSG+17(8),TSQNAME  MOVE NAME TO MESSAGE
         EXEC  CICS WRITEQ TD QUEUE('CSML') FROM(TSQMESSG),            *
               LENGTH(L'DELMESSG) NOHANDLE.
         B     DELLOOP1
DELRETRN EXEC  CICS INQUIRE TSQUEUE END NOHANDLE.
         B     RETURN                  EXIT PROGRAM
*
DELMESSG DC    C'DFHZNEP  TSQUEUE XXXXXXXX DELETED'
*
RETURN   DS    0H
         L     CSVTBAR,NEPEPRS
         BR    CSVTBAR
*
*        HANDLE "NORMAL" DISCONNECTS
*
         DFHSNEP TYPE=ERRPROC,GROUP=12,CODE=(24,54,59,5B,D8,CB)
*
         NI    TWAOPT1,TWAOAF                PRINT ACTION MESSAGES ONLY
         OI    TWAOPT2,TWAOCT                CANCEL TASK
         OI    TWAOPT3,TWAOCN                CLSDST NODE
*
         BR    CSVTBAR
*
*        HANDLE DFHZC3424 MESSAGE
*
         DFHSNEP TYPE=ERRPROC,GROUP=13,CODE=(5C)
*
         NI    TWAOPT2,255-TWAOASM           SET SIMLOGON OFF
*
         BR    CSVTBAR
*
         DFHSNEP TYPE=FINAL
*
         END     DFHNEPNA