Qur'an – Bible.

* Religion * Politics * News Networks * Mainstream Media Biased Reporting * Independent Analysis

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
About these ads

7 Responses to “Sample COBOL Program – Indexed File Update.”

  1. m.satheesh said

    it is usefull information gather from student.

  2. 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.

    • prashanth said

      i need cobol programs which include all their functions in one program…
      arrays with perform,
      file handling ,
      ksds,
      using dynamic,
      sub programs,
      call,
      sort…
      pls post me this pgm….
      thanks

  3. 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?

  4. 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.

  5. tamanna said

    question: program to create auto generation of number? i am doing project where i have to do add emp-code where when i add 1 entry next time emp-code is automatically generted?

    • QB said

      Tamana the easy way to do it to keep your last Employee ID in a file, this file will have Employee ID field and only one record last employee id.

      When user use add option than read this file which only will have one record, compute your next Employee ID move it to Employee ID file and update the record.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

 
Follow

Get every new post delivered to your Inbox.

%d bloggers like this: