PROGRAM-ID.  DYNAMIC-FRS.
       ENVIRONMENT DIVISION.
       DATA DIVISION.
       WORKING-STORAGE SECTION.

*      Include SQL Communications and Descriptor Areas
       EXEC SQL INCLUDE SQLCA END-EXEC.
       EXEC SQL INCLUDE SQLDA END-EXEC.
       
*      Dynamic SQL SELECT and INSERT statements (documentary only)
       EXEC SQL DECLARE sel_stmt STATEMENT END-EXEC.
       EXEC SQL DECLARE ins_stmt STATEMENT END-EXEC.

*      Cursor declaration for dynamic statement
       EXEC SQL DECLARE csr CURSOR FOR sel_stmt END-EXEC.

       EXEC SQL BEGIN DECLARE SECTION END-EXEC.

*      Database, form and table names
       01 DB-NAME        PIC X(40).
       01 FORM-NAME      PIC X(40).
       01 TABLE-NAME     PIC X(40).

*      Dynamic SQL SELECT and INSERT statement buffers
       01 SEL-BUF        PIC X(1000).
       01 INS-BUF        PIC X(1000).

*      Error status and prompt error return buffer
       01 ERR            PIC S9(8) USAGE COMP.
       01 RET            PIC X.

       EXEC SQL END DECLARE SECTION END-EXEC.

*      DESCRIBE-FORM (form profiler) return state
       01 DESCRIBED          PIC S9(4) USAGE COMP.
          88 DESCRIBE-FAIL   VALUE 0.
          88 DESCRIBE-OK     VALUE 1.

*      Index into SQLVAR table
       01 COLN               PIC S9(4) USAGE COMP.

*      Base data type of SQLVAR item without nullability
       01 BASE-TYPE          PIC S9(4) USAGE COMP.

*      Is a result column type nullable
       01 IS-NULLABLE        PIC S9(4) USAGE COMP.
          88 NOT-NULLABLE   VALUE 0.
          88 NULLABLE       VALUE 1.

*      Global result data storage.  This pool of data includes the
*      maximum number of data items needed to execute a dynamic
*      retrieval or insertion.  There is a table of 1024 integer,
*      decimal and null indicator data items, and a large
*      character string buffer from which sub-strings are
*      allocated.  Floating-point and money types are stored

*      in decimal variables.

       01 RESULT-DATA.
          02 ARRAY-STORAGE OCCURS IISQ-MAX-COLS TIMES.
              03 INTEGERS          PIC S9(9) USAGE COMP-5 SYNC.
              03 DECIMALS          PIC S9(10)V9(8) USAGE COMP-3.
              03 INDICATORS        PIC S9(4) USAGE COMP-5 SYNC.
          02 CHARS                PIC X(3000).
*      Total used length of data buffer
          02 CHAR-CNT             PIC S9(4) USAGE COMP VALUE 1.
*      Current length required from character data buffer
          02 CHAR-CUR             PIC S9(4) USAGE COMP.

*      Buffer for building Dynamic SQL statement string names
       01 NAMES                    PIC X(1000) VALUE SPACES.
       01 NAME-CNT                 PIC S9(4) USAGE COMP VALUE 1.

*      Buffer for collecting Dynamic SQL place holders
       01 MARKS                    PIC X(1000) VALUE SPACES.
       01 MARK-CNT                 PIC S9(4) USAGE COMP VALUE 1.

**

* Procedure Division: DYNAMIC-FRS
*
*     Main body of Dynamic SQL forms application.  Prompt for
*     database, form and table name.  Perform DESCRIBE-FORM
*     to obtain a profile of the form and set up the SQL
*     statements.  Then allow the user to interactively browse
*     the database table and append new data.
**

       PROCEDURE DIVISION.
       EXAMPLE SECTION.
       XBEGIN.

*      Turn on forms system
       EXEC FRS FORMS END-EXEC.

