hsyx3952501
260 lines
9.4 KiB
COBOL
260 lines
9.4 KiB
COBOL
IDENTIFICATION DIVISION.
|
|
PROGRAM-ID. CRDCALC.
|
|
|
|
* CALCULATE INTEREST AND FEES - CREDIT CARD BATCH SYSTEM
|
|
* DEMONSTRATES: OCCURS+SEARCH, KEY BREAK, COMPUTE,
|
|
* EVALUATE, COMP-3, COPY REPLACING
|
|
|
|
ENVIRONMENT DIVISION.
|
|
INPUT-OUTPUT SECTION.
|
|
FILE-CONTROL.
|
|
SELECT VALID-IN ASSIGN TO "VALIDIN"
|
|
ORGANIZATION IS LINE SEQUENTIAL.
|
|
SELECT RATE-FILE ASSIGN TO "RATE"
|
|
ORGANIZATION IS SEQUENTIAL.
|
|
SELECT CALC-OUT ASSIGN TO "CALCOUT"
|
|
ORGANIZATION IS LINE SEQUENTIAL.
|
|
|
|
DATA DIVISION.
|
|
FILE SECTION.
|
|
FD VALID-IN.
|
|
COPY TXCPY.
|
|
|
|
FD RATE-FILE.
|
|
COPY RATECPY.
|
|
|
|
FD CALC-OUT.
|
|
01 CALC-RECORD PIC X(200).
|
|
|
|
WORKING-STORAGE SECTION.
|
|
01 WS-SWITCHES.
|
|
05 WS-EOF-VALID PIC X VALUE 'N'.
|
|
88 WS-END-OF-VALID VALUE 'Y'.
|
|
05 WS-EOF-RATE PIC X VALUE 'N'.
|
|
88 WS-END-OF-RATE VALUE 'Y'.
|
|
|
|
01 WS-COUNTERS.
|
|
05 WS-TOTAL-IN PIC 9(5) VALUE 0.
|
|
05 WS-TOTAL-OUT PIC 9(5) VALUE 0.
|
|
05 WS-RATE-COUNT PIC 9(5) VALUE 0.
|
|
|
|
* INTERNAL TABLE: RATE TABLE WITH OCCURS + SEARCH
|
|
01 WS-RATE-TABLE.
|
|
05 WS-RATE-ENTRY OCCURS 1 TO 5 TIMES
|
|
DEPENDING ON WS-RATE-COUNT
|
|
INDEXED BY WS-RT-IDX.
|
|
10 WS-RT-TYPE PIC X.
|
|
10 WS-RT-PCT PIC 9(1)V9(8) COMP-3.
|
|
10 WS-RT-EFF-DATE PIC 9(8).
|
|
|
|
* COPY REPLACING DEMO: STATEMENT DATE
|
|
COPY DATESUB REPLACING ==:TAG:== BY ==WS-STMT==.
|
|
|
|
01 WS-CARD-ACCUM.
|
|
05 WS-CURRENT-CARD PIC 9(16) VALUE 0.
|
|
05 WS-CARD-PURCHASES PIC S9(9)V99 COMP-3 VALUE 0.
|
|
05 WS-CARD-CASH PIC S9(9)V99 COMP-3 VALUE 0.
|
|
05 WS-CARD-REFUNDS PIC S9(9)V99 COMP-3 VALUE 0.
|
|
05 WS-CARD-INTEREST PIC S9(9)V99 COMP-3 VALUE 0.
|
|
05 WS-CARD-FEE PIC S9(9)V99 COMP-3 VALUE 0.
|
|
05 WS-CARD-TOTAL PIC S9(9)V99 COMP-3 VALUE 0.
|
|
05 WS-TX-COUNT PIC 9(4) VALUE 0.
|
|
|
|
01 WS-CALC-DETAIL.
|
|
05 WS-D-CARD PIC 9(16).
|
|
05 WS-D-SEP1 PIC X VALUE SPACE.
|
|
05 WS-D-TYPE PIC X.
|
|
05 WS-D-SEP2 PIC X VALUE SPACE.
|
|
05 WS-D-AMOUNT PIC -(9)9.99.
|
|
05 WS-D-SEP3 PIC X VALUE SPACE.
|
|
05 WS-D-INTEREST PIC -(7)9.99.
|
|
05 WS-D-SEP4 PIC X VALUE SPACE.
|
|
05 WS-D-FEE PIC -(7)9.99.
|
|
05 WS-D-SEP5 PIC X VALUE SPACE.
|
|
05 WS-D-DESC PIC X(30).
|
|
|
|
01 WS-SUMMARY.
|
|
05 WS-S-CARD PIC 9(16).
|
|
05 WS-S-SEP1 PIC X VALUE SPACE.
|
|
05 WS-S-TOTAL-AMT PIC -(9)9.99.
|
|
05 WS-S-SEP2 PIC X VALUE SPACE.
|
|
05 WS-S-TOTAL-INT PIC -(9)9.99.
|
|
05 WS-S-SEP3 PIC X VALUE SPACE.
|
|
05 WS-S-TOTAL-FEE PIC -(9)9.99.
|
|
05 WS-S-SEP4 PIC X VALUE SPACE.
|
|
05 WS-S-GRAND-TOTAL PIC -(9)9.99.
|
|
05 WS-S-SEP5 PIC X VALUE SPACE.
|
|
05 WS-S-TX-COUNT PIC Z(4)9.
|
|
|
|
01 WS-GRAND-TOTAL PIC S9(12)V99 COMP-3 VALUE 0.
|
|
01 WS-GRAND-INT PIC S9(12)V99 COMP-3 VALUE 0.
|
|
01 WS-GRAND-FEE PIC S9(12)V99 COMP-3 VALUE 0.
|
|
01 WS-GRAND-DISP.
|
|
05 WS-GD-TOTAL PIC -(12)9.99.
|
|
05 WS-GD-SP1 PIC X VALUE SPACE.
|
|
05 WS-GD-INT PIC -(12)9.99.
|
|
05 WS-GD-SP2 PIC X VALUE SPACE.
|
|
05 WS-GD-FEE PIC -(12)9.99.
|
|
|
|
01 WS-DAYS-DIFF PIC 9(4).
|
|
01 WS-INT-AMOUNT PIC S9(9)V99 COMP-3.
|
|
01 WS-FEE-AMOUNT PIC S9(9)V99 COMP-3.
|
|
01 WS-DAILY-RATE PIC 9(1)V9(8) COMP-3.
|
|
01 WS-CASH-RATE PIC 9(1)V9(4) COMP-3.
|
|
01 WS-OVERDUE-RATE PIC 9(1)V9(4) COMP-3.
|
|
01 WS-STATEMENT-DATE PIC 9(8).
|
|
|
|
PROCEDURE DIVISION.
|
|
0000-MAIN.
|
|
OPEN INPUT VALID-IN
|
|
INPUT RATE-FILE
|
|
OUTPUT CALC-OUT.
|
|
|
|
ACCEPT WS-STATEMENT-DATE FROM DATE YYYYMMDD.
|
|
MOVE WS-STATEMENT-DATE(1:4) TO WS-STMT-YYYY.
|
|
MOVE WS-STATEMENT-DATE(5:2) TO WS-STMT-MM.
|
|
MOVE WS-STATEMENT-DATE(7:2) TO WS-STMT-DD.
|
|
|
|
* LOAD RATES INTO OCCURS TABLE
|
|
PERFORM 1000-LOAD-RATES.
|
|
|
|
* PROCESS TRANSACTIONS (KEY BREAK: CARD CHANGE)
|
|
PERFORM 2000-PROCESS-VALID UNTIL WS-END-OF-VALID.
|
|
|
|
* WRITE FINAL CARD SUMMARY IF DATA REMAINS
|
|
IF WS-TX-COUNT > 0
|
|
PERFORM 3000-WRITE-CARD-SUMMARY.
|
|
|
|
* WRITE GRAND TOTAL
|
|
PERFORM 4000-WRITE-GRAND-TOTAL.
|
|
|
|
CLOSE VALID-IN RATE-FILE CALC-OUT.
|
|
DISPLAY 'CRDCALC: ' WS-TOTAL-IN ' READ, '
|
|
WS-TOTAL-OUT ' WRITTEN'.
|
|
GOBACK.
|
|
|
|
* LOAD RATES INTO OCCURS TABLE
|
|
1000-LOAD-RATES.
|
|
MOVE 0 TO WS-RATE-COUNT.
|
|
PERFORM UNTIL WS-END-OF-RATE
|
|
READ RATE-FILE
|
|
AT END SET WS-END-OF-RATE TO TRUE
|
|
NOT AT END
|
|
ADD 1 TO WS-RATE-COUNT
|
|
MOVE RATE-TYPE
|
|
TO WS-RT-TYPE(WS-RATE-COUNT)
|
|
MOVE RATE-PCT
|
|
TO WS-RT-PCT(WS-RATE-COUNT)
|
|
MOVE RATE-EFF-DATE
|
|
TO WS-RT-EFF-DATE(WS-RATE-COUNT)
|
|
END-READ
|
|
END-PERFORM.
|
|
|
|
* SEARCH TABLE FOR CASH RATE
|
|
SET WS-RT-IDX TO 1.
|
|
SEARCH WS-RATE-ENTRY
|
|
AT END MOVE 0.0005 TO WS-CASH-RATE
|
|
WHEN WS-RT-TYPE(WS-RT-IDX) = 'C'
|
|
MOVE WS-RT-PCT(WS-RT-IDX) TO WS-CASH-RATE
|
|
END-SEARCH.
|
|
|
|
* SEARCH TABLE FOR OVERDUE RATE
|
|
SET WS-RT-IDX TO 1.
|
|
SEARCH WS-RATE-ENTRY
|
|
AT END MOVE 0.0500 TO WS-OVERDUE-RATE
|
|
WHEN WS-RT-TYPE(WS-RT-IDX) = 'O'
|
|
MOVE WS-RT-PCT(WS-RT-IDX) TO WS-OVERDUE-RATE
|
|
END-SEARCH.
|
|
|
|
IF WS-CASH-RATE = 0 MOVE 0.0005 TO WS-CASH-RATE END-IF.
|
|
IF WS-OVERDUE-RATE = 0 MOVE 0.0500 TO WS-OVERDUE-RATE
|
|
END-IF.
|
|
MOVE 0 TO WS-TOTAL-IN.
|
|
|
|
2000-PROCESS-VALID.
|
|
READ VALID-IN
|
|
AT END SET WS-END-OF-VALID TO TRUE
|
|
NOT AT END
|
|
ADD 1 TO WS-TOTAL-IN
|
|
IF WS-CURRENT-CARD = 0
|
|
MOVE TX-CARD-NO TO WS-CURRENT-CARD
|
|
END-IF
|
|
* KEY BREAK: WHEN CARD CHANGES, OUTPUT SUMMARY
|
|
IF TX-CARD-NO NOT = WS-CURRENT-CARD
|
|
PERFORM 3000-WRITE-CARD-SUMMARY
|
|
MOVE TX-CARD-NO TO WS-CURRENT-CARD
|
|
MOVE 0 TO WS-CARD-PURCHASES
|
|
WS-CARD-CASH
|
|
WS-CARD-REFUNDS
|
|
WS-CARD-INTEREST
|
|
WS-CARD-FEE
|
|
WS-CARD-TOTAL
|
|
WS-TX-COUNT
|
|
END-IF
|
|
PERFORM 2500-ACCUMULATE-TX
|
|
END-READ.
|
|
|
|
2500-ACCUMULATE-TX.
|
|
MOVE 0 TO WS-INT-AMOUNT WS-FEE-AMOUNT.
|
|
ADD 1 TO WS-TX-COUNT.
|
|
EVALUATE TRUE
|
|
WHEN TX-PURCHASE
|
|
ADD TX-AMOUNT TO WS-CARD-PURCHASES
|
|
MOVE 'PURCHASE' TO WS-D-DESC
|
|
WHEN TX-CASH
|
|
ADD TX-AMOUNT TO WS-CARD-CASH
|
|
MOVE 'CASH ADVANCE' TO WS-D-DESC
|
|
COMPUTE WS-INT-AMOUNT = TX-AMOUNT *
|
|
WS-CASH-RATE * 30
|
|
ADD WS-INT-AMOUNT TO WS-CARD-INTEREST
|
|
WHEN TX-REFUND
|
|
ADD TX-AMOUNT TO WS-CARD-PURCHASES
|
|
MOVE 'REFUND' TO WS-D-DESC
|
|
END-EVALUATE.
|
|
|
|
* FEE CALCULATION: 1% OF CASH ADVANCE (MIN 100)
|
|
IF TX-CASH
|
|
COMPUTE WS-FEE-AMOUNT = TX-AMOUNT * 0.01
|
|
IF WS-FEE-AMOUNT < 100
|
|
MOVE 100 TO WS-FEE-AMOUNT
|
|
END-IF
|
|
ADD WS-FEE-AMOUNT TO WS-CARD-FEE
|
|
END-IF.
|
|
|
|
* WRITE DETAIL LINE
|
|
MOVE TX-CARD-NO TO WS-D-CARD
|
|
MOVE TX-TYPE TO WS-D-TYPE
|
|
MOVE TX-AMOUNT TO WS-D-AMOUNT
|
|
MOVE WS-INT-AMOUNT TO WS-D-INTEREST
|
|
MOVE WS-FEE-AMOUNT TO WS-D-FEE
|
|
WRITE CALC-RECORD FROM WS-CALC-DETAIL.
|
|
|
|
3000-WRITE-CARD-SUMMARY.
|
|
COMPUTE WS-CARD-TOTAL = WS-CARD-PURCHASES + WS-CARD-CASH
|
|
+ WS-CARD-INTEREST + WS-CARD-FEE - WS-CARD-REFUNDS.
|
|
ADD WS-CARD-TOTAL TO WS-GRAND-TOTAL.
|
|
ADD WS-CARD-INTEREST TO WS-GRAND-INT.
|
|
ADD WS-CARD-FEE TO WS-GRAND-FEE.
|
|
|
|
MOVE WS-CURRENT-CARD TO WS-S-CARD
|
|
MOVE WS-CARD-PURCHASES TO WS-S-TOTAL-AMT
|
|
MOVE WS-CARD-INTEREST TO WS-S-TOTAL-INT
|
|
MOVE WS-CARD-FEE TO WS-S-TOTAL-FEE
|
|
MOVE WS-CARD-TOTAL TO WS-S-GRAND-TOTAL
|
|
MOVE WS-TX-COUNT TO WS-S-TX-COUNT
|
|
WRITE CALC-RECORD FROM WS-SUMMARY.
|
|
ADD 1 TO WS-TOTAL-OUT.
|
|
|
|
4000-WRITE-GRAND-TOTAL.
|
|
MOVE WS-GRAND-TOTAL TO WS-GD-TOTAL.
|
|
MOVE WS-GRAND-INT TO WS-GD-INT.
|
|
MOVE WS-GRAND-FEE TO WS-GD-FEE.
|
|
STRING
|
|
'GRAND TOTAL CARDS:' WS-TOTAL-OUT
|
|
' AMOUNT:' WS-GD-TOTAL
|
|
' INTEREST:' WS-GD-INT
|
|
' FEE:' WS-GD-FEE
|
|
INTO CALC-RECORD
|
|
END-STRING.
|
|
WRITE CALC-RECORD.
|