Skip to content

USE Statement

The USE statement determines the error handling that takes place inside the DECLARATIVES section of the PROCEDURE DIVISION.

General Format:

       USE [GLOBAL] AFTER STANDARD {EXCEPTION} PROCEDURE ON {{file-1 }... } 
                                   {ERROR    }              { INPUT  } 
                                                            { OUTPUT } 
                                                            { I-O    } 
                                                            { EXTEND }

Syntax:

  1. file is a data file described in the FILE Section.
  2. The USE statement may only be used in the DECLARATIVES section of the PROCEDURE DIVISION.
  3. file-n is a file described in the File Section with an FD.

General Rules:

  1. The USE AFTER STANDARD ERROR PROCEDURE clause includes statements to be executed in the event of file errors if programmatic phrases have not been included to handle the file error conditions inline. Such programmatic phrases include the AT END and INVALID KEY phrases. In each of these cases, the statement lists that are executed when the file error conditions are triggered are listed after the AT END/INVALID KEY phrase.
  2. AT END conditions are identified with FILE STATUS conditions whose first byte is “1”. INVALID KEY conditions are identified with FILE STATUS conditions whose first byte is “2”. FILE STATUS conditions whose first byte is “0” are considered to be successful I-O operations.
  3. The USE AFTER STANDARD ERROR PROCEDURE clause can be associated with file errors in specific files, as represented by the file-1 notation in the General Format, or with specific I-O types, as represented by the INPUT, OUTPUT, I-O, and EXTEND notations in the General Format.
  4. If a specific file is named in the USE clause, then the following statement list is executed when an unsuccessful file operation is returned for that file.
  5. After the statement list associated with an unsuccessful file operation has been executed, control returns to the statement after the statement that caused the unsuccessful file operation.
  6. Unsuccessful file operations are any file operations that return a value to the FILE STATUS variable described in the SELECT statement of the file, where the first byte of the FILE STATUS variable is greater than zero.
  7. If a specific file is named in the USE clause, this takes precedence over the more general association with specific I-O types. That is, if there is a USE AFTER STANDARD ERROR PROCEDURE FOR file-1 statement, and a USE AFTER STANDARD ERROR PROCEDURE FOR INPUT statement, and file-1 is OPEN INPUT and returns a file error, the USE AFTER STANDARD ERROR PROCEDURE FOR file-1 clause will take precedence over the USE AFTER STANDARD ERROR PROCEDURE ON INPUT clause.
  8. The USE GLOBAL phrase allows the err or handling described by the USE statement to be applicable in all of the programs in the entire compilation unit.
  9. EXCEPTION and ERROR are synonyms.
  10. The statements that can generate unsuccessful file operations are CLOSE, DELETE, OPEN, READ, REWRITE, START, UNLOCK, and WRITE.

Code Sample:

       IDENTIFICATION DIVISION. 
       PROGRAM-ID. USE-1 
       ENVIRONMENT DIVISION. 
       INPUT-OUTPUT SECTION. 
              SELECT CUSTFILE ASSIGN TO "CUSTOMER" 
              ORGANIZATION IS INDEXED 
              ACCESS IS DYNAMIC 
              RECORD KEY IS CUSTOMER-ID 
              FILE STATUS IS CUSTOMER-STAT. 
       DATA DIVISION. 
       FILE SECTION. 
       FD CUSTFILE. 
       01 CUSTOMER-RECORD. 
              03 CUSTOMER-ID PIC 9(5). 
              03 CUSTOMER-NAME PIC X(25). 
              03 CUSTOMER-ADDR PIC X(25). 
              03 CUSTOMER-CITY PIC X(25). 
              03 CUSTOMER-STATE PIC XX. 
              03 CUSTOMER-PHONE PIC X(10). 

       WORKING-STORAGE SECTION. 
       77 CUSTOMER-STAT PIC XX. 
       77 DUMMY PIC X. 

       PROCEDURE DIVISION. 
       DECLARATIVES. 
       USE-1-ERR-HANDLING SECTION. 
              USE AFTER STANDARD ERROR PROCEDURE ON CUSTFILE. 
       CUSTFILE-ERR. 
              DISPLAY "USE AFTER STANDARD ERROR ON [FILENAME]" 
                     LINE 8 COL 10. 

              DISPLAY "FILE STATUS: " LINE 10 COL 10. 
              DISPLAY CUSTOMER-STAT LINE 10 COL 24. 
              ACCEPT DUMMY LINE 10 COL 30. 
              DISPLAY "USE-1 FINISHED!" LINE 12 COL 10. 
              STOP RUN. 
       END DECLARATIVES. 
       MAIN. 
              OPEN OUTPUT CUSTFILE. 
              MOVE 11111 TO CUSTOMER-ID. 
              MOVE "JOHN SMITH" TO CUSTOMER-NAME. 
              MOVE "101 MAIN ST" TO CUSTOMER-ADDR. 
              MOVE "SAN DIEGO" TO CUSTOMER-CITY. 
              MOVE "CA" TO CUSTOMER-STATE. 
              MOVE "6195551212" TO CUSTOMER-PHONE. 
              WRITE CUSTOMER-RECORD. 

              MOVE 11111 TO CUSTOMER-ID. 
              MOVE "JOHN SMITH" TO CUSTOMER-NAME. 
              MOVE "101 MAIN ST" TO CUSTOMER-ADDR. 
              MOVE "SAN DIEGO" TO CUSTOMER-CITY. 
              MOVE "CA" TO CUSTOMER-STATE. 
              MOVE "6195551212" TO CUSTOMER-PHONE. 
              WRITE CUSTOMER-RECORD. 

              STOP RUN.
Back to top