*      Prompt for database name - will abort on errors
       EXEC SQL WHENEVER SQLERROR STOP END-EXEC.
       EXEC FRS PROMPT ('Database name: ', :DB-NAME) END-EXEC.
       EXEC SQL CONNECT :DB-NAME END-EXEC.

       EXEC SQL WHENEVER SQLERROR CALL SQLPRINT END-EXEC.

*      Prompt for table name - later a Dynamic SQL SELECT
*      statement will be built from it.

       EXEC FRS PROMPT ('Table name: ', :TABLE-NAME) END-EXEC.

*      Prompt for form name.  Check forms errors through
*      INQUIRE_FRS.

       EXEC FRS PROMPT ('Form name: ', :FORM-NAME) END-EXEC.
       EXEC FRS MESSAGE 'Loading form ...' END-EXEC.
       EXEC FRS FORMINIT :FORM-NAME END-EXEC.
       EXEC FRS INQUIRE_FRS FRS (:ERR = ERRORNO) END-EXEC.
       IF (ERR > 0) THEN
            EXEC FRS MESSAGE 'Could not load form.
                   Exiting.' END-EXEC
            EXEC FRS ENDFORMS END-EXEC
            EXEC SQL DISCONNECT END-EXEC
            STOP RUN.
*      Commit any work done so far - access of forms catalogs
       EXEC SQL COMMIT END-EXEC.

*      Describe the form and build the SQL statement strings
       PERFORM DESCRIBE-FORM THROUGH END-DESCRIBE.
       IF (DESCRIBE-FAIL) THEN
           EXEC FRS MESSAGE 'Could not describe form.  Exiting.'
               END-EXEC
           EXEC FRS ENDFORMS END-EXEC
           EXEC SQL DISCONNECT END-EXEC
           STOP RUN.

*      PREPARE the SELECT and INSERT statements that correspond
*      to the menu items Browse and Insert.  If the Save menu item
*      is chosen the statements are reprepared.

       EXEC SQL PREPARE sel_stmt FROM :SEL-BUF END-EXEC.
       MOVE SQLCODE TO ERR.
       EXEC SQL PREPARE ins_stmt FROM :INS-BUF END-EXEC.
       IF (ERR < 0) OR (SQLCODE < 0) THEN
           EXEC FRS MESSAGE 
                'Could not prepare SQL statements.
                           Exiting.' END-EXEC
           EXEC FRS ENDFORMS END-EXEC
           EXEC SQL DISCONNECT END-EXEC
           STOP RUN.

*      Display the form and interact with user, allowing browsing
*      and the inserting of new data.

       EXEC FRS DISPLAY :FORM-NAME FILL END-EXEC
       EXEC FRS INITIALIZE END-EXEC
       EXEC FRS ACTIVATE MENUITEM 'Browse' END-EXEC
       EXEC FRS BEGIN END-EXEC

*      Retrieve data and display the first row on the form,
*      allowing the user to browse through successive rows.  If
*      data types from the database table are not consistent with
*      data descriptions obtained from the form, a retrieval
*      error will occur.  Inform the user of this or other errors.
*  

*      Note that the data will return sorted by the first field
*      that was described, as the SELECT statement, sel_stmt,
*      included an ORDER BY clause.

             EXEC SQL OPEN csr FOR READONLY END-EXEC.

*      Fetch and display each row
       FETCH-NEXT-ROW.
             IF (SQLCODE NOT= 0) THEN
                  GO TO END-FETCH-NEXT.

             EXEC SQL FETCH csr USING DESCRIPTOR :SQLDA END-EXEC.

             IF (SQLCODE NOT= 0) THEN
                  EXEC SQL CLOSE csr END-EXEC
                  EXEC FRS PROMPT NOECHO ('No more rows :', :RET)
                       END-EXEC
                  EXEC FRS CLEAR FIELD ALL END-EXEC
                  EXEC FRS RESUME END-EXEC.

             EXEC FRS PUTFORM :FORM-NAME USING DESCRIPTOR :SQLDA
                 END-EXEC.
             EXEC FRS INQUIRE_FRS FRS (:ERR = ERRORNO) END-EXEC.
             IF (ERR > 0) THEN
                  EXEC SQL CLOSE csr END-EXEC
                  EXEC FRS RESUME END-EXEC.

