Coordinating Db2 and MQ Updates Using RRS in a COBOL Batch Program

When a batch COBOL program performs INSERT, UPDATE, or DELETE operations on a Db2 table and also executes MQPUT operations to an IBM MQ queue, the commit/rollback processing becomes more complex.

In such a scenario, issuing a Db2 COMMIT commits only the Db2 changes; it does not commit the MQ messages. Similarly, issuing MQCMIT commits only the MQ operations and has no effect on pending Db2 updates. Each resource manager commits its own work independently but does not coordinate with other resource managers.

This is where Resource Recovery Services (RRS) becomes essential.

RRS acts as a central transaction coordinator for resource managers such as Db2 and IBM MQ. When an application requests a commit or rollback, RRS coordinates all participating resource managers using the standard two-phase commit protocol, ensuring that updates across all resources are committed or rolled back as a single unit of work.

The following sample COBOL program updates both Db2 and MQ resources and uses the RRS services to commit the changes atomically.

Unlike a traditional batch Db2 COBOL program, an application that uses RRS must explicitly establish and terminate the Db2 connection and thread within the program itself.

When we compile the program, we need to add "ATTACH(RRSAF)" option in the DB2 precompiler step. This instructs Db2 to use the RRS Attachment Facility (RRSAF) for transaction coordination.

After doing all the DB2, MQ updates, COBOL program need to invoke RSS API "SRRCMIT" to initiate the two phase COMMIT process.     

The following stub modules must be link-edited to the COBOL module:

CSQBRSTB - available in MQ SCSQLOAD library
ATRSCSS  - available in SYS1.CSSLIB library
DSNRLI   - available in Db2 SDSNLOAD library

Since the COBOL program explicitly manages the Db2 connection through RRSAF, it can be executed like a regular Batch COBOL program.

Below is the sample run JCL.

//STEP01 EXEC PGM=DB2MQPGM,                              
//STEPLIB  DD DSN=xxxx.DB2.SDSNEXIT,DISP=SHR          
//         DD DSN=xxxx.DB2.SDSNLOAD,DISP=SHR          
//         DD DSN=xxxx.MQ.SCSQANLE,DISP=SHR            
//         DD DSN=xxxx.MQ.SCSQAUTH,DISP=SHR            
//         DD DSN=USER.LOADLIB,DISP=SHR                  
//*                                                      
//SYSOUT   DD SYSOUT=*                                    

