Source code for the example program to refresh a replicated user-maintained data table
This source code is not provided in the CICS samples library, only in this documentation.
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 data set
- Overview
- This program demonstrates how to update a user maintained table (UMT) to match the data in the source data set it was loaded from when opened, while 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 data set. 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 data set file, currently called SOURCEDS, is used to directly access the data set 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 data set.
The keys of the pair of records are compared. If the key to the UMT and the key to the source data set 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 data set is used to update the UMT. If the key in the UMT is greater than the key in the source data set, then the record(s) in the source data set are written to the UMT until the keys become equal or the UMT key becomes less than the source data set key. If the UMT key is less than the source data set key, then the record(s) in the UMT are removed until the keys become equal, or the UMT key is greater than the source data set. 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 data set 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 data set 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 data set file is set as SOURCEDS, and can also be changed.
- Source code
-
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 data set 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 data set 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 data set 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 data set IF (OPEN-STAT = DFHVALUE(CLOSED)) EXEC CICS SET FILE('SOURCEDS') OPEN RESP(RESPONSE) RESP2(RESPONSE2) END-EXEC * Check open of data set 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 data set from the first record EXEC CICS STARTBR FILE('SOURCEDS') RIDFLD(DS-KEY) GTEQ RESP(RESPONSE) RESP2(RESPONSE2) END-EXEC. * If data set is empty then treat as end of data set an empty UMT IF (RESPONSE = DFHRESP(NOTFND)) MOVE 1 TO DS-EOF ELSE * Output an error if the start browse for the data set failed IF (RESPONSE NOT = DFHRESP(NORMAL)) MOVE 'STARTBR ' TO ERROR-OPNAME MOVE 'SOURCEDS' TO ERROR-FILE PERFORM PROCESS-ERROR END-IF END-IF. * Set data set 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 data set 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 data set 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 data set 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 data set 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 data set 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 data set 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 data set 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 data set 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 data set 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 data set 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 data set 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.