The following CICS CLIv2 sample is written in COBOL. It uses 2PC processing.
ID DIVISION. PROGRAM-ID. CCX05. ****************************************************************** * TITLE: SAMPLE PROGRAM IN COBOL FOR 2PC PROTOCOL * * * * PROGRAM: THIS SAMPLE PROGRAM SHOWS ONE POSSIBLE METHOD FOR * * CODING A COBOL APPLICATION THAT UTILIZES THE * * TWO PHASE COMMIT PROTOCOL FOR PERFORMING UPDATES. * * * * TABLES: EMPLOYEE TABLE SUPPLIED WITH SAMPLES. * * * * CICS DEFS: PPT FOR THE CLC2PC01 SAMPLE PROGRAM. * * DFHPPT TYPE=ENTRY,PROGRAM=CLC2PC01,PGMLANG=COBOL * * PCT FOR THE PPC2PC01 SAMPLE PROGRAM. * * DFHPCT TYPE=ENTRY,PROGRAM=CLC2PC01,TRANSID=SAM4, * * TPURGE=NO,SPURGE=NO,TRNPRTY=255 * * * ****************************************************************** * MULTIPLE SESSIONS,USES MULTIPLE ACTIVE REQUESTS (ON 1 SESSION)* * * * REQUEST THREAD 1: SELECT EMPLOYEE_NUMBER , LAST_NAME FROM * * EMPLOYEE * * REQUEST THREAD 2: UPDATE EMPLOYEE SET HIRE_DATE = ’84/05/07’ * * WHERE EMPLOYEE_NUMBER = ? * * * * FOR TWO PHASE COMMIT, CONNECT WITH 2PC=’Y’ * * TO COMMIT WORK USE ’ISSUE-REQUEST-PROTOCOL’ FUNCTION ’T’’ * * THIS WILL ’PIGGY-BACK’ A VOTE AND TERMINATE PARCEL TO THE * * APPLICATION REQUEST PARCEL. THE ENTIRE UNIT OF WORK WILL * * BE COMMITTED OR ROLLED BACK. * * * * ALTERNATIVE TO VOTE&TERMINATE IS CICS SYNCPOINT OR * * SYNCPOINT ROLLBACK. THE SYNCPOINT TO COMMIT WORK MUST BE * * ISSUED BEFORE DISCONNECT. (DISCONNECT WILL ROLL BACK * * UNCOMMITTED UNITS OF WORK.) * * * *----------------------------------------------------------------* ENVIRONMENT DIVISION. DATA DIVISION. WORKING-STORAGE SECTION. 01 SESSION-INFO. 05 FAILURES PIC S9(9) COMP VALUE 0. 05 SESS-INDX PIC S9(9) COMP VALUE 0. 05 REQT-INDX PIC S9(9) COMP VALUE 0. 05 SESSION-DATA OCCURS 5 TIMES. 10 SESSION-NUM PIC S9(9) COMP. 10 REQUEST-NUM PIC S9(9) COMP OCCURS 15 TIMES. 01 PGM-FAILURE PIC X(3) VALUE ’NO ’. 01 LOGON-STRING PIC X(35) VALUE VALUE ’tdpid/userid,pswd’. 01 QUERY-SOURCE. 05 QUERY-STMT-LEN PIC S9(4) COMP. 05 QUERY-STMT PIC X(256) VALUE SPACES. 01 SELECT-STMT. 05 FILLER PIC X(25) VALUE ’SELECT EMPLOYEE_NUMBER ’. 05 FILLER PIC X(25) VALUE ’, LAST_NAME (CHAR(12)) ’. 05 FILLER PIC X(25) VALUE ’FROM EMPLOYEE ORDER BY ’. 05 FILLER PIC X(25) VALUE ’EMPLOYEE_NUMBER ’. 01 SELECT-STMT-LEN PIC S9(4) VALUE +100 COMP. 01 UPDATE-STMT. 05 FILLER PIC X(30) VALUE ’UPDATE EMPLOYEE SET HIRE_DATE=’ . 05 UPDATE-HIRE-DATE PIC X(12) VALUE ’’’84/05/07’’’ . 05 FILLER PIC X(25) VALUE ’ WHERE EMPLOYEE_NUMBER = ’. 05 UPDATE-EMPLOYEE-NUM PIC 9999 . 05 FILLER PIC X(25) VALUE ’ ; ’. 01 UPDATE-STMT-LEN PIC S9(4) VALUE +90 COMP. COPY DBCAREAC. COPY CLIPARMC. 01 FILLER REDEFINES PARCEL. 05 EMPNO PIC S9(9) COMP. 05 NAME PIC X(12). 01 FUDGE. 05 END-OF-BUFFER PIC S9(9) COMP VALUE 33. 05 WS-2PC-FUNC PIC X(1). 05 CON-2PC-NONE PIC X(1) VALUE ’N’. 05 CON-2PC-VOTE-TERM PIC X(1) VALUE ’T’. 05 CON-2PC-VOTE PIC X(1) VALUE ’V’. 01 MESSAGES. 05 MSG PIC X(80) VALUE SPACES. 05 MSG-1 PIC X(80) VALUE SPACES. 05 MSG-2 PIC X(80) VALUE SPACES. 05 MSG-3 PIC X(80) VALUE SPACES. 05 MSG-4 PIC X(80) VALUE SPACES. 05 MSG-5 PIC X(80) VALUE SPACES. 05 MSG-6 PIC X(80) VALUE SPACES. 05 MSG-FLAVOR. 10 MSG-FLAVOR-A PIC X(14) VALUE ’PARCEL FLAVOR ’. 10 MSG-FLAVOR-B PIC +99,999 DISPLAY. 10 FILLER PIC X(9) VALUE SPACES. 10 MSG-FLAVOR-C PIC X(20). 10 FILLER PIC X(30) VALUE SPACES. *---------------------------------------------------------------* * MAIN PROGRAM LOGIC * *---------------------------------------------------------------* PROCEDURE DIVISION. MOVE 1 TO SESS-INDX. MOVE 1 TO REQT-INDX. PERFORM Z000-INITIALIZE-DBCAREA. IF PGM-FAILURE = ’YES’ MOVE ’INTIALIZATION FAILURE - PROGRAM TERMINATING’ TO MSG PERFORM 0000-DISPLAY-80 PERFORM 0000-GOBACK. PERFORM Z100-CONNECT-SESSION. IF PGM-FAILURE = ’YES’ MOVE ’CONNECT FAILED - PROGRAM TERMINATING’ TO MSG PERFORM 0000-DISPLAY-80 PERFORM Z900-TERMINATE-DBCAREA PERFORM 0000-GOBACK. MOVE ’ CONNECTED ’ TO MSG. PERFORM 0000-DISPLAY-80. MOVE SELECT-STMT TO QUERY-STMT. MOVE SELECT-STMT-LEN TO QUERY-STMT-LEN. PERFORM B000-ISSUE-REQUEST. IF PGM-FAILURE = ’YES’ MOVE ’REQUEST FAILED - PROGRAM TERMINATING’ TO MSG PERFORM 0000-DISPLAY-80 PERFORM Z200-DISCONNECT-SESSION PERFORM Z900-TERMINATE-DBCAREA PERFORM 0000-GOBACK. MOVE DBCAREA-O-REQ-ID TO DBCAREA-I-REQ-ID. PERFORM A900-FETCH-PRINT-UPDATE UNTIL CLI-RETURN-CD NOT = 0 OR PGM-FAILURE = ’YES’. MOVE ’NO ’ TO PGM-FAILURE. MOVE 1 TO SESS-INDX. MOVE 1 TO REQT-INDX. PERFORM D000-END-REQUEST. IF PGM-FAILURE = ’YES’ MOVE ’END REQUEST FAILED’ TO MSG PERFORM 0000-DISPLAY-80 PERFORM Z200-DISCONNECT-SESSION PERFORM Z900-TERMINATE-DBCAREA PERFORM 0000-GOBACK. PERFORM Z200-DISCONNECT-SESSION. IF PGM-FAILURE = ’YES’ MOVE ’CONNECT FAILED - PROGRAM TERMINATING’ TO MSG PERFORM 0000-DISPLAY-80 PERFORM Z900-TERMINATE-DBCAREA PERFORM 0000-GOBACK. PERFORM Z900-TERMINATE-DBCAREA. IF PGM-FAILURE = ’YES’ MOVE ’TERMINATION FAILURE’ TO MSG PERFORM 0000-DISPLAY-80 . PERFORM 0000-GOBACK. *----------------------------------------------------------------* * SEND THE MESSAGE BUFFER * * ISOLATE THE CICS DISPLAY. TO AID MOVING THE PROGRAM TO * * OTHER ENVIRONMENTS. *----------------------------------------------------------------* 0000-DISPLAY-80 SECTION. EXEC CICS SEND FROM(MSG) LENGTH(80) END-EXEC. *----------------------------------------------------------------* * ROLLBACK ANY UPDATES * *----------------------------------------------------------------* 0000-SYNCPOINT-ROLL SECTION. EXEC CICS SYNCPOINT ROLLBACK END-EXEC. *----------------------------------------------------------------* * COMMIT ANY UPDATES * *----------------------------------------------------------------* 0000-SYNCPOINT SECTION. EXEC CICS SYNCPOINT END-EXEC. *----------------------------------------------------------------* * 0000-GOBACK * * ISOLATES END OF TASK PROCESSING TO AID MOVING THE PROGRAM * * OTHER ENVIRONMENTS. *----------------------------------------------------------------* 0000-GOBACK SECTION. MOVE ’ END OF TRANSACTION ’ TO MSG. PERFORM 0000-DISPLAY-80. EXEC CICS RETURN END-EXEC. *----------------------------------------------------------------* * FETCH AND PRINT A PARCEL * *----------------------------------------------------------------* A900-FETCH-PRINT-UPDATE SECTION. MOVE 1 TO REQT-INDX. PERFORM C000-FETCH-RESPONSE. IF PGM-FAILURE = ’YES’ GO TO A900-EXIT. PERFORM Y300-PRINT-PARCEL. IF DBCAREA-FET-PARCEL-FLAVOR = RECORD-TYPE THEN PERFORM A900-UPDATE. PERFORM A900-EXIT. A900-EXIT. EXIT. *----------------------------------------------------------------* * * * MAKE A SINGLE ROW UPDATE, USING REQUEST THREAD 2 * * ASSIGN THE HOST VARIABLES * * BUILD THE SQL STATEMENT * * ISSUE THE UPDATE REQUET * * RETRIEVE THE FEEDBACK PARCELS (SUCCESS/FAILURE) * * SET THE FAILURE PROFILE AS APPROPRIATE * * * *----------------------------------------------------------------* A900-UPDATE SECTION. MOVE 2 TO REQT-INDX. MOVE EMPNO TO UPDATE-EMPLOYEE-NUM. MOVE UPDATE-STMT TO QUERY-STMT. MOVE UPDATE-STMT-LEN TO QUERY-STMT-LEN. MOVE QUERY-STMT TO MSG. PERFORM 0000-DISPLAY-80. PERFORM B000-ISSUE-REQUEST. IF DBCAREA-RETURN-CD = 0 THEN PERFORM C000-FETCH-RESPONSE PERFORM Y300-PRINT-PARCEL PERFORM D000-END-REQUEST. PERFORM A901-EXIT. A901-EXIT. EXIT. *----------------------------------------------------------------* * * * ISSUE A REQUEST * * * * THIS INITIATE REQUEST DOES NOT USE A DATA PARCEL * * * * DURING REQUEST INITIATION THE FOLLOWING FIELDS MUST BE SET: * * * * DBCAREA-FUNC * * DBCAREA-I-SESS-ID * * DBCAREA-REQ-PTR * * DBCAREA-REQ-LEN * * DBCAREA-DATA-PTR * * DBCAREA-DATA-LEN * * * * REQUEST INITIATION RETURNS DBCAREA-O-REQ-ID * * * *----------------------------------------------------------------* B000-ISSUE-REQUEST SECTION. MOVE INITIATE-REQ-FUNC TO DBCAREA-FUNC. MOVE SESSION-NUM(SESS-INDX) TO DBCAREA-I-SESS-ID. MOVE ZERO TO DBCAREA-I-REQ-ID. CALL ’DBCHSAD’ USING CLI-RETURN-CD, DBCAREA-REQ-PTR, QUERY-STMT . IF CLI-RETURN-CD NOT = ZERO PERFORM Y000-ERROR GO TO B000-EXIT. MOVE QUERY-STMT-LEN TO DBCAREA-REQ-LEN. * IDENTIFY A NULL DATA PARCEL MOVE 0 TO DBCAREA-USING-DATA-LEN, DBCAREA-USING-DATA-PTR. CALL ’DBCHCL’ USING CLI-RETURN-CD, CONTEXT-PTR, DBCAREA. IF CLI-RETURN-CD NOT = ZERO PERFORM Y000-ERROR GO TO B000-EXIT. MOVE DBCAREA-O-REQ-ID TO REQUEST-NUM(SESS-INDX, REQT-INDX). B000-EXIT. EXIT. *----------------------------------------------------------------* * * * ISSUE A REQUEST WITH PROTOCOL FUNCTION PIGGY BACK * * * * THIS INITIATE REQUEST DOES NOT USE A DATA PARCEL * * * * DURING REQUEST INITIATION THE FOLLOWING FIELDS MUST BE SET: * * * * DBCAREA-FUNC * * DBCAREA-I-SESS-ID * * DBCAREA-REQ-PTR * * DBCAREA-REQ-LEN * * DBCAREA-DATA-PTR * * DBCAREA-DATA-LEN * * * * REQUEST INITIATION RETURNS DBCAREA-O-REQ-ID * * * *----------------------------------------------------------------* B000-ISSUE-REQUEST-PROTOCOL SECTION. MOVE INITIATE-REQ-FUNC TO DBCAREA-FUNC. MOVE SESSION-NUM(SESS-INDX) TO DBCAREA-I-SESS-ID. MOVE ZERO TO DBCAREA-I-REQ-ID. CALL ’DBCHSAD’ USING CLI-RETURN-CD, DBCAREA-REQ-PTR, SELECT-STMT. IF CLI-RETURN-CD NOT = ZERO PERFORM Y000-ERROR GO TO B000-EXIT. MOVE SELECT-STMT-LEN TO DBCAREA-REQ-LEN. * IDENTIFY A NULL DATA PARCEL MOVE 0 TO DBCAREA-USING-DATA-LEN, DBCAREA-USING-DATA-PTR. MOVE INIT-WITH-2PC-FUNC TO DBCAREA-FUNC. MOVE WS-2PC-FUNC TO DBCAREA-IWPF-FUNCTION. CALL ’DBCHCL’ USING CLI-RETURN-CD, CONTEXT-PTR, DBCAREA. IF CLI-RETURN-CD NOT = ZERO PERFORM Y000-ERROR GO TO B000-EXIT. MOVE DBCAREA-O-REQ-ID TO REQUEST-NUM(SESS-INDX, REQT-INDX). GO TO B000-EXIT. *----------------------------------------------------------------* * * * RETURN ONE PARCEL AT A TIME FROM THE RESPONSE BUFFER * * * * DURING FETCH THE FOLLOWING DBCAREA FIELDS MUST BE SET: * * * * DBCAREA-FUNC * * DBCAREA-I-SESS-ID * * DBCAREA-I-REQ-ID * * DBCAREA-FET-MAX-DATA-LEN * * DBCAREA-FET-DATA-PTR * * * * NOTES 1) FET-DATA-PTR REPRESENTS THE LOCATION OF THE WORKING * * STORAGE AREA TO RECEIVE THE RESPONSE PARCEL * * * * 2) FET-MAX-DATA-LEN IS THE LENGTH OF THE WORKING * * STORAGE AREA TO RECEIVE THE RESPONSE PARCEL. * * * *----------------------------------------------------------------* C000-FETCH-RESPONSE SECTION. MOVE FETCH-FUNC TO DBCAREA-FUNC. MOVE SPACES TO PARCEL. MOVE SESSION-NUM(SESS-INDX) TO DBCAREA-I-SESS-ID. MOVE REQUEST-NUM(SESS-INDX, REQT-INDX) TO DBCAREA-I-REQ-ID. MOVE REQUEST-NUM(SESS-INDX, REQT-INDX) TO DBCAREA-O-REQ-ID. CALL ’DBCHSAD’ USING CLI-RETURN-CD, DBCAREA-FET-DATA-PTR, PARCEL. IF CLI-RETURN-CD NOT = ZERO PERFORM Y000-ERROR GO TO C000-EXIT. MOVE +4096 TO DBCAREA-FET-MAX-DATA-LEN. CALL ’DBCHCL’ USING CLI-RETURN-CD, CONTEXT-PTR, DBCAREA. IF CLI-RETURN-CD NOT = ZERO PERFORM Y000-ERROR GO TO C000-EXIT. C000-EXIT. EXIT. *----------------------------------------------------------------* * * * END THE REQUEST TO PREMIT REUSE OF THE RESPONSE BUFFERS * * * * PRIOR TO CALLING THIS ROUTINE, THE FOLLOWING FIELDS MUST BE * * SET: * * * * DBCAREA-I-SESS-ID * * DBCAREA-I-REQ-ID * * * * NOTE: END REQUEST HAS NO EFFECT UPON ACTIVE TRANSACTIONS. * * IT WILL DISCARD ANY SPOOL SPACE RESERVED ON THE DBC * * FOR THIS RESPONSE. * * * *----------------------------------------------------------------* D000-END-REQUEST SECTION. MOVE END-REQUEST-FUNC TO DBCAREA-FUNC. MOVE SESSION-NUM(SESS-INDX) TO DBCAREA-I-SESS-ID. MOVE REQUEST-NUM(SESS-INDX, REQT-INDX) TO DBCAREA-I-REQ-ID. MOVE REQUEST-NUM(SESS-INDX, REQT-INDX) TO DBCAREA-O-REQ-ID. CALL ’DBCHCL’ USING CLI-RETURN-CD, CONTEXT-PTR, DBCAREA. IF CLI-RETURN-CD NOT = ZERO PERFORM Y000-ERROR GO TO D000-EXIT. PERFORM 0000-DISPLAY-80. D000-EXIT. EXIT. *---------------------------------------------------------------* * CLI RETURN CODE ERROR PROCESSING * *---------------------------------------------------------------* Y000-ERROR SECTION. MOVE ’YES’ TO PGM-FAILURE. MOVE DBCAREA-MSG-TEXT TO MSG. PERFORM 0000-DISPLAY-80 . Y000-EXIT. EXIT. *---------------------------------------------------------------* * PRINT A PARCEL * *---------------------------------------------------------------* Y300-PRINT-PARCEL SECTION. MOVE ’FLAVOR - ’ TO MSG-FLAVOR-A. MOVE DBCAREA-FET-PARCEL-FLAVOR TO MSG-FLAVOR-B IF DBCAREA-FET-PARCEL-FLAVOR = SUCCESS-TYPE MOVE ’SUCCESS PARCEL’ TO MSG-FLAVOR-C. IF DBCAREA-FET-PARCEL-FLAVOR = FAILURE-TYPE ADD 1 TO FAILURES GIVING FAILURES MOVE ’FAILURE’ TO MSG-FLAVOR-C. IF DBCAREA-FET-PARCEL-FLAVOR = ERROR-TYPE MOVE ’ERROR’ TO MSG-FLAVOR-C. IF DBCAREA-FET-PARCEL-FLAVOR = RECORD-TYPE MOVE ’RECORD FLAVOR’ TO MSG-FLAVOR-A MOVE EMPNO TO MSG-FLAVOR-B MOVE NAME TO MSG-FLAVOR-C IF DBCAREA-FET-PARCEL-FLAVOR = END-STATEMENT-TYPE MOVE ’END STATEMENT’ TO MSG-FLAVOR-C. IF DBCAREA-FET-PARCEL-FLAVOR = END-REQUEST-TYPE MOVE ’END REQUEST’ TO MSG-FLAVOR-C. MOVE MSG-FLAVOR TO MSG. PERFORM 0000-DISPLAY-80 . Y300-EXIT. EXIT. *---------------------------------------------------------------* * INITIALIZE DBCAREA * *---------------------------------------------------------------* Z000-INITIALIZE-DBCAREA SECTION. CALL ’DBCHINI’ USING CLI-RETURN-CD, CONTEXT-PTR, DBCAREA. IF CLI-RETURN-CD NOT = ZERO PERFORM Y000-ERROR GO TO Z000-EXIT. MOVE +512 TO DBCAREA-REQ-BUF-LEN. MOVE +32767 TO DBCAREA-RESP-BUF-LEN. MOVE +1 TO DBCAREA-MAX-NUM-SESS. MOVE ’Y’ TO DBCAREA-CHANGE-OPTS. MOVE ’R’ TO DBCAREA-RESP-MODE. MOVE ’N’ TO DBCAREA-USE-PRESENCE-BITS. MOVE ’N’ TO DBCAREA-KEEP-RESP. MOVE ’N’ TO DBCAREA-WAIT-ACROSS-CRASH. MOVE ’Y’ TO DBCAREA-TELL-ABOUT-CRASH. MOVE ’Y’ TO DBCAREA-GIVE-MSG. MOVE ’N’ TO DBCAREA-LOC-MODE. MOVE ’N’ TO DBCAREA-VAR-LEN-REQ. MOVE ’N’ TO DBCAREA-VAR-LEN-FETCH. MOVE ’Y’ TO DBCAREA-SAVE-RESP-BUF. MOVE ’Y’ TO DBCAREA-TWO-RESP-BUFS. MOVE ’N’ TO DBCAREA-RET-TIME. MOVE ’Y’ TO DBCAREA-PARCEL-MODE. MOVE ’Y’ TO DBCAREA-WAIT-FOR-RESP. MOVE ’E’ TO DBCAREA-REQ-PROC-OPT. MOVE ’N’ TO DBCAREA-MSG-SECURITY. Z000-EXIT. EXIT. *---------------------------------------------------------------* * * * CONNECT A SESSION * * * * THIS ROUTINE CREATES DBCAREA-0-SESS-ID AND MOVES THAT * * NUMBER TO DBCAREA-I-SESS-ID * * * * THIS IS AN EXAMPLE OF TWO PHASE CONNECT WITH WAIT FOR * * RESPONSE SET TO YES * * * *---------------------------------------------------------------* Z100-CONNECT-SESSION SECTION. MOVE CONNECT-FUNC TO DBCAREA-FUNC. MOVE ZERO TO DBCAREA-RUN-PTR DBCAREA-RUN-LEN. MOVE ’C’ TO DBCAREA-CONNECT-TYPE. MOVE ’Y’ TO DBCAREA-TWO-PHASE-COMMIT. CALL ’DBCHSAD’ USING CLI-RETURN-CD, DBCAREA-LOGON-PTR, LOGON-STRING. IF CLI-RETURN-CD NOT = ZERO PERFORM Y000-ERROR GO TO Z100-EXIT. MOVE +35 TO DBCAREA-LOGON-LEN. CALL ’DBCHCL’ USING CLI-RETURN-CD, CONTEXT-PTR, DBCAREA. IF CLI-RETURN-CD NOT = ZERO PERFORM Y000-ERROR GO TO Z100-EXIT. * A CONNECTION REQUEST GENERATES A SESSION ID AND A REQUEST ID. * * THIS IS DUE TO THE CONNECT (LOGON) BEGIN A REQUEST FOR DBC * * SERVICES. * * * * TO COMPLETE THE CONNECT REQUEST, A FETCH REQUEST MUST FOLLOW * * THE CONNECT REQUEST. * * * * THE FETCH WILL RETURN A SUCCESS PARCEL IF THE CONNECT IS * * COMPLETE. * * * MOVE FETCH-FUNC TO DBCAREA-FUNC. MOVE DBCAREA-O-SESS-ID TO DBCAREA-I-SESS-ID. MOVE DBCAREA-O-REQ-ID TO DBCAREA-I-REQ-ID. MOVE +4096 TO DBCAREA-FET-MAX-DATA-LEN. MOVE SPACES TO PARCEL. CALL ’DBCHSAD’ USING CLI-RETURN-CD, DBCAREA-FET-DATA-PTR, PARCEL. IF CLI-RETURN-CD NOT = ZERO MOVE ’YES’ TO PGM-FAILURE GO TO Z100-EXIT. CALL ’DBCHCL’ USING CLI-RETURN-CD, CONTEXT-PTR, DBCAREA. IF CLI-RETURN-CD = END-OF-BUFFER GO TO Z100-EXIT. IF CLI-RETURN-CD = 0 AND DBCAREA-FET-PARCEL-FLAVOR = SUCCESS-TYPE MOVE ’CONNECT SESS -’ TO MSG-FLAVOR-A MOVE DBCAREA-O-SESS-ID TO MSG-FLAVOR-B MOVE DBCAREA-O-SESS-ID TO SESSION-NUM( SESS-INDX ) MOVE MSG-FLAVOR TO MSG PERFORM 0000-DISPLAY-80 GO TO Z100-EXIT. MOVE ’CONNECT FAILED’ TO MSG-FLAVOR-A. MOVE ZERO TO MSG-FLAVOR-B. MOVE MSG-FLAVOR TO MSG. PERFORM 0000-DISPLAY-80. IF CLI-RETURN-CD = 0 MOVE ’YES’ TO PGM-FAILURE PERFORM Y300-PRINT-PARCEL GO TO Z100-EXIT. PERFORM Y000-ERROR. Z100-EXIT. EXIT. *---------------------------------------------------------------* * * * DISCONNECT A SESSION * * * * PRIOR TO CALLING THIS ROUTINE, DBCAREA-I-SESS-ID MUST BE * * ESTABLISHED. * * * * FOR 2PC APPLICATIONS, SYNCPOINT OR VOTE&TERMINATE WILL * * COMMIT UPDATES. WITHOUT SP/VT, CHANGES WILL ROLL. * * * * NOTE: THE DISCONNECT WILL CAUSE TRANSACTION FAILURE FOR ANY * * ACTIVE TRANSACTIONS AND/OR REQUESTS. ANY RESPONSES * * STILL ON THE DBC FOR THIS SESSION WILL BE DISCARDED. * * * *---------------------------------------------------------------* Z200-DISCONNECT-SESSION SECTION. IF FAILURES = 0 THEN PERFORM 0000-SYNCPOINT. IF FAILURES > 0 THEN PERFORM 0000-SYNCPOINT-ROLL. MOVE DISCONNECT-FUNC TO DBCAREA-FUNC. MOVE SESSION-NUM(SESS-INDX) TO DBCAREA-I-SESS-ID. CALL ’DBCHCL’ USING CLI-RETURN-CD, CONTEXT-PTR, DBCAREA. IF CLI-RETURN-CD NOT = ZERO PERFORM Y000-ERROR GO TO Z200-EXIT. Z200-EXIT. EXIT. *---------------------------------------------------------------* * * * RELEASE ACQUIRED STORAGE * * * * NOTE: TERMINATION WILL CAUSE TRANSACTION FAILURE FOR ANY * * ACTIVE TRANSACTIONS AND/OR REQUESTS FOR ANY OPEN * * SESSIONS. ALL RESPONSES HELD ON THE DBC BY THIS * * PROGRAM WILL BE DISCARDED. * * * *---------------------------------------------------------------* Z900-TERMINATE-DBCAREA SECTION. CALL ’DBCHCLN’ USING CLI-RETURN-CD, CONTEXT-PTR. IF CLI-RETURN-CD NOT = ZERO PERFORM Y000-ERROR GO TO Z900-EXIT. Z900-EXIT. EXIT.