Files
cobol-java-v3/benchmark-programs/31-validation-withdup/main-31-validation-withdup.cbl
T
NB-076 94400d50d4 feat: add benchmark-programs — 58 telecom COBOL test programs
作为子目录纳入系统,与核心测试管道协同

Co-Authored-By: Claude <noreply@anthropic.com>
2026-06-25 09:53:21 +08:00

684 lines
28 KiB
COBOL

*> ============================================================
*> 31-validation-withdup : Duplicate CDR Detection
*> Input : FILE-IN (file-in.dat: sorted CDR records)
*> Output : FILE-OUT-GOOD (file-out-good.dat: non-duplicate)
*> FILE-OUT-BAD (file-out-bad.dat: duplicate)
*> FILE-OUT-AUDIT (audit-file.dat: statistics)
*> Coverage: VF-N003, VF-N004, VF-R001
*> Features:
*> - SECTION structure (10 sections)
*> - Multi-key duplicate detection (primary + secondary key)
*> - Duplicate frequency tracking per key pair
*> - Duplicate rate reporting as percentage
*> - Batch-level duplicate statistics
*> - Error detail report with dup frequency per key
*> - FILE STATUS checks after every I/O
*> - Audit file with statistics and timestamps
*> - DISPLAY tracing with timestamp
*> - Hash totals for data integrity
*> - Batch control totals
*> ============================================================
IDENTIFICATION DIVISION.
PROGRAM-ID. ValidationWithdup.
*>
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
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS WS-FILE-GOOD-STATUS.
SELECT FILE-OUT-BAD ASSIGN TO 'file-out-bad.dat'
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS WS-FILE-BAD-STATUS.
SELECT FILE-OUT-AUDIT ASSIGN TO 'audit-file.dat'
ORGANIZATION IS SEQUENTIAL
ACCESS MODE IS SEQUENTIAL
FILE STATUS IS WS-FILE-AUDIT-STATUS.
*>
DATA DIVISION.
FILE SECTION.
FD FILE-IN.
01 IN-REC.
05 IN-KEY PIC X(05).
05 IN-DATA PIC X(30).
*>
FD FILE-OUT-GOOD.
01 GOOD-REC.
05 GOOD-KEY PIC X(05).
05 GOOD-DATA PIC X(30).
*>
FD FILE-OUT-BAD.
01 BAD-REC.
05 BAD-KEY PIC X(05).
05 BAD-DATA PIC X(30).
05 BAD-ERR PIC X(02).
*>
FD FILE-OUT-AUDIT.
01 AUDIT-OUT-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-FILE-AUDIT-STATUS PIC X(02).
*>
*> File open flags
01 WS-FILE-OPEN-FLAGS.
05 WS-FILE-IN-OPEN PIC X(01) VALUE 'N'.
88 WS-FILE-IN-OPEN-YES VALUE 'Y' FALSE 'N'.
05 WS-FILE-GOOD-OPEN PIC X(01) VALUE 'N'.
88 WS-FILE-GOOD-OPEN-YES VALUE 'Y' FALSE 'N'.
05 WS-FILE-BAD-OPEN PIC X(01) VALUE 'N'.
88 WS-FILE-BAD-OPEN-YES VALUE 'Y' FALSE 'N'.
05 WS-FILE-AUDIT-OPEN PIC X(01) VALUE 'N'.
88 WS-FILE-AUDIT-OPEN-YES VALUE 'Y' FALSE 'N'.
*>
*> Control flags
01 WS-CONTROL-FLAGS.
05 WS-EOF PIC X(01) VALUE 'N'.
88 WS-EOF-YES VALUE 'Y' FALSE 'N'.
05 WS-DUP-FLAG PIC X(01) VALUE 'N'.
88 WS-IS-DUPLICATE VALUE 'Y' FALSE 'N'.
05 WS-KEY-FOUND PIC X(01) VALUE 'N'.
88 WS-KEY-FOUND-YES VALUE 'Y' FALSE 'N'.
*>
*> Batch control counters
01 WS-COUNTERS.
05 WS-GOOD-COUNT PIC 9(05) VALUE ZERO.
05 WS-BAD-COUNT PIC 9(05) VALUE ZERO.
05 WS-TOTAL-READ PIC 9(05) VALUE ZERO.
05 WS-TOTAL-UNIQUE PIC 9(05) VALUE ZERO.
05 WS-TOTAL-DUPS PIC 9(05) VALUE ZERO.
05 WS-MAX-DUP-FREQ PIC 9(05) VALUE ZERO.
05 WS-DUP-FREQ-SUM PIC 9(07) VALUE ZERO.
*>
*> Timestamp buffer
01 WS-CURRENT-DATE PIC X(21).
01 WS-TRACE-MSG PIC X(60).
*>
*> Hash totals for data integrity
01 WS-HASH-TOTALS.
05 WS-HASH-GOOD PIC 9(09) VALUE ZERO.
05 WS-HASH-BAD PIC 9(09) VALUE ZERO.
05 WS-HASH-ALL PIC 9(09) VALUE ZERO.
05 WS-HASH-CHAR PIC 9(03) VALUE ZERO.
*>
*> Computation fields
01 WS-COMP-FIELDS.
05 WS-DUP-RATE PIC 9(03)V99.
05 WS-DUP-RATE-DISP PIC ZZ9.99.
05 WS-AVG-DUP-FREQ PIC 9(05)V99.
05 WS-AVG-DISP PIC ZZZ9.99.
*>
*> Key table indexes
01 WS-IDX PIC 9(03).
01 WS-ENTRY-COUNT PIC 9(03) VALUE ZERO.
01 WS-MAX-ENTRIES PIC 9(03) VALUE 100.
01 WS-J PIC 9(03).
*>
*> Key lookup table - stores unique primary+secondary key pairs
*> with occurrence and duplicate counts
01 WS-KEY-TABLE.
05 WS-KEY-ENTRY OCCURS 100 TIMES.
10 WS-KEY-PRIMARY PIC X(05).
10 WS-KEY-SECONDARY PIC X(10).
10 WS-KEY-TOTAL-CNT PIC 9(05).
10 WS-KEY-DUP-CNT PIC 9(05).
*>
*> Secondary key (first 10 characters of IN-DATA)
01 WS-SECONDARY-KEY PIC X(10).
*>
*> Audit record buffer
01 WS-AUDIT-BUFFER.
05 WS-AUDIT-TYPE PIC X(10).
05 WS-AUDIT-SEP1 PIC X(02) VALUE ' | '.
05 WS-AUDIT-DATE PIC X(08).
05 WS-AUDIT-SEP2 PIC X(02) VALUE ' | '.
05 WS-AUDIT-TIME PIC X(08).
05 WS-AUDIT-SEP3 PIC X(02) VALUE ' | '.
05 WS-AUDIT-STATS PIC X(48).
*>
*> Error message buffer
01 WS-ERROR-MSG PIC X(80).
*>
*> Temporary working fields
01 WS-TEMP-COUNT PIC 9(05).
01 WS-WARN-TABLE-FULL PIC X(01) VALUE 'N'.
88 WS-WARN-TABLE-FULL-YES VALUE 'Y' FALSE 'N'.
*>
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 9000-EXIT.
STOP RUN.
*>
*> ============================================================
*> 1000-INIT : Initialize program state, clear counters,
*> display startup trace.
*> ============================================================
1000-INIT SECTION.
MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-DATE.
MOVE '1000-INIT: Program starting' TO WS-TRACE-MSG.
PERFORM DISPLAY-TRACE.
INITIALIZE WS-COUNTERS.
INITIALIZE WS-HASH-TOTALS.
INITIALIZE WS-COMP-FIELDS.
MOVE ZERO TO WS-ENTRY-COUNT.
MOVE 'N' TO WS-EOF.
MOVE 'N' TO WS-DUP-FLAG.
MOVE 'N' TO WS-KEY-FOUND.
MOVE 'N' TO WS-WARN-TABLE-FULL.
MOVE '1000-INIT: Initialization complete' TO WS-TRACE-MSG.
PERFORM DISPLAY-TRACE.
EXIT.
*>
*> ============================================================
*> 2000-OPEN-FILES : Open all four files and verify
*> each FILE STATUS after OPEN. Abort on error.
*> ============================================================
2000-OPEN-FILES SECTION.
MOVE '2000-OPEN-FILES: Opening FILE-IN'
TO WS-TRACE-MSG.
PERFORM DISPLAY-TRACE.
OPEN INPUT FILE-IN.
IF WS-FILE-IN-STATUS NOT = '00'
AND WS-FILE-IN-STATUS NOT = '0'
STRING '2000-OPEN-FILES: ERROR FILE-IN status '
WS-FILE-IN-STATUS DELIMITED BY SIZE
INTO WS-ERROR-MSG
END-STRING
PERFORM 6000-ERROR-HANDLE
MOVE 1 TO RETURN-CODE
STOP RUN
END-IF.
SET WS-FILE-IN-OPEN-YES TO TRUE.
MOVE '2000-OPEN-FILES: FILE-IN opened OK' TO WS-TRACE-MSG.
PERFORM DISPLAY-TRACE.
OPEN OUTPUT FILE-OUT-GOOD.
IF WS-FILE-GOOD-STATUS NOT = '00'
AND WS-FILE-GOOD-STATUS NOT = '0'
STRING '2000-OPEN-FILES: ERROR FILE-OUT-GOOD status '
WS-FILE-GOOD-STATUS DELIMITED BY SIZE
INTO WS-ERROR-MSG
END-STRING
PERFORM 6000-ERROR-HANDLE
MOVE 1 TO RETURN-CODE
STOP RUN
END-IF.
SET WS-FILE-GOOD-OPEN-YES TO TRUE.
MOVE '2000-OPEN-FILES: FILE-OUT-GOOD opened OK'
TO WS-TRACE-MSG.
PERFORM DISPLAY-TRACE.
OPEN OUTPUT FILE-OUT-BAD.
IF WS-FILE-BAD-STATUS NOT = '00'
AND WS-FILE-BAD-STATUS NOT = '0'
STRING '2000-OPEN-FILES: ERROR FILE-OUT-BAD status '
WS-FILE-BAD-STATUS DELIMITED BY SIZE
INTO WS-ERROR-MSG
END-STRING
PERFORM 6000-ERROR-HANDLE
MOVE 1 TO RETURN-CODE
STOP RUN
END-IF.
SET WS-FILE-BAD-OPEN-YES TO TRUE.
MOVE '2000-OPEN-FILES: FILE-OUT-BAD opened OK'
TO WS-TRACE-MSG.
PERFORM DISPLAY-TRACE.
OPEN OUTPUT FILE-OUT-AUDIT.
IF WS-FILE-AUDIT-STATUS NOT = '00'
AND WS-FILE-AUDIT-STATUS NOT = '0'
STRING '2000-OPEN-FILES: ERROR FILE-OUT-AUDIT status '
WS-FILE-AUDIT-STATUS DELIMITED BY SIZE
INTO WS-ERROR-MSG
END-STRING
PERFORM 6000-ERROR-HANDLE
MOVE 1 TO RETURN-CODE
STOP RUN
END-IF.
SET WS-FILE-AUDIT-OPEN-YES TO TRUE.
MOVE '2000-OPEN-FILES: FILE-OUT-AUDIT opened OK'
TO WS-TRACE-MSG.
PERFORM DISPLAY-TRACE.
EXIT.
*>
*> ============================================================
*> 3000-READ-INPUT : Read next input record. At EOF set
*> WS-EOF-YES. On non-EOF increment total-read counter
*> and dispatch to validate. FILE STATUS checked.
*> ============================================================
3000-READ-INPUT SECTION.
READ FILE-IN
AT END
SET WS-EOF-YES TO TRUE
MOVE '3000-READ-INPUT: EOF reached'
TO WS-TRACE-MSG
PERFORM DISPLAY-TRACE
NOT AT END
ADD 1 TO WS-TOTAL-READ
PERFORM 3100-VALIDATE-RECORD
END-READ.
IF WS-FILE-IN-STATUS NOT = '00'
AND WS-FILE-IN-STATUS NOT = '10'
STRING '3000-READ-INPUT: READ error status '
WS-FILE-IN-STATUS DELIMITED BY SIZE
INTO WS-ERROR-MSG
END-STRING
PERFORM 6000-ERROR-HANDLE
END-IF.
EXIT.
*>
*> ============================================================
*> 3100-VALIDATE-RECORD : Check current record against the
*> key table. A duplicate match requires BOTH primary key
*> (IN-KEY) AND secondary key (first 10 chars of IN-DATA)
*> to match a previously seen entry.
*> - Duplicate found : increment dup counters, compute
*> bad hash, write to bad output.
*> - New unique key : add to key table, compute good hash,
*> process record, write to good output.
*> ============================================================
3100-VALIDATE-RECORD SECTION.
MOVE IN-DATA(1:10) TO WS-SECONDARY-KEY.
MOVE 'N' TO WS-DUP-FLAG.
MOVE 'N' TO WS-KEY-FOUND.
IF WS-ENTRY-COUNT > 0
PERFORM VARYING WS-IDX FROM 1 BY 1
UNTIL WS-IDX > WS-ENTRY-COUNT
OR WS-KEY-FOUND-YES
IF IN-KEY = WS-KEY-PRIMARY(WS-IDX)
AND WS-SECONDARY-KEY
= WS-KEY-SECONDARY(WS-IDX)
SET WS-KEY-FOUND-YES TO TRUE
END-IF
END-PERFORM
END-IF.
IF WS-KEY-FOUND-YES
ADD 1 TO WS-KEY-TOTAL-CNT(WS-IDX)
ADD 1 TO WS-KEY-DUP-CNT(WS-IDX)
ADD 1 TO WS-TOTAL-DUPS
SET WS-IS-DUPLICATE TO TRUE
STRING '3100-VALIDATE-RECORD: Duplicate key='
IN-KEY DELIMITED BY SIZE
' dup#' WS-KEY-DUP-CNT(WS-IDX)
INTO WS-TRACE-MSG
END-STRING
PERFORM DISPLAY-TRACE
PERFORM COMPUTE-HASH-BAD
PERFORM 3300-WRITE-OUTPUT
ELSE
ADD 1 TO WS-ENTRY-COUNT
IF WS-ENTRY-COUNT <= WS-MAX-ENTRIES
MOVE IN-KEY TO WS-KEY-PRIMARY(WS-ENTRY-COUNT)
MOVE WS-SECONDARY-KEY
TO WS-KEY-SECONDARY(WS-ENTRY-COUNT)
MOVE 1 TO WS-KEY-TOTAL-CNT(WS-ENTRY-COUNT)
MOVE 0 TO WS-KEY-DUP-CNT(WS-ENTRY-COUNT)
ADD 1 TO WS-TOTAL-UNIQUE
ELSE
IF NOT WS-WARN-TABLE-FULL-YES
SET WS-WARN-TABLE-FULL-YES TO TRUE
MOVE '3100: Key table full, some keys '
& 'not tracked' TO WS-TRACE-MSG
PERFORM DISPLAY-TRACE
END-IF
END-IF
MOVE 'N' TO WS-DUP-FLAG
PERFORM 3200-PROCESS-RECORD
PERFORM 3300-WRITE-OUTPUT
END-IF.
EXIT.
*>
*> ============================================================
*> 3200-PROCESS-RECORD : Prepare a good (non-duplicate)
*> record for output. Copy fields, compute good hash,
*> update hash totals.
*> ============================================================
3200-PROCESS-RECORD SECTION.
MOVE IN-KEY TO GOOD-KEY.
MOVE IN-DATA TO GOOD-DATA.
PERFORM COMPUTE-HASH-GOOD.
MOVE '3200-PROCESS-RECORD: Good record prepared'
TO WS-TRACE-MSG.
PERFORM DISPLAY-TRACE.
EXIT.
*>
*> ============================================================
*> 3300-WRITE-OUTPUT : Write record to the appropriate
*> output file (GOOD or BAD) based on WS-DUP-FLAG.
*> FILE STATUS is verified after each WRITE.
*> ============================================================
3300-WRITE-OUTPUT SECTION.
IF WS-IS-DUPLICATE
MOVE IN-KEY TO BAD-KEY
MOVE IN-DATA TO BAD-DATA
MOVE '01' TO BAD-ERR
WRITE BAD-REC
IF WS-FILE-BAD-STATUS NOT = '00'
STRING '3300-WRITE-OUTPUT: BAD WRITE status '
WS-FILE-BAD-STATUS DELIMITED BY SIZE
INTO WS-ERROR-MSG
END-STRING
PERFORM 6000-ERROR-HANDLE
ELSE
ADD 1 TO WS-BAD-COUNT
MOVE '3300-WRITE-OUTPUT: Written to BAD output'
TO WS-TRACE-MSG
PERFORM DISPLAY-TRACE
END-IF
ELSE
WRITE GOOD-REC
IF WS-FILE-GOOD-STATUS NOT = '00'
STRING '3300-WRITE-OUTPUT: GOOD WRITE status '
WS-FILE-GOOD-STATUS DELIMITED BY SIZE
INTO WS-ERROR-MSG
END-STRING
PERFORM 6000-ERROR-HANDLE
ELSE
ADD 1 TO WS-GOOD-COUNT
END-IF
END-IF.
EXIT.
*>
*> ============================================================
*> 4000-REPORT : Calculate and display batch-level
*> duplicate statistics:
*> - Total records read, unique keys, duplicates
*> - Duplicate rate as percentage
*> - Max dup frequency, average dup frequency
*> - Hash totals for integrity verification
*> - Error detail report listing each key pair that
*> had duplicates along with its dup frequency count
*> ============================================================
4000-REPORT SECTION.
MOVE '4000-REPORT: Generating batch statistics'
TO WS-TRACE-MSG.
PERFORM DISPLAY-TRACE.
*>
*> Calculate duplicate rate as percentage
IF WS-TOTAL-READ > 0
COMPUTE WS-DUP-RATE ROUNDED =
(WS-BAD-COUNT / WS-TOTAL-READ) * 100
MOVE WS-DUP-RATE TO WS-DUP-RATE-DISP
ELSE
MOVE ZERO TO WS-DUP-RATE
MOVE '0.00' TO WS-DUP-RATE-DISP
END-IF.
*>
*> Calculate max dup frequency and total dup sum
MOVE ZERO TO WS-MAX-DUP-FREQ.
MOVE ZERO TO WS-DUP-FREQ-SUM.
IF WS-ENTRY-COUNT > 0
PERFORM VARYING WS-J FROM 1 BY 1
UNTIL WS-J > WS-ENTRY-COUNT
IF WS-KEY-DUP-CNT(WS-J) > WS-MAX-DUP-FREQ
MOVE WS-KEY-DUP-CNT(WS-J)
TO WS-MAX-DUP-FREQ
END-IF
ADD WS-KEY-DUP-CNT(WS-J) TO WS-DUP-FREQ-SUM
END-PERFORM
END-IF.
*>
*> Calculate average dup frequency
IF WS-TOTAL-UNIQUE > 0
COMPUTE WS-AVG-DUP-FREQ ROUNDED =
WS-DUP-FREQ-SUM / WS-TOTAL-UNIQUE
MOVE WS-AVG-DUP-FREQ TO WS-AVG-DISP
ELSE
MOVE ZERO TO WS-AVG-DUP-FREQ
MOVE '0.00' TO WS-AVG-DISP
END-IF.
*>
*> Display batch summary report
DISPLAY ' '.
DISPLAY '============================================'.
DISPLAY '============================================'.
DISPLAY ' Program : ValidationWithdup'.
DISPLAY ' Total records : ' WS-TOTAL-READ.
DISPLAY ' Good output : ' WS-GOOD-COUNT.
DISPLAY ' Bad (duplicate): ' WS-BAD-COUNT.
DISPLAY ' Unique keys : ' WS-TOTAL-UNIQUE.
DISPLAY ' Total dups : ' WS-TOTAL-DUPS.
DISPLAY ' Duplicate rate : ' WS-DUP-RATE-DISP '%'.
DISPLAY ' Max dup freq : ' WS-MAX-DUP-FREQ.
DISPLAY ' Avg dup freq : ' WS-AVG-DISP.
DISPLAY ' Hash good : ' WS-HASH-GOOD.
DISPLAY ' Hash bad : ' WS-HASH-BAD.
DISPLAY ' Hash all : ' WS-HASH-ALL.
DISPLAY '============================================'.
DISPLAY ' '.
*>
*> Error detail report showing dup frequency per key
DISPLAY 'ERROR DETAIL REPORT - Dup Frequency per Key'.
DISPLAY '-------------------------------------------'.
DISPLAY ' Primary Secondary Total DupCount'.
DISPLAY '-------------------------------------------'.
IF WS-ENTRY-COUNT > 0
PERFORM VARYING WS-J FROM 1 BY 1
UNTIL WS-J > WS-ENTRY-COUNT
IF WS-KEY-DUP-CNT(WS-J) > 0
DISPLAY WS-KEY-PRIMARY(WS-J) ' '
WS-KEY-SECONDARY(WS-J) ' '
WS-KEY-TOTAL-CNT(WS-J) ' '
WS-KEY-DUP-CNT(WS-J)
END-IF
END-PERFORM
ELSE
DISPLAY ' (No key pairs recorded)'
END-IF.
DISPLAY '-------------------------------------------'.
DISPLAY ' '.
EXIT.
*>
*> ============================================================
*> 5000-AUDIT : Write audit trail file with batch-level
*> duplicate statistics and timestamps. Records written:
*> HEADER, STATS, HASH, MAXDUP, FOOTER.
*> ============================================================
5000-AUDIT SECTION.
MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-DATE.
MOVE '5000-AUDIT: Writing audit file' TO WS-TRACE-MSG.
PERFORM DISPLAY-TRACE.
IF WS-FILE-AUDIT-OPEN-YES
MOVE 'HEADER' TO WS-AUDIT-TYPE
MOVE WS-CURRENT-DATE(1:8) TO WS-AUDIT-DATE
MOVE WS-CURRENT-DATE(9:8) TO WS-AUDIT-TIME
MOVE 'Batch Report - ValidationWithdup'
TO WS-AUDIT-STATS
MOVE WS-AUDIT-BUFFER TO AUDIT-OUT-REC
WRITE AUDIT-OUT-REC
IF WS-FILE-AUDIT-STATUS NOT = '00'
STRING '5000-AUDIT: WRITE HEADER status '
WS-FILE-AUDIT-STATUS DELIMITED BY SIZE
INTO WS-ERROR-MSG
END-STRING
PERFORM 6000-ERROR-HANDLE
END-IF
MOVE 'STATS' TO WS-AUDIT-TYPE
MOVE WS-CURRENT-DATE(1:8) TO WS-AUDIT-DATE
MOVE WS-CURRENT-DATE(9:8) TO WS-AUDIT-TIME
STRING 'READ=' WS-TOTAL-READ
' GOOD=' WS-GOOD-COUNT
' BAD=' WS-BAD-COUNT
' UNIQUE=' WS-TOTAL-UNIQUE
' DUP=' WS-TOTAL-DUPS
' RATE=' WS-DUP-RATE-DISP '%'
DELIMITED BY SIZE
INTO WS-AUDIT-STATS
END-STRING
MOVE WS-AUDIT-BUFFER TO AUDIT-OUT-REC
WRITE AUDIT-OUT-REC
IF WS-FILE-AUDIT-STATUS NOT = '00'
STRING '5000-AUDIT: WRITE STATS status '
WS-FILE-AUDIT-STATUS DELIMITED BY SIZE
INTO WS-ERROR-MSG
END-STRING
PERFORM 6000-ERROR-HANDLE
END-IF
MOVE 'HASH' TO WS-AUDIT-TYPE
MOVE WS-CURRENT-DATE(1:8) TO WS-AUDIT-DATE
MOVE WS-CURRENT-DATE(9:8) TO WS-AUDIT-TIME
STRING 'GOOD=' WS-HASH-GOOD
' BAD=' WS-HASH-BAD
' ALL=' WS-HASH-ALL
DELIMITED BY SIZE
INTO WS-AUDIT-STATS
END-STRING
MOVE WS-AUDIT-BUFFER TO AUDIT-OUT-REC
WRITE AUDIT-OUT-REC
MOVE 'MAXDUP' TO WS-AUDIT-TYPE
MOVE WS-CURRENT-DATE(1:8) TO WS-AUDIT-DATE
MOVE WS-CURRENT-DATE(9:8) TO WS-AUDIT-TIME
STRING 'MAX-FREQ=' WS-MAX-DUP-FREQ
' AVG-FREQ=' WS-AVG-DISP
DELIMITED BY SIZE
INTO WS-AUDIT-STATS
END-STRING
MOVE WS-AUDIT-BUFFER TO AUDIT-OUT-REC
WRITE AUDIT-OUT-REC
MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-DATE
MOVE 'FOOTER' TO WS-AUDIT-TYPE
MOVE WS-CURRENT-DATE(1:8) TO WS-AUDIT-DATE
MOVE WS-CURRENT-DATE(9:8) TO WS-AUDIT-TIME
MOVE 'End of audit trail' TO WS-AUDIT-STATS
MOVE WS-AUDIT-BUFFER TO AUDIT-OUT-REC
WRITE AUDIT-OUT-REC
IF WS-FILE-AUDIT-STATUS NOT = '00'
STRING '5000-AUDIT: WRITE FOOTER status '
WS-FILE-AUDIT-STATUS DELIMITED BY SIZE
INTO WS-ERROR-MSG
END-STRING
PERFORM 6000-ERROR-HANDLE
END-IF
END-IF.
EXIT.
*>
*> ============================================================
*> 6000-ERROR-HANDLE : Log error to DISPLAY with timestamp
*> and write error record to audit file if available.
*> ============================================================
6000-ERROR-HANDLE SECTION.
MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-DATE.
DISPLAY WS-CURRENT-DATE(1:8) ' '
WS-CURRENT-DATE(9:8) ' - ERROR: '
WS-ERROR-MSG.
IF WS-FILE-AUDIT-OPEN-YES
MOVE 'ERROR' TO WS-AUDIT-TYPE
MOVE WS-CURRENT-DATE(1:8) TO WS-AUDIT-DATE
MOVE WS-CURRENT-DATE(9:8) TO WS-AUDIT-TIME
MOVE WS-ERROR-MSG TO WS-AUDIT-STATS
MOVE WS-AUDIT-BUFFER TO AUDIT-OUT-REC
WRITE AUDIT-OUT-REC
END-IF.
EXIT.
*>
*> ============================================================
*> 9000-EXIT : Close all open files with FILE STATUS
*> verification, display final completion message.
*> ============================================================
9000-EXIT SECTION.
MOVE '9000-EXIT: Closing files' TO WS-TRACE-MSG.
PERFORM DISPLAY-TRACE.
CLOSE FILE-IN.
IF WS-FILE-IN-STATUS NOT = '00'
STRING '9000-EXIT: FILE-IN CLOSE status '
WS-FILE-IN-STATUS DELIMITED BY SIZE
INTO WS-ERROR-MSG
END-STRING
PERFORM 6000-ERROR-HANDLE
END-IF.
CLOSE FILE-OUT-GOOD.
IF WS-FILE-GOOD-STATUS NOT = '00'
STRING '9000-EXIT: FILE-OUT-GOOD CLOSE status '
WS-FILE-GOOD-STATUS DELIMITED BY SIZE
INTO WS-ERROR-MSG
END-STRING
PERFORM 6000-ERROR-HANDLE
END-IF.
CLOSE FILE-OUT-BAD.
IF WS-FILE-BAD-STATUS NOT = '00'
STRING '9000-EXIT: FILE-OUT-BAD CLOSE status '
WS-FILE-BAD-STATUS DELIMITED BY SIZE
INTO WS-ERROR-MSG
END-STRING
PERFORM 6000-ERROR-HANDLE
END-IF.
CLOSE FILE-OUT-AUDIT.
IF WS-FILE-AUDIT-STATUS NOT = '00'
STRING '9000-EXIT: FILE-OUT-AUDIT CLOSE status '
WS-FILE-AUDIT-STATUS DELIMITED BY SIZE
INTO WS-ERROR-MSG
END-STRING
PERFORM 6000-ERROR-HANDLE
END-IF.
MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-DATE.
DISPLAY WS-CURRENT-DATE(1:8) ' '
WS-CURRENT-DATE(9:8) ' - '
'ValidationWithdup: Completed. Good='
WS-GOOD-COUNT ' Bad=' WS-BAD-COUNT.
EXIT.
*>
*> ============================================================
*> DISPLAY-TRACE : Display a trace message prefixed with
*> YYYYMMDD HHMMSS timestamp.
*> ============================================================
DISPLAY-TRACE.
MOVE FUNCTION CURRENT-DATE TO WS-CURRENT-DATE.
DISPLAY WS-CURRENT-DATE(1:8) ' '
WS-CURRENT-DATE(9:8) ' - ' WS-TRACE-MSG.
*>
*> ============================================================
*> COMPUTE-HASH-GOOD : Accumulate hash total for a good
*> record by summing FUNCTION ORD of each character
*> in IN-KEY and IN-DATA.
*> ============================================================
COMPUTE-HASH-GOOD.
PERFORM VARYING WS-J FROM 1 BY 1 UNTIL WS-J > 5
COMPUTE WS-HASH-CHAR =
FUNCTION ORD(IN-KEY(WS-J:1))
ADD WS-HASH-CHAR TO WS-HASH-GOOD
ADD WS-HASH-CHAR TO WS-HASH-ALL
END-PERFORM.
PERFORM VARYING WS-J FROM 1 BY 1 UNTIL WS-J > 30
COMPUTE WS-HASH-CHAR =
FUNCTION ORD(IN-DATA(WS-J:1))
ADD WS-HASH-CHAR TO WS-HASH-GOOD
ADD WS-HASH-CHAR TO WS-HASH-ALL
END-PERFORM.
*>
*> ============================================================
*> COMPUTE-HASH-BAD : Accumulate hash total for a bad
*> (duplicate) record by summing FUNCTION ORD of each
*> character in IN-KEY and IN-DATA.
*> ============================================================
COMPUTE-HASH-BAD.
PERFORM VARYING WS-J FROM 1 BY 1 UNTIL WS-J > 5
COMPUTE WS-HASH-CHAR =
FUNCTION ORD(IN-KEY(WS-J:1))
ADD WS-HASH-CHAR TO WS-HASH-BAD
ADD WS-HASH-CHAR TO WS-HASH-ALL
END-PERFORM.
PERFORM VARYING WS-J FROM 1 BY 1 UNTIL WS-J > 30
COMPUTE WS-HASH-CHAR =
FUNCTION ORD(IN-DATA(WS-J:1))
ADD WS-HASH-CHAR TO WS-HASH-BAD
ADD WS-HASH-CHAR TO WS-HASH-ALL
END-PERFORM.
*>
END PROGRAM ValidationWithdup.