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.