3. Embedded QUEL for COBOL : Sample Applications : UNIX and VMS—The Table Editor Table Field Application
 
Share this page                  
UNIX and VMS—The Table Editor Table Field Application
This EQUEL/FORMS application uses a table field to edit the Person table in the Personnel database. It allows the user to update a person's values, remove the person, or add new persons. Various table field utilities are provided with the application to demonstrate their use and their interaction with an Ingres database.
The objects used in this application are:
Object
Description
personnel
The program's database environment.
person
A table in the database, with three columns:
name (c20)
age (i2)
number (i4). Number is unique.
personfrm
The VIFRED form with a single table field.
persontbl
A table field in the form, with two columns:
name (c20)
age (i4)
When initialized, the table field includes the hidden column number (i4).
At the start of the application, a retrieve statement is issued to load the table field with data from the Person table. Once the table field has been loaded, the user can browse and edit the displayed values. Entries can be added, updated or deleted. When finished, the values are unloaded from the table field, and, in a multi-statement transaction, the user's updates are transferred back into the Person table.
For readability, all EQUEL reserved words are in uppercase.
UNIX: The following create statement describes the format of the Person database table:
##   CREATE person
##     (name   = c20,     /* Person name */
##      age    = i2,      /* Age */
##      number = i4       /* Unique id number */

        IDENTIFICATION DIVISION. 
        PROGRAM-ID. TABLE-EDITOR.

        ENVIRONMENT DIVISION.

        DATA DIVISION.
        WORKING-STORAGE SECTION.
##      DECLARE

*       Record corresponds to "person" table
##      01    PERSON-VALUES.
##            02 PNAME           PIC X(20).
##            02 P-AGE           PIC S9(2) USAGE COMP.
##            02 PNUMBER         PIC S9(8) USAGE COMP.

##      01    MAXID              PIC S9(9) USAGE COMP.

*       Table field row states
##      01    STATE              PIC S9 USAGE COMP.
*             Empty or undefined row
              88 ST-UNDEF VALUE 0.
*             Appended by user
              88 ST-NEW VALUE 1.
*             Loaded by program - not updated
              88 ST-UNCHANGED VALUE 2.
*             Loaded by program - since changed
              88 ST-CHANGED VALUE 3.
*             Deleted by program
              88 ST-DELETED VALUE 4.
*       Table field entry information
##      01    T-RECORD           PIC S9(4) USAGE COMP.
##      01    LASTROW            PIC S9 USAGE COMP.

*       Utility buffers
##      01    MSGBUF             PIC X(200).
##      01    RESPBUF            PIC X(20).

*       Status variables
*       Number of rows updated
##      01    UPDATE-ROWS        PIC S9(4) USAGE COMP.
*       Update error from database
##      01    UPDATE-ERROR       PIC S9(2) USAGE COMP.
*       Transaction aborted
##      01    XACT-ABORTED       PIC S9 USAGE COMP.
*       Save changes to database?
#       01    SAVE-CHANGES       PIC S9 USAGE COMP.

        PROCEDURE DIVISION.
        EXAMPLE SECTION.
        XBEGIN.
*       Start up Ingres and the FORMS system

##      INGRES "personnel"

##      FORMS

*       Verify that the user can edit the "person" table

##      PROMPT NOECHO ("Password for table editor: ", RESPBUF)

        IF RESPBUF NOT = "MASTER_OF_ALL" THEN

##            MESSAGE "No permission for task. Exiting..."
##            ENDFORMS
##            EXIT
              STOP RUN

        END-IF.

##      MESSAGE "Initializing Person Form..."

##      RANGE OF p IS person

##      FORMINIT personfrm

*       Initialize "persontbl" table field with a data set in FILL 
*       mode so that the runtime user can append rows. To keep 
*       track of events occurring to original rows that will
*       be loaded into the table field, hide 
*       the unique person number.

##      INITTABLE personfrm persontbl FILL (number = integer)

        PERFORM LOAD-TABLE THROUGH ENDLOAD-TABLE.
##      DISPLAY personfrm UPDATE
##      INITIALIZE

##      ACTIVATE MENUITEM "Top", FRSKEY5
##      {

*       Provide menu, as well as the system FRS key to scroll
*       to both extremes of the table field

##      SCROLL personfrm persontbl TO 1

##      }

##      ACTIVATE MENUITEM "Bottom", FRSKEY6
##      {
##            SCROLL personfrm persontbl TO END
##      }
##      ACTIVATE MENUITEM "Remove"
##      {

*             Remove the person in the row the user's cursor is on.
*             Record this in the database later.

##            DELETEROW personfrm persontbl
##      }

##      ACTIVATE MENUITEM "Find", FRSKEY7
##      {

