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.