Below is the sample COBOL program that invoke RRS services to commit the changes in both DB2 and MQ.

       IDENTIFICATION DIVISION.
       PROGRAM-ID.    DB2MQPGM.
       DATA DIVISION.
       WORKING-STORAGE SECTION.

       01 RRSAF-FIELDS.
      * DB2 subsystem name for IDENTIFY
           05 SSNM          PIC X(04).
      * Correlation ID for SIGNON
           05 CORRID        PIC X(12).
      * Accounting token for SIGNON
           05 ACCTTKN       PIC X(22).
      * Accounting interval for SIGNON
           05 ACCTINT       PIC X(06).
      * DB2 plan name for CREATE THREAD
           05 PLAN          PIC X(08).
      * Collection ID for CREATE THREAD.
      * IF PLAN contains a plan name, not used.
           05 COLLID        PIC X(18).
      * Controls SIGNON after CREATE THREAD
           05 REUSE         PIC X(08).
      *  Action that application takes based
      *  on return code from RRSAF
           05 CONTROL1      PIC X(08).
      ****************** VARIABLES SET BY DB2 *******************************
      *  DB2 startup ECB
           05 STARTECB      PIC X(04).
      *  DB2 termination ECB
           05 TERMECB       PIC X(04).
      *  Address of environment info block
           05 EIBPTR        PIC X(04).
      *  Address of release info block
           05 RIBPTR        PIC X(04).
      ****************************** CONSTANTS ******************************
      * CONTROL value: Everything OK
           05 CONTINUE1     PIC X(08) VALUE 'CONTINUE'.
      * Name of RRSAF servicS
           05 IDFYFN        PIC X(18) VALUE 'IDENTIFY'.
           05 SGNONFN       PIC X(18) VALUE 'SIGNON'.
           05 CRTHRDFN      PIC X(18) VALUE 'CREATE THREAD'.
           05 TRMTHDFN      PIC X(18) VALUE 'TERMINATE THREAD'.
           05 TMIDFYFN      PIC X(18) VALUE 'TERMINATE IDENTIFY'.
           05 XLATFN        PIC X(18) VALUE 'TRANSLATE'.
           05 RETCODE       PIC X(04).
           05 REASCODE      PIC X(04).

       01  WS-WORK-AREAS.
           05  WS-ERROR-CODE            PIC S9(04)  VALUE ZEROS COMP.
           05  PROCESS-REC-COUNT        PIC S9(4) COMP.

       01 WS-SQLCODE                      PIC ----9.
           EXEC SQL
             INCLUDE SQLCA
           END-EXEC.

        01 OUT-MSG-LEN              PIC S9(9) COMP.

        01 MQ-Q-NAME              PIC X(48)      VALUE SPACES.
        01 MQ-HOBJ                PIC S9(9) COMP VALUE 0.
        01 MQ-OPEN-OPTS           PIC S9(9) COMP VALUE 0.
        01 MQ-CLOSE-OPTS          PIC S9(9) COMP VALUE 0.

        01 MQ-CONSTANTS.
            COPY CMQV.
        01 MQ-OBJ-DESC.
            COPY CMQODV.
        01 MQ-MSG-DESC.
            COPY CMQMDV.
        01 MQ-PUT-MSG-OPTS.
            COPY CMQPMOV.
        01 MQ-GET-MSG-OPTS.
            COPY CMQGMOV.

      * -------------------------------------------------------
      * Queue manager connection name and handle...
      * -------------------------------------------------------
        01 MQ-QM-NAME               PIC X(48)      VALUE SPACES.
        01 MQ-HCONN                 PIC S9(9) COMP-5.
        01 MQ-PROC                  PIC X(08).

      * -------------------------------------------------------
      * Queue manager op return codes and like things...
      * -------------------------------------------------------
        01 MQ-RETURN-STUFF.
            10 MQ-RC                PIC S9(9) COMP VALUE 0.
            10 MQ-RC-N9             PIC 9(9)       VALUE 0.
            10 MQ-RSN               PIC S9(9) COMP VALUE 0.
            10 MQ-RSN-N9            PIC 9(9)       VALUE 0.
            10 MQ-MSG               PIC X(256)     VALUE SPACES.

       PROCEDURE DIVISION.
       0000-MAINLINE.

           PERFORM 1000-INITIALIZATION
              THRU 1000-INITIALIZATION-EXIT.

           PERFORM 2000-PROCESS
              THRU 2000-EXIT
             VARYING PROCESS-REC-COUNT FROM 1 BY 1
             UNTIL PROCESS-REC-COUNT > 100

           PERFORM 3000-TERMINATION
              THRU 3000-TERMINATION-EXIT.

       0000-MAINLINE-EXIT.
           GOBACK.

       1000-INITIALIZATION.

           MOVE 'XXXX'     TO MQ-QM-NAME.
           MOVE 'TEST.MQ'  TO MQ-Q-NAME.

           CALL 'MQCONN' USING
                MQ-QM-NAME
                MQ-HCONN
                MQ-RC
                MQ-RSN

           IF MQ-RC = MQCC-FAILED
              MOVE 'MQCONN'    TO MQ-PROC
              GO TO 999-ERROR
           END-IF.

           MOVE MQOO-OUTPUT            TO MQ-OPEN-OPTS
           ADD  MQOO-FAIL-IF-QUIESCING TO MQ-OPEN-OPTS
           MOVE MQOT-Q    TO MQOD-OBJECTTYPE
           MOVE MQ-Q-NAME TO MQOD-OBJECTNAME

           CALL 'MQOPEN' USING
               MQ-HCONN
               MQ-OBJ-DESC
               MQ-OPEN-OPTS
               MQ-HOBJ
               MQ-RC
               MQ-RSN

           IF MQ-RC = MQCC-FAILED
              MOVE 'MQOPEN'    TO MQ-PROC
              GO TO 999-ERROR
           END-IF.

      ****************************** IDENTIFY **********************
           MOVE 'DB2A' TO SSNM
           CALL  'DSNRLI' USING
                  IDFYFN SSNM RIBPTR EIBPTR TERMECB STARTECB
                  RETCODE REASCODE
           IF RETCODE NOT = LOW-VALUES
              DISPLAY IDFYFN RETCODE REASCODE
              CALL  'DSNRLI' USING XLATFN SQLCA RETCODE REASCODE
              MOVE SQLCODE   TO WS-SQLCODE
              DISPLAY ' IDENTIFY ' WS-SQLCODE SQLERRM
           END-IF
      ***************************** SIGNON *************************
           CALL  'DSNRLI' USING
                  SGNONFN CORRID ACCTTKN ACCTINT
                  RETCODE REASCODE
           IF RETCODE NOT = LOW-VALUES
              DISPLAY SGNONFN RETCODE REASCODE
              CALL  'DSNRLI' USING XLATFN SQLCA RETCODE REASCODE
              MOVE SQLCODE   TO WS-SQLCODE
              DISPLAY 'SIGNON    ' WS-SQLCODE SQLERRM
           END-IF
      *************************** CREATE THREAD ********************
           MOVE 'TESTPLAN' TO PLAN
           CALL  'DSNRLI' USING
                  CRTHRDFN PLAN COLLID REUSE
                  RETCODE REASCODE.
           IF RETCODE NOT = LOW-VALUES
              DISPLAY CRTHRDFN RETCODE REASCODE
              CALL  'DSNRLI' USING XLATFN SQLCA RETCODE REASCODE
              MOVE SQLCODE   TO WS-SQLCODE
              DISPLAY 'CRE THRD  ' WS-SQLCODE SQLERRM
           END-IF.

       1000-INITIALIZATION-EXIT.
           EXIT.

       2000-PROCESS.

           EXEC SQL
               INSERT INTO TEST_TABLE
               ..............
               ..............  
           END-EXEC
 
           IF SQLCODE NOT = ZERO
              MOVE SQLCODE   TO WS-SQLCODE
              DISPLAY ' INSERT FAILED ' WS-SQLCODE
              PERFORM 9000-ABEND THRU 9000-ABEND-EXIT
           END-IF.

           COMPUTE MQPMO-OPTIONS
                 = MQPMO-FAIL-IF-QUIESCING
                 + MQPMO-SYNCPOINT

           MOVE LENGTH OF DATA-TO-BE-INSERTED
              TO OUT-MSG-LEN

           CALL 'MQPUT' USING
                MQ-HCONN
                MQ-HOBJ
                MQ-MSG-DESC
                MQ-PUT-MSG-OPTS
                OUT-MSG-LEN
                DATA-TO-BE-INSERTED
                MQ-RC
                MQ-RSN

           IF MQ-RC = MQCC-FAILED
              MOVE 'MQPUT'     TO MQ-PROC
              GO TO 999-ERROR
           END-IF.

       2000-EXIT.
           EXIT.

       3000-TERMINATION.

           CALL 'SRRCMIT' USING RETCODE
           DISPLAY 'SRRCMIT : ' RETCODE
      *    call 'SRRBACK' USING RETCODE
      *    DISPLAY 'SRRBACK : ' RETCODE

           CALL 'MQCLOSE' USING
               MQ-HCONN
               MQ-HOBJ
               MQ-CLOSE-OPTS
               MQ-RC
               MQ-RSN.

           IF MQ-RC = MQCC-FAILED
              DISPLAY 'MQCLOSE'
              DISPLAY 'MQ-RC: ' MQ-RC
           END-IF.

            CALL 'MQDISC' USING
                 MQ-HCONN
                 MQ-RC
                 MQ-RSN.

           IF MQ-RC = MQCC-FAILED
              DISPLAY 'MQDISC'
              DISPLAY 'MQ-RC: ' MQ-RC
           END-IF.

      ************************ TERMINATE THREAD ***********************
            CALL  'DSNRLI' USING TRMTHDFN
                   RETCODE REASCODE
            IF RETCODE NOT = LOW-VALUES
               DISPLAY TRMTHDFN RETCODE REASCODE
               CALL  'DSNRLI' USING XLATFN SQLCA RETCODE REASCODE
               MOVE SQLCODE   TO WS-SQLCODE
               DISPLAY 'TRM THRD  ' WS-SQLCODE SQLERRM
            END-IF.
      ************************ TERMINATE IDENTIFY *********************
            CALL  'DSNRLI' USING TMIDFYFN
                   RETCODE REASCODE.
            IF RETCODE NOT = LOW-VALUES
               DISPLAY TMIDFYFN RETCODE REASCODE
               CALL  'DSNRLI' USING XLATFN SQLCA RETCODE REASCODE
               MOVE SQLCODE   TO WS-SQLCODE
               DISPLAY 'TRM IDNTY ' WS-SQLCODE SQLERRM
            END-IF.

       3000-TERMINATION-EXIT.
           EXIT.


       9000-ABEND.

           CALL 'ILBOABN0' USING WS-ERROR-CODE.

       9000-ABEND-EXIT.
           EXIT.

       999-ERROR.
           MOVE MQ-RSN    TO MQ-RSN-N9
           DISPLAY 'MQ-PROC: ' MQ-PROC
           DISPLAY 'MQ-RSN : ' MQ-RSN-N9
           GOBACK.