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.