Sample COBOL Program – Indexed File Update.
Posted by QB on November 21, 2007
000010 IDENTIFICATION DIVISION. 000020********************************************************************************** 000030* This program reads Agency file and update records on Accounts * 000040* Index File. There are two types of records on this file. * 000050* Deposits and withdrawal. Deposits cannot exceed 30000 and * 000060* withdrawal must be equal to or less than the deposit amount. * 000070* Records meeting this criteria will be updated on Account Index * 000080* file rejecting records which do not meet this criteria. * 000090********************************************************************************* 000100 PROGRAM-ID. PRFOURC. 000110 AUTHOR. QB. 000120 ENVIRONMENT DIVISION. 000130 CONFIGURATION SECTION. 000140 INPUT-OUTPUT SECTION. 000150 FILE-CONTROL. 000160 SELECT AGENCY-FILE ASSIGN TO "AGENCY.DAT" 000170 ORGANIZATION IS SEQUENTIAL. 000180 SELECT ACCOUNT-INDEXED-FILE ASSIGN TO "ACCOUNTIDX.DAT" 000190 ORGANIZATION IS INDEXED 000200 ACCESS MODE IS DYNAMIC 000210 RECORD KEY IS ACCT-NO. 000220 DATA DIVISION. 000230 FILE SECTION. 000240 FD AGENCY-FILE. 000250 01 AGENCY-RECORD. 000260 05 RECORD-TYPE PIC X. 000270 05 ACCOUNT-NO PIC X(7). 000280 05 AMT PIC 9(4)V99. 000290 FD ACCOUNT-INDEXED-FILE. 000300 01 ACCOUNT-INDEXED-RECORD. 000310 05 ACCT-NO PIC X(7). 000320 05 ACCT-NAME PIC X(15). 000330 05 ACCT-BAL PIC 9(4)V99. 000340 05 TOT-DEPOSIT PIC 9(4)V99. 000350 WORKING-STORAGE SECTION. 000360 77 EOF PIC X(3) VALUE "NO ". 000370 77 RECORD-FOUND PIC X VALUE "N". 000380 01 WORKING-FIELDS. 000390 05 AMT-WORK PIC 9(4)V99. 000400 PROCEDURE DIVISION. 000410 MAIN-RTN. 000420 OPEN INPUT AGENCY-FILE. 000430 OPEN I-O ACCOUNT-INDEXED-FILE. 000440 PERFORM READ-TRANSACTIONS UNTIL EOF = "YES". 000450 000460 CLOSE AGENCY-FILE 000470 ACCOUNT-INDEXED-FILE. 000480 STOP RUN. 000490 READ-TRANSACTIONS. 000500 READ AGENCY-FILE NEXT RECORD AT END 000510 MOVE "YES" TO EOF. 000520*********************************************************************************** 000530* Set record found indicator ON before reading account index file. * 000540* Record found indicator will be turned OFF when record not found * 000550* on account indexed file. * 000560*********************************************************************************** 000570 MOVE "Y" TO RECORD-FOUND. 000580 MOVE ACCOUNT-NO TO ACCT-NO. 000590 READ ACCOUNT-INDEXED-FILE INVALID KEY 000600 MOVE "N" TO RECORD-FOUND. 000610 000620 IF EOF NOT = "YES" AND RECORD-FOUND = "Y" 000630 PERFORM CHECK-RECORD-TYPE. 000640 CHECK-RECORD-TYPE. 000650 IF RECORD-TYPE = "L" 000660 PERFORM UPDATE-DEPOSIT 000670 ELSE 000680 PERFORM UPDATE-WITHDRAWAL. 000690 UPDATE-DEPOSIT. 000700******************************************************************** 000710* Check the transation amount not exceeding 3000.00 * 000720******************************************************************** 000730 COMPUTE ACCT-BAL = ACCT-BAL + AMT. 000740 MOVE ACCT-BAL TO AMT-WORK. 000750 IF AMT-WORK < 3000.00 OR AMT-WORK = 3000.00 000760 REWRITE ACCOUNT-INDEXED-RECORD INVALID KEY 000770 DISPLAY "ERROR ON REWRITE". 000780 UPDATE-WITHDRAWAL. 000790************************************************************************************** 000800* In withdrawal case only check will be the withdrawal amount is less * 000810* or equal to account balance amount. * 000820************************************************************************************** 000830 IF AMT < ACCT-BAL OR AMT = ACCT-BAL 000840 COMPUTE ACCT-BAL = ACCT-BAL - AMT 000850 REWRITE ACCOUNT-INDEXED-RECORD INVALID KEY 000860 DISPLAY "ERROR ON REWRITE". 000870 Input File Agency. L1001000010000 W3167592050000 W2313140035050 L1000001217483 L3234577250000 W2000312190043
m.satheesh said
it is usefull information gather from student.
QB said
This program is written by me for student assignment. This program does not come from any student. If you have any questions regarding COBOL, RPG, RPG/ILE, CL, OS/400, don’t hesitate to ask.
holidaygal said
question: how does one add into a pc cobol program both in the Ws and procedure to redfine a YYYYDDD JULIAN to a Gregorian date?
QB said
You have to write conversion routine if you want to convert Date. This is something very easy to do if you are writing program on AS/400 by using the build in date conversion routine. The date conversion and date difference calculation is simple. Date conversion can be done in CL program with CVTDAT command. Calculating date difference can be done by ADDDUR or SUBDUR in RPG program.