**

* Program: TABLE-EDIT
*
* Table Editor program. The main program initializes
* the database and displays a form that contains a

* single table field of personnel. It allows the user

* to add, change or delete the rows in the field.
* The program then makes the changes to the
* underlying database table in a multi-statement
* transaction.

**

       IDENTIFICATION DIVISION.
       PROGRAM-ID. TABLE-EDIT.
       ENVIRONMENT DIVISION.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
       EXEC SQL INCLUDE SQLCA END-EXEC.
       EXEC SQL DECLARE person TABLE
                (name    char(20),
                age     smallint,
                number  integer)
        END-EXEC.
       EXEC SQL BEGIN DECLARE SECTION END-EXEC.
*      Person information

        
         01 PERSONREC.
            02 PNAME     PIC X(20)
            02 P-AGE     PIC S99 USAGE COMP.
            02 PNUMBER   PIC S9(6) USAGE COMP.
         01 MAXID      PIC S9(6) USAGE COMP.
*      Table field entry information
         01 RECNUM     PIC S9(4) USAGE COMP.
         01 LASTROW     PIC S9 USAGE COMP.
*      Utility buffers
         01 MSGBUF        PIC X(200).
         01 RESPBUF       PIC X(20).
         01 STATE         PIC S9 USAGE COMP.
       EXEC SQL END DECLARE SECTION END-EXEC.
*      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-CHANGE      PIC S9 USAGE COMP VALUE 3.
*      Deleted by program
       01 ST-DELETE      PIC S9 USAGE COMP VALUE 4.
*      SQLCA value for no rows
       01 NOT-FOUND      PIC S9(3) USAGE COMP VALUE 100.
*      Update error from database
       01 UPDATE-ERROR        PIC S9(2) USAGE COMP.
*      Transaction aborted
       01 XACT-ABORTED        PIC S9 USAGE COMP.
       PROCEDURE DIVISION.
       EXAMPLE SECTION.
       XBEGIN.

*      Set up error handling for main program
       EXEC SQL WHENEVER SQLWARNING CONTINUE END-EXEC.
       EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC.
       EXEC SQL WHENEVER SQLERROR STOP END-EXEC.
*      Start Ingres and the Ingres/FORMS system
       EXEC SQL CONNECT personnel END-EXEC.
       EXEC FRS FORMS END-EXEC.
*      Verify that the user can edit the "person" table
       EXEC FRS PROMPT NOECHO
               ('Password for table editor: ', :RESPBUF)
       END-EXEC.
       IF RESPBUF NOT = "MASTER_OF_ALL" THEN
                EXEC FRS MESSAGE 'No permission for task.
                     Exiting . . .' END-EXEC
                EXEC FRS ENDFORMS END-EXEC
                EXEC SQL DISCONNECT END-EXEC
                STOP RUN.

*      We assume no SQL errors can happen during screen updating
         EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC.
       EXEC FRS MESSAGE 'Initializing Person Form . . .' END-EXEC.
       EXEC FRS FORMINIT personfrm END-EXEC.
*       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 loaded into the
*       table field, hide the unique person number.
       EXEC FRS INITTABLE personfrm persontbl FILL
                                (number = integer)
         END-EXEC.
       PERFORM LOAD-TABLE THROUGH ENDLOAD-TABLE.
       EXEC FRS DISPLAY personfrm UPDATE END-EXEC
       EXEC FRS INITIALIZE END-EXEC
       EXEC FRS ACTIVATE MENUITEM 'Top' END-EXEC
       EXEC FRS BEGIN END-EXEC

*      Provide menu items, as well as the system FRS key,
*      to scroll to both extremes of the table field.
           EXEC FRS SCROLL personfrm persontbl TO 1 END-EXEC.
       EXEC FRS END END-EXEC
       EXEC FRS ACTIVATE MENUITEM 'Bottom' END-EXEC
       EXEC FRS BEGIN END-EXEC
           EXEC FRS SCROLL personfrm persontbl TO END END-EXEC.
       EXEC FRS END END-EXEC
       EXEC FRS ACTIVATE MENUITEM 'Remove' END-EXEC
       EXEC FRS BEGIN END-EXEC

*           Remove the person in the row the user's cursor is on.
*           If there are no persons, exit operation with message.
*           Note that this check cannot really happen, as there
*           is always an UNDEFINED row in FILL mode.
            EXEC FRS INQUIRE_FRS table personfrm
                     (:LASTROW = LASTROW(persontbl)) END-EXEC.
            IF LASTROW = 0 THEN
                  EXEC FRS MESSAGE 'Nobody to Remove' END-EXEC
                  EXEC FRS SLEEP 2 END-EXEC
                  EXEC FRS RESUME FIELD persontbl END-EXEC.
                  EXEC FRS DELETEROW personfrm persontbl END-EXEC.

       EXEC FRS END END-EXEC
       EXEC FRS ACTIVATE MENUITEM 'Find' END-EXEC
       EXEC FRS BEGIN END-EXEC