*      Display data before prompting user with submenu
             EXEC FRS REDISPLAY END-EXEC.

             EXEC FRS SUBMENU END-EXEC
             EXEC FRS ACTIVATE MENUITEM 'Next', FRSKEY4 END-EXEC
             EXEC FRS BEGIN END-EXEC
*      Continue with cursor loop
                  EXEC FRS MESSAGE 'Next row ...' END-EXEC.
                  EXEC FRS CLEAR FIELD ALL END-EXEC.

             EXEC FRS END END-EXEC
             EXEC FRS ACTIVATE MENUITEM 'End', FRSKEY3 END-EXEC
             EXEC FRS BEGIN END-EXEC
                 EXEC SQL CLOSE csr END-EXEC.
                 EXEC FRS CLEAR FIELD ALL END-EXEC.
                 EXEC FRS RESUME END-EXEC.

             EXEC FRS END END-EXEC

*      Fetch next row
             GO TO FETCH-NEXT-ROW.

*      End of row processing
       END-FETCH-NEXT.
             CONTINUE.

       EXEC FRS END END-EXEC
       EXEC FRS ACTIVATE MENUITEM 'Insert' END-EXEC
       EXEC FRS BEGIN END-EXEC
           EXEC FRS GETFORM :FORM-NAME USING DESCRIPTOR :SQLDA
                END-EXEC.
           EXEC FRS INQUIRE_FRS FRS (:ERR = ERRORNO) END-EXEC.
           IF (ERR > 0) THEN
                EXEC FRS CLEAR FIELD ALL END-EXEC
                EXEC FRS RESUME END-EXEC.

 

                EXEC SQL EXECUTE ins_stmt USING DESCRIPTOR :SQLDA
                   END-EXEC.
                IF (SQLCODE < 0) OR (SQLERRD(3) = 0) THEN
                EXEC FRS PROMPT NOECHO 
                     ('No rows inserted :', :RET) END-EXEC
           ELSE
                EXEC FRS PROMPT NOECHO
                    ('One row inserted :', :ret) END-EXEC.

        EXEC FRS END END-EXEC
        EXEC FRS ACTIVATE MENUITEM 'Save' END-EXEC
        EXEC FRS BEGIN END-EXEC

       EXEC FRS END END-EXEC
       EXEC FRS ACTIVATE MENUITEM 'Quit', FRSKEY2 END-EXEC
       EXEC FRS BEGIN END-EXEC
             EXEC SQL ROLLBACK END-EXEC.
             EXEC FRS BREAKDISPLAY END-EXEC.
       EXEC FRS END END-EXEC
       EXEC FRS FINALIZE END-EXEC.

       EXEC FRS ENDFORMS END-EXEC.
       EXEC SQL DISCONNECT END-EXEC.

       STOP RUN.

**

* Paragraph: DESCRIBE-FORM
*
*      Profile the specified form for name and data type
*      information.  Using the DESCRIBE FORM statement, the SQLDA
*      is loaded with field information from the form.  This h
*      paragraph (together with the DESCRIBE-COLUMN paragraph) n
*      processes the form information to allocate result storage,
*      point at storage for dynamic FRS
*      data retrieval and assignment, and build SQL statements
*      strings for subsequent dynamic SELECT and INSERT
*      statements.  For example, assume the form (and table) 'emp'
*      has the following fields:
* 

*                Field Name    Type     Nullable?
*                ----------    ----     ---------
*                name          char(10)  No
*                age           integer4  Yes
*                salary        money     Yes
*

