0% found this document useful (0 votes)
131 views

Cobol Db2 Program

This program rounds up WWXCLMWT data and produces six output files based on changes. It reads input records and valuation dates, locates the appropriate partition, gets the current and prior records, and processes any deltas between the records to determine which output files to write the record to. It writes records to files for all activity, new/refreshed customers, refreshed claims, customers with no ID, records with status changes, and mismatches.
Copyright
© Attribution Non-Commercial (BY-NC)
Available Formats
Download as DOC, PDF, TXT or read online on Scribd
0% found this document useful (0 votes)
131 views

Cobol Db2 Program

This program rounds up WWXCLMWT data and produces six output files based on changes. It reads input records and valuation dates, locates the appropriate partition, gets the current and prior records, and processes any deltas between the records to determine which output files to write the record to. It writes records to files for all activity, new/refreshed customers, refreshed claims, customers with no ID, records with status changes, and mismatches.
Copyright
© Attribution Non-Commercial (BY-NC)
Available Formats
Download as DOC, PDF, TXT or read online on Scribd
You are on page 1/ 10

***************************** Top of Data ****************** IDENTIFICATION DIVISION. PROGRAM-ID. XS2853. AUTHOR. BRETT CALDON. DATE-WRITTEN. APRIL 1997. DATE-COMPILED.

*********************************************************** ********* * PROGRAM XS2853#, ROUNDS UP WWXCLMWT DATA AND PRODUCES * * SIX FILES DETRMINED BY THE DELTA PROCESSING. * * 1) OUTCHG - ALL RECORDS WITH ACTIVITY OR REFRESH * * REGARDLESS OF CHANGE * * 2) NEW/REFRESH CUSTOMER - ALL NEW RECORDS AND THOSE * * WITH CHANGE IN ID-CUST-PERS * * 3) REFRESH CLAIM - ALL RECORD IN REFRESH FILE * * 4) NO CUSTOMER - ALL RECORDS WHERE ID-CUST-PERS = 0 * * 5) STATUS CHANGE - ALL RECORDS NEW, REFRESH, AND * * WHERE CDE-STS-CLM HAS CHANGED * * 6) NO HIT - ERROR FILE, RECORD MISMATCH * * * * CHANGE LOG: * * XSPP00 - ADDED THE FIELDS I-LIEN,CDE-RSN-CLS-CLM, * * I-INJ-CAT,CNT-WRK-DAY,DTE-CHG-CLM TO COPYBOOKS * * XS28531, XS2853I, XS2853R. * * - ADDED THE FIELDS I_LIEN,CDE_RSN_CLS_CLM, * * I_INJ_CAT,CNT_WRK_DAY,DTE_CHG_CLM TO COPYBOOKS * * XS2853QR, XS2853QC. * * - INCREASED OUTPUT-CHG-REC LENGTH TO 538 * * * ********************************************************************* ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT INPUT-FILE ASSIGN TO INFILE FILE STATUS IS FILE-STATUS. SELECT OUTPUT-CHG ASSIGN TO OD1XS001 FILE STATUS IS FILE-STATUS. SELECT OUTPUT-REFRESH-CUST ASSIGN TO OD2XS001 FILE STATUS IS FILE-STATUS. SELECT OUTPUT-REFRESH-CLM ASSIGN TO OD3XS001 FILE STATUS IS FILE-STATUS. SELECT OUTPUT-NO-CUST ASSIGN TO OD4XS001 FILE STATUS IS FILE-STATUS. SELECT OUTPUT-STAT-CHG ASSIGN TO OD5XS001 FILE STATUS IS FILE-STATUS. SELECT OUTPUT-NOHIT ASSIGN TO OD6XS001 FILE STATUS IS FILE-STATUS. SELECT VALUATION-DATES

