IDENTIFICATION DIVISION. PROGRAM-ID. CRDVAL. * VALIDATE TRANSACTIONS - CREDIT CARD BATCH SYSTEM * DEMONSTRATES: COPY REPLACING, OCCURS+SEARCH ALL, * INSPECT, STRING, 88-LEVEL, REDEFINES IO ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. SELECT TX-FILE ASSIGN TO "TRANSIN" ORGANIZATION IS LINE SEQUENTIAL. SELECT MEM-FILE ASSIGN TO "MEMBER" ORGANIZATION IS LINE SEQUENTIAL. SELECT VALID-OUT ASSIGN TO "VALIDOUT" ORGANIZATION IS LINE SEQUENTIAL. SELECT REJECT-OUT ASSIGN TO "REJECT" ORGANIZATION IS LINE SEQUENTIAL. SELECT ERR-OUT ASSIGN TO "REPORTERR" ORGANIZATION IS LINE SEQUENTIAL. DATA DIVISION. FILE SECTION. FD TX-FILE. COPY TXCPY. FD MEM-FILE. COPY MEMCPY. FD VALID-OUT. 01 VALID-RECORD PIC X(100). FD REJECT-OUT. 01 REJECT-RECORD PIC X(100). FD ERR-OUT. 01 ERR-RECORD PIC X(120). WORKING-STORAGE SECTION. 01 WS-SWITCHES. 05 WS-EOF-TX PIC X VALUE 'N'. 88 WS-END-OF-TX VALUE 'Y'. 05 WS-EOF-MEM PIC X VALUE 'N'. 88 WS-END-OF-MEM VALUE 'Y'. 05 WS-VALID PIC X VALUE 'Y'. 88 WS-IS-VALID VALUE 'Y'. 05 WS-FOUND PIC X VALUE 'N'. 88 WS-IS-FOUND VALUE 'Y'. 01 WS-COUNTERS. 05 WS-TOTAL-READ PIC 9(5) VALUE 0. 05 WS-TOTAL-VALID PIC 9(5) VALUE 0. 05 WS-TOTAL-REJECT PIC 9(5) VALUE 0. 05 WS-TOTAL-MEMBERS PIC 9(5) VALUE 0. * DATESUB COPYBOOK WITH COPY REPLACING DEMO * GENERATES: WS-RUN-DATE (WS-RUN-YYYY, WS-RUN-MM, WS-RUN-DD) COPY DATESUB REPLACING ==:TAG:== BY ==WS-RUN==. * GENERATES: WS-TX-DATE (WS-TX-YYYY, WS-TX-MM, WS-TX-DD) COPY DATESUB REPLACING ==:TAG:== BY ==WS-TX==. * INTERNAL TABLE: MEMBER TABLE WITH OCCURS + SEARCH ALL 01 WS-MEMBER-TABLE. 05 WS-MEMBER-ENTRY OCCURS 1 TO 100 TIMES DEPENDING ON WS-TOTAL-MEMBERS ASCENDING KEY IS WS-MEM-ID INDEXED BY WS-MEM-IDX. 10 WS-MEM-ID PIC 9(16). 10 WS-MEM-NAME PIC X(30). 10 WS-MEM-LIMIT PIC 9(9)V99. 10 WS-MEM-TYPE PIC X. 10 WS-MEM-STATUS PIC X. 10 WS-MEM-BALANCE PIC S9(9)V99. 10 WS-MEM-MINPAY PIC 9(9)V99. 10 WS-MEM-ADDR PIC X(60). 01 WS-ERR-MSG. 05 WS-ERR-CARD PIC 9(16). 05 WS-ERR-SP1 PIC X(2) VALUE SPACES. 05 WS-ERR-CODE PIC X(20). 05 WS-ERR-SP2 PIC X(2) VALUE SPACES. 05 WS-ERR-DESC PIC X(80). 01 WS-MERCHANT-CHECK. 05 WS-MC-LEN PIC 9(2). 05 WS-MC-COUNT PIC 9(2). PROCEDURE DIVISION. 0000-MAIN. OPEN INPUT TX-FILE INPUT MEM-FILE OUTPUT VALID-OUT OUTPUT REJECT-OUT OUTPUT ERR-OUT. ACCEPT WS-RUN-DATE FROM DATE YYYYMMDD. PERFORM 1000-LOAD-MEMBERS. PERFORM 2000-PROCESS-TX UNTIL WS-END-OF-TX. PERFORM 3000-WRITE-SUMMARY. CLOSE TX-FILE MEM-FILE VALID-OUT REJECT-OUT ERR-OUT. GOBACK. * LOAD ALL MEMBERS INTO OCCURS TABLE AT ONCE 1000-LOAD-MEMBERS. MOVE 0 TO WS-TOTAL-MEMBERS. PERFORM UNTIL WS-END-OF-MEM READ MEM-FILE AT END SET WS-END-OF-MEM TO TRUE NOT AT END ADD 1 TO WS-TOTAL-MEMBERS MOVE MEM-ID TO WS-MEM-ID(WS-TOTAL-MEMBERS) MOVE MEM-NAME TO WS-MEM-NAME(WS-TOTAL-MEMBERS) MOVE MEM-CREDIT-LIMIT TO WS-MEM-LIMIT(WS-TOTAL-MEMBERS) MOVE MEM-TYPE TO WS-MEM-TYPE(WS-TOTAL-MEMBERS) MOVE MEM-STATUS TO WS-MEM-STATUS(WS-TOTAL-MEMBERS) MOVE MEM-BALANCE TO WS-MEM-BALANCE(WS-TOTAL-MEMBERS) MOVE MEM-MIN-PAYMENT TO WS-MEM-MINPAY(WS-TOTAL-MEMBERS) MOVE MEM-ADDRESS TO WS-MEM-ADDR(WS-TOTAL-MEMBERS) END-READ END-PERFORM. 2000-PROCESS-TX. READ TX-FILE AT END SET WS-END-OF-TX TO TRUE NOT AT END ADD 1 TO WS-TOTAL-READ PERFORM 2100-VALIDATE-TX END-READ. 2100-VALIDATE-TX. SET WS-IS-VALID TO TRUE. * INSPECT DEMO: CHECK MERCHANT NAME FOR INVALID CHARS MOVE 0 TO WS-MC-COUNT. INSPECT TX-MERCHANT TALLYING WS-MC-COUNT FOR CHARACTERS BEFORE INITIAL SPACE. IF WS-MC-COUNT = 0 MOVE 'INVALID-MERCHANT' TO WS-ERR-CODE MOVE 'MERCHANT NAME EMPTY' TO WS-ERR-DESC PERFORM 2200-REJECT EXIT PARAGRAPH END-IF. CONTINUE. IF TX-CARD-NO = 0 MOVE 'INVALID-CARD' TO WS-ERR-CODE MOVE 'CARD NUMBER IS ZERO' TO WS-ERR-DESC PERFORM 2200-REJECT EXIT PARAGRAPH. IF TX-AMOUNT <= 0 AND NOT TX-REFUND MOVE 'INVALID-AMOUNT' TO WS-ERR-CODE MOVE 'AMOUNT MUST BE POSITIVE' TO WS-ERR-DESC PERFORM 2200-REJECT EXIT PARAGRAPH. IF TX-REFUND AND TX-AMOUNT >= 0 MOVE 'INVALID-REFUND' TO WS-ERR-CODE MOVE 'REFUND AMOUNT MUST BE NEGATIVE' TO WS-ERR-DESC PERFORM 2200-REJECT EXIT PARAGRAPH. MOVE TX-DATE(1:4) TO WS-TX-YYYY MOVE TX-DATE(5:2) TO WS-TX-MM MOVE TX-DATE(7:2) TO WS-TX-DD IF WS-TX-MM NOT = WS-RUN-MM MOVE 'OUT-OF-MONTH' TO WS-ERR-CODE MOVE 'TX DATE NOT IN RUN MONTH' TO WS-ERR-DESC PERFORM 2200-REJECT EXIT PARAGRAPH. * SEARCH ALL DEMO: BINARY SEARCH ON MEMBER TABLE PERFORM 2300-FIND-MEMBER. IF NOT WS-IS-FOUND MOVE 'MEMBER-NOT-FOUND' TO WS-ERR-CODE MOVE 'CARD NOT IN MEMBER FILE' TO WS-ERR-DESC PERFORM 2200-REJECT EXIT PARAGRAPH. IF WS-MEM-STATUS(WS-MEM-IDX) = 'F' MOVE 'FROZEN-CARD' TO WS-ERR-CODE MOVE 'CARD STATUS IS FROZEN' TO WS-ERR-DESC PERFORM 2200-REJECT EXIT PARAGRAPH. IF WS-VALID = 'Y' WRITE VALID-RECORD FROM TX-RECORD ADD 1 TO WS-TOTAL-VALID. 2200-REJECT. WRITE REJECT-RECORD FROM TX-RECORD. MOVE TX-CARD-NO TO WS-ERR-CARD. WRITE ERR-RECORD FROM WS-ERR-MSG. ADD 1 TO WS-TOTAL-REJECT. 2300-FIND-MEMBER. SET WS-MEM-IDX TO 1. SEARCH ALL WS-MEMBER-ENTRY AT END MOVE 'N' TO WS-FOUND WHEN WS-MEM-ID(WS-MEM-IDX) = TX-CARD-NO MOVE 'Y' TO WS-FOUND. 3000-WRITE-SUMMARY. STRING 'CRDVAL SUMMARY - TOTAL READ:' WS-TOTAL-READ ' VALID:' WS-TOTAL-VALID ' REJECT:' WS-TOTAL-REJECT ' MEMBERS LOADED:' WS-TOTAL-MEMBERS INTO ERR-RECORD END-STRING. WRITE ERR-RECORD. DISPLAY 'CRDVAL: ' WS-TOTAL-READ ' READ, ' WS-TOTAL-VALID ' VALID, ' WS-TOTAL-REJECT ' REJECTS'.