*> ============================================================ *> 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.