COBOL use EXTFH handler to access dataset

This is sample usage of EXTFH handler to access a file.

Access an Index File

• READ-KEY
• READ-RBA

       IDENTIFICATION   DIVISION.
       PROGRAM-ID.      READIDXF16.
       ENVIRONMENT      DIVISION.
       INPUT-OUTPUT     SECTION.
       FILE-CONTROL.
      $set fcdreg
         SELECT MW-ENTREE ASSIGN TO "DATA.IDX.F16"
            ORGANIZATION IS INDEXED
            ACCESS MODE IS DYNAMIC
            RECORD KEY IS S-ID
            FILE STATUS IS IO-STATUS.

       DATA DIVISION.
       FILE SECTION.
         FD  MW-ENTREE
             LABEL RECORD STANDARD
             DATA RECORD DATAF16-REC.
         01 DATAF16-REC.
             03 S-ID     PIC X(02).
             03 S-NAME   PIC X(04).
             03 S-VALUE  PIC X(10).

       WORKING-STORAGE SECTION.
         COPY EXTFHOPS.
         01  IO-STATUS          PIC XX.

       LINKAGE SECTION.
         01 FCD.     COPY "XFHFCD.CPY".

       PROCEDURE DIVISION.
            SET ADDRESS OF FCD TO ADDRESS OF FH--FCD OF MW-ENTREE.
            MOVE Cobol-Type          TO Action-Type.

            OPEN INPUT MW-ENTREE.
            IF IO-STATUS NOT = "00"
                DISPLAY "OPEN INPUT FAILED"
                DISPLAY "IO-STATUS =" IO-STATUS
                GO TO FIN-REL
            END-IF.

            DISPLAY "------------READ SEQUENTIAL------------".
         READ-SEQUENTIAL.
            MOVE SPACES TO DATAF16-REC.
            READ MW-ENTREE NEXT
              AT END GO TO READ-KEY
            END-READ.
            PERFORM DISPLAY-RECORD THRU E-DISPLAY-RECORD.
            GO TO READ-SEQUENTIAL.

         READ-KEY.
            MOVE "33" TO S-ID
            DISPLAY "------------READ KEY(" S-ID ")------------".
            MOVE Read-Random TO Cobol-Op
            CALL "EXTFH" USING Action-Code FCD.
            MOVE FCD-File-Status TO IO-STATUS.
            IF IO-STATUS NOT = "00"
              DISPLAY "READ FAILED"
              DISPLAY "IO-STATUS =" IO-STATUS
              GO TO FIN-REL
            END-IF.
            PERFORM DISPLAY-RECORD THRU E-DISPLAY-RECORD.

         READ-RBA.
            MOVE 34 TO FCD-Reladdr-Offset.
            DISPLAY "------------READ RBA(" FCD-Reladdr-Offset
                    ")------------".
            MOVE Read-Direct TO Cobol-Op
            CALL "EXTFH" USING Action-Code FCD.
            MOVE FCD-File-Status TO IO-STATUS.
            IF IO-STATUS NOT = "00"
              DISPLAY "READ FAILED"
              DISPLAY "IO-STATUS =" IO-STATUS
              GO TO FIN-REL
            END-IF.
            PERFORM DISPLAY-RECORD THRU E-DISPLAY-RECORD.
 
         FIN-REL.
            CLOSE MW-ENTREE.
      
            EXIT PROGRAM.
            STOP RUN.

         DISPLAY-RECORD.
           DISPLAY "RECORD" ": S-ID=" S-ID
                            ", S-NAME=" S-NAME
                            ", S-VALUE=" S-VALUE
                            ", RBA=" FCD-Reladdr-Offset.
         E-DISPLAY-RECORD.
           EXIT.

Access a Sequential File

