NB-076
1084 lines
40 KiB
COBOL
1084 lines
40 KiB
COBOL
*> ============================================================
|
|
*> 22-matching-2stage-MN : 二级套餐M:N (2-Stage Plan M:N)
|
|
*> Input : FILE-A (file-a.dat: 合同), FILE-B (file-b.dat: 套餐),
|
|
*> FILE-C (file-c.dat: 资费)
|
|
*> Output: FINAL-OUT (final.dat: 二级M:N匹配结果)
|
|
*> Coverage: AM-N008, AM-R001
|
|
*>
|
|
*> EXPANDED: Added SECTION structure, base plan + add-on plan
|
|
*> compatibility check, discount stacking rules, stage-level
|
|
*> control totals with reconciliation, audit file, error file,
|
|
*> hash totals, tracing, FILE STATUS checks.
|
|
*> ============================================================
|
|
IDENTIFICATION DIVISION.
|
|
PROGRAM-ID. Matching2StageMN.
|
|
|
|
ENVIRONMENT DIVISION.
|
|
INPUT-OUTPUT SECTION.
|
|
FILE-CONTROL.
|
|
SELECT FILE-A ASSIGN TO "file-a.dat"
|
|
ORGANIZATION IS SEQUENTIAL
|
|
ACCESS MODE IS SEQUENTIAL
|
|
FILE STATUS IS FS-A.
|
|
SELECT FILE-B ASSIGN TO "file-b.dat"
|
|
ORGANIZATION IS SEQUENTIAL
|
|
ACCESS MODE IS SEQUENTIAL
|
|
FILE STATUS IS FS-B.
|
|
SELECT TEMP-FILE ASSIGN TO "temp.dat"
|
|
ORGANIZATION IS SEQUENTIAL
|
|
ACCESS MODE IS SEQUENTIAL
|
|
FILE STATUS IS FS-TEMP.
|
|
SELECT FILE-C ASSIGN TO "file-c.dat"
|
|
ORGANIZATION IS SEQUENTIAL
|
|
ACCESS MODE IS SEQUENTIAL
|
|
FILE STATUS IS FS-C.
|
|
SELECT FINAL-OUT ASSIGN TO "final.dat"
|
|
ORGANIZATION IS SEQUENTIAL
|
|
ACCESS MODE IS SEQUENTIAL
|
|
FILE STATUS IS FS-FINAL.
|
|
SELECT AUDIT-FILE ASSIGN TO "audit-report-22.txt"
|
|
ORGANIZATION IS LINE SEQUENTIAL
|
|
FILE STATUS IS FS-AUDIT.
|
|
SELECT ERROR-FILE ASSIGN TO "error-report-22.txt"
|
|
ORGANIZATION IS LINE SEQUENTIAL
|
|
FILE STATUS IS FS-ERROR.
|
|
|
|
DATA DIVISION.
|
|
FILE SECTION.
|
|
FD FILE-A.
|
|
01 A-REC.
|
|
COPY "STD-REC.cpy".
|
|
FD FILE-B.
|
|
01 B-REC.
|
|
COPY "STD-REC.cpy".
|
|
FD TEMP-FILE.
|
|
01 TEMP-REC.
|
|
COPY "STD-REC.cpy".
|
|
FD FILE-C.
|
|
01 C-REC.
|
|
COPY "STD-REC.cpy".
|
|
FD FINAL-OUT.
|
|
01 OUT-REC.
|
|
COPY "STD-REC.cpy".
|
|
FD AUDIT-FILE.
|
|
01 AUDIT-LINE PIC X(120).
|
|
FD ERROR-FILE.
|
|
01 ERROR-LINE PIC X(120).
|
|
|
|
WORKING-STORAGE SECTION.
|
|
|
|
*> ============================================================
|
|
*> FILE STATUS
|
|
*> ============================================================
|
|
01 FS-A PIC X(02).
|
|
01 FS-B PIC X(02).
|
|
01 FS-TEMP PIC X(02).
|
|
01 FS-C PIC X(02).
|
|
01 FS-FINAL PIC X(02).
|
|
01 FS-AUDIT PIC X(02).
|
|
01 FS-ERROR PIC X(02).
|
|
|
|
*> ============================================================
|
|
*> EOF FLAGS
|
|
*> ============================================================
|
|
01 WS-FLAGS.
|
|
05 WS-EOF-A PIC X VALUE 'N'.
|
|
88 WS-END-A VALUE 'Y' FALSE 'N'.
|
|
05 WS-EOF-B PIC X VALUE 'N'.
|
|
88 WS-END-B VALUE 'Y' FALSE 'N'.
|
|
05 WS-EOF-TEMP PIC X VALUE 'N'.
|
|
88 WS-END-TEMP VALUE 'Y' FALSE 'N'.
|
|
05 WS-EOF-C PIC X VALUE 'N'.
|
|
88 WS-END-C VALUE 'Y' FALSE 'N'.
|
|
|
|
*> ============================================================
|
|
*> KEY FIELDS
|
|
*> ============================================================
|
|
01 WS-KEYS.
|
|
05 WS-KEY-A PIC X(10).
|
|
05 WS-KEY-B PIC X(10).
|
|
05 WS-KEY-TEMP PIC X(10).
|
|
05 WS-KEY-C PIC X(10).
|
|
05 WS-GROUP-KEY PIC X(10).
|
|
|
|
*> ============================================================
|
|
*> CONTROL TOTALS
|
|
*> ============================================================
|
|
01 WS-COUNTERS.
|
|
05 WS-STAGE1-CNT PIC 9(09) VALUE 0.
|
|
05 WS-STAGE2-CNT PIC 9(09) VALUE 0.
|
|
05 WS-TOTAL-A PIC 9(09) VALUE 0.
|
|
05 WS-TOTAL-B PIC 9(09) VALUE 0.
|
|
05 WS-TOTAL-C PIC 9(09) VALUE 0.
|
|
05 WS-A-MATCHED PIC 9(09) VALUE 0.
|
|
05 WS-B-MATCHED PIC 9(09) VALUE 0.
|
|
05 WS-C-MATCHED PIC 9(09) VALUE 0.
|
|
05 WS-A-UNMATCHED PIC 9(09) VALUE 0.
|
|
05 WS-C-UNMATCHED PIC 9(09) VALUE 0.
|
|
|
|
*> ============================================================
|
|
*> HASH TOTALS
|
|
*> ============================================================
|
|
01 WS-HASH-TOTALS.
|
|
05 WS-HASH-A-IN PIC 9(15) VALUE 0.
|
|
05 WS-HASH-B-IN PIC 9(15) VALUE 0.
|
|
05 WS-HASH-C-IN PIC 9(15) VALUE 0.
|
|
05 WS-HASH-TEMP-OUT PIC 9(15) VALUE 0.
|
|
05 WS-HASH-FINAL-OUT PIC 9(15) VALUE 0.
|
|
05 WS-HASH-SUM-CHECK PIC 9(15) VALUE 0.
|
|
|
|
*> ============================================================
|
|
*> TABLE COUNTS
|
|
*> ============================================================
|
|
01 WS-B-COUNT PIC 9(02) VALUE 0.
|
|
01 WS-C-COUNT PIC 9(02) VALUE 0.
|
|
01 WS-I PIC 9(02).
|
|
01 WS-J PIC 9(02).
|
|
|
|
*> ============================================================
|
|
*> B TABLE
|
|
*> ============================================================
|
|
01 WS-B-TABLE.
|
|
05 WS-B-ENTRY OCCURS 10 TIMES.
|
|
10 WS-B-REC PIC X(45).
|
|
|
|
*> ============================================================
|
|
*> C TABLE
|
|
*> ============================================================
|
|
01 WS-C-TABLE.
|
|
05 WS-C-ENTRY OCCURS 10 TIMES.
|
|
10 WS-C-REC PIC X(45).
|
|
|
|
*> ============================================================
|
|
*> PLAN COMPATIBILITY RULES
|
|
*> ============================================================
|
|
01 WS-COMPAT-RULES.
|
|
05 WS-BASE-PLAN PIC X(03).
|
|
05 WS-ADDON-PLAN PIC X(03).
|
|
05 WS-COMPAT-OK PIC X(01).
|
|
88 WS-COMPATIBLE VALUE 'Y' FALSE 'N'.
|
|
88 WS-INCOMPATIBLE VALUE 'N'.
|
|
05 WS-COMPAT-REASON PIC X(40).
|
|
|
|
*> ============================================================
|
|
*> DISCOUNT STACKING RULES
|
|
*> ============================================================
|
|
01 WS-DISCOUNT-RULES.
|
|
05 WS-DISCOUNT-TABLE.
|
|
10 WS-DISC-ENTRY OCCURS 5 TIMES.
|
|
15 WS-DISC-BASE PIC X(03).
|
|
15 WS-DISC-ADDON PIC X(03).
|
|
15 WS-DISC-PCT PIC 9(02).
|
|
05 WS-DISC-COUNT PIC 9(02) VALUE 0.
|
|
05 WS-DISC-INDEX PIC 9(02) VALUE 0.
|
|
05 WS-DISC-FOUND PIC X(01) VALUE 'N'.
|
|
05 WS-DISC-BASE-KEY PIC X(03).
|
|
05 WS-DISC-ADDON-KEY PIC X(03).
|
|
05 WS-APPLIED-DISC PIC 9(02) VALUE 0.
|
|
05 WS-ORIGINAL-AMOUNT PIC 9(09) VALUE 0.
|
|
05 WS-DISCOUNTED-AMT PIC 9(09) VALUE 0.
|
|
|
|
*> ============================================================
|
|
*> RECONCILIATION FIELDS
|
|
*> ============================================================
|
|
01 WS-RECONCILE.
|
|
05 WS-STAGE1-EXPECTED PIC 9(09) VALUE 0.
|
|
05 WS-STAGE2-EXPECTED PIC 9(09) VALUE 0.
|
|
05 WS-STAGE1-DIFF PIC S9(09) VALUE 0.
|
|
05 WS-STAGE2-DIFF PIC S9(09) VALUE 0.
|
|
|
|
*> ============================================================
|
|
*> AUDIT / LOGGING
|
|
*> ============================================================
|
|
01 WS-CURRENT-TIME.
|
|
05 WS-CURRENT-HOUR PIC 9(02).
|
|
05 WS-CURRENT-MINUTE PIC 9(02).
|
|
05 WS-CURRENT-SECOND PIC 9(02).
|
|
05 WS-CURRENT-HUND PIC 9(02).
|
|
01 WS-TIMESTAMP PIC X(20).
|
|
01 WS-PROGRAM-NAME PIC X(20)
|
|
VALUE '22-matching-2stage-MN'.
|
|
|
|
*> ============================================================
|
|
*> ERROR FIELDS
|
|
*> ============================================================
|
|
01 WS-ERROR-COUNT PIC 9(03) VALUE 0.
|
|
01 WS-ERROR-MESSAGE PIC X(80).
|
|
01 WS-ERROR-DETAIL.
|
|
05 FILLER PIC X(10) VALUE 'ERROR #'.
|
|
05 ED-NUM PIC Z(9).
|
|
05 FILLER PIC X(02) VALUE ': '.
|
|
05 ED-MESSAGE PIC X(80).
|
|
|
|
*> ============================================================
|
|
*> AUDIT REPORT LINES
|
|
*> ============================================================
|
|
01 WS-AUDIT-HEADER.
|
|
05 FILLER PIC X(40) VALUE
|
|
'=== 22-matching-2stage-MN AUDIT REPORT ==='.
|
|
01 WS-AUDIT-FOOTER.
|
|
05 FILLER PIC X(50) VALUE
|
|
'--- END OF 22-matching-2stage-MN AUDIT REPORT ---'.
|
|
01 WS-AUDIT-STAGE1.
|
|
05 FILLER PIC X(20) VALUE 'Stage 1 (A x B):'.
|
|
01 WS-AUDIT-STAGE2.
|
|
05 FILLER PIC X(20) VALUE 'Stage 2 (T x C):'.
|
|
01 WS-AUDIT-LINE-A.
|
|
05 FILLER PIC X(20) VALUE ' Total A recs: '.
|
|
05 AL-TOT-A PIC Z(9)9.
|
|
05 FILLER PIC X(15) VALUE ' Matched A: '.
|
|
05 AL-MATCH-A PIC Z(9)9.
|
|
05 FILLER PIC X(15) VALUE ' Unmatched A: '.
|
|
05 AL-UNMATCH-A PIC Z(9)9.
|
|
01 WS-AUDIT-LINE-B.
|
|
05 FILLER PIC X(20) VALUE ' Total B recs: '.
|
|
05 AL-TOT-B PIC Z(9)9.
|
|
05 FILLER PIC X(15) VALUE ' Matched B: '.
|
|
05 AL-MATCH-B PIC Z(9)9.
|
|
01 WS-AUDIT-LINE-C.
|
|
05 FILLER PIC X(20) VALUE ' Total C recs: '.
|
|
05 AL-TOT-C PIC Z(9)9.
|
|
05 FILLER PIC X(15) VALUE ' Matched C: '.
|
|
05 AL-MATCH-C PIC Z(9)9.
|
|
05 FILLER PIC X(15) VALUE ' Unmatched C: '.
|
|
05 AL-UNMATCH-C PIC Z(9)9.
|
|
01 WS-AUDIT-LINE-S1.
|
|
05 FILLER PIC X(20) VALUE ' Stage 1 output: '.
|
|
05 AL-S1-OUT PIC Z(9)9.
|
|
05 FILLER PIC X(15) VALUE ' Expected: '.
|
|
05 AL-S1-EXP PIC Z(9)9.
|
|
05 FILLER PIC X(10) VALUE ' Diff: '.
|
|
05 AL-S1-DIFF PIC +9(9).
|
|
01 WS-AUDIT-LINE-S2.
|
|
05 FILLER PIC X(20) VALUE ' Stage 2 output: '.
|
|
05 AL-S2-OUT PIC Z(9)9.
|
|
05 FILLER PIC X(15) VALUE ' Expected: '.
|
|
05 AL-S2-EXP PIC Z(9)9.
|
|
05 FILLER PIC X(10) VALUE ' Diff: '.
|
|
05 AL-S2-DIFF PIC +9(9).
|
|
01 WS-AUDIT-LINE-HASH.
|
|
05 FILLER PIC X(20) VALUE ' Hash Check: '.
|
|
05 AL-HASH-RES PIC X(10).
|
|
01 WS-AUDIT-LINE-CTRL.
|
|
05 FILLER PIC X(20) VALUE ' Control Check: '.
|
|
05 AL-CTRL-RES PIC X(10).
|
|
01 WS-AUDIT-DISC-LINE.
|
|
05 FILLER PIC X(20) VALUE ' Discount Stack: '.
|
|
05 AL-DISC-BASE PIC X(03).
|
|
05 FILLER PIC X(05) VALUE ' + '.
|
|
05 AL-DISC-ADDON PIC X(03).
|
|
05 FILLER PIC X(05) VALUE ' = '.
|
|
05 AL-DISC-PCT PIC Z(9)9.
|
|
05 FILLER PIC X(01) VALUE '%'.
|
|
01 WS-AUDIT-TRACE.
|
|
05 FILLER PIC X(10) VALUE '[TRACE] '.
|
|
05 AT-TIMESTAMP PIC X(08).
|
|
05 FILLER PIC X(02) VALUE ' '.
|
|
05 AT-MESSAGE PIC X(80).
|
|
|
|
*> ============================================================
|
|
*> WORKING VARIABLES
|
|
*> ============================================================
|
|
01 WS-CONTROL-OK PIC X(01) VALUE 'Y'.
|
|
01 WS-HASH-OK PIC X(01) VALUE 'Y'.
|
|
01 WS-AMOUNT-A PIC 9(09).
|
|
01 WS-AMOUNT-B PIC 9(09).
|
|
01 WS-AMOUNT-C PIC 9(09).
|
|
01 WS-AMOUNT-TEMP PIC 9(09).
|
|
01 WS-AMOUNT-FINAL PIC 9(09).
|
|
01 WS-AMOUNT-DISC PIC 9(09).
|
|
01 WS-PLAN-CODE-FROM PIC X(03).
|
|
|
|
01 WS-TELECOM-REC.
|
|
COPY "telecom/TEL-INVOICE.cpy".
|
|
|
|
01 WS-TELECOM-BILLING.
|
|
COPY "telecom/TEL-BILLING.cpy".
|
|
|
|
PROCEDURE DIVISION.
|
|
|
|
*> ============================================================
|
|
*> 1000-INIT — Initialization
|
|
*> ============================================================
|
|
1000-INIT SECTION.
|
|
1000-START.
|
|
|
|
DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 1000-INIT start'.
|
|
|
|
MOVE 0 TO WS-STAGE1-CNT
|
|
MOVE 0 TO WS-STAGE2-CNT
|
|
MOVE 0 TO WS-TOTAL-A
|
|
MOVE 0 TO WS-TOTAL-B
|
|
MOVE 0 TO WS-TOTAL-C
|
|
MOVE 0 TO WS-A-MATCHED
|
|
MOVE 0 TO WS-B-MATCHED
|
|
MOVE 0 TO WS-C-MATCHED
|
|
MOVE 0 TO WS-A-UNMATCHED
|
|
MOVE 0 TO WS-C-UNMATCHED
|
|
MOVE 0 TO WS-HASH-A-IN
|
|
MOVE 0 TO WS-HASH-B-IN
|
|
MOVE 0 TO WS-HASH-C-IN
|
|
MOVE 0 TO WS-HASH-TEMP-OUT
|
|
MOVE 0 TO WS-HASH-FINAL-OUT
|
|
MOVE 0 TO WS-ERROR-COUNT
|
|
MOVE 0 TO WS-DISC-COUNT
|
|
MOVE 'Y' TO WS-CONTROL-OK
|
|
MOVE 'Y' TO WS-HASH-OK
|
|
|
|
*> Initialize discount stacking rules
|
|
PERFORM 1100-INIT-DISCOUNTS THRU 1100-INIT-DISCOUNTS-EXIT.
|
|
|
|
ACCEPT WS-CURRENT-TIME FROM TIME.
|
|
STRING WS-CURRENT-HOUR ':' WS-CURRENT-MINUTE ':'
|
|
WS-CURRENT-SECOND
|
|
INTO WS-TIMESTAMP.
|
|
|
|
DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 1000-INIT complete '
|
|
WS-TIMESTAMP.
|
|
|
|
1000-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 1100-INIT-DISCOUNTS — Load discount stacking rules
|
|
*> ============================================================
|
|
1100-INIT-DISCOUNTS SECTION.
|
|
1100-START.
|
|
|
|
DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 1100-INIT-DISCOUNTS'.
|
|
|
|
*> Define base+addon → discount percent rules
|
|
MOVE 1 TO WS-DISC-COUNT.
|
|
MOVE 'P01' TO WS-DISC-BASE(1).
|
|
MOVE 'A01' TO WS-DISC-ADDON(1).
|
|
MOVE 10 TO WS-DISC-PCT(1).
|
|
|
|
ADD 1 TO WS-DISC-COUNT.
|
|
MOVE 'P01' TO WS-DISC-BASE(2).
|
|
MOVE 'A02' TO WS-DISC-ADDON(2).
|
|
MOVE 15 TO WS-DISC-PCT(2).
|
|
|
|
ADD 1 TO WS-DISC-COUNT.
|
|
MOVE 'P02' TO WS-DISC-BASE(3).
|
|
MOVE 'A01' TO WS-DISC-ADDON(3).
|
|
MOVE 05 TO WS-DISC-PCT(3).
|
|
|
|
ADD 1 TO WS-DISC-COUNT.
|
|
MOVE 'P02' TO WS-DISC-BASE(4).
|
|
MOVE 'A02' TO WS-DISC-ADDON(4).
|
|
MOVE 20 TO WS-DISC-PCT(4).
|
|
|
|
ADD 1 TO WS-DISC-COUNT.
|
|
MOVE 'P03' TO WS-DISC-BASE(5).
|
|
MOVE 'A03' TO WS-DISC-ADDON(5).
|
|
MOVE 25 TO WS-DISC-PCT(5).
|
|
|
|
DISPLAY '[TRACE] Discount rules loaded: ' WS-DISC-COUNT.
|
|
|
|
1100-INIT-DISCOUNTS-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 2000-OPEN — Open all files
|
|
*> ============================================================
|
|
2000-OPEN SECTION.
|
|
2000-START.
|
|
|
|
DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 2000-OPEN start'.
|
|
|
|
OPEN INPUT FILE-A FILE-B.
|
|
IF FS-A NOT = '00'
|
|
MOVE 'ERROR opening FILE-A, status=' TO WS-ERROR-MESSAGE
|
|
STRING WS-ERROR-MESSAGE FS-A INTO WS-ERROR-MESSAGE
|
|
PERFORM 6000-ERROR THRU 6000-EXIT
|
|
MOVE 1 TO RETURN-CODE
|
|
STOP RUN
|
|
END-IF.
|
|
IF FS-B NOT = '00'
|
|
MOVE 'ERROR opening FILE-B, status=' TO WS-ERROR-MESSAGE
|
|
STRING WS-ERROR-MESSAGE FS-B INTO WS-ERROR-MESSAGE
|
|
PERFORM 6000-ERROR THRU 6000-EXIT
|
|
MOVE 1 TO RETURN-CODE
|
|
STOP RUN
|
|
END-IF.
|
|
|
|
OPEN OUTPUT TEMP-FILE.
|
|
IF FS-TEMP NOT = '00'
|
|
MOVE 'ERROR opening TEMP-FILE, status='
|
|
TO WS-ERROR-MESSAGE
|
|
STRING WS-ERROR-MESSAGE FS-TEMP INTO WS-ERROR-MESSAGE
|
|
PERFORM 6000-ERROR THRU 6000-EXIT
|
|
MOVE 1 TO RETURN-CODE
|
|
STOP RUN
|
|
END-IF.
|
|
|
|
OPEN OUTPUT AUDIT-FILE.
|
|
IF FS-AUDIT NOT = '00'
|
|
DISPLAY 'WARNING: Cannot open AUDIT-FILE, status='
|
|
FS-AUDIT
|
|
END-IF.
|
|
|
|
OPEN OUTPUT ERROR-FILE.
|
|
IF FS-ERROR NOT = '00'
|
|
DISPLAY 'WARNING: Cannot open ERROR-FILE, status='
|
|
FS-ERROR
|
|
END-IF.
|
|
|
|
WRITE AUDIT-LINE FROM WS-AUDIT-HEADER.
|
|
|
|
DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 2000-OPEN complete'.
|
|
DISPLAY 'Stage 1: M:N Cartesian product'.
|
|
|
|
2000-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 3000-PROCESS — Main processing
|
|
*> ============================================================
|
|
3000-PROCESS SECTION.
|
|
3000-START.
|
|
|
|
DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 3000-PROCESS start'.
|
|
|
|
*> ============================================
|
|
*> STAGE 1: M:N Cartesian product
|
|
*> FILE-A x FILE-B -> TEMP-FILE
|
|
*> ============================================
|
|
PERFORM 3100-STAGE1 THRU 3100-STAGE1-EXIT.
|
|
|
|
*> ============================================
|
|
*> STAGE 2: M:N Cartesian product
|
|
*> TEMP-FILE x FILE-C -> FINAL-OUT
|
|
*> ============================================
|
|
PERFORM 3200-STAGE2 THRU 3200-STAGE2-EXIT.
|
|
|
|
DISPLAY '[TRACE] ' WS-PROGRAM-NAME
|
|
' 3000-PROCESS complete — stage1='
|
|
WS-STAGE1-CNT ' stage2=' WS-STAGE2-CNT.
|
|
|
|
3000-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 3100-STAGE1 — Stage 1: A x B -> TEMP
|
|
*> ============================================================
|
|
3100-STAGE1 SECTION.
|
|
3100-STAGE1-START.
|
|
|
|
DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 3100-STAGE1 start'.
|
|
|
|
PERFORM 3110-READ-A THRU 3110-READ-A-EXIT.
|
|
PERFORM 3120-READ-B THRU 3120-READ-B-EXIT.
|
|
|
|
PERFORM UNTIL WS-END-A
|
|
*> Advance B past any keys smaller than current A key
|
|
PERFORM UNTIL WS-END-B
|
|
OR WS-KEY-B NOT < WS-KEY-A
|
|
PERFORM 3120-READ-B THRU 3120-READ-B-EXIT
|
|
END-PERFORM
|
|
|
|
IF NOT WS-END-B AND WS-KEY-B = WS-KEY-A
|
|
*> Matching key found — load B group and process A group
|
|
MOVE WS-KEY-A TO WS-GROUP-KEY
|
|
MOVE 0 TO WS-B-COUNT
|
|
PERFORM UNTIL WS-END-B
|
|
OR WS-KEY-B NOT = WS-GROUP-KEY
|
|
ADD 1 TO WS-B-COUNT
|
|
MOVE B-REC TO WS-B-ENTRY(WS-B-COUNT)
|
|
ADD 1 TO WS-B-MATCHED
|
|
PERFORM 3120-READ-B
|
|
THRU 3120-READ-B-EXIT
|
|
END-PERFORM
|
|
|
|
DISPLAY '[TRACE] Stage1 group=' WS-GROUP-KEY
|
|
' B-count=' WS-B-COUNT
|
|
|
|
PERFORM UNTIL WS-END-A
|
|
OR WS-KEY-A NOT = WS-GROUP-KEY
|
|
ADD 1 TO WS-A-MATCHED
|
|
|
|
*> Check plan compatibility before writing
|
|
PERFORM 3300-CHECK-COMPATIBILITY
|
|
THRU 3300-CHECK-COMPATIBILITY-EXIT
|
|
|
|
PERFORM VARYING WS-I FROM 1 BY 1
|
|
UNTIL WS-I > WS-B-COUNT
|
|
MOVE A-REC TO TEMP-REC
|
|
WRITE TEMP-REC
|
|
IF FS-TEMP NOT = '00'
|
|
MOVE 'ERROR writing TEMP-FILE,status='
|
|
TO WS-ERROR-MESSAGE
|
|
STRING WS-ERROR-MESSAGE FS-TEMP
|
|
INTO WS-ERROR-MESSAGE
|
|
PERFORM 6000-ERROR
|
|
THRU 6000-EXIT
|
|
END-IF
|
|
ADD 1 TO WS-STAGE1-CNT
|
|
MOVE STD-DATA-2 OF A-REC TO WS-AMOUNT-TEMP
|
|
ADD WS-AMOUNT-TEMP TO WS-HASH-TEMP-OUT
|
|
END-PERFORM
|
|
PERFORM 3110-READ-A
|
|
THRU 3110-READ-A-EXIT
|
|
END-PERFORM
|
|
ELSE
|
|
*> No B match for this A key — skip A group
|
|
MOVE WS-KEY-A TO WS-GROUP-KEY
|
|
PERFORM UNTIL WS-END-A
|
|
OR WS-KEY-A NOT = WS-GROUP-KEY
|
|
ADD 1 TO WS-A-UNMATCHED
|
|
PERFORM 3110-READ-A
|
|
THRU 3110-READ-A-EXIT
|
|
END-PERFORM
|
|
END-IF
|
|
END-PERFORM.
|
|
|
|
*> Handle any remaining B records (unmatched)
|
|
PERFORM UNTIL WS-END-B
|
|
ADD 1 TO WS-B-MATCHED
|
|
PERFORM 3120-READ-B THRU 3120-READ-B-EXIT
|
|
END-PERFORM.
|
|
|
|
CLOSE FILE-A FILE-B TEMP-FILE.
|
|
DISPLAY "Stage 1 records: " WS-STAGE1-CNT.
|
|
|
|
*> Calculate expected Stage 1 output for reconciliation
|
|
IF WS-B-COUNT > 0
|
|
COMPUTE WS-STAGE1-EXPECTED =
|
|
WS-A-MATCHED * WS-B-COUNT
|
|
ELSE
|
|
MOVE 0 TO WS-STAGE1-EXPECTED
|
|
END-IF.
|
|
|
|
COMPUTE WS-STAGE1-DIFF = WS-STAGE1-CNT - WS-STAGE1-EXPECTED.
|
|
DISPLAY '[TRACE] Stage1 actual=' WS-STAGE1-CNT
|
|
' expected=' WS-STAGE1-EXPECTED.
|
|
|
|
3100-STAGE1-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 3110-READ-A — Read A record
|
|
*> ============================================================
|
|
3110-READ-A SECTION.
|
|
3110-READ-A-START.
|
|
|
|
READ FILE-A INTO A-REC
|
|
AT END MOVE 'Y' TO WS-EOF-A
|
|
NOT AT END
|
|
MOVE STD-KEY OF A-REC TO WS-KEY-A
|
|
END-READ.
|
|
|
|
IF FS-A NOT = '00' AND NOT = '10'
|
|
MOVE 'ERROR reading FILE-A, status='
|
|
TO WS-ERROR-MESSAGE
|
|
STRING WS-ERROR-MESSAGE FS-A INTO WS-ERROR-MESSAGE
|
|
PERFORM 6000-ERROR THRU 6000-EXIT
|
|
END-IF.
|
|
|
|
IF NOT WS-END-A
|
|
ADD 1 TO WS-TOTAL-A
|
|
MOVE STD-DATA-2 OF A-REC TO WS-AMOUNT-A
|
|
ADD WS-AMOUNT-A TO WS-HASH-A-IN
|
|
END-IF.
|
|
|
|
3110-READ-A-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 3120-READ-B — Read B record
|
|
*> ============================================================
|
|
3120-READ-B SECTION.
|
|
3120-READ-B-START.
|
|
|
|
READ FILE-B INTO B-REC
|
|
AT END MOVE 'Y' TO WS-EOF-B
|
|
NOT AT END
|
|
MOVE STD-KEY OF B-REC TO WS-KEY-B
|
|
END-READ.
|
|
|
|
IF FS-B NOT = '00' AND NOT = '10'
|
|
MOVE 'ERROR reading FILE-B, status='
|
|
TO WS-ERROR-MESSAGE
|
|
STRING WS-ERROR-MESSAGE FS-B INTO WS-ERROR-MESSAGE
|
|
PERFORM 6000-ERROR THRU 6000-EXIT
|
|
END-IF.
|
|
|
|
IF NOT WS-END-B
|
|
ADD 1 TO WS-TOTAL-B
|
|
MOVE STD-DATA-2 OF B-REC TO WS-AMOUNT-B
|
|
ADD WS-AMOUNT-B TO WS-HASH-B-IN
|
|
END-IF.
|
|
|
|
3120-READ-B-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 3200-STAGE2 — Stage 2: TEMP x C -> FINAL
|
|
*> ============================================================
|
|
3200-STAGE2 SECTION.
|
|
3200-STAGE2-START.
|
|
|
|
DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 3200-STAGE2 start'.
|
|
|
|
OPEN INPUT TEMP-FILE FILE-C
|
|
OUTPUT FINAL-OUT.
|
|
|
|
IF FS-TEMP NOT = '00'
|
|
MOVE 'ERROR re-opening TEMP-FILE, status='
|
|
TO WS-ERROR-MESSAGE
|
|
STRING WS-ERROR-MESSAGE FS-TEMP INTO WS-ERROR-MESSAGE
|
|
PERFORM 6000-ERROR THRU 6000-EXIT
|
|
MOVE 1 TO RETURN-CODE
|
|
STOP RUN
|
|
END-IF.
|
|
IF FS-C NOT = '00'
|
|
MOVE 'ERROR opening FILE-C, status='
|
|
TO WS-ERROR-MESSAGE
|
|
STRING WS-ERROR-MESSAGE FS-C INTO WS-ERROR-MESSAGE
|
|
PERFORM 6000-ERROR THRU 6000-EXIT
|
|
MOVE 1 TO RETURN-CODE
|
|
STOP RUN
|
|
END-IF.
|
|
IF FS-FINAL NOT = '00'
|
|
MOVE 'ERROR opening FINAL-OUT, status='
|
|
TO WS-ERROR-MESSAGE
|
|
STRING WS-ERROR-MESSAGE FS-FINAL INTO WS-ERROR-MESSAGE
|
|
PERFORM 6000-ERROR THRU 6000-EXIT
|
|
MOVE 1 TO RETURN-CODE
|
|
STOP RUN
|
|
END-IF.
|
|
|
|
PERFORM 3210-READ-TEMP THRU 3210-READ-TEMP-EXIT.
|
|
PERFORM 3220-READ-C THRU 3220-READ-C-EXIT.
|
|
|
|
PERFORM UNTIL WS-END-TEMP
|
|
PERFORM UNTIL WS-END-C
|
|
OR WS-KEY-C NOT < WS-KEY-TEMP
|
|
PERFORM 3220-READ-C THRU 3220-READ-C-EXIT
|
|
END-PERFORM
|
|
|
|
IF NOT WS-END-C AND WS-KEY-C = WS-KEY-TEMP
|
|
MOVE WS-KEY-TEMP TO WS-GROUP-KEY
|
|
MOVE 0 TO WS-C-COUNT
|
|
PERFORM UNTIL WS-END-C
|
|
OR WS-KEY-C NOT = WS-GROUP-KEY
|
|
ADD 1 TO WS-C-COUNT
|
|
MOVE C-REC TO WS-C-ENTRY(WS-C-COUNT)
|
|
ADD 1 TO WS-C-MATCHED
|
|
PERFORM 3220-READ-C
|
|
THRU 3220-READ-C-EXIT
|
|
END-PERFORM
|
|
|
|
DISPLAY '[TRACE] Stage2 group=' WS-GROUP-KEY
|
|
' C-count=' WS-C-COUNT
|
|
|
|
PERFORM UNTIL WS-END-TEMP
|
|
OR WS-KEY-TEMP NOT = WS-GROUP-KEY
|
|
|
|
*> Apply discount stacking and compatibility check
|
|
PERFORM 3400-APPLY-DISCOUNT
|
|
THRU 3400-APPLY-DISCOUNT-EXIT
|
|
|
|
PERFORM VARYING WS-I FROM 1 BY 1
|
|
UNTIL WS-I > WS-C-COUNT
|
|
MOVE TEMP-REC TO OUT-REC
|
|
WRITE OUT-REC
|
|
IF FS-FINAL NOT = '00'
|
|
MOVE 'ERROR writing FINAL-OUT,status='
|
|
TO WS-ERROR-MESSAGE
|
|
STRING WS-ERROR-MESSAGE FS-FINAL
|
|
INTO WS-ERROR-MESSAGE
|
|
PERFORM 6000-ERROR
|
|
THRU 6000-EXIT
|
|
END-IF
|
|
ADD 1 TO WS-STAGE2-CNT
|
|
MOVE STD-DATA-2 OF TEMP-REC
|
|
TO WS-AMOUNT-FINAL
|
|
ADD WS-AMOUNT-FINAL TO WS-HASH-FINAL-OUT
|
|
END-PERFORM
|
|
PERFORM 3210-READ-TEMP
|
|
THRU 3210-READ-TEMP-EXIT
|
|
END-PERFORM
|
|
ELSE
|
|
*> No C match for this temp key — skip temp group
|
|
MOVE WS-KEY-TEMP TO WS-GROUP-KEY
|
|
PERFORM UNTIL WS-END-TEMP
|
|
OR WS-KEY-TEMP NOT = WS-GROUP-KEY
|
|
ADD 1 TO WS-C-UNMATCHED
|
|
PERFORM 3210-READ-TEMP
|
|
THRU 3210-READ-TEMP-EXIT
|
|
END-PERFORM
|
|
END-IF
|
|
END-PERFORM.
|
|
|
|
*> Handle remaining C records
|
|
PERFORM UNTIL WS-END-C
|
|
ADD 1 TO WS-C-MATCHED
|
|
PERFORM 3220-READ-C THRU 3220-READ-C-EXIT
|
|
END-PERFORM.
|
|
|
|
CLOSE TEMP-FILE FILE-C FINAL-OUT.
|
|
DISPLAY "Stage 2 records: " WS-STAGE2-CNT.
|
|
|
|
*> Stage 2 reconciliation
|
|
IF WS-C-COUNT > 0
|
|
COMPUTE WS-STAGE2-EXPECTED =
|
|
WS-STAGE1-CNT * WS-C-COUNT
|
|
ELSE
|
|
MOVE 0 TO WS-STAGE2-EXPECTED
|
|
END-IF.
|
|
|
|
COMPUTE WS-STAGE2-DIFF = WS-STAGE2-CNT - WS-STAGE2-EXPECTED.
|
|
DISPLAY '[TRACE] Stage2 actual=' WS-STAGE2-CNT
|
|
' expected=' WS-STAGE2-EXPECTED.
|
|
|
|
3200-STAGE2-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 3210-READ-TEMP
|
|
*> ============================================================
|
|
3210-READ-TEMP SECTION.
|
|
3210-READ-TEMP-START.
|
|
|
|
READ TEMP-FILE INTO TEMP-REC
|
|
AT END MOVE 'Y' TO WS-EOF-TEMP
|
|
NOT AT END
|
|
MOVE STD-KEY OF TEMP-REC TO WS-KEY-TEMP
|
|
END-READ.
|
|
|
|
IF FS-TEMP NOT = '00' AND NOT = '10'
|
|
MOVE 'ERROR reading TEMP-FILE, status='
|
|
TO WS-ERROR-MESSAGE
|
|
STRING WS-ERROR-MESSAGE FS-TEMP INTO WS-ERROR-MESSAGE
|
|
PERFORM 6000-ERROR THRU 6000-EXIT
|
|
END-IF.
|
|
|
|
3210-READ-TEMP-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 3220-READ-C
|
|
*> ============================================================
|
|
3220-READ-C SECTION.
|
|
3220-READ-C-START.
|
|
|
|
READ FILE-C INTO C-REC
|
|
AT END MOVE 'Y' TO WS-EOF-C
|
|
NOT AT END
|
|
MOVE STD-KEY OF C-REC TO WS-KEY-C
|
|
END-READ.
|
|
|
|
IF FS-C NOT = '00' AND NOT = '10'
|
|
MOVE 'ERROR reading FILE-C, status='
|
|
TO WS-ERROR-MESSAGE
|
|
STRING WS-ERROR-MESSAGE FS-C INTO WS-ERROR-MESSAGE
|
|
PERFORM 6000-ERROR THRU 6000-EXIT
|
|
END-IF.
|
|
|
|
IF NOT WS-END-C
|
|
ADD 1 TO WS-TOTAL-C
|
|
MOVE STD-DATA-2 OF C-REC TO WS-AMOUNT-C
|
|
ADD WS-AMOUNT-C TO WS-HASH-C-IN
|
|
END-IF.
|
|
|
|
3220-READ-C-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 3300-CHECK-COMPATIBILITY — Check base/addon plan compatibility
|
|
*> ============================================================
|
|
3300-CHECK-COMPATIBILITY SECTION.
|
|
3300-CHECK-COMPAT-START.
|
|
|
|
*> Extract base plan code from STD-DATA-1 of A-REC
|
|
MOVE STD-DATA-1 OF A-REC(1:3) TO WS-BASE-PLAN.
|
|
*> Extract addon plan code from STD-DATA-1 of B-REC (first in B group)
|
|
MOVE STD-DATA-1 OF B-REC(1:3) TO WS-ADDON-PLAN.
|
|
|
|
DISPLAY '[TRACE] Compatibility check: base='
|
|
WS-BASE-PLAN ' addon=' WS-ADDON-PLAN.
|
|
|
|
*> Define simple compatibility rules
|
|
MOVE 'Y' TO WS-COMPAT-OK.
|
|
|
|
*> Rule: P03 (Enterprise) is compatible with all addons
|
|
IF WS-BASE-PLAN = 'P03'
|
|
MOVE 'Enterprise plan — all addons OK'
|
|
TO WS-COMPAT-REASON
|
|
ELSE
|
|
*> Rule: P01 (Basic) only compatible with A01, A02
|
|
IF WS-BASE-PLAN = 'P01'
|
|
IF WS-ADDON-PLAN = 'A01' OR 'A02'
|
|
MOVE 'Basic + standard addon — OK'
|
|
TO WS-COMPAT-REASON
|
|
ELSE
|
|
MOVE 'N' TO WS-COMPAT-OK
|
|
MOVE 'P01 incompatible with ' TO WS-COMPAT-REASON
|
|
STRING WS-COMPAT-REASON WS-ADDON-PLAN
|
|
INTO WS-COMPAT-REASON
|
|
ADD 1 TO WS-ERROR-COUNT
|
|
END-IF
|
|
ELSE
|
|
*> P02 (Premium) compatible with A01, A02, A03
|
|
IF WS-BASE-PLAN = 'P02'
|
|
IF WS-ADDON-PLAN = 'A01' OR 'A02' OR 'A03'
|
|
MOVE 'Premium + addon — OK'
|
|
TO WS-COMPAT-REASON
|
|
ELSE
|
|
MOVE 'N' TO WS-COMPAT-OK
|
|
MOVE 'P02 incompatible with '
|
|
TO WS-COMPAT-REASON
|
|
STRING WS-COMPAT-REASON WS-ADDON-PLAN
|
|
INTO WS-COMPAT-REASON
|
|
ADD 1 TO WS-ERROR-COUNT
|
|
END-IF
|
|
ELSE
|
|
MOVE 'N' TO WS-COMPAT-OK
|
|
MOVE 'Unknown base plan' TO WS-COMPAT-REASON
|
|
ADD 1 TO WS-ERROR-COUNT
|
|
END-IF
|
|
END-IF
|
|
END-IF.
|
|
|
|
DISPLAY '[TRACE] Compat result=' WS-COMPAT-OK
|
|
' reason=' WS-COMPAT-REASON.
|
|
|
|
3300-CHECK-COMPATIBILITY-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 3400-APPLY-DISCOUNT — Apply discount stacking rules
|
|
*> ============================================================
|
|
3400-APPLY-DISCOUNT SECTION.
|
|
3400-APPLY-DISC-START.
|
|
|
|
*> Extract plan codes from TEMP-REC for discount lookup
|
|
MOVE STD-DATA-1 OF TEMP-REC(1:3) TO WS-DISC-BASE-KEY.
|
|
MOVE STD-DATA-1 OF B-REC(1:3) TO WS-DISC-ADDON-KEY.
|
|
MOVE STD-DATA-2 OF TEMP-REC TO WS-ORIGINAL-AMOUNT.
|
|
MOVE 0 TO WS-APPLIED-DISC.
|
|
MOVE 'N' TO WS-DISC-FOUND.
|
|
|
|
*> Look up discount rule
|
|
PERFORM VARYING WS-DISC-INDEX FROM 1 BY 1
|
|
UNTIL WS-DISC-INDEX > WS-DISC-COUNT
|
|
IF WS-DISC-BASE(WS-DISC-INDEX) = WS-DISC-BASE-KEY
|
|
AND WS-DISC-ADDON(WS-DISC-INDEX) = WS-DISC-ADDON-KEY
|
|
MOVE 'Y' TO WS-DISC-FOUND
|
|
MOVE WS-DISC-PCT(WS-DISC-INDEX) TO WS-APPLIED-DISC
|
|
EXIT PERFORM
|
|
END-IF
|
|
END-PERFORM.
|
|
|
|
IF WS-DISC-FOUND = 'Y'
|
|
COMPUTE WS-DISCOUNTED-AMT =
|
|
WS-ORIGINAL-AMOUNT *
|
|
(100 - WS-APPLIED-DISC) / 100
|
|
COMPUTE WS-AMOUNT-DISC =
|
|
WS-ORIGINAL-AMOUNT - WS-DISCOUNTED-AMT
|
|
DISPLAY '[TRACE] DISCOUNT: base=' WS-DISC-BASE-KEY
|
|
' addon=' WS-DISC-ADDON-KEY
|
|
' pct=' WS-APPLIED-DISC '%'
|
|
' orig=' WS-ORIGINAL-AMOUNT
|
|
' disc=' WS-AMOUNT-DISC
|
|
' final=' WS-DISCOUNTED-AMT
|
|
ELSE
|
|
MOVE WS-ORIGINAL-AMOUNT TO WS-DISCOUNTED-AMT
|
|
MOVE 0 TO WS-AMOUNT-DISC
|
|
DISPLAY '[TRACE] No discount for base='
|
|
WS-DISC-BASE-KEY
|
|
' addon=' WS-DISC-ADDON-KEY
|
|
END-IF.
|
|
|
|
*> Write discount info to audit trail
|
|
IF WS-DISC-FOUND = 'Y'
|
|
MOVE WS-DISC-BASE-KEY TO AL-DISC-BASE
|
|
MOVE WS-DISC-ADDON-KEY TO AL-DISC-ADDON
|
|
MOVE WS-APPLIED-DISC TO AL-DISC-PCT
|
|
WRITE AUDIT-LINE FROM WS-AUDIT-DISC-LINE
|
|
END-IF.
|
|
|
|
3400-APPLY-DISCOUNT-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 4000-VALIDATE — Validate control totals and hash
|
|
*> ============================================================
|
|
4000-VALIDATE SECTION.
|
|
4000-START.
|
|
|
|
DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 4000-VALIDATE start'.
|
|
|
|
*> Stage 1 reconciliation
|
|
IF WS-STAGE1-CNT NOT = WS-STAGE1-EXPECTED
|
|
MOVE 'N' TO WS-CONTROL-OK
|
|
MOVE 'Control FAIL: Stage 1 count mismatch'
|
|
TO WS-ERROR-MESSAGE
|
|
PERFORM 6000-ERROR THRU 6000-EXIT
|
|
DISPLAY 'CONTROL FAIL: Stage1=' WS-STAGE1-CNT
|
|
' expected=' WS-STAGE1-EXPECTED
|
|
' diff=' WS-STAGE1-DIFF
|
|
ELSE
|
|
DISPLAY 'CONTROL OK: Stage1=' WS-STAGE1-CNT
|
|
' = expected'
|
|
END-IF.
|
|
|
|
*> Stage 2 reconciliation
|
|
IF WS-STAGE2-CNT NOT = WS-STAGE2-EXPECTED
|
|
MOVE 'N' TO WS-CONTROL-OK
|
|
MOVE 'Control FAIL: Stage 2 count mismatch'
|
|
TO WS-ERROR-MESSAGE
|
|
PERFORM 6000-ERROR THRU 6000-EXIT
|
|
DISPLAY 'CONTROL FAIL: Stage2=' WS-STAGE2-CNT
|
|
' expected=' WS-STAGE2-EXPECTED
|
|
' diff=' WS-STAGE2-DIFF
|
|
ELSE
|
|
DISPLAY 'CONTROL OK: Stage2=' WS-STAGE2-CNT
|
|
' = expected'
|
|
END-IF.
|
|
|
|
*> Hash total check (A-in + B-in should = temp-out)
|
|
IF WS-HASH-A-IN + WS-HASH-B-IN NOT = WS-HASH-TEMP-OUT
|
|
MOVE 'N' TO WS-HASH-OK
|
|
MOVE 'Hash FAIL: stage 1 hash mismatch'
|
|
TO WS-ERROR-MESSAGE
|
|
PERFORM 6000-ERROR THRU 6000-EXIT
|
|
COMPUTE WS-HASH-SUM-CHECK =
|
|
WS-HASH-A-IN + WS-HASH-B-IN
|
|
DISPLAY 'HASH FAIL: A+B=' WS-HASH-SUM-CHECK
|
|
' temp=' WS-HASH-TEMP-OUT
|
|
ELSE
|
|
DISPLAY 'HASH OK: A+B = temp-out'
|
|
END-IF.
|
|
|
|
DISPLAY '[TRACE] ' WS-PROGRAM-NAME
|
|
' 4000-VALIDATE complete'.
|
|
|
|
4000-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 5000-REPORT — Generate audit report
|
|
*> ============================================================
|
|
5000-REPORT SECTION.
|
|
5000-START.
|
|
|
|
DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 5000-REPORT start'.
|
|
|
|
WRITE AUDIT-LINE FROM WS-AUDIT-STAGE1.
|
|
|
|
MOVE WS-TOTAL-A TO AL-TOT-A.
|
|
MOVE WS-A-MATCHED TO AL-MATCH-A.
|
|
MOVE WS-A-UNMATCHED TO AL-UNMATCH-A.
|
|
WRITE AUDIT-LINE FROM WS-AUDIT-LINE-A.
|
|
|
|
MOVE WS-TOTAL-B TO AL-TOT-B.
|
|
MOVE WS-B-MATCHED TO AL-MATCH-B.
|
|
WRITE AUDIT-LINE FROM WS-AUDIT-LINE-B.
|
|
|
|
MOVE WS-STAGE1-CNT TO AL-S1-OUT.
|
|
MOVE WS-STAGE1-EXPECTED TO AL-S1-EXP.
|
|
MOVE WS-STAGE1-DIFF TO AL-S1-DIFF.
|
|
WRITE AUDIT-LINE FROM WS-AUDIT-LINE-S1.
|
|
|
|
WRITE AUDIT-LINE FROM WS-AUDIT-STAGE2.
|
|
|
|
MOVE WS-TOTAL-C TO AL-TOT-C.
|
|
MOVE WS-C-MATCHED TO AL-MATCH-C.
|
|
MOVE WS-C-UNMATCHED TO AL-UNMATCH-C.
|
|
WRITE AUDIT-LINE FROM WS-AUDIT-LINE-C.
|
|
|
|
MOVE WS-STAGE2-CNT TO AL-S2-OUT.
|
|
MOVE WS-STAGE2-EXPECTED TO AL-S2-EXP.
|
|
MOVE WS-STAGE2-DIFF TO AL-S2-DIFF.
|
|
WRITE AUDIT-LINE FROM WS-AUDIT-LINE-S2.
|
|
|
|
IF WS-CONTROL-OK = 'Y'
|
|
MOVE 'PASS' TO AL-CTRL-RES
|
|
ELSE
|
|
MOVE 'FAIL' TO AL-CTRL-RES
|
|
END-IF.
|
|
WRITE AUDIT-LINE FROM WS-AUDIT-LINE-CTRL.
|
|
|
|
IF WS-HASH-OK = 'Y'
|
|
MOVE 'PASS' TO AL-HASH-RES
|
|
ELSE
|
|
MOVE 'FAIL' TO AL-HASH-RES
|
|
END-IF.
|
|
WRITE AUDIT-LINE FROM WS-AUDIT-LINE-HASH.
|
|
|
|
DISPLAY '22-matching-2stage-MN: A=' WS-TOTAL-A
|
|
' B=' WS-TOTAL-B ' C=' WS-TOTAL-C
|
|
' Stage1=' WS-STAGE1-CNT
|
|
' Stage2=' WS-STAGE2-CNT.
|
|
|
|
WRITE AUDIT-LINE FROM WS-AUDIT-FOOTER.
|
|
|
|
5000-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 6000-ERROR — Error handler
|
|
*> ============================================================
|
|
6000-ERROR SECTION.
|
|
6000-START.
|
|
|
|
ADD 1 TO WS-ERROR-COUNT.
|
|
MOVE WS-ERROR-COUNT TO ED-NUM.
|
|
MOVE WS-ERROR-MESSAGE TO ED-MESSAGE.
|
|
DISPLAY WS-ERROR-DETAIL.
|
|
|
|
WRITE ERROR-LINE FROM WS-ERROR-DETAIL.
|
|
|
|
6000-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 7000-AUDIT — Trace entry
|
|
*> ============================================================
|
|
7000-AUDIT SECTION.
|
|
7000-START.
|
|
|
|
ACCEPT WS-CURRENT-TIME FROM TIME.
|
|
STRING WS-CURRENT-HOUR ':' WS-CURRENT-MINUTE ':'
|
|
WS-CURRENT-SECOND
|
|
INTO AT-TIMESTAMP.
|
|
MOVE '7000-AUDIT entry' TO AT-MESSAGE.
|
|
WRITE AUDIT-LINE FROM WS-AUDIT-TRACE.
|
|
|
|
7000-EXIT.
|
|
EXIT.
|
|
|
|
*> ============================================================
|
|
*> 9000-EXIT — Cleanup and close
|
|
*> ============================================================
|
|
9000-EXIT SECTION.
|
|
9000-START.
|
|
|
|
DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 9000-EXIT start'.
|
|
|
|
CLOSE AUDIT-FILE.
|
|
IF FS-AUDIT NOT = '00'
|
|
DISPLAY 'WARNING: AUDIT-FILE close status=' FS-AUDIT
|
|
END-IF.
|
|
|
|
CLOSE ERROR-FILE.
|
|
IF FS-ERROR NOT = '00'
|
|
DISPLAY 'WARNING: ERROR-FILE close status=' FS-ERROR
|
|
END-IF.
|
|
|
|
DISPLAY "22-matching-2stage-MN: PASS".
|
|
IF WS-ERROR-COUNT > 0
|
|
DISPLAY '22-matching-2stage-MN: Errors=' WS-ERROR-COUNT
|
|
' — see error-report-22.txt'
|
|
END-IF.
|
|
|
|
DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' END'.
|
|
STOP RUN.
|
|
|
|
9000-EXIT-EXIT.
|
|
EXIT.
|
|
|
|
END PROGRAM Matching2StageMN.
|