ASSIGN TO INVALS FILE STATUS IS FILE-STATUS. DATA DIVISION. FILE SECTION. FD VALUATION-DATES BLOCK CONTAINS 0 RECORDS RECORDING MODE F. 01 VALUATION-DATES-REC. 05 VAL-TIME PIC X(26). 05 FILLER PIC X(54). FD INPUT-FILE BLOCK CONTAINS 0 RECORDS RECORDING MODE F. 01 INPUT-RECORD PIC X(30). FD OUTPUT-CHG BLOCK CONTAINS 0 RECORDS RECORDING MODE F. 01 OUTPUT-CHG-REC PIC X(538). FD OUTPUT-REFRESH-CUST BLOCK CONTAINS 0 RECORDS RECORDING MODE F. 01 OUTPUT-REFRESH-CUST-REC PIC X(30). FD OUTPUT-REFRESH-CLM BLOCK CONTAINS 0 RECORDS RECORDING MODE F. 01 OUTPUT-REFRESH-CLM-REC PIC X(30). FD OUTPUT-NO-CUST BLOCK CONTAINS 0 RECORDS RECORDING MODE F. 01 OUTPUT-NO-CUST-REC PIC X(30). FD OUTPUT-STAT-CHG BLOCK CONTAINS 0 RECORDS RECORDING MODE F. 01 OUTPUT-STAT-CHG-REC PIC X(9). FD OUTPUT-NOHIT BLOCK CONTAINS 0 RECORDS RECORDING MODE F. 01 OUTPUT-NOHIT-REC PIC X(30). WORKING-STORAGE SECTION. 01 FILE-STATUS PIC XX.

01 SWITCH-AREA. 05 DONE-FETCHING-SW PIC X(01) VALUE '0'. 88 DONE-FETCHING VALUE '1'. 05 SW-EOF-INPUT PIC X(01) VALUE '0'.

88 EOF-INPUT 05 SW-EOF-INVALS 88 EOF-INVALS

VALUE '1'. PIC X(01) VALUE '0'. VALUE '1'.

01 RUN-TIMES. 05 DATETIME-VAL-CURR PIC X(26). 05 DATETIME-VAL-PRIOR PIC X(26). 01 RUN-TIMES-REFORMAT REDEFINES RUN-TIMES. 05 DATE-VAL-CURR PIC X(10). 05 FILLER PIC X(1). 05 TIME-VAL-CURR PIC X(15). 05 DATE-VAL-PRIOR PIC X(10). 05 FILLER PIC X(1). 05 TIME-VAL-PRIOR PIC X(15). 01 NUM-PART PIC S9(4) COMP. 01 PARTITION-VARS. 02 PART-FETCH. 05 NUM-PRTT PIC S9(4) COMP. 05 DATETIME-EFF PIC X(26). 05 DATETIME-EXP PIC X(26). 01 XSPARTBL-INFO. 05 CALLING-PROGRAM PIC X(08) VALUE 'XSDELTA'. 05 ID-SOURCE PIC X(08). 05 DATETIME-ONE PIC X(26). 05 DATETIME-TWO PIC X(26). 05 NUM-PRTT PIC S9(04) COMP. 01 WS-MSSG-AREA. 05 WS-MSSG-PARAGRAPH PIC X(40). 05 WS-MSSG-REASON PIC X(40). 05 WS-MSSG-SQLCODE PIC 9(9). 01 WS-SQLCODE PIC S9(04) VALUE -999.

01 WS-LITERALS. 03 WS-SQL-CODES COMP. 10 SQL-OK PIC S9(04) VALUE +000. 10 SQL-NOT-FOUND PIC S9(04) VALUE +100. 10 SQL-LOCKOUT PIC S9(04) VALUE -913. 01 WS-COUNTERS. 05 RECS-READ PIC 9(08) VALUE 0. 05 RECS-READ-ACT PIC 9(08) VALUE 0. 05 RECS-READ-REF PIC 9(08) VALUE 0. 05 RECS-WRITTEN-CHG PIC 9(08) VALUE 0. 05 RECS-WRITTEN-REF-CUST PIC 9(08) VALUE 0. 05 RECS-WRITTEN-REF-CUST-SECUR PIC 9(08) VALUE 0. 05 RECS-WRITTEN-REF-CLM PIC 9(08) VALUE 0. 05 RECS-WRITTEN-REF-CLM-SECUR PIC 9(08) VALUE 0. 05 RECS-WRITTEN-NO-CUST PIC 9(08) VALUE 0. 05 RECS-WRITTEN-STAT-CHG PIC 9(08) VALUE 0. 05 RECS-WRITTEN-NOHIT PIC 9(08) VALUE 0. 01 WS-INPUT-RECORD. EXEC SQL

