* AS WRITTEN, THIS PROGRAM REQUIRES THE FOLLOWING CBL OPTIONS. * CBL MAP,XREF(SHORT),OFFSET,TEST(ALL,SYM),APOST,LIB * CBL TRUNC(BIN),NOZWB * CBL DATA(31),RMODE(ANY) IDENTIFICATION DIVISION. PROGRAM-ID. BSTTEZ61. * * COPYRIGHT TEI 2009-2011 * * IPV6 VERSION OF BSTTEZ11 * * BASED ON FIGURE 38 IN MVS TCP/IP SOCKETS RED BOOK. * GG24-2561-00 * * ALL LINES MARKED WITH CHANGE> MUST BE CHANGED TO MATCH * LOCAL REQUIREMENTS. * * HOW TO USE THIS SAMPLE PROGRAM: * * 1) COMPILE BSTTEZ60, BSTTEZ61, BSTTEZ62, AND BSTTEZ63. * 2) DEFINE THE FOLLOWING TRANSACTION TO CICS: * EZ60 TO RUN BSTTEZ60 * EZ61 TO RUN BSTTEZ61 * EZ62 TO RUN BSTTEZ62 * EZ63 TO RUN BSTTEZ63 * 3) DEFINE THE FOLLOWING PROGRAMS TO CICS: * BSTTEZ60 (STARTS/STOPS LISTENER) * BSTTEZ61 (LISTENER) * BSTTEZ62 (TEST CLIENT) * BSTTEZ63 (TEST CHILD) * 4) THE LISTENER CAN BE MANUALLY STARTED USING TRANSACTION * EZ60. * 5) OPTIONALLY, PLACE THE STARTUP PROGRAM BSTTEZ60 IN THE * STARTUP PLT. * 6) RUN TRANSACTION EZ62 TO TEST THE PROCESS. * 'EZ62 APPLID' OR 'EZ62 TIME' * 7) CONSOLE MESSAGES WILL INDICATE IF EVERYTHING WORKS AS * AS EXPECTED. * 8) TO SHUTDOWN THE LISTENER, RUN TRANSACTION EZ60 AGAIN. * 9) OPTIONALLY, PLACE THE SHUTDOWN PROGRAM BSTTEZ60 IN THE * SHUTDOWN PLT. * * CHANGE LOG: * AUG 19, 2009 TT NEW PROGRAM * TT = TONY THIGPEN TONY@VSE2PDF.COM * AUG 20, 2009 TT FIXED CLOSE-ALL LOGIC * OCT 13, 2009 TT ADDED PERFORM EZA-TERMAPI IN ABEND ROUTINE * SEP 04, 2010 TT REMOVED BSTTEZA8 COPYBOOK * SEP 04, 2010 TT REMOVED BSTTEZA8 COPYBOOK * NOV 18, 2010 TT CHANGED SOME WS-SUB1 TO NEW WS-SUB2 WHEN * BEING PERFORMED FROM PARAGRAPH USING WS-SUB1. ENVIRONMENT DIVISION. CONFIGURATION SECTION. DATA DIVISION. WORKING-STORAGE SECTION. 01 PROGRAM-INFOMATION. 05 PROGRAM-NAME PIC X(08) VALUE 'BSTTEZ61'. 05 PROGRAM-TITLE PIC X(23) VALUE 'EZA CICS LISTENER '. 01 WS-AREA. 05 WS-SUB1 PIC S9(04) COMP. 111810 05 WS-SUB2 PIC S9(04) COMP. 05 WS-CUR-SOCKET PIC S9(04) COMP. 05 WS-SOCKET-ORIGINAL PIC S9(04) COMP. 05 WS-SOCKET-ACCEPT PIC S9(04) COMP. 05 WS-SOCKET-GIVE PIC S9(04) COMP. 05 WS-TEXT-LENGTH PIC S9(04) COMP. 05 WS-IPADDRESS PIC X(16) VALUE LOW-VALUES. 05 WS-IPPORT PIC S9(04) COMP VALUE +4444. 05 WS-COUNT PIC S9(04) COMP VALUE +0. 05 WS-OURCLIENT PIC X(40) VALUE LOW-VALUES. 05 WS-CLIENT-NAME PIC X(16) VALUE LOW-VALUES. 05 WS-FCI PIC X(01) VALUE SPACES. 88 HAVE-TERMINAL VALUE X'01'. 05 WS-SHUTDOWN PIC X(01) VALUE SPACES. 88 SHUTDOWN-PROGRAM VALUE 'Y'. 05 WS-CVDA PIC S9(09) COMP. 01 ABEND-INFORMATION. 03 CURRENT-FUNCTION PIC X(20) VALUE SPACES. 03 CURRENT-ERROR PIC 9(05) VALUE ZEROES. 03 ABEND-FILLER PIC X(01) VALUE SPACES. 03 ABEND-CODE PIC 9(04) VALUE ZEROS. 101309 01 ABEND-INFO-SAVE PIC X(30). 01 MESSAGES. 05 MSG-DONE PIC X(14) VALUE 'BSTTEZ61 DONE '. 05 MSG-EZA. 10 MSG-EZA-TRAN PIC X(04). 10 FILLER PIC X(01). 10 MSG-EZA-TASK PIC 9(07). 10 FILLER PIC X(01). 10 MSG-EZA-FUNCTION PIC X(16). 05 MSG-CLOSE-GIVEN PIC X(14) VALUE 'CLOSING GIVEN '. 05 MSG-ACCEPT PIC X(14) VALUE 'READING ACCEPT'. 05 MSG-INVALID-REQUEST PIC X(35) VALUE 'INVALID REQUEST '. 05 MSG-SCTY-ERROR PIC X(35) VALUE '95 AUTHORIZATION FAILED '. 01 BUFFER-IN PIC X(80) VALUE SPACES. 01 BUFFER-OUT PIC X(80) VALUE SPACES. 01 SELECT-MASKS. 05 RSNDMSK PIC X(08) VALUE LOW-VALUES. 05 WSNDMSK PIC X(08) VALUE LOW-VALUES. 05 ESNDMSK PIC X(08) VALUE LOW-VALUES. 05 RRETMSK PIC X(08) VALUE LOW-VALUES. 05 WRETMSK PIC X(08) VALUE LOW-VALUES. 05 ERETMSK PIC X(08) VALUE LOW-VALUES. 01 SOCKET-FLAGS VALUE SPACES. 05 SOCKET-STATUS PIC X(01) OCCURS 64 TIMES. * VALUES FOR SOCKET-STATUS CAN BE: * ' ' SOCKET IS UNUSED OR HAS BEEN TAKEN * 'L' SOCKET IS IN LISTEN MODE * 'P' SOCKET IS WAITING FOR PEEK DATA * 'G' SOCKET IS BEING GIVEN 01 SOCKET-MASKS VALUE SPACES. 05 SM-RECVS. 10 SM-RECV PIC X(01) OCCURS 64 TIMES. 05 SM-WRITES. 10 SM-WRITE PIC X(01) OCCURS 64 TIMES. 05 SM-EXCEPTIONS. 10 SM-EXCEPTION PIC X(01) OCCURS 64 TIMES. 01 SOCKET-MASKS-LIMIT PIC S9(04) COMP VALUE +64. 01 SOCKET-MASKS-USED PIC S9(04) COMP VALUE +0. 01 START-CHILD-PARM. * THIS AREA IS DOCUMENTED IN "LISTENER OUTPUT FORMAT", * FIGURE 15 IN CHAPTER 14, EXTERNAL DATA STRUCTURES, OF * "TCP/IP FOR VSE/ESA - IBM PROGRAM SETUP AND SUPPLEMENTARY * INFORMATION - SC33-6601-5" 05 START-S PIC 9(08) COMP. 05 START-CLIENTID. 15 START-C-DOMAIN PIC 9(08) COMP. 15 START-C-NAME PIC X(08). 15 START-C-TASK PIC X(08). 15 FILLER PIC X(20). 05 START-USER-DATA PIC X(35). 05 FILLER PIC X(01). 05 START-NAME. 15 START-FAMILY PIC 9(04) COMP. 15 START-PORT PIC 9(04) COMP. 15 START-ADDRESS PIC 9(08) COMP. 15 START-ZERO PIC X(08). 01 CLIENT-DATA. * THIS AREA IS DOCUMENTED IN "LISTENER INPUT FORMAT", * IN CHAPTER 15, EXTERNAL DATA STRUCTURES, OF * "TCP/IP FOR VSE/ESA - IBM PROGRAM SETUP AND SUPPLEMENTARY * INFORMATION - SC33-6601-5" 05 CLIENT-TRANID PIC X(04). 05 CLIENT-USER-DATA PIC X(35). 05 CLIENT-START-METHOD PIC X(02). 05 CLIENT-INTERVAL-TIME PIC X(06). 01 SECURITY-DATA. * THIS AREA IS DOCUMENTED IN "WRITING YOUR OWN SECURITY LINK * MODULE FOR THE LISTENER" IN SECTION 6.6.3 OF * "TCP/IP V3R2 FOR MVS: CICS TCP/IP SOCKET INTERFACE GUIDE - * SC31-7131-03" 05 SCTY-TRANID PIC X(04). 05 SCTY-USER-AREA PIC X(40). 05 SCTY-START-METHOD PIC X(02). 05 SCTY-INTERVAL-TIME PIC X(06). 05 SCTY-FAMILY PIC 9(04) COMP. 05 SCTY-PORT PIC 9(04) COMP. 05 SCTY-IPADDRESS PIC X(04). 05 SCTY-SWITCH PIC X(01). 88 SCTY-OK VALUE '1'. 05 SCTY-SWITCH2 PIC X(01). 88 SCTY-SEND-MSG VALUE '1'. 05 SCTY-TERMID PIC X(04). 05 SCTY-S PIC S9(04) COMP. 05 SCTY-USERID PIC X(08). 01 EZA-CALL-DATA. COPY BSTTEZA. 01 EZACIC06-DATA. COPY BSTTEZA6. PROCEDURE DIVISION. MAINLINE SECTION. ML-START. EXEC CICS ASSIGN FCI(WS-FCI) NOHANDLE END-EXEC. PERFORM EZACIC06-SETUP. ML-INITAPI. MOVE SOCKET-MASKS-LIMIT TO EZA-MAXSOC. MOVE SPACES TO EZA-IDENT. MOVE SPACES TO EZA-SUBTASK. PERFORM EZA-INITAPI. IF EZA-RETCODE IS LESS THAN +0 GO TO AR-0001. ML-GETCLIENTID. PERFORM EZA-GETCLIENTID. IF EZA-RETCODE IS LESS THAN +0 GO TO AR-0002. MOVE EZA-CLIENT TO WS-OURCLIENT. ML-SOCKET. MOVE EZA-INET6 TO EZA-AF. PERFORM EZA-SOCKET. IF EZA-RETCODE IS LESS THAN +0 GO TO AR-0003. MOVE EZA-RETCODE TO EZA-S. MOVE EZA-RETCODE TO WS-SOCKET-ORIGINAL. ML-BIND. MOVE LOW-VALUES TO EZA-NAMEV6. MOVE +19 TO EZA-NAMEV6-FAMILY. MOVE WS-IPPORT TO EZA-NAMEV6-PORT. MOVE WS-IPADDRESS TO EZA-NAMEV6-IPADDRESS. PERFORM EZA-BIND. IF EZA-RETCODE IS LESS THAN +0 GO TO AR-0004. ML-LISTEN. MOVE +10 TO EZA-BACKLOG. PERFORM EZA-LISTEN. IF EZA-RETCODE IS LESS THAN +0 GO TO AR-0005. COMPUTE WS-SUB1 = EZA-S + 1. MOVE 'L' TO SOCKET-STATUS (WS-SUB1). PERFORM WAIT-FOR-DATA. PERFORM CLOSE-ALL. ML-TERMAPI. PERFORM EZA-TERMAPI. IF HAVE-TERMINAL EXEC CICS SEND TEXT FROM(MSG-DONE) LENGTH(LENGTH OF MSG-DONE) ERASE END-EXEC EXEC CICS SEND CONTROL FREEKB END-EXEC ELSE EXEC CICS WRITE OPERATOR TEXT(MSG-DONE) TEXTLENGTH(LENGTH OF MSG-DONE) END-EXEC. EXEC CICS RETURN END-EXEC. ML-EXIT. GOBACK. WAIT-FOR-DATA SECTION. WFD-START. ADD +1 TO WS-COUNT. WFD-SELECT-SET. MOVE ZEROES TO SOCKET-MASKS. MOVE -1 TO WS-CUR-SOCKET. WFD-SELECT-SET-LOOP. ADD +1 TO WS-CUR-SOCKET. COMPUTE WS-SUB1 = WS-CUR-SOCKET + 1. IF WS-SUB1 IS GREATER THAN SOCKET-MASKS-LIMIT GO TO WFD-SELECT-SET-END. IF SOCKET-STATUS (WS-SUB1) IS EQUAL TO ' ' GO TO WFD-SELECT-SET-LOOP. MOVE WS-SUB1 TO SOCKET-MASKS-USED. IF SOCKET-STATUS (WS-SUB1) IS EQUAL TO 'L' MOVE '1' TO SM-RECV (WS-SUB1). IF SOCKET-STATUS (WS-SUB1) IS EQUAL TO 'P' MOVE '1' TO SM-RECV (WS-SUB1). IF SOCKET-STATUS (WS-SUB1) IS EQUAL TO 'G' MOVE '1' TO SM-EXCEPTION (WS-SUB1). GO TO WFD-SELECT-SET-LOOP. WFD-SELECT-SET-END. WFD-SELECT. MOVE LOW-VALUES TO EZA-TIMEOUT. MOVE 30 TO EZA-TIMEOUT-SECONDS. MOVE SOCKET-MASKS-USED TO EZA-MAXSOC-SELECT. MOVE SM-RECVS TO EZ6-FLAGS. PERFORM EZA-CHARACTERS-TO-BITS. MOVE LOW-VALUES TO RSNDMSK. MOVE EZ6-MASK TO RSNDMSK (1 : LENGTH OF EZ6-MASK). MOVE SM-WRITES TO EZ6-FLAGS. PERFORM EZA-CHARACTERS-TO-BITS. MOVE LOW-VALUES TO WSNDMSK. MOVE EZ6-MASK TO WSNDMSK (1 : LENGTH OF EZ6-MASK). MOVE SM-EXCEPTIONS TO EZ6-FLAGS. PERFORM EZA-CHARACTERS-TO-BITS. MOVE LOW-VALUES TO ESNDMSK. MOVE EZ6-MASK TO ESNDMSK (1 : LENGTH OF EZ6-MASK). PERFORM EZA-SELECT. IF EZA-RETCODE IS LESS THAN +0 GO TO AR-0006. IF EZA-RETCODE IS EQUAL TO +0 071709 GO WFD-SELECT-INSPECT-END. MOVE RRETMSK TO EZ6-MASK. PERFORM EZA-BITS-TO-CHARACTERS. MOVE EZ6-FLAGS TO SM-RECVS. MOVE WRETMSK TO EZ6-MASK. PERFORM EZA-BITS-TO-CHARACTERS. MOVE EZ6-FLAGS TO SM-WRITES. MOVE ERETMSK TO EZ6-MASK. PERFORM EZA-BITS-TO-CHARACTERS. MOVE EZ6-FLAGS TO SM-EXCEPTIONS. WFD-SELECT-INSPECT. MOVE -1 TO WS-CUR-SOCKET. WFD-SELECT-INSPECT-LOOP. ADD +1 TO WS-CUR-SOCKET. COMPUTE WS-SUB1 = WS-CUR-SOCKET + 1. IF WS-SUB1 IS GREATER THAN SOCKET-MASKS-LIMIT GO TO WFD-SELECT-INSPECT-END. IF SOCKET-STATUS (WS-SUB1) IS EQUAL TO ' ' GO TO WFD-SELECT-INSPECT-LOOP. IF SM-RECV (WS-SUB1) IS EQUAL TO '1' AND SOCKET-STATUS (WS-SUB1) IS EQUAL TO 'L' PERFORM NEW-CONNECTION. IF SM-RECV (WS-SUB1) IS EQUAL TO '1' AND SOCKET-STATUS (WS-SUB1) IS EQUAL TO 'P' PERFORM START-REQUESTED. IF SM-EXCEPTION (WS-SUB1) IS EQUAL TO '1' AND SOCKET-STATUS (WS-SUB1) IS EQUAL TO 'G' PERFORM CLOSE-GIVEN. GO TO WFD-SELECT-INSPECT-LOOP. WFD-SELECT-INSPECT-END. EXEC CICS INQUIRE SYSTEM CICSSTATUS(WS-CVDA) END-EXEC. IF WS-CVDA IS NOT EQUAL TO DFHVALUE(ACTIVE) AND WS-CVDA IS NOT EQUAL TO DFHVALUE(STARTUP) MOVE 'Y' TO WS-SHUTDOWN. IF SHUTDOWN-PROGRAM GO TO WFD-EXIT. GO TO WFD-START. WFD-EXIT. EXIT. NEW-CONNECTION SECTION. NC-START. IF HAVE-TERMINAL EXEC CICS SEND TEXT FROM(MSG-ACCEPT) LENGTH(LENGTH OF MSG-ACCEPT) ERASE 071709 END-EXEC 071709 EXEC CICS SEND CONTROL 071709 FREEKB END-EXEC. NC-ACCEPT. MOVE WS-CUR-SOCKET TO EZA-S. PERFORM EZA-ACCEPT. IF EZA-RETCODE IS EQUAL TO -1 * OTHER END DROPPED BEFORE WE CONNECTED VSEBSI AND EZA-ERRNO IS EQUAL TO +30358 VSECSI* AND EZA-ERRNO IS EQUAL TO ?????? ZOS * AND EZA-ERRNO IS EQUAL TO ?????? GO TO NC-EXIT. IF EZA-RETCODE IS LESS THAN +0 GO TO AR-0007. 091108 MOVE EZA-RETCODE TO WS-SOCKET-ACCEPT. 111810 COMPUTE WS-SUB2 = EZA-RETCODE + 1. 111810 MOVE 'P' TO SOCKET-STATUS (WS-SUB2). NC-EXIT. EXIT. START-REQUESTED SECTION. SR-RECVFROM. MOVE WS-CUR-SOCKET TO EZA-S. PERFORM EZA-RECVFROM. IF EZA-RETCODE IS LESS THAN +0 GO TO AR-0008. MOVE EZA-RETCODE TO EZA-NBYTE. PERFORM EZA-ASCII-TO-EBCDIC. MOVE EZA-NBYTE TO WS-TEXT-LENGTH IF HAVE-TERMINAL EXEC CICS SEND TEXT FROM(BUFFER-IN) LENGTH(WS-TEXT-LENGTH) ERASE 071709 END-EXEC 071709 EXEC CICS SEND CONTROL 071709 FREEKB END-EXEC. TRACE EXEC CICS WRITE OPERATOR TRACE TEXT(BUFFER-IN) TRACE TEXTLENGTH(EZA-NBYTE) TRACE END-EXEC. MOVE EZA-NAME TO WS-CLIENT-NAME. MOVE SPACES TO CLIENT-DATA. UNSTRING BUFFER-IN (1 : EZA-NBYTE) DELIMITED BY ',' INTO CLIENT-TRANID CLIENT-USER-DATA CLIENT-START-METHOD CLIENT-INTERVAL-TIME ON OVERFLOW GO TO SR-SECURITY. SR-SECURITY. MOVE SPACES TO SECURITY-DATA. MOVE CLIENT-TRANID TO SCTY-TRANID MOVE CLIENT-USER-DATA TO SCTY-USER-AREA MOVE CLIENT-START-METHOD TO SCTY-START-METHOD MOVE CLIENT-INTERVAL-TIME TO SCTY-INTERVAL-TIME MOVE WS-CLIENT-NAME TO EZA-NAME. MOVE EZA-NAME-FAMILY TO SCTY-FAMILY. MOVE EZA-NAME-PORT TO SCTY-PORT. MOVE EZA-NAME-IPADDRESS TO SCTY-IPADDRESS. MOVE WS-SOCKET-ACCEPT TO SCTY-S. EXEC CICS LINK PROGRAM('EZACICSE') COMMAREA(SECURITY-DATA) LENGTH(LENGTH OF SECURITY-DATA) NOHANDLE END-EXEC. * EZACICSE IS OPTIONAL AND IF NOT FOUND, JUST IGNORE IF EIBRESP IS NOT EQUAL TO DFHRESP(NORMAL) SET SCTY-OK TO TRUE. IF SCTY-OK OR SCTY-SEND-MSG GO TO SR-MAYBE-SHUTDOWN. MOVE MSG-SCTY-ERROR TO BUFFER-OUT. PERFORM INVALID-INFORMATION. GO TO SR-EXIT. SR-MAYBE-SHUTDOWN. IF CLIENT-TRANID = 'DOWN' OR CLIENT-TRANID = 'STOP' MOVE 'Y' TO WS-SHUTDOWN GO TO SR-EXIT. SR-GIVESOCKET. PERFORM EZA-GIVESOCKET. IF EZA-RETCODE IS LESS THAN +0 GO TO AR-0009. MOVE WS-CUR-SOCKET TO WS-SOCKET-GIVE. PERFORM SPAWN-CHILD. SR-EXIT. EXIT. SPAWN-CHILD SECTION. SC-START. MOVE SPACES TO START-CHILD-PARM. MOVE WS-SOCKET-ACCEPT TO START-S. MOVE WS-OURCLIENT TO START-CLIENTID. MOVE CLIENT-USER-DATA TO START-USER-DATA. MOVE EZA-NAME TO START-NAME. EXEC CICS START TRANSID(CLIENT-TRANID) FROM(START-CHILD-PARM) LENGTH(LENGTH OF START-CHILD-PARM) NOHANDLE END-EXEC 111810 COMPUTE WS-SUB2 = WS-SOCKET-GIVE + 1. 111810 MOVE 'G' TO SOCKET-STATUS (WS-SUB2). IF EIBRESP IS NOT EQUAL TO DFHRESP(NORMAL) MOVE MSG-INVALID-REQUEST TO BUFFER-OUT PERFORM INVALID-INFORMATION. SC-EXIT. EXIT. CLOSE-GIVEN SECTION. CG-START. IF HAVE-TERMINAL EXEC CICS SEND TEXT FROM(MSG-CLOSE-GIVEN) LENGTH(LENGTH OF MSG-CLOSE-GIVEN) ERASE 071709 END-EXEC 071709 EXEC CICS SEND CONTROL 071709 FREEKB END-EXEC. CG-CLOSE. MOVE WS-CUR-SOCKET TO EZA-S. PERFORM EZA-CLOSE. IF EZA-RETCODE IS LESS THAN +0 GO TO AR-0010. 111810 COMPUTE WS-SUB2 = WS-CUR-SOCKET + 1. 111810 MOVE ' ' TO SOCKET-STATUS (WS-SUB2). CG-EXIT. EXIT. CLOSE-ALL SECTION. CA-START. MOVE +0 TO WS-SUB1. CA-SHUTDOWN-LOOP. ADD +1 TO WS-SUB1. COMPUTE EZA-S = WS-SUB1 - 1. IF WS-SUB1 IS GREATER THAN SOCKET-MASKS-LIMIT GO TO CA-EXIT. IF SOCKET-STATUS (WS-SUB1) IS EQUAL TO SPACE GO TO CA-SHUTDOWN-LOOP. CA-CLOSE. PERFORM EZA-CLOSE IF EZA-RETCODE IS LESS THAN +0 GO TO AR-0011. MOVE ' ' TO SOCKET-STATUS (WS-SUB1). GO TO CA-SHUTDOWN-LOOP. CA-EXIT. EXIT. INVALID-INFORMATION SECTION. II-START. MOVE LENGTH OF MSG-SCTY-ERROR TO EZA-NBYTE. PERFORM EZA-EBCDIC-TO-ASCII. PERFORM EZA-SEND. IF HAVE-TERMINAL EXEC CICS SEND TEXT FROM(MSG-SCTY-ERROR) LENGTH(LENGTH OF MSG-SCTY-ERROR) ERASE 071709 END-EXEC 071709 EXEC CICS SEND CONTROL 071709 FREEKB END-EXEC. EXEC CICS WRITE OPERATOR TEXT(MSG-SCTY-ERROR) TEXTLENGTH(LENGTH OF MSG-SCTY-ERROR) END-EXEC. PERFORM EZA-CLOSE. IF EZA-RETCODE IS LESS THAN +0 GO TO AR-0012. COMPUTE WS-SUB1 = WS-CUR-SOCKET + 1. MOVE ' ' TO SOCKET-STATUS (WS-SUB1). II-EXIT. EXIT. * COPY IN ALL THE EZA SECTIONS COPY BSTTEZAP. CONSOLE-TRACE SECTION. * COMMENT OUT THE WTO IF IT IS NOT WANTED CT-START. MOVE SPACES TO MSG-EZA. MOVE EIBTRNID TO MSG-EZA-TRAN. MOVE EIBTASKN TO MSG-EZA-TASK. MOVE EZA-FUNCTION TO MSG-EZA-FUNCTION. EXEC CICS WRITE OPERATOR TEXT(MSG-EZA) TEXTLENGTH(LENGTH OF MSG-EZA) END-EXEC. CT-EXIT. EXIT. ABEND SECTION. AR-0001. MOVE 0001 TO ABEND-CODE. GO TO AR-ABEND. AR-0002. MOVE 0002 TO ABEND-CODE. GO TO AR-ABEND. AR-0003. MOVE 0003 TO ABEND-CODE. GO TO AR-ABEND. AR-0004. MOVE 0004 TO ABEND-CODE. GO TO AR-ABEND. AR-0005. MOVE 0005 TO ABEND-CODE. GO TO AR-ABEND. AR-0006. MOVE 0006 TO ABEND-CODE. GO TO AR-ABEND. AR-0007. MOVE 0007 TO ABEND-CODE. GO TO AR-ABEND. AR-0008. MOVE 0008 TO ABEND-CODE. GO TO AR-ABEND. AR-0009. MOVE 0009 TO ABEND-CODE. GO TO AR-ABEND. AR-0010. MOVE 0010 TO ABEND-CODE. GO TO AR-ABEND. AR-0011. MOVE 0011 TO ABEND-CODE. GO TO AR-ABEND. AR-0012. MOVE 0012 TO ABEND-CODE. GO TO AR-ABEND. AR-ABEND. MOVE EZA-ERRNO TO CURRENT-ERROR. IF HAVE-TERMINAL EXEC CICS SEND TEXT FROM(ABEND-INFORMATION) LENGTH(LENGTH OF ABEND-INFORMATION) ERASE END-EXEC EXEC CICS SEND CONTROL FREEKB END-EXEC. EXEC CICS WRITE OPERATOR TEXT(ABEND-INFORMATION) TEXTLENGTH(LENGTH OF ABEND-INFORMATION) END-EXEC. 101309 MOVE ABEND-INFORMATION TO ABEND-INFO-SAVE. 101309 PERFORM EZA-TERMAPI. 101309 MOVE ABEND-INFO-SAVE TO ABEND-INFORMATION. EXEC CICS ABEND ABCODE(ABEND-CODE) END-EXEC. AR-EXIT. EXIT.