Category : Miscellaneous Language Source Code
Archive   : LCMS.ZIP
Filename : ARP910.COB

IDENTIFICATION DIVISION.
PROGRAM-ID. 'ARP910'.
AUTHOR. HAROLD HAUSERMAN.
INSTALLATION. SMYRNA CITY BANK.
DATE-WRITTEN. JULY 24, 1989.
REMARKS. ACTIVITY CONVERSION PROGRAM.
READS THE TRANSACTION FILE AND ADDS THE LATEST
CHARGE AND LAST FOUR PAMENTS TO THE CUSTOMER
MASTER RECORD. THE INPUT ACTIVITY FILE IS
IN THE OLD FORMAT, AND THE CUSTOMER MASTER
FILE IS IN THE NEW (VSAM) FORMAT.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
00001 SELECT FILE1 ASSIGN TO TRANFILE. ARP910
00002 SELECT FILE2 ASSIGN TO VSAM-CUSTOMER ARP910
00003 ORGANIZATION IS INDEXED ARP910
00004 ACCESS MODE IS DIRECT ARP910
00005 FILE STATUS IS R2-STATUS ARP910
00006 RECORD KEY IS R2-RECORD-KEY. ARP910
00007 SELECT FILE3 ASSIGN TO SYSPRINT. ARP910
DATA DIVISION.
FILE SECTION.
FD FILE1 DATA RECORD IS RECORD1
RECORD CONTAINS 35 TO 100 CHARACTERS
BLOCK CONTAINS 0 RECORDS
LABEL RECORDS ARE STANDARD
RECORDING MODE IS V.
01 RECORD1, PICTURE X(100).
FD FILE2 DATA RECORD IS RECORD2
RECORD CONTAINS 1066 TO 18826 CHARACTERS.
000420 01 RECORD2.
000430 03 R2-RECORD-KEY.
000440 05 R2-BANK-NBR PICTURE 999.
000450 05 R2-MERCHANT-NBR PICTURE 999.
000460 05 R2-CUSTOMER-NBR PICTURE 9999.
000470 05 R2-CHECK-DIGIT PICTURE 9.
03 R2-HEADER-ID PICTURE X(6).
03 FILLER PICTURE X(1043).
03 R2-TRANSACTION-INDEX PICTURE S999, COMP.
03 R2-TRANSACTION-ENTRY OCCURS 1 TO 240 TIMES
DEPENDING ON R2-TRANSACTION-INDEX.
05 FILLER, PICTURE X(74).
FD FILE3 DATA RECORD IS PRINTLINE
RECORD CONTAINS 133 CHARACTERS
BLOCK CONTAINS 20 RECORDS
LABEL RECORDS ARE STANDARD
RECORDING MODE IS F.
01 PRINTLINE, PICTURE X(133).
00063 WORKING-STORAGE SECTION.
00065 77 SS1 PICTURE S9(5) COMP VALUE ZERO.
00066 77 SS2 PICTURE S9(5) COMP VALUE ZERO.
00067 77 SS3 PICTURE S9(5) COMP VALUE ZERO.
00068 77 EOF-FLAG PICTURE X VALUE SPACE.
000700 01 R2-STATUS, PICTURE XX.
000710 88 OKAY VALUE '00'.
000720 88 END-OF-FILE VALUE '10'.
000730 88 NOT-FOUND VALUE '23'.
000750 01 BREAK-CONTROL.
000760 02 BC-MERCHANT-NBR, PICTURE 999.
000770 02 BC-CUSTOMER-NBR, PICTURE 9999.
000780 02 BC-CHECK-DIGIT, PICTURE 9.
000800 01 WORKING-DATE.
000810 10 WD-CENTURY, PICTURE 99, VALUE 19.
000820 10 WD-YYMMDD.
000830 15 WD-YEAR, PICTURE 99.
000840 15 WD-MONTH, PICTURE 99.
000850 15 WD-DAY, PICTURE 99.
000870 01 NUMERIC-CONVERSION-FIELDS.
000880 03 NCF-1.
000890 07 NCF-1A, PICTURE XXXX.
000900 07 NCF-1B, PICTURE S9, COMP-3, VALUE ZERO.
000910 03 NCF-2 REDEFINES NCF-1.
000920 07 NCF-2A, PICTURE S9(9), COMP-3.
000930 03 NCF-3, PICTURE 9(9).
000940 03 NCF-4 REDEFINES NCF-3.
000950 04 NCF-4A, PICTURE 999.
000960 04 NCF-4B, PICTURE 9999.
000970 04 NCF-4C, PICTURE 9.
000980 04 FILLER, PICTURE X.
000990 03 NCF-5, PICTURE 9(9).
000 03 NCF-6 REDEFINES NCF-5.
010 06 NCF-6A, PICTURE 9(6).
020 06 NCF-6B, PICTURE 999.
040 01 TRAN-INPUT-AREA.
050 13 TIA-SEG-1, PICTURE X(4).
060 13 TIA-SEG-2, PICTURE S9(9), COMP-3.
070 13 FILLER, PICTURE X(15).
080 13 TIA-AMT, PICTURE S9(5)V99, COMP-3.
090 13 FILLER, PICTURE X(7).
100 13 TIA-DESCR, PICTURE X(40).
120 01 TRANSACTION-RECORD.
130 02 TR-RECORD-KEY.
140 05 TR-MERCHANT-NBR PICTURE 999.
150 05 TR-CUSTOMER-NBR PICTURE 9999.
160 05 TR-CHECK-DIGIT PICTURE 9.
170 02 TR-DATE PICTURE 9(6).
180 02 TR-TRAN-CODE PICTURE 999.
190 02 TR-COMMENT, PICTURE X(40).
200 02 TR-AMOUNT PICTURE 9(5)V99.
220 01 TRANSACTION-SEGMENTS.
230 03 TRANSACTION-SEGMENT, OCCURS 4 TIMES.
240 05 TS-TRAN-CODE, PICTURE XXX.
250 05 TS-POST-DATE.
260 09 TSPD-CENTURY, PICTURE 99.
270 09 TSPD-YEAR, PICTURE 99.
280 09 TSPD-MONTH, PICTURE 99.
290 09 TSPD-DAY, PICTURE 99.
300 05 TS-EFFECTIVE-DATE.
310 07 TSED-CENTURY, PICTURE 99.
320 07 TSED-YEAR, PICTURE 99.
330 07 TSED-MONTH, PICTURE 99.
340 07 TSED-DAY, PICTURE 99.
350 05 TS-AMOUNT, PICTURE S9(7)V99, COMP-3.
360 05 TS-DESCR, PICTURE X(50).
380 01 CHARGE-SEGMENT.
390 03 CS-TRAN-CODE, PICTURE XXX.
400 03 CS-POST-DATE, PICTURE X(8).
410 03 CS-EFFECTIVE-DATE, PICTURE X(8).
420 03 CS-AMOUNT, PICTURE S9(7)V99, COMP-3.
430 03 CS-DESCR, PICTURE X(50).
450 01 MESSAGE1.
460 03 FILLER, PICTURE X, VALUE SPACE.
470 03 M1-BANK-NBR, PICTURE XXX, VALUE '000'.
480 03 FILLER, PICTURE X, VALUE '-'.
490 03 M1-MERCHANT-NBR, PICTURE 999.
500 03 FILLER, PICTURE X, VALUE '-'
510 03 M1-CUSTOMER-NBR, PICTURE 9999.
520 03 FILLER, PICTURE X, VALUE '-'.
530 03 M1-CHECK-DIGIT, PICTURE 9.
540 03 FILLER, PICTURE XX, VALUE SPACES.
550 03 M1-MSG-AREA, PICTURE X(40), VALUE SPACES.
580 COPY ARF020.
610*************************************************************
620* M A I N L I N E C O N T R O L R O U T I N E S *
630*************************************************************
650 PROCEDURE DIVISION.
670 HOUSEKEEPING-ROUTINE.
680 MOVE SPACES TO TRAN-INPUT-AREA.
690 OPEN INPUT FILE1.
700 OPEN I-O FILE2.
710 IF R2-STATUS-CODE IS OKAY, NEXT SENTENCE,
720 ELSE GO TO ERROR-4.
730 OPEN OUTPUT FILE3.
740 READ FILE1 INTO TRAN-INPUT-AREA, AT END GO TO ERROR-1.
750 PERFORM BUILD-TRANSACTION-RECORD.
760 GO TO A2.
780 INPUT-CONTROL-ROUTINE.
790 A1. READ FILE1 INTO TRAN-INPUT-AREA, AT END GO TO B1.
800 PERFORM BUILD-TRANSACTION-RECORD.
810 IF TR-RECORD-KEY = BREAK-CONTROL GO TO A3.
830 CONTROL-BREAK-ROUTINE.
840 MOVE ZEROS TO R2-BANK-NBR,
850 MOVE BC-MERCHANT-NBR TO R2-MERCHANT-NBR,
860 MOVE BC-CUSTOMER-NBR TO R2-CUSTOMER-NBR,
870 MOVE BC-CHECK-DIGIT TO R2-CHECK-DIGIT.
880 READ FILE2 INTO CUSTOMER-RECORD.
890 IF R2-STATUS IS OKAY, NEXT SENTENCE,
900 ELSE GO TO ERROR-2.
910 PERFORM UPDATE-CUSTOMER-RECORD THRU T3.
920 REWRITE RECORD2 FROM CUSTOMER-RECORD.
930 IF R2-STATUS IS OKAY, NEXT SENTENCE,
940 ELSE GO TO ERROR-3.
950 A2. MOVE SPACES TO TRANSACTION-SEGMENTS, CHARGE-SEGMENT.
960 MOVE TR-RECORD-KEY TO BREAK-CONTROL.
970 IF EOF-FLAG = 'X' GO TO B2.
990 EXTRACT-PAYMENTS-ADJUSTMENTS.
002000 A3. MOVE TR-DATE TO WD-YYMMDD.
002010 IF TR-TRAN-CODE = 950 GO TO A5.
002020 IF TR-TRAN-CODE = 970 GO TO A4.
002030 IF TR-TRAN-CODE = 973 GO TO A4.
002040 IF TR-TRAN-CODE = 975 GO TO A4, ELSE GO TO A1.
002050 A4. PERFORM SHIFT-TRANSACTION-SEGMENTS.
002060 MOVE WORKING-DATE TO TS-POST-DATE (4).
002070 MOVE WORKING-DATE TO TS-EFFECTIVE-DATE (4).
002080 MOVE TR-AMOUNT TO TS-AMOUNT.
002090 IF TR-TRAN-CODE = 970 MOVE '740' TO TS-TRAN-CODE (4),
002100 ELSE IF TR-TRAN-CODE = 973 MOVE '770' TO TS-TRAN-CODE (4),
002110 ELSE MOVE '790' TO TS-TRAN-CODE (4).
002120 MOVE TR-COMMENT TO TS-DESCR (4), GO TO A1.
002140 EXTRACT-CHARGE-TRANSACTION.
002150 A5. MOVE '640' TO CS-TRAN-CODE.
002160 MOVE WORKING-DATE TO CS-POST-DATE, CS-EFFECTIVE-DATE.
002170 MOVE TR-AMOUNT TO CS-AMOUNT.
002180 MOVE TR-COMMENT TO CS-DESCR.
002190 GO TO A1.
002210 END-OF-JOB-ROUTINE.
002220 B1. CLOSE FILE1.
002230 MOVE 'X' TO EOF-FLAG, GO TO CONTROL-BREAK-ROUTINE.
002240 B2. CLOSE FILE2, FILE3.
002250 STOP RUN.
002280*************************************
002290* E R R O R R O U T I N E S *
002300*************************************
002320 ERROR-1.
002330 MOVE ' INPUT TRANSACTIONS FILE CONTAINS NO DATA'
002340 TO PRINTLINE.
002350 WRITE PRINTLINE, GO TO B2.
002370 ERROR-2.
002380 PERFORM LOAD-MESSAGE-HEADER.
002390 MOVE ' CUSTOMER RECORD NOT FOUND ' TO M1-MSG-AREA.
002400 WRITE PRINTLINE FROM MESSAGE1.
002410 GO TO A2.
002430 ERROR-3.
002440 PERFORM LOAD-MESSAGE-HEADER.
002450 MOVE ' CANNOT REWRITE CUSTOMER RECORD' TO M1-MSG-AREA.
002460 WRITE PRINTLINE FROM MESSAGE1.
002470 GO TO A2.
002490 ERROR-4.
002500 MOVE ' CANNOT OPEN CUSTOMER FILE' TO PRINTLINE.
002510 WRITE PRINTLINE.
002520 MOVE ' PROGRAM ABORTING' TO PRINTLINE.
002530 WRITE PRINTLINE.
002540 STOP RUN.
002570***************************************************
002580* P E R F O R M E D S U B R O U T I N E S *
002590***************************************************
002610 LOAD-MESSAGE-HEADER.
002620 MOVE BC-MERCHANT-NBR TO M1-MERCHANT-NBR.
002630 MOVE BC-CUSTOMER-NBR TO M1-CUSTOMER-NBR.
002640 MOVE BC-CHECK-DIGIT TO M1-CHECK-DIGIT.
002660 SHIFT-TRANSACTION-SEGMENTS.
002670 MOVE TRANSACTION-SEGMENT (2)
002680 TO TRANSACTION-SEGMENT (1).
002690 MOVE TRANSACTION-SEGMENT (3)
002700 TO TRANSACTION-SEGMENT (2).
002710 MOVE TRANSACTION-SEGMENT (4)
002720 TO TRANSACTION-SEGMENT (3).
002730 MOVE SPACES TO TRANSACTION-SEGMENT (4).
BUILD-TRANSACTION-RECORD.
MOVE TIA-SEG-1 TO NCF-1A,
MOVE NCF-21 TO NCF-3.
MOVE NCF-4A TO TR-MERCHANT-NBR.
MOVE NCF-4B TO TR-CUSTOMER-NBR.
MOVE NCF-4C TO TR-CHECK-DIGIT.
MOVE TIA-SEG-2 TO NCF-5.
MOVE NCF-6A TO TR-DATE.
MOVE NCF-6B TO TR-TRAN-CODE.
MOVE TIA-AMT TO TR-AMOUNT.
MOVE TIA-DESCR TO TR-COMMENT.
MOVE SPACES TO TRAN-INPUT-AREA.
00070 UPDATE-CUSTOMER-RECORD.
00080 IF CS-TRAN=CODE = SPACES GO TO S1.
00090 MOVE CHARGE-SEGMENT TO MONETARY-TRANSACTION-TABLE (1).
031000 MOVE +1 TO MONETARY-TRANSACTION-NBR-OCCURS.
031010 MOVE +2 TO SS2, GO TO S2.
031020 S1. MOVE +1 TO SS2.
031030 S2. MOVE +1 TO SS1, GO TO T2.
031040 T1. ADD +1 TO SS1.
IF SS1 IS GREATER THAN +4 GO TO T3.
T2. IF TS-TRANCODE (SS1) = SPACES GO TO T1.
031070 MOVE TRANSACTION-SEGMENT (SS1)
031080 TO MONETARY-TRANSACTION-TABLE (SS2).
031090 MOVE SS2 TO MONETARY-TRANSACTION-NBR-OCCURS.
003000 ADD +1 TO SS2, GO TO T1.
003010 T3. EXIT.