INCLUDE XS2853F END-EXEC. 01 WS-ALL-REC-DEFAULTS. EXEC SQL INCLUDE XS2853D END-EXEC. 01 WS-OUTPUT-CHG-REC. EXEC SQL INCLUDE XS28531 END-EXEC. 01 WS-OUTPUT-REFRESH-CUST-REC. EXEC SQL INCLUDE XS28532 END-EXEC. 01 WS-OUTPUT-REFRESH-CLM-REC. EXEC SQL INCLUDE XS2853F END-EXEC. 01 WS-OUTPUT-NO-CUST-REC. EXEC SQL INCLUDE XS2853F END-EXEC. 01 WS-OUTPUT-STAT-CHG-REC. EXEC SQL INCLUDE XS28533 END-EXEC. 01 WS-OUTPUT-NOHIT-REC. EXEC SQL INCLUDE XS2853F END-EXEC. 01 INPUT-STRUC-PRIOR. EXEC SQL INCLUDE XS2853IP END-EXEC. 01 INPUT-STRUC. EXEC SQL INCLUDE XS2853I END-EXEC. 01 INPUT-STRUC-NUL. 10 NUL-IND PIC S9(4) COMP OCCURS 150 TIMES. 01 INPUT-STRUC-NAME-NULL REDEFINES INPUT-STRUC-NUL. EXEC SQL INCLUDE XS2853R END-EXEC.

01 INPUT-STRUC-NUL-PRIOR. 10 NUL-IND PIC S9(4) COMP OCCURS 100 TIMES. 01 INPUT-STRUC-NAME-NULL-PRIOR REDEFINES INPUT-STRUC-NUL-PRIOR. EXEC SQL INCLUDE XS2853RP END-EXEC. EXEC SQL INCLUDE SQLCA END-EXEC. PROCEDURE DIVISION. 0000-MAINLINE. DISPLAY ' '. DISPLAY ' '. PERFORM 1000-OPEN-FILES. PERFORM 2000-GET-INVALS-AND-FIRST-REC. PERFORM 3000-MAIN UNTIL EOF-INPUT. PERFORM 10000-TERM. 1000-OPEN-FILES. OPEN INPUT INPUT-FILE. MOVE 'OPENING INPUT KEYS FILE ' TO WS-MSSG-REASON. PERFORM 8200-FILE-STATUS. OPEN INPUT VALUATION-DATES. MOVE 'OPENING VALUATION-DATES ' TO WS-MSSG-REASON. PERFORM 8200-FILE-STATUS. OPEN OUTPUT OUTPUT-CHG. MOVE 'OPENING OUTPUT CHG FILE ' TO WS-MSSG-REASON. PERFORM 8200-FILE-STATUS. OPEN OUTPUT OUTPUT-REFRESH-CUST. MOVE 'OPENING OUTPUT REF CUST FILE ' TO WS-MSSG-REASON. PERFORM 8200-FILE-STATUS. OPEN OUTPUT OUTPUT-REFRESH-CLM. MOVE 'OPENING OUTPUT REF CLM FILE ' TO WS-MSSG-REASON. PERFORM 8200-FILE-STATUS. OPEN OUTPUT OUTPUT-NO-CUST. MOVE 'OPENING OUTPUT NO CUST FILE' TO WS-MSSG-REASON. PERFORM 8200-FILE-STATUS. OPEN OUTPUT OUTPUT-STAT-CHG. MOVE 'OPENING OUTPUT STATUS CHG FILE ' TO WS-MSSG-REASON. PERFORM 8200-FILE-STATUS. OPEN OUTPUT OUTPUT-NOHIT. MOVE 'OPENING OUTPUT NOHIT FILE ' TO WS-MSSG-REASON. PERFORM 8200-FILE-STATUS.

