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,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