hsyx3952501
227 lines
7.7 KiB
COBOL
227 lines
7.7 KiB
COBOL
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'.
|