*          Scroll user to the requested table field entry. Prompt
*          the user for a name, and if one is typed in loop through
*          the data set searching for it.

##         PROMPT ("Person's name : ", RESPBUF)

           IF RESPBUF = SPACES THEN
##             RESUME FIELD persontbl
           END-IF.

##         UNLOADTABLE personfrm persontbl
##             (PNAME = name, T-RECORD = _RECORD, STATE = _STATE)
##         {
*              Do not compare with deleted rows

               IF PNAME = RESPBUF AND NOT ST-DELETED THEN

##               SCROLL personfrm persontbl TO T-RECORD
##               RESUME FIELD persontbl

               END-IF.
##         }

*          Fell out of loop without finding name
           STRING "Person """ DELIMITED BY SIZE,
              RESPBUF DELIMITED BY SIZE,
              """ not found in table [HIT RETURN]"
              DELIMITED BY SIZE
              INTO MSGBUF.
##         PROMPT NOECHO (MSGBUF, RESPBUF)

##      }

##      ACTIVATE MENUITEM "Save", FRSKEY8
##      {
##         VALIDATE FIELD persontbl
           MOVE 1 TO SAVE-CHANGES.
##         BREAKDISPLAY
##      }

##      ACTIVATE MENUITEM "Quit", FRSKEY2
##      {
            MOVE 0 TO SAVE-CHANGES.
##          BREAKDISPLAY
##      }
##      FINALIZE

##      MESSAGE "Exiting Person Application..."

        IF SAVE-CHANGES = 0 THEN
##          ENDFORMS
##          EXIT
            STOP RUN
        END-IF.
*       Exit person table editor and unload the table field. If any
*       updates, deletions or additions were made, duplicate these
*       changes in the source table. If the user added new people
*       we must assign a unique person id before
*       returning it to the table. To do this, increment the 
*       previously saved maximum id
*       number with each insert. 

*       Do all the updates in a transaction (for simplicity,
*       this transaction does not restart on DEADLOCK error: 4700)

##      BEGIN TRANSACTION

        MOVE 0 TO UPDATE-ERROR.
        MOVE 0 TO XACT-ABORTED.

##      UNLOADTABLE personfrm persontbl
##          (PNAME = name, P-AGE = age, PNUMBER = number, 
##              STATE = _STATE)
##      {

        IF ST-NEW THEN

*           Appended by user. Insert with new unique id
            ADD 1 TO MAXID
##          REPEAT APPEND TO person (name = @PNAME,
##             age = @P-AGE,
##             number = @MAXID)

        ELSE IF ST-CHANGED THEN

*           Updated by user. Reflect in table
##          REPEAT REPLACE person (name = @PNAME, age = @P-AGE)
##             WHERE person.number = @PNUMBER

        ELSE IF ST-DELETED THEN

*           Deleted by user, so delete from table. Note that
*           only original rows are saved by the program, and
*           not rows appended at runtime.
##          REPEAT DELETE FROM p WHERE p.number = @PNUMBER

        END-IF.

*       ELSE ST-UNDEFINED or ST-UNCHANGED - No updates
*       Handle error conditions -
*       If an error occurred, then abort the transaction.
*       If no rows were updated then inform user, and prompt for
*       continuation.

##      INQUIRE_INGRES (UPDATE-ERROR = ERRORNO, 
##      UPDATE-ROWS = ROWCOUNT)
        IF UPDATE-ERROR NOT = 0 THEN
*           Error
##          INQUIRE_EQUEL (MSGBUF = ERRORTEXT)
##          ABORT
            MOVE 1 TO XACT-ABORTED
##          ENDLOOP
        ELSE IF UPDATE-ROWS = 0 THEN
            STRING  "Person """, PNAME,
                    """ not updated. Abort all updates? "
                    DELIMITED BY SIZE
                    INTO MSGBUF
##          PROMPT  (MSGBUF, RESPBUF)
            IF RESPBUF = "Y" OR RESPBUF = "y" THEN
##                  ABORT
                    MOVE 1 TO XACT-ABORTED
##                  ENDLOOP
            END-IF
        END-IF.

## }

    IF XACT-ABORTED = 0 THEN
*       Commit the updates
##      END TRANSACTION
    END-IF.

*   Terminate the FORMS and Ingres
##  ENDFORMS 
#       EXIT

    IF UPDATE-ERROR NOT = 0 THEN
        DISPLAY "Your updates were aborted because of error:"
        DISPLAY MSGBUF
    END-IF.

    STOP RUN.
**
* Paragraph: LOAD-TABLE
*
*   Load the table field from the "person" table. The columns
*   name" and "age" will be displayed, and "number" will be
*   hidden.
**

    LOAD-TABLE.

##  MESSAGE "Loading Person Information . . ."

*   Fetch the maximum person id number for later use.
*   max() will do a sequential scan of the table.

##  RETRIEVE (MAXID = MAX(p.number))

*   Fetch data, and load table field

##  RETRIEVE (PNAME = p.name, P-AGE = p.age, PNUMBER = p.number)
##  {
##       LOADTABLE personfrm persontbl
##           (name = PNAME, age = P-AGE, number = PNUMBER)
##  }

    ENDLOAD-TABLE.
        EXIT. 

VMS: The create statement describing the format of the Person database table appears first:
              ##    CREATE person
              ##          (name    = c20,   /* Person name */
              ##           age     = i2,    /* Age */
              ##           number  = i4)    /* Unique id number */
IDENTIFICATION DIVISION.
PROGRAM-ID. TABLE-EDITOR.

ENVIRONMENT DIVISION.

DATA DIVISION.
WORKING-STORAGE SECTION.
##        DECLARE

* Record corresponds to "person" table

##     01   PERSON-VALUES.
##          02   PNAME            PIC X(20).
##          02   P-AGE            PIC S9(2) USAGE COMP.
##          02   PNUMBER          PIC S9(8) USAGE COMP.

##     01   MAXID                 PIC S9(9) USAGE COMP.

* Table field row states

* Empty or undefined row
##     01   ST-UNDEF              PIC S9 USAGE COMP VALUE 0.
* Appended by user
##     01   ST-NEW                PIC S9 USAGE COMP VALUE 1.
* Loaded by program - not updated
##     01   ST-UNCHANGED          PIC S9 USAGE COMP VALUE 2.
* Loaded by program - since changed
##     01   ST-CHANGED            PIC S9 USAGE COMP VALUE 3.
* Deleted by program
##     01   ST-DELETED            PIC S9 USAGE COMP VALUE 4.
* Table field entry information
##     01    STATE                PIC S9 USAGE COMP. 
##     01    T-RECORD             PIC S9(4) USAGE COMP.
##     01    LASTROW              PIC S9 USAGE COMP.

* Utility buffers

##     01    MSGBUF               PIC X(200).
##     01    RESPBUF              PIC X(20).
* Status variables

* Number of rows updated
##    01     UPDATE-ROWS          PIC S9(4) USAGE COMP.
* Update error from database
##    01     UPDATE-ERROR         PIC S9(2) USAGE COMP.
* Transaction aborted
##    01     XACT-ABORTED         PIC S9 USAGE COMP.
* Save changes to database?
##    01     SAVE-CHANGES         PIC S9 USAGE COMP.

PROCEDURE DIVISION.
SBEGIN.
* Start up Ingres and the FORMS system

##        INGRES "personnel"

##        FORMS

* Verify that the user can edit the "person" table

##        PROMPT NOECHO ("Password for table editor: ", RESPBUF)

          IF RESPBUF NOT = "MASTER_OF_ALL" THEN

##           MESSAGE "No permission for task. Exiting..."
##           ENDFORMS
##           EXIT
             STOP RUN

          END-IF.

##        MESSAGE "Initializing Person Form..."

##        RANGE OF p IS person

##        FORMINIT personfrm
* Initialize "persontbl" table field with a data set in FILL mode
* so that the runtime user can append rows. To keep track of
* events occurring to original rows that will be loaded
* into the table field, hide the unique person number.

##        INITTABLE personfrm persontbl FILL (number = integer)

          PERFORM LOAD-TABLE THROUGH ENDLOAD-TABLE.

##        DISPLAY personfrm UPDATE
##        INITIALIZE

##        ACTIVATE MENUITEM "Top", FRSKEY5
##        {

* Provide menu, as well as the system FRS key to scroll 
* to both extremes of the table field

##               SCROLL personfrm persontbl TO 1

##        }

##        ACTIVATE MENUITEM "Bottom", FRSKEY6
##        {
##               SCROLL personfrm persontbl TO END
##        }

##        ACTIVATE MENUITEM "Remove"
##        {

* Remove the person in the row the user's cursor is on.
* Record this in the database later.

##               DELETEROW personfrm persontbl
##        }

##        ACTIVATE MENUITEM "Find", FRSKEY7
##        {
* Scroll user to the requested table field entry. Prompt the 
* user for a name, and if one is typed in loop through the 
* data set searching for it.

##               PROMPT ("Person's name : ", RESPBUF)

                 IF RESPBUF = "" THEN
##                    RESUME FIELD persontbl
                 END-IF.

##               UNLOADTABLE personfrm persontbl
##               (PNAME = name, T-RECORD = _RECORD, STATE = _STATE)
##               {

* Do not compare with deleted rows

                 IF PNAME = RESPBUF AND STATE NOT = ST-DELETED THEN

##                           SCROLL personfrm persontbl TO T-RECORD
##                             RESUME FIELD persontbl

                    END-IF.
##                  }

* Fell out of loop without finding name

                    STRING "Person """ DELIMITED BY SIZE,
                            RESPBUF DELIMITED BY SIZE,
                            """ not found in table
                            [HIT RETURN]" DELIMITED BY SIZE
                            INTO MSGBUF.

##                  PROMPT NOECHO (MSGBUF, RESPBUF)

##        }

##        ACTIVATE MENUITEM "Save", FRSKEY8
##        {
##                  VALIDATE FIELD persontbl
                    MOVE 1 TO SAVE-CHANGES.
##                  BREAKDISPLAY
##        }

##        ACTIVATE MENUITEM "Quit", FRSKEY2
##        {
                  MOVE 0 TO SAVE-CHANGES.
##                BREAKDISPLAY
##        }
##        FINALIZE

##        MESSAGE "Exiting Person Application..."

        IF SAVE-CHANGES = 0 THEN
##                  ENDFORMS
##                  EXIT
                    STOP RUN
        END-IF.
*    Exit person table editor and unload the table field. 
*    If any updates, deletions or additions were made, duplicate 
*    these changes in the source table. If the user added new 
*    people we must assign a unique person id before returning 
*    it to the table. To do this, increment the previously
*    saved maximum id number with each insert.

*    Do all the updates in a transaction (for simplicity, 
*    this transaction does not restart on DEADLOCK error: 4700)

##      BEGIN TRANSACTION

        MOVE 0 TO UPDATE-ERROR.
        MOVE 0 TO XACT-ABORTED.

##      UNLOADTABLE personfrm persontbl
##           (PNAME = name, P-AGE = age, PNUMBER = number, 
##            STATE = _STATE)
##      {

             IF STATE = ST-NEW THEN

*    Appended by user. Insert with new unique id

                        ADD 1 TO MAXID

##                        REPEAT APPEND TO person (name = @PNAME, 
##                                age = @P-AGE,
##                                number = @MAXID)

              ELSE IF STATE = ST-CHANGED THEN

*    Updated by user. Reflect in table

##              REPEAT REPLACE person (name = @PNAME, age = @P-AGE)
##                       WHERE person.number = @PNUMBER

              ELSE IF STATE = ST-DELETED THEN

*    Deleted by user, so delete from table. Note that only 
*    orignal rows are saved by the program, and not rows 
*    appended at runtime.

##                REPEAT DELETE FROM p WHERE p.number = @PNUMBER
              END-IF
*    Else UNDEFINED or UNCHANGED - No updates
*    Handle error conditions -
*    If an error occurred, then abort the transaction.
*    If no rows were updated then inform user, and prompt
*    for continuation.

##           INQUIRE_INGRES (UPDATE-ERROR = ERRORNO, UPDATE-ROWS = 
##                ROWCOUNT)

              IF UPDATE-ERROR NOT = 0 THEN
*      Error
##                INQUIRE_EQUEL (MSGBUF = ERRORTEXT)
##                ABORT
                  MOVE 1 TO XACT-ABORTED
##                ENDLOOP

       ELSE IF UPDATE-ROWS = 0 THEN

                  STRING "Person """ PNAME 
                          """ not updated. Abort all updates? " 
                          DELIMITED BY SIZE 
                          INTO MSGBUF
##                PROMPT (MSGBUF, RESPBUF)
                  IF RESPBUF = "Y" OR RESPBUF = "Y" THEN
##                        ABORT
                          MOVE 1 TO XACT-ABORTED
##                        ENDLOOP
                  END-IF

       END-IF

##   }

      IF XACT-ABORTED = 0 THEN

*    Commit the updates

##                  END TRANSACTION

      END-IF.

*    Terminate the FORMS and Ingres

##    ENDFORMS

##    EXIT

      IF UPDATE-ERROR NOT = 0 THEN

              DISPLAY "Your updates were aborted because of error:"
              DISPLAY MSGBUF

      END-IF.

      STOP RUN.
**
* Paragraph: LOAD-TABLE
*
*      Load the table field from the "person" table. The columns
*      "name" and "age" will be displayed, and "number" will be
*      hidden.
**

LOAD-TABLE.

##      MESSAGE "Loading Person Information . . ."

* Fetch the maximum person id number for later use.
* PERFORMANCE max() will do a sequential scan of the table.

##      RETRIEVE (MAXID = MAX(p.number))

* Fetch data, and load table field

##      RETRIEVE (PNAME = p.name, P-AGE = p.age, PNUMBER = p.number)
##      {
##                LOADTABLE personfrm persontbl
##                     (name = PNAME, age = P-AGE, number = PNUMBER)
##      }

ENDLOAD-TABLE.