*> ============================================================ *> subprogram : 计费子程序 (Billing Subprogram) — CALLEE *> Input : LK-A, LK-B (LINKAGE参数: 用量值) *> LK-TIER (LINKAGE参数: 计费阶梯) *> Output: LK-RESULT, LK-STATUS (计算结果+状态) *> LK-ERROR-CODE (错误编码) *> Coverage: C-N001~N008, C-A001, C-R001, C-R002 *> *> EXPANDED: Multiple billing tiers with configurable multipliers, *> parameter validation (range checks, numeric checks), *> error code mapping with lookup, audit file with detail lines, *> statistical tracking (min/max/avg), discount/premium stacking, *> voice/data/message component breakdown, tracing, SECTION structure. *> ============================================================ IDENTIFICATION DIVISION. PROGRAM-ID. SUBPGM. ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT AUDIT-FILE ASSIGN TO "subpgm-audit.txt" ORGANIZATION IS LINE SEQUENTIAL FILE STATUS IS FS-AUDIT. SELECT ERROR-FILE ASSIGN TO "subpgm-errors.txt" ORGANIZATION IS LINE SEQUENTIAL FILE STATUS IS FS-ERROR. SELECT CONFIG-FILE ASSIGN TO "subpgm-config.dat" ORGANIZATION IS LINE SEQUENTIAL FILE STATUS IS FS-CONFIG. DATA DIVISION. FILE SECTION. FD AUDIT-FILE. 01 AUDIT-LINE PIC X(120). FD ERROR-FILE. 01 ERROR-LINE PIC X(120). FD CONFIG-FILE. 01 CONFIG-LINE PIC X(80). WORKING-STORAGE SECTION. *> ============================================================ *> FILE STATUS FIELDS *> ============================================================ 01 FS-AUDIT PIC X(02). 01 FS-ERROR PIC X(02). 01 FS-CONFIG PIC X(02). *> ============================================================ *> LOCAL STATE *> ============================================================ 01 WS-LOCAL-COUNT PIC 9(05) VALUE 0. 01 WS-PGM-NAME PIC X(08) VALUE 'SUBPGM '. 01 WS-CALL-COUNT PIC 9(05) VALUE 0. 01 WS-INIT-FLAG PIC X(01) VALUE 'N'. 88 WS-INITIALIZED VALUE 'Y'. 01 WS-SUB-STATUS PIC X(01) VALUE 'N'. 88 WS-SUB-ACTIVE VALUE 'Y'. *> ============================================================ *> BILLING TIER CONFIGURATION *> ============================================================ 01 WS-TIER-CONFIG. 05 WS-TIER-MULTIPLIER PIC 9(02)V99. 05 WS-TIER-NAME PIC X(15). 05 WS-TIER-BASE-RATE PIC 9(03)V99. 05 WS-TIER-DATA-RATE PIC 9(03)V99. 05 WS-TIER-DISCOUNT PIC 9(02). 01 WS-TIER-TABLE. 05 FILLER PIC X(32) VALUE '011.00Basic 005.005.00 00'. 05 FILLER PIC X(32) VALUE '021.50Premium 008.007.00 05'. 05 FILLER PIC X(32) VALUE '033.00Enterprise 010.008.00 10'. 05 FILLER PIC X(32) VALUE '042.50Family 007.006.00 08'. 01 WS-TIER-TABLE-REDEF REDEFINES WS-TIER-TABLE. 05 WS-TIER-ENTRY OCCURS 4 TIMES. 10 WS-TIER-CODE PIC 9(01). 10 WS-TIER-MULT PIC 9(02)V99. 10 WS-TIER-DESC PIC X(15). 10 WS-TIER-BASE PIC 9(03)V99. 10 WS-TIER-DATA PIC 9(03)V99. 10 WS-TIER-DISC PIC 9(02). *> ============================================================ *> CALCULATION COMPONENTS *> ============================================================ 01 WS-CALC-COMPONENTS. 05 WS-COMP-VOICE-AMT PIC 9(09)V99 VALUE 0. 05 WS-COMP-DATA-AMT PIC 9(09)V99 VALUE 0. 05 WS-COMP-MSG-AMT PIC 9(09)V99 VALUE 0. 05 WS-COMP-DISCOUNT PIC 9(09)V99 VALUE 0. 05 WS-COMP-SUBTOTAL PIC 9(09)V99 VALUE 0. 05 WS-COMP-FINAL PIC 9(09)V99 VALUE 0. 05 WS-COMP-TIER-MULT PIC 9(02)V99 VALUE 1.00. *> ============================================================ *> CALL STATISTICS *> ============================================================ 01 WS-STATISTICS. 05 WS-STAT-MIN-VAL PIC 9(10) VALUE 9999999999. 05 WS-STAT-MAX-VAL PIC 9(10) VALUE 0. 05 WS-STAT-SUM-VAL PIC 9(15) VALUE 0. 05 WS-STAT-COUNT PIC 9(05) VALUE 0. 05 WS-STAT-AVG-VAL PIC 9(10) VALUE 0. 05 WS-STAT-ERR-COUNT PIC 9(05) VALUE 0. 05 WS-STAT-SUCCESS-CNT PIC 9(05) VALUE 0. *> ============================================================ *> ERROR CODE MAPPING *> ============================================================ 01 WS-ERR-CODE-TABLE. 05 FILLER PIC X(32) VALUE '00OK '. 05 FILLER PIC X(32) VALUE '01INVALID INPUT A '. 05 FILLER PIC X(32) VALUE '02INVALID INPUT B '. 05 FILLER PIC X(32) VALUE '03INPUT OUT OF RANGE '. 05 FILLER PIC X(32) VALUE '04INVALID BILLING TIER '. 05 FILLER PIC X(32) VALUE '05CALCULATION OVERFLOW '. 05 FILLER PIC X(32) VALUE '06SUBPROGRAM NOT FOUND '. 05 FILLER PIC X(32) VALUE '07SUBPROGRAM ERROR '. 05 FILLER PIC X(32) VALUE '08TIER MULTIPLIER ERROR '. 05 FILLER PIC X(32) VALUE '09INTERNAL ERROR '. 01 WS-ERR-REDEF REDEFINES WS-ERR-CODE-TABLE. 05 WS-ERR-ENTRY OCCURS 10 TIMES. 10 WS-EC-CODE PIC X(02). 10 WS-EC-MESSAGE PIC X(30). *> ============================================================ *> CALCULATION FIELDS *> ============================================================ 01 WS-CALC-SUM PIC 9(10) VALUE 0. 01 WS-CALC-RESULT PIC 9(10) VALUE 0. 01 WS-CALC-MULT PIC 9(05)V99 VALUE 0. 01 WS-OVERFLOW-CHECK PIC 9(15) VALUE 0. 01 WS-CALC-VOICE-MIN PIC 9(05) VALUE 0. 01 WS-CALC-DATA-MB PIC 9(09) VALUE 0. 01 WS-CALC-MSG-COUNT PIC 9(05) VALUE 0. *> ============================================================ *> VALIDATION CONTROLS *> ============================================================ 01 WS-MIN-VALUE PIC 9(05) VALUE 0. 01 WS-MAX-VALUE PIC 9(05) VALUE 99999. 01 WS-MIN-TIER PIC 9(01) VALUE 1. 01 WS-MAX-TIER PIC 9(01) VALUE 4. 01 WS-VALIDATION-MSG PIC X(40). *> ============================================================ *> AUDIT / TRACE FIELDS *> ============================================================ 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). *> ============================================================ *> 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 'SUBPGM ERR '. 05 ED-NUM PIC Z(9). 05 FILLER PIC X(02) VALUE ': '. 05 ED-MESSAGE PIC X(80). *> ============================================================ *> AUDIT LINE TEMPLATES *> ============================================================ 01 WS-AUDIT-HEADER. 05 FILLER PIC X(40) VALUE '=== SUBPGM Callee Audit Log ==='. 01 WS-AUDIT-CALL. 05 FILLER PIC X(10) VALUE ' CALL #'. 05 AC-CALL-NUM PIC Z(9)5. 05 FILLER PIC X(05) VALUE ' A='. 05 AC-A PIC Z(9)5. 05 FILLER PIC X(05) VALUE ' B='. 05 AC-B PIC Z(9)5. 05 FILLER PIC X(10) VALUE ' TIER='. 05 AC-TIER PIC Z(9). 05 FILLER PIC X(10) VALUE ' RESULT='. 05 AC-RESULT PIC Z(9)9. 05 FILLER PIC X(10) VALUE ' STATUS='. 05 AC-STATUS PIC Z(9). 05 FILLER PIC X(10) VALUE ' ERR='. 05 AC-ERR PIC Z(9). 01 WS-AUDIT-DETAIL. 05 FILLER PIC X(10) VALUE ' DETAIL '. 05 AD-COMP PIC X(10). 05 FILLER PIC X(05) VALUE ' AMT='. 05 AD-AMT PIC Z(11)9.99. 01 WS-AUDIT-STATS. 05 FILLER PIC X(10) VALUE ' STATS: '. 05 FILLER PIC X(10) VALUE 'MIN='. 05 AS-MIN PIC Z(9)9. 05 FILLER PIC X(10) VALUE ' MAX='. 05 AS-MAX PIC Z(9)9. 05 FILLER PIC X(10) VALUE ' AVG='. 05 AS-AVG PIC Z(9)9. 05 FILLER PIC X(10) VALUE ' CNT='. 05 AS-CNT PIC Z(9)5. 01 WS-AUDIT-ERR-STATS. 05 FILLER PIC X(10) VALUE ' ERRORS:'. 05 AE-COUNT PIC Z(9)5. 05 FILLER PIC X(10) VALUE ' SUCCESS:'. 05 AE-SUCCESS PIC Z(9)5. 01 WS-AUDIT-FOOTER. 05 FILLER PIC X(50) VALUE '--- END OF SUBPGM AUDIT LOG ---'. LINKAGE SECTION. 01 LK-A PIC 9(05). 01 LK-B PIC 9(05). 01 LK-RESULT PIC 9(10). 01 LK-STATUS PIC 9(02). 01 LK-ERROR-CODE PIC 9(02). 01 LK-TIER PIC 9(01). PROCEDURE DIVISION USING LK-A, LK-B, LK-RESULT, LK-STATUS, LK-ERROR-CODE, LK-TIER. *> ============================================================ *> 1000-INIT — Initialization *> ============================================================ 1000-INIT SECTION. 1000-START. ADD 1 TO WS-LOCAL-COUNT. ADD 1 TO WS-CALL-COUNT. ACCEPT WS-CURRENT-TIME FROM TIME. STRING WS-CURRENT-HOUR ':' WS-CURRENT-MINUTE ':' WS-CURRENT-SECOND INTO WS-TIMESTAMP. DISPLAY '[TRACE] SUBPGM 1000-INIT call #' WS-CALL-COUNT ' at ' WS-TIMESTAMP. *> Open files only on first call IF NOT WS-INITIALIZED SET WS-INITIALIZED TO TRUE SET WS-SUB-ACTIVE TO TRUE OPEN OUTPUT AUDIT-FILE IF FS-AUDIT NOT = '00' DISPLAY 'SUBPGM: WARNING Cannot open AUDIT-FILE ' 'status=' FS-AUDIT ELSE WRITE AUDIT-LINE FROM WS-AUDIT-HEADER END-IF OPEN OUTPUT ERROR-FILE IF FS-ERROR NOT = '00' DISPLAY 'SUBPGM: WARNING Cannot open ERROR-FILE ' 'status=' FS-ERROR END-IF *> Attempt to load config file (optional) OPEN INPUT CONFIG-FILE IF FS-CONFIG = '00' DISPLAY 'SUBPGM: Config file loaded' PERFORM 1100-LOAD-CONFIG THRU 1100-LOAD-CONFIG-EXIT CLOSE CONFIG-FILE ELSE DISPLAY 'SUBPGM: No config file — using defaults' END-IF DISPLAY '[TRACE] SUBPGM initialized, tier table ready' END-IF. DISPLAY '[TRACE] SUBPGM call #' WS-CALL-COUNT ' A=' LK-A ' B=' LK-B ' TIER=' LK-TIER. 1000-EXIT. EXIT. *> ============================================================ *> 1100-LOAD-CONFIG — Load configuration file *> ============================================================ 1100-LOAD-CONFIG SECTION. 1100-LOAD-CONFIG-START. DISPLAY '[TRACE] SUBPGM 1100-LOAD-CONFIG start'. *> Read config lines (format: TIER,NAME,MULT,BASE,DATA,DISC) READ CONFIG-FILE INTO CONFIG-LINE AT END DISPLAY 'SUBPGM: Config file empty' END-READ. DISPLAY '[TRACE] SUBPGM 1100-LOAD-CONFIG complete'. 1100-LOAD-CONFIG-EXIT. EXIT. *> ============================================================ *> 2000-VALIDATE — Validate all inputs *> ============================================================ 2000-VALIDATE SECTION. 2000-START. DISPLAY '[TRACE] SUBPGM 2000-VALIDATE A=' LK-A ' B=' LK-B ' TIER=' LK-TIER. *> Validate input A: must be numeric IF LK-A IS NOT NUMERIC MOVE 01 TO LK-ERROR-CODE MOVE 99 TO LK-STATUS STRING 'INPUT A NOT NUMERIC: value=' LK-A INTO WS-VALIDATION-MSG DISPLAY 'SUBPGM: ' WS-VALIDATION-MSG PERFORM 6000-ERROR THRU 6000-ERROR-EXIT GOBACK END-IF. *> Validate input A: range check IF LK-A < WS-MIN-VALUE MOVE 03 TO LK-ERROR-CODE MOVE 99 TO LK-STATUS STRING 'INPUT A BELOW MIN: ' LK-A ' < ' WS-MIN-VALUE INTO WS-VALIDATION-MSG DISPLAY 'SUBPGM: ' WS-VALIDATION-MSG PERFORM 6000-ERROR THRU 6000-ERROR-EXIT GOBACK END-IF. IF LK-A > WS-MAX-VALUE MOVE 03 TO LK-ERROR-CODE MOVE 99 TO LK-STATUS STRING 'INPUT A EXCEEDS MAX: ' LK-A ' > ' WS-MAX-VALUE INTO WS-VALIDATION-MSG DISPLAY 'SUBPGM: ' WS-VALIDATION-MSG PERFORM 6000-ERROR THRU 6000-ERROR-EXIT GOBACK END-IF. *> Validate input B: must be numeric IF LK-B IS NOT NUMERIC MOVE 02 TO LK-ERROR-CODE MOVE 99 TO LK-STATUS STRING 'INPUT B NOT NUMERIC: value=' LK-B INTO WS-VALIDATION-MSG DISPLAY 'SUBPGM: ' WS-VALIDATION-MSG PERFORM 6000-ERROR THRU 6000-ERROR-EXIT GOBACK END-IF. *> Validate input B: range check IF LK-B < WS-MIN-VALUE MOVE 03 TO LK-ERROR-CODE MOVE 99 TO LK-STATUS STRING 'INPUT B BELOW MIN: ' LK-B ' < ' WS-MIN-VALUE INTO WS-VALIDATION-MSG DISPLAY 'SUBPGM: ' WS-VALIDATION-MSG PERFORM 6000-ERROR THRU 6000-ERROR-EXIT GOBACK END-IF. IF LK-B > WS-MAX-VALUE MOVE 03 TO LK-ERROR-CODE MOVE 99 TO LK-STATUS STRING 'INPUT B EXCEEDS MAX: ' LK-B ' > ' WS-MAX-VALUE INTO WS-VALIDATION-MSG DISPLAY 'SUBPGM: ' WS-VALIDATION-MSG PERFORM 6000-ERROR THRU 6000-ERROR-EXIT GOBACK END-IF. *> Validate tier: must be numeric IF LK-TIER IS NOT NUMERIC MOVE 04 TO LK-ERROR-CODE MOVE 99 TO LK-STATUS STRING 'TIER NOT NUMERIC: value=' LK-TIER INTO WS-VALIDATION-MSG DISPLAY 'SUBPGM: ' WS-VALIDATION-MSG PERFORM 6000-ERROR THRU 6000-ERROR-EXIT GOBACK END-IF. *> Validate tier: range check IF LK-TIER < WS-MIN-TIER MOVE 04 TO LK-ERROR-CODE MOVE 99 TO LK-STATUS STRING 'TIER ' LK-TIER ' BELOW MIN ' WS-MIN-TIER INTO WS-VALIDATION-MSG DISPLAY 'SUBPGM: ' WS-VALIDATION-MSG PERFORM 6000-ERROR THRU 6000-ERROR-EXIT GOBACK END-IF. IF LK-TIER > WS-MAX-TIER MOVE 04 TO LK-ERROR-CODE MOVE 99 TO LK-STATUS STRING 'TIER ' LK-TIER ' EXCEEDS MAX ' WS-MAX-TIER INTO WS-VALIDATION-MSG DISPLAY 'SUBPGM: ' WS-VALIDATION-MSG PERFORM 6000-ERROR THRU 6000-ERROR-EXIT GOBACK END-IF. DISPLAY '[TRACE] SUBPGM 2000-VALIDATE all checks passed'. 2000-EXIT. EXIT. *> ============================================================ *> 3000-CALCULATE — Perform billing calculation with components *> ============================================================ 3000-CALCULATE SECTION. 3000-START. DISPLAY '[TRACE] SUBPGM 3000-CALCULATE start' ' A=' LK-A ' B=' LK-B. *> Step 1: Decompose input A into billing components *> Input A represents voice minutes (high-order) + msg count DIVIDE LK-A BY 1000 GIVING WS-CALC-VOICE-MIN REMAINDER WS-CALC-MSG-COUNT. *> Input B represents data volume in MB MOVE LK-B TO WS-CALC-DATA-MB. DISPLAY '[TRACE] SUBPGM 3000-CALC components: voice=' WS-CALC-VOICE-MIN ' data=' WS-CALC-DATA-MB ' msg=' WS-CALC-MSG-COUNT. *> Step 2: Look up tier configuration from table MOVE 1.00 TO WS-COMP-TIER-MULT. MOVE 'Basic' TO WS-TIER-NAME. MOVE 5.00 TO WS-TIER-BASE-RATE. MOVE 5.00 TO WS-TIER-DATA-RATE. MOVE 0 TO WS-TIER-DISCOUNT. MOVE 0 TO WS-CALC-SUM. IF LK-TIER >= 1 AND LK-TIER <= 4 MOVE WS-TIER-MULT(LK-TIER) TO WS-COMP-TIER-MULT MOVE WS-TIER-DESC(LK-TIER) TO WS-TIER-NAME MOVE WS-TIER-BASE(LK-TIER) TO WS-TIER-BASE-RATE MOVE WS-TIER-DATA(LK-TIER) TO WS-TIER-DATA-RATE MOVE WS-TIER-DISC(LK-TIER) TO WS-TIER-DISCOUNT DISPLAY '[TRACE] SUBPGM tier=' WS-TIER-NAME ' mult=' WS-COMP-TIER-MULT ' base-rate=' WS-TIER-BASE-RATE ' data-rate=' WS-TIER-DATA-RATE ' disc=' WS-TIER-DISCOUNT '%' ELSE MOVE 04 TO LK-ERROR-CODE DISPLAY 'SUBPGM: Invalid tier — using defaults' END-IF. *> Step 3: Calculate voice amount COMPUTE WS-COMP-VOICE-AMT = WS-CALC-VOICE-MIN * WS-TIER-BASE-RATE. DISPLAY '[TRACE] SUBPGM voice amt=' WS-COMP-VOICE-AMT. *> Step 4: Calculate data amount COMPUTE WS-COMP-DATA-AMT = WS-CALC-DATA-MB * WS-TIER-DATA-RATE. DISPLAY '[TRACE] SUBPGM data amt=' WS-COMP-DATA-AMT. *> Step 5: Calculate messaging amount (flat 2.00 per msg) COMPUTE WS-COMP-MSG-AMT = WS-CALC-MSG-COUNT * 2.00. DISPLAY '[TRACE] SUBPGM msg amt=' WS-COMP-MSG-AMT. *> Step 6: Calculate subtotal (voice + data + msg) COMPUTE WS-COMP-SUBTOTAL = WS-COMP-VOICE-AMT + WS-COMP-DATA-AMT + WS-COMP-MSG-AMT. DISPLAY '[TRACE] SUBPGM subtotal=' WS-COMP-SUBTOTAL. *> Step 7: Apply tier discount IF WS-TIER-DISCOUNT > 0 COMPUTE WS-COMP-DISCOUNT = WS-COMP-SUBTOTAL * WS-TIER-DISCOUNT / 100 COMPUTE WS-COMP-FINAL = WS-COMP-SUBTOTAL - WS-COMP-DISCOUNT DISPLAY '[TRACE] SUBPGM discount=' WS-COMP-DISCOUNT ' (' WS-TIER-DISCOUNT '%)' ELSE MOVE 0 TO WS-COMP-DISCOUNT MOVE WS-COMP-SUBTOTAL TO WS-COMP-FINAL END-IF. *> Step 8: Apply tier multiplier COMPUTE WS-CALC-MULT = WS-COMP-FINAL * WS-COMP-TIER-MULT. *> Step 9: Check for overflow MOVE WS-CALC-MULT TO WS-OVERFLOW-CHECK. IF WS-OVERFLOW-CHECK > 9999999999 MOVE 05 TO LK-ERROR-CODE MOVE 98 TO LK-STATUS MOVE 9999999999 TO WS-CALC-RESULT DISPLAY 'SUBPGM: OVERFLOW final=' WS-COMP-FINAL ' mult=' WS-COMP-TIER-MULT PERFORM 6000-ERROR THRU 6000-ERROR-EXIT GOBACK END-IF. *> Step 10: Round and store result COMPUTE WS-CALC-RESULT ROUNDED = WS-CALC-MULT. MOVE WS-CALC-RESULT TO LK-RESULT. *> Step 11: Compute original legacy sum for backward compatibility COMPUTE WS-CALC-SUM = LK-A + LK-B. *> Step 12: Set success status MOVE 00 TO LK-STATUS. MOVE 00 TO LK-ERROR-CODE. MOVE 0 TO RETURN-CODE. *> Step 13: Update statistics ADD 1 TO WS-STAT-COUNT. ADD 1 TO WS-STAT-SUCCESS-CNT. ADD LK-RESULT TO WS-STAT-SUM-VAL. IF LK-RESULT < WS-STAT-MIN-VAL MOVE LK-RESULT TO WS-STAT-MIN-VAL END-IF. IF LK-RESULT > WS-STAT-MAX-VAL MOVE LK-RESULT TO WS-STAT-MAX-VAL END-IF. COMPUTE WS-STAT-AVG-VAL = WS-STAT-SUM-VAL / WS-STAT-COUNT. DISPLAY ' SUBPGM: A=' LK-A ' B=' LK-B ' SUM(legacy)=' WS-CALC-SUM ' TIER=' LK-TIER ' (' WS-TIER-NAME ')' ' MULT=' WS-COMP-TIER-MULT ' DISCOUNT=' WS-TIER-DISCOUNT '%' ' VOICE=' WS-COMP-VOICE-AMT ' DATA=' WS-COMP-DATA-AMT ' MSG=' WS-COMP-MSG-AMT ' RESULT=' LK-RESULT ' CALLS=' WS-LOCAL-COUNT. 3000-EXIT. EXIT. *> ============================================================ *> 4000-LOG — Comprehensive audit logging *> ============================================================ 4000-LOG SECTION. 4000-START. DISPLAY '[TRACE] SUBPGM 4000-LOG call #' WS-CALL-COUNT. *> Write main call record MOVE WS-CALL-COUNT TO AC-CALL-NUM. MOVE LK-A TO AC-A. MOVE LK-B TO AC-B. MOVE LK-TIER TO AC-TIER. MOVE LK-RESULT TO AC-RESULT. MOVE LK-STATUS TO AC-STATUS. MOVE LK-ERROR-CODE TO AC-ERR. WRITE AUDIT-LINE FROM WS-AUDIT-CALL. *> Write component breakdown MOVE 'Voice ' TO AD-COMP. MOVE WS-COMP-VOICE-AMT TO AD-AMT. WRITE AUDIT-LINE FROM WS-AUDIT-DETAIL. MOVE 'Data ' TO AD-COMP. MOVE WS-COMP-DATA-AMT TO AD-AMT. WRITE AUDIT-LINE FROM WS-AUDIT-DETAIL. MOVE 'Messaging ' TO AD-COMP. MOVE WS-COMP-MSG-AMT TO AD-AMT. WRITE AUDIT-LINE FROM WS-AUDIT-DETAIL. MOVE 'Discount ' TO AD-COMP. MOVE WS-COMP-DISCOUNT TO AD-AMT. WRITE AUDIT-LINE FROM WS-AUDIT-DETAIL. MOVE 'Final ' TO AD-COMP. MOVE WS-COMP-FINAL TO AD-AMT. WRITE AUDIT-LINE FROM WS-AUDIT-DETAIL. *> Write tier info MOVE 'Tier Info ' TO AD-COMP. STRING WS-TIER-NAME ' mult=' WS-COMP-TIER-MULT INTO AD-COMP. MOVE 0 TO AD-AMT. WRITE AUDIT-LINE FROM WS-AUDIT-DETAIL. 4000-EXIT. EXIT. *> ============================================================ *> 5000-STATS — Update and optionally report statistics *> ============================================================ 5000-STATS SECTION. 5000-START. DISPLAY '[TRACE] SUBPGM 5000-STATS call #' WS-CALL-COUNT. *> Write statistics every 5 calls IF WS-CALL-COUNT / 5 * 5 = WS-CALL-COUNT MOVE WS-STAT-MIN-VAL TO AS-MIN MOVE WS-STAT-MAX-VAL TO AS-MAX MOVE WS-STAT-AVG-VAL TO AS-AVG MOVE WS-STAT-COUNT TO AS-CNT WRITE AUDIT-LINE FROM WS-AUDIT-STATS MOVE WS-STAT-ERR-COUNT TO AE-COUNT MOVE WS-STAT-SUCCESS-CNT TO AE-SUCCESS WRITE AUDIT-LINE FROM WS-AUDIT-ERR-STATS END-IF. 5000-EXIT. EXIT. *> ============================================================ *> 5500-DISCOUNT-CALC — Additional discount stacking logic *> ============================================================ 5500-DISCOUNT-CALC SECTION. 5500-START. DISPLAY '[TRACE] SUBPGM 5500-DISCOUNT-CALC' ' tier=' LK-TIER. *> Apply additional volume-based discount *> If combined voice+data exceeds threshold, extra discount IF WS-COMP-SUBTOTAL > 10000 COMPUTE WS-COMP-DISCOUNT = WS-COMP-DISCOUNT + (WS-COMP-SUBTOTAL * 5 / 100) DISPLAY '[TRACE] SUBPGM volume discount applied: +5%' END-IF. *> If enterprise tier and high data usage, waive data fees IF LK-TIER = 3 AND WS-CALC-DATA-MB > 500 COMPUTE WS-COMP-DATA-AMT = 0 DISPLAY '[TRACE] SUBPGM enterprise data waiver applied' END-IF. *> Recalculate final after additional discounts COMPUTE WS-COMP-FINAL = WS-COMP-VOICE-AMT + WS-COMP-DATA-AMT + WS-COMP-MSG-AMT - WS-COMP-DISCOUNT. IF WS-COMP-FINAL < 0 MOVE 0 TO WS-COMP-FINAL END-IF. DISPLAY '[TRACE] SUBPGM after extra discounts: final=' WS-COMP-FINAL. 5500-EXIT. EXIT. *> ============================================================ *> 6000-ERROR — Error handler with error code lookup *> ============================================================ 6000-ERROR SECTION. 6000-START. ADD 1 TO WS-ERROR-COUNT. ADD 1 TO WS-STAT-ERR-COUNT. MOVE WS-ERROR-COUNT TO ED-NUM. *> Look up error code description IF LK-ERROR-CODE >= 0 AND LK-ERROR-CODE <= 9 ADD 1 TO LK-ERROR-CODE MOVE WS-EC-MESSAGE(LK-ERROR-CODE) TO ED-MESSAGE SUBTRACT 1 FROM LK-ERROR-CODE ELSE STRING 'Error code=' LK-ERROR-CODE ' A=' LK-A ' B=' LK-B ' tier=' LK-TIER INTO ED-MESSAGE END-IF. DISPLAY WS-ERROR-DETAIL. WRITE ERROR-LINE FROM WS-ERROR-DETAIL. 6000-EXIT. EXIT. *> ============================================================ *> 7000-CLEANUP — Close files and write final stats *> ============================================================ 7000-CLEANUP SECTION. 7000-START. DISPLAY '[TRACE] SUBPGM 7000-CLEANUP' ' call #' WS-CALL-COUNT. *> Write final statistics MOVE WS-STAT-MIN-VAL TO AS-MIN. MOVE WS-STAT-MAX-VAL TO AS-MAX. MOVE WS-STAT-AVG-VAL TO AS-AVG. MOVE WS-STAT-COUNT TO AS-CNT. WRITE AUDIT-LINE FROM WS-AUDIT-STATS. MOVE WS-STAT-ERR-COUNT TO AE-COUNT. MOVE WS-STAT-SUCCESS-CNT TO AE-SUCCESS. WRITE AUDIT-LINE FROM WS-AUDIT-ERR-STATS. WRITE AUDIT-LINE FROM WS-AUDIT-FOOTER. *> Close files when count >= 15 IF WS-CALL-COUNT >= 15 CLOSE AUDIT-FILE IF FS-AUDIT NOT = '00' AND NOT = '00' DISPLAY 'SUBPGM: WARNING closing AUDIT status=' FS-AUDIT END-IF CLOSE ERROR-FILE IF FS-ERROR NOT = '00' AND NOT = '00' DISPLAY 'SUBPGM: WARNING closing ERROR status=' FS-ERROR END-IF DISPLAY '[TRACE] SUBPGM files closed cleanly' END-IF. 7000-EXIT. EXIT. *> ============================================================ *> 8000-REPORT — Summary report generation *> ============================================================ 8000-REPORT SECTION. 8000-START. DISPLAY '[TRACE] SUBPGM 8000-REPORT call #' WS-CALL-COUNT. DISPLAY ' SUBPGM CALL SUMMARY:' DISPLAY ' Total calls : ' WS-STAT-COUNT DISPLAY ' Successful : ' WS-STAT-SUCCESS-CNT DISPLAY ' Errors : ' WS-STAT-ERR-COUNT DISPLAY ' Min result : ' WS-STAT-MIN-VAL DISPLAY ' Max result : ' WS-STAT-MAX-VAL DISPLAY ' Avg result : ' WS-STAT-AVG-VAL DISPLAY ' Sum result : ' WS-STAT-SUM-VAL. 8000-EXIT. EXIT. *> ============================================================ *> 9000-EXIT — Return to caller with GOBACK *> ============================================================ 9000-EXIT SECTION. 9000-START. DISPLAY '[TRACE] SUBPGM 9000-EXIT call #' WS-CALL-COUNT. *> Call PERFORM to log, update stats, and cleanup PERFORM 4000-LOG THRU 4000-LOG-EXIT. PERFORM 5000-STATS THRU 5000-STATS-EXIT. PERFORM 5500-DISCOUNT-CALC THRU 5500-DISCOUNT-CALC-EXIT. PERFORM 7000-CLEANUP THRU 7000-CLEANUP-EXIT. DISPLAY '[TRACE] SUBPGM returning to caller, result=' LK-RESULT ' status=' LK-STATUS. GOBACK. 9000-EXIT-EXIT. EXIT.