[ Home | Contents | Search | Post | Reply | Next | Previous | Up ]
From: Bob Juch
Date: 06 Aug 1999
Time: 00:51:07
Remote Name: 32.101.63.130
Here's my code that cleans up TS queues during Autoinstall delete. Note that it prints the contents of CEBR queues. That's so the COBOL diagnostic info doesn't get lost. (Stuff like subscript range checking messages.) I prefer to have this in the Autoinstall delete instead of DFHZNEP as there are many terminal errors that don't cause a disconnect. (The terminal connection goes through DFHZNEP too.) I suppose a check could be made on the action bits, but I think it's safer in the delete code.
Bob Juch***********************************************************************
* FUNCTION 1 - DELETE
PROCESSING
*
***********************************************************************
DELETE_TERMINAL DS 0H
USING DELETE_EXIT_COMMAREA,R2
ADDRESS DELETE COMMAREA
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),DELETE_TERM_ID
BE
DELNEXT3
MATCH ?
CLC
TSQNAME+4(4),DELETE_TERM_ID
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.
B
DELLOOP1
DELRETRN EXEC CICS INQUIRE TSQUEUE END NOHANDLE.
B
RETURN
EXIT PROGRAM
*
DFHEISTG DSECT ,
TSQLEN DS H
TSQNAME DS CL8 TS QUEUE NAME
DFHZATDY CSECT ,