100        !

        ! Program: Dynamic_FRS
        ! Purpose: Main body of Dynamic SQL forms application. Prompt for
        !          database, form and table name. Call 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.
        !

        program Dynamic_FRS
            ! Declare the global SQLCA and SQLDA records
            exec sql include sqlca
            exec sql include sqlda
            common (sqlda_area) IISQLDA sqlda
            exec sql declare sel_stmt statement    ! Dynamic SQL SELECT and
            exec sql declare ins_stmt statement    ! INSERT statements
            exec sql declare csr cursor
                for sel_stmt                       ! Cursor for dynamic SELECT
            external byte function
                Describe_Form                      ! DESCRIBE form/SQL statements

            exec sql begin declare section
                declare string  dbname             ! Database name
                declare string  formname           ! Form name
                declare string  tabname            ! Database table name
                declare string  sel_buf            ! Prepared SELECT statement
                declare string  ins_buf            ! Prepared INSERT statement
                declare integer er                 ! Error status
                declare string  ret                ! Prompt error buffer
            exec sql end declare section
            exec frs forms

            ! Prompt for database name - will abort on errors
            exec sql whenever sqlerror stop
            exec frs prompt ('Database name: ', :dbname)
            exec sql connect :dbname
            exec sql whenever sqlerror call sqlprint
            !
            ! Prompt for table name - later a Dynamic SQL SELECT statement
            ! will be built from it.
            !
            exec frs prompt ('Table name: ', :tabname)

            !
            ! Prompt for form name. Check forms errors reported
            ! through INQUIRE_FRS.
            !
            exec frs prompt ('Form name: ', :formname)
            exec frs message 'Loading form ...'
            exec frs forminit :formname
            exec frs inquire_frs frs (:er = ERRORNO)
            if (er > 0) then
                exec frs message 'Could not load form. Exiting.'
                exec frs endforms
                exec sql disconnect
                exit program
            end if

            ! Commit any work done so far - access of forms catalogs
            exec sql commit
            ! Describe the form and build the SQL statement strings
            if (not Describe_Form
                (formname, tabname, sel_buf, ins_buf)) then
                exec frs message 'Could not describe form. Exiting.'
                exec frs endforms
                exec sql disconnect
                exit program
            end if

            !
            ! PREPARE the SELECT and INSERT statements that correspond
            ! to the menu items Browse and Insert. If the Save menu item
            ! is chose the statements are reprepared.
            !
            exec sql prepare sel_stmt from :sel_buf
            er = sqlcode
            exec sql prepare ins_stmt from :ins_buf

            if ((er < 0) or (sqlcode < 0)) then
                exec frs message
                    'Could not prepare SQL statements. Exiting.'
                exec frs endforms
                exec sql disconnect
                exit program
            end if
            !
            ! Display the form and interact with user, allowing browsing
            ! and the inserting of new data.
            !

            exec frs display :formname fill
            exec frs initialize
            exec frs activate menuitem 'Browse'
            exec frs begin
                !
                ! 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
                ! Fetch and display each row
                while (sqlcode = 0)

                    exec sql fetch csr using descriptor :sqlda
                    if (sqlcode <> 0) then
                        exec sql close csr
                        exec frs prompt noecho ('No more rows :', :ret)
                        exec frs clear field all
                        exec frs resume
                    end if
                    exec frs putform :formname using descriptor :sqlda
                    exec frs inquire_frs frs (:er = ERRORNO)
                    if (er > 0) then
                        exec sql close csr
                        exec frs resume
                    end if

                    ! Display data before prompting user with submenu
                    exec frs redisplay
                    exec frs submenu
                    exec frs activate menuitem 'Next', FRSKEY4
                    exec frs begin
                        ! Continue with cursor loop
                        exec frs message 'Next row ...'
                        exec frs clear field all

                    exec frs end
                    exec frs activate menuitem 'End', FRSKEY3
                    exec frs begin
                        exec sql close csr
                        exec frs clear field all
                        exec frs resume
                    exec frs end
                next             ! While there are more rows
            exec frs end
            exec frs activate menuitem 'Insert'
            exec frs begin
                exec frs getform :formname using descriptor :sqlda
                exec frs inquire_frs frs (:er = errorno)
                if (er > 0) then
                    exec frs clear field all
                    exec frs resume
                end if
                exec sql execute ins_stmt using descriptor :sqlda
                if ((sqlcode < 0) or (sqlerrd(2) = 0)) then
                    exec frs prompt noecho ('No rows inserted :', :ret)
                else
                    exec frs prompt noecho ('One row inserted :', :ret)
                end if
            exec frs end
            exec frs activate menuitem 'Save'
            exec frs begin
                !
                ! COMMIT any changes and then re-PREPARE the SELECT
                !    and INSERT statements as the COMMIT statements
                !    discards them.
                !
                exec sql commit
                exec sql prepare sel_stmt from :sel_buf
                er = sqlcode
                exec sql prepare ins_stmt from :ins_buf
                if ((er < 0) or (sqlcode < 0)) then
                    exec frs prompt noecho             &
                        ('Could not reprepare SQL statements :', :ret)
                    exec frs breakdisplay
                end if
            exec frs end
            exec frs activate menuitem 'Clear'
                exec frs begin
                            exec frs clear field all
                exec frs end
                exec frs activate menuitem 'Quit', FRSKEY2
                exec frs begin
                    exec sql rollback
                    exec frs breakdisplay
                    exec frs end
                exec frs finalize
                exec frs endforms
               exec sql disconnect
        end program                     ! Dynamic_FRS
        !
        ! Function: Describe_Form
        ! Purpose: 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
        !        procedure processes this 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 procedure will construct the
        !            SQLDA.    The procedure allocates variables from a
        !            result variable pool (integers, floats and a large
        !            character string buffer).
       !            The SQLDATA and SQLIND fields are pointed at
        !            the addresses of the result variables in the pool.
        !            The following SQLDA is built:
        !
        !             sqlvar(0)
        !                 sqltype         = IISQ_CHA_TYPE
        !                 sqllen          = 10
        !                 sqldata         = pointer into characters array
        !                 sqlind          = null
        !                 sqlname         = 'name'
        !             sqlvar(1)
        !                 sqltype         = -IISQ_INT_TYPE
        !                 sqllen          = 4
        !                 sqldata         = address of integers(1)
        !                 sqlind          = address of indicators(1)
        !                 sqlname         = 'age'
        !             sqlvar(2)
        !                 sqltype         = -IISQ_FLT_TYPE
        !                 sqllen          = 8
        !                 sqldata         = address of floats(2)
        !                 sqlind          = address of indicators(2)
        !                 sqlname         = 'salary'
        !
        !             This procedure also builds two dynamic SQL statements
        !             strings. Note that the procedure 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 (?, ?, ?)'
        !
        ! Parameters:
        !             formname - Name of form to profile.
        !             tabname - Name of database table.
        !             sel_buf - Buffer to hold SELECT statement string.
        !             ins_buf - Buffer to hold INSERT statement string.
        ! Returns:
        !             TRUE (-1) - Success/failure - will fail on error
        !             FALSE (0) or upon finding a table field.
        !