*        Based on 'emp', this paragraph will construct the SQLDA.
*        The paragraph allocates variables from a result variable
*        pool (integers, floats and a large character string
*        space).  The SQLDATA and SQLIND fields are pointed at the
*        addresses of the result variables in the pool.  The
*        following SQLDA is built:

*

*                SQLVAR(1)
*                         SQLTYPE  =  CHAR TYPE
*                         SQLLEN   =  10
*                         SQLDATA  =  pointer into CHARS buffer
*                         SQLIND   =  null
*                         SQLNAME  =  'name'
*                SQLVAR(2)
*                         SQLTYPE   = - INTEGER TYPE
*                         SQLLEN    = 4
*                         SQLDATA   = address of INTEGERS(2)
*                         SQLIND    = address of INDICATORS(2)
*                         SQLNAME   = 'age'
*                SQLVAR(3)
*                         SQLTYPE   = - DECIMAL TYPE
*                         SQLLEN    = 4616 (see below)
*                         SQLDATA   = address of DECIMALS(3)
*                         SQLIND    = address of INDICATORS(3)
*                         SQLNAME   = 'salary'

*

*      This paragraph also builds two dynamic SQL statements
*      strings.
*      Note that the paragraph should be extended to verify that
*      the statement strings do fit into the statement buffers
*      (this was not done in this example).  The above example
*      would construct the following statement strings:
*

*        'SELECT name, age, salary FROM emp ORDER BY name'
*        'INSERT INTO emp (name, age, salary) VALUES (?, ?, ?)'

PROGRAM-ID. DYNAMIC-FRS.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.

* Database, form and table names
    01 DB-NAME                PIC X(40).
    01 FORM-NAME              PIC X(40).
    01 TABLE-NAME             PIC X(40).

* Dynamic SQL SELECT and INSERT statement buffers
    01 SEL-BUF                PIC X(1000).
    01 INS-BUF                PIC X(1000).
* Error status and prompt error return buffer
    01 ERR                    PIC S9(8) USAGE COMP.
    01 RET                    PIC X.
EXEC SQL END DECLARE SECTION END-EXEC.
* DESCRIBE-FORM (form profiler) return state
  01 DESCRIBED             PIC S9(4) USAGE COMP.
      88 DESCRIBE-FAIL      VALUE 0.
      88 DESCRIBE-OK        VALUE 1.
* Index into SQLVAR table
  01 COL                    PIC S9(4) USAGE COMP.
* Base data type of SQLVAR item without nullability
  01 BASE-TYPE              PIC S9(4) USAGE COMP.
* Is a result column type nullable
  01 IS-NULLABLE            PIC S9(4) USAGE COMP.
      88 NOT-NULLABLE        VALUE 0.
      88 NULLABLE            VALUE 1.
 

* Global result data storage. This pool of data includes the maximum
* number of data items needed to execute a dynamic retrieval or
* insertion. There is a table of 1024 integer, floating-point and
* null indicator data items, and a large character string buffer
* from which sub-strings are allocated.
  01 RESULT-DATA.
     02 INTEGERS        PIC S9(9) USAGE COMP OCCURS 1024 TIMES.
     02 DECIMALS        PIC S9(10)V9(8) USAGE COMP-3 OCCURS 1024 TIMES.
     02 INDICATORS      PIC S9(4) USAGE COMP OCCURS 1024 TIMES.
     02 CHARS           PIC X(3000).
* Total used length of data buffer
  01 CHAR-CNT           PIC S9(4) USAGE COMP VALUE 1.

* Current length required from character data buffer
  01 CHAR-CUR           PIC S9(4) USAGE COMP.
* Buffer for building Dynamic SQL statement string names
  01 NAMES              PIC X(1000) VALUE SPACES.
  01 NAME-CNT           PIC S9(4) USAGE COMP VALUE 1.
