IDENTIFICATION DIVISION. PROGRAM-ID. IMAGE2. AUTHOR. BILL BLASINGIM. REMARKS. THIS PROGRAM READS/SORTS THE MASTER ACCOUNT FILE AND ADDS A CHECK DIGIT IF ACCOUNT DOES NOT START WITH 005. ****************************************************** * 05/11/94 WHB 1) ADD 8 BYTE EDITED DATE TO FILE * * 2) CHANGE OUTPUT BLOCKSIZE * * FROM 411 TO 361 * ****************************************************** DATE-WRITTEN. JUL. 06, 1993. DATE-COMPILED. ENVIRONMENT DIVISION. CONFIGURATION SECTION. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT IN-FILE ASSIGN TO SYS010-DA-3380-S-INFILE. SELECT OUT-FILE ASSIGN TO SYS015-DA-3380-S-OTFILE. SELECT SORT-FILE ASSIGN TO SYS001-DA-3380-S-SORTWK1. DATA DIVISION. FILE SECTION. FD IN-FILE BLOCK CONTAINS 10 RECORDS LABEL RECORDS STANDARD. 01 IN-REC. 05 IN-OFFICE-NO PIC X(03). 05 IN-ACCOUNT-TYPE PIC X(03). 05 IN-ACCOUNT-NO. 10 IN-ACCOUNT-PREFIX. 15 IN-ACCOUNT-PREFIX-1 PIC X(01). 15 IN-ACCOUNT-PREFIX-2 PIC X(01). 15 IN-ACCOUNT-PREFIX-3 PIC X(01). 10 IN-ACCOUNT-SUFFIX PIC X(07). 05 FILLER REDEFINES IN-ACCOUNT-NO. 10 FILLER PIC X(01). 10 IN-ACCOUNT-9 PIC 9(09). 05 IN-NAME PIC X(29). 05 IN-CIF-KEY PIC X(11). 05 IN-STATUS PIC X(01). 05 IN-DATE PIC X(08). FD OUT-FILE BLOCK CONTAINS 361 RECORDS LABEL RECORDS STANDARD. 01 OUT-REC PIC X(65). SD SORT-FILE. 01 SORT-RECORD. 05 SORT-OFFICE-NO PIC X(03). 05 SORT-ACCOUNT-TYPE PIC X(03). 05 SORT-ACCOUNT. 10 SORT-ACCOUNT-PREFIX PIC X(03). 10 SORT-ACCOUNT-SUFFIX PIC X(07). 05 SORT-NAME PIC X(29). 05 SORT-CIF-KEY PIC X(11). 05 SORT-STATUS PIC X(01). 05 SORT-DATE PIC X(08). WORKING-STORAGE SECTION. 01 WORK-AREA. 05 ACCOUNT-NEW. 15 AN-ACCOUNT PIC X(09). 15 AN-CHECK-DIGIT PIC X(01). 05 ACCOUNT-STATUS PIC X(01). 05 PAGE-CNT PIC S9(3) VALUE +0 COMP-3. 05 LINE-CNT PIC S9(3) VALUE +0 COMP-3. 05 KEY-SEQUENCE PIC S9(3) VALUE +0 COMP-3. 05 RECIN-CNT PIC S9(7) VALUE +0 COMP-3. 05 RECOUT-CNT PIC S9(7) VALUE +0 COMP-3. 05 FIX-CNT PIC S9(7) VALUE +0 COMP-3. 05 BYPASS-CNT PIC S9(7) VALUE +0 COMP-3. 05 COMP-133 PIC S9(4) COMP VALUE +133. 05 FILLER REDEFINES COMP-133. 10 FILLER PIC X(01). 10 LOWER-E PIC X(01). 05 COMP-168 PIC S9(4) COMP VALUE +168. 05 FILLER REDEFINES COMP-168. 10 FILLER PIC X(01). 10 LOWER-Y PIC X(01). 05 WS-SEARCH. 10 FILLER PIC X(01) VALUE 'K'. 10 LC-E PIC X(01). 10 LC-Y PIC X(01). 10 FILLER PIC X(02) VALUE ': '. 05 HALF-2 PIC S9(4) VALUE +2 COMP. 05 FILLER REDEFINES HALF-2. 10 FILLER PIC X(01). 10 PPT-TYPE PIC X(01). 05 INDEX-1 PIC S9(4) VALUE +0 COMP. 05 FILLER REDEFINES INDEX-1. 10 FILLER PIC X(01). 10 INDEX-VAL PIC X(01). 05 NOF-IND PIC X(01) VALUE 'N'. 88 NOT-ON-FILE VALUE 'Y'. 05 EOF-FLAG PIC X(01) VALUE 'N'. 88 EOF VALUE 'Y'. 05 COUNT-DETAIL. 10 FILLER PIC X(02) VALUE SPACES. 10 COUNT-TYPE PIC X(10) VALUE SPACES. 10 FILLER PIC X(03) VALUE SPACES. 10 COUNT-UNPACK PIC Z9(6) VALUE ZEROES. 05 WS-NAME. 10 FILLER PIC X(01) VALUE '*'. 10 TRUNC-NAME PIC X(28). PROCEDURE DIVISION. SORT SORT-FILE ASCENDING KEY SORT-ACCOUNT INPUT PROCEDURE SRT-INPUT-PROCEDURE OUTPUT PROCEDURE SRT-OUTPUT-PROCEDURE. GO TO NORMAL-EOJ. SRT-INPUT-PROCEDURE SECTION. OPEN INPUT IN-FILE. PERFORM READ-INPUT-RTN THRU READ-INPUT-EXIT UNTIL EOF. END-INPUT SECTION. READ-INPUT-RTN. READ IN-FILE AT END MOVE 'Y' TO EOF-FLAG GO TO READ-INPUT-EXIT. ADD +1 TO RECIN-CNT. MOVE IN-REC TO SORT-RECORD. * IF IN-ACCOUNT-PREFIX = '000' * OR (IN-ACCOUNT-PREFIX-1 = '0' AND * IN-ACCOUNT-PREFIX-2 NOT = '0') THEN IF IN-ACCOUNT-PREFIX NOT = '005' THEN MOVE IN-ACCOUNT-9 TO AN-ACCOUNT * CALL 'PDUMP' USING ACCOUNT-NEW, PAGE-CNT CALL 'CHECKDIG' USING AN-ACCOUNT, AN-CHECK-DIGIT, ACCOUNT-STATUS * EXHIBIT NAMED AN-ACCOUNT, AN-CHECK-DIGIT, * ACCOUNT-STATUS IF ACCOUNT-STATUS = SPACE THEN ADD +1 TO FIX-CNT MOVE IN-NAME TO TRUNC-NAME MOVE WS-NAME TO SORT-NAME MOVE ACCOUNT-NEW TO SORT-ACCOUNT. * IF FIX-CNT > +10 * GO TO NORMAL-EOJ. RELEASE SORT-RECORD. READ-INPUT-EXIT. EXIT. SRT-OUTPUT-PROCEDURE SECTION. OPEN OUTPUT OUT-FILE. MOVE 'N' TO EOF-FLAG. RETURN SORT-FILE RECORD INTO OUT-REC AT END MOVE 'Y' TO EOF-FLAG. PERFORM WRITE-OUTPUT-RTN THRU WRITE-OUTPUT-EXIT UNTIL EOF. END-OUTPUT SECTION. WRITE-OUTPUT-RTN. WRITE OUT-REC. ADD +1 TO RECOUT-CNT. RETURN SORT-FILE RECORD INTO OUT-REC AT END MOVE 'Y' TO EOF-FLAG. WRITE-OUTPUT-EXIT. EXIT. NORMAL-EOJ. CLOSE IN-FILE, OUT-FILE. MOVE 'READ' TO COUNT-TYPE. MOVE RECIN-CNT TO COUNT-UNPACK. DISPLAY COUNT-DETAIL. MOVE 'BYPASSED' TO COUNT-TYPE. MOVE BYPASS-CNT TO COUNT-UNPACK. DISPLAY COUNT-DETAIL. MOVE 'WRITTEN' TO COUNT-TYPE. MOVE RECOUT-CNT TO COUNT-UNPACK. DISPLAY COUNT-DETAIL. MOVE 'ACCT FIXED' TO COUNT-TYPE. MOVE FIX-CNT TO COUNT-UNPACK. DISPLAY COUNT-DETAIL. STOP RUN.