200        function byte Describe_Form
                (string formname, tabname, sel_buf, ins_buf)

        ! Declare the global SQLCA and SQLDA records
        exec sql include sqlca
        exec sql include sqlda
        common (sqlda_area) IISQLDA sqlda
        !
        ! Global result data storage pool for integer data, floating-point
        ! data, indicator variables, and character data. The character
        ! data is a large buffer from which sub-strings are chosen.
        !
        declare word constant CHAR_MAX = 2500
        common (result_area) integer integers(IISQ_MAX_COLS),         &
                 double floats(IISQ_MAX_COLS),                        &
                 word indicators(IISQ_MAX_COLS),                      &
                 string characters(CHAR_MAX) = 1
        declare integer char_cnt         ! Character counter
        declare integer char_cur         ! Current character length
        declare integer i                ! Index into SQLVAR
        declare integer base_type        ! Base type w/o nullability
        declare byte nullable            ! Is nullable (SQLTYPE < 0)

        declare string names             ! Names for SQL statements
        declare string name_cur          ! Current column name
        declare string marks             ! Place holders for INSERT
        declare integer er               ! Error status
        declare string ret               ! Prompt error buffer
        !
        ! 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.
        !
        sqlda::sqln = IISQ_MAX_COLS
        exec frs describe form :formname all into :sqlda
        exec frs inquire_frs frs (:er = errorno)
        if (er > 0) then
            Describe_Form = 0            ! Error already displayed
            exit function
        end if
        if (sqlda::sqld > sqlda::sqln) then
            exec frs prompt noecho ('SQLDA is too small for form :', :ret)
            Describe_Form = 0
            exit function
        end if
        if (sqlda::sqld = 0) then        ! No fields
                exec frs prompt noecho
                    ('There are no fields in the form :', :ret)
                    Describe_Form = 0
                    exit function
        end if
        !
        ! For each field determine the size and type of the result data
        ! area. This data area will be allocated out of the result
        ! variable pool (integers, floats and characters) and will be
        ! pointed at by SQLDATA and SQLIND. Note that the index into
        ! SQLVAR begins at 0 and not 1 because the array is zero-based.
        !
        ! 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.
        !

        char_cnt = 1
        for i = 0 to sqlda::sqld - 1         ! For each column
            ! Find the base-type of the result (non-nullable).
            if (sqlda::sqlvar(i)::sqltype > 0) then
                base_type = sqlda::sqlvar(i)::sqltype
                nullable = 0             ! False
            else
                base_type = -sqlda::sqlvar(i)::sqltype
                nullable = -1 ! True
            end if
            !
            ! Collapse all different types into one of 4-byte integer,
            ! 8-byte floating-point, or fixed length character. Figure
            ! out where to point SQLDATA and SQLIND - which member
            ! of the result variable pool is compatible with the data.
            !
            select base_type
                case IISQ_INT_TYPE         ! Use 4-byte integer
                    sqlda::sqlvar(i)::sqltype = IISQ_INT_TYPE
                    sqlda::sqlvar(i)::sqllen = 4
                    sqlda::sqlvar(i)::sqldata = loc(integers(i))

                case IISQ_FLT_TYPE, IISQ_MNY_TYPE ! Use 8-byte float
                    sqlda::sqlvar(i)::sqltype = IISQ_FLT_TYPE
                    sqlda::sqlvar(i)::sqllen = 8
                    sqlda::sqlvar(i)::sqldata = loc(floats(i))

                case IISQ_CHA_TYPE, IISQ_VCH_TYPE, IISQ_DTE_TYPE
                !
                ! Determine the length of the sub-string required
                ! from the large character buffer. If we have enough
                ! space left then point at the start of the corresponding
                ! sub-string, otherwise print an error and return.
                !
                ! Note that for DATE types we must set the length.
                !
                if (base_type = IISQ_DTE_TYPE) then
                    char_cur = IISQ_DTE_LEN
                else
                    char_cur = sqlda::sqlvar(i)::sqllen
                end if
                if ((char_cnt + char_cur) > CHAR_MAX) then
                    exec frs prompt noecho                 &
                        ('Character pool buffer overflow :', :ret)
                    Describe_Form = 0
                exit function
                end if                 ! If too many characters
                !
                ! Grab space out of the large character buffer and
                ! keep track of the amount of space used so far.
                !
                sqlda::sqlvar(i)::sqltype = IISQ_CHA_TYPE
                sqlda::sqlvar(i)::sqllen = char_cur
                sqlda::sqlvar(i)::sqldata = loc(characters(char_cnt))
                char_cnt                 = char_cnt + char_cur
            case IISQ_TBL_TYPE                 ! Table field
                exec frs prompt noecho                     &
                    ('Table field found in form :', :ret)
                Describe_Form = 0
                exit function
            case else                     ! Bad data type
                exec frs prompt noecho ('Invalid field type :', :ret)
                Describe_Form = 0
                exit function
        end select                     ! Of checking types
        ! If nullable then point at a null indicator and negate type id
        if (nullable) then
            sqlda::sqlvar(i)::sqlind = loc(indicators(i))
            sqlda::sqlvar(i)::sqltype = -sqlda::sqlvar(i)::sqltype
        else
            sqlda::sqlvar(i)::sqlind = 0
        end if
        !
        ! Store field names and place holders (separated by commas)
        ! for the SQL statements.
        !
        name_cur =                            &
            left$(sqlda::sqlvar(i)::sqlnamec, sqlda::sqlvar(i)::sqlnamel)
        if (i = 0) then
            names = name_cur
            marks = '?'
        else
            names = names + ',' + name_cur
            marks = marks + ',?'
        end if
        next i                     ! End of column processing
        !
        ! Create final SELECT and INSERT statements. For the SELECT
        ! statement ORDER BY the first field.
        !
        name_cur =                             &
            left$(sqlda::sqlvar(0)::sqlnamec, sqlda::sqlvar(0)::sqlnamel)
        sel_buf = 'select ' + names + ' from ' + tabname &
                    + ' order by ' + name_cur
        ins_buf = 'insert into ' + tabname + ' (' + names &
                    + ') values (' + marks + ')'

        Describe_Form = -1           ! True

    end function                     ! Describe_Form