NB-076
806 lines
30 KiB
COBOL
806 lines
30 KiB
COBOL
*> ============================================================
|
|
*> 04-edit-getput : 请求书编辑输出 (Invoice GETPUT)
|
|
*> Input : file-in.dat (客户/用量记录)
|
|
*> Output: file-out.dat (格式化的请求书输出)
|
|
*> file-out-detail.dat (详细格式)
|
|
*> file-out-summary.dat (汇总格式)
|
|
*> audit-trail.dat (审计日志)
|
|
*> Coverage: COM-N001~N006
|
|
*> field editing, audit trail, hash totals
|
|
*> ============================================================
|
|
IDENTIFICATION DIVISION.
|
|
PROGRAM-ID. EditGetPut.
|
|
ENVIRONMENT DIVISION.
|
|
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.
|
|
*> Additional output files for telecom billing
|
|
SELECT FILE-OUT-DTL ASSIGN TO 'file-out-detail.dat'
|
|
ORGANIZATION IS SEQUENTIAL
|
|
FILE STATUS IS WS-FILE-DTL-STATUS.
|
|
SELECT FILE-OUT-SUM ASSIGN TO 'file-out-summary.dat'
|
|
ORGANIZATION IS SEQUENTIAL
|
|
FILE STATUS IS WS-FILE-SUM-STATUS.
|
|
SELECT FILE-OUT-AUDIT ASSIGN TO 'audit-trail.dat'
|
|
ORGANIZATION IS SEQUENTIAL
|
|
FILE STATUS IS WS-FILE-AUD-STATUS.
|
|
*>
|
|
DATA DIVISION.
|
|
FILE SECTION.
|
|
FD FILE-IN.
|
|
01 IN-REC.
|
|
05 IN-FIELD1 PIC X(10).
|
|
05 IN-FIELD2 PIC X(20).
|
|
05 IN-FIELD3 PIC 9(05).
|
|
*>
|
|
FD FILE-OUT.
|
|
01 OUT-REC.
|
|
05 OUT-FIELD1 PIC X(10).
|
|
05 OUT-FIELD2 PIC X(20).
|
|
05 OUT-FIELD3 PIC 9(05).
|
|
*>
|
|
FD FILE-OUT-DTL.
|
|
01 OUT-DTL-REC PIC X(120).
|
|
*>
|
|
FD FILE-OUT-SUM.
|
|
01 OUT-SUM-REC PIC X(120).
|
|
*>
|
|
FD FILE-OUT-AUDIT.
|
|
01 OUT-AUDIT-REC PIC X(120).
|
|
*>
|
|
WORKING-STORAGE SECTION.
|
|
*> === PRESERVED ORIGINAL ITEMS ===
|
|
01 WS-TELECOM-REC.
|
|
COPY "telecom/TEL-INVOICE.cpy".
|
|
01 WS-FILE-IN-STATUS PIC X(02).
|
|
01 WS-FILE-OUT-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.
|
|
01 WS-INVOICE-REC.
|
|
COPY "telecom/TEL-INVOICE.cpy".
|
|
*> === NEW ITEMS ===
|
|
*> Timestamp for tracing
|
|
01 WS-TIMESTAMP.
|
|
05 WS-TS-YEAR PIC 9(04).
|
|
05 WS-TS-MONTH PIC 9(02).
|
|
05 WS-TS-DAY PIC 9(02).
|
|
05 WS-TS-HOUR PIC 9(02).
|
|
05 WS-TS-MINUTE PIC 9(02).
|
|
05 WS-TS-SECOND PIC 9(02).
|
|
05 WS-TS-MS PIC 9(02).
|
|
01 WS-TIMESTAMP-STR PIC X(26).
|
|
01 WS-TRACE-MSG PIC X(80).
|
|
*> Format control
|
|
01 WS-FORMAT-MODE PIC X(01) VALUE 'D'.
|
|
88 WS-FORMAT-SHORT VALUE 'S'.
|
|
88 WS-FORMAT-DETAIL VALUE 'D'.
|
|
88 WS-FORMAT-SUMMARY VALUE 'M'.
|
|
01 WS-CONDENSED-MODE PIC X(01) VALUE 'N'.
|
|
88 WS-CONDENSED-YES VALUE 'Y' FALSE 'N'.
|
|
01 WS-FMT-CONFIG PIC X(02) VALUE 'BH'.
|
|
88 WS-FMT-HEADER-ONLY VALUE 'H '.
|
|
88 WS-FMT-FOOTER-ONLY VALUE 'F '.
|
|
88 WS-FMT-BOTH VALUE 'BH'.
|
|
*> Page control
|
|
01 WS-PAGE-COUNT PIC 9(05) VALUE ZERO.
|
|
01 WS-LINE-COUNT PIC 9(03) VALUE ZERO.
|
|
01 WS-LINES-PER-PAGE PIC 9(03) VALUE 50.
|
|
01 WS-PAGE-MAX PIC 9(03) VALUE 55.
|
|
01 WS-PAGE-BREAK-NEEDED PIC X(01) VALUE 'N'.
|
|
88 WS-PAGE-BREAK VALUE 'Y' FALSE 'N'.
|
|
*> Heading lines
|
|
01 WS-HDG-1 PIC X(120).
|
|
01 WS-HDG-2 PIC X(120).
|
|
01 WS-HDG-3 PIC X(120).
|
|
01 WS-HDG-4 PIC X(120).
|
|
01 WS-HDG-5 PIC X(120).
|
|
*> Footing lines
|
|
01 WS-FTG-1 PIC X(120).
|
|
01 WS-FTG-2 PIC X(120).
|
|
*> Separator lines
|
|
01 WS-SEP-STARS PIC X(120) VALUE ALL '*'.
|
|
01 WS-SEP-DASHES PIC X(120) VALUE ALL '-'.
|
|
01 WS-SEP-EQUALS PIC X(120) VALUE ALL '='.
|
|
*> Detail and summary lines
|
|
01 WS-DETAIL-LINE PIC X(120).
|
|
01 WS-SUMMARY-LINE PIC X(120).
|
|
*> Telecom billing fields
|
|
01 WS-BILL-DATA.
|
|
05 WS-BD-CUST-ID PIC X(10).
|
|
05 WS-BD-CUST-NAME PIC X(30).
|
|
05 WS-BD-PLAN-CODE PIC X(02).
|
|
05 WS-BD-USAGE PIC 9(09).
|
|
05 WS-BD-BASE-FEE PIC 9(07).
|
|
05 WS-BD-USAGE-FEE PIC 9(07).
|
|
05 WS-BD-TAX PIC 9(07).
|
|
05 WS-BD-TOTAL PIC 9(09).
|
|
05 WS-BD-STATUS-DESC PIC X(15).
|
|
*> Edited numeric fields — various PIC patterns
|
|
01 WS-ED-AMOUNT PIC Z(9)9.
|
|
01 WS-ED-TOTAL PIC Z(11)9.
|
|
01 WS-ED-COUNT PIC Z(9)9.
|
|
01 WS-ED-PAGE PIC Z(9)9.
|
|
01 WS-ED-USAGE PIC Z(9)9.
|
|
01 WS-ED-FEE PIC Z(9)9.
|
|
01 WS-ED-TAX PIC Z(9)9.
|
|
*> Additional editing patterns per requirement
|
|
01 WS-ED-CHECK-PROT PIC *(8)9.
|
|
01 WS-ED-SIGNED PIC +Z(8)9.
|
|
01 WS-ED-CURRENCY PIC $$$$$$$$9.99.
|
|
01 WS-ED-BLANK-ZERO PIC Z(9)9 BLANK WHEN ZERO.
|
|
01 WS-ED-FLOAT-DOLLAR PIC $$$$,$$$,$$9.
|
|
*> Hash totals
|
|
01 WS-HASH-REC-COUNT PIC 9(09) VALUE ZERO.
|
|
01 WS-HASH-AMT PIC 9(15) VALUE ZERO.
|
|
01 WS-HASH-CHECKSUM PIC 9(15) VALUE ZERO.
|
|
01 WS-HASH-AMT-REM PIC 9(15).
|
|
*> Accumulators by invoice status
|
|
01 WS-ACC-STATUS-0 PIC 9(12) VALUE ZERO.
|
|
01 WS-ACC-STATUS-1 PIC 9(12) VALUE ZERO.
|
|
01 WS-ACC-STATUS-2 PIC 9(12) VALUE ZERO.
|
|
*> Error handling
|
|
01 WS-ERR-SEVERITY PIC 9(01).
|
|
88 WS-ERR-INFO VALUE 0.
|
|
88 WS-ERR-WARN VALUE 1.
|
|
88 WS-ERR-ERROR VALUE 2.
|
|
88 WS-ERR-FATAL VALUE 3.
|
|
01 WS-ERR-MSG PIC X(60).
|
|
01 WS-ERR-COUNT PIC 9(04) VALUE ZERO.
|
|
01 WS-WARN-COUNT PIC 9(04) VALUE ZERO.
|
|
*> Additional file statuses
|
|
01 WS-FILE-DTL-STATUS PIC X(02).
|
|
01 WS-FILE-SUM-STATUS PIC X(02).
|
|
01 WS-FILE-AUD-STATUS PIC X(02).
|
|
*> Audit fields
|
|
01 WS-AUDIT-ENTRIES PIC 9(04) VALUE ZERO.
|
|
01 WS-AUDIT-LINE PIC X(120).
|
|
*> Report date/time
|
|
01 WS-RPT-DATE PIC X(10).
|
|
01 WS-RPT-TIME PIC X(08).
|
|
*> Second-pass record counter
|
|
01 WS-PASS2-COUNT PIC 9(05) VALUE ZERO.
|
|
*> Configuration constants
|
|
01 WS-CONFIG-LPP PIC 9(03) VALUE 50.
|
|
01 WS-CONFIG-MAXERR PIC 9(04) VALUE 100.
|
|
*> Plan description table
|
|
01 WS-PLAN-TABLE.
|
|
05 FILLER PIC X(12) VALUE '01BASIC '.
|
|
05 FILLER PIC X(12) VALUE '02PREMIUM '.
|
|
05 FILLER PIC X(12) VALUE '03BUSINESS '.
|
|
05 FILLER PIC X(12) VALUE '04ENTERPRISE'.
|
|
05 FILLER PIC X(12) VALUE '99UNKNOWN '.
|
|
01 WS-PLAN-TAB-R REDEFINES WS-PLAN-TABLE.
|
|
05 WS-PLAN-ENT OCCURS 5 TIMES.
|
|
10 WS-PLAN-CODE PIC X(02).
|
|
10 WS-PLAN-DESC PIC X(10).
|
|
01 WS-PLAN-IDX PIC 9(01).
|
|
01 WS-PLAN-FOUND PIC X(01).
|
|
*> Record buffer for second pass
|
|
01 WS-BUFFER-IN.
|
|
05 WS-BUF-ID PIC X(10).
|
|
05 WS-BUF-CUST PIC X(10).
|
|
05 WS-BUF-DATA PIC X(10).
|
|
05 WS-BUF-AMOUNT PIC 9(05).
|
|
*> ============================================================
|
|
PROCEDURE DIVISION.
|
|
*>
|
|
MAIN SECTION.
|
|
MB-PROCESS.
|
|
*>
|
|
PERFORM 1000-INIT
|
|
PERFORM 3000-PROCESS
|
|
PERFORM 4000-REPORT
|
|
PERFORM 5000-AUDIT
|
|
PERFORM 6000-ERROR-HANDLE
|
|
PERFORM 9000-EXIT
|
|
STOP RUN.
|
|
*>
|
|
1000-INIT SECTION.
|
|
*>
|
|
DISPLAY 'EditGetPut: Initializing program...'.
|
|
MOVE FUNCTION CURRENT-DATE TO WS-TIMESTAMP.
|
|
STRING WS-TS-YEAR '-' WS-TS-MONTH '-'
|
|
WS-TS-DAY ' ' WS-TS-HOUR ':'
|
|
WS-TS-MINUTE ':' WS-TS-SECOND
|
|
INTO WS-TIMESTAMP-STR.
|
|
DISPLAY 'EditGetPut: Start time=' WS-TIMESTAMP-STR.
|
|
*>
|
|
MOVE WS-TS-YEAR TO WS-RPT-DATE(1:4).
|
|
MOVE '-' TO WS-RPT-DATE(5:1).
|
|
MOVE WS-TS-MONTH TO WS-RPT-DATE(6:2).
|
|
MOVE '-' TO WS-RPT-DATE(8:1).
|
|
MOVE WS-TS-DAY TO WS-RPT-DATE(9:2).
|
|
STRING WS-TS-HOUR ':' WS-TS-MINUTE ':'
|
|
WS-TS-SECOND INTO WS-RPT-TIME.
|
|
*>
|
|
MOVE SPACES TO WS-HDG-1 WS-HDG-2 WS-HDG-3
|
|
WS-HDG-4 WS-HDG-5.
|
|
MOVE SPACES TO WS-FTG-1 WS-FTG-2.
|
|
*>
|
|
MOVE ZERO TO WS-PAGE-COUNT WS-LINE-COUNT
|
|
WS-HASH-REC-COUNT WS-HASH-AMT
|
|
WS-HASH-CHECKSUM WS-ERR-COUNT
|
|
WS-WARN-COUNT WS-PASS2-COUNT
|
|
WS-ACC-STATUS-0 WS-ACC-STATUS-1
|
|
WS-ACC-STATUS-2 WS-AUDIT-ENTRIES.
|
|
*>
|
|
DISPLAY 'EditGetPut: INIT complete. Format=' WS-FORMAT-MODE
|
|
' LPP=' WS-CONFIG-LPP
|
|
' MaxErr=' WS-CONFIG-MAXERR.
|
|
*>
|
|
2000-OPEN-FILES SECTION.
|
|
*>
|
|
DISPLAY 'EditGetPut: Opening files...'.
|
|
*>
|
|
*> === PRESERVED ORIGINAL OPEN + STATUS CHECK ===
|
|
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
|
|
STOP RUN
|
|
END-IF.
|
|
*>
|
|
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
|
|
STOP RUN
|
|
END-IF.
|
|
*> === END PRESERVED ORIGINAL OPEN ===
|
|
*>
|
|
*> Additional output files
|
|
OPEN OUTPUT FILE-OUT-DTL.
|
|
IF WS-FILE-DTL-STATUS NOT = '00'
|
|
MOVE 1 TO WS-ERR-SEVERITY
|
|
STRING 'WARN: FILE-OUT-DTL open status='
|
|
WS-FILE-DTL-STATUS INTO WS-ERR-MSG
|
|
DISPLAY WS-ERR-MSG
|
|
ADD 1 TO WS-WARN-COUNT
|
|
END-IF.
|
|
*>
|
|
OPEN OUTPUT FILE-OUT-SUM.
|
|
IF WS-FILE-SUM-STATUS NOT = '00'
|
|
MOVE 1 TO WS-ERR-SEVERITY
|
|
STRING 'WARN: FILE-OUT-SUM open status='
|
|
WS-FILE-SUM-STATUS INTO WS-ERR-MSG
|
|
DISPLAY WS-ERR-MSG
|
|
ADD 1 TO WS-WARN-COUNT
|
|
END-IF.
|
|
*>
|
|
OPEN EXTEND FILE-OUT-AUDIT.
|
|
IF WS-FILE-AUD-STATUS NOT = '00'
|
|
OPEN OUTPUT FILE-OUT-AUDIT
|
|
IF WS-FILE-AUD-STATUS NOT = '00'
|
|
MOVE 1 TO WS-ERR-SEVERITY
|
|
STRING 'WARN: FILE-OUT-AUDIT open status='
|
|
WS-FILE-AUD-STATUS INTO WS-ERR-MSG
|
|
DISPLAY WS-ERR-MSG
|
|
ADD 1 TO WS-WARN-COUNT
|
|
END-IF
|
|
END-IF.
|
|
*>
|
|
DISPLAY 'EditGetPut: Files opened.'
|
|
' IN=' WS-FILE-IN-STATUS
|
|
' OUT=' WS-FILE-OUT-STATUS
|
|
' DTL=' WS-FILE-DTL-STATUS.
|
|
*>
|
|
3000-PROCESS SECTION.
|
|
*>
|
|
DISPLAY 'EditGetPut: PASS-1 — Original copy loop...'.
|
|
*>
|
|
*> ============================================================
|
|
*> === PRESERVED ORIGINAL PROCESSING LOOP (exact) ===
|
|
*> ============================================================
|
|
PERFORM UNTIL WS-EOF-YES
|
|
READ FILE-IN
|
|
AT END
|
|
SET WS-EOF-YES TO TRUE
|
|
NOT AT END
|
|
MOVE IN-REC TO OUT-REC
|
|
WRITE OUT-REC
|
|
ADD 1 TO WS-REC-COUNT
|
|
END-READ
|
|
END-PERFORM.
|
|
*> === END PRESERVED ORIGINAL LOOP ===
|
|
*>
|
|
DISPLAY 'EditGetPut: PASS-1 complete.'
|
|
' Records copied=' WS-REC-COUNT.
|
|
*>
|
|
*> Reopen FILE-IN for PASS-2 detailed processing.
|
|
*> Close FILE-IN first (original close moved to 9000-EXIT).
|
|
CLOSE FILE-IN.
|
|
IF WS-FILE-IN-STATUS NOT = '00'
|
|
MOVE 3 TO WS-ERR-SEVERITY
|
|
STRING 'ERROR: Close FILE-IN status='
|
|
WS-FILE-IN-STATUS INTO WS-ERR-MSG
|
|
DISPLAY WS-ERR-MSG
|
|
PERFORM 6000-ERROR-HANDLE
|
|
END-IF.
|
|
*>
|
|
MOVE 'N' TO WS-EOF.
|
|
OPEN INPUT FILE-IN.
|
|
IF WS-FILE-IN-STATUS NOT = '00'
|
|
MOVE 3 TO WS-ERR-SEVERITY
|
|
STRING 'ERROR: Reopen FILE-IN status='
|
|
WS-FILE-IN-STATUS INTO WS-ERR-MSG
|
|
DISPLAY WS-ERR-MSG
|
|
PERFORM 6000-ERROR-HANDLE
|
|
END-IF.
|
|
*>
|
|
DISPLAY 'EditGetPut: PASS-2 — Telecom billing detail...'.
|
|
*>
|
|
PERFORM UNTIL WS-EOF-YES
|
|
READ FILE-IN
|
|
AT END
|
|
SET WS-EOF-YES TO TRUE
|
|
NOT AT END
|
|
ADD 1 TO WS-PASS2-COUNT
|
|
PERFORM 3100-VALIDATE
|
|
PERFORM 3200-CALCULATE
|
|
PERFORM 3300-FORMAT-OUTPUT
|
|
PERFORM 3400-WRITE-OUTPUT
|
|
END-READ
|
|
END-PERFORM.
|
|
*>
|
|
CLOSE FILE-IN.
|
|
IF WS-FILE-IN-STATUS NOT = '00'
|
|
MOVE 2 TO WS-ERR-SEVERITY
|
|
STRING 'WARN: Close FILE-IN after PASS-2 status='
|
|
WS-FILE-IN-STATUS INTO WS-ERR-MSG
|
|
DISPLAY WS-ERR-MSG
|
|
ADD 1 TO WS-WARN-COUNT
|
|
END-IF.
|
|
*>
|
|
DISPLAY 'EditGetPut: PASS-2 complete.'
|
|
' Detail processed=' WS-PASS2-COUNT.
|
|
*>
|
|
3100-VALIDATE SECTION.
|
|
*>
|
|
*> Map 35-byte input fields to telecom invoice structure
|
|
MOVE IN-FIELD1 TO INV-ID OF WS-INVOICE-REC.
|
|
MOVE IN-FIELD2(1:10) TO INV-CUST-ID OF WS-INVOICE-REC.
|
|
MOVE IN-FIELD3 TO INV-AMOUNT OF WS-INVOICE-REC.
|
|
MOVE '1' TO INV-STATUS OF WS-INVOICE-REC.
|
|
*>
|
|
*> Validate invoice ID
|
|
IF INV-ID OF WS-INVOICE-REC = SPACES
|
|
MOVE 1 TO WS-ERR-SEVERITY
|
|
STRING 'WARN: Empty invoice ID at PASS-2 record '
|
|
WS-PASS2-COUNT INTO WS-ERR-MSG
|
|
DISPLAY WS-ERR-MSG
|
|
ADD 1 TO WS-ERR-COUNT
|
|
END-IF.
|
|
IF INV-ID OF WS-INVOICE-REC = LOW-VALUES
|
|
MOVE 1 TO WS-ERR-SEVERITY
|
|
STRING 'WARN: Low-values invoice ID at record '
|
|
WS-PASS2-COUNT INTO WS-ERR-MSG
|
|
DISPLAY WS-ERR-MSG
|
|
ADD 1 TO WS-ERR-COUNT
|
|
END-IF.
|
|
*>
|
|
*> Validate customer ID
|
|
IF INV-CUST-ID OF WS-INVOICE-REC = SPACES
|
|
MOVE 1 TO WS-ERR-SEVERITY
|
|
STRING 'WARN: Empty cust ID for '
|
|
INV-ID OF WS-INVOICE-REC INTO WS-ERR-MSG
|
|
DISPLAY WS-ERR-MSG
|
|
ADD 1 TO WS-WARN-COUNT
|
|
END-IF.
|
|
*>
|
|
*> Validate invoice amount
|
|
IF INV-AMOUNT OF WS-INVOICE-REC = ZERO
|
|
MOVE 1 TO WS-ERR-SEVERITY
|
|
STRING 'INFO: Zero amount invoice '
|
|
INV-ID OF WS-INVOICE-REC INTO WS-ERR-MSG
|
|
DISPLAY WS-ERR-MSG
|
|
ADD 1 TO WS-ERR-COUNT
|
|
END-IF.
|
|
IF INV-AMOUNT OF WS-INVOICE-REC > 999999999
|
|
MOVE 2 TO WS-ERR-SEVERITY
|
|
STRING 'WARN: Overlimit amount '
|
|
INV-ID OF WS-INVOICE-REC INTO WS-ERR-MSG
|
|
DISPLAY WS-ERR-MSG
|
|
ADD 1 TO WS-WARN-COUNT
|
|
END-IF.
|
|
*>
|
|
*> Validate reserved field content
|
|
IF INV-RESERVED OF WS-INVOICE-REC NOT = SPACES
|
|
MOVE 1 TO WS-ERR-SEVERITY
|
|
STRING 'INFO: Non-blank reserved at '
|
|
INV-ID OF WS-INVOICE-REC INTO WS-ERR-MSG
|
|
DISPLAY WS-ERR-MSG
|
|
END-IF.
|
|
*>
|
|
3200-CALCULATE SECTION.
|
|
*>
|
|
*> Accumulate hash totals
|
|
ADD 1 TO WS-HASH-REC-COUNT.
|
|
ADD INV-AMOUNT OF WS-INVOICE-REC TO WS-HASH-AMT.
|
|
COMPUTE WS-HASH-CHECKSUM =
|
|
WS-HASH-CHECKSUM + INV-AMOUNT OF WS-INVOICE-REC.
|
|
DIVIDE WS-HASH-CHECKSUM BY 1000000
|
|
GIVING WS-HASH-AMT-REM.
|
|
*>
|
|
*> Accumulate by invoice status
|
|
EVALUATE INV-STATUS OF WS-INVOICE-REC
|
|
WHEN '0'
|
|
ADD INV-AMOUNT OF WS-INVOICE-REC
|
|
TO WS-ACC-STATUS-0
|
|
WHEN '1'
|
|
ADD INV-AMOUNT OF WS-INVOICE-REC
|
|
TO WS-ACC-STATUS-1
|
|
WHEN '2'
|
|
ADD INV-AMOUNT OF WS-INVOICE-REC
|
|
TO WS-ACC-STATUS-2
|
|
WHEN OTHER
|
|
CONTINUE
|
|
END-EVALUATE.
|
|
*>
|
|
*> Telecom billing fee calculation
|
|
DIVIDE INV-AMOUNT OF WS-INVOICE-REC BY 100
|
|
GIVING WS-BD-TOTAL.
|
|
COMPUTE WS-BD-BASE-FEE = WS-BD-TOTAL * 60 / 100.
|
|
COMPUTE WS-BD-USAGE-FEE = WS-BD-TOTAL - WS-BD-BASE-FEE.
|
|
COMPUTE WS-BD-TAX = WS-BD-TOTAL * 10 / 100.
|
|
COMPUTE WS-BD-USAGE = WS-BD-TOTAL * 2.
|
|
*>
|
|
*> Look up plan code from invoice ID prefix
|
|
MOVE 'N' TO WS-PLAN-FOUND.
|
|
MOVE 1 TO WS-PLAN-IDX.
|
|
PERFORM VARYING WS-PLAN-IDX FROM 1 BY 1
|
|
UNTIL WS-PLAN-IDX > 5 OR WS-PLAN-FOUND = 'Y'
|
|
IF WS-PLAN-CODE(WS-PLAN-IDX)
|
|
= INV-ID OF WS-INVOICE-REC(1:2)
|
|
MOVE WS-PLAN-DESC(WS-PLAN-IDX)
|
|
TO WS-BD-PLAN-CODE
|
|
MOVE 'Y' TO WS-PLAN-FOUND
|
|
END-IF
|
|
END-PERFORM.
|
|
IF WS-PLAN-FOUND NOT = 'Y'
|
|
MOVE '99' TO WS-BD-PLAN-CODE
|
|
END-IF.
|
|
*>
|
|
*> Set status description
|
|
EVALUATE INV-STATUS OF WS-INVOICE-REC
|
|
WHEN '0' MOVE 'UNISSUED ' TO WS-BD-STATUS-DESC
|
|
WHEN '1' MOVE 'ISSUED ' TO WS-BD-STATUS-DESC
|
|
WHEN '2' MOVE 'PAID ' TO WS-BD-STATUS-DESC
|
|
WHEN OTHER MOVE 'UNKNOWN ' TO WS-BD-STATUS-DESC
|
|
END-EVALUATE.
|
|
*>
|
|
3300-FORMAT-OUTPUT SECTION.
|
|
*>
|
|
*> Edit numeric fields with various PIC patterns
|
|
MOVE INV-AMOUNT OF WS-INVOICE-REC TO WS-ED-AMOUNT.
|
|
MOVE WS-HASH-AMT TO WS-ED-TOTAL.
|
|
MOVE WS-HASH-REC-COUNT TO WS-ED-COUNT.
|
|
MOVE WS-BD-USAGE TO WS-ED-USAGE.
|
|
MOVE WS-BD-BASE-FEE TO WS-ED-FEE.
|
|
MOVE WS-BD-TAX TO WS-ED-TAX.
|
|
*> Additional editing patterns
|
|
MOVE INV-AMOUNT OF WS-INVOICE-REC TO WS-ED-CHECK-PROT.
|
|
MOVE INV-AMOUNT OF WS-INVOICE-REC TO WS-ED-SIGNED.
|
|
MOVE INV-AMOUNT OF WS-INVOICE-REC TO WS-ED-CURRENCY.
|
|
MOVE INV-AMOUNT OF WS-INVOICE-REC TO WS-ED-BLANK-ZERO.
|
|
MOVE INV-AMOUNT OF WS-INVOICE-REC TO WS-ED-FLOAT-DOLLAR.
|
|
*>
|
|
*> Build detail line (DETAIL format)
|
|
IF WS-FORMAT-DETAIL
|
|
STRING INV-ID OF WS-INVOICE-REC ' '
|
|
INV-CUST-ID OF WS-INVOICE-REC ' '
|
|
INV-MONTH OF WS-INVOICE-REC ' '
|
|
WS-ED-AMOUNT ' '
|
|
INV-STATUS OF WS-INVOICE-REC ' '
|
|
WS-BD-STATUS-DESC
|
|
DELIMITED BY SIZE INTO WS-DETAIL-LINE
|
|
PERFORM 3500-WRITE-DETAIL
|
|
END-IF.
|
|
*>
|
|
*> Build condensed line (SHORT or CONDENSED)
|
|
IF WS-FORMAT-SHORT
|
|
STRING INV-ID OF WS-INVOICE-REC ' '
|
|
WS-ED-AMOUNT ' '
|
|
INV-STATUS OF WS-INVOICE-REC
|
|
DELIMITED BY SIZE INTO WS-DETAIL-LINE
|
|
PERFORM 3500-WRITE-DETAIL
|
|
END-IF.
|
|
IF WS-CONDENSED-YES
|
|
STRING INV-ID OF WS-INVOICE-REC ' '
|
|
WS-ED-CHECK-PROT ' '
|
|
INV-STATUS OF WS-INVOICE-REC
|
|
DELIMITED BY SIZE INTO WS-DETAIL-LINE
|
|
PERFORM 3500-WRITE-DETAIL
|
|
END-IF.
|
|
*>
|
|
*> Accumulate for summary (SUMMARY mode)
|
|
IF WS-FORMAT-SUMMARY
|
|
CONTINUE
|
|
END-IF.
|
|
*>
|
|
*> Trace formatted output with timestamp
|
|
STRING WS-TS-HOUR ':' WS-TS-MINUTE ':'
|
|
WS-TS-SECOND ' FMT '
|
|
INV-ID OF WS-INVOICE-REC
|
|
INTO WS-TRACE-MSG.
|
|
DISPLAY WS-TRACE-MSG.
|
|
*>
|
|
3400-WRITE-OUTPUT SECTION.
|
|
*>
|
|
*> Write to primary output file if detail mode
|
|
IF WS-FORMAT-DETAIL
|
|
MOVE IN-REC TO OUT-REC
|
|
WRITE OUT-REC
|
|
IF WS-FILE-OUT-STATUS NOT = '00'
|
|
MOVE 2 TO WS-ERR-SEVERITY
|
|
STRING 'ERROR: OUT write failed status='
|
|
WS-FILE-OUT-STATUS INTO WS-ERR-MSG
|
|
DISPLAY WS-ERR-MSG
|
|
ADD 1 TO WS-ERR-COUNT
|
|
END-IF
|
|
END-IF.
|
|
*>
|
|
3500-WRITE-DETAIL SECTION.
|
|
*>
|
|
*> Page break control: check line count
|
|
ADD 1 TO WS-LINE-COUNT.
|
|
IF WS-LINE-COUNT > WS-LINES-PER-PAGE
|
|
PERFORM 4100-PAGE-HEADING
|
|
MOVE 1 TO WS-LINE-COUNT
|
|
END-IF.
|
|
*>
|
|
*> Write detail record with status check
|
|
WRITE OUT-DTL-REC FROM WS-DETAIL-LINE.
|
|
IF WS-FILE-DTL-STATUS NOT = '00'
|
|
MOVE 2 TO WS-ERR-SEVERITY
|
|
STRING 'ERROR: DTL write failed status='
|
|
WS-FILE-DTL-STATUS INTO WS-ERR-MSG
|
|
DISPLAY WS-ERR-MSG
|
|
ADD 1 TO WS-ERR-COUNT
|
|
END-IF.
|
|
*>
|
|
4000-REPORT SECTION.
|
|
*>
|
|
DISPLAY 'EditGetPut: Generating output report...'.
|
|
PERFORM 4100-PAGE-HEADING.
|
|
PERFORM 4200-WRITE-REPORT-BODY.
|
|
PERFORM 4300-PAGE-FOOTING.
|
|
DISPLAY 'EditGetPut: Report generated, pages='
|
|
WS-PAGE-COUNT.
|
|
*>
|
|
4100-PAGE-HEADING SECTION.
|
|
*>
|
|
ADD 1 TO WS-PAGE-COUNT.
|
|
MOVE WS-PAGE-COUNT TO WS-ED-PAGE.
|
|
*>
|
|
*> Build heading lines
|
|
' PAGE: ' WS-ED-PAGE
|
|
INTO WS-HDG-1.
|
|
*>
|
|
STRING 'DATE: ' WS-RPT-DATE
|
|
' TIME: ' WS-RPT-TIME
|
|
INTO WS-HDG-2.
|
|
*>
|
|
STRING 'INVOICE ID CUSTOMER ID MONTH '
|
|
'AMOUNT ST DESCRIPTION'
|
|
INTO WS-HDG-3.
|
|
*>
|
|
*> Write headings to detail file
|
|
WRITE OUT-DTL-REC FROM WS-HDG-1.
|
|
WRITE OUT-DTL-REC FROM WS-HDG-2.
|
|
WRITE OUT-DTL-REC FROM WS-HDG-3.
|
|
WRITE OUT-DTL-REC FROM WS-SEP-STARS.
|
|
*>
|
|
*> Write headings to summary file
|
|
WRITE OUT-SUM-REC FROM WS-HDG-1.
|
|
WRITE OUT-SUM-REC FROM WS-HDG-2.
|
|
WRITE OUT-SUM-REC FROM WS-SEP-STARS.
|
|
*>
|
|
IF WS-FILE-DTL-STATUS NOT = '00'
|
|
MOVE 2 TO WS-ERR-SEVERITY
|
|
STRING 'ERROR: Heading write failed status='
|
|
WS-FILE-DTL-STATUS INTO WS-ERR-MSG
|
|
DISPLAY WS-ERR-MSG
|
|
ADD 1 TO WS-ERR-COUNT
|
|
END-IF.
|
|
*>
|
|
4200-WRITE-REPORT-BODY SECTION.
|
|
*>
|
|
*> Grand total summary
|
|
MOVE WS-HASH-AMT TO WS-ED-TOTAL.
|
|
MOVE WS-HASH-REC-COUNT TO WS-ED-COUNT.
|
|
*>
|
|
STRING '=== GRAND TOTAL === Records: ' WS-ED-COUNT
|
|
' Amount: ' WS-ED-TOTAL
|
|
INTO WS-SUMMARY-LINE.
|
|
WRITE OUT-SUM-REC FROM WS-SUMMARY-LINE.
|
|
WRITE OUT-DTL-REC FROM WS-SUMMARY-LINE.
|
|
*>
|
|
*> Status breakdown
|
|
MOVE WS-ACC-STATUS-0 TO WS-ED-TOTAL.
|
|
STRING 'STATUS 0 (UNISSUED) Amount: ' WS-ED-TOTAL
|
|
INTO WS-SUMMARY-LINE.
|
|
WRITE OUT-SUM-REC FROM WS-SUMMARY-LINE.
|
|
WRITE OUT-DTL-REC FROM WS-SUMMARY-LINE.
|
|
*>
|
|
MOVE WS-ACC-STATUS-1 TO WS-ED-TOTAL.
|
|
STRING 'STATUS 1 (ISSUED) Amount: ' WS-ED-TOTAL
|
|
INTO WS-SUMMARY-LINE.
|
|
WRITE OUT-SUM-REC FROM WS-SUMMARY-LINE.
|
|
WRITE OUT-DTL-REC FROM WS-SUMMARY-LINE.
|
|
*>
|
|
MOVE WS-ACC-STATUS-2 TO WS-ED-TOTAL.
|
|
STRING 'STATUS 2 (PAID) Amount: ' WS-ED-TOTAL
|
|
INTO WS-SUMMARY-LINE.
|
|
WRITE OUT-SUM-REC FROM WS-SUMMARY-LINE.
|
|
WRITE OUT-DTL-REC FROM WS-SUMMARY-LINE.
|
|
*>
|
|
*> Hash checksum summary
|
|
MOVE WS-HASH-CHECKSUM TO WS-ED-TOTAL.
|
|
STRING 'HASH CHECKSUM: ' WS-ED-TOTAL
|
|
INTO WS-SUMMARY-LINE.
|
|
WRITE OUT-SUM-REC FROM WS-SUMMARY-LINE.
|
|
*>
|
|
*> Editing pattern demonstration
|
|
MOVE WS-HASH-AMT TO WS-ED-FLOAT-DOLLAR.
|
|
STRING 'FLOAT DOLLAR FORMAT: ' WS-ED-FLOAT-DOLLAR
|
|
INTO WS-SUMMARY-LINE.
|
|
WRITE OUT-SUM-REC FROM WS-SUMMARY-LINE.
|
|
WRITE OUT-DTL-REC FROM WS-SUMMARY-LINE.
|
|
*>
|
|
*> Error and warning counts
|
|
MOVE WS-ERR-COUNT TO WS-ED-COUNT.
|
|
MOVE WS-WARN-COUNT TO WS-ED-COUNT.
|
|
STRING 'ERRORS: ' WS-ERR-COUNT
|
|
' WARNINGS: ' WS-WARN-COUNT
|
|
INTO WS-SUMMARY-LINE.
|
|
WRITE OUT-SUM-REC FROM WS-SUMMARY-LINE.
|
|
WRITE OUT-DTL-REC FROM WS-SUMMARY-LINE.
|
|
*>
|
|
WRITE OUT-SUM-REC FROM WS-SEP-DASHES.
|
|
*>
|
|
4300-PAGE-FOOTING SECTION.
|
|
*>
|
|
MOVE WS-HASH-REC-COUNT TO WS-ED-COUNT.
|
|
MOVE WS-HASH-AMT TO WS-ED-TOTAL.
|
|
MOVE WS-PAGE-COUNT TO WS-ED-PAGE.
|
|
*>
|
|
WRITE OUT-DTL-REC FROM WS-SEP-DASHES.
|
|
*>
|
|
STRING '*** END OF PAGE ' WS-ED-PAGE
|
|
' *** RECORDS: ' WS-ED-COUNT
|
|
' TOTAL: ' WS-ED-TOTAL
|
|
INTO WS-FTG-1.
|
|
WRITE OUT-DTL-REC FROM WS-FTG-1.
|
|
WRITE OUT-DTL-REC FROM WS-SEP-EQUALS.
|
|
*>
|
|
*> Write footing to summary file as well
|
|
WRITE OUT-SUM-REC FROM WS-FTG-1.
|
|
WRITE OUT-SUM-REC FROM WS-SEP-EQUALS.
|
|
*>
|
|
5000-AUDIT SECTION.
|
|
*>
|
|
DISPLAY 'EditGetPut: Writing audit trail...'.
|
|
*>
|
|
MOVE WS-HASH-REC-COUNT TO WS-ED-COUNT.
|
|
MOVE WS-HASH-AMT TO WS-ED-TOTAL.
|
|
MOVE WS-PAGE-COUNT TO WS-ED-PAGE.
|
|
*>
|
|
*> Build and write audit record
|
|
STRING 'AUDIT:' WS-TIMESTAMP-STR
|
|
' PROG=EditGetPut'
|
|
' RECS=' WS-ED-COUNT
|
|
' AMT=' WS-ED-TOTAL
|
|
' PGS=' WS-ED-PAGE
|
|
' ERRS=' WS-ERR-COUNT
|
|
' WARNS=' WS-WARN-COUNT
|
|
INTO OUT-AUDIT-REC.
|
|
WRITE OUT-AUDIT-REC.
|
|
IF WS-FILE-AUD-STATUS NOT = '00'
|
|
DISPLAY 'ERROR: Audit write failed, status: '
|
|
WS-FILE-AUD-STATUS
|
|
ADD 1 TO WS-ERR-COUNT
|
|
END-IF.
|
|
*>
|
|
*> Second audit line — format configuration
|
|
STRING 'AUDIT:FORMAT=' WS-FORMAT-MODE
|
|
' COND=' WS-CONDENSED-MODE
|
|
' CFG=' WS-FMT-CONFIG
|
|
INTO OUT-AUDIT-REC.
|
|
WRITE OUT-AUDIT-REC.
|
|
*>
|
|
*> Third audit line — hash detail
|
|
MOVE WS-HASH-CHECKSUM TO WS-ED-TOTAL.
|
|
STRING 'AUDIT:HASH=' WS-ED-TOTAL
|
|
' PASS1=' WS-REC-COUNT
|
|
' PASS2=' WS-PASS2-COUNT
|
|
INTO OUT-AUDIT-REC.
|
|
WRITE OUT-AUDIT-REC.
|
|
*>
|
|
ADD 1 TO WS-AUDIT-ENTRIES.
|
|
DISPLAY 'EditGetPut: Audit trail written.'
|
|
' Entries=' WS-AUDIT-ENTRIES.
|
|
*>
|
|
6000-ERROR-HANDLE SECTION.
|
|
*>
|
|
ADD 1 TO WS-ERR-COUNT.
|
|
*>
|
|
EVALUATE WS-ERR-SEVERITY
|
|
WHEN 3
|
|
DISPLAY 'FATAL: ' WS-ERR-MSG
|
|
PERFORM 9000-EXIT
|
|
STOP RUN
|
|
WHEN 2
|
|
DISPLAY 'ERROR: ' WS-ERR-MSG
|
|
WHEN 1
|
|
DISPLAY 'WARN: ' WS-ERR-MSG
|
|
WHEN 0
|
|
DISPLAY 'INFO: ' WS-ERR-MSG
|
|
WHEN OTHER
|
|
DISPLAY 'UNKN: ' WS-ERR-MSG
|
|
END-EVALUATE.
|
|
*>
|
|
*> Check if error threshold exceeded
|
|
IF WS-ERR-COUNT > WS-CONFIG-MAXERR
|
|
MOVE 3 TO WS-ERR-SEVERITY
|
|
STRING 'FATAL: Error threshold exceeded '
|
|
WS-CONFIG-MAXERR INTO WS-ERR-MSG
|
|
DISPLAY WS-ERR-MSG
|
|
PERFORM 9000-EXIT
|
|
STOP RUN
|
|
END-IF.
|
|
*>
|
|
9000-EXIT SECTION.
|
|
*>
|
|
DISPLAY 'EditGetPut: Cleanup and exit...'.
|
|
*>
|
|
*> === PRESERVED ORIGINAL CLOSE + DISPLAY ===
|
|
CLOSE FILE-IN.
|
|
CLOSE FILE-OUT.
|
|
*>
|
|
DISPLAY 'EditGetPut: Completed successfully. '
|
|
'Records processed: ' WS-REC-COUNT.
|
|
*> === END PRESERVED ORIGINAL CLOSE + DISPLAY ===
|
|
*>
|
|
*> Additional file closes
|
|
CLOSE FILE-OUT-DTL.
|
|
IF WS-FILE-DTL-STATUS NOT = '00'
|
|
DISPLAY 'WARN: FILE-OUT-DTL close status='
|
|
WS-FILE-DTL-STATUS
|
|
END-IF.
|
|
*>
|
|
CLOSE FILE-OUT-SUM.
|
|
IF WS-FILE-SUM-STATUS NOT = '00'
|
|
DISPLAY 'WARN: FILE-OUT-SUM close status='
|
|
WS-FILE-SUM-STATUS
|
|
END-IF.
|
|
*>
|
|
CLOSE FILE-OUT-AUDIT.
|
|
IF WS-FILE-AUD-STATUS NOT = '00'
|
|
DISPLAY 'WARN: FILE-OUT-AUDIT close status='
|
|
WS-FILE-AUD-STATUS
|
|
END-IF.
|
|
*>
|
|
*> Final status display
|
|
DISPLAY 'EditGetPut: PASS-1 records=' WS-REC-COUNT
|
|
' PASS-2 records=' WS-PASS2-COUNT.
|
|
DISPLAY 'EditGetPut: Hash total=' WS-HASH-AMT
|
|
' Checksum=' WS-HASH-CHECKSUM.
|
|
DISPLAY 'EditGetPut: Errors=' WS-ERR-COUNT
|
|
' Warnings=' WS-WARN-COUNT.
|
|
DISPLAY 'EditGetPut: Pages=' WS-PAGE-COUNT
|
|
' Audit entries=' WS-AUDIT-ENTRIES.
|
|
DISPLAY 'EditGetPut: End at ' WS-TIMESTAMP-STR.
|
|
*>
|
|
EXIT.
|
|
*>
|
|
END PROGRAM EditGetPut.
|