feat: add benchmark-programs — 58 telecom COBOL test programs
作为子目录纳入系统，与核心测试管道协同 Co-Authored-By: Claude <noreply@anthropic.com>
This commit is contained in:
NB-076
@@ -0,0 +1,933 @@
|
||||
>>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.
|
||||
Reference in New Issue
Block a user