* Buffer for collecting Dynamic SQL place holders
  01 MARKS              PIC X(1000) VALUE SPACES.
  01 MARK-CNT           PIC S9(4) USAGE COMP VALUE 1.
**

* Procedure Division: DYNAMIC-FRS
*
* Main body of Dynamic SQL forms application. Prompt for database,
* form and table name. Perform DESCRIBE-FORM to obtain a profile
* of the form and set up the SQL statements. Then allow the user
* to interactively browse the database table and append new data.
**

PROCEDURE DIVISION.
SBEGIN.
* Turn on forms system
      EXEC FRS FORMS END-EXEC.
* Prompt for database name - will abort on errors
      EXEC SQL WHENEVER SQLERROR STOP END-EXEC.
      EXEC FRS PROMPT ('Database name: ', :DB-NAME) END-EXEC.
      EXEC SQL CONNECT :DB-NAME END-EXEC.
      EXEC SQL WHENEVER SQLERROR CALL SQLPRINT END-EXEC.
* Prompt for table name - later a Dynamic SQL SELECT statement
* will be built from it.
      EXEC FRS PROMPT ('Table name: ', :TABLE-NAME) END-EXEC.
* Prompt for form name. Check forms errors reported through
* INQUIRE_FRS.
      EXEC FRS PROMPT ('Form name: ', :FORM-NAME) END-EXEC.
      EXEC FRS MESSAGE 'Loading form ...' END-EXEC.
      EXEC FRS FORMINIT :FORM-NAME END-EXEC.
      EXEC FRS INQUIRE_FRS FRS (:ERR = ERRORNO) END-EXEC.
      IF (ERR > 0) THEN
             EXEC FRS MESSAGE 'Could not load form. Exiting.' END-EXEC
             EXEC FRS ENDFORMS END-EXEC
             EXEC SQL DISCONNECT END-EXEC
             STOP RUN.

* Commit any work done so far - access of forms catalogs
      EXEC SQL COMMIT END-EXEC.
* Describe the form and build the SQL statement strings
      PERFORM DESCRIBE-FORM THROUGH END-DESCRIBE.
      IF (DESCRIBE-FAIL) THEN
           EXEC FRS MESSAGE 'Could not describe form. Exiting.'
               END-EXEC
           EXEC FRS ENDFORMS END-EXEC
           EXEC SQL DISCONNECT END-EXEC
          STOP RUN.

* PREPARE the SELECT and INSERT statements that correspond to the
* menu items Browse and Insert. If the Save menu item is chosen
* the statements are reprepared.
      EXEC SQL PREPARE sel_stmt FROM :SEL-BUF END-EXEC.
      MOVE SQLCODE TO ERR.
      EXEC SQL PREPARE ins_stmt FROM :INS-BUF END-EXEC.
      IF (ERR < 0) OR (SQLCODE < 0) THEN
           EXEC FRS MESSAGE
                 'Could not prepare SQL statements. Exiting.' END-EXEC
           EXEC FRS ENDFORMS END-EXEC
           EXEC SQL DISCONNECT END-EXEC
           STOP RUN.
* Display the form and interact with user, allowing browsing
* and the inserting of new data.

      EXEC FRS DISPLAY :FORM-NAME FILL END-EXEC
      EXEC FRS INITIALIZE END-EXEC
      EXEC FRS ACTIVATE MENUITEM 'Browse' END-EXEC
      EXEC FRS BEGIN END-EXEC
* Retrieve data and display the first row on the form, allowing
* the user to browse through successive rows. If data types
* from the database table are not consistent with data descriptions
* obtained from the form, a retrieval error will occur. Inform
* the user of this or other errors.
* 

* Note that the data will return sorted by the first field that
* was described, as the SELECT statement, sel_stmt, included an
* ORDER BY clause.
      EXEC SQL OPEN csr FOR READONLY END-EXEC.