• OPEN FILE
• CLOSE FILE
• READ RECORD
• WRITE RECORD
• REWRITE RECORD

       IDENTIFICATION DIVISION.
       PROGRAM-ID.  EXTFHDEM.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  External-File-Handler           PIC x(08) VALUE 'EXTFH'.
       copy EXTFHOPS.

       01  FCD-Area.                       copy XFHFCD.CPY.
       01  File-Name                       PIC x(64).
       01  File-Name-Len                   PIC 9(04) comp-x.
      *-----Record Area-----*
       01  Record-Area.
           03 S-ID    PIC X(02).
           03 S-NAME  PIC X(04).
           03 S-VALUE PIC X(08).
      *-----Local Variable----*
       01  RBA                             PIC 9(9).

       PROCEDURE DIVISION.
       0000-Main.
           move 'DATA.SEQ.V14'      to File-Name.
           move 12                  to File-Name-Len.

           move Low-Values          to FCD-Area.
           move Low-Values          to Action-Code.

           move File-Name-Len       to FCD-Name-Length.
           set FCD-Filename-Address to address of File-Name.

           set FCD-Record-Address   to address of Record-Area.

           move 1                   to FCD-Version.

           move 1                   to FCD-Organization.
      *         0 - Line sequential
      *         1 - Sequential
      *         2 - Indexed
      *         3 - Relative

           move 0                   to FCD-Access-Mode.
      *         0   Sequential access mode
      *         4   Random access mode
      *         8   Dynamic access mode
           move 1                   to FCD-Recording-Mode.
      *         0    Fixed
      *         1    Variable
           move 128                 to FCD-Open-Mode.
      *         0   Open for input
      *         1   Open for output
      *         2   Open for input and output
      *         3   EXTEND
      *         128 File is closed
           move 14                  to FCD-Max-Rec-Length.
           move 1                   to FCD-Min-Rec-Length.

           display "----Open File I/O----".
           perform 1000-Open-File-I-O.
           perform 2000-Read-Record.
           perform 3000-Rewrite-Record.
           perform 2000-Read-Record.
           perform 5000-Close-File.


           display "----Open File Extend----".
           perform 1000-Open-File-Extend.
           perform 4000-Write-Record.
           perform 5000-Close-File.


           display "----Open File I/O RBA----".
           perform 1000-Open-File-I-O.
           perform 2000-Read-Record-RBA.
           perform 5000-Close-File.

           stop run.

      *--------------------------------*
       1100-Call-Extfh.
      *--------------------------------*
           call External-File-Handler using Action-Code
                                            FCD-Area.
           if FCD-File-Status not = '00'
               if FCD-Status-Key-1 = '9'
                   display "File Error, status: 9/" FCD-Binary
               else
                   display "File Error, status: " FCD-File-Status
               end-if
               goback
           end-if.

      *--------------------------------*
       1000-Open-File-I-O.
      *--------------------------------*
           move Cobol-Type          to Action-Type.
           move Open-I-O            to Cobol-Op.

           perform 1100-Call-Extfh.
       
      *--------------------------------*
       1000-Open-File-Extend.
      *--------------------------------*
           move Cobol-Type          to Action-Type.
           move Open-Extend         to Cobol-Op.

           perform 1100-Call-Extfh.
 
      *--------------------------------*
       2000-Read-Record.
      *--------------------------------*
           initialize Record-Area.

           move Cobol-Type          to Action-Type.
           move Read-Seq            to Cobol-Op.
           perform 1100-Call-Extfh.
           display 'Read:LEN=' FCD-Current-Rec-Len
                   ",S-ID=" S-ID
                   ",S-NAME=" S-NAME
                   ",S-VALUE=" S-VALUE
                   ",RBA=" FCD-Reladdr-Offset.

      *--------------------------------*
       2000-Read-Record-RBA.
      *--------------------------------*
           initialize Record-Area.
      *    move 0 to RBA.
           move RBA to FCD-Reladdr-Offset.
           move 64 to FCD-Config-Flags.
      *     Bit 7    - WRITETHRU 
      *     Bit 6    - Use Relative Byte Address 
      *     Bit 5    - Update current record pointer
      *     Bit 4    - Use offset 13 for relative byte address,
      *                instead of offset 72
      *     Bits 3-2 - Reserved
      *     Bit 1    - Check COBFSTATCONV
      *     Bit 0    - Set if IGNORELOCK required

           DISPLAY "READ FROM RBA=" FCD-Reladdr-Offset.
           move Cobol-Type          to Action-Type.
           move Read-Random         to Cobol-Op.
           perform 1100-Call-Extfh.
           display 'Read:LEN=' FCD-Current-Rec-Len
                   ",S-ID=" S-ID
                   ",S-NAME=" S-NAME
                   ",S-VALUE=" S-VALUE
                   ",RBA=" FCD-Reladdr-Offset.

      *--------------------------------*
       3000-Rewrite-Record.
      *--------------------------------*
           move "55"                to S-ID.
           move "XXXX"              to S-NAME.
           move "xxxxxxxx"          to S-VALUE.
           move 14                  to FCD-Current-Rec-Len.

           move Cobol-Type          to Action-Type.
           move Rewrite-Record      to Cobol-Op.
           perform 1100-Call-Extfh.

      *--------------------------------*
       4000-write-Record.
      *--------------------------------*
           move "44"                to S-ID.
           move "DDDD"              to S-NAME.
           move "dddddddddd"        to S-VALUE.
           move 14                  to FCD-Current-Rec-Len.

           move Cobol-Type          to Action-Type.
           move Write-Record        to Cobol-Op.
           perform 1100-Call-Extfh.
           display "Write Record Return RBA=" FCD-Reladdr-Offset.
           move FCD-Reladdr-Offset  to RBA.
 
      *--------------------------------*
       5000-Close-File.
      *--------------------------------*
           move Cobol-Type          to Action-Type.
           move Close-File          to Cobol-Op.
           perform 1100-Call-Extfh.
      *--------------------------------*