>>SOURCE FORMAT IS FREE *> ============================================================ *> 13-validation-nodup : CDR字段校验 (CDR Field Validation) *> Expanded with SECTION structure, comprehensive field-by-field *> CDR validation, error accumulation, error detail report, *> audit summary, batch control totals, hash totals, *> FILE STATUS checks after every I/O, DISPLAY tracing with *> timestamps, and error severity levels. *> Input : FILE-IN (file-in.dat: CDR记录, 90 bytes) *> Output: FILE-OUT-GOOD (file-out-good.dat: 校验通过) *> FILE-OUT-BAD (file-out-bad.dat: 校验失败) *> ERROR-REPORT (error-report.dat: 错误明细) *> AUDIT-FILE (audit-report.dat: 审计摘要) *> Coverage: VF-N001, VF-N002, VF-R001, VF-N007, VF-N008 *> VF-A003, VF-A004, VF-P004, VF-L002, VF-S002 *> ============================================================ IDENTIFICATION DIVISION. PROGRAM-ID. ValidationNodup. *> ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT FILE-IN ASSIGN TO 'file-in.dat' ORGANIZATION IS SEQUENTIAL ACCESS MODE IS SEQUENTIAL FILE STATUS IS WS-FILE-IN-STATUS. SELECT FILE-OUT-GOOD ASSIGN TO 'file-out-good.dat' ORGANIZATION IS SEQUENTIAL FILE STATUS IS WS-FILE-GOOD-STATUS. SELECT FILE-OUT-BAD ASSIGN TO 'file-out-bad.dat' ORGANIZATION IS SEQUENTIAL FILE STATUS IS WS-FILE-BAD-STATUS. SELECT ERROR-REPORT ASSIGN TO 'error-report.dat' ORGANIZATION IS SEQUENTIAL FILE STATUS IS WS-ERR-RPT-STATUS. SELECT AUDIT-FILE ASSIGN TO 'audit-report.dat' ORGANIZATION IS SEQUENTIAL FILE STATUS IS WS-AUDIT-STATUS. *> DATA DIVISION. FILE SECTION. FD FILE-IN. 01 IN-REC. *> Original fields (backward compatible, 31 bytes) 05 IN-FIELD1 PIC X(01). 05 IN-FIELD2 PIC X(30). *> Extended CDR fields (additional 59 bytes = 90 total) 05 IN-CALLER-NUM PIC X(15). 05 IN-CALLEE-NUM PIC X(15). 05 IN-DURATION PIC 9(05). 05 IN-START-TIME PIC X(06). 05 IN-START-DATE PIC X(08). 05 IN-RECORD-ID PIC X(10). *> FD FILE-OUT-GOOD. 01 GOOD-REC. 05 GOOD-FIELD1 PIC X(01). 05 GOOD-FIELD2 PIC X(30). 05 GOOD-CALLER-NUM PIC X(15). 05 GOOD-CALLEE-NUM PIC X(15). 05 GOOD-DURATION PIC 9(05). 05 GOOD-START-TIME PIC X(06). 05 GOOD-START-DATE PIC X(08). 05 GOOD-RECORD-ID PIC X(10). *> FD FILE-OUT-BAD. 01 BAD-REC. 05 BAD-FIELD1 PIC X(01). 05 BAD-FIELD2 PIC X(30). 05 BAD-CALLER-NUM PIC X(15). 05 BAD-CALLEE-NUM PIC X(15). 05 BAD-DURATION PIC 9(05). 05 BAD-START-TIME PIC X(06). 05 BAD-START-DATE PIC X(08). 05 BAD-RECORD-ID PIC X(10). 05 BAD-ERR-CODE PIC X(04). 05 BAD-SEVERITY PIC X(06). *> FD ERROR-REPORT. 01 ERR-RPT-REC. 05 ERR-RPT-RECORD-ID PIC X(10). 05 ERR-RPT-SEP1 PIC X(01) VALUE SPACE. 05 ERR-RPT-FIELD-NAME PIC X(15). 05 ERR-RPT-SEP2 PIC X(01) VALUE SPACE. 05 ERR-RPT-ERR-CODE PIC X(04). 05 ERR-RPT-SEP3 PIC X(01) VALUE SPACE. 05 ERR-RPT-ERR-DESC PIC X(40). 05 ERR-RPT-SEP4 PIC X(01) VALUE SPACE. 05 ERR-RPT-SEVERITY PIC X(06). *> FD AUDIT-FILE. 01 AUDIT-REC PIC X(80). *> WORKING-STORAGE SECTION. 01 WS-TELECOM-REC. COPY "telecom/TEL-BILLING.cpy". *> File status fields 01 WS-FILE-IN-STATUS PIC X(02). 01 WS-FILE-GOOD-STATUS PIC X(02). 01 WS-FILE-BAD-STATUS PIC X(02). 01 WS-ERR-RPT-STATUS PIC X(02). 01 WS-AUDIT-STATUS PIC X(02). *> Flags and indicators 01 WS-EOF PIC X(01) VALUE 'N'. 88 WS-EOF-YES VALUE 'Y' FALSE 'N'. 01 WS-REC-IS-VALID PIC X(01) VALUE 'Y'. 88 WS-REC-IS-VALID-YES VALUE 'Y' FALSE 'N'. 88 WS-REC-IS-VALID-NO VALUE 'N'. 01 WS-VALID-FOUND PIC X(01) VALUE 'N'. 88 WS-VALID-FOUND-YES VALUE 'Y' FALSE 'N'. 01 WS-NUM-OK PIC X(01) VALUE 'Y'. 88 WS-NUM-OK-YES VALUE 'Y' FALSE 'N'. 88 WS-NUM-OK-NO VALUE 'N'. *> Record counts 01 WS-TOTAL-READ PIC 9(05) VALUE ZERO. 01 WS-GOOD-COUNT PIC 9(05) VALUE ZERO. 01 WS-BAD-COUNT PIC 9(05) VALUE ZERO. 01 WS-PROCESSED-COUNT PIC 9(05) VALUE ZERO. 01 WS-VALID-COUNT PIC 9(05) VALUE ZERO. 01 WS-INVALID-COUNT PIC 9(05) VALUE ZERO. 01 WS-TRACE-COUNT PIC 9(05) VALUE ZERO. 01 WS-RECORD-ID-NUM PIC 9(05) VALUE ZERO. *> Allowed values table for call type (original logic) 01 WS-ALLOWED-VALUES. 05 WS-ALLOWED-CHAR PIC X(01) OCCURS 5 TIMES. 01 WS-IDX PIC 9(02). 01 WS-J PIC 9(02). *> Error code definitions (8 error types E001-E008) 01 WS-ERR-DEF-TABLE. 05 WS-ERR-DEF-ENTRY OCCURS 8 TIMES. 10 WS-ED-CODE PIC X(04). 10 WS-ED-DESC PIC X(40). 10 WS-ED-SEVERITY PIC X(06). 10 WS-ED-COUNT PIC 9(05) VALUE ZERO. 01 WS-ERR-DEF-COUNT PIC 9(02) VALUE 8. 01 WS-ED-IDX PIC 9(02). *> Per-record error accumulation table (max 10 errors) 01 WS-REC-ERROR-TABLE. 05 WS-REC-ERR OCCURS 10 TIMES. 10 WS-RE-FIELD PIC X(15). 10 WS-RE-CODE PIC X(04). 10 WS-RE-DESC PIC X(40). 10 WS-RE-SEVERITY PIC X(06). 01 WS-REC-ERR-COUNT PIC 9(02) VALUE ZERO. 01 WS-REC-ERR-IDX PIC 9(02). *> Hash totals for data integrity 01 WS-HASH-DURATION PIC 9(12) VALUE ZERO. 01 WS-HASH-CALLER-CHARS PIC 9(12) VALUE ZERO. 01 WS-CHAR-VAL PIC 9(03). *> Batch control totals 01 WS-CONTROL-TOTAL-REC PIC 9(05) VALUE ZERO. 01 WS-CONTROL-TOTAL-GOOD PIC 9(05) VALUE ZERO. 01 WS-CONTROL-TOTAL-BAD PIC 9(05) VALUE ZERO. 01 WS-BATCH-HASH-DUR PIC 9(12) VALUE ZERO. *> Timestamp fields for DISPLAY tracing 01 WS-CURRENT-TIME. 05 WS-CURR-YEAR PIC X(04). 05 WS-CURR-MONTH PIC X(02). 05 WS-CURR-DAY PIC X(02). 05 WS-CURR-HOUR PIC X(02). 05 WS-CURR-MIN PIC X(02). 05 WS-CURR-SEC PIC X(02). 01 WS-TIMESTAMP PIC X(20). 01 WS-TRACE-TS PIC X(20). *> Work fields for duration validation 01 WS-DURATION-NUM PIC 9(05). 01 WS-DURATION-DISP PIC Z(04)9. 01 WS-DURATION-STR PIC X(05). 01 WS-DURATION-CHR PIC X(01). *> Work fields for caller number (IN-FIELD2) validation 01 WS-CALLER-TEXT PIC X(30). 01 WS-CALLER-LEN PIC 9(02). 01 WS-CALLER-TRAIL-SP PIC 9(02). 01 WS-CALLER-CHK-IDX PIC 9(02). 01 WS-CALLER-CHR PIC X(01). *> Work fields for start-time validation 01 WS-START-TIME-STR PIC X(06). 01 WS-TIME-HH PIC 9(02). 01 WS-TIME-MM PIC 9(02). 01 WS-TIME-SS PIC 9(02). 01 WS-TIME-CHR PIC X(01). *> Numeric check work fields 01 WS-NUM-CHR PIC X(01). 01 WS-NUM-IDX PIC 9(02). *> Report and audit formatting fields 01 WS-ED-TOTAL PIC Z(09)9. 01 WS-ED-GOOD PIC Z(09)9. 01 WS-ED-BAD PIC Z(09)9. 01 WS-ED-VALID PIC Z(09)9. 01 WS-ED-INVALID PIC Z(09)9. 01 WS-ED-HASH PIC Z(14)9. 01 WS-ED-ERR-COUNT PIC Z(09)9. *> Error severity 01 WS-SEVERITY PIC X(01). 88 WS-SEV-WARNING VALUE 'W'. 88 WS-SEV-ERROR VALUE 'E'. 88 WS-SEV-FATAL VALUE 'F'. 01 WS-RETURN-CODE PIC 9(02) VALUE ZERO. *> PROCEDURE DIVISION. MAIN SECTION. MB-PROCESS. PERFORM 1000-INIT PERFORM 2000-OPEN-FILES PERFORM 3000-READ-INPUT UNTIL WS-EOF-YES PERFORM 4000-REPORT PERFORM 5000-AUDIT PERFORM 6000-ERROR-HANDLE PERFORM 9000-EXIT STOP RUN. *> *> ============================================================ *> 1000-INIT : Initialize counters, tables, and batch header *> ============================================================ 1000-INIT SECTION. I1000-START. DISPLAY 'ValidationNodup: 1000-INIT starting...'. *> Fill allowed-values table (original logic) MOVE 'A' TO WS-ALLOWED-CHAR(1). MOVE 'B' TO WS-ALLOWED-CHAR(2). MOVE 'C' TO WS-ALLOWED-CHAR(3). MOVE 'D' TO WS-ALLOWED-CHAR(4). MOVE 'E' TO WS-ALLOWED-CHAR(5). *> Initialize counters MOVE ZERO TO WS-TOTAL-READ WS-GOOD-COUNT WS-BAD-COUNT WS-PROCESSED-COUNT WS-VALID-COUNT WS-INVALID-COUNT WS-TRACE-COUNT WS-RECORD-ID-NUM. *> Initialize hash and control totals MOVE ZERO TO WS-HASH-DURATION WS-HASH-CALLER-CHARS WS-CONTROL-TOTAL-REC WS-CONTROL-TOTAL-GOOD WS-CONTROL-TOTAL-BAD WS-BATCH-HASH-DUR. MOVE 'N' TO WS-EOF. *> Populate error code definitions (8 error types) MOVE 'E001' TO WS-ED-CODE(1). MOVE 'Invalid call type - not in A/B/C/D/E' TO WS-ED-DESC(1). MOVE 'HIGH' TO WS-ED-SEVERITY(1). MOVE 'E002' TO WS-ED-CODE(2). MOVE 'Call type not uppercase' TO WS-ED-DESC(2). MOVE 'LOW' TO WS-ED-SEVERITY(2). MOVE 'E003' TO WS-ED-CODE(3). MOVE 'Caller number length not 10-15 chars' TO WS-ED-DESC(3). MOVE 'MED' TO WS-ED-SEVERITY(3). MOVE 'E004' TO WS-ED-CODE(4). MOVE 'Caller number leading chars not numeric' TO WS-ED-DESC(4). MOVE 'MED' TO WS-ED-SEVERITY(4). MOVE 'E005' TO WS-ED-CODE(5). MOVE 'Duration out of valid range 0-99999' TO WS-ED-DESC(5). MOVE 'HIGH' TO WS-ED-SEVERITY(5). MOVE 'E006' TO WS-ED-CODE(6). MOVE 'Duration field not numeric' TO WS-ED-DESC(6). MOVE 'HIGH' TO WS-ED-SEVERITY(6). MOVE 'E007' TO WS-ED-CODE(7). MOVE 'Start-time format invalid (not HHMMSS)' TO WS-ED-DESC(7). MOVE 'MED' TO WS-ED-SEVERITY(7). MOVE 'E008' TO WS-ED-CODE(8). MOVE 'Start-time field not numeric' TO WS-ED-DESC(8). MOVE 'MED' TO WS-ED-SEVERITY(8). *> Capture batch start timestamp MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-TIME. STRING WS-CURR-YEAR '-' WS-CURR-MONTH '-' WS-CURR-DAY ' ' WS-CURR-HOUR ':' WS-CURR-MIN ':' WS-CURR-SEC INTO WS-TIMESTAMP. DISPLAY 'ValidationNodup: Batch started at ' WS-TIMESTAMP. DISPLAY 'ValidationNodup: 8 error definitions loaded'. EXIT SECTION. *> *> ============================================================ *> 2000-OPEN-FILES : Open all 5 files with FILE STATUS checks *> ============================================================ 2000-OPEN-FILES SECTION. I2000-START. DISPLAY 'ValidationNodup: 2000-OPEN-FILES...'. OPEN INPUT FILE-IN. IF WS-FILE-IN-STATUS NOT = '00' DISPLAY 'ERROR: Cannot open FILE-IN, status: ' WS-FILE-IN-STATUS MOVE 1 TO RETURN-CODE STOP RUN END-IF. DISPLAY ' FILE-IN opened status=' WS-FILE-IN-STATUS. OPEN OUTPUT FILE-OUT-GOOD. IF WS-FILE-GOOD-STATUS NOT = '00' DISPLAY 'ERROR: Cannot open FILE-OUT-GOOD, status: ' WS-FILE-GOOD-STATUS MOVE 1 TO RETURN-CODE STOP RUN END-IF. DISPLAY ' FILE-OUT-GOOD opened status=' WS-FILE-GOOD-STATUS. OPEN OUTPUT FILE-OUT-BAD. IF WS-FILE-BAD-STATUS NOT = '00' DISPLAY 'ERROR: Cannot open FILE-OUT-BAD, status: ' WS-FILE-BAD-STATUS MOVE 1 TO RETURN-CODE STOP RUN END-IF. DISPLAY ' FILE-OUT-BAD opened status=' WS-FILE-BAD-STATUS. OPEN OUTPUT ERROR-REPORT. IF WS-ERR-RPT-STATUS NOT = '00' DISPLAY 'ERROR: Cannot open ERROR-REPORT, status: ' WS-ERR-RPT-STATUS MOVE 1 TO RETURN-CODE STOP RUN END-IF. DISPLAY ' ERROR-REPORT opened status=' WS-ERR-RPT-STATUS. OPEN OUTPUT AUDIT-FILE. IF WS-AUDIT-STATUS NOT = '00' DISPLAY 'ERROR: Cannot open AUDIT-FILE, status: ' WS-AUDIT-STATUS MOVE 1 TO RETURN-CODE STOP RUN END-IF. DISPLAY ' AUDIT-FILE opened status=' WS-AUDIT-STATUS. *> Write report and audit headers MOVE SPACES TO ERR-RPT-REC. STRING 'Error Detail Report - ValidationNodup' INTO ERR-RPT-RECORD-ID. WRITE ERR-RPT-REC. IF WS-ERR-RPT-STATUS NOT = '00' DISPLAY 'ERROR: Write ERR-RPT header status=' WS-ERR-RPT-STATUS END-IF. MOVE SPACES TO ERR-RPT-REC. STRING 'Run: ' WS-TIMESTAMP INTO ERR-RPT-RECORD-ID. WRITE ERR-RPT-REC. MOVE SPACES TO ERR-RPT-REC. STRING 'Rec-ID Field Code Description' INTO ERR-RPT-RECORD-ID. WRITE ERR-RPT-REC. MOVE SPACES TO ERR-RPT-REC. WRITE ERR-RPT-REC. *> MOVE SPACES TO AUDIT-REC. STRING 'Audit Report - ValidationNodup' INTO AUDIT-REC. WRITE AUDIT-REC. IF WS-AUDIT-STATUS NOT = '00' DISPLAY 'ERROR: Write AUDIT header status=' WS-AUDIT-STATUS END-IF. MOVE SPACES TO AUDIT-REC. STRING 'Run: ' WS-TIMESTAMP INTO AUDIT-REC. WRITE AUDIT-REC. MOVE SPACES TO AUDIT-REC. WRITE AUDIT-REC. DISPLAY 'ValidationNodup: All files opened OK'. EXIT SECTION. *> *> ============================================================ *> 3000-READ-INPUT : Read loop — read record and dispatch *> ============================================================ 3000-READ-INPUT SECTION. I3000-START. READ FILE-IN AT END SET WS-EOF-YES TO TRUE DISPLAY '3000-READ-INPUT: EOF total read=' WS-TOTAL-READ NOT AT END ADD 1 TO WS-TOTAL-READ ADD 1 TO WS-RECORD-ID-NUM ADD 1 TO WS-TRACE-COUNT *> Periodic tracing every 50 records IF WS-TRACE-COUNT >= 50 MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-TIME STRING WS-CURR-HOUR ':' WS-CURR-MIN ':' WS-CURR-SEC INTO WS-TRACE-TS DISPLAY '3000-READ-INPUT: [' WS-TRACE-TS '] #' WS-TOTAL-READ ' F1="' IN-FIELD1 '"' MOVE ZERO TO WS-TRACE-COUNT END-IF IF WS-FILE-IN-STATUS NOT = '00' DISPLAY '3000-READ-INPUT: READ status=' WS-FILE-IN-STATUS END-IF PERFORM 3100-VALIDATE-RECORD PERFORM 3200-PROCESS-RECORD END-READ. EXIT SECTION. *> *> ============================================================ *> 3100-VALIDATE-RECORD : Field-by-field CDR validation *> R1A/E001 IN-FIELD1 allowed values A-E *> R1B/E002 IN-FIELD1 uppercase check *> R2A/E003 IN-FIELD2 caller length 10-15 *> R2B/E004 IN-FIELD2 leading digit numeric *> R3A/E005 IN-DURATION range 0-99999 *> R3B/E006 IN-DURATION numeric check *> R4A/E007 IN-START-TIME HHMMSS format *> R4B/E008 IN-START-TIME numeric check *> Errors accumulated into WS-REC-ERROR-TABLE *> ============================================================ 3100-VALIDATE-RECORD SECTION. I3100-START. MOVE ZERO TO WS-REC-ERR-COUNT. MOVE SPACES TO WS-REC-ERROR-TABLE. MOVE 'Y' TO WS-REC-IS-VALID. MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-TIME. STRING WS-CURR-HOUR ':' WS-CURR-MIN ':' WS-CURR-SEC INTO WS-TRACE-TS. DISPLAY '3100-VALIDATE: [' WS-TRACE-TS '] #' WS-TOTAL-READ ' F1="' IN-FIELD1 '"'. *> ---- Rule 1A: IN-FIELD1 allowed values check (original) ---- MOVE 'N' TO WS-VALID-FOUND. PERFORM VARYING WS-IDX FROM 1 BY 1 UNTIL WS-IDX > 5 IF IN-FIELD1 = WS-ALLOWED-CHAR(WS-IDX) SET WS-VALID-FOUND-YES TO TRUE END-IF END-PERFORM. IF NOT WS-VALID-FOUND-YES ADD 1 TO WS-REC-ERR-COUNT MOVE 'IN-FIELD1' TO WS-RE-FIELD(WS-REC-ERR-COUNT) MOVE 'E001' TO WS-RE-CODE(WS-REC-ERR-COUNT) MOVE 'Invalid call type - not in A/B/C/D/E' TO WS-RE-DESC(WS-REC-ERR-COUNT) MOVE 'HIGH' TO WS-RE-SEVERITY(WS-REC-ERR-COUNT) MOVE 'N' TO WS-REC-IS-VALID DISPLAY '3100-VALIDATE: E001 F1="' IN-FIELD1 '"' END-IF. *> ---- Rule 1B: IN-FIELD1 uppercase check ---- IF IN-FIELD1 NOT >= 'A' OR IN-FIELD1 NOT <= 'Z' IF WS-REC-ERR-COUNT < 10 ADD 1 TO WS-REC-ERR-COUNT MOVE 'IN-FIELD1' TO WS-RE-FIELD(WS-REC-ERR-COUNT) MOVE 'E002' TO WS-RE-CODE(WS-REC-ERR-COUNT) MOVE 'Call type not uppercase' TO WS-RE-DESC(WS-REC-ERR-COUNT) MOVE 'LOW' TO WS-RE-SEVERITY(WS-REC-ERR-COUNT) DISPLAY '3100-VALIDATE: E002 F1 not upper' END-IF END-IF. *> ---- Rule 2A: IN-FIELD2 caller length 10-15 ---- MOVE IN-FIELD2 TO WS-CALLER-TEXT. MOVE ZERO TO WS-CALLER-TRAIL-SP. INSPECT FUNCTION REVERSE(WS-CALLER-TEXT) TALLYING WS-CALLER-TRAIL-SP FOR LEADING SPACES. COMPUTE WS-CALLER-LEN = 30 - WS-CALLER-TRAIL-SP. IF WS-CALLER-LEN < 10 OR WS-CALLER-LEN > 15 IF WS-REC-ERR-COUNT < 10 ADD 1 TO WS-REC-ERR-COUNT MOVE 'IN-FIELD2' TO WS-RE-FIELD(WS-REC-ERR-COUNT) MOVE 'E003' TO WS-RE-CODE(WS-REC-ERR-COUNT) MOVE 'Caller number length not 10-15 chars' TO WS-RE-DESC(WS-REC-ERR-COUNT) MOVE 'MED' TO WS-RE-SEVERITY(WS-REC-ERR-COUNT) MOVE 'N' TO WS-REC-IS-VALID DISPLAY '3100-VALIDATE: E003 len=' WS-CALLER-LEN END-IF END-IF. *> ---- Rule 2B: IN-FIELD2 leading digits numeric ---- IF WS-CALLER-LEN >= 5 MOVE 5 TO WS-CALLER-CHK-IDX ELSE MOVE WS-CALLER-LEN TO WS-CALLER-CHK-IDX END-IF. IF WS-CALLER-CHK-IDX > 0 MOVE 'Y' TO WS-NUM-OK PERFORM VARYING WS-IDX FROM 1 BY 1 UNTIL WS-IDX > WS-CALLER-CHK-IDX MOVE IN-FIELD2(WS-IDX:1) TO WS-CALLER-CHR IF WS-CALLER-CHR < '0' OR WS-CALLER-CHR > '9' MOVE 'N' TO WS-NUM-OK END-IF END-PERFORM IF WS-NUM-OK = 'N' IF WS-REC-ERR-COUNT < 10 ADD 1 TO WS-REC-ERR-COUNT MOVE 'IN-FIELD2' TO WS-RE-FIELD(WS-REC-ERR-COUNT) MOVE 'E004' TO WS-RE-CODE(WS-REC-ERR-COUNT) MOVE 'Caller number leading chars not numeric' TO WS-RE-DESC(WS-REC-ERR-COUNT) MOVE 'MED' TO WS-RE-SEVERITY(WS-REC-ERR-COUNT) MOVE 'N' TO WS-REC-IS-VALID DISPLAY '3100-VALIDATE: E004 lead not num' END-IF END-IF END-IF. *> ---- Rule 3A: IN-DURATION numeric check ---- MOVE IN-DURATION TO WS-DURATION-STR. MOVE 'Y' TO WS-NUM-OK. PERFORM VARYING WS-IDX FROM 1 BY 1 UNTIL WS-IDX > 5 MOVE WS-DURATION-STR(WS-IDX:1) TO WS-NUM-CHR IF WS-NUM-CHR < '0' OR WS-NUM-CHR > '9' MOVE 'N' TO WS-NUM-OK END-IF END-PERFORM. IF WS-NUM-OK = 'N' IF WS-REC-ERR-COUNT < 10 ADD 1 TO WS-REC-ERR-COUNT MOVE 'IN-DURATION' TO WS-RE-FIELD(WS-REC-ERR-COUNT) MOVE 'E006' TO WS-RE-CODE(WS-REC-ERR-COUNT) MOVE 'Duration field not numeric' TO WS-RE-DESC(WS-REC-ERR-COUNT) MOVE 'HIGH' TO WS-RE-SEVERITY(WS-REC-ERR-COUNT) MOVE 'N' TO WS-REC-IS-VALID DISPLAY '3100-VALIDATE: E006 dur non-num' END-IF END-IF. *> ---- Rule 3B: IN-DURATION range 0-99999 ---- IF WS-NUM-OK NOT = 'N' MOVE IN-DURATION TO WS-DURATION-NUM IF WS-DURATION-NUM < 0 OR WS-DURATION-NUM > 99999 IF WS-REC-ERR-COUNT < 10 ADD 1 TO WS-REC-ERR-COUNT MOVE 'IN-DURATION' TO WS-RE-FIELD(WS-REC-ERR-COUNT) MOVE 'E005' TO WS-RE-CODE(WS-REC-ERR-COUNT) MOVE 'Duration out of valid range 0-99999' TO WS-RE-DESC(WS-REC-ERR-COUNT) MOVE 'HIGH' TO WS-RE-SEVERITY(WS-REC-ERR-COUNT) MOVE 'N' TO WS-REC-IS-VALID DISPLAY '3100-VALIDATE: E005 dur=' WS-DURATION-NUM END-IF END-IF END-IF. *> ---- Rule 4A: IN-START-TIME numeric check ---- MOVE IN-START-TIME TO WS-START-TIME-STR. MOVE 'Y' TO WS-NUM-OK. PERFORM VARYING WS-IDX FROM 1 BY 1 UNTIL WS-IDX > 6 MOVE WS-START-TIME-STR(WS-IDX:1) TO WS-NUM-CHR IF WS-NUM-CHR < '0' OR WS-NUM-CHR > '9' MOVE 'N' TO WS-NUM-OK END-IF END-PERFORM. IF WS-NUM-OK = 'N' IF WS-REC-ERR-COUNT < 10 ADD 1 TO WS-REC-ERR-COUNT MOVE 'IN-START-TIME' TO WS-RE-FIELD(WS-REC-ERR-COUNT) MOVE 'E008' TO WS-RE-CODE(WS-REC-ERR-COUNT) MOVE 'Start-time field not numeric' TO WS-RE-DESC(WS-REC-ERR-COUNT) MOVE 'MED' TO WS-RE-SEVERITY(WS-REC-ERR-COUNT) MOVE 'N' TO WS-REC-IS-VALID DISPLAY '3100-VALIDATE: E008 time non-num' END-IF END-IF. *> ---- Rule 4B: IN-START-TIME HHMMSS format ---- IF WS-NUM-OK NOT = 'N' MOVE IN-START-TIME TO WS-START-TIME-STR MOVE WS-START-TIME-STR(1:2) TO WS-TIME-HH MOVE WS-START-TIME-STR(3:2) TO WS-TIME-MM MOVE WS-START-TIME-STR(5:2) TO WS-TIME-SS IF WS-TIME-HH > 23 OR WS-TIME-MM > 59 OR WS-TIME-SS > 59 IF WS-REC-ERR-COUNT < 10 ADD 1 TO WS-REC-ERR-COUNT MOVE 'IN-START-TIME' TO WS-RE-FIELD(WS-REC-ERR-COUNT) MOVE 'E007' TO WS-RE-CODE(WS-REC-ERR-COUNT) MOVE 'Start-time format invalid (not HHMMSS)' TO WS-RE-DESC(WS-REC-ERR-COUNT) MOVE 'MED' TO WS-RE-SEVERITY(WS-REC-ERR-COUNT) MOVE 'N' TO WS-REC-IS-VALID DISPLAY '3100-VALIDATE: E007 time HH=' WS-TIME-HH ' MM=' WS-TIME-MM ' SS=' WS-TIME-SS END-IF END-IF END-IF. *> Accumulate error counts into definitions table PERFORM VARYING WS-REC-ERR-IDX FROM 1 BY 1 UNTIL WS-REC-ERR-IDX > WS-REC-ERR-COUNT PERFORM VARYING WS-ED-IDX FROM 1 BY 1 UNTIL WS-ED-IDX > WS-ERR-DEF-COUNT IF WS-RE-CODE(WS-REC-ERR-IDX) = WS-ED-CODE(WS-ED-IDX) ADD 1 TO WS-ED-COUNT(WS-ED-IDX) END-IF END-PERFORM END-PERFORM. DISPLAY '3100-VALIDATE: Done errors=' WS-REC-ERR-COUNT ' valid=' WS-REC-IS-VALID. EXIT SECTION. *> *> ============================================================ *> 3200-PROCESS-RECORD : Route record and update totals *> ============================================================ 3200-PROCESS-RECORD SECTION. I3200-START. IF WS-REC-IS-VALID-YES ADD 1 TO WS-GOOD-COUNT WS-VALID-COUNT WS-CONTROL-TOTAL-GOOD DISPLAY '3200: #' WS-TOTAL-READ ' -> GOOD' ELSE ADD 1 TO WS-BAD-COUNT WS-INVALID-COUNT WS-CONTROL-TOTAL-BAD DISPLAY '3200: #' WS-TOTAL-READ ' -> BAD errors=' WS-REC-ERR-COUNT END-IF. ADD 1 TO WS-PROCESSED-COUNT WS-CONTROL-TOTAL-REC. *> Hash totals MOVE IN-DURATION TO WS-DURATION-NUM. ADD WS-DURATION-NUM TO WS-HASH-DURATION WS-BATCH-HASH-DUR. MOVE IN-FIELD1 TO WS-CALLER-CHR. COMPUTE WS-CHAR-VAL = FUNCTION ORD(WS-CALLER-CHR). ADD WS-CHAR-VAL TO WS-HASH-CALLER-CHARS. PERFORM VARYING WS-IDX FROM 1 BY 1 UNTIL WS-IDX > 30 MOVE IN-FIELD2(WS-IDX:1) TO WS-CALLER-CHR IF WS-CALLER-CHR NOT = SPACE COMPUTE WS-CHAR-VAL = FUNCTION ORD(WS-CALLER-CHR) ADD WS-CHAR-VAL TO WS-HASH-CALLER-CHARS END-IF END-PERFORM. PERFORM 3300-WRITE-OUTPUT. EXIT SECTION. *> *> ============================================================ *> 3300-WRITE-OUTPUT : Write records and error details *> ============================================================ 3300-WRITE-OUTPUT SECTION. I3300-START. MOVE IN-RECORD-ID TO ERR-RPT-RECORD-ID. *> Write to GOOD file IF WS-REC-IS-VALID-YES MOVE IN-FIELD1 TO GOOD-FIELD1 MOVE IN-FIELD2 TO GOOD-FIELD2 MOVE IN-CALLER-NUM TO GOOD-CALLER-NUM MOVE IN-CALLEE-NUM TO GOOD-CALLEE-NUM MOVE IN-DURATION TO GOOD-DURATION MOVE IN-START-TIME TO GOOD-START-TIME MOVE IN-START-DATE TO GOOD-START-DATE MOVE IN-RECORD-ID TO GOOD-RECORD-ID WRITE GOOD-REC IF WS-FILE-GOOD-STATUS NOT = '00' DISPLAY '3300: WRITE GOOD failed status=' WS-FILE-GOOD-STATUS END-IF DISPLAY '3300: Wrote GOOD #' WS-TOTAL-READ ELSE *> Write to BAD file MOVE IN-FIELD1 TO BAD-FIELD1 MOVE IN-FIELD2 TO BAD-FIELD2 MOVE IN-CALLER-NUM TO BAD-CALLER-NUM MOVE IN-CALLEE-NUM TO BAD-CALLEE-NUM MOVE IN-DURATION TO BAD-DURATION MOVE IN-START-TIME TO BAD-START-TIME MOVE IN-START-DATE TO BAD-START-DATE MOVE IN-RECORD-ID TO BAD-RECORD-ID IF WS-REC-ERR-COUNT > 0 MOVE WS-RE-CODE(1) TO BAD-ERR-CODE MOVE WS-RE-SEVERITY(1) TO BAD-SEVERITY ELSE MOVE 'E001' TO BAD-ERR-CODE MOVE 'HIGH' TO BAD-SEVERITY END-IF WRITE BAD-REC IF WS-FILE-BAD-STATUS NOT = '00' DISPLAY '3300: WRITE BAD failed status=' WS-FILE-BAD-STATUS END-IF DISPLAY '3300: Wrote BAD #' WS-TOTAL-READ ' code=' BAD-ERR-CODE END-IF. *> Write each error detail to ERROR-REPORT PERFORM VARYING WS-REC-ERR-IDX FROM 1 BY 1 UNTIL WS-REC-ERR-IDX > WS-REC-ERR-COUNT MOVE IN-RECORD-ID TO ERR-RPT-RECORD-ID MOVE WS-RE-FIELD(WS-REC-ERR-IDX) TO ERR-RPT-FIELD-NAME MOVE WS-RE-CODE(WS-REC-ERR-IDX) TO ERR-RPT-ERR-CODE MOVE WS-RE-DESC(WS-REC-ERR-IDX) TO ERR-RPT-ERR-DESC MOVE WS-RE-SEVERITY(WS-REC-ERR-IDX) TO ERR-RPT-SEVERITY WRITE ERR-RPT-REC IF WS-ERR-RPT-STATUS NOT = '00' DISPLAY '3300: WRITE ERR-RPT failed status=' WS-ERR-RPT-STATUS END-IF END-PERFORM. EXIT SECTION. *> *> ============================================================ *> 4000-REPORT : Finalize error report with summary counts *> ============================================================ 4000-REPORT SECTION. I4000-START. DISPLAY 'ValidationNodup: 4000-REPORT...'. MOVE WS-TOTAL-READ TO WS-ED-TOTAL. MOVE WS-GOOD-COUNT TO WS-ED-GOOD. MOVE WS-BAD-COUNT TO WS-ED-BAD. MOVE WS-VALID-COUNT TO WS-ED-VALID. MOVE WS-INVALID-COUNT TO WS-ED-INVALID. MOVE WS-HASH-DURATION TO WS-ED-HASH. *> Summary header MOVE SPACES TO ERR-RPT-REC. STRING '--- End of Error Detail ---' INTO ERR-RPT-RECORD-ID. WRITE ERR-RPT-REC. MOVE SPACES TO ERR-RPT-REC. STRING '*** ERROR REPORT SUMMARY ***' INTO ERR-RPT-RECORD-ID. WRITE ERR-RPT-REC. MOVE SPACES TO ERR-RPT-REC. STRING 'Batch: ' WS-TIMESTAMP INTO ERR-RPT-RECORD-ID. WRITE ERR-RPT-REC. MOVE SPACES TO ERR-RPT-REC. WRITE ERR-RPT-REC. *> Record counts MOVE SPACES TO ERR-RPT-REC. STRING 'Records read :' WS-ED-TOTAL INTO ERR-RPT-RECORD-ID. WRITE ERR-RPT-REC. MOVE SPACES TO ERR-RPT-REC. STRING 'Records good :' WS-ED-GOOD INTO ERR-RPT-RECORD-ID. WRITE ERR-RPT-REC. MOVE SPACES TO ERR-RPT-REC. STRING 'Records bad :' WS-ED-BAD INTO ERR-RPT-RECORD-ID. WRITE ERR-RPT-REC. MOVE SPACES TO ERR-RPT-REC. STRING 'Valid (no errors) :' WS-ED-VALID INTO ERR-RPT-RECORD-ID. WRITE ERR-RPT-REC. MOVE SPACES TO ERR-RPT-REC. STRING 'Invalid (w/errors):' WS-ED-INVALID INTO ERR-RPT-RECORD-ID. WRITE ERR-RPT-REC. MOVE WS-PROCESSED-COUNT TO WS-ED-TOTAL. MOVE SPACES TO ERR-RPT-REC. STRING 'Total processed :' WS-ED-TOTAL INTO ERR-RPT-RECORD-ID. WRITE ERR-RPT-REC. *> Hash totals MOVE SPACES TO ERR-RPT-REC. STRING 'Hash duration :' WS-ED-HASH INTO ERR-RPT-RECORD-ID. WRITE ERR-RPT-REC. MOVE SPACES TO ERR-RPT-REC. WRITE ERR-RPT-REC. *> Error code breakdown MOVE SPACES TO ERR-RPT-REC. STRING '--- Error Code Breakdown ---' INTO ERR-RPT-RECORD-ID. WRITE ERR-RPT-REC. PERFORM VARYING WS-ED-IDX FROM 1 BY 1 UNTIL WS-ED-IDX > WS-ERR-DEF-COUNT MOVE WS-ED-COUNT(WS-ED-IDX) TO WS-ED-ERR-COUNT MOVE SPACES TO ERR-RPT-REC STRING WS-ED-CODE(WS-ED-IDX) ' ' WS-ED-SEVERITY(WS-ED-IDX) ' ' WS-ED-ERR-COUNT ' ' WS-ED-DESC(WS-ED-IDX)(1:30) INTO ERR-RPT-RECORD-ID WRITE ERR-RPT-REC END-PERFORM. MOVE SPACES TO ERR-RPT-REC. STRING '*** END OF REPORT ***' INTO ERR-RPT-RECORD-ID. WRITE ERR-RPT-REC. *> Close ERROR-REPORT CLOSE ERROR-REPORT. IF WS-ERR-RPT-STATUS NOT = '00' AND NOT = '10' DISPLAY '4000: CLOSE ERROR-REPORT status=' WS-ERR-RPT-STATUS END-IF. DISPLAY 'ValidationNodup: 4000-REPORT complete'. EXIT SECTION. *> *> ============================================================ *> 5000-AUDIT : Write audit summary with validation summary *> ============================================================ 5000-AUDIT SECTION. I5000-START. DISPLAY 'ValidationNodup: 5000-AUDIT...'. MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-TIME. STRING WS-CURR-YEAR '-' WS-CURR-MONTH '-' WS-CURR-DAY ' ' WS-CURR-HOUR ':' WS-CURR-MIN ':' WS-CURR-SEC INTO WS-TIMESTAMP. *> Audit header MOVE SPACES TO AUDIT-REC. STRING '=== VALIDATION AUDIT LOG ===' INTO AUDIT-REC. WRITE AUDIT-REC. IF WS-AUDIT-STATUS NOT = '00' DISPLAY '5000: WRITE AUDIT header status=' WS-AUDIT-STATUS END-IF. *> Program ID and timestamp MOVE SPACES TO AUDIT-REC. STRING 'Program: ValidationNodup' INTO AUDIT-REC. WRITE AUDIT-REC. MOVE SPACES TO AUDIT-REC. STRING 'Batch timestamp: ' WS-TIMESTAMP INTO AUDIT-REC. WRITE AUDIT-REC. MOVE SPACES TO AUDIT-REC. WRITE AUDIT-REC. *> Summary counts MOVE WS-TOTAL-READ TO WS-ED-TOTAL. MOVE WS-GOOD-COUNT TO WS-ED-GOOD. MOVE WS-BAD-COUNT TO WS-ED-BAD. MOVE WS-VALID-COUNT TO WS-ED-VALID. MOVE WS-INVALID-COUNT TO WS-ED-INVALID. MOVE SPACES TO AUDIT-REC. STRING 'Records read :' WS-ED-TOTAL INTO AUDIT-REC. WRITE AUDIT-REC. MOVE SPACES TO AUDIT-REC. STRING 'Records good :' WS-ED-GOOD INTO AUDIT-REC. WRITE AUDIT-REC. MOVE SPACES TO AUDIT-REC. STRING 'Records bad :' WS-ED-BAD INTO AUDIT-REC. WRITE AUDIT-REC. MOVE SPACES TO AUDIT-REC. STRING 'Valid (no err) :' WS-ED-VALID INTO AUDIT-REC. WRITE AUDIT-REC. MOVE SPACES TO AUDIT-REC. STRING 'Invalid (error):' WS-ED-INVALID INTO AUDIT-REC. WRITE AUDIT-REC. *> Control totals MOVE SPACES TO AUDIT-REC. STRING 'Control recs :' WS-CONTROL-TOTAL-REC INTO AUDIT-REC. WRITE AUDIT-REC. MOVE SPACES TO AUDIT-REC. STRING 'Control good :' WS-CONTROL-TOTAL-GOOD INTO AUDIT-REC. WRITE AUDIT-REC. MOVE SPACES TO AUDIT-REC. STRING 'Control bad :' WS-CONTROL-TOTAL-BAD INTO AUDIT-REC. WRITE AUDIT-REC. MOVE SPACES TO AUDIT-REC. WRITE AUDIT-REC. *> Hash totals (data integrity) MOVE WS-HASH-DURATION TO WS-ED-HASH. MOVE SPACES TO AUDIT-REC. STRING 'Hash duration :' WS-ED-HASH INTO AUDIT-REC. WRITE AUDIT-REC. MOVE WS-HASH-CALLER-CHARS TO WS-ED-HASH. MOVE SPACES TO AUDIT-REC. STRING 'Hash caller :' WS-ED-HASH INTO AUDIT-REC. WRITE AUDIT-REC. MOVE SPACES TO AUDIT-REC. WRITE AUDIT-REC. *> Error code count breakdown MOVE SPACES TO AUDIT-REC. STRING '--- Error Counts by Code ---' INTO AUDIT-REC. WRITE AUDIT-REC. PERFORM VARYING WS-ED-IDX FROM 1 BY 1 UNTIL WS-ED-IDX > WS-ERR-DEF-COUNT MOVE WS-ED-COUNT(WS-ED-IDX) TO WS-ED-ERR-COUNT MOVE SPACES TO AUDIT-REC STRING WS-ED-CODE(WS-ED-IDX) ' ' WS-ED-SEVERITY(WS-ED-IDX) ' ' WS-ED-ERR-COUNT ' ' WS-ED-DESC(WS-ED-IDX)(1:35) INTO AUDIT-REC WRITE AUDIT-REC END-PERFORM. MOVE SPACES TO AUDIT-REC. WRITE AUDIT-REC. *> Severity legend and validation rules MOVE SPACES TO AUDIT-REC. STRING 'Severity: LOW=format MED=data HIGH=critical' INTO AUDIT-REC. WRITE AUDIT-REC. MOVE SPACES TO AUDIT-REC. STRING 'Rules: R1A/E001 R1B/E002 R2A/E003 R2B/E004' INTO AUDIT-REC. WRITE AUDIT-REC. MOVE SPACES TO AUDIT-REC. STRING ' R3A/E005 R3B/E006 R4A/E007 R4B/E008' INTO AUDIT-REC. WRITE AUDIT-REC. MOVE SPACES TO AUDIT-REC. WRITE AUDIT-REC. *> File list MOVE SPACES TO AUDIT-REC. STRING 'Input : file-in.dat' INTO AUDIT-REC. WRITE AUDIT-REC. MOVE SPACES TO AUDIT-REC. STRING 'Output: file-out-good.dat' INTO AUDIT-REC. WRITE AUDIT-REC. MOVE SPACES TO AUDIT-REC. STRING 'Output: file-out-bad.dat' INTO AUDIT-REC. WRITE AUDIT-REC. MOVE SPACES TO AUDIT-REC. STRING 'Output: error-report.dat' INTO AUDIT-REC. WRITE AUDIT-REC. MOVE SPACES TO AUDIT-REC. STRING 'Output: audit-report.dat' INTO AUDIT-REC. WRITE AUDIT-REC. *> Audit footer MOVE SPACES TO AUDIT-REC. STRING '=== END AUDIT LOG ===' INTO AUDIT-REC. WRITE AUDIT-REC. *> Close AUDIT-FILE CLOSE AUDIT-FILE. IF WS-AUDIT-STATUS NOT = '00' AND NOT = '10' DISPLAY '5000: CLOSE AUDIT-FILE status=' WS-AUDIT-STATUS END-IF. DISPLAY 'ValidationNodup: 5000-AUDIT complete'. EXIT SECTION. *> *> ============================================================ *> 6000-ERROR-HANDLE : Final error handler *> ============================================================ 6000-ERROR-HANDLE SECTION. I6000-START. DISPLAY 'ValidationNodup: 6000-ERROR-HANDLE...'. IF WS-FILE-IN-STATUS NOT = '00' AND NOT = '10' DISPLAY ' FILE-IN status=' WS-FILE-IN-STATUS END-IF. IF WS-FILE-GOOD-STATUS NOT = '00' AND NOT = '10' DISPLAY ' FILE-OUT-GOOD status=' WS-FILE-GOOD-STATUS END-IF. IF WS-FILE-BAD-STATUS NOT = '00' AND NOT = '10' DISPLAY ' FILE-OUT-BAD status=' WS-FILE-BAD-STATUS END-IF. DISPLAY 'ValidationNodup: 6000 complete'. EXIT SECTION. *> *> ============================================================ *> 9000-EXIT : Close files, display final summary, stop *> ============================================================ 9000-EXIT SECTION. I9000-START. DISPLAY 'ValidationNodup: 9000-EXIT...'. CLOSE FILE-IN. IF WS-FILE-IN-STATUS NOT = '00' AND NOT = '10' DISPLAY ' CLOSE FILE-IN status=' WS-FILE-IN-STATUS ELSE DISPLAY ' FILE-IN closed status=' WS-FILE-IN-STATUS END-IF. CLOSE FILE-OUT-GOOD. IF WS-FILE-GOOD-STATUS NOT = '00' AND NOT = '10' DISPLAY ' CLOSE GOOD status=' WS-FILE-GOOD-STATUS ELSE DISPLAY ' FILE-OUT-GOOD closed status=' WS-FILE-GOOD-STATUS END-IF. CLOSE FILE-OUT-BAD. IF WS-FILE-BAD-STATUS NOT = '00' AND NOT = '10' DISPLAY ' CLOSE BAD status=' WS-FILE-BAD-STATUS ELSE DISPLAY ' FILE-OUT-BAD closed status=' WS-FILE-BAD-STATUS END-IF. *> Final timestamp MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-TIME. STRING WS-CURR-YEAR '-' WS-CURR-MONTH '-' WS-CURR-DAY ' ' WS-CURR-HOUR ':' WS-CURR-MIN ':' WS-CURR-SEC INTO WS-TIMESTAMP. *> Edited counters MOVE WS-TOTAL-READ TO WS-ED-TOTAL. MOVE WS-GOOD-COUNT TO WS-ED-GOOD. MOVE WS-BAD-COUNT TO WS-ED-BAD. MOVE WS-VALID-COUNT TO WS-ED-VALID. MOVE WS-INVALID-COUNT TO WS-ED-INVALID. MOVE WS-HASH-DURATION TO WS-ED-HASH. *> Display final summary DISPLAY ' ' DISPLAY '========================================'. DISPLAY 'ValidationNodup: FINAL SUMMARY'. DISPLAY 'End: ' WS-TIMESTAMP. DISPLAY 'Records read : ' WS-ED-TOTAL. DISPLAY 'Records good (valid): ' WS-ED-GOOD. DISPLAY 'Records bad (invalid): ' WS-ED-BAD. DISPLAY 'Valid (no errors) : ' WS-ED-VALID. DISPLAY 'Invalid (w/errors) : ' WS-ED-INVALID. DISPLAY 'Hash duration total : ' WS-ED-HASH. DISPLAY 'Error breakdown:' PERFORM VARYING WS-ED-IDX FROM 1 BY 1 UNTIL WS-ED-IDX > WS-ERR-DEF-COUNT MOVE WS-ED-COUNT(WS-ED-IDX) TO WS-ED-ERR-COUNT DISPLAY ' ' WS-ED-CODE(WS-ED-IDX) ' ' WS-ED-SEVERITY(WS-ED-IDX) ' ' WS-ED-ERR-COUNT ' ' WS-ED-DESC(WS-ED-IDX)(1:30) END-PERFORM. DISPLAY 'Error report : error-report.dat'. DISPLAY 'Audit report : audit-report.dat'. DISPLAY '========================================'. MOVE WS-RETURN-CODE TO RETURN-CODE. DISPLAY 'ValidationNodup: Done. RC=' WS-RETURN-CODE. STOP RUN. *> END PROGRAM ValidationNodup.