IN-TRANSACTION-FUNCTION (op-code 21)

This routine returns a value indicating whether or not the program is currently in an unfinished transaction. The return value is 1 if there is current and unfinished transaction, 0 otherwise. This routine has no parameters.

Example

The following program opens a file, determines the number of records in the file, and then reads each of those records, printing out the size of each record found.

This example makes heavy use of variables found in filesys.def.

IDENTIFICATION DIVISION.
PROGRAM-ID.  EXAMPLE.

DATA DIVISION.

WORKING-STORAGE SECTION.

* Assume that we already know the maximum record size, minimum
* record size and the number of keys in the file.

78 MAX-SIZE    VALUE 1000.
78 MIN-SIZE    VALUE 100.
78 KEY-COUNT   VALUE 1.

COPY "filesys.def".

77  FILE-HANDLE               USAGE POINTER.
01  RECORD-AREA.
    03 OCCURS MAX-SIZE TIMES  PIC X.

PROCEDURE DIVISION.
MAIN-LOGIC.
* Open the file
    SET OPEN-FUNCTION TO TRUE.
    MOVE MAX-SIZE TO MAX-REC-SIZE.
    MOVE MIN-SIZE TO MIN-REC-SIZE.
    MOVE KEY-COUNT TO NUM-KEYS.
    MOVE Finput TO OPEN-MODE.
    CALL "I$IO" USING IO-FUNCTION, "MYFILE", OPEN-MODE,
                LOGICAL-INFO.
    IF RETURN-CODE = ZERO
        DISPLAY "Could not open file, error code = ", F-ERRNO,
                CONVERT
        STOP RUN.
    MOVE RETURN-CODE TO FILE-HANDLE.
* Now get the record count
    SET INFO-FUNCTION TO TRUE.
    SET GET-RECORD-COUNT TO TRUE.
    CALL "I$IO" USING IO-FUNCTION, FILE-HANDLE, INFO-MODE,
                RECORD-COUNT-INFO.
    IF E-NO-SUPPORT
        DISPLAY "File system cannot determine record count"
        PERFORM CLOSE-FILE
        STOP RUN.
* Read each record
    SET NEXT-FUNCTION TO TRUE
    PERFORM NUMBER-OF-RECORDS TIMES
        CALL "I$IO" USING IO-FUNCTION, FILE-HANDLE, RECORD-AREA
        IF RETURN-CODE = ZERO
        DISPLAY "Error reading record, code = ", F-ERRNO,
                 CONVERT
        PERFORM CLOSE-FILE
        STOP RUN
        ELSE
        DISPLAY "Record size = ", RETURN-CODE, CONVERT, LEFT
        END-IF
    END-PERFORM.
* All done
    PERFORM CLOSE-FILE.
    STOP RUN.

CLOSE-FILE.
    SET CLOSE-FUNCTION TO TRUE.
    CALL "I$IO" USING IO-FUNCTION, FILE-HANDLE.