*       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.