2000-GET-INVALS-AND-FIRST-REC. MOVE '2000-GET-INVALS' TO WS-MSSG-PARAGRAPH. READ VALUATION-DATES INTO DATETIME-VAL-PRIOR AT END MOVE '1' TO SW-EOF-INVALS. IF EOF-INVALS MOVE 'READING PRIOR INVAL ' TO WS-MSSG-REASON PERFORM 9000-ERROR END-IF. READ VALUATION-DATES INTO DATETIME-VAL-CURR AT END MOVE '1' TO SW-EOF-INVALS. IF EOF-INVALS MOVE 'READING CURR INVAL ' TO WS-MSSG-REASON PERFORM 9000-ERROR END-IF. DISPLAY ' '. DISPLAY 'INVALS USED: '. DISPLAY ' CURRENT - ' DATETIME-VAL-CURR. DISPLAY ' PRIOR - ' DATETIME-VAL-PRIOR. PERFORM 8000-READ-INPUT. 3000-MAIN. IF DATETIME-EFF OF WS-INPUT-RECORD = SPACE OR LOW-VALUE ADD 1 TO RECS-READ-REF PERFORM 3100-PROCESS-REFRESH-RECORD ELSE ADD 1 TO RECS-READ-ACT PERFORM 3200-LOCATE-PART PERFORM 3300-GET-CURRENT PERFORM 3400-GET-PRIOR END-IF. PERFORM 8000-READ-INPUT. 3100-PROCESS-REFRESH-RECORD. PERFORM 8100-INIT-INPUT. EXEC SQL INCLUDE XS2853QR END-EXEC. IF SQLCODE = SQL-OK PERFORM 7100-WRITE-OUTPUT-CHG PERFORM 7200-WRITE-OUTPUT-REFRESH-CUST PERFORM 7300-WRITE-OUTPUT-REFRESH-CLM PERFORM 7500-WRITE-OUTPUT-STAT-CHG ELSE IF SQLCODE = SQL-NOT-FOUND MOVE 4 TO RETURN-CODE DISPLAY ID-CLM OF WS-INPUT-RECORD DISPLAY 'ID_CLM NOT ON FILE OR' DISPLAY 'DATETIME_EFF STAMP HIGHER THAN CURR INVAL' PERFORM 7600-WRITE-OUTPUT-NOHIT ELSE

MOVE ' OPEN CURSOR ERROR ' TO WS-MSSG-PARAGRAPH MOVE SQLCODE TO WS-MSSG-REASON GO TO 9000-ERROR END-IF END-IF. 3200-LOCATE-PART. MOVE 'WWXCLMWT' TO ID-SOURCE OF XSPARTBL-INFO. MOVE DATETIME-EFF OF WS-INPUT-RECORD TO DATETIME-ONE OF XSPARTBL-INFO. MOVE DATETIME-EFF OF WS-INPUT-RECORD TO DATETIME-TWO OF XSPARTBL-INFO. MOVE ZEROS TO NUM-PRTT OF XSPARTBL-INFO. CALL 'XSPARTBL' USING XSPARTBL-INFO. MOVE NUM-PRTT OF XSPARTBL-INFO TO NUM-PART. 3300-GET-CURRENT. PERFORM 8100-INIT-INPUT. EXEC SQL INCLUDE XS2853QC END-EXEC. IF SQLCODE = SQL-OK PERFORM 7100-WRITE-OUTPUT-CHG ELSE IF SQLCODE = SQL-NOT-FOUND MOVE 12 TO RETURN-CODE PERFORM 7600-WRITE-OUTPUT-NOHIT MOVE ' 3300-GET-CURRENT ' TO WS-MSSG-PARAGRAPH MOVE ' ' TO WS-MSSG-REASON MOVE SQLCODE TO WS-MSSG-SQLCODE GO TO 9000-ERROR END-IF END-IF. 3400-GET-PRIOR. INITIALIZE INPUT-STRUC-PRIOR. EXEC SQL INCLUDE XS2853QP END-EXEC. IF SQLCODE = SQL-OK PERFORM 3500-PROCESS-DELTA ELSE IF SQLCODE = SQL-NOT-FOUND PERFORM 7200-WRITE-OUTPUT-REFRESH-CUST PERFORM 7500-WRITE-OUTPUT-STAT-CHG ELSE MOVE ' OPEN CURSOR ERROR ' TO WS-MSSG-PARAGRAPH MOVE SQLCODE TO WS-MSSG-REASON GO TO 9000-ERROR END-IF END-IF. 3500-PROCESS-DELTA. IF ID-CUST-PERS OF INPUT-STRUC NOT EQUAL ID-CUST-PERS OF INPUT-STRUC-PRIOR IF ID-CUST-PERS OF INPUT-STRUC = 0 PERFORM 7400-WRITE-OUTPUT-NO-CUST

