FILE READ Statement


READ statement is used to retrieve a record from the file. At a time, only one record is retrieved from the file.

Points to note -

  • The file should open in INPUT or I-O mode to perform the READ statement.
  • The READ statement is used for all types of (sequential, indexed and relative) files.
  • A simple READ statement is used when the ACCESS MODE is SEQUENTIAL or ACCESS MODE is RANDOM.

Syntax -

SEQUENTIAL Read (for sequential, indexed and relative files) -

READ logical-file-name  
    [INTO ws-record-name]
        [AT END statements-set1]
    [NOT AT END statements-set2]
[END-READ].

RANDOM Read (for indexed and relative files) -

READ logical-file-name  
    [INTO ws-record-name]
	[KEY IS key-variable]
        [INVALID KEY statements-set3]
    [NOT INVALID KEY statements-set4]
[END-READ].
Note! All statements coded in [ ] are optional.

Parameters -

  • logical-file-name - Specifies the file from where the record is to be read.
  • INTO ws-record-name - Specifies the working-storage record name to where the record is retrieved. ws-record-name matches with the actual record layout.
  • KEY IS key-variable - Specifies the key value used to read the record for indexed and relative files.
  • END-READ - Specifies the end of the READ statement. END-READ is not required when a READ statement ends with a period.

Error Handling -

  • INVALID KEY - This phrase specifies the action to be taken if the record is not found (or if the key is invalid). The statements following INVALID KEY are executed in such cases. This is applicable to indexed or relative files.
  • NOT INVALID KEY - This phrase specifies the steps to be taken if the read is successful and the key is valid. This is applicable to indexed or relative files.
  • AT END - This phrase specifies the action to take if you're at the end of a file or no more records are left. It applies to sequential files only.
  • NOT AT END - This phrase specifies the action to perform when the read is successful and it's not the end of the file. It applies to sequential files only.
Note! If the FILE-STATUS clause is coded, the associated file status is updated when the READ statement is executed.

Practical Example -


Scenario - Reading all the records from a PS file.

Input file -

 BROWSE    MATESY.EMPLOYEE.INPFILE                    Line 00000000 Col 001 080 
 Command ===>                                                  Scroll ===> CSR  
----+----1----+----2----+----3----+----4----+----5----+----6----+----7----+----8
********************************* Top of Data **********************************
E0001EMPLOYEE1      MANAGER   0000200000
E0002EMPLOYEE2      TL        0000150000
E0003EMPLOYEE3      SE        0000050000
E0004EMPLOYEE4      SSE       0000040000
E0005EMPLOYEE5      SE        0000045000
******************************** Bottom of Data ********************************

Code -

----+----1----+----2----+----3----+----4----+
       IDENTIFICATION DIVISION.
       PROGRAM-ID. SEQREAD.

       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
           SELECT EMPFILE ASSIGN TO INPUT01 
           ORGANIZATION IS SEQUENTIAL
           ACCESS MODE  IS SEQUENTIAL 
           FILE STATUS  IS WS-FS1.

       DATA DIVISION.
       FILE SECTION.
       FD EMPFILE  
           RECORD CONTAINS 80  CHARACTERS 
           BLOCK  CONTAINS 800 CHARACTERS 
           RECORDING MODE  IS  F 
           DATA RECORD     IS EMPFILE-RECORD.

       01 EMPFILE-RECORD. 
          05 EMP-ID        PIC X(05).
          05 EMP-NAME      PIC X(15).
          05 EMP-DESG      PIC X(10). 
          05 EMP-SALARY    PIC 9(10). 
          05 FILLER        PIC X(40). 

       WORKING-STORAGE SECTION.
       01 WS-VAR.
          05 WS-FS1        PIC 9(02).
          05 WS-EOF-SW     PIC X(01).
             88 WS-EOF               VALUE 'Y'.
             88 WS-NOT-EOF           VALUE 'N'.

       PROCEDURE DIVISION.

           OPEN INPUT EMPFILE. 
 
           SET  WS-NOT-EOF      TO  TRUE.
           PERFORM UNTIL WS-EOF
                READ EMPFILE 
                         AT END SET WS-EOF TO TRUE
                     NOT AT END DISPLAY EMPFILE-RECORD
                END-READ
           END-PERFORM.
 
           CLOSE EMPFILE. 
           STOP RUN.

Run JCL -

//MATESYF JOB MSGLEVEL=(1,1),NOTIFY=&SYSUID
//*                                                 
//STEP01  EXEC PGM=SEQFILE
//STEPLIB  DD  DSN=MATESY.COBOL.LOADLIB,DISP=SHR
//INPUT01  DD  DSN=MATESY.EMPLOYEE.INPFILE,DISP=SHR 
//SYSOUT   DD  SYSOUT=*

Output -

E0001EMPLOYEE1      MANAGER   0000200000
E0002EMPLOYEE2      TL        0000150000
E0003EMPLOYEE3      SE        0000050000
E0004EMPLOYEE4      SSE       0000040000
E0005EMPLOYEE5      SE        0000045000