* Fetch and display each row
FETCH-NEXT-ROW.
            IF (SQLCODE NOT= 0) THEN
                GO TO END-FETCH-NEXT.
            EXEC SQL FETCH csr USING DESCRIPTOR :SQLDA END-EXEC.
            IF (SQLCODE NOT= 0) THEN
                EXEC SQL CLOSE csr END-EXEC
                EXEC FRS PROMPT NOECHO ('No more rows :', :RET)
                   END-EXEC
                EXEC FRS CLEAR FIELD ALL END-EXEC
                EXEC FRS RESUME END-EXEC.
            EXEC FRS PUTFORM :FORM-NAME USING DESCRIPTOR :SQLDA
                END-EXEC.
            EXEC FRS INQUIRE_FRS FRS (:ERR = ERRORNO) END-EXEC.
            IF (ERR > 0) THEN
                 EXEC SQL CLOSE csr END-EXEC
                 EXEC FRS RESUME END-EXEC.
* Display data before prompting user with submenu
            EXEC FRS REDISPLAY END-EXEC.
            EXEC FRS SUBMENU END-EXEC
            EXEC FRS ACTIVATE MENUITEM 'Next', FRSKEY4 END-EXEC
            EXEC FRS BEGIN END-EXEC

* Continue with cursor loop
                  EXEC FRS MESSAGE 'Next row ...' END-EXEC.
                  EXEC FRS CLEAR FIELD ALL END-EXEC.
            EXEC FRS END END-EXEC
            EXEC FRS ACTIVATE MENUITEM 'End', FRSKEY3 END-EXEC
            EXEC FRS BEGIN END-EXEC
                  EXEC SQL CLOSE csr END-EXEC.
                  EXEC FRS CLEAR FIELD ALL END-EXEC.
                  EXEC FRS RESUME END-EXEC.
            EXEC FRS END END-EXEC
* Fetch next row
            GO TO FETCH-NEXT-ROW.
* End of row processing
END-FETCH-NEXT.
            CONTINUE.
      EXEC FRS END END-EXEC
      EXEC FRS ACTIVATE MENUITEM 'Insert' END-EXEC
      EXEC FRS BEGIN END-EXEC
         EXEC FRS GETFORM :FORM-NAME USING DESCRIPTOR :SQLDA END-EXEC.
         EXEC FRS INQUIRE_FRS FRS (:ERR = ERRORNO) END-EXEC.
         IF (ERR > 0) THEN
              EXEC FRS CLEAR FIELD ALL END-EXEC
              EXEC FRS RESUME END-EXEC.
         EXEC SQL EXECUTE ins_stmt USING DESCRIPTOR :SQLDA END-EXEC.
         IF (SQLCODE < 0) OR (SQLERRD(3) = 0) THEN
               EXEC FRS PROMPT NOECHO ('No rows inserted :', :RET)
                 END-EXEC
         ELSE
         EXEC FRS PROMPT NOECHO ('One row inserted :', :ret)
               END-EXEC.
      EXEC FRS END END-EXEC
      EXEC FRS ACTIVATE MENUITEM 'Save' END-EXEC
      EXEC FRS BEGIN END-EXEC
* COMMIT any changes and then re-PREPARE the SELECT and INSERT
* statements as the COMMIT statements discards them.
              EXEC SQL COMMIT END-EXEC.
              EXEC SQL PREPARE sel_stmt FROM :SEL-BUF END-EXEC.
              MOVE SQLCODE TO ERR.
              EXEC SQL PREPARE ins_stmt FROM :INS-BUF END-EXEC.
              IF (ERR < 0) OR (SQLCODE < 0) THEN
                    EXEC FRS PROMPT NOECHO
                        ('Could not reprepare SQL statements :', :RET)
                        END-EXEC
                    EXEC FRS BREAKDISPLAY END-EXEC.
      EXEC FRS END END-EXEC
      EXEC FRS ACTIVATE MENUITEM 'Clear' END-EXEC
      EXEC FRS BEGIN END-EXEC
           EXEC FRS CLEAR FIELD ALL END-EXEC.
      EXEC FRS END END-EXEC
      EXEC FRS ACTIVATE MENUITEM 'Quit', FRSKEY2 END-EXEC
      EXEC FRS BEGIN END-EXEC
            EXEC SQL ROLLBACK END-EXEC.
            EXEC FRS BREAKDISPLAY END-EXEC.

      EXEC FRS END END-EXEC
      EXEC FRS FINALIZE END-EXEC.
      EXEC FRS ENDFORMS END-EXEC.
      EXEC SQL DISCONNECT END-EXEC.
      STOP RUN.
