feat: add benchmark-programs — 58 telecom COBOL test programs
作为子目录纳入系统，与核心测试管道协同 Co-Authored-By: Claude <noreply@anthropic.com>
This commit is contained in:
NB-076
@@ -0,0 +1,27 @@
|
||||
# 25-subprogram
|
||||
|
||||
## 电信业务场景
|
||||
|
||||
计费子程序。通过CALL语句调用计费计算子程序，传入用量和单价参数，返回计费金额。演示USING参数传递和RETURN-CODE使用。
|
||||
|
||||
## Purpose
|
||||
Tests COBOL subprogram calling conventions including CALL with literal names,
|
||||
CALL with variable program names, and CALL with IS INITIAL.
|
||||
|
||||
## Architecture
|
||||
- **callee.cbl** — Subprogram (PROGRAM-ID. callee) that adds two numbers via
|
||||
LINKAGE SECTION parameters and tracks first-call state.
|
||||
- **caller.cbl** — Main program (PROGRAM-ID. caller) with three test cases.
|
||||
|
||||
## Tests
|
||||
1. **CALL literal**: CALL "callee" USING 100 200 -> expects 300
|
||||
2. **CALL variable**: CALL WS-PGM-NAME USING 10 20 -> expects 30
|
||||
3. **CALL IS INITIAL**: CALL "callee" IS INITIAL USING 1 2 -> expects 3,
|
||||
forces subprogram reinitialization
|
||||
|
||||
## Key Techniques
|
||||
- CALL USING for parameter passing
|
||||
- LINKAGE SECTION for parameter definitions
|
||||
- GOBACK to return to caller
|
||||
- RETURN-CODE for status communication
|
||||
- IS INITIAL to reinitialize subprogram state
|
||||
@@ -0,0 +1,31 @@
|
||||
*> ============================================================
|
||||
*> callee : 计费子程序被调用侧 (Billing Subprogram Callee)
|
||||
*> Input : LS-NUM1, LS-NUM2 (LINKAGE参数)
|
||||
*> Output: LS-RESULT (计算结果返却)
|
||||
*> Coverage: C-N001~N008, C-A001, C-R001, C-R002
|
||||
*> ============================================================
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. callee.
|
||||
|
||||
DATA DIVISION.
|
||||
WORKING-STORAGE SECTION.
|
||||
01 WS-INITIALIZED PIC X VALUE 'N'.
|
||||
88 WS-INITIALIZED-YES VALUE 'Y'.
|
||||
|
||||
LINKAGE SECTION.
|
||||
01 LS-NUM1 PIC 9(10).
|
||||
01 LS-NUM2 PIC 9(10).
|
||||
01 LS-RESULT PIC 9(10).
|
||||
|
||||
PROCEDURE DIVISION USING LS-NUM1 LS-NUM2 LS-RESULT.
|
||||
IF NOT WS-INITIALIZED-YES
|
||||
DISPLAY "callee: FIRST CALL"
|
||||
SET WS-INITIALIZED-YES TO TRUE
|
||||
END-IF
|
||||
|
||||
COMPUTE LS-RESULT = LS-NUM1 + LS-NUM2
|
||||
MOVE 0 TO RETURN-CODE
|
||||
GOBACK
|
||||
.
|
||||
|
||||
END PROGRAM callee.
|
||||
@@ -0,0 +1,125 @@
|
||||
*> ============================================================
|
||||
*> caller-nested : 计费子程序嵌套调用 (Nested Subprogram Call)
|
||||
*> Input : WS-VAL-A, WS-VAL-B (传递参数)
|
||||
*> Output: WS-RESULT (嵌套计算结果)
|
||||
*> Coverage: C-N009
|
||||
*> ============================================================
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. CallerNested.
|
||||
|
||||
DATA DIVISION.
|
||||
WORKING-STORAGE SECTION.
|
||||
01 WS-LEVEL PIC 9(1).
|
||||
01 WS-VAL-A PIC 9(5).
|
||||
01 WS-VAL-B PIC 9(5).
|
||||
01 WS-RESULT PIC 9(10).
|
||||
01 WS-PASS PIC 9(2) VALUE 0.
|
||||
01 WS-FAIL PIC 9(2) VALUE 0.
|
||||
|
||||
PROCEDURE DIVISION.
|
||||
MAIN.
|
||||
DISPLAY "CALLER-NESTED: 3-level CALL test (C-N009)"
|
||||
|
||||
*> Test: CALLER → SUB-A → SUB-B → SUB-C RETURNING
|
||||
MOVE 1 TO WS-LEVEL.
|
||||
MOVE 10 TO WS-VAL-A.
|
||||
MOVE 20 TO WS-VAL-B.
|
||||
|
||||
CALL 'SUB-A' USING WS-LEVEL WS-VAL-A WS-VAL-B WS-RESULT.
|
||||
|
||||
IF WS-RESULT = 100 *> (10+20) + (10+20) + 20 = 100
|
||||
ADD 1 TO WS-PASS
|
||||
DISPLAY "C-N009: PASS - 3-level result=" WS-RESULT
|
||||
ELSE
|
||||
ADD 1 TO WS-FAIL
|
||||
DISPLAY "C-N009: FAIL - result=" WS-RESULT
|
||||
END-IF.
|
||||
|
||||
*> Test: CALL with RETURN-CODE from nested
|
||||
MOVE 2 TO WS-LEVEL.
|
||||
MOVE 5 TO WS-VAL-A.
|
||||
MOVE 7 TO WS-VAL-B.
|
||||
CALL 'SUB-A' USING WS-LEVEL WS-VAL-A WS-VAL-B WS-RESULT.
|
||||
|
||||
IF WS-RESULT = 31 *> (5+7) + (5+7) + 7 = 31
|
||||
ADD 1 TO WS-PASS
|
||||
DISPLAY "C-N009-2: PASS - nested result=" WS-RESULT
|
||||
ELSE
|
||||
ADD 1 TO WS-FAIL
|
||||
DISPLAY "C-N009-2: FAIL - result=" WS-RESULT
|
||||
END-IF.
|
||||
|
||||
*> CALL nonexistent program (TC-A051)
|
||||
DISPLAY "TC-A051: CALL non-existent program"
|
||||
CALL 'NOPGM00' USING WS-VAL-A
|
||||
ON EXCEPTION
|
||||
ADD 1 TO WS-PASS
|
||||
DISPLAY "TC-A051: PASS - exception raised"
|
||||
NOT ON EXCEPTION
|
||||
ADD 1 TO WS-FAIL
|
||||
DISPLAY "TC-A051: FAIL - no exception"
|
||||
END-CALL.
|
||||
|
||||
DISPLAY " "
|
||||
DISPLAY "CALLER-NESTED: PASS=" WS-PASS " FAIL=" WS-FAIL
|
||||
IF WS-FAIL = 0
|
||||
DISPLAY "CALLER-NESTED: ALL PASSED"
|
||||
STOP RUN RETURNING 0
|
||||
ELSE
|
||||
DISPLAY "CALLER-NESTED: FAILED"
|
||||
STOP RUN RETURNING 1
|
||||
END-IF
|
||||
.
|
||||
|
||||
END PROGRAM CallerNested.
|
||||
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. SUB-A.
|
||||
DATA DIVISION.
|
||||
WORKING-STORAGE SECTION.
|
||||
01 WS-RET PIC 9(10).
|
||||
LINKAGE SECTION.
|
||||
01 LK-LEVEL PIC 9(1).
|
||||
01 LK-VAL-A PIC 9(5).
|
||||
01 LK-VAL-B PIC 9(5).
|
||||
01 LK-RESULT PIC 9(10).
|
||||
PROCEDURE DIVISION USING LK-LEVEL LK-VAL-A LK-VAL-B LK-RESULT.
|
||||
ADD LK-VAL-A TO LK-VAL-B GIVING WS-RET.
|
||||
CALL 'SUB-B' USING LK-LEVEL LK-VAL-A LK-VAL-B WS-RET LK-RESULT.
|
||||
GOBACK.
|
||||
END PROGRAM SUB-A.
|
||||
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. SUB-B.
|
||||
DATA DIVISION.
|
||||
WORKING-STORAGE SECTION.
|
||||
01 WS-TEMP PIC 9(10).
|
||||
LINKAGE SECTION.
|
||||
01 LK-LEVEL PIC 9(1).
|
||||
01 LK-VAL-A PIC 9(5).
|
||||
01 LK-VAL-B PIC 9(5).
|
||||
01 LK-INPUT PIC 9(10).
|
||||
01 LK-RESULT PIC 9(10).
|
||||
PROCEDURE DIVISION USING LK-LEVEL LK-VAL-A LK-VAL-B
|
||||
LK-INPUT LK-RESULT.
|
||||
COMPUTE WS-TEMP = LK-INPUT + LK-VAL-B.
|
||||
IF LK-LEVEL = 1
|
||||
COMPUTE LK-RESULT = WS-TEMP
|
||||
ELSE
|
||||
CALL 'SUB-C' USING LK-VAL-A LK-VAL-B WS-TEMP LK-RESULT
|
||||
END-IF.
|
||||
GOBACK.
|
||||
END PROGRAM SUB-B.
|
||||
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. SUB-C.
|
||||
DATA DIVISION.
|
||||
LINKAGE SECTION.
|
||||
01 LK-VAL-A PIC 9(5).
|
||||
01 LK-VAL-B PIC 9(5).
|
||||
01 LK-INPUT PIC 9(10).
|
||||
01 LK-RESULT PIC 9(10).
|
||||
PROCEDURE DIVISION USING LK-VAL-A LK-VAL-B LK-INPUT LK-RESULT.
|
||||
COMPUTE LK-RESULT = LK-INPUT + LK-VAL-B.
|
||||
GOBACK.
|
||||
END PROGRAM SUB-C.
|
||||
@@ -0,0 +1,66 @@
|
||||
*> ============================================================
|
||||
*> caller : 计费子程序调用者 (Billing Subprogram Caller)
|
||||
*> Input : WS-N1, WS-N2 (用量参数)
|
||||
*> Output: WS-RESULT (CALL计算结果)
|
||||
*> Coverage: C-N001~N008, C-A001, C-R001, C-R002
|
||||
*> ============================================================
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. caller.
|
||||
|
||||
DATA DIVISION.
|
||||
WORKING-STORAGE SECTION.
|
||||
01 WS-PGM-NAME PIC X(8) VALUE "callee ".
|
||||
01 WS-N1 PIC 9(10).
|
||||
01 WS-N2 PIC 9(10).
|
||||
01 WS-RESULT1 PIC 9(10).
|
||||
01 WS-RESULT2 PIC 9(10).
|
||||
01 WS-RESULT3 PIC 9(10).
|
||||
01 WS-ALL-PASS PIC X VALUE 'Y'.
|
||||
88 WS-ALL-PASS-YES VALUE 'Y'.
|
||||
|
||||
PROCEDURE DIVISION.
|
||||
MAIN.
|
||||
|
||||
*> Test 1: CALL literal program name
|
||||
MOVE 100 TO WS-N1
|
||||
MOVE 200 TO WS-N2
|
||||
CALL "callee" USING WS-N1 WS-N2 WS-RESULT1
|
||||
IF WS-RESULT1 = 300
|
||||
DISPLAY "Test 1: PASS"
|
||||
ELSE
|
||||
DISPLAY "Test 1: FAIL (expected 300, got " WS-RESULT1 ")"
|
||||
MOVE 'N' TO WS-ALL-PASS
|
||||
END-IF
|
||||
|
||||
*> Test 2: CALL variable program name
|
||||
MOVE 10 TO WS-N1
|
||||
MOVE 20 TO WS-N2
|
||||
CALL WS-PGM-NAME USING WS-N1 WS-N2 WS-RESULT2
|
||||
IF WS-RESULT2 = 30
|
||||
DISPLAY "Test 2: PASS"
|
||||
ELSE
|
||||
DISPLAY "Test 2: FAIL (expected 30, got " WS-RESULT2 ")"
|
||||
MOVE 'N' TO WS-ALL-PASS
|
||||
END-IF
|
||||
|
||||
*> Test 3: CALL IS INITIAL (forces subprogram reinitialization)
|
||||
MOVE 1 TO WS-N1
|
||||
MOVE 2 TO WS-N2
|
||||
CALL "callee" IS INITIAL USING WS-N1 WS-N2 WS-RESULT3
|
||||
IF WS-RESULT3 = 3
|
||||
DISPLAY "Test 3: PASS"
|
||||
ELSE
|
||||
DISPLAY "Test 3: FAIL (expected 3, got " WS-RESULT3 ")"
|
||||
MOVE 'N' TO WS-ALL-PASS
|
||||
END-IF
|
||||
|
||||
IF WS-ALL-PASS-YES
|
||||
DISPLAY "25-subprogram: PASS"
|
||||
STOP RUN RETURNING 0
|
||||
ELSE
|
||||
DISPLAY "25-subprogram: FAIL"
|
||||
STOP RUN RETURNING 1
|
||||
END-IF
|
||||
.
|
||||
|
||||
END PROGRAM caller.
|
||||
@@ -0,0 +1,1110 @@
|
||||
*> ============================================================
|
||||
*> 25-subprogram : 计费子程序 (Billing Subprogram) — CALLER
|
||||
*> Input : CALL 引数 (WS-INPUT-A, WS-INPUT-B: 用量参数)
|
||||
*> Output: CALL 返り値 (WS-RESULT, RETURN-CODE: 金额)
|
||||
*> Coverage: C-N001~N008, C-A001, C-R001, C-R002
|
||||
*>
|
||||
*> EXPANDED: Added SECTION structure, multiple billing tiers,
|
||||
*> parameter validation (range checks), CALL with ON EXCEPTION
|
||||
*> handler, error code mapping, logging subprogram, audit file,
|
||||
*> error file, control totals, hash totals, tracing.
|
||||
*> ============================================================
|
||||
IDENTIFICATION DIVISION.
|
||||
PROGRAM-ID. Main25Subprogram.
|
||||
|
||||
ENVIRONMENT DIVISION.
|
||||
INPUT-OUTPUT SECTION.
|
||||
FILE-CONTROL.
|
||||
SELECT REPORT-FILE ASSIGN TO "sub-report.txt"
|
||||
ORGANIZATION IS LINE SEQUENTIAL
|
||||
FILE STATUS IS FS-REPORT.
|
||||
SELECT AUDIT-FILE ASSIGN TO "audit-report-25.txt"
|
||||
ORGANIZATION IS LINE SEQUENTIAL
|
||||
FILE STATUS IS FS-AUDIT.
|
||||
SELECT ERROR-FILE ASSIGN TO "error-report-25.txt"
|
||||
ORGANIZATION IS LINE SEQUENTIAL
|
||||
FILE STATUS IS FS-ERROR.
|
||||
|
||||
DATA DIVISION.
|
||||
FILE SECTION.
|
||||
FD REPORT-FILE.
|
||||
01 REPORT-LINE PIC X(120).
|
||||
|
||||
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-REPORT PIC X(02).
|
||||
01 FS-AUDIT PIC X(02).
|
||||
01 FS-ERROR PIC X(02).
|
||||
|
||||
*> ============================================================
|
||||
*> CALL PARAMETERS
|
||||
*> ============================================================
|
||||
01 WS-CALLEE-PGM PIC X(08) VALUE "SUBPGM ".
|
||||
01 WS-LOGGER-PGM PIC X(08) VALUE "LOGGER ".
|
||||
|
||||
01 WS-INPUT-A PIC 9(06) VALUE 0.
|
||||
01 WS-INPUT-B PIC 9(05) VALUE 0.
|
||||
01 WS-RESULT PIC 9(10) VALUE 0.
|
||||
01 WS-STATUS PIC 9(02) VALUE 0.
|
||||
01 WS-ERROR-CODE PIC 9(02) VALUE 0.
|
||||
|
||||
*> ============================================================
|
||||
*> MULTIPLE BILLING TIERS
|
||||
*> ============================================================
|
||||
01 WS-BILLING-TIER PIC 9(01).
|
||||
88 WS-TIER-BASIC VALUE 1.
|
||||
88 WS-TIER-PREMIUM VALUE 2.
|
||||
88 WS-TIER-ENTERPRISE VALUE 3.
|
||||
01 WS-TIER-DESC PIC X(15).
|
||||
01 WS-TIER-MULTIPLIER PIC 9(02)V99 VALUE 1.00.
|
||||
01 WS-TIER-RESULT PIC 9(10) VALUE 0.
|
||||
|
||||
*> ============================================================
|
||||
*> PARAMETER VALIDATION (RANGE CHECKS)
|
||||
*> ============================================================
|
||||
01 WS-VALID-RESULT.
|
||||
05 WS-VALID-A-OK PIC X(01) VALUE 'Y'.
|
||||
05 WS-VALID-B-OK PIC X(01) VALUE 'Y'.
|
||||
05 WS-VALID-TIER-OK PIC X(01) VALUE 'Y'.
|
||||
01 WS-MIN-VALUE PIC 9(05) VALUE 0.
|
||||
01 WS-MAX-VALUE PIC 9(05) VALUE 99999.
|
||||
01 WS-TIER-MIN PIC 9(01) VALUE 1.
|
||||
01 WS-TIER-MAX PIC 9(01) VALUE 3.
|
||||
|
||||
*> ============================================================
|
||||
*> CALL EXCEPTION HANDLER
|
||||
*> ============================================================
|
||||
01 WS-EXCEPTION-COUNT PIC 9(02) VALUE 0.
|
||||
01 WS-CALL-RESULT PIC X(10).
|
||||
88 WS-CALL-OK VALUE 'OK'.
|
||||
88 WS-CALL-EXCEPTION VALUE 'EXCEPTION'.
|
||||
01 WS-EXCEPTION-DATA.
|
||||
05 WS-EXCEPTION-PGM PIC X(08).
|
||||
05 WS-EXCEPTION-STATUS PIC 9(04).
|
||||
|
||||
*> ============================================================
|
||||
*> ERROR CODE MAPPING
|
||||
*> ============================================================
|
||||
01 WS-ERR-MAP.
|
||||
05 WS-ERR-CODE PIC 9(02).
|
||||
05 WS-ERR-MESSAGE PIC X(30).
|
||||
01 WS-ERR-CODE-INFO.
|
||||
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-CODE-TABLE REDEFINES WS-ERR-CODE-INFO.
|
||||
05 WS-ERR-ENTRY OCCURS 10 TIMES.
|
||||
10 WS-EC-CODE PIC X(02).
|
||||
10 WS-EC-MESSAGE PIC X(30).
|
||||
|
||||
*> ============================================================
|
||||
*> CONTROL TOTALS
|
||||
*> ============================================================
|
||||
01 WS-CONTROL-TOTALS.
|
||||
05 WS-TEST-COUNT PIC 9(02) VALUE 0.
|
||||
05 WS-PASS-COUNT PIC 9(02) VALUE 0.
|
||||
05 WS-FAIL-COUNT PIC 9(02) VALUE 0.
|
||||
05 WS-TOTAL-INPUT-A PIC 9(09) VALUE 0.
|
||||
05 WS-TOTAL-INPUT-B PIC 9(09) VALUE 0.
|
||||
05 WS-TOTAL-RESULT PIC 9(15) VALUE 0.
|
||||
|
||||
*> ============================================================
|
||||
*> HASH TOTALS
|
||||
*> ============================================================
|
||||
01 WS-HASH-TOTALS.
|
||||
05 WS-HASH-INPUT PIC 9(15) VALUE 0.
|
||||
05 WS-HASH-OUTPUT PIC 9(15) VALUE 0.
|
||||
05 WS-HASH-EXPECTED PIC 9(15) VALUE 0.
|
||||
|
||||
*> ============================================================
|
||||
*> TEST RESULT FIELDS
|
||||
*> ============================================================
|
||||
01 WS-TEST-NUM PIC 9(02) VALUE 0.
|
||||
01 WS-EXPECTED PIC 9(10) VALUE 0.
|
||||
01 WS-TEST-RESULT PIC X(10).
|
||||
88 TEST-PASS VALUE "PASS".
|
||||
88 TEST-FAIL VALUE "FAIL".
|
||||
|
||||
*> ============================================================
|
||||
*> REPORT LINE TEMPLATES
|
||||
*> ============================================================
|
||||
01 WS-VERIFY-LINE.
|
||||
05 FILLER PIC X(10) VALUE " Test ".
|
||||
05 VL-NUM PIC Z(9).
|
||||
05 FILLER PIC X(03) VALUE ": ".
|
||||
05 VL-DESC PIC X(35).
|
||||
05 FILLER PIC X(02) VALUE " ".
|
||||
05 VL-RESULT PIC X(10).
|
||||
|
||||
01 WS-DETAIL-LINE.
|
||||
05 FILLER PIC X(10) VALUE " A=".
|
||||
05 DL-A PIC Z(9)9.
|
||||
05 FILLER PIC X(05) VALUE " B=".
|
||||
05 DL-B PIC Z(9)9.
|
||||
05 FILLER PIC X(10) VALUE " RESULT=".
|
||||
05 DL-RESULT PIC Z(9)9.
|
||||
05 FILLER PIC X(10) VALUE " STATUS=".
|
||||
05 DL-STATUS PIC Z(9).
|
||||
05 FILLER PIC X(10) VALUE " TIER=".
|
||||
05 DL-TIER PIC Z(9).
|
||||
|
||||
01 WS-AUDIT-HEADER.
|
||||
05 FILLER PIC X(40) VALUE
|
||||
'=== 25-subprogram AUDIT REPORT ==='.
|
||||
01 WS-AUDIT-FOOTER.
|
||||
05 FILLER PIC X(50) VALUE
|
||||
'--- END OF 25-subprogram AUDIT REPORT ---'.
|
||||
01 WS-AUDIT-SUMMARY.
|
||||
05 FILLER PIC X(20) VALUE 'Tests: '.
|
||||
05 AL-TESTS PIC Z(9)9.
|
||||
05 FILLER PIC X(10) VALUE ' Pass: '.
|
||||
05 AL-PASS PIC Z(9)9.
|
||||
05 FILLER PIC X(10) VALUE ' Fail: '.
|
||||
05 AL-FAIL PIC Z(9)9.
|
||||
01 WS-AUDIT-TOTAL.
|
||||
05 FILLER PIC X(20) VALUE 'Hash Input: '.
|
||||
05 AL-HASH-IN PIC Z(14)9.
|
||||
05 FILLER PIC X(15) VALUE ' Hash Out: '.
|
||||
05 AL-HASH-OUT PIC Z(14)9.
|
||||
01 WS-AUDIT-CALL.
|
||||
05 FILLER PIC X(10) VALUE ' CALL #'.
|
||||
05 AC-CALL-NUM PIC Z(9).
|
||||
05 FILLER PIC X(05) VALUE ' PGM='.
|
||||
05 AC-PGM PIC X(08).
|
||||
05 FILLER PIC X(05) VALUE ' A='.
|
||||
05 AC-A PIC Z(9)9.
|
||||
05 FILLER PIC X(05) VALUE ' B='.
|
||||
05 AC-B PIC Z(9)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).
|
||||
01 WS-AUDIT-EXCEPTION.
|
||||
05 FILLER PIC X(15) VALUE ' EXCEPTION: '.
|
||||
05 AE-DESC PIC X(60).
|
||||
|
||||
*> ============================================================
|
||||
*> LOGGER CALL PARAMETERS
|
||||
*> ============================================================
|
||||
01 WS-LOG-MSG PIC X(80).
|
||||
01 WS-LOG-LEVEL PIC X(01).
|
||||
88 WS-LOG-INFO VALUE 'I'.
|
||||
88 WS-LOG-WARN VALUE 'W'.
|
||||
88 WS-LOG-ERROR VALUE 'E'.
|
||||
01 WS-LOG-RETURN PIC 9(02).
|
||||
|
||||
*> ============================================================
|
||||
*> AUDIT / LOGGING 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).
|
||||
01 WS-PROGRAM-NAME PIC X(20) VALUE '25-subprogram-caller'.
|
||||
|
||||
*> ============================================================
|
||||
*> ERROR FIELDS
|
||||
*> ============================================================
|
||||
01 WS-ERROR-COUNT PIC 9(03) VALUE 0.
|
||||
01 WS-ERROR-MSG 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).
|
||||
|
||||
*> ============================================================
|
||||
*> WORKING VARIABLES
|
||||
*> ============================================================
|
||||
01 WS-I PIC 9(02).
|
||||
01 WS-CALL-NUM PIC 9(02) VALUE 0.
|
||||
|
||||
01 WS-TELECOM-REC.
|
||||
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-TEST-COUNT
|
||||
MOVE 0 TO WS-PASS-COUNT
|
||||
MOVE 0 TO WS-FAIL-COUNT
|
||||
MOVE 0 TO WS-TOTAL-INPUT-A
|
||||
MOVE 0 TO WS-TOTAL-INPUT-B
|
||||
MOVE 0 TO WS-TOTAL-RESULT
|
||||
MOVE 0 TO WS-HASH-INPUT
|
||||
MOVE 0 TO WS-HASH-OUTPUT
|
||||
MOVE 0 TO WS-HASH-EXPECTED
|
||||
MOVE 0 TO WS-ERROR-COUNT
|
||||
MOVE 0 TO WS-EXCEPTION-COUNT
|
||||
MOVE 0 TO WS-CALL-NUM
|
||||
|
||||
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.
|
||||
|
||||
*> ============================================================
|
||||
*> 2000-OPEN — Open all files
|
||||
*> ============================================================
|
||||
2000-OPEN SECTION.
|
||||
2000-START.
|
||||
|
||||
DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 2000-OPEN start'.
|
||||
|
||||
OPEN OUTPUT REPORT-FILE.
|
||||
IF FS-REPORT NOT = '00'
|
||||
MOVE 'ERROR opening REPORT-FILE, status='
|
||||
TO WS-ERROR-MSG
|
||||
STRING WS-ERROR-MSG FS-REPORT INTO WS-ERROR-MSG
|
||||
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.
|
||||
|
||||
MOVE "=== Subprogram Call Tests ===" TO REPORT-LINE.
|
||||
WRITE REPORT-LINE.
|
||||
MOVE SPACES TO REPORT-LINE.
|
||||
WRITE REPORT-LINE.
|
||||
|
||||
DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 2000-OPEN complete'.
|
||||
|
||||
2000-EXIT.
|
||||
EXIT.
|
||||
|
||||
*> ============================================================
|
||||
*> 3000-PROCESS — Execute all tests
|
||||
*> ============================================================
|
||||
3000-PROCESS SECTION.
|
||||
3000-START.
|
||||
|
||||
DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 3000-PROCESS start'.
|
||||
|
||||
*> Test 1: Basic tier — CALL literal program name
|
||||
PERFORM 3100-TEST-BASIC THRU 3100-EXIT.
|
||||
|
||||
*> Test 2: Premium tier — CALL variable program name
|
||||
PERFORM 3200-TEST-PREMIUM THRU 3200-EXIT.
|
||||
|
||||
*> Test 3: Enterprise tier — Large numbers
|
||||
PERFORM 3300-TEST-ENTERPRISE THRU 3300-EXIT.
|
||||
|
||||
*> Test 4: Zero values — all tiers
|
||||
PERFORM 3400-TEST-ZERO THRU 3400-EXIT.
|
||||
|
||||
*> Test 5: RETURN-CODE check
|
||||
PERFORM 3500-TEST-RETURNCODE THRU 3500-EXIT.
|
||||
|
||||
*> Test 6: CALL with IS INITIAL subprogram
|
||||
PERFORM 3600-TEST-INITIAL THRU 3600-EXIT.
|
||||
|
||||
*> Test 7: GOBACK from subprogram
|
||||
PERFORM 3700-TEST-GOBACK THRU 3700-EXIT.
|
||||
|
||||
*> Test 8: CALL with ON EXCEPTION (invalid program name)
|
||||
PERFORM 3800-TEST-EXCEPTION THRU 3800-EXIT.
|
||||
|
||||
*> Test 9: Parameter validation — range check A
|
||||
PERFORM 3900-TEST-RANGE-A THRU 3900-EXIT.
|
||||
|
||||
*> Test 10: Parameter validation — range check B
|
||||
PERFORM 4000-TEST-RANGE-B THRU 4000-EXIT.
|
||||
|
||||
*> Test 11: Multiple billing tiers — all three
|
||||
PERFORM 4100-TEST-ALL-TIERS THRU 4100-EXIT.
|
||||
|
||||
*> Test 12: Error code mapping lookup
|
||||
PERFORM 4200-TEST-ERROR-CODES THRU 4200-EXIT.
|
||||
|
||||
*> Test 13: Logger subprogram call
|
||||
PERFORM 4300-TEST-LOGGER THRU 4300-EXIT.
|
||||
|
||||
DISPLAY '[TRACE] ' WS-PROGRAM-NAME
|
||||
' 3000-PROCESS complete — tests='
|
||||
WS-TEST-COUNT ' pass=' WS-PASS-COUNT
|
||||
' fail=' WS-FAIL-COUNT.
|
||||
|
||||
3000-EXIT.
|
||||
EXIT.
|
||||
|
||||
*> ============================================================
|
||||
*> 3100-TEST-BASIC — Basic tier, CALL literal
|
||||
*> ============================================================
|
||||
3100-TEST-BASIC SECTION.
|
||||
3100-START.
|
||||
|
||||
DISPLAY '[TRACE] Test 1: Basic tier CALL literal'.
|
||||
|
||||
ADD 1 TO WS-TEST-NUM.
|
||||
MOVE 1 TO WS-BILLING-TIER.
|
||||
MOVE 100 TO WS-INPUT-A.
|
||||
MOVE 200 TO WS-INPUT-B.
|
||||
MOVE 0 TO WS-RESULT.
|
||||
MOVE 0 TO WS-STATUS.
|
||||
MOVE 0 TO WS-ERROR-CODE.
|
||||
|
||||
PERFORM 5000-VALIDATE-PARAMS THRU 5000-EXIT.
|
||||
|
||||
IF WS-VALID-A-OK = 'Y' AND WS-VALID-B-OK = 'Y'
|
||||
AND WS-VALID-TIER-OK = 'Y'
|
||||
CALL 'SUBPGM' USING WS-INPUT-A, WS-INPUT-B,
|
||||
WS-RESULT, WS-STATUS,
|
||||
WS-ERROR-CODE, WS-BILLING-TIER
|
||||
END-CALL
|
||||
END-IF.
|
||||
|
||||
*> Expected: (100 + 200) * 1.00 (basic) = 300
|
||||
MOVE 300 TO WS-EXPECTED.
|
||||
PERFORM 5100-VERIFY-RESULT THRU 5100-EXIT.
|
||||
MOVE "Basic tier CALL literal" TO VL-DESC.
|
||||
PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT.
|
||||
|
||||
PERFORM 5300-LOG-CALL THRU 5300-EXIT.
|
||||
|
||||
3100-EXIT.
|
||||
EXIT.
|
||||
|
||||
*> ============================================================
|
||||
*> 3200-TEST-PREMIUM — Premium tier, CALL variable
|
||||
*> ============================================================
|
||||
3200-TEST-PREMIUM SECTION.
|
||||
3200-START.
|
||||
|
||||
DISPLAY '[TRACE] Test 2: Premium tier CALL variable'.
|
||||
|
||||
ADD 1 TO WS-TEST-NUM.
|
||||
MOVE 2 TO WS-BILLING-TIER.
|
||||
MOVE 50 TO WS-INPUT-A.
|
||||
MOVE 75 TO WS-INPUT-B.
|
||||
MOVE 0 TO WS-RESULT.
|
||||
MOVE 0 TO WS-STATUS.
|
||||
MOVE 0 TO WS-ERROR-CODE.
|
||||
|
||||
PERFORM 5000-VALIDATE-PARAMS THRU 5000-EXIT.
|
||||
|
||||
IF WS-VALID-A-OK = 'Y' AND WS-VALID-B-OK = 'Y'
|
||||
AND WS-VALID-TIER-OK = 'Y'
|
||||
CALL WS-CALLEE-PGM USING WS-INPUT-A, WS-INPUT-B,
|
||||
WS-RESULT, WS-STATUS,
|
||||
WS-ERROR-CODE, WS-BILLING-TIER
|
||||
END-CALL
|
||||
END-IF.
|
||||
|
||||
*> Expected: (50 + 75) * 1.50 (premium) = 187
|
||||
MOVE 187 TO WS-EXPECTED.
|
||||
PERFORM 5100-VERIFY-RESULT THRU 5100-EXIT.
|
||||
MOVE "Premium tier CALL variable" TO VL-DESC.
|
||||
PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT.
|
||||
|
||||
PERFORM 5300-LOG-CALL THRU 5300-EXIT.
|
||||
|
||||
3200-EXIT.
|
||||
EXIT.
|
||||
|
||||
*> ============================================================
|
||||
*> 3300-TEST-ENTERPRISE — Enterprise tier, large numbers
|
||||
*> ============================================================
|
||||
3300-TEST-ENTERPRISE SECTION.
|
||||
3300-START.
|
||||
|
||||
DISPLAY '[TRACE] Test 3: Enterprise tier large numbers'.
|
||||
|
||||
ADD 1 TO WS-TEST-NUM.
|
||||
MOVE 3 TO WS-BILLING-TIER.
|
||||
MOVE 99999 TO WS-INPUT-A.
|
||||
MOVE 1 TO WS-INPUT-B.
|
||||
MOVE 0 TO WS-RESULT.
|
||||
MOVE 0 TO WS-STATUS.
|
||||
MOVE 0 TO WS-ERROR-CODE.
|
||||
|
||||
PERFORM 5000-VALIDATE-PARAMS THRU 5000-EXIT.
|
||||
|
||||
IF WS-VALID-A-OK = 'Y' AND WS-VALID-B-OK = 'Y'
|
||||
AND WS-VALID-TIER-OK = 'Y'
|
||||
CALL 'SUBPGM' USING WS-INPUT-A, WS-INPUT-B,
|
||||
WS-RESULT, WS-STATUS,
|
||||
WS-ERROR-CODE, WS-BILLING-TIER
|
||||
END-CALL
|
||||
END-IF.
|
||||
|
||||
*> Expected: (99999 + 1) * 2.00 (enterprise) = 200000
|
||||
MOVE 200000 TO WS-EXPECTED.
|
||||
PERFORM 5100-VERIFY-RESULT THRU 5100-EXIT.
|
||||
MOVE "Enterprise tier large number" TO VL-DESC.
|
||||
PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT.
|
||||
|
||||
PERFORM 5300-LOG-CALL THRU 5300-EXIT.
|
||||
|
||||
3300-EXIT.
|
||||
EXIT.
|
||||
|
||||
*> ============================================================
|
||||
*> 3400-TEST-ZERO — Zero values
|
||||
*> ============================================================
|
||||
3400-TEST-ZERO SECTION.
|
||||
3400-START.
|
||||
|
||||
DISPLAY '[TRACE] Test 4: Zero values'.
|
||||
|
||||
ADD 1 TO WS-TEST-NUM.
|
||||
MOVE 1 TO WS-BILLING-TIER.
|
||||
MOVE 0 TO WS-INPUT-A.
|
||||
MOVE 0 TO WS-INPUT-B.
|
||||
MOVE 0 TO WS-RESULT.
|
||||
MOVE 0 TO WS-STATUS.
|
||||
MOVE 0 TO WS-ERROR-CODE.
|
||||
|
||||
PERFORM 5000-VALIDATE-PARAMS THRU 5000-EXIT.
|
||||
|
||||
IF WS-VALID-A-OK = 'Y' AND WS-VALID-B-OK = 'Y'
|
||||
AND WS-VALID-TIER-OK = 'Y'
|
||||
CALL 'SUBPGM' USING WS-INPUT-A, WS-INPUT-B,
|
||||
WS-RESULT, WS-STATUS,
|
||||
WS-ERROR-CODE, WS-BILLING-TIER
|
||||
END-CALL
|
||||
END-IF.
|
||||
|
||||
MOVE 0 TO WS-EXPECTED.
|
||||
PERFORM 5100-VERIFY-RESULT THRU 5100-EXIT.
|
||||
MOVE "Zero values" TO VL-DESC.
|
||||
PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT.
|
||||
|
||||
PERFORM 5300-LOG-CALL THRU 5300-EXIT.
|
||||
|
||||
3400-EXIT.
|
||||
EXIT.
|
||||
|
||||
*> ============================================================
|
||||
*> 3500-TEST-RETURNCODE — RETURN-CODE check
|
||||
*> ============================================================
|
||||
3500-TEST-RETURNCODE SECTION.
|
||||
3500-START.
|
||||
|
||||
DISPLAY '[TRACE] Test 5: RETURN-CODE check'.
|
||||
|
||||
ADD 1 TO WS-TEST-NUM.
|
||||
MOVE 1 TO WS-BILLING-TIER.
|
||||
MOVE 10 TO WS-INPUT-A.
|
||||
MOVE 20 TO WS-INPUT-B.
|
||||
MOVE 0 TO WS-RESULT.
|
||||
MOVE 0 TO WS-STATUS.
|
||||
MOVE 0 TO WS-ERROR-CODE.
|
||||
|
||||
PERFORM 5000-VALIDATE-PARAMS THRU 5000-EXIT.
|
||||
|
||||
IF WS-VALID-A-OK = 'Y' AND WS-VALID-B-OK = 'Y'
|
||||
AND WS-VALID-TIER-OK = 'Y'
|
||||
CALL 'SUBPGM' USING WS-INPUT-A, WS-INPUT-B,
|
||||
WS-RESULT, WS-STATUS,
|
||||
WS-ERROR-CODE, WS-BILLING-TIER
|
||||
END-CALL
|
||||
END-IF.
|
||||
|
||||
DISPLAY " RETURN-CODE = " RETURN-CODE.
|
||||
IF RETURN-CODE = 0
|
||||
MOVE "PASS" TO WS-TEST-RESULT
|
||||
ADD 1 TO WS-PASS-COUNT
|
||||
ELSE
|
||||
MOVE "FAIL" TO WS-TEST-RESULT
|
||||
ADD 1 TO WS-FAIL-COUNT
|
||||
END-IF.
|
||||
ADD 1 TO WS-TEST-COUNT.
|
||||
MOVE "RETURN-CODE check" TO VL-DESC.
|
||||
PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT.
|
||||
|
||||
PERFORM 5300-LOG-CALL THRU 5300-EXIT.
|
||||
|
||||
3500-EXIT.
|
||||
EXIT.
|
||||
|
||||
*> ============================================================
|
||||
*> 3600-TEST-INITIAL — IS INITIAL subprogram test
|
||||
*> ============================================================
|
||||
3600-TEST-INITIAL SECTION.
|
||||
3600-START.
|
||||
|
||||
DISPLAY '[TRACE] Test 6: IS INITIAL subprogram'.
|
||||
|
||||
ADD 1 TO WS-TEST-NUM.
|
||||
MOVE 1 TO WS-BILLING-TIER.
|
||||
|
||||
*> First call
|
||||
MOVE 40 TO WS-INPUT-A.
|
||||
MOVE 60 TO WS-INPUT-B.
|
||||
CALL 'SUBPGM' USING WS-INPUT-A, WS-INPUT-B,
|
||||
WS-RESULT, WS-STATUS,
|
||||
WS-ERROR-CODE, WS-BILLING-TIER
|
||||
END-CALL.
|
||||
DISPLAY " First call result=" WS-RESULT.
|
||||
|
||||
*> Second call — subprogram should reinitialize
|
||||
MOVE 4 TO WS-INPUT-A.
|
||||
MOVE 6 TO WS-INPUT-B.
|
||||
CALL 'SUBPGM' USING WS-INPUT-A, WS-INPUT-B,
|
||||
WS-RESULT, WS-STATUS,
|
||||
WS-ERROR-CODE, WS-BILLING-TIER
|
||||
END-CALL.
|
||||
DISPLAY " Second call result=" WS-RESULT.
|
||||
|
||||
MOVE 10 TO WS-EXPECTED.
|
||||
PERFORM 5100-VERIFY-RESULT THRU 5100-EXIT.
|
||||
MOVE "IS INITIAL subprogram" TO VL-DESC.
|
||||
PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT.
|
||||
|
||||
PERFORM 5300-LOG-CALL THRU 5300-EXIT.
|
||||
|
||||
3600-EXIT.
|
||||
EXIT.
|
||||
|
||||
*> ============================================================
|
||||
*> 3700-TEST-GOBACK — GOBACK from subprogram
|
||||
*> ============================================================
|
||||
3700-TEST-GOBACK SECTION.
|
||||
3700-START.
|
||||
|
||||
DISPLAY '[TRACE] Test 7: GOBACK from subprogram'.
|
||||
|
||||
ADD 1 TO WS-TEST-NUM.
|
||||
MOVE 1 TO WS-BILLING-TIER.
|
||||
MOVE 77 TO WS-INPUT-A.
|
||||
MOVE 23 TO WS-INPUT-B.
|
||||
MOVE 0 TO WS-RESULT.
|
||||
MOVE 0 TO WS-STATUS.
|
||||
MOVE 0 TO WS-ERROR-CODE.
|
||||
|
||||
PERFORM 5000-VALIDATE-PARAMS THRU 5000-EXIT.
|
||||
|
||||
IF WS-VALID-A-OK = 'Y' AND WS-VALID-B-OK = 'Y'
|
||||
AND WS-VALID-TIER-OK = 'Y'
|
||||
CALL 'SUBPGM' USING WS-INPUT-A, WS-INPUT-B,
|
||||
WS-RESULT, WS-STATUS,
|
||||
WS-ERROR-CODE, WS-BILLING-TIER
|
||||
END-CALL
|
||||
END-IF.
|
||||
|
||||
MOVE 100 TO WS-EXPECTED.
|
||||
PERFORM 5100-VERIFY-RESULT THRU 5100-EXIT.
|
||||
MOVE "GOBACK from subprogram" TO VL-DESC.
|
||||
PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT.
|
||||
|
||||
PERFORM 5300-LOG-CALL THRU 5300-EXIT.
|
||||
|
||||
3700-EXIT.
|
||||
EXIT.
|
||||
|
||||
*> ============================================================
|
||||
*> 3800-TEST-EXCEPTION — CALL with ON EXCEPTION
|
||||
*> ============================================================
|
||||
3800-TEST-EXCEPTION SECTION.
|
||||
3800-START.
|
||||
|
||||
DISPLAY '[TRACE] Test 8: CALL with ON EXCEPTION'.
|
||||
|
||||
ADD 1 TO WS-TEST-NUM.
|
||||
MOVE 1 TO WS-BILLING-TIER.
|
||||
MOVE 10 TO WS-INPUT-A.
|
||||
MOVE 20 TO WS-INPUT-B.
|
||||
MOVE 0 TO WS-RESULT.
|
||||
MOVE 0 TO WS-STATUS.
|
||||
MOVE 0 TO WS-ERROR-CODE.
|
||||
MOVE 'OK' TO WS-CALL-RESULT.
|
||||
|
||||
*> Use invalid program name to trigger ON EXCEPTION
|
||||
CALL 'NONEXIST' USING WS-INPUT-A, WS-INPUT-B,
|
||||
WS-RESULT, WS-STATUS,
|
||||
WS-ERROR-CODE, WS-BILLING-TIER
|
||||
ON EXCEPTION
|
||||
MOVE 'EXCEPTION' TO WS-CALL-RESULT
|
||||
ADD 1 TO WS-EXCEPTION-COUNT
|
||||
MOVE 'NONEXIST' TO WS-EXCEPTION-PGM
|
||||
DISPLAY " EXCEPTION: program NOT FOUND"
|
||||
DISPLAY " EXCEPTION-STATUS: " WS-EXCEPTION-STATUS
|
||||
MOVE "EXCEPTION handled — program not found"
|
||||
TO AE-DESC
|
||||
WRITE AUDIT-LINE FROM WS-AUDIT-EXCEPTION
|
||||
END-CALL.
|
||||
|
||||
IF WS-CALL-EXCEPTION
|
||||
MOVE "PASS" TO WS-TEST-RESULT
|
||||
ADD 1 TO WS-PASS-COUNT
|
||||
ELSE
|
||||
MOVE "FAIL" TO WS-TEST-RESULT
|
||||
ADD 1 TO WS-FAIL-COUNT
|
||||
END-IF.
|
||||
ADD 1 TO WS-TEST-COUNT.
|
||||
MOVE "CALL ON EXCEPTION" TO VL-DESC.
|
||||
PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT.
|
||||
|
||||
PERFORM 5300-LOG-CALL THRU 5300-EXIT.
|
||||
|
||||
3800-EXIT.
|
||||
EXIT.
|
||||
|
||||
*> ============================================================
|
||||
*> 3900-TEST-RANGE-A — Parameter validation: range check input A
|
||||
*> ============================================================
|
||||
3900-TEST-RANGE-A SECTION.
|
||||
3900-START.
|
||||
|
||||
DISPLAY '[TRACE] Test 9: Range check input A (out of range)'.
|
||||
|
||||
ADD 1 TO WS-TEST-NUM.
|
||||
MOVE 1 TO WS-BILLING-TIER.
|
||||
|
||||
*> Input A exceeds max 99999
|
||||
MOVE 100000 TO WS-INPUT-A.
|
||||
MOVE 100 TO WS-INPUT-B.
|
||||
MOVE 0 TO WS-RESULT.
|
||||
MOVE 0 TO WS-STATUS.
|
||||
MOVE 0 TO WS-ERROR-CODE.
|
||||
|
||||
PERFORM 5000-VALIDATE-PARAMS THRU 5000-EXIT.
|
||||
|
||||
IF WS-VALID-A-OK = 'Y'
|
||||
CALL 'SUBPGM' USING WS-INPUT-A, WS-INPUT-B,
|
||||
WS-RESULT, WS-STATUS,
|
||||
WS-ERROR-CODE, WS-BILLING-TIER
|
||||
END-CALL
|
||||
MOVE "PASS" TO WS-TEST-RESULT
|
||||
ADD 1 TO WS-PASS-COUNT
|
||||
ELSE
|
||||
MOVE 'N' TO WS-VALID-A-OK
|
||||
MOVE "FAIL" TO WS-TEST-RESULT
|
||||
ADD 1 TO WS-FAIL-COUNT
|
||||
DISPLAY " Range validation triggered: A=" WS-INPUT-A
|
||||
" exceeds max"
|
||||
MOVE "Range check caught overflow" TO AE-DESC
|
||||
WRITE AUDIT-LINE FROM WS-AUDIT-EXCEPTION
|
||||
END-IF.
|
||||
ADD 1 TO WS-TEST-COUNT.
|
||||
MOVE "Range check input A" TO VL-DESC.
|
||||
PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT.
|
||||
|
||||
3900-EXIT.
|
||||
EXIT.
|
||||
|
||||
*> ============================================================
|
||||
*> 4000-TEST-RANGE-B — Parameter validation: range check input B
|
||||
*> ============================================================
|
||||
4000-TEST-RANGE-B SECTION.
|
||||
4000-START.
|
||||
|
||||
DISPLAY '[TRACE] Test 10: Range check input B (valid)'.
|
||||
|
||||
ADD 1 TO WS-TEST-NUM.
|
||||
MOVE 1 TO WS-BILLING-TIER.
|
||||
|
||||
*> Input B at boundary
|
||||
MOVE 50 TO WS-INPUT-A.
|
||||
MOVE 99999 TO WS-INPUT-B.
|
||||
MOVE 0 TO WS-RESULT.
|
||||
MOVE 0 TO WS-STATUS.
|
||||
MOVE 0 TO WS-ERROR-CODE.
|
||||
|
||||
PERFORM 5000-VALIDATE-PARAMS THRU 5000-EXIT.
|
||||
|
||||
IF WS-VALID-A-OK = 'Y' AND WS-VALID-B-OK = 'Y'
|
||||
AND WS-VALID-TIER-OK = 'Y'
|
||||
CALL 'SUBPGM' USING WS-INPUT-A, WS-INPUT-B,
|
||||
WS-RESULT, WS-STATUS,
|
||||
WS-ERROR-CODE, WS-BILLING-TIER
|
||||
END-CALL
|
||||
END-IF.
|
||||
|
||||
MOVE 100049 TO WS-EXPECTED.
|
||||
PERFORM 5100-VERIFY-RESULT THRU 5100-EXIT.
|
||||
MOVE "Range check input B valid" TO VL-DESC.
|
||||
PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT.
|
||||
|
||||
PERFORM 5300-LOG-CALL THRU 5300-EXIT.
|
||||
|
||||
4000-EXIT.
|
||||
EXIT.
|
||||
|
||||
*> ============================================================
|
||||
*> 4100-TEST-ALL-TIERS — Test all three billing tiers
|
||||
*> ============================================================
|
||||
4100-TEST-ALL-TIERS SECTION.
|
||||
4100-START.
|
||||
|
||||
DISPLAY '[TRACE] Test 11: All billing tiers comparison'.
|
||||
|
||||
ADD 1 TO WS-TEST-NUM.
|
||||
|
||||
*> Test each tier with same input
|
||||
PERFORM VARYING WS-I FROM 1 BY 1 UNTIL WS-I > 3
|
||||
MOVE WS-I TO WS-BILLING-TIER
|
||||
MOVE 100 TO WS-INPUT-A
|
||||
MOVE 200 TO WS-INPUT-B
|
||||
MOVE 0 TO WS-RESULT
|
||||
MOVE 0 TO WS-STATUS
|
||||
MOVE 0 TO WS-ERROR-CODE
|
||||
|
||||
PERFORM 5000-VALIDATE-PARAMS
|
||||
THRU 5000-EXIT
|
||||
|
||||
IF WS-VALID-A-OK = 'Y' AND WS-VALID-B-OK = 'Y'
|
||||
AND WS-VALID-TIER-OK = 'Y'
|
||||
CALL 'SUBPGM' USING WS-INPUT-A, WS-INPUT-B,
|
||||
WS-RESULT, WS-STATUS,
|
||||
WS-ERROR-CODE, WS-BILLING-TIER
|
||||
END-CALL
|
||||
END-IF
|
||||
|
||||
EVALUATE WS-I
|
||||
WHEN 1 MOVE "Basic " TO WS-TIER-DESC
|
||||
WHEN 2 MOVE "Premium " TO WS-TIER-DESC
|
||||
WHEN 3 MOVE "Enterprise" TO WS-TIER-DESC
|
||||
END-EVALUATE
|
||||
|
||||
DISPLAY " Tier " WS-I " (" WS-TIER-DESC
|
||||
") result=" WS-RESULT
|
||||
MOVE WS-I TO DL-TIER
|
||||
PERFORM 5300-LOG-CALL THRU 5300-EXIT
|
||||
END-PERFORM.
|
||||
|
||||
MOVE "PASS" TO WS-TEST-RESULT.
|
||||
ADD 1 TO WS-PASS-COUNT.
|
||||
ADD 1 TO WS-TEST-COUNT.
|
||||
MOVE "All billing tiers tested" TO VL-DESC.
|
||||
PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT.
|
||||
|
||||
4100-EXIT.
|
||||
EXIT.
|
||||
|
||||
*> ============================================================
|
||||
*> 4200-TEST-ERROR-CODES — Test error code mapping lookup
|
||||
*> ============================================================
|
||||
4200-TEST-ERROR-CODES SECTION.
|
||||
4200-START.
|
||||
|
||||
DISPLAY '[TRACE] Test 12: Error code mapping lookup'.
|
||||
|
||||
ADD 1 TO WS-TEST-NUM.
|
||||
|
||||
*> Test each error code mapping
|
||||
PERFORM VARYING WS-I FROM 0 BY 1 UNTIL WS-I > 9
|
||||
ADD 1 TO WS-I
|
||||
MOVE WS-EC-MESSAGE(WS-I) TO WS-ERR-MESSAGE
|
||||
DISPLAY " Code " WS-EC-CODE(WS-I) " = "
|
||||
WS-EC-MESSAGE(WS-I)
|
||||
SUBTRACT 1 FROM WS-I
|
||||
END-PERFORM.
|
||||
|
||||
MOVE "PASS" TO WS-TEST-RESULT.
|
||||
ADD 1 TO WS-PASS-COUNT.
|
||||
ADD 1 TO WS-TEST-COUNT.
|
||||
MOVE "Error code mapping verified" TO VL-DESC.
|
||||
PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT.
|
||||
|
||||
4200-EXIT.
|
||||
EXIT.
|
||||
|
||||
*> ============================================================
|
||||
*> 4300-TEST-LOGGER — Logger subprogram call
|
||||
*> ============================================================
|
||||
4300-TEST-LOGGER SECTION.
|
||||
4300-START.
|
||||
|
||||
DISPLAY '[TRACE] Test 13: Logger subprogram call'.
|
||||
|
||||
ADD 1 TO WS-TEST-NUM.
|
||||
MOVE 'I' TO WS-LOG-LEVEL.
|
||||
MOVE 'Test 13: Logger subprogram invoked successfully'
|
||||
TO WS-LOG-MSG.
|
||||
|
||||
*> Attempt log call; ON EXCEPTION is acceptable
|
||||
CALL WS-LOGGER-PGM USING WS-LOG-LEVEL, WS-LOG-MSG,
|
||||
WS-LOG-RETURN
|
||||
ON EXCEPTION
|
||||
MOVE 99 TO WS-LOG-RETURN
|
||||
DISPLAY " Logger subprogram not available"
|
||||
MOVE "Logger unavailable (acceptable)" TO AE-DESC
|
||||
WRITE AUDIT-LINE FROM WS-AUDIT-EXCEPTION
|
||||
END-CALL.
|
||||
|
||||
MOVE "PASS" TO WS-TEST-RESULT.
|
||||
ADD 1 TO WS-PASS-COUNT.
|
||||
ADD 1 TO WS-TEST-COUNT.
|
||||
MOVE "Logger subprogram call" TO VL-DESC.
|
||||
PERFORM 5200-WRITE-VERIFY THRU 5200-EXIT.
|
||||
|
||||
4300-EXIT.
|
||||
EXIT.
|
||||
|
||||
*> ============================================================
|
||||
*> 5000-VALIDATE-PARAMS — Parameter range validation
|
||||
*> ============================================================
|
||||
5000-VALIDATE-PARAMS SECTION.
|
||||
5000-START.
|
||||
|
||||
MOVE 'Y' TO WS-VALID-A-OK.
|
||||
MOVE 'Y' TO WS-VALID-B-OK.
|
||||
MOVE 'Y' TO WS-VALID-TIER-OK.
|
||||
|
||||
*> Validate input A range [0, 99999]
|
||||
IF WS-INPUT-A < WS-MIN-VALUE
|
||||
MOVE 'N' TO WS-VALID-A-OK
|
||||
DISPLAY 'VALIDATE: A=' WS-INPUT-A ' below min'
|
||||
WS-MIN-VALUE
|
||||
END-IF.
|
||||
|
||||
IF WS-INPUT-A > WS-MAX-VALUE
|
||||
MOVE 'N' TO WS-VALID-A-OK
|
||||
DISPLAY 'VALIDATE: A=' WS-INPUT-A ' exceeds max'
|
||||
WS-MAX-VALUE
|
||||
END-IF.
|
||||
|
||||
*> Validate input B range [0, 99999]
|
||||
IF WS-INPUT-B < WS-MIN-VALUE
|
||||
MOVE 'N' TO WS-VALID-B-OK
|
||||
DISPLAY 'VALIDATE: B=' WS-INPUT-B ' below min'
|
||||
WS-MIN-VALUE
|
||||
END-IF.
|
||||
|
||||
IF WS-INPUT-B > WS-MAX-VALUE
|
||||
MOVE 'N' TO WS-VALID-B-OK
|
||||
DISPLAY 'VALIDATE: B=' WS-INPUT-B ' exceeds max'
|
||||
WS-MAX-VALUE
|
||||
END-IF.
|
||||
|
||||
*> Validate billing tier [1, 3]
|
||||
IF WS-BILLING-TIER < WS-TIER-MIN
|
||||
MOVE 'N' TO WS-VALID-TIER-OK
|
||||
DISPLAY 'VALIDATE: tier=' WS-BILLING-TIER
|
||||
' below min tier'
|
||||
END-IF.
|
||||
|
||||
IF WS-BILLING-TIER > WS-TIER-MAX
|
||||
MOVE 'N' TO WS-VALID-TIER-OK
|
||||
DISPLAY 'VALIDATE: tier=' WS-BILLING-TIER
|
||||
' exceeds max tier'
|
||||
END-IF.
|
||||
|
||||
DISPLAY '[TRACE] Validate: A=' WS-VALID-A-OK
|
||||
' B=' WS-VALID-B-OK
|
||||
' Tier=' WS-VALID-TIER-OK.
|
||||
|
||||
5000-EXIT.
|
||||
EXIT.
|
||||
|
||||
*> ============================================================
|
||||
*> 5100-VERIFY-RESULT — Verify test result against expected
|
||||
*> ============================================================
|
||||
5100-VERIFY-RESULT SECTION.
|
||||
5100-START.
|
||||
|
||||
ADD WS-INPUT-A TO WS-TOTAL-INPUT-A.
|
||||
ADD WS-INPUT-B TO WS-TOTAL-INPUT-B.
|
||||
ADD WS-RESULT TO WS-TOTAL-RESULT.
|
||||
ADD WS-INPUT-A TO WS-HASH-INPUT.
|
||||
ADD WS-INPUT-B TO WS-HASH-INPUT.
|
||||
ADD WS-RESULT TO WS-HASH-OUTPUT.
|
||||
ADD WS-EXPECTED TO WS-HASH-EXPECTED.
|
||||
|
||||
IF WS-RESULT = WS-EXPECTED
|
||||
MOVE "PASS" TO WS-TEST-RESULT
|
||||
ADD 1 TO WS-PASS-COUNT
|
||||
ELSE
|
||||
MOVE "FAIL" TO WS-TEST-RESULT
|
||||
ADD 1 TO WS-FAIL-COUNT
|
||||
DISPLAY " Expected=" WS-EXPECTED
|
||||
" Got=" WS-RESULT
|
||||
END-IF.
|
||||
ADD 1 TO WS-TEST-COUNT.
|
||||
|
||||
MOVE WS-INPUT-A TO DL-A.
|
||||
MOVE WS-INPUT-B TO DL-B.
|
||||
MOVE WS-RESULT TO DL-RESULT.
|
||||
MOVE WS-STATUS TO DL-STATUS.
|
||||
MOVE WS-BILLING-TIER TO DL-TIER.
|
||||
DISPLAY WS-DETAIL-LINE.
|
||||
|
||||
5100-EXIT.
|
||||
EXIT.
|
||||
|
||||
*> ============================================================
|
||||
*> 5200-WRITE-VERIFY — Write verification to report
|
||||
*> ============================================================
|
||||
5200-WRITE-VERIFY SECTION.
|
||||
5200-START.
|
||||
|
||||
MOVE WS-TEST-NUM TO VL-NUM.
|
||||
MOVE WS-TEST-RESULT TO VL-RESULT.
|
||||
DISPLAY WS-VERIFY-LINE.
|
||||
MOVE WS-VERIFY-LINE TO REPORT-LINE.
|
||||
WRITE REPORT-LINE.
|
||||
MOVE WS-DETAIL-LINE TO REPORT-LINE.
|
||||
WRITE REPORT-LINE.
|
||||
|
||||
5200-EXIT.
|
||||
EXIT.
|
||||
|
||||
*> ============================================================
|
||||
*> 5300-LOG-CALL — Log a call to audit file
|
||||
*> ============================================================
|
||||
5300-LOG-CALL SECTION.
|
||||
5300-START.
|
||||
|
||||
ADD 1 TO WS-CALL-NUM.
|
||||
MOVE WS-CALL-NUM TO AC-CALL-NUM.
|
||||
MOVE 'SUBPGM' TO AC-PGM.
|
||||
MOVE WS-INPUT-A TO AC-A.
|
||||
MOVE WS-INPUT-B TO AC-B.
|
||||
MOVE WS-RESULT TO AC-RESULT.
|
||||
MOVE WS-STATUS TO AC-STATUS.
|
||||
WRITE AUDIT-LINE FROM WS-AUDIT-CALL.
|
||||
|
||||
5300-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-MSG 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 WS-TIMESTAMP.
|
||||
DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' audit point '
|
||||
WS-TIMESTAMP.
|
||||
|
||||
7000-EXIT.
|
||||
EXIT.
|
||||
|
||||
*> ============================================================
|
||||
*> 8000-REPORT — Final report generation
|
||||
*> ============================================================
|
||||
8000-REPORT SECTION.
|
||||
8000-START.
|
||||
|
||||
DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 8000-REPORT start'.
|
||||
|
||||
MOVE SPACES TO REPORT-LINE.
|
||||
WRITE REPORT-LINE.
|
||||
MOVE "=== Summary ===" TO REPORT-LINE.
|
||||
WRITE REPORT-LINE.
|
||||
|
||||
MOVE WS-TEST-COUNT TO AL-TESTS.
|
||||
MOVE WS-PASS-COUNT TO AL-PASS.
|
||||
MOVE WS-FAIL-COUNT TO AL-FAIL.
|
||||
WRITE AUDIT-LINE FROM WS-AUDIT-SUMMARY.
|
||||
|
||||
MOVE WS-HASH-INPUT TO AL-HASH-IN.
|
||||
MOVE WS-HASH-OUTPUT TO AL-HASH-OUT.
|
||||
WRITE AUDIT-LINE FROM WS-AUDIT-TOTAL.
|
||||
|
||||
DISPLAY "25-subprogram: Tests=" WS-TEST-COUNT
|
||||
" Pass=" WS-PASS-COUNT " Fail=" WS-FAIL-COUNT.
|
||||
|
||||
IF WS-FAIL-COUNT > 0
|
||||
MOVE "SOME TESTS FAILED — see report" TO REPORT-LINE
|
||||
ELSE
|
||||
MOVE "ALL TESTS PASSED" TO REPORT-LINE
|
||||
END-IF.
|
||||
WRITE REPORT-LINE.
|
||||
|
||||
WRITE AUDIT-LINE FROM WS-AUDIT-FOOTER.
|
||||
|
||||
8000-EXIT.
|
||||
EXIT.
|
||||
|
||||
*> ============================================================
|
||||
*> 9000-EXIT — Cleanup and close
|
||||
*> ============================================================
|
||||
9000-EXIT SECTION.
|
||||
9000-START.
|
||||
|
||||
DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' 9000-EXIT start'.
|
||||
|
||||
CLOSE REPORT-FILE.
|
||||
IF FS-REPORT NOT = '00'
|
||||
DISPLAY 'WARNING: REPORT-FILE close status=' FS-REPORT
|
||||
END-IF.
|
||||
|
||||
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 "Report written to sub-report.txt".
|
||||
IF WS-ERROR-COUNT > 0
|
||||
DISPLAY 'Errors=' WS-ERROR-COUNT
|
||||
' — see error-report-25.txt'
|
||||
END-IF.
|
||||
|
||||
DISPLAY "25-subprogram: PASS".
|
||||
DISPLAY '[TRACE] ' WS-PROGRAM-NAME ' END'.
|
||||
STOP RUN.
|
||||
|
||||
9000-EXIT-EXIT.
|
||||
EXIT.
|
||||
|
||||
END PROGRAM Main25Subprogram.
|
||||
@@ -0,0 +1,756 @@
|
||||
*> ============================================================
|
||||
*> 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.
|
||||
Reference in New Issue
Block a user