ELSE PERFORM 7200-WRITE-OUTPUT-REFRESH-CUST END-IF END-IF. IF CDE-STS-CLM OF INPUT-STRUC-PRIOR NOT EQUAL CDE-STS-CLM OF INPUT-STRUC THEN PERFORM 7500-WRITE-OUTPUT-STAT-CHG END-IF. IF ((CDE-SNTV-CLM OF INPUT-STRUC NOT EQUAL CDE-SNTV-CLM OF INPUT-STRUC-PRIOR) AND (N-CDE-SNTV-CLM OF INPUT-STRUC-NAME-NULL = -1 OR CDE-SNTV-CLM OF INPUT-STRUC = SPACES)) IF ID-CUST-PERS OF INPUT-STRUC = 0 PERFORM 7400-WRITE-OUTPUT-NO-CUST ELSE PERFORM 7200-WRITE-OUTPUT-REFRESH-CUST ADD 1 TO RECS-WRITTEN-REF-CUST-SECUR PERFORM 7300-WRITE-OUTPUT-REFRESH-CLM ADD 1 TO RECS-WRITTEN-REF-CLM-SECUR END-IF END-IF. ********************************************************** * WRITE COMMANDS FOR ALL OUTPUT FILES: * * XSWCLM3,XSWCLM4,XSWCLM5,XSWCLM6,XSWCLM7,XSWCLM8 ********************************************************** 7100-WRITE-OUTPUT-CHG. MOVE CORR WS-ALL-REC-DEFAULTS TO WS-OUTPUT-CHG-REC. MOVE CORR INPUT-STRUC TO WS-OUTPUT-CHG-REC. MOVE CORR INPUT-STRUC-NAME-NULL TO WS-OUTPUT-CHG-REC. WRITE OUTPUT-CHG-REC FROM WS-OUTPUT-CHG-REC. ADD 1 TO RECS-WRITTEN-CHG. 7200-WRITE-OUTPUT-REFRESH-CUST. IF ID-CUST-PERS OF INPUT-STRUC NOT EQUAL 0 THEN INITIALIZE WS-OUTPUT-REFRESH-CUST-REC MOVE ID-CUST-PERS OF INPUT-STRUC TO WS-OUTPUT-REFRESH-CUST-REC WRITE OUTPUT-REFRESH-CUST-REC FROM WS-OUTPUT-REFRESH-CUST-REC ADD 1 TO RECS-WRITTEN-REF-CUST END-IF. 7300-WRITE-OUTPUT-REFRESH-CLM. INITIALIZE WS-OUTPUT-REFRESH-CLM-REC. MOVE ID-CLM OF INPUT-STRUC TO WS-OUTPUT-REFRESH-CLM-REC. WRITE OUTPUT-REFRESH-CLM-REC FROM WS-OUTPUT-REFRESH-CLM-REC.

