IDENTIFICATION DIVISION.
PROGRAM-ID. MBHCL000.
AUTHOR. AA&CO.
DATE-WRITTEN. JULY 08, 1987.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER.
VAX-8700.
OBJECT-COMPUTER.
VAX-8700.
DATA DIVISION.
WORKING-STORAGE SECTION.
COPY "PRJ:RLMCL000.CPY".
COPY "PRJ:RAERR001.CPY"
REPLACING ==
01 SYER-PARMS. ==
BY ==
01 SYER-PARMS EXTERNAL. ==.
COPY "PRJ:RAERR003.CPY".
COPY "PRJ:RLCIO001.CPY".
COPY "PRJ:RLCIO002.CPY".
COPY "PRJ:RCDBIO.CPY".
COPY "DICDATA:RTHO000.CPY".
COPY "DICDATA:RTHO001.CPY".
COPY "DICDATA:RLDATE.CPY".
COPY "DICDATA:RARUFA.CPY".
COPY "PRJ:RAEXC001.CPY".
COPY "DICDATA:RMPRCSTS.CPY".
COPY "PRJ:RCDATFCT.CPY".
COPY "PRJ:RCDATRTN.CPY".
COPY "PRJ:RCPRSSTS.CPY".
COPY "PRJ:RCTBLIDS.CPY".
01 WS-TEMP-LITERAL-FIELDS.
05 WS-MODULE-ID PIC X(8) VALUE
"MBHCL000".
05 WS-NO PIC X(1) VALUE "0".
05 WS-YES PIC X(1) VALUE "1".
01 WS-ERROR-PARAGRAPHES.
05 WS-ERR-PARA-121 PIC X(30) VALUE
"121_OPEN_ALL_FILES".
05 WS-ERR-PARA-1231 PIC X(30) VALUE
"1231_OBTAIN_EFF_DAT".
05 WS-ERR-PARA-1233 PIC X(30) VALUE
"1233_OBTAIN_LIM_FATAL".
05 WS-ERR-PARA-124 PIC X(30) VALUE
"124_PRIM_READ_TABLE".
05 WS-ERR-PARA-221 PIC X(30) VALUE
"221_EVAL_TABL_OLN_FLG".
05 WS-ERR-PARA-231 PIC X(30) VALUE
"231_UPDATE_TABLE_REC".
05 WS-ERR-PARA-2321 PIC X(30) VALUE
"2321_UNIQUE_READ_TABLES".
05 WS-ERR-PARA-31 PIC X(30) VALUE
"31_CLOSE_ALL_FILES".
05 WS-ERR-PARA-93 PIC X(30) VALUE
"93_NEXT_READ_TABLES".
05 WS-ERR-PARA-9911 PIC X(30) VALUE
"9911_UPDATE_PRCS_STS".
01 WS-ERROR-MESSAGES.
05 WS-ERR-MSG-221 PIC X(50) VALUE
"INVALID ONLINE CODE".
01 WS-FLAG-FIELDS.
05 WS-FIRST-TIME-THRU-FLAG PIC X(1) VALUE "1".
05 WS-KEY-LIM-EXCED-FLAG PIC X(1) VALUE "0".
05 WS-END-OF-DATA-FLAG PIC X(1) VALUE "0".
01 WS-TABL-VAL-COD.
05 WS-TABL-OLN-COD PIC X(1) VALUE "Y".
05 WS-TABL-EXT-COD PIC X(1) VALUE "N".
05 WS-TABL-UD-COD PIC X(1) VALUE "U".
05 WS-TABL-STATIC-COD PIC X(1) VALUE "S".
01 WS-CNTR-MBHCL000-MAX PIC 9(3)V9(2) VALUE 240.
01 WS-IMAGE-KEY.
05 WS-SAVE-TBL-OF-TBL-POS-KEY.
10 WS-TBL-ID-COD-SAV PIC X(3).
10 WS-TBL-EFF-DAT-SAV PIC X(8).
10 WS-REST-OF-TBL-POS-KEY-SAV.
15 WS-TBL-REP-COD-SAV PIC X(3).
15 WS-FILLER PIC X(36).
01 WS-IMAG-EXIT-STATUS.
05 WS-EXIT-STATUS-COD PIC S9(9) COMP.
01 WS-MAX-ISIX-USED PIC S9(9) COMP EXTERNAL.
01 WS-PRCS-MAX-REC-NO-RMPRCSTS PIC 9(4) COMP EXTERNAL.
PROCEDURE DIVISION.
0-MAINLINE.
PERFORM 1-BEGIN-PROCESS
THRU 1-BEGIN-PROCESS-EXIT.
PERFORM 2-PROCESS-TABLES
THRU 2-PROCESS-TABLES-EXIT
UNTIL WS-KEY-LIM-EXCED-FLAG = WS-YES OR
WS-END-OF-DATA-FLAG = WS-YES.
PERFORM 3-END-PROCESS
THRU 3-END-PROCESS-EXIT.
0-MAINLINE-EXIT.
EXIT.
1-BEGIN-PROCESS.
IF WS-FIRST-TIME-THRU-FLAG = WS-YES
MOVE WS-NO TO WS-FIRST-TIME-THRU-FLAG
PERFORM 11-INIT-HOUSEKEEPING
THRU 11-INIT-HOUSEKEEPING-EXIT
PERFORM 12-HOUSEKEEPING
THRU 12-HOUSEKEEPING-EXIT
ELSE
NEXT SENTENCE.
1-BEGIN-PROCESS-EXIT.
EXIT.
11-INIT-HOUSEKEEPING.
INITIALIZE RLMCL000-WS-REC.
MOVE SYER-GOOD-STS-COD TO IMAG-STS-COD-RLMCL000
WS-EXIT-STATUS-COD.
INITIALIZE SYER-PARMS.
MOVE WS-MODULE-ID TO SYER-IMAGE-ID.
MOVE SYER-PROG-BATCH-TYP TO SYER-PROGRAM-TYPE.
MOVE SYER-NO-OPER-MSG TO SYER-STATUS-CODE.
MOVE 0 TO CNTR-TBL-REC-NO-RLMCL000.
11-INIT-HOUSEKEEPING-EXIT.
EXIT.
12-HOUSEKEEPING.
PERFORM 121-OPEN-ALL-FILES
THRU 121-OPEN-ALL-FILES-EXIT.
PERFORM 91-START-RECOV-UNIT
THRU 91-START-RECOV-UNIT-EXIT.
PERFORM 122-EXCEP-HANDLING
THRU 122-EXCEP-HANDLING-EXIT.
PERFORM 123-INIT-WORK-STORAGE
THRU 123-INIT-WORK-STORAGE-EXIT.
PERFORM 124-PRIM-READ-TABLE
THRU 124-PRIM-READ-TABLE-EXIT.
12-HOUSEKEEPING-EXIT.
EXIT.
121-OPEN-ALL-FILES.
COPY "PRJ:CADMYOPN.LIB".
INITIALIZE RLCIO001-WS-REC.
MOVE DBIO-OPN-ALL-COD TO DBIO-CALL-TYP-COD-RLCIO001.
MOVE WS-MODULE-ID TO DBIO-IMG-NAM-RLCIO001.
CALL "OCFILES" USING DBIO-FILE-PROC-GRP-RLCIO001.
IF DBIO-GOOD-OC-STS-88
NEXT SENTENCE
ELSE
MOVE RLCIO001-WS-REC TO SYER-OCOP-PARMS
MOVE SYER-OCOP-ERROR TO SYER-STATUS-ID
MOVE WS-ERR-PARA-121 TO SYER-PARAGRAPH-NUM
MOVE SYER-SEVERE-ERROR TO IMAG-STS-COD-RLMCL000
CALL "SYSERROR" USING SYER-PARMS
PERFORM 99-FATAL-ERROR-HANDLING
THRU 99-FATAL-ERROR-HANDLING-EXIT.
INITIALIZE RLCIO001-WS-REC.
MOVE DBIO-OPN-SPF-COD TO DBIO-CALL-TYP-COD-RLCIO001.
MOVE DBIO-ORDERB-COD TO DBIO-FILE-NAM-RLCIO001.
MOVE DBIO-IO-YES-COD TO DBIO-IO-FLG-RLCIO001.
CALL "OCFILES" USING DBIO-FILE-PROC-GRP-RLCIO001.
IF NOT DBIO-GOOD-OC-STS-88
AND NOT DBIO-FILE-OPN-OC-88
MOVE SYER-SEVERE-ERROR TO IMAG-STS-COD-RLMCL000
MOVE RLCIO001-WS-REC TO SYER-OCOP-PARMS
MOVE SYER-OCOP-ERROR TO SYER-STATUS-ID
MOVE "121_OPEN_ALL_FILES" TO SYER-PARAGRAPH-NUM
CALL "SYSERROR" USING SYER-PARMS
PERFORM 99-FATAL-ERROR-HANDLING
THRU 99-FATAL-ERROR-HANDLING-EXIT
END-IF.
INITIALIZE RLCIO001-WS-REC.
MOVE DBIO-OPN-SPF-COD TO DBIO-CALL-TYP-COD-RLCIO001.
MOVE DBIO-ORDERS-COD TO DBIO-FILE-NAM-RLCIO001.
MOVE DBIO-IO-YES-COD TO DBIO-IO-FLG-RLCIO001.
CALL "OCFILES" USING DBIO-FILE-PROC-GRP-RLCIO001.
IF NOT DBIO-GOOD-OC-STS-88
AND NOT DBIO-FILE-OPN-OC-88
MOVE SYER-SEVERE-ERROR TO IMAG-STS-COD-RLMCL000
MOVE RLCIO001-WS-REC TO SYER-OCOP-PARMS
MOVE SYER-OCOP-ERROR TO SYER-STATUS-ID
MOVE "121_OPEN_ALL_FILES" TO SYER-PARAGRAPH-NUM
CALL "SYSERROR" USING SYER-PARMS
PERFORM 99-FATAL-ERROR-HANDLING
THRU 99-FATAL-ERROR-HANDLING-EXIT
END-IF.
121-OPEN-ALL-FILES-EXIT.
EXIT.
122-EXCEP-HANDLING.
COPY "PRJ:CAEST001.LIB".
122-EXCEP-HANDLING-EXIT.
EXIT.
123-INIT-WORK-STORAGE.
INITIALIZE RTHO000-WS-REC
WS-IMAGE-KEY.
MOVE WS-NO TO WS-END-OF-DATA-FLAG
PERFORM 1231-OBTAIN-EFF-DAT
THRU 1231-OBTAIN-EFF-DAT-EXIT.
PERFORM 1232-OBTAIN-NXT-BUS-DAY
THRU 1232-OBTAIN-NXT-BUS-DAY-EXIT.
PERFORM 1233-OBTAIN-LIM-FATAL
THRU 1233-OBTAIN-LIM-FATAL-EXIT.
123-INIT-WORK-STORAGE-EXIT.
EXIT.
1231-OBTAIN-EFF-DAT.
INITIALIZE RLCIO002-WS-REC
RTHO001-WS-REC.
MOVE CLG-HSE-PARM-RCTBLIDS TO TABL-ID-COD-RTHO001.
MOVE PRIM-TBL-KEY-RTHO001 TO DBIO-REC-KEY-RLCIO002.
MOVE DBIO-KEY-P-COD TO DBIO-KEY-COD-RLCIO002.
MOVE DBIO-READ-UNQ-COD TO DBIO-CALL-TYP-COD-RLCIO002.
MOVE DBIO-TABLES-COD TO DBIO-FILE-NAM-RLCIO002.
MOVE DBIO-LCK-YES-COD TO DBIO-REC-LCK-FLG-RLCIO002.
MOVE DBIO-BATCH-COD TO DBIO-CALLING-ID-COD-RLCIO002.
MOVE WS-MODULE-ID TO DBIO-UPD-ID-TXT-RLCIO002.
CALL "FILEACCESS" USING DBIO-FILE-ACC-GRP-RLCIO002.
IF DBIO-GOOD-READ-UNQ-88
INITIALIZE RTHO001-WS-REC
MOVE DBIO-REC-DATA-TXT-RLCIO002
TO RTHO001-WS-REC
MOVE EXCH-CRT-PROC-DAT-RTHO001 TO PRCS-CRT-DAT-GRP-RLMCL000
MOVE MAX-ISIX-USED-PERM-RTHO001 TO WS-MAX-ISIX-USED
ELSE
MOVE RLCIO002-WS-REC TO SYER-DBIO-PARMS
MOVE SYER-DBIO-ERROR TO SYER-STATUS-ID
MOVE WS-ERR-PARA-1231 TO SYER-PARAGRAPH-NUM
MOVE SYER-SEVERE-ERROR TO IMAG-STS-COD-RLMCL000
CALL "SYSERROR" USING SYER-PARMS
PERFORM 99-FATAL-ERROR-HANDLING
THRU 99-FATAL-ERROR-HANDLING-EXIT
END-IF.
1231-OBTAIN-EFF-DAT-EXIT.
EXIT.
1232-OBTAIN-NXT-BUS-DAY.
INITIALIZE RLDATE-WS-REC.
MOVE DATE-FUT-PAST-BUS-COD TO DATE-FCT-COD-RLDATE.
MOVE EXCH-CRT-PROC-DAT-RTHO001 TO DATE-INP-DAT-1-RLDATE
MOVE 1 TO DATE-INP-DAY-QTY-RLDATE.
CALL "MZHZA001" USING RLDATE-WS-REC
SYER-PARMS.
IF DATE-RTN-COD-RLDATE = DATE-GOOD-RTN-COD
MOVE DATE-OUT-DAT-RLDATE TO PRCS-NXT-BUS-DAT-RLMCL000
EXCH-CRT-PROC-DAT-RTHO001
ELSE
MOVE SYER-SEVERE-ERROR TO IMAG-STS-COD-RLMCL000
PERFORM 99-FATAL-ERROR-HANDLING
THRU 99-FATAL-ERROR-HANDLING-EXIT
END-IF.
1232-OBTAIN-NXT-BUS-DAY-EXIT.
EXIT.
1233-OBTAIN-LIM-FATAL.
INITIALIZE DBIO-FILE-ACC-GRP-RLCIO002
RMPRCSTS-WS-REC.
MOVE WS-CNTR-MBHCL000-MAX TO PRIM-RECORD-KEY-RMPRCSTS.
MOVE DBIO-READ-UNQ-COD TO DBIO-CALL-TYP-COD-RLCIO002.
MOVE DBIO-PRCSTS-COD TO DBIO-FILE-NAM-RLCIO002.
MOVE PRIM-RECORD-KEY-RMPRCSTS TO DBIO-REC-KEY-RLCIO002.
MOVE DBIO-KEY-P-COD TO DBIO-KEY-COD-RLCIO002.
MOVE DBIO-LCK-NO-COD TO DBIO-REC-LCK-FLG-RLCIO002.
MOVE DBIO-BATCH-COD TO DBIO-CALLING-ID-COD-RLCIO002.
MOVE WS-MODULE-ID TO DBIO-UPD-ID-TXT-RLCIO002.
CALL "FILEACCESS" USING DBIO-FILE-ACC-GRP-RLCIO002.
IF DBIO-GOOD-READ-UNQ-88
MOVE DBIO-REC-DATA-TXT-RLCIO002
TO RMPRCSTS-WS-REC
MOVE PRCS-MAX-REC-NO-RMPRCSTS TO WS-PRCS-MAX-REC-NO-RMPRCSTS
ELSE
MOVE SYER-SEVERE-ERROR TO IMAG-STS-COD-RLMCL000
MOVE RLCIO002-WS-REC TO SYER-DBIO-PARMS
MOVE SYER-DBIO-ERROR TO SYER-STATUS-ID
MOVE WS-ERR-PARA-1233 TO SYER-PARAGRAPH-NUM
CALL "SYSERROR" USING SYER-PARMS
PERFORM 99-FATAL-ERROR-HANDLING
THRU 99-FATAL-ERROR-HANDLING-EXIT
END-IF.
1233-OBTAIN-LIM-FATAL-EXIT.
EXIT.
124-PRIM-READ-TABLE.
INITIALIZE RLCIO002-WS-REC.
MOVE LOW-VALUES TO PRIM-TBL-KEY-RTHO000.
MOVE PRIM-TBL-KEY-RTHO000 TO DBIO-REC-KEY-RLCIO002.
MOVE HIGH-VALUES TO PRIM-TBL-KEY-RTHO000.
MOVE TABLE-OF-TABLES-RCTBLIDS TO TABL-ID-COD-RTHO000.
MOVE PRIM-TBL-KEY-RTHO000 TO DBIO-LIM-KEY-RLCIO002.
MOVE DBIO-READ-COD TO DBIO-CALL-TYP-COD-RLCIO002.
MOVE DBIO-TABLES-COD TO DBIO-FILE-NAM-RLCIO002.
MOVE DBIO-KEY-P-COD TO DBIO-KEY-COD-RLCIO002.
MOVE DBIO-LCK-YES-COD TO DBIO-REC-LCK-FLG-RLCIO002.
MOVE DBIO-BATCH-COD TO DBIO-CALLING-ID-COD-RLCIO002.
MOVE WS-MODULE-ID TO DBIO-UPD-ID-TXT-RLCIO002.
CALL "FILEACCESS" USING DBIO-FILE-ACC-GRP-RLCIO002.
IF DBIO-GOOD-READ-88
INITIALIZE RTHO000-WS-REC
MOVE DBIO-REC-DATA-TXT-RLCIO002
TO RTHO000-WS-REC
ELSE
MOVE RLCIO002-WS-REC TO SYER-DBIO-PARMS
MOVE SYER-DBIO-ERROR TO SYER-STATUS-ID
MOVE WS-ERR-PARA-124 TO SYER-PARAGRAPH-NUM
MOVE SYER-SEVERE-ERROR TO IMAG-STS-COD-RLMCL000
CALL "SYSERROR" USING SYER-PARMS
PERFORM 99-FATAL-ERROR-HANDLING
THRU 99-FATAL-ERROR-HANDLING-EXIT
END-IF.
PERFORM 93-NEXT-READ-TABLES
THRU 93-NEXT-READ-TABLES-EXIT
UNTIL PRCS-BAT-STS-COD-RTHO000 = PRCS-INC-COD
OR WS-KEY-LIM-EXCED-FLAG = WS-YES
OR WS-END-OF-DATA-FLAG = WS-YES.
124-PRIM-READ-TABLE-EXIT.
EXIT.
2-PROCESS-TABLES.
PERFORM 21-BEGIN-MAINLINE
THRU 21-BEGIN-MAINLINE-EXIT.
IF TABL-REP-COD-RTHO000 NOT = MEMB-PROFILE-RCTBLIDS
AND NOT = SYSTEM-PROFILE-RCTBLIDS
*** SIR R4M05 DELETE
AND NOT = UNDR-INT-PRES-RCTBLIDS
PERFORM 22-PROCESS-MAINLINE
THRU 22-PROCESS-MAINLINE-EXIT
END-IF.
PERFORM 23-END-MAINLINE
THRU 23-END-MAINLINE-EXIT.
2-PROCESS-TABLES-EXIT.
EXIT.
21-BEGIN-MAINLINE.
MOVE PRIM-TBL-KEY-RTHO000 TO WS-SAVE-TBL-OF-TBL-POS-KEY.
MOVE TABL-REP-COD-RTHO000 TO SAVE-TBL-ID-COD-RLMCL000
SAVE-TBL-REP-COD-RLMCL000.
MOVE PRCS-NXT-BUS-DAT-RLMCL000 TO SAVE-TBL-EFF-DAT-RLMCL000.
21-BEGIN-MAINLINE-EXIT.
EXIT.
22-PROCESS-MAINLINE.
IF TABL-OLN-FLG-RTHO000 NOT = WS-TABL-STATIC-COD
PERFORM 221-EVAL-TABL-OLN-FLG
THRU 221-EVAL-TABL-OLN-FLG-EXIT
END-IF.
PERFORM 222-EVAL-TABL-TYP-COD
THRU 222-EVAL-TABL-TYP-COD-EXIT.
22-PROCESS-MAINLINE-EXIT.
EXIT.
221-EVAL-TABL-OLN-FLG.
EVALUATE TABL-OLN-FLG-RTHO000
WHEN WS-TABL-OLN-COD
PERFORM 2211-CALL-ONLINE-TBL-MOD
THRU 2211-CALL-ONLINE-TBL-MOD-EXIT
WHEN WS-TABL-EXT-COD
PERFORM 2212-CALL-EXTRACT-TBL-MOD
THRU 2212-CALL-EXTRACT-TBL-MOD-EXIT
WHEN OTHER
MOVE RTHO000-WS-REC TO SYER-DBIO-PARMS
MOVE SYER-APPLIC-ERROR TO SYER-STATUS-ID
MOVE WS-ERR-PARA-221 TO SYER-PARAGRAPH-NUM
MOVE SPACES TO SYER-ERR-REC
MOVE WS-ERR-MSG-221 TO SYER-ERR-REC
MOVE SYER-FATAL-ERROR TO IMAG-STS-COD-RLMCL000
CALL "SYSERROR" USING SYER-PARMS
PERFORM 99-FATAL-ERROR-HANDLING
THRU 99-FATAL-ERROR-HANDLING-EXIT
END-EVALUATE.
PERFORM 92-END-RECOV-UNIT
THRU 92-END-RECOV-UNIT-EXIT.
PERFORM 91-START-RECOV-UNIT
THRU 91-START-RECOV-UNIT-EXIT.
221-EVAL-TABL-OLN-FLG-EXIT.
EXIT.
2211-CALL-ONLINE-TBL-MOD.
CALL "MBHCL010".
IF IMAG-STS-COD-RLMCL000 = SYER-GOOD-STS-COD
MOVE WS-MODULE-ID TO SYER-CALLED-MODULE
ELSE
MOVE SYER-FATAL-ERROR TO IMAG-STS-COD-RLMCL000
PERFORM 99-FATAL-ERROR-HANDLING
THRU 99-FATAL-ERROR-HANDLING-EXIT
END-IF.
2211-CALL-ONLINE-TBL-MOD-EXIT.
EXIT.
2212-CALL-EXTRACT-TBL-MOD.
CALL "MBHCL030".
IF IMAG-STS-COD-RLMCL000 = SYER-GOOD-STS-COD
MOVE WS-MODULE-ID TO SYER-CALLED-MODULE
ELSE
MOVE SYER-FATAL-ERROR TO IMAG-STS-COD-RLMCL000
PERFORM 99-FATAL-ERROR-HANDLING
THRU 99-FATAL-ERROR-HANDLING-EXIT
END-IF.
2212-CALL-EXTRACT-TBL-MOD-EXIT.
EXIT.
222-EVAL-TABL-TYP-COD.
IF SAVE-TBL-ID-COD-RLMCL000 = CLG-HSE-PARM-RCTBLIDS
OR SAVE-TBL-ID-COD-RLMCL000 = EXCH-HOLIDAYS-RCTBLIDS
PERFORM 2221-CALL-USR-DEV-TBL-MOD
THRU 2221-CALL-USR-DEV-TBL-MOD-EXIT
END-IF.
EVALUATE TABL-TYP-COD-RTHO000
WHEN WS-TABL-UD-COD
PERFORM 2221-CALL-USR-DEV-TBL-MOD
THRU 2221-CALL-USR-DEV-TBL-MOD-EXIT
END-EVALUATE.
222-EVAL-TABL-TYP-COD-EXIT.
EXIT.
2221-CALL-USR-DEV-TBL-MOD.
CALL "MBHCL020".
IF IMAG-STS-COD-RLMCL000 = SYER-GOOD-STS-COD
MOVE WS-MODULE-ID TO SYER-CALLED-MODULE
ELSE
MOVE SYER-FATAL-ERROR TO IMAG-STS-COD-RLMCL000
PERFORM 99-FATAL-ERROR-HANDLING
THRU 99-FATAL-ERROR-HANDLING-EXIT
END-IF.
2221-CALL-USR-DEV-TBL-MOD-EXIT.
EXIT.
23-END-MAINLINE.
PERFORM 231-UPDATE-TABLE-REC
THRU 231-UPDATE-TABLE-REC-EXIT.
PERFORM 92-END-RECOV-UNIT
THRU 92-END-RECOV-UNIT-EXIT.
PERFORM 91-START-RECOV-UNIT
THRU 91-START-RECOV-UNIT-EXIT.
PERFORM 232-CNTRL-NXT-READ-TABLES
THRU 232-CNTRL-NXT-READ-TABLES-EXIT.
23-END-MAINLINE-EXIT.
EXIT.
231-UPDATE-TABLE-REC.
INITIALIZE RLCIO002-WS-REC.
MOVE PRCS-COMPL-COD TO PRCS-BAT-STS-COD-RTHO000.
MOVE WS-SAVE-TBL-OF-TBL-POS-KEY TO PRIM-TBL-KEY-RTHO000.
MOVE DBIO-RWR-COD TO DBIO-CALL-TYP-COD-RLCIO002.
MOVE DBIO-TABLES-COD TO DBIO-FILE-NAM-RLCIO002.
MOVE DBIO-BATCH-COD TO DBIO-CALLING-ID-COD-RLCIO002.
MOVE DBIO-KEY-P-COD TO DBIO-KEY-COD-RLCIO002.
MOVE WS-MODULE-ID TO DBIO-UPD-ID-TXT-RLCIO002.
MOVE RTHO000-WS-REC TO DBIO-REC-DATA-TXT-RLCIO002.
CALL "FILEACCESS" USING DBIO-FILE-ACC-GRP-RLCIO002.
IF DBIO-GOOD-REWRITE-88
NEXT SENTENCE
ELSE
MOVE RLCIO002-WS-REC TO SYER-DBIO-PARMS
MOVE SYER-DBIO-ERROR TO SYER-STATUS-ID
MOVE WS-ERR-PARA-231 TO SYER-PARAGRAPH-NUM
MOVE SYER-FATAL-ERROR TO IMAG-STS-COD-RLMCL000
CALL "SYSERROR" USING SYER-PARMS
PERFORM 99-FATAL-ERROR-HANDLING
THRU 99-FATAL-ERROR-HANDLING-EXIT.
231-UPDATE-TABLE-REC-EXIT.
EXIT.
232-CNTRL-NXT-READ-TABLES.
PERFORM 2321-UNIQUE-READ-TABLES
THRU 2321-UNIQUE-READ-TABLES-EXIT.
INITIALIZE RTHO000-WS-REC.
PERFORM 93-NEXT-READ-TABLES
THRU 93-NEXT-READ-TABLES-EXIT
UNTIL PRCS-BAT-STS-COD-RTHO000 = PRCS-INC-COD
OR WS-KEY-LIM-EXCED-FLAG = WS-YES
OR WS-END-OF-DATA-FLAG = WS-YES.
232-CNTRL-NXT-READ-TABLES-EXIT.
EXIT.
2321-UNIQUE-READ-TABLES.
INITIALIZE RLCIO002-WS-REC.
MOVE PRIM-TBL-KEY-RTHO000 TO DBIO-REC-KEY-RLCIO002.
MOVE DBIO-KEY-P-COD TO DBIO-KEY-COD-RLCIO002.
MOVE DBIO-READ-UNQ-COD TO DBIO-CALL-TYP-COD-RLCIO002.
MOVE DBIO-TABLES-COD TO DBIO-FILE-NAM-RLCIO002.
MOVE DBIO-LCK-NO-COD TO DBIO-REC-LCK-FLG-RLCIO002.
MOVE DBIO-BATCH-COD TO DBIO-CALLING-ID-COD-RLCIO002.
MOVE WS-MODULE-ID TO DBIO-UPD-ID-TXT-RLCIO002.
CALL "FILEACCESS" USING DBIO-FILE-ACC-GRP-RLCIO002.
IF DBIO-GOOD-READ-UNQ-88
NEXT SENTENCE
ELSE
MOVE RLCIO002-WS-REC TO SYER-DBIO-PARMS
MOVE SYER-DBIO-ERROR TO SYER-STATUS-ID
MOVE WS-ERR-PARA-2321 TO SYER-PARAGRAPH-NUM
MOVE SYER-SEVERE-ERROR TO IMAG-STS-COD-RLMCL000
CALL "SYSERROR" USING SYER-PARMS
PERFORM 99-FATAL-ERROR-HANDLING
THRU 99-FATAL-ERROR-HANDLING-EXIT.
2321-UNIQUE-READ-TABLES-EXIT.
EXIT.
3-END-PROCESS.
PERFORM 92-END-RECOV-UNIT
THRU 92-END-RECOV-UNIT-EXIT.
PERFORM 31-CLOSE-ALL-FILES
THRU 31-CLOSE-ALL-FILES-EXIT.
PERFORM 9999-END-IMAGE
THRU 9999-END-IMAGE-EXIT.
3-END-PROCESS-EXIT.
EXIT.
31-CLOSE-ALL-FILES.
INITIALIZE RLCIO001-WS-REC.
MOVE DBIO-CLOSE-ALL-COD TO DBIO-CALL-TYP-COD-RLCIO001.
MOVE WS-MODULE-ID TO DBIO-IMG-NAM-RLCIO001.
CALL "OCFILES" USING DBIO-FILE-PROC-GRP-RLCIO001.
IF DBIO-GOOD-OC-STS-88
NEXT SENTENCE
ELSE
MOVE RLCIO001-WS-REC TO SYER-OCOP-PARMS
MOVE SYER-OCOP-ERROR TO SYER-STATUS-ID
MOVE WS-ERR-PARA-31 TO SYER-PARAGRAPH-NUM
MOVE SYER-SEVERE-ERROR TO IMAG-STS-COD-RLMCL000
CALL "SYSERROR" USING SYER-PARMS
PERFORM 99-FATAL-ERROR-HANDLING
THRU 99-FATAL-ERROR-HANDLING-EXIT.
INITIALIZE RLCIO001-WS-REC.
MOVE DBIO-CLOSE-SPF-COD TO DBIO-CALL-TYP-COD-RLCIO001.
MOVE DBIO-ORDERB-COD TO DBIO-FILE-NAM-RLCIO001.
MOVE DBIO-IO-YES-COD TO DBIO-IO-FLG-RLCIO001.
CALL "OCFILES" USING DBIO-FILE-PROC-GRP-RLCIO001.
IF NOT DBIO-GOOD-OC-STS-88
AND NOT DBIO-FILE-OPN-OC-88
MOVE SYER-SEVERE-ERROR TO IMAG-STS-COD-RLMCL000
MOVE RLCIO001-WS-REC TO SYER-OCOP-PARMS
MOVE SYER-OCOP-ERROR TO SYER-STATUS-ID
MOVE "31_CLOSE_ALL_FILES"
TO SYER-PARAGRAPH-NUM
CALL "SYSERROR" USING SYER-PARMS
PERFORM 99-FATAL-ERROR-HANDLING
THRU 99-FATAL-ERROR-HANDLING-EXIT
END-IF.
INITIALIZE RLCIO001-WS-REC.
MOVE DBIO-CLOSE-SPF-COD TO DBIO-CALL-TYP-COD-RLCIO001.
MOVE DBIO-ORDERS-COD TO DBIO-FILE-NAM-RLCIO001.
MOVE DBIO-IO-YES-COD TO DBIO-IO-FLG-RLCIO001.
CALL "OCFILES" USING DBIO-FILE-PROC-GRP-RLCIO001.
IF NOT DBIO-GOOD-OC-STS-88
AND NOT DBIO-FILE-OPN-OC-88
MOVE SYER-SEVERE-ERROR TO IMAG-STS-COD-RLMCL000
MOVE RLCIO001-WS-REC TO SYER-OCOP-PARMS
MOVE SYER-OCOP-ERROR TO SYER-STATUS-ID
MOVE "31_CLOSE_ALL_FILES"
TO SYER-PARAGRAPH-NUM
CALL "SYSERROR" USING SYER-PARMS
PERFORM 99-FATAL-ERROR-HANDLING
THRU 99-FATAL-ERROR-HANDLING-EXIT
END-IF.
COPY "PRJ:CADMYCLO.LIB".
31-CLOSE-ALL-FILES-EXIT.
EXIT.
91-START-RECOV-UNIT.
COPY "PRJ:CARUFA.LIB".
COPY "PRJ:CARUF001.LIB".
IF RUFA-RTN-COD-NO-RARUFA IS FAILURE
MOVE SYER-SEVERE-ERROR TO IMAG-STS-COD-RLMCL000
PERFORM 99-FATAL-ERROR-HANDLING
THRU 99-FATAL-ERROR-HANDLING-EXIT
ELSE
NEXT SENTENCE.
91-START-RECOV-UNIT-EXIT.
EXIT.
92-END-RECOV-UNIT.
COPY "PRJ:CARUF002.LIB".
IF RUFA-RTN-COD-NO-RARUFA IS FAILURE
MOVE SYER-SEVERE-ERROR TO IMAG-STS-COD-RLMCL000
PERFORM 99-FATAL-ERROR-HANDLING
THRU 99-FATAL-ERROR-HANDLING-EXIT
ELSE
NEXT SENTENCE.
92-END-RECOV-UNIT-EXIT.
EXIT.
93-NEXT-READ-TABLES.
INITIALIZE RLCIO002-WS-REC.
MOVE HIGH-VALUES TO PRIM-TBL-KEY-RTHO000.
MOVE TABLE-OF-TABLES-RCTBLIDS TO TABL-ID-COD-RTHO000.
MOVE PRIM-TBL-KEY-RTHO000 TO DBIO-LIM-KEY-RLCIO002.
MOVE DBIO-READ-NXT-COD TO DBIO-CALL-TYP-COD-RLCIO002.
MOVE DBIO-TABLES-COD TO DBIO-FILE-NAM-RLCIO002.
MOVE DBIO-LCK-YES-COD TO DBIO-REC-LCK-FLG-RLCIO002.
MOVE DBIO-KEY-P-COD TO DBIO-KEY-COD-RLCIO002.
MOVE DBIO-BATCH-COD TO DBIO-CALLING-ID-COD-RLCIO002.
MOVE WS-MODULE-ID TO DBIO-UPD-ID-TXT-RLCIO002.
CALL "FILEACCESS" USING DBIO-FILE-ACC-GRP-RLCIO002.
IF DBIO-GOOD-READ-NEXT-88
MOVE DBIO-REC-DATA-TXT-RLCIO002
TO RTHO000-WS-REC
ELSE
IF DBIO-LIM-KEY-EXCEED-88
MOVE WS-YES TO WS-KEY-LIM-EXCED-FLAG
ELSE
IF DBIO-END-OF-DATA-88
MOVE WS-YES TO WS-END-OF-DATA-FLAG
ELSE
MOVE RLCIO002-WS-REC TO SYER-DBIO-PARMS
MOVE SYER-DBIO-ERROR TO SYER-STATUS-ID
MOVE WS-ERR-PARA-93 TO SYER-PARAGRAPH-NUM
MOVE SYER-SEVERE-ERROR TO IMAG-STS-COD-RLMCL000
CALL "SYSERROR" USING SYER-PARMS
PERFORM 99-FATAL-ERROR-HANDLING
THRU 99-FATAL-ERROR-HANDLING-EXIT
END-IF
END-IF
END-IF.
93-NEXT-READ-TABLES-EXIT.
EXIT.
99-FATAL-ERROR-HANDLING.
MOVE IMAG-STS-COD-RLMCL000 TO WS-EXIT-STATUS-COD.
IF IMAG-STS-COD-RLMCL000 = SYER-SEVERE-ERROR
PERFORM 9999-END-IMAGE
THRU 9999-END-IMAGE-EXIT
ELSE
ADD 1 TO CNTR-FAT-ERR-NO-RLMCL000
PERFORM 991-PROCESS-FATAL-ERROR
THRU 991-PROCESS-FATAL-ERROR-EXIT
END-IF.
99-FATAL-ERROR-HANDLING-EXIT.
EXIT.
991-PROCESS-FATAL-ERROR.
MOVE SYER-GOOD-STS-COD TO IMAG-STS-COD-RLMCL000.
PERFORM 91-START-RECOV-UNIT
THRU 91-START-RECOV-UNIT-EXIT.
PERFORM 9911-UPDATE-PRCS-STS
THRU 9911-UPDATE-PRCS-STS-EXIT.
PERFORM 92-END-RECOV-UNIT
THRU 92-END-RECOV-UNIT-EXIT.
IF CNTR-FAT-ERR-NO-RLMCL000 > CNTR-FAT-ERR-NO-RMPRCSTS
MOVE SYER-FATAL-ERROR TO IMAG-STS-COD-RLMCL000
PERFORM 9999-END-IMAGE
THRU 9999-END-IMAGE-EXIT
ELSE
NEXT SENTENCE.
PERFORM 91-START-RECOV-UNIT
THRU 91-START-RECOV-UNIT-EXIT.
PERFORM 93-NEXT-READ-TABLES
THRU 93-NEXT-READ-TABLES-EXIT
UNTIL WS-END-OF-DATA-FLAG = WS-YES OR
WS-KEY-LIM-EXCED-FLAG = WS-YES OR
PRCS-BAT-STS-COD-RTHO000 = PRCS-INC-COD.
GO TO 0-MAINLINE.
991-PROCESS-FATAL-ERROR-EXIT.
EXIT.
9911-UPDATE-PRCS-STS.
INITIALIZE RTHO000-WS-REC.
INITIALIZE RLCIO002-WS-REC.
MOVE DBIO-READ-UNQ-COD TO DBIO-CALL-TYP-COD-RLCIO002.
MOVE DBIO-TABLES-COD TO DBIO-FILE-NAM-RLCIO002.
MOVE WS-SAVE-TBL-OF-TBL-POS-KEY TO DBIO-REC-KEY-RLCIO002.
MOVE DBIO-KEY-P-COD TO DBIO-KEY-COD-RLCIO002.
MOVE DBIO-LCK-YES-COD TO DBIO-REC-LCK-FLG-RLCIO002.
MOVE DBIO-BATCH-COD TO DBIO-CALLING-ID-COD-RLCIO002.
MOVE WS-MODULE-ID TO DBIO-UPD-ID-TXT-RLCIO002.
CALL "FILEACCESS" USING DBIO-FILE-ACC-GRP-RLCIO002.
IF DBIO-GOOD-READ-UNQ-88
MOVE DBIO-REC-DATA-TXT-RLCIO002
TO RTHO000-WS-REC
MOVE PRCS-ERR-COD TO PRCS-BAT-STS-COD-RTHO000
ELSE
MOVE RLCIO002-WS-REC TO SYER-DBIO-PARMS
MOVE SYER-DBIO-ERROR TO SYER-STATUS-ID
MOVE WS-ERR-PARA-9911 TO SYER-PARAGRAPH-NUM
MOVE SYER-SEVERE-ERROR TO IMAG-STS-COD-RLMCL000
CALL "SYSERROR" USING SYER-PARMS
PERFORM 9999-END-IMAGE
THRU 9999-END-IMAGE-EXIT
END-IF.
INITIALIZE RLCIO002-WS-REC.
MOVE DBIO-RWR-COD TO DBIO-CALL-TYP-COD-RLCIO002.
MOVE DBIO-TABLES-COD TO DBIO-FILE-NAM-RLCIO002.
MOVE DBIO-KEY-P-COD TO DBIO-KEY-COD-RLCIO002.
MOVE RTHO000-WS-REC TO DBIO-REC-DATA-TXT-RLCIO002.
MOVE WS-MODULE-ID TO DBIO-UPD-ID-TXT-RLCIO002.
CALL "FILEACCESS" USING DBIO-FILE-ACC-GRP-RLCIO002.
IF DBIO-GOOD-REWRITE-88
NEXT SENTENCE
ELSE
MOVE RLCIO002-WS-REC TO SYER-DBIO-PARMS
MOVE SYER-DBIO-ERROR TO SYER-STATUS-ID
MOVE WS-ERR-PARA-9911 TO SYER-PARAGRAPH-NUM
MOVE SYER-SEVERE-ERROR TO IMAG-STS-COD-RLMCL000
CALL "SYSERROR" USING SYER-PARMS
PERFORM 9999-END-IMAGE
THRU 9999-END-IMAGE-EXIT.
9911-UPDATE-PRCS-STS-EXIT.
EXIT.
9999-END-IMAGE.
IF IMAG-STS-COD-RLMCL000 = SYER-SEVERE-ERROR
MOVE IMAG-STS-COD-RLMCL000 TO WS-EXIT-STATUS-COD
END-IF.
CALL "SYS$EXIT" USING BY VALUE WS-EXIT-STATUS-COD.
9999-END-IMAGE-EXIT.
EXIT.