**

* Paragraph: DESCRIBE-FORM
*

* Profile the specified form for name and data type information.
* Using the DESCRIBE FORM statement, the SQLDA is loaded with
* field information from the form. This paragraph (together with
* the DESCRIBE-COLUMN paragraph) processes the form information
* to allocate result storage, point at storage for dynamic FRS
* data retrieval and assignment, and build SQL statements strings
* for subsequent dynamic SELECT and INSERT statements. For example,
* assume the form (and table) 'emp' has the following fields:
* 
* Field Name Type    Nullable?
* ---------- ----    ---------
* name      char(10)  No
* age       integer4  Yes
* salary    money     Yes
*
* Based on 'emp', this paragraph will construct the SQLDA.
* The paragraph allocates variables from a result variable
* pool (integers, decimals and a large character string space).
* The SQLDATA and SQLIND fields are pointed at the addresses
* of the result variables in the pool. The following SQLDA
* is built:
*

*       SQLVAR(1)
*           SQLTYPE = CHAR TYPE
*           SQLLEN  = 10
*           SQLDATA = pointer into CHARS buffer
*           SQLIND  = null
*           SQLNAME = 'name'
*       SQLVAR(2)
*           SQLTYPE = - INTEGER TYPE
*           SQLLEN  = 4
*           SQLDATA = address of INTEGERS(2)
*           SQLIND  = address of INDICATORS(2)
*           SQLNAME = 'age'
*       SQLVAR(3)
*           SQLTYPE = - DECIMAL TYPE
*           SQLLEN  = 4616 (see below)
*           SQLDATA = address of DECIMALS(3)
*           SQLIND  = address of INDICATORS(3)
*           SQLNAME = 'salary'
*

 

* This paragraph also builds two dynamic SQL statements strings.
* Note that the paragraph should be extended to verify that the
* statement strings do fit into the statement buffers (this was
* not done in this example). The above example would construct
* the following statement strings:
*

* 'SELECT name, age, salary FROM emp ORDER BY name'
* 'INSERT INTO emp (name, age, salary) VALUES (?, ?, ?)'
*

* This paragraph sets DESCRIBE-OK if it succeeds, and
* DESCRIBE-FAIL if there was some sort of initialization error.
**

DESCRIBE-FORM.
* Initialize the SQLDA and DESCRIBE the form. If we cannot fully
* describe the form (our SQLDA is too small) then report an error
* and return.
          SET DESCRIBE-OK TO TRUE.
          MOVE 1024 TO SQLN.
          EXEC FRS DESCRIBE FORM :FORM-NAME ALL INTO :SQLDA END-EXEC.
          EXEC FRS INQUIRE_FRS FRS (:ERR = ERRORNO) END-EXEC.
          IF (ERR > 0 ) THEN
                SET DESCRIBE-FAIL TO TRUE
                GO TO END-DESCRIBE.
          IF (SQLD > SQLN) THEN
                EXEC FRS PROMPT NOECHO
                     ('SQLDA is too small for form :', :RET) END-EXEC
                SET DESCRIBE-FAIL TO TRUE
                GO TO END-DESCRIBE.
          IF (SQLD = 0) THEN
                EXEC FRS PROMPT NOECHO
                  ('There are no fields in the form :', :RET) END-EXEC
                SET DESCRIBE-FAIL TO TRUE
                GO TO END-DESCRIBE.
 