ADD 1 TO RECS-WRITTEN-REF-CLM. 7400-WRITE-OUTPUT-NO-CUST. INITIALIZE WS-OUTPUT-NO-CUST-REC. MOVE CORR WS-INPUT-RECORD TO WS-OUTPUT-NO-CUST-REC. WRITE OUTPUT-NO-CUST-REC FROM WS-OUTPUT-NO-CUST-REC. ADD 1 TO RECS-WRITTEN-NO-CUST. 7500-WRITE-OUTPUT-STAT-CHG. INITIALIZE WS-OUTPUT-STAT-CHG-REC. MOVE 1 TO CHAR-SWITCH-5 OF WS-OUTPUT-STAT-CHG-REC. MOVE CORR WS-INPUT-RECORD TO WS-OUTPUT-STAT-CHG-REC. WRITE OUTPUT-STAT-CHG-REC FROM WS-OUTPUT-STAT-CHG-REC. ADD 1 TO RECS-WRITTEN-STAT-CHG. 7600-WRITE-OUTPUT-NOHIT. INITIALIZE WS-OUTPUT-NOHIT-REC. MOVE CORR WS-INPUT-RECORD TO WS-OUTPUT-NOHIT-REC. WRITE OUTPUT-NOHIT-REC FROM WS-OUTPUT-NOHIT-REC. DISPLAY ' NO HIT OCCURRED, BROWSE FILE TO VALIDATE'. ADD 1 TO RECS-WRITTEN-NOHIT. / 8000-READ-INPUT. READ INPUT-FILE INTO WS-INPUT-RECORD AT END MOVE '1' TO SW-EOF-INPUT. IF NOT EOF-INPUT ADD 1 TO RECS-READ END-IF. / 8100-INIT-INPUT. INITIALIZE INPUT-STRUC. INITIALIZE INPUT-STRUC-NUL REPLACING NUMERIC BY -1. 8200-FILE-STATUS. ******************************** ** CHECK FOR I/O FILE ERRORS ******************************** IF FILE-STATUS NOT = '00' MOVE '8200-FILE-STATUS' TO WS-MSSG-PARAGRAPH PERFORM 9000-ERROR. / 9000-ERROR. DISPLAY WS-MSSG-PARAGRAPH. DISPLAY WS-MSSG-REASON. DISPLAY WS-MSSG-SQLCODE. DISPLAY 'ABNORMAL END TO PROGRAM OCCURRED'. PERFORM 10000-TERM. 10000-TERM.

DISPLAY ' '. DISPLAY ' PROGRAM XS2853# TERMINATION INFORMATION'. DISPLAY ' '. DISPLAY ' RECORDS READ: ' DISPLAY ' ACTIVITY : ', RECS-READ-ACT. DISPLAY ' REFRESH : ', RECS-READ-REF. DISPLAY ' TOTAL : ', RECS-READ. DISPLAY ' RECORDS WRITTEN :' DISPLAY ' OUT CHANGE : ', RECS-WRITTEN-CHG. DISPLAY ' REF CUSTOMER : ', RECS-WRITTEN-REF-CUST. DISPLAY ' REF CUST SECUR CLM: ', RECS-WRITTEN-REF-CUST-SECUR. DISPLAY ' REF CLAIM : ', RECS-WRITTEN-REF-CLM. DISPLAY ' REF CLM SECUR CLM : ', RECS-WRITTEN-REF-CLM-SECUR. DISPLAY ' NO CUSTOMER : ', RECS-WRITTEN-NO-CUST. DISPLAY ' STATUS CHANGE : ', RECS-WRITTEN-STAT-CHG. DISPLAY ' NO HIT : ', RECS-WRITTEN-NOHIT. DISPLAY ' '. CLOSE INPUT-FILE, VALUATION-DATES, OUTPUT-CHG, OUTPUT-REFRESH-CUST, OUTPUT-REFRESH-CLM, OUTPUT-NO-CUST, OUTPUT-STAT-CHG. GOBACK.

You might also like