* 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