Code:
IDENTIFICATION DIVISION.
PROGRAM-ID. P6WJR011.
AUTHOR. WILLIAM RADY.
*****************************************************************
* PROGRAM NAME: P6WJR011 *
*---------------------------------------------------------------*
* *
*---------------------------------------------------------------*
* 09/2009 WJR - PROGRAM WAS CREATED. *
*****************************************************************
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT FIP55-NATFEDCD-INPUT ASSIGN TO FIP55NFC.
SELECT FIP55-NATFEDCD-VALID ASSIGN TO FIP55VAL.
SELECT FIP55-NATFEDCD-ERROR ASSIGN TO FIP55ERR.
SELECT P6WJR010-CONTROL-DATA ASSIGN TO P6WJR010.
SELECT P6WJR011-CONTROL-DATA ASSIGN TO P6WJR011.
SELECT P6WJR11A-CONTROL-DATA ASSIGN TO P6WJR11A.
DATA DIVISION.
FILE SECTION.
FD FIP55-NATFEDCD-INPUT
LABEL RECORD IS STANDARD
RECORD CONTAINS 350 CHARACTERS
RECORDING MODE IS F
BLOCK CONTAINS 0 RECORDS
DATA RECORD FIP55-NATFEDCD-RECORD.
01 FIP55-NATFEDCD-RECORD PIC X(0350).
FD FIP55-NATFEDCD-VALID
LABEL RECORD IS STANDARD
RECORD CONTAINS 229 CHARACTERS
RECORDING MODE IS F
BLOCK CONTAINS 0 RECORDS
DATA RECORD FIP55-NATFEDCD-VAL-REC.
01 FIP55-NATFEDCD-VAL-REC PIC X(0229).
FD FIP55-NATFEDCD-ERROR
LABEL RECORD IS STANDARD
RECORD CONTAINS 380 CHARACTERS
RECORDING MODE IS F
BLOCK CONTAINS 0 RECORDS
DATA RECORD FIP55-NATFEDCD-ERR-REC.
01 FIP55-NATFEDCD-ERR-REC PIC X(0380).
FD P6WJR010-CONTROL-DATA
LABEL RECORD IS STANDARD
RECORDING MODE IS F
BLOCK CONTAINS 0 RECORDS
RECORD CONTAINS 26 CHARACTERS
DATA RECORD IS P6WJR010-DATA-RECORD.
01 P6WJR010-DATA-RECORD PIC X(0026).
FD P6WJR011-CONTROL-DATA
LABEL RECORD IS STANDARD
RECORDING MODE IS F
BLOCK CONTAINS 0 RECORDS
RECORD CONTAINS 26 CHARACTERS
DATA RECORD IS P6WJR011-DATA-RECORD.
01 P6WJR011-DATA-RECORD PIC X(0026).
FD P6WJR11A-CONTROL-DATA
LABEL RECORD IS STANDARD
RECORDING MODE IS F
BLOCK CONTAINS 0 RECORDS
RECORD CONTAINS 26 CHARACTERS
DATA RECORD IS P6WJR11A-DATA-RECORD.
01 P6WJR11A-DATA-RECORD PIC X(0026).
WORKING-STORAGE SECTION.
*********************************************************
* COPYBOOK *
*********************************************************
COPY C6WJR010.
COPY C6WJR011.
COPY C6WJR11A.
*********************************************************
* END OF COPYBOOK SECTION. *
*********************************************************
* EXEC SQL
* DECLARE FIPS55 CURSOR WITH ROWSET POSITIONING FOR
* SELECT DISTINCT WJR00000_FIPS_STCD,
* WJR00000_FIPS_CNTY,
* WJR00000_FIPS_PLAC
* FROM WJR00000_FIPS55
* GROUP BY WJR00000_FIPS_STCD,
* WJR00000_FIPS_CNTY,
* WJR00000_FIPS_PLAC
* END-EXEC.
* EXEC SQL
* DECLARE FIPS551 CURSOR WITH ROWSET POSITIONING FOR
* SELECT DISTINCT WJR00000_FIPS_STCD,
* WJR00000_FIPS_CNTY
* FROM WJR00000_FIPS55
* GROUP BY WJR00000_FIPS_STCD,
* WJR00000_FIPS_CNTY
* END-EXEC.
EXEC SQL
DECLARE FIPS552 SCROLL CURSOR FOR
SELECT DISTINCT WJR00000_FIPS_STCD
FROM WJR00000_FIPS55
GROUP BY WJR00000_FIPS_STCD
END-EXEC.
01 SQLCA.
05 SQLCAID PIC X(08).
05 SQLCABC PIC S9(09) COMP-4.
05 SQLCODE PIC S9(09) COMP-4.
05 SQLERRM.
49 SQLERRML PIC S9(04) COMP-4.
49 SQLERRMC PIC X(70).
05 SQLERRP PIC X(08).
05 SQLERRD OCCURS 6 TIMES
PIC S9(09) COMP-4.
05 SQLERRM.
10 SQLWARN0 PIC X(01).
10 SQLWARN1 PIC X(01).
10 SQLWARN2 PIC X(01).
10 SQLWARN3 PIC X(01).
10 SQLWARN4 PIC X(01).
10 SQLWARN5 PIC X(01).
10 SQLWARN6 PIC X(01).
10 SQLWARN7 PIC X(01).
05 SQLEXT.
10 SQLWARN8 PIC X(01).
10 SQLWARN9 PIC X(01).
10 SQLWARNA PIC X(01).
10 SQLSTATE PIC X(05).
01 WS000-PROGRAM-SWITCHES.
05 WS000-END-OF-FILE PIC X(0001) VALUE 'N'.
05 WS000-END-OF-FIP55 PIC X(0001) VALUE 'N'.
05 WS000-END-OF-FIP551 PIC X(0001) VALUE 'N'.
05 WS000-END-OF-FIP552 PIC X(0001) VALUE 'N'.
05 WS000-ERROR-001 PIC X(0001) VALUE 'N'.
01 WS001-PROGRAM-ACCUMULATORS.
05 WS001-TOTAL-RECORDS-READ PIC S9(009) COMP-3 VALUE +0.
05 WS001-TOTAL-RECORDS-VALID PIC S9(009) COMP-3 VALUE +0.
05 WS001-TOTAL-RECORDS-ERROR PIC S9(009) COMP-3 VALUE +0.
05 WS001-ERROR-001 PIC S9(009) COMP-3 VALUE +0.
05 WS001-ERROR-002 PIC S9(009) COMP-3 VALUE +0.
05 WS001-ERROR-003 PIC S9(009) COMP-3 VALUE +0.
05 WS001-ERROR-COUNT PIC S9(002) COMP-3 VALUE +0.
01 WS002-PROGRAM-DISPLAY-AREA.
05 WS002-TOTAL-RECORDS-READ PIC -ZZZ,ZZZ,ZZ9.
05 WS002-TOTAL-RECORDS-VALID PIC -ZZZ,ZZZ,ZZ9.
05 WS002-TOTAL-RECORDS-ERROR PIC -ZZZ,ZZZ,ZZ9.
05 WS002-ERROR-001 PIC -ZZZ,ZZZ,ZZ9.
05 WS002-ERROR-002 PIC -ZZZ,ZZZ,ZZ9.
05 WS002-ERROR-003 PIC -ZZZ,ZZZ,ZZ9.
05 WS002-SQLERROR-CODE PIC -ZZZ,ZZZ,ZZ9.
01 WS003-P6WJR010-CONTROL-RECORD.
05 WS003-JOBNAME PIC X(008).
05 WS003-BAL-IND PIC X(001).
05 WS003-RUNDATE PIC X(012).
05 WS003-JOB-TOTALS PIC S9(009) COMP-3 VALUE +0.
01 WS004-P6WJR011-CONTROL-RECORD.
05 WS004-JOBNAME PIC X(008) VALUE 'J6WJR011'.
05 WS004-BAL-IND PIC X(001).
05 WS004-RUNDATE PIC X(012).
05 WS004-JOB-TOTALS PIC S9(009) COMP-3 VALUE +0.
01 WS005-FIPS55-RECORD.
05 WS005-FIPS55-STCD PIC X(002).
05 WS005-FIPS55-CNTY PIC X(003).
05 WS005-FIPS55-PLAC PIC X(005).
01 WS006-FIPS551-RECORD.
05 WS006-FIPS55-STCD PIC X(002).
05 WS006-FIPS55-CNTY PIC X(003).
01 WS007-FIPS552-RECORD.
05 WS007-FIPS55-STCD PIC X(002).
PROCEDURE DIVISION.
P0000-BEGIN-PROCESSING.
PERFORM P1000-PROGRAM-INITIALIZATION THRU P1000-EXIT.
PERFORM P2000-PROGRAM-PROCESS THRU P2000-EXIT
UNTIL WS000-END-OF-FILE EQUAL 'Y'.
PERFORM P3000-PROGRAM-TERMINATION THRU P3000-EXIT.
STOP RUN.
P0000-EXIT.
EXIT.
P1000-PROGRAM-INITIALIZATION.
PERFORM P1001-OPEN-FILE THRU P1001-EXIT.
PERFORM P1002-OPEN-FIP55 THRU P1002-EXIT.
PERFORM P9000-READ-INPUT-FILE THRU P9000-EXIT.
* PERFORM P9001-FETCH-FIP55 THRU P9001-EXIT.
* PERFORM P9002-FETCH-FIP551 THRU P9002-EXIT.
P1000-EXIT.
EXIT.
P1001-OPEN-FILE.
OPEN INPUT FIP55-NATFEDCD-INPUT.
OPEN INPUT P6WJR010-CONTROL-DATA.
OPEN OUTPUT FIP55-NATFEDCD-VALID.
OPEN OUTPUT FIP55-NATFEDCD-ERROR.
OPEN OUTPUT P6WJR011-CONTROL-DATA.
OPEN OUTPUT P6WJR11A-CONTROL-DATA.
P1001-EXIT.
EXIT.
P1002-OPEN-FIP55.
* EXEC SQL
* OPEN FIPS55
* END-EXEC.
* EXEC SQL
* OPEN FIPS551
* END-EXEC.
EXEC SQL
OPEN FIPS552
END-EXEC.
P1002-EXIT.
EXIT.
P2000-PROGRAM-PROCESS.
ADD +1 TO WS001-TOTAL-RECORDS-READ.
MOVE +0 TO WS001-ERROR-COUNT.
***************************************************************
* THE FIRST SET OF EDITS TO BE PERFORMED ARE AGAINST THE *
* FIPS55 DB2 TABLE. THE FOLLOWING WILL BE THE RESULTING ERROR *
* CODES: *
* 001 - INVALID STATE CODE; INPUT C6WJR010-STATE-NUMERIC WAS *
* NOT FOUND IN THE FIPS55 TABLE. *
* 002 - INVALID COUNTY CODE; INPUT C6WJR010-COUNTY-NUMERIC WAS*
* NOT FOUND IN THE FIPS55 TABLE. *
* 003 - INVALID FIPS55 PLACE; INPUT C6WJR010-CENSUS-CODE WAS *
* NOT FOUND IN THE FIPS55 TABLE. *
***************************************************************
PERFORM P2003-FIPS55-EDIT THRU P2003-EXIT.
IF WS001-ERROR-COUNT EQUAL +0
PERFORM P2001-WRITE-VALID-RECORD THRU P2001-EXIT
ELSE
PERFORM P2002-WRITE-ERROR-RECORD THRU P2002-EXIT.
PERFORM P9000-READ-INPUT-FILE THRU P9000-EXIT.
P2000-EXIT.
EXIT.
P2001-WRITE-VALID-RECORD.
MOVE C6WJR010-FEATURE-ID TO C6WJR011-FEATURE-ID.
MOVE C6WJR010-FEATURE-NAME TO C6WJR011-FEATURE-NAME.
MOVE C6WJR010-FEATURE-CLASS TO C6WJR011-FEATURE-CLASS.
MOVE C6WJR010-CENSUS-CODE TO C6WJR011-CENSUS-CODE.
MOVE C6WJR010-CENSUS-CLASS-CODE TO
C6WJR011-CENSUS-CLASS-CODE.
MOVE C6WJR010-GSA-CODE TO C6WJR011-GSA-CODE.
MOVE C6WJR010-OPM-CODE TO C6WJR011-OPM-CODE.
MOVE C6WJR010-STATE-NUMERIC TO
C6WJR011-STATE-NUMERIC.
MOVE C6WJR010-COUNTY-SEQUENCE TO
C6WJR011-COUNTY-SEQUENCE.
MOVE C6WJR010-COUNTY-NUMERIC TO
C6WJR011-COUNTY-NUMERIC.
MOVE C6WJR010-PRIMARY-LAT TO
C6WJR011-PRIMARY-LAT.
MOVE C6WJR010-PRIMARY-LON TO
C6WJR011-PRIMARY-LON.
MOVE C6WJR010-DATE-CREATED TO
C6WJR011-DATE-CREATED.
MOVE C6WJR010-DATE-EDITED TO
C6WJR011-DATE-EDITED.
ADD +1 TO WS001-TOTAL-RECORDS-VALID.
WRITE FIP55-NATFEDCD-VAL-REC FROM C6WJR011-RECORD.
P2001-EXIT.
EXIT.
P2002-WRITE-ERROR-RECORD.
MOVE C6WJR010-FEATURE-ID TO C6WJR11A-FEATURE-ID.
MOVE C6WJR010-FEATURE-NAME TO C6WJR11A-FEATURE-NAME.
MOVE C6WJR010-FEATURE-CLASS TO C6WJR11A-FEATURE-CLASS.
MOVE C6WJR010-CENSUS-CODE TO C6WJR11A-CENSUS-CODE.
MOVE C6WJR010-CENSUS-CLASS-CODE TO
C6WJR11A-CENSUS-CLASS-CODE.
MOVE C6WJR010-GSA-CODE TO C6WJR11A-GSA-CODE.
MOVE C6WJR010-OPM-CODE TO C6WJR11A-OPM-CODE.
MOVE C6WJR010-STATE-NUMERIC TO
C6WJR11A-STATE-NUMERIC.
MOVE C6WJR010-STATE-ALPHA TO
C6WJR11A-STATE-ALPHA.
MOVE C6WJR010-COUNTY-SEQUENCE TO
C6WJR11A-COUNTY-SEQUENCE.
MOVE C6WJR010-COUNTY-NUMERIC TO
C6WJR11A-COUNTY-NUMERIC.
MOVE C6WJR010-COUNTY-NAME TO
C6WJR11A-COUNTY-NAME.
MOVE C6WJR010-PRIMARY-LAT TO
C6WJR11A-PRIMARY-LAT.
MOVE C6WJR010-PRIMARY-LON TO
C6WJR11A-PRIMARY-LON.
MOVE C6WJR010-DATE-CREATED TO
C6WJR11A-DATE-CREATED.
MOVE C6WJR010-DATE-EDITED TO
C6WJR11A-DATE-EDITED.
ADD +1 TO WS001-TOTAL-RECORDS-ERROR.
WRITE FIP55-NATFEDCD-ERR-REC FROM C6WJR11A-RECORD.
P2002-EXIT.
EXIT.
P2003-FIPS55-EDIT.
*EDIT 001
MOVE 'N' TO WS000-END-OF-FIP552.
MOVE 'N' TO WS000-ERROR-001.
PERFORM P9003-FETCH-FIP552 THRU P9003-EXIT.
PERFORM P2004-EDIT-001 THRU P2004-EXIT
UNTIL WS000-END-OF-FIP552 EQUAL 'Y' OR
WS000-ERROR-001 EQUAL 'Y'.
IF WS000-ERROR-001 EQUAL 'N'
ADD +1 TO WS001-ERROR-COUNT
MOVE '001' TO C6WJR11A-ERROR-CODE (WS001-ERROR-COUNT)
ELSE
NEXT SENTENCE.
*EDIT 002
* IF WS001-ERROR-COUNT EQUAL +0
* PERFORM P9002-FETCH-FIP551 THRU P9002-EXIT
* IF WS000-END-OF-FIP55 EQUAL 'Y'
* ADD +1 TO WS001-ERROR-COUNT
* MOVE '002' TO C6WJR11A-ERROR-CODE (WS001-ERROR-COUNT)
* ELSE
* NEXT SENTENCE
* ELSE
* NEXT SENTENCE.
*EDIT 003
* IF WS001-ERROR-COUNT EQUAL +0
* PERFORM P9001-FETCH-FIP55 THRU P9001-EXIT
* IF WS000-END-OF-FIP55 EQUAL 'Y'
* ADD +1 TO WS001-ERROR-COUNT
* MOVE '003' TO C6WJR11A-ERROR-CODE (WS001-ERROR-COUNT)
* ELSE
* NEXT SENTENCE
* ELSE
* NEXT SENTENCE.
* PERFORM P3004-CLOSE-FIP55 THRU P3004-EXIT.
P2003-EXIT.
EXIT.
P2004-EDIT-001.
IF C6WJR010-STATE-NUMERIC EQUAL WS007-FIPS55-STCD
MOVE 'Y' TO WS000-ERROR-001
GO TO P2004-EXIT.
PERFORM P9003-FETCH-FIP552 THRU P9003-EXIT.
P2004-EXIT.
EXIT.
P3000-PROGRAM-TERMINATION.
PERFORM P3001-DISPLAY-CONTROLS THRU P3001-EXIT.
PERFORM P3002-WRITE-CONTROL THRU P3002-EXIT.
PERFORM P302A-WRITE-CONTROL THRU P302A-EXIT.
PERFORM P3003-CLOSE-FILES THRU P3003-EXIT.
PERFORM P3004-CLOSE-FIP55 THRU P3004-EXIT.
P3000-EXIT.
EXIT.
P3001-DISPLAY-CONTROLS.
MOVE WS001-TOTAL-RECORDS-READ TO WS002-TOTAL-RECORDS-READ.
MOVE WS001-TOTAL-RECORDS-VALID TO
WS002-TOTAL-RECORDS-VALID.
MOVE WS001-TOTAL-RECORDS-ERROR TO
WS002-TOTAL-RECORDS-ERROR.
DISPLAY 'J6WJR011 CONTROL REPORT'.
DISPLAY ' '.
DISPLAY ' TOTAL RECORDS READ: ',
WS002-TOTAL-RECORDS-READ.
DISPLAY ' TOTAL RECORDS VALID: ',
WS002-TOTAL-RECORDS-VALID.
DISPLAY 'TOTAL RECORDS IN ERROR: ',
WS002-TOTAL-RECORDS-ERROR.
IF (WS001-TOTAL-RECORDS-VALID +
WS001-TOTAL-RECORDS-ERROR) EQUAL
WS001-TOTAL-RECORDS-READ
DISPLAY 'JOB J6WJR011 BALANCED'
ELSE
MOVE '0' TO WS004-BAL-IND
DISPLAY 'JOB J6WJR011 IS OUT OF BALANCE'.
DISPLAY ' '.
DISPLAY '********************************************'.
DISPLAY '* JOB TO JOB BALANCING *'.
DISPLAY '********************************************'.
DISPLAY ' '.
IF WS001-TOTAL-RECORDS-READ EQUAL
WS003-JOB-TOTALS
DISPLAY 'JOB J6WJR011 BALANCES WITH J6WJR010'
ELSE
DISPLAY 'JOB J6WJR011 IS OUT OF BALANCE WITH J6WJR010'
MOVE '0' TO WS004-BAL-IND.
P3001-EXIT.
EXIT.
P3002-WRITE-CONTROL.
MOVE FUNCTION CURRENT-DATE TO WS004-RUNDATE.
MOVE WS001-TOTAL-RECORDS-VALID TO WS004-JOB-TOTALS.
WRITE P6WJR011-DATA-RECORD FROM
WS004-P6WJR011-CONTROL-RECORD.
P3002-EXIT.
EXIT.
P302A-WRITE-CONTROL.
MOVE FUNCTION CURRENT-DATE TO WS004-RUNDATE.
MOVE WS001-TOTAL-RECORDS-ERROR TO WS004-JOB-TOTALS.
WRITE P6WJR11A-DATA-RECORD FROM
WS004-P6WJR011-CONTROL-RECORD.
P302A-EXIT.
EXIT.
P3003-CLOSE-FILES.
CLOSE FIP55-NATFEDCD-INPUT.
CLOSE FIP55-NATFEDCD-ERROR.
CLOSE FIP55-NATFEDCD-VALID.
CLOSE P6WJR010-CONTROL-DATA.
CLOSE P6WJR011-CONTROL-DATA.
CLOSE P6WJR11A-CONTROL-DATA.
P3003-EXIT.
EXIT.
P3004-CLOSE-FIP55.
* EXEC SQL
* CLOSE FIPS55
* END-EXEC.
* EXEC SQL
* CLOSE FIPS551
* END-EXEC.
EXEC SQL
CLOSE FIPS552
END-EXEC.
P3004-EXIT.
EXIT.
P9000-READ-INPUT-FILE.
READ FIP55-NATFEDCD-INPUT
INTO C6WJR010-RECORD
AT END MOVE 'Y' TO WS000-END-OF-FILE.
P9000-EXIT.
EXIT.
P9001-FETCH-FIP55.
EXEC SQL
FETCH FIPS55
INTO :WS005-FIPS55-STCD,
:WS005-FIPS55-CNTY,
:WS005-FIPS55-PLAC
END-EXEC.
IF SQLCODE EQUAL 0
GO TO P9001-EXIT.
IF SQLCODE EQUAL 100
MOVE 'Y' TO WS000-END-OF-FIP55
GO TO P9001-EXIT.
DISPLAY 'SQL ERROR: ', SQLCODE.
MOVE 'Y' TO WS000-END-OF-FIP55.
P9001-EXIT.
EXIT.
P9002-FETCH-FIP551.
EXEC SQL
FETCH FIPS551
INTO :WS006-FIPS55-STCD,
:WS006-FIPS55-CNTY
END-EXEC.
IF SQLCODE EQUAL 0
GO TO P9002-EXIT.
IF SQLCODE EQUAL 100
MOVE 'Y' TO WS000-END-OF-FIP55
GO TO P9002-EXIT.
DISPLAY 'SQL ERROR: ', SQLCODE.
MOVE 'Y' TO WS000-END-OF-FIP55.
P9002-EXIT.
EXIT.
P9003-FETCH-FIP552.
EXEC SQL
FETCH FIPS552
INTO :WS007-FIPS55-STCD
END-EXEC.
IF SQLCODE EQUAL 0
GO TO P9003-EXIT.
IF SQLCODE EQUAL 100
MOVE 'Y' TO WS000-END-OF-FIP552
GO TO P9003-EXIT.
MOVE SQLCODE TO WS002-SQLERROR-CODE.
DISPLAY 'SQL ERROR: ', WS002-SQLERROR-CODE.
MOVE 'Y' TO WS000-END-OF-FIP552.
P9003-EXIT.
EXIT.
PROGRAM-ID. P6WJR011.
AUTHOR. WILLIAM RADY.
*****************************************************************
* PROGRAM NAME: P6WJR011 *
*---------------------------------------------------------------*
* *
*---------------------------------------------------------------*
* 09/2009 WJR - PROGRAM WAS CREATED. *
*****************************************************************
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT FIP55-NATFEDCD-INPUT ASSIGN TO FIP55NFC.
SELECT FIP55-NATFEDCD-VALID ASSIGN TO FIP55VAL.
SELECT FIP55-NATFEDCD-ERROR ASSIGN TO FIP55ERR.
SELECT P6WJR010-CONTROL-DATA ASSIGN TO P6WJR010.
SELECT P6WJR011-CONTROL-DATA ASSIGN TO P6WJR011.
SELECT P6WJR11A-CONTROL-DATA ASSIGN TO P6WJR11A.
DATA DIVISION.
FILE SECTION.
FD FIP55-NATFEDCD-INPUT
LABEL RECORD IS STANDARD
RECORD CONTAINS 350 CHARACTERS
RECORDING MODE IS F
BLOCK CONTAINS 0 RECORDS
DATA RECORD FIP55-NATFEDCD-RECORD.
01 FIP55-NATFEDCD-RECORD PIC X(0350).
FD FIP55-NATFEDCD-VALID
LABEL RECORD IS STANDARD
RECORD CONTAINS 229 CHARACTERS
RECORDING MODE IS F
BLOCK CONTAINS 0 RECORDS
DATA RECORD FIP55-NATFEDCD-VAL-REC.
01 FIP55-NATFEDCD-VAL-REC PIC X(0229).
FD FIP55-NATFEDCD-ERROR
LABEL RECORD IS STANDARD
RECORD CONTAINS 380 CHARACTERS
RECORDING MODE IS F
BLOCK CONTAINS 0 RECORDS
DATA RECORD FIP55-NATFEDCD-ERR-REC.
01 FIP55-NATFEDCD-ERR-REC PIC X(0380).
FD P6WJR010-CONTROL-DATA
LABEL RECORD IS STANDARD
RECORDING MODE IS F
BLOCK CONTAINS 0 RECORDS
RECORD CONTAINS 26 CHARACTERS
DATA RECORD IS P6WJR010-DATA-RECORD.
01 P6WJR010-DATA-RECORD PIC X(0026).
FD P6WJR011-CONTROL-DATA
LABEL RECORD IS STANDARD
RECORDING MODE IS F
BLOCK CONTAINS 0 RECORDS
RECORD CONTAINS 26 CHARACTERS
DATA RECORD IS P6WJR011-DATA-RECORD.
01 P6WJR011-DATA-RECORD PIC X(0026).
FD P6WJR11A-CONTROL-DATA
LABEL RECORD IS STANDARD
RECORDING MODE IS F
BLOCK CONTAINS 0 RECORDS
RECORD CONTAINS 26 CHARACTERS
DATA RECORD IS P6WJR11A-DATA-RECORD.
01 P6WJR11A-DATA-RECORD PIC X(0026).
WORKING-STORAGE SECTION.
*********************************************************
* COPYBOOK *
*********************************************************
COPY C6WJR010.
COPY C6WJR011.
COPY C6WJR11A.
*********************************************************
* END OF COPYBOOK SECTION. *
*********************************************************
* EXEC SQL
* DECLARE FIPS55 CURSOR WITH ROWSET POSITIONING FOR
* SELECT DISTINCT WJR00000_FIPS_STCD,
* WJR00000_FIPS_CNTY,
* WJR00000_FIPS_PLAC
* FROM WJR00000_FIPS55
* GROUP BY WJR00000_FIPS_STCD,
* WJR00000_FIPS_CNTY,
* WJR00000_FIPS_PLAC
* END-EXEC.
* EXEC SQL
* DECLARE FIPS551 CURSOR WITH ROWSET POSITIONING FOR
* SELECT DISTINCT WJR00000_FIPS_STCD,
* WJR00000_FIPS_CNTY
* FROM WJR00000_FIPS55
* GROUP BY WJR00000_FIPS_STCD,
* WJR00000_FIPS_CNTY
* END-EXEC.
EXEC SQL
DECLARE FIPS552 SCROLL CURSOR FOR
SELECT DISTINCT WJR00000_FIPS_STCD
FROM WJR00000_FIPS55
GROUP BY WJR00000_FIPS_STCD
END-EXEC.
01 SQLCA.
05 SQLCAID PIC X(08).
05 SQLCABC PIC S9(09) COMP-4.
05 SQLCODE PIC S9(09) COMP-4.
05 SQLERRM.
49 SQLERRML PIC S9(04) COMP-4.
49 SQLERRMC PIC X(70).
05 SQLERRP PIC X(08).
05 SQLERRD OCCURS 6 TIMES
PIC S9(09) COMP-4.
05 SQLERRM.
10 SQLWARN0 PIC X(01).
10 SQLWARN1 PIC X(01).
10 SQLWARN2 PIC X(01).
10 SQLWARN3 PIC X(01).
10 SQLWARN4 PIC X(01).
10 SQLWARN5 PIC X(01).
10 SQLWARN6 PIC X(01).
10 SQLWARN7 PIC X(01).
05 SQLEXT.
10 SQLWARN8 PIC X(01).
10 SQLWARN9 PIC X(01).
10 SQLWARNA PIC X(01).
10 SQLSTATE PIC X(05).
01 WS000-PROGRAM-SWITCHES.
05 WS000-END-OF-FILE PIC X(0001) VALUE 'N'.
05 WS000-END-OF-FIP55 PIC X(0001) VALUE 'N'.
05 WS000-END-OF-FIP551 PIC X(0001) VALUE 'N'.
05 WS000-END-OF-FIP552 PIC X(0001) VALUE 'N'.
05 WS000-ERROR-001 PIC X(0001) VALUE 'N'.
01 WS001-PROGRAM-ACCUMULATORS.
05 WS001-TOTAL-RECORDS-READ PIC S9(009) COMP-3 VALUE +0.
05 WS001-TOTAL-RECORDS-VALID PIC S9(009) COMP-3 VALUE +0.
05 WS001-TOTAL-RECORDS-ERROR PIC S9(009) COMP-3 VALUE +0.
05 WS001-ERROR-001 PIC S9(009) COMP-3 VALUE +0.
05 WS001-ERROR-002 PIC S9(009) COMP-3 VALUE +0.
05 WS001-ERROR-003 PIC S9(009) COMP-3 VALUE +0.
05 WS001-ERROR-COUNT PIC S9(002) COMP-3 VALUE +0.
01 WS002-PROGRAM-DISPLAY-AREA.
05 WS002-TOTAL-RECORDS-READ PIC -ZZZ,ZZZ,ZZ9.
05 WS002-TOTAL-RECORDS-VALID PIC -ZZZ,ZZZ,ZZ9.
05 WS002-TOTAL-RECORDS-ERROR PIC -ZZZ,ZZZ,ZZ9.
05 WS002-ERROR-001 PIC -ZZZ,ZZZ,ZZ9.
05 WS002-ERROR-002 PIC -ZZZ,ZZZ,ZZ9.
05 WS002-ERROR-003 PIC -ZZZ,ZZZ,ZZ9.
05 WS002-SQLERROR-CODE PIC -ZZZ,ZZZ,ZZ9.
01 WS003-P6WJR010-CONTROL-RECORD.
05 WS003-JOBNAME PIC X(008).
05 WS003-BAL-IND PIC X(001).
05 WS003-RUNDATE PIC X(012).
05 WS003-JOB-TOTALS PIC S9(009) COMP-3 VALUE +0.
01 WS004-P6WJR011-CONTROL-RECORD.
05 WS004-JOBNAME PIC X(008) VALUE 'J6WJR011'.
05 WS004-BAL-IND PIC X(001).
05 WS004-RUNDATE PIC X(012).
05 WS004-JOB-TOTALS PIC S9(009) COMP-3 VALUE +0.
01 WS005-FIPS55-RECORD.
05 WS005-FIPS55-STCD PIC X(002).
05 WS005-FIPS55-CNTY PIC X(003).
05 WS005-FIPS55-PLAC PIC X(005).
01 WS006-FIPS551-RECORD.
05 WS006-FIPS55-STCD PIC X(002).
05 WS006-FIPS55-CNTY PIC X(003).
01 WS007-FIPS552-RECORD.
05 WS007-FIPS55-STCD PIC X(002).
PROCEDURE DIVISION.
P0000-BEGIN-PROCESSING.
PERFORM P1000-PROGRAM-INITIALIZATION THRU P1000-EXIT.
PERFORM P2000-PROGRAM-PROCESS THRU P2000-EXIT
UNTIL WS000-END-OF-FILE EQUAL 'Y'.
PERFORM P3000-PROGRAM-TERMINATION THRU P3000-EXIT.
STOP RUN.
P0000-EXIT.
EXIT.
P1000-PROGRAM-INITIALIZATION.
PERFORM P1001-OPEN-FILE THRU P1001-EXIT.
PERFORM P1002-OPEN-FIP55 THRU P1002-EXIT.
PERFORM P9000-READ-INPUT-FILE THRU P9000-EXIT.
* PERFORM P9001-FETCH-FIP55 THRU P9001-EXIT.
* PERFORM P9002-FETCH-FIP551 THRU P9002-EXIT.
P1000-EXIT.
EXIT.
P1001-OPEN-FILE.
OPEN INPUT FIP55-NATFEDCD-INPUT.
OPEN INPUT P6WJR010-CONTROL-DATA.
OPEN OUTPUT FIP55-NATFEDCD-VALID.
OPEN OUTPUT FIP55-NATFEDCD-ERROR.
OPEN OUTPUT P6WJR011-CONTROL-DATA.
OPEN OUTPUT P6WJR11A-CONTROL-DATA.
P1001-EXIT.
EXIT.
P1002-OPEN-FIP55.
* EXEC SQL
* OPEN FIPS55
* END-EXEC.
* EXEC SQL
* OPEN FIPS551
* END-EXEC.
EXEC SQL
OPEN FIPS552
END-EXEC.
P1002-EXIT.
EXIT.
P2000-PROGRAM-PROCESS.
ADD +1 TO WS001-TOTAL-RECORDS-READ.
MOVE +0 TO WS001-ERROR-COUNT.
***************************************************************
* THE FIRST SET OF EDITS TO BE PERFORMED ARE AGAINST THE *
* FIPS55 DB2 TABLE. THE FOLLOWING WILL BE THE RESULTING ERROR *
* CODES: *
* 001 - INVALID STATE CODE; INPUT C6WJR010-STATE-NUMERIC WAS *
* NOT FOUND IN THE FIPS55 TABLE. *
* 002 - INVALID COUNTY CODE; INPUT C6WJR010-COUNTY-NUMERIC WAS*
* NOT FOUND IN THE FIPS55 TABLE. *
* 003 - INVALID FIPS55 PLACE; INPUT C6WJR010-CENSUS-CODE WAS *
* NOT FOUND IN THE FIPS55 TABLE. *
***************************************************************
PERFORM P2003-FIPS55-EDIT THRU P2003-EXIT.
IF WS001-ERROR-COUNT EQUAL +0
PERFORM P2001-WRITE-VALID-RECORD THRU P2001-EXIT
ELSE
PERFORM P2002-WRITE-ERROR-RECORD THRU P2002-EXIT.
PERFORM P9000-READ-INPUT-FILE THRU P9000-EXIT.
P2000-EXIT.
EXIT.
P2001-WRITE-VALID-RECORD.
MOVE C6WJR010-FEATURE-ID TO C6WJR011-FEATURE-ID.
MOVE C6WJR010-FEATURE-NAME TO C6WJR011-FEATURE-NAME.
MOVE C6WJR010-FEATURE-CLASS TO C6WJR011-FEATURE-CLASS.
MOVE C6WJR010-CENSUS-CODE TO C6WJR011-CENSUS-CODE.
MOVE C6WJR010-CENSUS-CLASS-CODE TO
C6WJR011-CENSUS-CLASS-CODE.
MOVE C6WJR010-GSA-CODE TO C6WJR011-GSA-CODE.
MOVE C6WJR010-OPM-CODE TO C6WJR011-OPM-CODE.
MOVE C6WJR010-STATE-NUMERIC TO
C6WJR011-STATE-NUMERIC.
MOVE C6WJR010-COUNTY-SEQUENCE TO
C6WJR011-COUNTY-SEQUENCE.
MOVE C6WJR010-COUNTY-NUMERIC TO
C6WJR011-COUNTY-NUMERIC.
MOVE C6WJR010-PRIMARY-LAT TO
C6WJR011-PRIMARY-LAT.
MOVE C6WJR010-PRIMARY-LON TO
C6WJR011-PRIMARY-LON.
MOVE C6WJR010-DATE-CREATED TO
C6WJR011-DATE-CREATED.
MOVE C6WJR010-DATE-EDITED TO
C6WJR011-DATE-EDITED.
ADD +1 TO WS001-TOTAL-RECORDS-VALID.
WRITE FIP55-NATFEDCD-VAL-REC FROM C6WJR011-RECORD.
P2001-EXIT.
EXIT.
P2002-WRITE-ERROR-RECORD.
MOVE C6WJR010-FEATURE-ID TO C6WJR11A-FEATURE-ID.
MOVE C6WJR010-FEATURE-NAME TO C6WJR11A-FEATURE-NAME.
MOVE C6WJR010-FEATURE-CLASS TO C6WJR11A-FEATURE-CLASS.
MOVE C6WJR010-CENSUS-CODE TO C6WJR11A-CENSUS-CODE.
MOVE C6WJR010-CENSUS-CLASS-CODE TO
C6WJR11A-CENSUS-CLASS-CODE.
MOVE C6WJR010-GSA-CODE TO C6WJR11A-GSA-CODE.
MOVE C6WJR010-OPM-CODE TO C6WJR11A-OPM-CODE.
MOVE C6WJR010-STATE-NUMERIC TO
C6WJR11A-STATE-NUMERIC.
MOVE C6WJR010-STATE-ALPHA TO
C6WJR11A-STATE-ALPHA.
MOVE C6WJR010-COUNTY-SEQUENCE TO
C6WJR11A-COUNTY-SEQUENCE.
MOVE C6WJR010-COUNTY-NUMERIC TO
C6WJR11A-COUNTY-NUMERIC.
MOVE C6WJR010-COUNTY-NAME TO
C6WJR11A-COUNTY-NAME.
MOVE C6WJR010-PRIMARY-LAT TO
C6WJR11A-PRIMARY-LAT.
MOVE C6WJR010-PRIMARY-LON TO
C6WJR11A-PRIMARY-LON.
MOVE C6WJR010-DATE-CREATED TO
C6WJR11A-DATE-CREATED.
MOVE C6WJR010-DATE-EDITED TO
C6WJR11A-DATE-EDITED.
ADD +1 TO WS001-TOTAL-RECORDS-ERROR.
WRITE FIP55-NATFEDCD-ERR-REC FROM C6WJR11A-RECORD.
P2002-EXIT.
EXIT.
P2003-FIPS55-EDIT.
*EDIT 001
MOVE 'N' TO WS000-END-OF-FIP552.
MOVE 'N' TO WS000-ERROR-001.
PERFORM P9003-FETCH-FIP552 THRU P9003-EXIT.
PERFORM P2004-EDIT-001 THRU P2004-EXIT
UNTIL WS000-END-OF-FIP552 EQUAL 'Y' OR
WS000-ERROR-001 EQUAL 'Y'.
IF WS000-ERROR-001 EQUAL 'N'
ADD +1 TO WS001-ERROR-COUNT
MOVE '001' TO C6WJR11A-ERROR-CODE (WS001-ERROR-COUNT)
ELSE
NEXT SENTENCE.
*EDIT 002
* IF WS001-ERROR-COUNT EQUAL +0
* PERFORM P9002-FETCH-FIP551 THRU P9002-EXIT
* IF WS000-END-OF-FIP55 EQUAL 'Y'
* ADD +1 TO WS001-ERROR-COUNT
* MOVE '002' TO C6WJR11A-ERROR-CODE (WS001-ERROR-COUNT)
* ELSE
* NEXT SENTENCE
* ELSE
* NEXT SENTENCE.
*EDIT 003
* IF WS001-ERROR-COUNT EQUAL +0
* PERFORM P9001-FETCH-FIP55 THRU P9001-EXIT
* IF WS000-END-OF-FIP55 EQUAL 'Y'
* ADD +1 TO WS001-ERROR-COUNT
* MOVE '003' TO C6WJR11A-ERROR-CODE (WS001-ERROR-COUNT)
* ELSE
* NEXT SENTENCE
* ELSE
* NEXT SENTENCE.
* PERFORM P3004-CLOSE-FIP55 THRU P3004-EXIT.
P2003-EXIT.
EXIT.
P2004-EDIT-001.
IF C6WJR010-STATE-NUMERIC EQUAL WS007-FIPS55-STCD
MOVE 'Y' TO WS000-ERROR-001
GO TO P2004-EXIT.
PERFORM P9003-FETCH-FIP552 THRU P9003-EXIT.
P2004-EXIT.
EXIT.
P3000-PROGRAM-TERMINATION.
PERFORM P3001-DISPLAY-CONTROLS THRU P3001-EXIT.
PERFORM P3002-WRITE-CONTROL THRU P3002-EXIT.
PERFORM P302A-WRITE-CONTROL THRU P302A-EXIT.
PERFORM P3003-CLOSE-FILES THRU P3003-EXIT.
PERFORM P3004-CLOSE-FIP55 THRU P3004-EXIT.
P3000-EXIT.
EXIT.
P3001-DISPLAY-CONTROLS.
MOVE WS001-TOTAL-RECORDS-READ TO WS002-TOTAL-RECORDS-READ.
MOVE WS001-TOTAL-RECORDS-VALID TO
WS002-TOTAL-RECORDS-VALID.
MOVE WS001-TOTAL-RECORDS-ERROR TO
WS002-TOTAL-RECORDS-ERROR.
DISPLAY 'J6WJR011 CONTROL REPORT'.
DISPLAY ' '.
DISPLAY ' TOTAL RECORDS READ: ',
WS002-TOTAL-RECORDS-READ.
DISPLAY ' TOTAL RECORDS VALID: ',
WS002-TOTAL-RECORDS-VALID.
DISPLAY 'TOTAL RECORDS IN ERROR: ',
WS002-TOTAL-RECORDS-ERROR.
IF (WS001-TOTAL-RECORDS-VALID +
WS001-TOTAL-RECORDS-ERROR) EQUAL
WS001-TOTAL-RECORDS-READ
DISPLAY 'JOB J6WJR011 BALANCED'
ELSE
MOVE '0' TO WS004-BAL-IND
DISPLAY 'JOB J6WJR011 IS OUT OF BALANCE'.
DISPLAY ' '.
DISPLAY '********************************************'.
DISPLAY '* JOB TO JOB BALANCING *'.
DISPLAY '********************************************'.
DISPLAY ' '.
IF WS001-TOTAL-RECORDS-READ EQUAL
WS003-JOB-TOTALS
DISPLAY 'JOB J6WJR011 BALANCES WITH J6WJR010'
ELSE
DISPLAY 'JOB J6WJR011 IS OUT OF BALANCE WITH J6WJR010'
MOVE '0' TO WS004-BAL-IND.
P3001-EXIT.
EXIT.
P3002-WRITE-CONTROL.
MOVE FUNCTION CURRENT-DATE TO WS004-RUNDATE.
MOVE WS001-TOTAL-RECORDS-VALID TO WS004-JOB-TOTALS.
WRITE P6WJR011-DATA-RECORD FROM
WS004-P6WJR011-CONTROL-RECORD.
P3002-EXIT.
EXIT.
P302A-WRITE-CONTROL.
MOVE FUNCTION CURRENT-DATE TO WS004-RUNDATE.
MOVE WS001-TOTAL-RECORDS-ERROR TO WS004-JOB-TOTALS.
WRITE P6WJR11A-DATA-RECORD FROM
WS004-P6WJR011-CONTROL-RECORD.
P302A-EXIT.
EXIT.
P3003-CLOSE-FILES.
CLOSE FIP55-NATFEDCD-INPUT.
CLOSE FIP55-NATFEDCD-ERROR.
CLOSE FIP55-NATFEDCD-VALID.
CLOSE P6WJR010-CONTROL-DATA.
CLOSE P6WJR011-CONTROL-DATA.
CLOSE P6WJR11A-CONTROL-DATA.
P3003-EXIT.
EXIT.
P3004-CLOSE-FIP55.
* EXEC SQL
* CLOSE FIPS55
* END-EXEC.
* EXEC SQL
* CLOSE FIPS551
* END-EXEC.
EXEC SQL
CLOSE FIPS552
END-EXEC.
P3004-EXIT.
EXIT.
P9000-READ-INPUT-FILE.
READ FIP55-NATFEDCD-INPUT
INTO C6WJR010-RECORD
AT END MOVE 'Y' TO WS000-END-OF-FILE.
P9000-EXIT.
EXIT.
P9001-FETCH-FIP55.
EXEC SQL
FETCH FIPS55
INTO :WS005-FIPS55-STCD,
:WS005-FIPS55-CNTY,
:WS005-FIPS55-PLAC
END-EXEC.
IF SQLCODE EQUAL 0
GO TO P9001-EXIT.
IF SQLCODE EQUAL 100
MOVE 'Y' TO WS000-END-OF-FIP55
GO TO P9001-EXIT.
DISPLAY 'SQL ERROR: ', SQLCODE.
MOVE 'Y' TO WS000-END-OF-FIP55.
P9001-EXIT.
EXIT.
P9002-FETCH-FIP551.
EXEC SQL
FETCH FIPS551
INTO :WS006-FIPS55-STCD,
:WS006-FIPS55-CNTY
END-EXEC.
IF SQLCODE EQUAL 0
GO TO P9002-EXIT.
IF SQLCODE EQUAL 100
MOVE 'Y' TO WS000-END-OF-FIP55
GO TO P9002-EXIT.
DISPLAY 'SQL ERROR: ', SQLCODE.
MOVE 'Y' TO WS000-END-OF-FIP55.
P9002-EXIT.
EXIT.
P9003-FETCH-FIP552.
EXEC SQL
FETCH FIPS552
INTO :WS007-FIPS55-STCD
END-EXEC.
IF SQLCODE EQUAL 0
GO TO P9003-EXIT.
IF SQLCODE EQUAL 100
MOVE 'Y' TO WS000-END-OF-FIP552
GO TO P9003-EXIT.
MOVE SQLCODE TO WS002-SQLERROR-CODE.
DISPLAY 'SQL ERROR: ', WS002-SQLERROR-CODE.
MOVE 'Y' TO WS000-END-OF-FIP552.
P9003-EXIT.
EXIT.
No comments:
Post a Comment