Source code for the example program to refresh a replicated user-maintained data table

Figure 10. Example program to refresh a replicated UMT
      CBL XOPTS(SP)
      *****************************************************************
      *                                                               *
      * PROGRAM NAME : UMTUPDT COBOL                                  *
      *                                                               *
      * DESCRIPTIVE NAME : CICS application to dynamically update a   *
      *                 UMT with the current contents of a dataset.   *
      *                                                               *
      *---------------------------------------------------------------*
      *                                                               *
      * OVERVIEW                                                      *
      *                                                               *
      * This program demonstrates how to update a user maintained     *
      * table (UMT) to match the data in the source dataset it was    *
      * loaded from when opened, whilst it remains in use by one      *
      * (or more) CICS systems.  It can be used to update a UMT that  *
      * is replicated in different sysplexes so that they all match   *
      * the source dataset.  It should be run on the FOR.             *
      *                                                               *
      *---------------------------------------------------------------*
      *                                                               *
      * REQUIREMENTS                                                  *
      *                                                               *
      * This program should be translated, compiled and linked as a   *
      * CICS COBOL program, and defined to CICS.  A transaction name  *
      * should be defined to this program.  A UMT file, currently     *
      * called UMTNAME, is used to access the UMT, and a source       *
      * dataset file, currently called SOURCEDS, is used to directly  *
      * access the dataset the UMT is loaded from.  These definitions *
      * must be installed only in the region in which the UMT resides *
      * (the FOR).  Any regions in the same sysplex that use the UMT  *
      * remotely do not need to run any update process.               *
      *                                                               *
      *---------------------------------------------------------------*
      *                                                               *
      * DESCRIPTION                                                   *
      *                                                               *
      * The program will first initialize the two files that are      *
      * needed, and start browsing them from the beginning.           *
      * Opening the UMT will cause it to be loaded if it isn't open.  *
      * If it is not open and the UMT is loaded, the operation of the *
      * program is effectively redundant and the update code will     *
      * not be run.  The program will also check for a remote system  *
      * name.  If one is present for either file, then the program    *
      * will not run.  This is to prevent function shipping occurring *
      * which would obviously degrade performance.                    *
      *                                                               *
      * The program will continuously read a pair of records from the *
      * two files and compare them, adding, deleting or updating any  *
      * records in the UMT that don't match the source dataset.       *
      *                                                               *
      * The keys of the pair of records are compared.  If the key to  *
      * the UMT and the key to the source dataset are equal, and the  *
      * records match, then no update is required.  If both keys are  *
      * equal, but the records are different, then the record in the  *
      * source dataset is used to update the UMT.  If the key in the  *
      * UMT is greater than the key in the source dataset, then the   *
      * record(s) in the source dataset are written to the UMT until  *
      * the keys become equal or the UMT key becomes less than the    *
      * source dataset key.  If the UMT key is less than the source   *
      * dataset key, then the record(s) in the UMT are removed until  *
      * the keys become equal, or the UMT key is greater than the     *
      * source dataset.  This continues until the end of both files   *
      * is reached, or an unexpected error occurs.                    *
      *                                                               *
      * Any errors that are unexpected are reported to the screen,    *
      * and operation of the program stops.  Some errors are trapped, *
      * and a further attempt will be made to update the UMT.  If     *
      * this attempt fails, no further action is taken for those      *
      * records, and the program will continue to process the next    *
      * pair.                                                         *
      *                                                               *
      *---------------------------------------------------------------*
      *                                                               *
      * MODIFYING THE PROGRAM                                         *
      *                                                               *
      * This program may not work as is.  The record structure it     *
      * uses assumes that a 4 character key is used to access a 40    *
      * character record.  The following changes will need to be made *
      * to allow this program to work with different record types.    *
      *                                                               *
      * The key that accesses the UMT and source dataset should be    *
      * changed.  The variables that store the key are UMT-KEY and    *
      * DS-KEY.                                                       *
      *                                                               *
      * The length of the records are held in UMT-LEN and DS-LEN.     *
      *                                                               *
      * The UMT and source dataset record variables should be changed.*
      * The variables that store these are UMT-REC (which contains    *
      * UMT-REC-KEY and UMT-REC-TEXT), and DS-REC (which contains     *
      * DS-REC-KEY and DS-REC-TEXT).  Additional fields can obviously *
      * be added as needed.                                           *
      *                                                               *
      * The filename of the UMT is set as UMTNAME.  This can be       *
      * changed to match any UMT already defined.  The source dataset *
      * file is set as SOURCEDS, and can also be changed.             *
      *                                                               *
      *****************************************************************
       IDENTIFICATION DIVISION.
       PROGRAM-ID. UMTUPDT.
 
       ENVIRONMENT DIVISION.
           EJECT.
 
       DATA DIVISION.
 
       WORKING-STORAGE SECTION.
 
      * Declare the UMT and DS record variables
       77 UMT-KEY          PIC X(4)  VALUE '0000'.
       77 UMT-LEN          PIC 9(2)  VALUE 40.
       01  UMT-REC.
         03  UMT-REC-KEY   PIC X(4)  VALUE SPACES.
         03  UMT-REC-TEXT  PIC X(36) VALUE SPACES.
 
       77 DS-KEY           PIC X(4)  VALUE '0000'.
       77 DS-LEN           PIC 9(2)  VALUE 40.
       01  DS-REC.
         03  DS-REC-KEY    PIC X(4)  VALUE SPACES.
         03  DS-REC-TEXT   PIC X(36) VALUE SPACES.
 
      * Declare other work variables
      * Screen output strings
       01  MESSAGE-OUTPUT  PIC X(26) VALUE 'UMT SUCCESSFULLY REFRESHED'.
       01  REMOTE-OUTPUT   PIC X(25) VALUE 'FILE RESOURCE NOT LOCAL'.
       01  ERROR-OUTPUT.
         03  ERROR-OPNAME  PIC X(8)  VALUE SPACES.
         03  FILLER        PIC X(15) VALUE ' RETURNED RESP '.
         03  ERROR-RESP    PIC X(8)  VALUE SPACES.
         03  FILLER        PIC X(7)  VALUE ' RESP2 '.
         03  ERROR-RESP2   PIC X(8)  VALUE SPACES.
         03  FILLER        PIC X(10) VALUE ' FOR FILE '.
         03  ERROR-FILE    PIC X(8)  VALUE SPACES.
 
      * End of file flags
       77  UMT-EOF         PIC 9(1)  VALUE 0.
       77  DS-EOF          PIC 9(1)  VALUE 0.
 
      * Record retrieval flags
       77  GET-NEXT-UMT    PIC 9(1)  VALUE 1.
       77  GET-NEXT-DS     PIC 9(1)  VALUE 1.
 
      * File inquire variables
       77  REM-SYS-NAME    PIC X(4)  VALUE SPACES.
       77  OPEN-STAT       PIC S9(8) BINARY.
 
      * Program operation flags
       77  PROCESS-FILES   PIC 9(1)  VALUE 1.
       77  REM-FILE        PIC 9(1)  VALUE 0.
       77  UMT-STARTBR     PIC 9(1)  VALUE 0.
       77  DS-STARTBR      PIC 9(1)  VALUE 0.
      * EXEC CICS response variables
       77  RESPONSE        PIC S9(8) BINARY.
       77  RESPONSE2       PIC S9(8) BINARY.
 
 
       COPY DFHAID.
       COPY DFHBMSCA.
 
 
       LINKAGE SECTION.
           EJECT.
 
       PROCEDURE DIVISION USING DFHEIBLK.
 
      *****************************************************************
      * Main processing starts here.                                  *
      *****************************************************************
       MAIN-PROCESSING SECTION.
 
      * Check the UMT and dataset for processing
           PERFORM FILE-CHECK.
 
      * If the file check completed okay, process the UMT
           IF (PROCESS-FILES = 1)
 
      * Ready the UMT and DS for access
              PERFORM INITIALIZE
 
      * Call the update routine until the end of both files reached
              PERFORM UPDATE-UMT UNTIL (DS-EOF = 1 AND UMT-EOF = 1)
 
           END-IF.
 
      * Exit the program cleanly
           PERFORM TRAN-FINISH.
 
       MAIN-PROCESSING-EXIT.
           GOBACK.
           EJECT
 
 
      *****************************************************************
      * Procedures start here.                                        *
      *****************************************************************
 
      *****************************************************************
      * Check the files open status and that they aren't remote       *
      *****************************************************************
       FILE-CHECK SECTION.
 
      * Inquire on the UMT to get remote and open status information
           MOVE SPACES TO REM-SYS-NAME.
           EXEC CICS INQUIRE FILE('UMTNAME')
                OPENSTATUS(OPEN-STAT)
                REMOTESYSTEM(REM-SYS-NAME)
                RESP(RESPONSE)
                RESP2(RESPONSE2)
           END-EXEC.
      * Output an error if inquire on the UMT failed
           IF (RESPONSE NOT = DFHRESP(NORMAL))
              MOVE 'INQUIRE ' TO ERROR-OPNAME
              MOVE 'UMTNAME ' TO ERROR-FILE
              PERFORM PROCESS-ERROR
           END-IF.
      * System name is not blank if the file is defined as remote
      * We don't want to do any processing if the file is remote
           IF (REM-SYS-NAME NOT = SPACES)
              MOVE 0 TO PROCESS-FILES
              MOVE 1 TO REM-FILE
           ELSE
      * If the UMT is not open, then opening it will update it
              IF (OPEN-STAT NOT = DFHVALUE(OPEN))
                 EXEC CICS SET FILE('UMTNAME')
                      OPEN
                      RESP(RESPONSE)
                      RESP2(RESPONSE2)
                 END-EXEC
      * Check open of UMT was successful
                 IF (RESPONSE NOT = DFHRESP(NORMAL))
                    MOVE 'OPEN    ' TO ERROR-OPNAME
                    MOVE 'UMTNAME ' TO ERROR-FILE
                    PERFORM PROCESS-ERROR
                 ELSE
      * Don't want to do any processing, as open will update UMT
                    MOVE 0 TO PROCESS-FILES
                 END-IF
              END-IF
           END-IF.
 
      * Inquire on the source dataset to get remote and open status
           MOVE SPACES TO REM-SYS-NAME.
           EXEC CICS INQUIRE FILE('SOURCEDS')
                REMOTESYSTEM(REM-SYS-NAME)
                OPENSTATUS(OPEN-STAT)
                RESP(RESPONSE)
                RESP2(RESPONSE2)
           END-EXEC.
      * Output an error if inquire on the dataset failed
           IF (RESPONSE NOT = DFHRESP(NORMAL))
              MOVE 'INQUIRE ' TO ERROR-OPNAME
              MOVE 'SOURCEDS' TO ERROR-FILE
              PERFORM PROCESS-ERROR
           END-IF.
      * Don't do any processing if it's a remote file
           IF (REM-SYS-NAME NOT = SPACES)
              MOVE 0 TO PROCESS-FILES
              MOVE 1 TO REM-FILE
           ELSE
      * Open the source dataset
              IF (OPEN-STAT = DFHVALUE(CLOSED))
                 EXEC CICS SET FILE('SOURCEDS')
                      OPEN
                      RESP(RESPONSE)
                      RESP2(RESPONSE2)
                 END-EXEC
      * Check open of dataset was successful
                 IF (RESPONSE NOT = DFHRESP(NORMAL))
                    MOVE 'OPEN    ' TO ERROR-OPNAME
                    MOVE 'SOURCEDS' TO ERROR-FILE
                    PERFORM PROCESS-ERROR
                 END-IF
              END-IF
           END-IF.
 
       FILE-CHECK-EXIT.
           EXIT.
           EJECT
 
 
 
      *****************************************************************
      * Initialize the files ready for sequential reading             *
      *****************************************************************
       INITIALIZE SECTION.
 
      * Start browsing the UMT from the first record
           EXEC CICS STARTBR FILE('UMTNAME')
                RIDFLD(UMT-KEY)
                GTEQ
                RESP(RESPONSE)
                RESP2(RESPONSE2)
           END-EXEC.
      * If UMT is empty (NOTFND) then treat as end of UMT and fill
           IF (RESPONSE = DFHRESP(NOTFND))
              MOVE 1 TO UMT-EOF
           ELSE
      * Output an error if the start browse for the UMT failed
              IF (RESPONSE NOT = DFHRESP(NORMAL))
                 MOVE 'STARTBR ' TO ERROR-OPNAME
                 MOVE 'UMTNAME ' TO ERROR-FILE
                 PERFORM PROCESS-ERROR
              END-IF
           END-IF.
      * Set UMT start browse flag
           MOVE 1 TO UMT-STARTBR.
 
      * Start browsing the dataset from the first record
           EXEC CICS STARTBR FILE('SOURCEDS')
                RIDFLD(DS-KEY)
                GTEQ
                RESP(RESPONSE)
                RESP2(RESPONSE2)
           END-EXEC.
      * If dataset is empty then treat as end of dataset an empty UMT
           IF (RESPONSE = DFHRESP(NOTFND))
              MOVE 1 TO DS-EOF
           ELSE
      * Output an error if the start browse for the dataset failed
              IF (RESPONSE NOT = DFHRESP(NORMAL))
                 MOVE 'STARTBR ' TO ERROR-OPNAME
                 MOVE 'SOURCEDS' TO ERROR-FILE
                 PERFORM PROCESS-ERROR
              END-IF
           END-IF.
      * Set dataset start browse flag
           MOVE 1 TO DS-STARTBR.
 
       INITIALIZE-EXIT.
           EXIT.
           EJECT
 
 
 
      *****************************************************************
      * Update the UMT according to the record/key states             *
      *****************************************************************
       UPDATE-UMT SECTION.
 
      * Get the next records from the UMT and dataset
           PERFORM READ-FILES.
 
      * If both records are the same, move to the next record
           IF UMT-REC = DS-REC
              MOVE 1 TO GET-NEXT-UMT
              MOVE 1 TO GET-NEXT-DS
           ELSE
 
      * If UMT is behind dataset then extra record in UMT so delete it.
      * Also delete records from UMT if EOF DS reached before EOF UMT
              IF (UMT-EOF = 0 AND (UMT-KEY < DS-KEY OR DS-EOF = 1))
                 PERFORM UMT-DELETE
              END-IF
 
      * If UMT ahead of dataset then extra record in DS so add to UMT
      * Also add records to the UMT if the EOF reached before EOF DS
              IF (DS-EOF = 0 AND (UMT-KEY > DS-KEY OR UMT-EOF = 1))
                 PERFORM UMT-WRITE
              END-IF
 
      * If both keys equal but record different, update UMT
              IF ((DS-EOF = 0 AND UMT-EOF = 0) AND UMT-KEY = DS-KEY)
                 PERFORM UMT-UPDATE
              END-IF
 
           END-IF.
 
 
       UPDATE-UMT-EXIT.
           EXIT.
           EJECT
 
 
      *****************************************************************
      * Read the next record from both files                          *
      *****************************************************************
       READ-FILES SECTION.
 
      * If the flags are set to read the next UMT record, do so
           IF (GET-NEXT-UMT = 1 AND UMT-EOF = 0)
              MOVE SPACES TO UMT-REC
              EXEC CICS READNEXT FILE('UMTNAME')
                   RIDFLD(UMT-KEY)
                   INTO(UMT-REC)
                   RESP(RESPONSE)
                   RESP2(RESPONSE2)
              END-EXEC
      * Set the EOF flag if the end of the UMT has been reached
              IF (RESPONSE = DFHRESP(ENDFILE))
                    MOVE 1 TO UMT-EOF
              ELSE
      * Output an error if the return code from the READ is unexpected
                 IF (RESPONSE NOT = DFHRESP(DUPKEY) AND
                    RESPONSE NOT = DFHRESP(NORMAL))
                       MOVE 'READNEXT' TO ERROR-OPNAME
                       MOVE 'UMTNAME ' TO ERROR-FILE
                       PERFORM PROCESS-ERROR
                 END-IF
              END-IF
           END-IF.
 
      * If the flags are set to read the next dataset record, do so
           IF (GET-NEXT-DS = 1 AND DS-EOF = 0)
              MOVE SPACES TO DS-REC
              EXEC CICS READNEXT FILE('SOURCEDS')
                   RIDFLD(DS-KEY)
                   INTO(DS-REC)
                   RESP(RESPONSE)
                   RESP2(RESPONSE2)
              END-EXEC
      * Set the EOF flag if the end of the dataset has been reached
              IF (RESPONSE = DFHRESP(ENDFILE))
                    MOVE 1 TO DS-EOF
              ELSE
      * Output an error if the return code from the READ is unexpected
                 IF (RESPONSE NOT = DFHRESP(DUPKEY) AND
                    RESPONSE NOT = DFHRESP(NORMAL))
                       MOVE 'READNEXT' TO ERROR-OPNAME
                       MOVE 'SOURCEDS' TO ERROR-FILE
                       PERFORM PROCESS-ERROR
                 END-IF
              END-IF
           END-IF.
 
       READ-FILES-EXIT.
           EXIT.
           EJECT
 
      *****************************************************************
      * Attempt to delete a record from the UMT                       *
      *****************************************************************
       UMT-DELETE SECTION.
 
      * Delete the last read record in the UMT
           EXEC CICS DELETE FILE('UMTNAME')
                RIDFLD(UMT-KEY)
                RESP(RESPONSE)
                RESP2(RESPONSE2)
           END-EXEC.
      * Allow NORMAL and NOTFND return codes in case record has been
      * deleted since it was first read, otherwise output an error
           IF (RESPONSE = DFHRESP(NORMAL) OR
             RESPONSE = DFHRESP(NOTFND))
      * Set flags to get next UMT record, but keep same dataset record
              MOVE 1 TO GET-NEXT-UMT
              MOVE 0 TO GET-NEXT-DS
           ELSE
              MOVE 'DELETE  ' TO ERROR-OPNAME
              MOVE 'UMTNAME ' TO ERROR-FILE
              PERFORM PROCESS-ERROR
           END-IF.
 
       UMT-DELETE-EXIT.
           EXIT.
           EJECT
      *****************************************************************
      * Attempt to write a record to the UMT                          *
      *****************************************************************
       UMT-WRITE SECTION.
 
      * Attempt to write the missing record using the dataset key
           EXEC CICS WRITE FILE('UMTNAME')
                RIDFLD(DS-KEY)
                FROM(DS-REC)
                RESP(RESPONSE)
                RESP2(RESPONSE2)
           END-EXEC.
      * If the UMT has had a record written to this position since the
      * read then delete it and try one last time.
      * If write still unsuccessful, move to the next pair of records
           IF RESPONSE = DFHRESP(DUPREC)
              EXEC CICS DELETE FILE('UMTNAME')
                   RIDFLD(DS-KEY)
                   RESP(RESPONSE)
                   RESP2(RESPONSE2)
              END-EXEC
              EXEC CICS WRITE FILE('UMTNAME')
                   RIDFLD(DS-KEY)
                   FROM(DS-REC)
                   RESP(RESPONSE)
                   RESP2(RESPONSE2)
              END-EXEC
           ELSE
      * Output an error if return code from first write was bad
      * (but allow suppression return code by user exit)
              IF (RESPONSE NOT = DFHRESP(NORMAL) AND
                 RESPONSE NOT = DFHRESP(SUPPRESSED))
                    MOVE 'UMTNAME ' TO ERROR-FILE
                    MOVE 'WRITE   ' TO ERROR-OPNAME
                    PERFORM PROCESS-ERROR
              END-IF
           END-IF.
 
      * Set flags to keep same UMT record, and get next dataset record
           MOVE 0 TO GET-NEXT-UMT.
           MOVE 1 TO GET-NEXT-DS.
 
       UMT-WRITE-EXIT.
           EXIT.
           EJECT
 
 
      *****************************************************************
      * Attempt to update a record in the UMT to match the DS         *
      *****************************************************************
       UMT-UPDATE SECTION.
 
      * Attempt to get a lock on the record using read for update
           EXEC CICS READ FILE('UMTNAME')
                RIDFLD(UMT-KEY)
                INTO(UMT-REC)
                UPDATE
                RESP(RESPONSE)
                RESP2(RESPONSE2)
           END-EXEC.
      * If record has been deleted since original read, write it.
      * If write is unsuccessful, move to next pair of records
           IF RESPONSE = DFHRESP(NOTFND)
              EXEC CICS WRITE FILE('UMTNAME')
                   RIDFLD(UMT-KEY)
                   FROM(DS-REC)
                   RESP(RESPONSE)
                   RESP2(RESPONSE2)
              END-EXEC
           ELSE
      * If read for update was successful, write dataset record to UMT
              IF RESPONSE = DFHRESP(NORMAL)
                 EXEC CICS REWRITE FILE('UMTNAME')
                      FROM(DS-REC)
                      RESP(RESPONSE)
                      RESP2(RESPONSE2)
                 END-EXEC
      * Output an error if rewrite failed
                 IF RESPONSE NOT = DFHRESP(NORMAL)
                    MOVE 'REWRITE ' TO ERROR-OPNAME
                    MOVE 'UMTNAME ' TO ERROR-FILE
                    PERFORM PROCESS-ERROR
                 END-IF
              ELSE
      * Output an error if the read for update failed
                 MOVE 'READUPDT' TO ERROR-OPNAME
                 MOVE 'UMTNAME ' TO ERROR-FILE
                 PERFORM PROCESS-ERROR
              END-IF
           END-IF.
 
      * Set flags to get next record for both UMT and dataset
           MOVE 1 TO GET-NEXT-UMT.
           MOVE 1 TO GET-NEXT-DS.
 
       UMT-UPDATE-EXIT.
           EXIT.
           EJECT
 
 
      *****************************************************************
      * Exit from the program cleanly                                 *
      *****************************************************************
       TRAN-FINISH SECTION.
 
      * End the browse operation for the UMT
           IF (UMT-STARTBR = 1)
              EXEC CICS ENDBR FILE('UMTNAME')
                   RESP(RESPONSE)
                   RESP2(RESPONSE2)
              END-EXEC
           END-IF.
 
      * End the browse operation for the dataset
           IF (DS-STARTBR = 1)
              EXEC CICS ENDBR FILE('SOURCEDS')
                   RESP(RESPONSE)
                   RESP2(RESPONSE2)
              END-EXEC
           END-IF
 
      * Output a message to the screen if UMT was updated
           IF (REM-FILE = 0)
              EXEC CICS SEND TEXT
                   FROM(MESSAGE-OUTPUT)
                   ERASE
                   RESP(RESPONSE)
                   RESP2(RESPONSE2)
              END-EXEC
           ELSE
      * Output a message if either file was defined as remote
              EXEC CICS SEND TEXT
                   FROM(REMOTE-OUTPUT)
                   ERASE
                   RESP(RESPONSE)
                   RESP2(RESPONSE2)
              END-EXEC
           END-IF.
 
 
      * End the program and return to CICS
           EXEC CICS RETURN
           END-EXEC.
 
       TRAN-FINISH-EXIT.
           EXIT.
           EJECT
 
      *****************************************************************
      * Display error message on screen and exit program              *
      *****************************************************************
       PROCESS-ERROR SECTION.
 
      * Copy last return codes into the message
           MOVE RESPONSE TO ERROR-RESP.
           MOVE RESPONSE2 TO ERROR-RESP2.
 
      * Output message to the screen
           EXEC CICS SEND TEXT
                FROM(ERROR-OUTPUT)
                ERASE
                RESP(RESPONSE)
                RESP2(RESPONSE2)
           END-EXEC.
 
      * End the program and return to CICS
           EXEC CICS RETURN
           END-EXEC.
 
       PROCESS-ERROR-EXIT.
           EXIT.

Related concepts
Using shared data tables support in a sysplex
Overview of shared data tables support in a sysplex
How to refresh replicated user-maintained data tables
Example program for refreshing a user-maintained data table
[[ Contents Previous Page | Next Page Index ]]