An overview of the specific changes made to make it run using GnuCOBOL

Since DCLGEN isn't the same on IBM DB2 LUW, create that

      ***** Convert to GnuCOBOL
      ***** Start of Step 1
      *     No DCLGEN member to INCLUDE
      *     Comment this INCLUDE out
      *    EXEC SQL
      *        INCLUDE CUSTOMER
      *    END-EXEC.
      *
      *     Add DECLARE TABLE
           EXEC SQL
           DECLARE CUSTOMERS TABLE
           (
            CUSTNO        CHAR(6) not null,
               FNAME         CHAR(20) not null,
               LNAME         CHAR(30) not null,
               ADDR          CHAR(30) not null,
               CITY          CHAR(20) not null,
               STATE         CHAR(2) not null,
               ZIPCODE       CHAR(10) not null)
           END-EXEC.

      *     Add DECLARE SECTION
           EXEC SQL BEGIN DECLARE SECTION END-EXEC.
       01  Customer-Row.
           12 CUSTNO     PIC X(06).
           12 FNAME      PIC X(20).
           12 LNAME      PIC X(30).
           12 ADDR       PIC X(30).
           12 CITY       PIC X(20).
           12 STATE      PIC X(02).
           12 ZIPCODE    PIC X(10).

      *    This is hardcoded for the MURACH DB.
      *    You might need to update this for your DB.
       01  DB-Connection-Info.
           12 DB-Alias                PIC X(8) VALUE 'MURACH'.
           12 DB-User-ID              PIC X(10).
           12 DB-Password.
              15 DB-Passwd-Length     PIC S9(4) COMP-5  VALUE 0.
              15 DB-Passwd-Name       PIC X(18).
           EXEC SQL END DECLARE SECTION END-EXEC.

      *     Add status check for connection info.
       01  WS-SQL-STATUS                PIC S9(9) COMP-5.
           88 SQL-STATUS-OK             VALUE    0.
           88 SQL-STATUS-NOT-FOUND      VALUE  100.
           88 SQL-STATUS-DUP            VALUE -803.

      ***** End of Step 1

Add the PERFORM paragraph

       000-DISPLAY-CUSTOMER-ROWS.
      *     Step 2
      *     Add Paragraph to connect to the DB
           PERFORM 9800-Connect-to-DB1.
      *
           PERFORM 100-DISPLAY-CUSTOMER-ROW
               UNTIL END-OF-INQUIRIES.
           STOP RUN.

Then add the 9800-Connect-to DB1 and friends paragraphs

      *     Step 2 - the actual connection.
       9800-Connect-to-DB1.
           PERFORM 9810-Setup-DB1-Connection.
           IF SQL-STATUS-OK
              CONTINUE
           ELSE
              DISPLAY "*** The DB connection is not valid!***"
              DISPLAY "Exiting the program.!"
              GOBACK
           END-IF.

       9810-Setup-DB1-Connection.
           PERFORM 9811-Get-Credentials.
           PERFORM 9812-Create-Connection-To-DB1.

       9811-Get-Credentials.
           DISPLAY "CUSTINQ: Need userid and password".

           DISPLAY "Enter your user id (default none): "
                WITH NO ADVANCING.
           ACCEPT DB-User-ID.

           DISPLAY "Enter your password : " WITH NO ADVANCING
           ACCEPT DB-Passwd-Name.

      * Passwords in a CONNECT statement must be entered in a VARCHAR
      * format with the length of the input string.
           INSPECT DB-Passwd-Name
              TALLYING DB-Passwd-Length
              FOR CHARACTERS BEFORE INITIAL " ".

       9812-Create-Connection-To-DB1.
           PERFORM 9814-Connect-To-DB1
           IF SQL-STATUS-OK
              CONTINUE
           ELSE
              DISPLAY "CUSTINQ: userid and/or password invalid"
              DISPLAY "CUSTINQ: Can not connect, exiting"
              GOBACK
           END-IF.

       9814-Connect-To-DB1.
           EXEC SQL CONNECT TO :DB-Alias
                USER :DB-User-ID
                USING :DB-Passwd-Name
              END-EXEC.
           MOVE SQLCODE TO WS-SQL-STATUS.