* For each field determine the size and type of the result data area.
* This is done by DESCRIBE-COLUMN.
* 

* If a table field type is returned then issue an error.
*

* Also, for each field add the field name to the 'NAMES' buffer
* and the SQL place holders '?' to the 'MARKS' buffer, which
* will be used to build the final SELECT and INSERT statements.
      PERFORM DESCRIBE-COLUMN
                VARYING COL FROM 1 BY 1
                UNTIL (COL > SQLD) OR (DESCRIBE-FAIL).
* At this point we've processed all columns for data type
* information. Create final SELECT and INSERT statements. For the
* SELECT statement ORDER BY the first field.
     STRING "SELECT " NAMES(1: NAME-CNT) " FROM " TABLE-NAME
               " ORDER BY " SQLNAMEC(1)(1: SQLNAMEL(1))
               DELIMITED BY SIZE INTO SEL-BUF.
     STRING "INSERT INTO " TABLE-NAME "(" NAMES(1: NAME-CNT)
               ") VALUES (" MARKS(1: MARK-CNT) ")"
              DELIMITED BY SIZE INTO INS-BUF.
END-DESCRIBE.
      EXIT.
**

* Paragraph: DESCRIBE-COLUMN
*

* When setting up data for the SQLDA result data items are chosen
* out of a pool of variables. The SQLDATA and SQLIND fields are
* pointed at the addresses of the result data items and indicators
* as described in paragraph DESCRIBE-FORM.
* 
* Field names are collected for the building of the Dynamic SQL
* statement strings as described for paragraph DESCRIBE-FORM.
*
* Paragraph sets DESCRIBE-FAIL if it fails.
**

DESCRIBE-COLUMN.
* Determine the data type of the filed and to where SQLDATA and
* SQLIND must point in order to retrieve type-compatible results.
* First find the base type of the current column.
            IF (SQLTYPE(COL) > 0) THEN
            MOVE SQLTYPE(COL) TO BASE-TYPE
            SET NOT-NULLABLE TO TRUE
            MOVE 0 TO SQLIND(COL)
      ELSE
            COMPUTE BASE-TYPE = 0 - SQLTYPE(COL)
            SET NULLABLE TO TRUE
            SET SQLIND(COL) TO REFERENCE INDICATORS(COL).
* Collapse all different types into one of integer, float
* or character.
* Integer data uses 4-byte COMP.
      IF (BASE-TYPE = 30) THEN
            IF (NOT-NULLABLE) THEN
                  MOVE 30 TO SQLTYPE(COL)
            ELSE
                  MOVE -30 TO SQLTYPE(COL)
            END-IF
            MOVE 4 TO SQLLEN(COL)
            SET SQLDATA(COL) TO REFERENCE INTEGERS(COL)
* Money and floating-point or decimal data use COMP-3.
* You must encode precision and length when setting SQLLEN
* for a decimal data type. Use the formula: SQLLEN = (256 *p+s)
* where p is the Ingres precision and s is scale of the decimal
* host variable. DEC-DATA is defined as PIC S9(10)V9(8), so
* p = 10 + 8 (Ingres precision is the total number of digits)
* and s= 8. Therefore, SQLLEN = (256 * 18+8) = 4616.
      ELSE IF (BASE-TYPE = 5)
           OR (BASE-TYPE = 10)
           OR (BASE-TYPE = 31) THEN
          IF (NOT-NULLABLE) THEN
                MOVE 10 TO SQLTYPE(COL)
          ELSE
                MOVE -10 TO SQLTYPE(COL)
          END-IF
          MOVE 4616 TO SQLLEN(COL)
          SET SQLDATA(COL) TO REFERENCE DECIMALS(COL)