NB-076
902 lines
36 KiB
COBOL
902 lines
36 KiB
COBOL
*> ============================================================
|
|
*> 24-table-search : 资费表检索 (Tariff SEARCH ALL) - EXPANDED
|
|
*> Input : FILE-IN (file-in.dat: 检索KEY + PLAN + ZONE + TOD)
|
|
*> TARIFF-IN (tariff.dat: 资费表数据文件, 可选)
|
|
*> Output: FILE-OUT (file-out.dat: 资费表检索结果 - 原有格式)
|
|
*> REPORT-OUT (rpt-out.dat: 扩展统计报告)
|
|
*> Coverage: T-N001~N007, T-A002, T-A003, T-R001
|
|
*> ============================================================
|
|
IDENTIFICATION DIVISION.
|
|
PROGRAM-ID. TableSearch.
|
|
*>
|
|
ENVIRONMENT DIVISION.
|
|
CONFIGURATION SECTION.
|
|
INPUT-OUTPUT SECTION.
|
|
FILE-CONTROL.
|
|
SELECT FILE-IN ASSIGN TO 'file-in.dat'
|
|
ORGANIZATION IS SEQUENTIAL
|
|
ACCESS MODE IS SEQUENTIAL
|
|
FILE STATUS IS WS-FILE-IN-STATUS.
|
|
SELECT FILE-OUT ASSIGN TO 'file-out.dat'
|
|
ORGANIZATION IS SEQUENTIAL
|
|
FILE STATUS IS WS-FILE-OUT-STATUS.
|
|
SELECT TARIFF-IN ASSIGN TO 'tariff.dat'
|
|
ORGANIZATION IS SEQUENTIAL
|
|
ACCESS MODE IS SEQUENTIAL
|
|
FILE STATUS IS WS-TARIFF-STATUS.
|
|
SELECT REPORT-OUT ASSIGN TO 'rpt-out.dat'
|
|
ORGANIZATION IS SEQUENTIAL
|
|
FILE STATUS IS WS-REPORT-STATUS.
|
|
*>
|
|
DATA DIVISION.
|
|
FILE SECTION.
|
|
FD FILE-IN.
|
|
01 IN-REC.
|
|
05 IN-KEY PIC X(02).
|
|
05 IN-PLAN PIC X(03).
|
|
05 IN-ZONE PIC X(02).
|
|
05 IN-TOD PIC X(01).
|
|
*>
|
|
FD FILE-OUT.
|
|
01 OUT-REC.
|
|
05 OUT-KEY PIC X(02).
|
|
05 FILLER PIC X(01) VALUE SPACE.
|
|
05 OUT-ALL-STAT PIC X(01).
|
|
05 FILLER PIC X(01) VALUE SPACE.
|
|
05 OUT-SEQ-STAT PIC X(01).
|
|
05 FILLER PIC X(01) VALUE SPACE.
|
|
05 OUT-VAR-STAT PIC X(01).
|
|
05 FILLER PIC X(01) VALUE SPACE.
|
|
05 OUT-ALL-VAL PIC X(20).
|
|
05 FILLER PIC X(01) VALUE SPACE.
|
|
05 OUT-SEQ-VAL PIC X(20).
|
|
05 FILLER PIC X(01) VALUE SPACE.
|
|
05 OUT-VAR-VAL PIC X(20).
|
|
*>
|
|
FD TARIFF-IN.
|
|
01 TARIFF-REC.
|
|
05 TR-PLAN PIC X(03).
|
|
05 TR-ZONE PIC X(02).
|
|
05 TR-TOD PIC X(01).
|
|
05 TR-RATE PIC 9(05)V9(02).
|
|
05 TR-DESC PIC X(30).
|
|
*>
|
|
FD REPORT-OUT.
|
|
01 REPORT-REC PIC X(80).
|
|
*>
|
|
WORKING-STORAGE SECTION.
|
|
01 WS-TELECOM-REC.
|
|
COPY "telecom/TEL-BILLING.cpy".
|
|
01 WS-FILE-IN-STATUS PIC X(02).
|
|
01 WS-FILE-OUT-STATUS PIC X(02).
|
|
01 WS-TARIFF-STATUS PIC X(02).
|
|
01 WS-REPORT-STATUS PIC X(02).
|
|
01 WS-EOF PIC X(01) VALUE 'N'.
|
|
88 WS-EOF-YES VALUE 'Y' FALSE 'N'.
|
|
01 WS-REC-COUNT PIC 9(05) VALUE ZERO.
|
|
*> Timestamp for tracing
|
|
01 WS-TIMESTAMP.
|
|
05 WS-TS-DATE PIC X(08).
|
|
05 WS-TS-TIME PIC X(08).
|
|
01 WS-TS-STRING PIC X(19).
|
|
01 WS-TRACE-MSG PIC X(80).
|
|
*> Error severity levels
|
|
01 WS-ERROR-SEVERITY PIC X(01).
|
|
88 WS-ERR-INFO VALUE 'I'.
|
|
88 WS-ERR-WARNING VALUE 'W'.
|
|
88 WS-ERR-ERROR VALUE 'E'.
|
|
88 WS-ERR-FATAL VALUE 'F'.
|
|
01 WS-ERROR-COUNT PIC 9(03) VALUE ZERO.
|
|
01 WS-WARN-COUNT PIC 9(03) VALUE ZERO.
|
|
01 WS-ERROR-MSG PIC X(80).
|
|
01 WS-PROCEDURE-NAME PIC X(30).
|
|
*> Telecom tariff table: 10 entries sorted by key (KEPT UNCHANGED)
|
|
01 WS-TABLE.
|
|
05 WS-ENTRY OCCURS 10 TIMES
|
|
ASCENDING KEY IS WS-ENTRY-KEY
|
|
INDEXED BY WS-IDX.
|
|
10 WS-ENTRY-KEY PIC X(02).
|
|
10 WS-ENTRY-VALUE PIC X(20).
|
|
*> Variable-length table for DEPENDING ON demo (KEPT UNCHANGED)
|
|
01 WS-VAR-TABLE.
|
|
05 WS-VAR-ENTRY OCCURS 0 TO 10 TIMES
|
|
DEPENDING ON WS-VAR-SIZE
|
|
ASCENDING KEY IS WS-VAR-KEY
|
|
INDEXED BY WS-VAR-IDX.
|
|
10 WS-VAR-KEY PIC X(02).
|
|
10 WS-VAR-VALUE PIC X(20).
|
|
01 WS-VAR-SIZE PIC 9(02) VALUE 8.
|
|
*> Search key holder
|
|
01 WS-SEARCH-KEY PIC X(02).
|
|
*> Results (KEPT UNCHANGED)
|
|
01 WS-FOUND-ALL PIC X(01).
|
|
88 WS-FOUND-ALL-YES VALUE 'Y' FALSE 'N'.
|
|
01 WS-FOUND-SEQ PIC X(01).
|
|
88 WS-FOUND-SEQ-YES VALUE 'Y' FALSE 'N'.
|
|
01 WS-FOUND-VAR PIC X(01).
|
|
88 WS-FOUND-VAR-YES VALUE 'Y' FALSE 'N'.
|
|
*> Index bounds test (KEPT UNCHANGED)
|
|
01 WS-IDX-VAL PIC 9(02).
|
|
01 WS-BOUNDS-OK PIC X(01).
|
|
88 WS-BOUNDS-OK-YES VALUE 'Y' FALSE 'N'.
|
|
*> ============================================================
|
|
*> EXPANDED: 50-entry multi-key tariff table
|
|
*> ASCENDING KEY = PLAN + ZONE + TOD
|
|
*> Sorted order for SEARCH ALL: P01Z1N < P01Z1O < ... < P10Z4O
|
|
*> Entries: plan codes P01-P10, zones Z1-Z5, TOD N/O/P
|
|
*> ============================================================
|
|
01 WS-MULTI-DATA.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P01Z1N0000040Basic Plan Local Night '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P01Z1O0000060Basic Plan Local Off-Peak '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P01Z1P0000080Basic Plan Local Peak '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P01Z2N0000060Basic Plan Natl Night '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P01Z2O0000090Basic Plan Natl Off-Peak '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P01Z2P0000120Basic Plan Natl Peak '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P02Z1N0000035Standard Local Night '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P02Z1O0000055Standard Local Off-Peak '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P02Z1P0000075Standard Local Peak '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P02Z2N0000055Standard Natl Night '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P02Z2O0000085Standard Natl Off-Peak '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P02Z2P0000110Standard Natl Peak '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P03Z1N0000030Business Local Night '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P03Z1O0000050Business Local Off-Peak '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P03Z1P0000065Business Local Peak '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P03Z2N0000050Business Natl Night '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P03Z2O0000075Business Natl Off-Peak '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P03Z2P0000095Business Natl Peak '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P04Z1N0000025Premium Local Night '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P04Z1O0000045Premium Local Off-Peak '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P04Z1P0000060Premium Local Peak '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P04Z2N0000045Premium Natl Night '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P04Z2O0000070Premium Natl Off-Peak '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P04Z2P0000090Premium Natl Peak '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P04Z3N0000080Premium Reg Night '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P04Z3O0000110Premium Reg Off-Peak '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P04Z3P0000140Premium Reg Peak '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P04Z4N0000500Premium Intl Night '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P04Z4O0000750Premium Intl Off-Peak '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P04Z4P0001000Premium Intl Peak '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P05Z1N0000020Unlimited Local Night '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P05Z1O0000040Unlimited Local Off-Peak '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P05Z1P0000050Unlimited Local Peak '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P05Z2N0000030Unlimited Natl Night '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P05Z2O0000050Unlimited Natl Off-Peak '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P05Z2P0000070Unlimited Natl Peak '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P06Z1N0000018Student Local Night '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P06Z1O0000035Student Local Off-Peak '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P06Z1P0000050Student Local Peak '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P07Z1N0000015Family Local Night '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P07Z1O0000030Family Local Off-Peak '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P07Z1P0000045Family Local Peak '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P08Z1N0000012Senior Local Night '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P08Z1O0000025Senior Local Off-Peak '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P08Z1P0000040Senior Local Peak '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P09Z1N0000020Data Local Night '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P09Z1O0000035Data Local Off-Peak '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P09Z1P0000045Data Local Peak '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P10Z4N0000300Roaming Intl Night '.
|
|
05 FILLER PIC X(43) VALUE
|
|
'P10Z4O0000500Roaming Intl Off-Peak '.
|
|
*>
|
|
01 WS-MULTI-TABLE REDEFINES WS-MULTI-DATA.
|
|
05 WS-ME OCCURS 50 TIMES
|
|
ASCENDING KEY IS WS-ME-PLAN WS-ME-ZONE WS-ME-TOD
|
|
INDEXED BY WS-ME-IDX.
|
|
10 WS-ME-PLAN PIC X(03).
|
|
10 WS-ME-ZONE PIC X(02).
|
|
10 WS-ME-TOD PIC X(01).
|
|
10 WS-ME-RATE PIC 9(05)V9(02).
|
|
10 WS-ME-DESC PIC X(30).
|
|
*> Multi-key search variables
|
|
01 WS-MULTI-SEARCH.
|
|
05 WS-MS-PLAN PIC X(03).
|
|
05 WS-MS-ZONE PIC X(02).
|
|
05 WS-MS-TOD PIC X(01).
|
|
05 WS-MS-RATE PIC 9(05)V9(02).
|
|
05 WS-MS-FOUND PIC X(01).
|
|
88 WS-MS-FOUND-YES VALUE 'Y' FALSE 'N'.
|
|
05 WS-MS-DEFAULT PIC X(01).
|
|
88 WS-MS-DEFAULT-YES VALUE 'Y' FALSE 'N'.
|
|
*> Default rate (5.00 per unit when tariff not found)
|
|
01 WS-DEFAULT-RATE PIC 9(05)V9(02) VALUE 0050000.
|
|
*> Table loading state
|
|
01 WS-TABLE-LOADED PIC X(01) VALUE 'N'.
|
|
88 WS-TABLE-LOADED-YES VALUE 'Y' FALSE 'N'.
|
|
01 WS-TARIFF-ENTRIES PIC 9(02) VALUE ZERO.
|
|
*> Sequential fallback control
|
|
01 WS-SEQ-FALLBACK PIC X(01) VALUE 'N'.
|
|
88 WS-SEQ-FALLBACK-YES VALUE 'Y' FALSE 'N'.
|
|
01 WS-FALLBACK-COUNT PIC 9(02) VALUE ZERO.
|
|
*> Table statistics for reporting
|
|
01 WS-STATS.
|
|
05 WS-STAT-MIN-RATE PIC 9(05)V9(02) VALUE 99999.99.
|
|
05 WS-STAT-MAX-RATE PIC 9(05)V9(02) VALUE ZERO.
|
|
05 WS-STAT-LOOKUP PIC 9(05) VALUE ZERO.
|
|
05 WS-STAT-HIT PIC 9(05) VALUE ZERO.
|
|
05 WS-STAT-MISS PIC 9(05) VALUE ZERO.
|
|
01 WS-STAT-HIT-RATE-DISP PIC Z(02)9.99.
|
|
*> Hash total for audit
|
|
01 WS-HASH-TOTAL PIC 9(09) VALUE ZERO.
|
|
01 WS-HASH-MOD PIC 9(09).
|
|
*> Output formatting fields
|
|
01 WS-OUT-LINE PIC X(80).
|
|
01 WS-OUT-RATE-DISP PIC Z(04)9.99.
|
|
01 WS-WS-IDX-50 PIC 9(02).
|
|
01 WS-J PIC 9(02).
|
|
*>
|
|
PROCEDURE DIVISION.
|
|
*>
|
|
MAIN SECTION.
|
|
MB-PROCESS.
|
|
PERFORM 1000-INIT THRU 1000-EXIT.
|
|
PERFORM 2000-OPEN-FILES THRU 2000-EXIT.
|
|
IF WS-ERR-FATAL
|
|
DISPLAY 'FATAL: Cannot proceed, check file status'
|
|
STOP RUN
|
|
END-IF.
|
|
*>
|
|
PERFORM UNTIL WS-EOF-YES
|
|
READ FILE-IN
|
|
AT END
|
|
SET WS-EOF-YES TO TRUE
|
|
NOT AT END
|
|
MOVE IN-KEY TO WS-SEARCH-KEY
|
|
MOVE IN-PLAN TO WS-MS-PLAN
|
|
MOVE IN-ZONE TO WS-MS-ZONE
|
|
MOVE IN-TOD TO WS-MS-TOD
|
|
PERFORM DO-SEARCH-ALL
|
|
PERFORM DO-SEARCH-SEQ
|
|
PERFORM DO-SEARCH-VAR
|
|
PERFORM DO-INDEX-BOUNDS
|
|
PERFORM 3100-VALIDATE THRU 3100-EXIT
|
|
PERFORM 3200-CALCULATE THRU 3200-EXIT
|
|
PERFORM 3300-FORMAT-OUTPUT THRU 3300-EXIT
|
|
PERFORM WRITE-RESULT
|
|
PERFORM 3400-WRITE-OUTPUT THRU 3400-EXIT
|
|
ADD 1 TO WS-REC-COUNT
|
|
END-READ
|
|
END-PERFORM.
|
|
*>
|
|
PERFORM 4000-REPORT THRU 4000-EXIT.
|
|
PERFORM 5000-AUDIT THRU 5000-EXIT.
|
|
PERFORM 6000-ERROR-HANDLE THRU 6000-EXIT.
|
|
PERFORM 9000-EXIT THRU 9000-EXIT.
|
|
STOP RUN.
|
|
*>
|
|
*> ============================================================
|
|
*> EXISTING PROCEDURES (KEPT UNCHANGED FROM ORIGINAL)
|
|
*> ============================================================
|
|
*> --- Populate telecom tariff table ---
|
|
INIT-TABLES.
|
|
*> Telecom tariff table (sorted ascending by key for SEARCH ALL)
|
|
MOVE 'T1' TO WS-ENTRY-KEY(1)
|
|
MOVE 'PLAN-BASIC 1500 ' TO WS-ENTRY-VALUE(1)
|
|
MOVE 'T2' TO WS-ENTRY-KEY(2)
|
|
MOVE 'PLAN-BUSINESS 1000 ' TO WS-ENTRY-VALUE(2)
|
|
MOVE 'T3' TO WS-ENTRY-KEY(3)
|
|
MOVE 'PLAN-UNLIMITED 2000' TO WS-ENTRY-VALUE(3)
|
|
MOVE 'T4' TO WS-ENTRY-KEY(4)
|
|
MOVE 'PLAN-STUDENT 0800 ' TO WS-ENTRY-VALUE(4)
|
|
MOVE 'T5' TO WS-ENTRY-KEY(5)
|
|
MOVE 'PLAN-FAMILY 2500 ' TO WS-ENTRY-VALUE(5)
|
|
MOVE 'T6' TO WS-ENTRY-KEY(6)
|
|
MOVE 'PLAN-SENIOR 0600 ' TO WS-ENTRY-VALUE(6)
|
|
MOVE 'T7' TO WS-ENTRY-KEY(7)
|
|
MOVE 'PLAN-ROAMING 3000 ' TO WS-ENTRY-VALUE(7)
|
|
MOVE 'T8' TO WS-ENTRY-KEY(8)
|
|
MOVE 'PLAN-DATA 1200 ' TO WS-ENTRY-VALUE(8)
|
|
MOVE 'T9' TO WS-ENTRY-KEY(9)
|
|
MOVE 'PLAN-VOICE 1800 ' TO WS-ENTRY-VALUE(9)
|
|
MOVE 'TA' TO WS-ENTRY-KEY(10)
|
|
MOVE 'PLAN-PREMIUM 3500 ' TO WS-ENTRY-VALUE(10).
|
|
*> Variable table: first 8 entries same as main tariff table
|
|
MOVE 8 TO WS-VAR-SIZE.
|
|
PERFORM VARYING WS-IDX-VAL FROM 1 BY 1
|
|
UNTIL WS-IDX-VAL > 8
|
|
MOVE WS-ENTRY-KEY(WS-IDX-VAL)
|
|
TO WS-VAR-KEY(WS-IDX-VAL)
|
|
MOVE WS-ENTRY-VALUE(WS-IDX-VAL)
|
|
TO WS-VAR-VALUE(WS-IDX-VAL)
|
|
END-PERFORM.
|
|
*>
|
|
*> --- SEARCH ALL: binary search on sorted table ---
|
|
DO-SEARCH-ALL.
|
|
MOVE 'N' TO WS-FOUND-ALL.
|
|
MOVE SPACES TO OUT-ALL-VAL.
|
|
SEARCH ALL WS-ENTRY
|
|
AT END
|
|
MOVE 'N' TO WS-FOUND-ALL
|
|
WHEN WS-ENTRY-KEY(WS-IDX) = WS-SEARCH-KEY
|
|
MOVE 'Y' TO WS-FOUND-ALL
|
|
MOVE WS-ENTRY-VALUE(WS-IDX) TO OUT-ALL-VAL
|
|
END-SEARCH.
|
|
MOVE WS-FOUND-ALL TO OUT-ALL-STAT.
|
|
*>
|
|
*> --- SEARCH: sequential search on same table ---
|
|
DO-SEARCH-SEQ.
|
|
MOVE 'N' TO WS-FOUND-SEQ.
|
|
MOVE SPACES TO OUT-SEQ-VAL.
|
|
SET WS-IDX TO 1.
|
|
SEARCH WS-ENTRY
|
|
AT END
|
|
MOVE 'N' TO WS-FOUND-SEQ
|
|
WHEN WS-ENTRY-KEY(WS-IDX) = WS-SEARCH-KEY
|
|
MOVE 'Y' TO WS-FOUND-SEQ
|
|
MOVE WS-ENTRY-VALUE(WS-IDX) TO OUT-SEQ-VAL
|
|
END-SEARCH.
|
|
MOVE WS-FOUND-SEQ TO OUT-SEQ-STAT.
|
|
*>
|
|
*> --- SEARCH ALL on variable-length (DEPENDING ON) table ---
|
|
DO-SEARCH-VAR.
|
|
MOVE 'N' TO WS-FOUND-VAR.
|
|
MOVE SPACES TO OUT-VAR-VAL.
|
|
SEARCH ALL WS-VAR-ENTRY
|
|
AT END
|
|
MOVE 'N' TO WS-FOUND-VAR
|
|
WHEN WS-VAR-KEY(WS-VAR-IDX) = WS-SEARCH-KEY
|
|
MOVE 'Y' TO WS-FOUND-VAR
|
|
MOVE WS-VAR-VALUE(WS-VAR-IDX) TO OUT-VAR-VAL
|
|
END-SEARCH.
|
|
MOVE WS-FOUND-VAR TO OUT-VAR-STAT.
|
|
*>
|
|
*> --- INDEXED BY bounds test ---
|
|
DO-INDEX-BOUNDS.
|
|
MOVE 'Y' TO WS-BOUNDS-OK.
|
|
*> Try to set index beyond table bounds
|
|
SET WS-IDX TO 15.
|
|
IF WS-IDX > 10
|
|
MOVE 'N' TO WS-BOUNDS-OK
|
|
DISPLAY 'INDEX BOUNDS: Index 15 > 10 detected'
|
|
END-IF.
|
|
*> Restore to valid index
|
|
SET WS-IDX TO 1.
|
|
*>
|
|
*> --- Write one result record ---
|
|
WRITE-RESULT.
|
|
MOVE WS-SEARCH-KEY TO OUT-KEY.
|
|
WRITE OUT-REC.
|
|
ADD 1 TO WS-REC-COUNT.
|
|
*>
|
|
*> ============================================================
|
|
*> SECTION 1000: INITIALIZATION
|
|
*> ============================================================
|
|
1000-INIT SECTION.
|
|
1000-ENTRY.
|
|
*> Build timestamp
|
|
MOVE FUNCTION CURRENT-DATE (1:8) TO WS-TS-DATE.
|
|
MOVE FUNCTION CURRENT-DATE (9:8) TO WS-TS-TIME.
|
|
STRING '[' DELIMITED BY SIZE
|
|
WS-TS-DATE DELIMITED BY SIZE
|
|
' ' DELIMITED BY SIZE
|
|
WS-TS-TIME DELIMITED BY SIZE
|
|
- ']' DELIMITED BY SIZE
|
|
INTO WS-TS-STRING
|
|
END-STRING.
|
|
DISPLAY WS-TS-STRING ' TableSearch: Starting initialization'.
|
|
*> Call existing init for 10-entry table
|
|
PERFORM INIT-TABLES.
|
|
DISPLAY WS-TS-STRING ' INIT-TABLES: 10-entry initialized'.
|
|
*> Initialize error handling
|
|
MOVE 'I' TO WS-ERROR-SEVERITY.
|
|
MOVE ZERO TO WS-ERROR-COUNT.
|
|
MOVE ZERO TO WS-WARN-COUNT.
|
|
*> Try to load tariff from file; fall back to built-in
|
|
MOVE 'N' TO WS-TABLE-LOADED.
|
|
PERFORM 1500-LOAD-TARIFF THRU 1500-EXIT.
|
|
IF NOT WS-TABLE-LOADED-YES
|
|
DISPLAY WS-TS-STRING
|
|
' 1600-INIT-MULTI: Using built-in tariff table'
|
|
ELSE
|
|
DISPLAY WS-TS-STRING
|
|
' TARIFF: Loaded ' WS-TARIFF-ENTRIES
|
|
' entries from tariff.dat'.
|
|
PERFORM BUILD-TIMESTAMP.
|
|
DISPLAY WS-TS-STRING ' INIT complete, ready to process'.
|
|
1000-EXIT.
|
|
EXIT.
|
|
*>
|
|
*> --- [1500] Load tariff table from file ---
|
|
1500-LOAD-TARIFF SECTION.
|
|
1500-ENTRY.
|
|
OPEN INPUT TARIFF-IN.
|
|
IF WS-TARIFF-STATUS NOT = '00'
|
|
MOVE 'W' TO WS-ERROR-SEVERITY
|
|
MOVE '1500-LOAD-TARIFF' TO WS-PROCEDURE-NAME
|
|
STRING 'Cannot open tariff.dat, status='
|
|
WS-TARIFF-STATUS
|
|
', using built-in table'
|
|
INTO WS-ERROR-MSG
|
|
END-STRING
|
|
PERFORM 6100-LOG-ERROR THRU 6100-EXIT
|
|
GO TO 1500-EXIT
|
|
END-IF.
|
|
DISPLAY WS-TS-STRING
|
|
' TARIFF: tariff.dat opened, loading entries'.
|
|
MOVE 'Y' TO WS-TABLE-LOADED.
|
|
MOVE ZERO TO WS-WS-IDX-50.
|
|
PERFORM UNTIL WS-WS-IDX-50 >= 50
|
|
READ TARIFF-IN
|
|
AT END
|
|
EXIT PERFORM
|
|
NOT AT END
|
|
ADD 1 TO WS-WS-IDX-50
|
|
MOVE TR-PLAN TO WS-ME-PLAN(WS-WS-IDX-50)
|
|
MOVE TR-ZONE TO WS-ME-ZONE(WS-WS-IDX-50)
|
|
MOVE TR-TOD TO WS-ME-TOD(WS-WS-IDX-50)
|
|
MOVE TR-RATE TO WS-ME-RATE(WS-WS-IDX-50)
|
|
MOVE TR-DESC TO WS-ME-DESC(WS-WS-IDX-50)
|
|
END-READ
|
|
END-PERFORM.
|
|
MOVE WS-WS-IDX-50 TO WS-TARIFF-ENTRIES.
|
|
CLOSE TARIFF-IN.
|
|
IF WS-TARIFF-STATUS NOT = '00'
|
|
MOVE 'W' TO WS-ERROR-SEVERITY
|
|
MOVE '1500-LOAD-TARIFF' TO WS-PROCEDURE-NAME
|
|
STRING 'TARIFF-IN close status=' WS-TARIFF-STATUS
|
|
INTO WS-ERROR-MSG
|
|
END-STRING
|
|
PERFORM 6100-LOG-ERROR THRU 6100-EXIT
|
|
END-IF.
|
|
1500-EXIT.
|
|
EXIT.
|
|
*>
|
|
*> --- Build timestamp helper ---
|
|
BUILD-TIMESTAMP.
|
|
MOVE FUNCTION CURRENT-DATE (1:8) TO WS-TS-DATE.
|
|
MOVE FUNCTION CURRENT-DATE (9:8) TO WS-TS-TIME.
|
|
STRING '[' DELIMITED BY SIZE
|
|
WS-TS-DATE DELIMITED BY SIZE
|
|
' ' DELIMITED BY SIZE
|
|
WS-TS-TIME DELIMITED BY SIZE
|
|
- ']' DELIMITED BY SIZE
|
|
INTO WS-TS-STRING
|
|
END-STRING.
|
|
*>
|
|
*> ============================================================
|
|
*> SECTION 2000: OPEN FILES
|
|
*> ============================================================
|
|
2000-OPEN-FILES SECTION.
|
|
2000-ENTRY.
|
|
PERFORM BUILD-TIMESTAMP.
|
|
*> Open FILE-IN (original code preserved)
|
|
OPEN INPUT FILE-IN.
|
|
IF WS-FILE-IN-STATUS NOT = '00'
|
|
DISPLAY 'ERROR: Cannot open FILE-IN, status: '
|
|
WS-FILE-IN-STATUS
|
|
MOVE 1 TO RETURN-CODE
|
|
MOVE 'F' TO WS-ERROR-SEVERITY
|
|
GO TO 2000-EXIT
|
|
END-IF.
|
|
DISPLAY WS-TS-STRING ' OPEN: FILE-IN status=00 OK'.
|
|
*> Open FILE-OUT (original code preserved)
|
|
OPEN OUTPUT FILE-OUT.
|
|
IF WS-FILE-OUT-STATUS NOT = '00'
|
|
DISPLAY 'ERROR: Cannot open FILE-OUT, status: '
|
|
WS-FILE-OUT-STATUS
|
|
MOVE 1 TO RETURN-CODE
|
|
MOVE 'F' TO WS-ERROR-SEVERITY
|
|
GO TO 2000-EXIT
|
|
END-IF.
|
|
DISPLAY WS-TS-STRING ' OPEN: FILE-OUT status=00 OK'.
|
|
*> Open REPORT-OUT (new extended output)
|
|
OPEN OUTPUT REPORT-OUT.
|
|
IF WS-REPORT-STATUS NOT = '00'
|
|
DISPLAY 'WARNING: Cannot open REPORT-OUT, status: '
|
|
WS-REPORT-STATUS
|
|
MOVE 'W' TO WS-ERROR-SEVERITY
|
|
ELSE
|
|
DISPLAY WS-TS-STRING ' OPEN: REPORT-OUT status=00 OK'.
|
|
2000-EXIT.
|
|
EXIT.
|
|
*>
|
|
*> ============================================================
|
|
*> SECTION 3100: VALIDATE
|
|
*> ============================================================
|
|
3100-VALIDATE SECTION.
|
|
3100-ENTRY.
|
|
*> Validate IN-PLAN, IN-ZONE, IN-TOD for new-format records
|
|
IF IN-PLAN = SPACES AND IN-ZONE = SPACES AND IN-TOD = SPACES
|
|
*> Old-format record (2-byte key only) -- not an error
|
|
MOVE 'I' TO WS-ERROR-SEVERITY
|
|
MOVE '3100-VALIDATE' TO WS-PROCEDURE-NAME
|
|
STRING 'Old-format record, key=' IN-KEY
|
|
INTO WS-ERROR-MSG
|
|
END-STRING
|
|
PERFORM 6100-LOG-ERROR THRU 6100-EXIT
|
|
GO TO 3100-EXIT
|
|
END-IF.
|
|
*> Validate plan code
|
|
IF IN-PLAN NOT = 'P01' AND IN-PLAN NOT = 'P02'
|
|
AND IN-PLAN NOT = 'P03' AND IN-PLAN NOT = 'P04'
|
|
AND IN-PLAN NOT = 'P05' AND IN-PLAN NOT = 'P06'
|
|
AND IN-PLAN NOT = 'P07' AND IN-PLAN NOT = 'P08'
|
|
AND IN-PLAN NOT = 'P09' AND IN-PLAN NOT = 'P10'
|
|
MOVE 'W' TO WS-ERROR-SEVERITY
|
|
MOVE '3100-VALIDATE' TO WS-PROCEDURE-NAME
|
|
STRING 'Invalid PLAN: ' IN-PLAN
|
|
INTO WS-ERROR-MSG
|
|
END-STRING
|
|
PERFORM 6100-LOG-ERROR THRU 6100-EXIT
|
|
END-IF.
|
|
*> Validate zone code
|
|
IF IN-ZONE NOT = 'Z1' AND IN-ZONE NOT = 'Z2'
|
|
AND IN-ZONE NOT = 'Z3' AND IN-ZONE NOT = 'Z4'
|
|
AND IN-ZONE NOT = 'Z5'
|
|
MOVE 'W' TO WS-ERROR-SEVERITY
|
|
MOVE '3100-VALIDATE' TO WS-PROCEDURE-NAME
|
|
STRING 'Invalid ZONE: ' IN-ZONE
|
|
INTO WS-ERROR-MSG
|
|
END-STRING
|
|
PERFORM 6100-LOG-ERROR THRU 6100-EXIT
|
|
END-IF.
|
|
*> Validate time-of-day
|
|
IF IN-TOD NOT = 'N' AND IN-TOD NOT = 'O'
|
|
AND IN-TOD NOT = 'P'
|
|
MOVE 'W' TO WS-ERROR-SEVERITY
|
|
MOVE '3100-VALIDATE' TO WS-PROCEDURE-NAME
|
|
STRING 'Invalid TOD: ' IN-TOD
|
|
INTO WS-ERROR-MSG
|
|
END-STRING
|
|
PERFORM 6100-LOG-ERROR THRU 6100-EXIT
|
|
END-IF.
|
|
3100-EXIT.
|
|
EXIT.
|
|
*>
|
|
*> ============================================================
|
|
*> SECTION 3200: CALCULATE (Multi-key SEARCH ALL + fallback)
|
|
*> ============================================================
|
|
3200-CALCULATE SECTION.
|
|
3200-ENTRY.
|
|
MOVE 'N' TO WS-MS-FOUND.
|
|
MOVE 'N' TO WS-MS-DEFAULT.
|
|
MOVE ZERO TO WS-MS-RATE.
|
|
*> Skip multi-key search if input is old-format (spaces)
|
|
IF IN-PLAN = SPACES AND IN-ZONE = SPACES
|
|
AND IN-TOD = SPACES
|
|
MOVE WS-DEFAULT-RATE TO WS-MS-RATE
|
|
MOVE 'Y' TO WS-MS-DEFAULT
|
|
GO TO 3200-EXIT
|
|
END-IF.
|
|
*> SEARCH ALL on multi-key tariff table (primary search)
|
|
SEARCH ALL WS-ME
|
|
AT END
|
|
MOVE 'N' TO WS-MS-FOUND
|
|
WHEN WS-ME-PLAN(WS-ME-IDX) = WS-MS-PLAN
|
|
AND WS-ME-ZONE(WS-ME-IDX) = WS-MS-ZONE
|
|
AND WS-ME-TOD(WS-ME-IDX) = WS-MS-TOD
|
|
MOVE 'Y' TO WS-MS-FOUND
|
|
MOVE WS-ME-RATE(WS-ME-IDX) TO WS-MS-RATE
|
|
END-SEARCH.
|
|
*> If SEARCH ALL fails, try sequential fallback
|
|
IF NOT WS-MS-FOUND-YES
|
|
MOVE 'Y' TO WS-SEQ-FALLBACK
|
|
ADD 1 TO WS-FALLBACK-COUNT
|
|
SET WS-ME-IDX TO 1
|
|
SEARCH WS-ME
|
|
AT END
|
|
CONTINUE
|
|
WHEN WS-ME-PLAN(WS-ME-IDX) = WS-MS-PLAN
|
|
AND WS-ME-ZONE(WS-ME-IDX) = WS-MS-ZONE
|
|
AND WS-ME-TOD(WS-ME-IDX) = WS-MS-TOD
|
|
MOVE 'Y' TO WS-MS-FOUND
|
|
MOVE WS-ME-RATE(WS-ME-IDX) TO WS-MS-RATE
|
|
END-SEARCH
|
|
MOVE 'N' TO WS-SEQ-FALLBACK
|
|
END-IF.
|
|
*> NOT-FOUND: apply default rate
|
|
IF NOT WS-MS-FOUND-YES
|
|
MOVE WS-DEFAULT-RATE TO WS-MS-RATE
|
|
MOVE 'Y' TO WS-MS-DEFAULT
|
|
MOVE '3100-VALIDATE' TO WS-PROCEDURE-NAME
|
|
STRING 'Default rate applied for ' WS-MS-PLAN
|
|
' ' WS-MS-ZONE ' ' WS-MS-TOD
|
|
INTO WS-ERROR-MSG
|
|
END-STRING
|
|
MOVE 'W' TO WS-ERROR-SEVERITY
|
|
PERFORM 6100-LOG-ERROR THRU 6100-EXIT
|
|
END-IF.
|
|
*> Update statistics
|
|
ADD 1 TO WS-STAT-LOOKUP.
|
|
IF WS-MS-FOUND-YES
|
|
ADD 1 TO WS-STAT-HIT
|
|
IF WS-MS-RATE < WS-STAT-MIN-RATE
|
|
MOVE WS-MS-RATE TO WS-STAT-MIN-RATE
|
|
END-IF
|
|
IF WS-MS-RATE > WS-STAT-MAX-RATE
|
|
MOVE WS-MS-RATE TO WS-STAT-MAX-RATE
|
|
END-IF
|
|
ELSE
|
|
ADD 1 TO WS-STAT-MISS
|
|
END-IF.
|
|
*> Update hash total
|
|
COMPUTE WS-HASH-MOD = FUNCTION MOD(
|
|
WS-HASH-TOTAL + WS-MS-RATE, 999999999).
|
|
MOVE WS-HASH-MOD TO WS-HASH-TOTAL.
|
|
3200-EXIT.
|
|
EXIT.
|
|
*>
|
|
*> ============================================================
|
|
*> SECTION 3300: FORMAT OUTPUT
|
|
*> ============================================================
|
|
3300-FORMAT-OUTPUT SECTION.
|
|
3300-ENTRY.
|
|
*> Format multi-key search result line
|
|
MOVE WS-MS-RATE TO WS-OUT-RATE-DISP.
|
|
STRING
|
|
'R=' WS-SEARCH-KEY
|
|
' P=' WS-MS-PLAN
|
|
' Z=' WS-MS-ZONE
|
|
' T=' WS-MS-TOD
|
|
' RATE=' WS-OUT-RATE-DISP
|
|
' F=' WS-MS-FOUND
|
|
' D=' WS-MS-DEFAULT
|
|
INTO WS-OUT-LINE
|
|
END-STRING.
|
|
3300-EXIT.
|
|
EXIT.
|
|
*>
|
|
*> ============================================================
|
|
*> SECTION 3400: WRITE OUTPUT
|
|
*> ============================================================
|
|
3400-WRITE-OUTPUT SECTION.
|
|
3400-ENTRY.
|
|
IF WS-REPORT-STATUS = '00' OR WS-REPORT-STATUS = SPACES
|
|
MOVE WS-OUT-LINE TO REPORT-REC
|
|
WRITE REPORT-REC
|
|
IF WS-REPORT-STATUS NOT = '00'
|
|
MOVE 'E' TO WS-ERROR-SEVERITY
|
|
MOVE '3400-WRITE-OUTPUT' TO WS-PROCEDURE-NAME
|
|
STRING 'REPORT-OUT write failed, status='
|
|
WS-REPORT-STATUS
|
|
INTO WS-ERROR-MSG
|
|
END-STRING
|
|
PERFORM 6100-LOG-ERROR THRU 6100-EXIT
|
|
END-IF
|
|
END-IF.
|
|
3400-EXIT.
|
|
EXIT.
|
|
*>
|
|
*> ============================================================
|
|
*> SECTION 4000: REPORT
|
|
*> ============================================================
|
|
4000-REPORT SECTION.
|
|
4000-ENTRY.
|
|
PERFORM BUILD-TIMESTAMP.
|
|
DISPLAY WS-TS-STRING ' 4000-REPORT: Generating report'.
|
|
*> Calculate hit rate
|
|
IF WS-STAT-LOOKUP > ZERO
|
|
COMPUTE WS-STAT-HIT-RATE-DISP ROUNDED =
|
|
(WS-STAT-HIT / WS-STAT-LOOKUP) * 100
|
|
ELSE
|
|
MOVE ZERO TO WS-STAT-HIT-RATE-DISP
|
|
END-IF.
|
|
*> Write report header
|
|
MOVE SPACES TO REPORT-REC.
|
|
MOVE '=== TableSearch Extended Report ===' TO REPORT-REC.
|
|
WRITE REPORT-REC.
|
|
IF WS-REPORT-STATUS NOT = '00'
|
|
MOVE 'E' TO WS-ERROR-SEVERITY
|
|
MOVE '4000-REPORT' TO WS-PROCEDURE-NAME
|
|
STRING 'REPORT-OUT write failed, status='
|
|
WS-REPORT-STATUS
|
|
INTO WS-ERROR-MSG
|
|
END-STRING
|
|
PERFORM 6100-LOG-ERROR THRU 6100-EXIT
|
|
END-IF.
|
|
*> Write statistics
|
|
MOVE SPACES TO REPORT-REC.
|
|
STRING 'Records processed: ' WS-REC-COUNT
|
|
INTO REPORT-REC
|
|
END-STRING.
|
|
WRITE REPORT-REC.
|
|
*>
|
|
MOVE WS-STAT-MIN-RATE TO WS-OUT-RATE-DISP.
|
|
MOVE SPACES TO REPORT-REC.
|
|
STRING 'Min rate: ' WS-OUT-RATE-DISP
|
|
INTO REPORT-REC
|
|
END-STRING.
|
|
WRITE REPORT-REC.
|
|
*>
|
|
MOVE WS-STAT-MAX-RATE TO WS-OUT-RATE-DISP.
|
|
MOVE SPACES TO REPORT-REC.
|
|
STRING 'Max rate: ' WS-OUT-RATE-DISP
|
|
INTO REPORT-REC
|
|
END-STRING.
|
|
WRITE REPORT-REC.
|
|
*>
|
|
MOVE SPACES TO REPORT-REC.
|
|
STRING 'Lookups: ' WS-STAT-LOOKUP
|
|
' Hits: ' WS-STAT-HIT
|
|
' Misses: ' WS-STAT-MISS
|
|
INTO REPORT-REC
|
|
END-STRING.
|
|
WRITE REPORT-REC.
|
|
*>
|
|
MOVE SPACES TO REPORT-REC.
|
|
STRING 'Hit rate: ' WS-STAT-HIT-RATE-DISP '%'
|
|
INTO REPORT-REC
|
|
END-STRING.
|
|
WRITE REPORT-REC.
|
|
*>
|
|
MOVE SPACES TO REPORT-REC.
|
|
STRING 'Hash total: ' WS-HASH-TOTAL
|
|
INTO REPORT-REC
|
|
END-STRING.
|
|
WRITE REPORT-REC.
|
|
*>
|
|
MOVE SPACES TO REPORT-REC.
|
|
STRING 'Fallback count: ' WS-FALLBACK-COUNT
|
|
INTO REPORT-REC
|
|
END-STRING.
|
|
WRITE REPORT-REC.
|
|
*>
|
|
MOVE SPACES TO REPORT-REC.
|
|
STRING 'Errors: ' WS-ERROR-COUNT
|
|
' Warnings: ' WS-WARN-COUNT
|
|
INTO REPORT-REC
|
|
END-STRING.
|
|
WRITE REPORT-REC.
|
|
*>
|
|
MOVE SPACES TO REPORT-REC.
|
|
MOVE ZERO TO WS-OUT-RATE-DISP.
|
|
STRING 'Default rate: '
|
|
INTO REPORT-REC
|
|
END-STRING.
|
|
MOVE WS-DEFAULT-RATE TO WS-OUT-RATE-DISP.
|
|
STRING 'Default rate: ' WS-OUT-RATE-DISP
|
|
INTO REPORT-REC
|
|
END-STRING.
|
|
WRITE REPORT-REC.
|
|
*>
|
|
MOVE '=== End of Report ===' TO REPORT-REC.
|
|
WRITE REPORT-REC.
|
|
4000-EXIT.
|
|
EXIT.
|
|
*>
|
|
*> ============================================================
|
|
*> SECTION 5000: AUDIT
|
|
*> ============================================================
|
|
5000-AUDIT SECTION.
|
|
5000-ENTRY.
|
|
PERFORM BUILD-TIMESTAMP.
|
|
DISPLAY WS-TS-STRING ' 5000-AUDIT: Audit trail'.
|
|
DISPLAY WS-TS-STRING
|
|
' AUDIT: records=' WS-REC-COUNT
|
|
' lookups=' WS-STAT-LOOKUP
|
|
' hits=' WS-STAT-HIT.
|
|
DISPLAY WS-TS-STRING
|
|
' AUDIT: hash-total=' WS-HASH-TOTAL
|
|
' fallbacks=' WS-FALLBACK-COUNT.
|
|
DISPLAY WS-TS-STRING
|
|
' AUDIT: errors=' WS-ERROR-COUNT
|
|
' warnings=' WS-WARN-COUNT.
|
|
5000-EXIT.
|
|
EXIT.
|
|
*>
|
|
*> ============================================================
|
|
*> SECTION 6000: ERROR HANDLE
|
|
*> ============================================================
|
|
6000-ERROR-HANDLE SECTION.
|
|
6000-ENTRY.
|
|
PERFORM BUILD-TIMESTAMP.
|
|
DISPLAY WS-TS-STRING ' 6000-ERROR-HANDLE: Summary'.
|
|
IF WS-ERROR-COUNT > 0
|
|
DISPLAY WS-TS-STRING
|
|
' ERRORS: Total errors=' WS-ERROR-COUNT
|
|
END-IF.
|
|
IF WS-WARN-COUNT > 0
|
|
DISPLAY WS-TS-STRING
|
|
' WARNINGS: Total warnings=' WS-WARN-COUNT
|
|
END-IF.
|
|
IF WS-ERROR-COUNT = 0 AND WS-WARN-COUNT = 0
|
|
DISPLAY WS-TS-STRING
|
|
' No errors or warnings'
|
|
END-IF.
|
|
6000-EXIT.
|
|
EXIT.
|
|
*>
|
|
*> ============================================================
|
|
*> SECTION 6100: LOG ERROR
|
|
*> ============================================================
|
|
6100-LOG-ERROR SECTION.
|
|
6100-ENTRY.
|
|
IF WS-ERR-ERROR OR WS-ERR-FATAL
|
|
ADD 1 TO WS-ERROR-COUNT
|
|
END-IF.
|
|
IF WS-ERR-WARNING
|
|
ADD 1 TO WS-WARN-COUNT
|
|
END-IF.
|
|
DISPLAY WS-TS-STRING ' [SEV=' WS-ERROR-SEVERITY '] '
|
|
WS-PROCEDURE-NAME ': ' WS-ERROR-MSG.
|
|
6100-EXIT.
|
|
EXIT.
|
|
*>
|
|
*> ============================================================
|
|
*> SECTION 9000: EXIT
|
|
*> ============================================================
|
|
9000-EXIT SECTION.
|
|
9000-ENTRY.
|
|
PERFORM BUILD-TIMESTAMP.
|
|
*> Close FILE-IN
|
|
CLOSE FILE-IN.
|
|
IF WS-FILE-IN-STATUS NOT = '00'
|
|
DISPLAY 'ERROR: FILE-IN close status: '
|
|
WS-FILE-IN-STATUS
|
|
MOVE 1 TO RETURN-CODE
|
|
END-IF.
|
|
*> Close FILE-OUT
|
|
CLOSE FILE-OUT.
|
|
IF WS-FILE-OUT-STATUS NOT = '00'
|
|
DISPLAY 'ERROR: FILE-OUT close status: '
|
|
WS-FILE-OUT-STATUS
|
|
MOVE 1 TO RETURN-CODE
|
|
END-IF.
|
|
*> Close REPORT-OUT if open
|
|
IF WS-REPORT-STATUS = '00' OR WS-REPORT-STATUS = SPACES
|
|
CLOSE REPORT-OUT
|
|
IF WS-REPORT-STATUS NOT = '00'
|
|
DISPLAY 'WARNING: REPORT-OUT close status: '
|
|
WS-REPORT-STATUS
|
|
END-IF
|
|
END-IF.
|
|
*> Existing final display (preserved)
|
|
DISPLAY 'TableSearch: Completed. Records processed: '
|
|
WS-REC-COUNT.
|
|
*> Exit with error code if errors occurred
|
|
IF WS-ERROR-COUNT > 0
|
|
MOVE 1 TO RETURN-CODE
|
|
END-IF.
|
|
9000-EXIT-END.
|
|
EXIT.
|
|
*>
|
|
END PROGRAM TableSearch.
|