*       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.
           MOVE SPACES TO RESPBUF.
           EXEC FRS PROMPT ('Person''s name : ', :RESPBUF)
                                   END-EXEC.
           IF RESPBUF = SPACES THEN
                EXEC FRS RESUME FIELD persontbl END-EXEC.
                EXEC FRS UNLOADTABLE personfrm persontbl
                   (:PNAME = name,
                    :RECNUM = _record,
                    :STATE = _state)
                   END-EXEC
           EXEC FRS BEGIN END-EXEC

*              Compare name typed in with names in table, but do
*              not compare with deleted rows.
                 IF PNAME = RESPBUF AND
                     STATE NOT = ST-DELETE THEN
                      EXEC FRS SCROLL personfrm persontbl
                         TO :RECNUM END-EXEC
                      EXEC FRS RESUME FIELD persontbl END-EXEC.
           EXEC FRS END END-EXEC.

*          Fell out of loop without finding name. Inform user.
           STRING "Person """, RESPBUF,
                 """ not found in table [HIT RETURN] "
                 DELIMITED BY SIZE INTO MSGBUF.
           EXEC FRS PROMPT NOECHO (:MSGBUF, :RESPBUF) END-EXEC.
       EXEC FRS END END-EXEC
       EXEC FRS ACTIVATE MENUITEM 'Exit' END-EXEC
       EXEC FRS BEGIN END-EXEC
           EXEC FRS VALIDATE FIELD persontbl END-EXEC.
           EXEC FRS BREAKDISPLAY END-EXEC.
       EXEC FRS END END-EXEC
       EXEC FRS FINALIZE END-EXEC.

*      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, assign a unique person id to
*      each person before adding the person to the table. To
*      do this, increment the previously-saved maximum id
*      number with each insert.

*      Do all the updates in a transaction
       EXEC SQL COMMIT WORK END-EXEC.
*      Hard code the error handling in the UNLOADTABLE
*      loop, as we want to cleanly exit the loop.
       EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC.
       MOVE 0 TO UPDATE-ERROR.
       MOVE 0 TO XACT-ABORTED.
       EXEC FRS MESSAGE
               'Exiting Person Application .  .  .' END-EXEC.

       EXEC FRS UNLOADTABLE personfrm persontbl
               (:PNAME = name, :P-AGE = age,
                :PNUMBER = number, :STATE = _state)
             END-EXEC
       EXEC FRS BEGIN END-EXEC
*           Row appended by user.  Insert into "person" table
*           with new unique id.
            IF STATE = ST-NEW THEN
                    ADD 1 TO MAXID
                    EXEC SQL REPEATED INSERT INTO person
                        VALUES (:PNAME, :P-AGE, :MAXID) END-EXEC
*           Row updated by user.  Reflect in table.
            ELSE IF STATE = ST-CHANGE THEN
                   EXEC SQL REPEATED UPDATE person SET
                       name = :PNAME, age = :P-AGE
                       WHERE number = :PNUMBER
                       END-EXEC

*           Row deleted by user, so delete from table. Note that
*           rows appended by the user at runtime and the
*           deleted are not saved and are therefore not unloaded.
            ELSE IF STATE = ST-DELETE THEN
                   EXEC SQL REPEATED DELETE FROM person
                           WHERE number = :PNUMBER END-EXEC
            END-IF.
*           Else rows are UNDEFINED or UNCHANGED. No updates.
*           Handle error conditions: if an error occurred, abort
*           the transaction. If no rows were updated, inform user
*           and prompt for continuation.

            IF SQLCODE < 0 THEN
                    EXEC SQL
                        INQUIRE_SQL(:MSGBUF = ERRORTEXT) END-EXEC
                    EXEC SQL ROLLBACK WORK END-EXEC
                    MOVE 1 TO UPDATE-ERROR
                    MOVE 1 TO XACT-ABORTED
                    EXEC FRS ENDLOOP END-EXEC
            ELSE IF SQLCODE = NOT-FOUND THEN
                   STRING "Person """, PNAME,
                       """ not updated. Abort all updates? "
                       DELIMITED BY SIZE INTO MSGBUF
                   EXEC FRS PROMPT (:MSGBUF, :RESPBUF) END-EXEC
                   IF RESPBUF = "Y" OR RESPBUF = "y" THEN
                             EXEC SQL ROLLBACK WORK END-EXEC
                             MOVE 1 TO XACT-ABORTED
                             EXEC FRS ENDLOOP END-EXEC
                   END-IF
            END-IF.

       EXEC FRS END END-EXEC.
       IF XACT-ABORTED = 0 THEN
                EXEC SQL COMMIT END-EXEC.
       EXEC FRS ENDFORMS END-EXEC.
       EXEC SQL DISCONNECT END-EXEC.
       IF UPDATE-ERROR = 1 THEN
               DISPLAY
                  "Your updates were aborted because of error:"
               DISPLAY msgbuf.
       STOP RUN.

**
* Paragraph: LOAD-TABLE
*
* This paragraph opens a database cursor to load the table
* field with data from the "person" table. The columns
* "name" and "age" will be displayed, and "number" will be
* hidden. It sets the maximum employee number.
**
     LOAD-TABLE.
     EXEC SQL DECLARE loadtab CURSOR FOR
              SELECT name, age, number
              FROM person
              END-EXEC.
*    Set up error handling for loading procedure
     EXEC SQL WHENEVER SQLERROR GOTO LOAD-END END-EXEC.
     EXEC SQL WHENEVER NOT FOUND GOTO LOAD-END END-EXEC.
     EXEC FRS MESSAGE 
            'Loading Person Information .  .  .' END-EXEC.

*    Fetch the maximum person id number for later use
     EXEC SQL SELECT MAX(number) INTO :MAXID
            FROM person END-EXEC.
     EXEC SQL OPEN loadtab END-EXEC.
     PERFORM UNTIL SQLCODE NOT = 0
*            Fetch data into record and load table field
             EXEC SQL FETCH loadtab INTO :PERSONREC END-EXEC
             EXEC FRS LOADTABLE personfrm persontbl
              (name = :PNAME, age = :P-AGE, number = :PNUMBER)
                  END-EXEC
END-PERFORM.
LOAD-END.
     EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC.
     EXEC SQL CLOSE loadtab END-EXEC.
ENDLOAD-TABLE.
     EXIT 

IDENTIFICATION DIVISION.

PROGRAM-ID. TABLE-EDIT.
* Table Editor program. The main program initializes the database
* and displays a form that contains a single table field of
* personnel. It allows the user to add, change or delete the rows
* in the field. The program then makes the changes to the
* underlying database table in a multi-statement transaction.

ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
EXEC SQL INCLUDE SQLCA END-EXEC.
EXEC SQL DECLARE person TABLE
     (name       char(20),
      age        smallint,
      number     integer) 
      END-EXEC.
EXEC SQL BEGIN DECLARE SECTION END-EXEC.

* Person information
    01 PERSONREC.
       02 PNAME        PIC X(20).
       02 P-AGE        PIC S99 USAGE COMP.
       02 PNUMBER      PIC S9(6) USAGE COMP.
    01 MAXID           PIC S9(6) USAGE COMP.
* Table field entry information
    01 STATE           PIC S9 USAGE COMP.
    01 RECNUM          PIC S9(4) USAGE COMP.
    01 LASTROW         PIC S9 USAGE COMP.
* Utility buffers
    01 MSGBUF          PIC X(200).
    01 RESPBUF         PIC X(20).
EXEC SQL END DECLARE SECTION END-EXEC.

* 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-CHANGE     PIC S9 USAGE COMP VALUE 3.
* Deleted by program
 01 ST-DELETE     PIC S9 USAGE COMP VALUE 4.
* SQLCA value for no rows
 01 NOT-FOUND     PIC S9(3) USAGE COMP VALUE 100.
* Update error from database
 01 UPDATE-ERROR  PIC S9(2) USAGE COMP.
* Transaction aborted
 01 XACT-ABORTED  PIC S9 USAGE COMP.
PROCEDURE DIVISION.
BEGIN.

* Set up error handling for main program
      EXEC SQL WHENEVER SQLWARNING CONTINUE END-EXEC.
      EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC.
      EXEC SQL WHENEVER SQLERROR STOP END-EXEC.
* Start Ingres and the Ingres/FORMS system
      EXEC SQL CONNECT personnel END-EXEC.
      EXEC FRS FORMS END-EXEC.
* Verify that the user can edit the "person" table
      EXEC FRS PROMPT NOECHO
           ('Password for table editor: ', :RESPBUF)
           END-EXEC.
      IF RESPBUF NOT = "MASTER_OF_ALL" THEN
          EXEC FRS
                MESSAGE 'No permission for task. Exiting . . .'
                END-EXEC
          EXEC FRS ENDFORMS END-EXEC
          EXEC SQL DISCONNECT END-EXEC
          STOP RUN.

* We assume no SQL errors can happen during screen updating
      EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC.
      EXEC FRS MESSAGE 'Initializing Person Form . . .' END-EXEC.
      EXEC FRS FORMINIT personfrm END-EXEC.
* Initialize "persontbl" table field with a data set in FILL
* mode, so that the runtime user can append rows. To keep track
* of events occuring to original rows loaded into the table
* field, hide the unique person number.
      EXEC FRS INITTABLE personfrm persontbl FILL
                  (number = integer)
           END-EXEC.
      CALL "LOAD-TABLE" GIVING MAXID.
      EXEC FRS DISPLAY personfrm UPDATE END-EXEC
      EXEC FRS INITIALIZE END-EXEC
      EXEC FRS ACTIVATE MENUITEM 'Top' END-EXEC
      EXEC FRS BEGIN END-EXEC

* Provide menu items, as well as the system FRS key, to scroll
* to both extremes of the table field.
            EXEC FRS SCROLL personfrm persontbl TO 1 END-EXEC.
      EXEC FRS END END-EXEC
      EXEC FRS ACTIVATE MENUITEM 'Bottom' END-EXEC
      EXEC FRS BEGIN END-EXEC
            EXEC FRS SCROLL personfrm persontbl TO END END-EXEC.
      EXEC FRS END END-EXEC
      EXEC FRS ACTIVATE MENUITEM 'Remove' END-EXEC
      EXEC FRS BEGIN END-EXEC

* Remove the person in the row the user's cursor is on. If there
* are no persons, exit operation with message. Note that this
* check cannot really happen, as there is always an UNDEFINED row
* in FILL mode.

            EXEC FRS INQUIRE_FRS table personfrm
                 (:LASTROW = LASTROW(persontbl)) END-EXEC.
            IF LASTROW = 0 THEN
                  EXEC FRS MESSAGE 'Nobody to Remove' END-EXEC
                  EXEC FRS SLEEP 2 END-EXEC
                  EXEC FRS RESUME FIELD persontbl END-EXEC.
            EXEC FRS DELETEROW personfrm persontbl END-EXEC.
      EXEC FRS END END-EXEC
      EXEC FRS ACTIVATE MENUITEM 'Find' END-EXEC
      EXEC FRS BEGIN END-EXEC
* 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.

            MOVE SPACES TO RESPBUF.
            EXEC FRS PROMPT ('Person''s name : ', :RESPBUF)
                        END-EXEC.
            IF RESPBUF = " " THEN
                  EXEC FRS RESUME FIELD persontbl END-EXEC.
            EXEC FRS UNLOADTABLE personfrm persontbl
                 (:PNAME = name,
                  :RECNUM = _record,
                  :STATE = _state)
                  END-EXEC
            EXEC FRS BEGIN END-EXEC
* Compare name typed in with names in table, but do not compare
* with deleted rows.

                 IF PNAME = RESPBUF AND STATE NOT = ST-DELETE
                 THEN
                      EXEC FRS SCROLL personfrm persontbl
                            TO :RECNUM END-EXEC
                      EXEC FRS RESUME FIELD persontbl END-EXEC.
          EXEC FRS END END-EXEC.
* Fell out of loop without finding name. Inform user.
          STRING "Person """ RESPBUF
              """ not found in table [HIT RETURN] "
              DELIMITED BY SIZE INTO MSGBUF.
          EXEC FRS PROMPT NOECHO (:MSGBUF, :RESPBUF) END-EXEC.
    EXEC FRS END END-EXEC
    EXEC FRS ACTIVATE MENUITEM 'Exit' END-EXEC
    EXEC FRS BEGIN END-EXEC
          EXEC FRS VALIDATE FIELD persontbl END-EXEC.
          EXEC FRS BREAKDISPLAY END-EXEC.
    EXEC FRS END END-EXEC
    EXEC FRS FINALIZE END-EXEC.

* Exit person table editor and unload the table field. If any
* update, deletions or additions were made, duplicate these
* changes in the source table. If the user added new people,
* assign a unique person id to each person before adding the
* person to the table. To do this, increment the previously-saved
* maximum id number with each insert.
* Do all the updates in a transaction
      EXEC SQL COMMIT WORK END-EXEC.
* Hard code the error handling in the UNLOADTABLE loop, as we
* want to cleanly exit the loop.
      EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC.
      MOVE 0 TO UPDATE-ERROR.
      MOVE 0 TO XACT-ABORTED.
      EXEC FRS MESSAGE 'Exiting Person Application . . .'
                  END-EXEC.
      EXEC FRS UNLOADTABLE personfrm persontbl
          (:PNAME = name, :P-AGE = age,
           :PNUMBER = number, :STATE = _state)
           END-EXEC
      EXEC FRS BEGIN END-EXEC

* Row appended by user. Insert into "person" table with new
* unique id.
           IF STATE = ST-NEW THEN
              ADD 1 TO MAXID
               EXEC SQL INSERT INTO person (name, age, number)
                   VALUES (:PNAME, :P-AGE, :MAXID)
               END-EXEC
* Row updated by user. Reflect in table.
           ELSE IF STATE = ST-CHANGE THEN
               EXEC SQL UPDATE person SET
                    name = :PNAME, age = :P-AGE
                    WHERE number = :PNUMBER
                    END-EXEC
* Row deleted by user, so delete from table. Note that rows x
* unique by the user at runtime and then deleted are not saved
* and are therefore not unloaded.

           ELSE IF state = ST-DELETE THEN
                EXEC SQL DELETE FROM person
                     WHERE number = :PNUMBER END-EXEC
           END-IF.
* Else rows are UNDEFINED or UNCHANGED. No updates.

* Handle error conditions: if an error occurred, abort the
* transaction. If no rows were updated, inform user and prompt

* for continuation.
          IF SQLCODE < 0 THEN
                EXEC SQL INQUIRE_SQL(:MSGBUF = ERRORTEXT) END-EXEC
                EXEC SQL ROLLBACK WORK END-EXEC
                MOVE 1 TO UPDATE-ERROR
                MOVE 1 TO XACT-ABORTED
                EXEC FRS ENDLOOP END-EXEC
          ELSE IF SQLCODE = NOT-FOUND THEN
                STRING "Person """ PNAME
                    """ not updated. Abort all updates? "
                    DELIMITED BY SIZE INTO MSGBUF
                EXEC FRS PROMPT (:MSGBUF, :RESPBUF) END-EXEC
                IF RESPBUF = "Y" OR RESPBUF = "y" THEN
                      EXEC SQL ROLLBACK WORK END-EXEC
                      MOVE 1 TO XACT-ABORTED 
                      EXEC FRS ENDLOOP END-EXEC
                END-IF
          END-IF.

      EXEC FRS END END-EXEC.
      IF XACT-ABORTED = 0 THEN
          EXEC SQL COMMIT END-EXEC.
      EXEC FRS ENDFORMS END-EXEC.
      EXEC SQL DISCONNECT END-EXEC.
      IF UPDATE-ERROR = 1 THEN
            DISPLAY "Your updates were aborted because of error:"
            DISPLAY msgbuf.
      STOP RUN.
END PROGRAM TABLE-EDIT.
IDENTIFICATION DIVISION.
PROGRAM-ID. LOAD-TABLE.
* This procedure opens a database cursor to load the table field
* with data from the "person" table. The columns "name" and "age"
* will be displayed, and "number" will be hidden. It returns the
* maximum employee number.

ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
EXEC SQL INCLUDE SQLCA END-EXEC.
* Person information -- declared to preprocessor in main program
01 PERSONREC.
    02 PNAME          PIC X(20).
    02 P-AGE          PIC S99 USAGE COMP.
    02 PNUMBER        PIC S9(6) USAGE COMP.
01  MAXID             PIC S9(6) USAGE COMP.
PROCEDURE DIVISION GIVING MAXID.
BEGIN.
      EXEC SQL DECLARE loadtab CURSOR FOR
         SELECT name, age, number
         FROM person
         END-EXEC.

* Set up error handling for loading procedure
    EXEC SQL WHENEVER SQLERROR GOTO LOAD-END END-EXEC.
    EXEC SQL WHENEVER NOT FOUND GOTO LOAD-END END-EXEC.
    EXEC FRS MESSAGE 'Loading Person Information . . .' END-EXEC.
* Fetch the maximum person id number for later use
    EXEC SQL SELECT MAX(number) INTO :MAXID FROM person END-EXEC.
    EXEC SQL OPEN loadtab END-EXEC.
    PERFORM UNTIL SQLCODE NOT = 0
* Fetch data into record and load table field
          EXEC SQL FETCH loadtab INTO :PERSONREC END-EXEC
          EXEC FRS LOADTABLE personfrm persontbl
             (name = :PNAME, age = :P-AGE, number = :PNUMBER)
              END-EXEC
      END-PERFORM.
LOAD-END.
      EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC.
      EXEC SQL CLOSE loadtab END-EXEC.
      EXIT PROGRAM.
      END PROGRAM LOAD-TABLE.