C Program: TableEdit
C Purpose: entry point to edit the "person"
C           table in the database,
C           via a table field.

      program TableEdit
      exec sql include sqlca
      exec sql declare person table
     1 (name  char(20),
     2 age    integer2,
     3 number integer4)

      exec sql begin declare section

C Person information
           character*20   pname
           integer        page
           integer        pnum
           integer maxid

C Table field entry information
C State of data set entry
           integer state 
C Record number
           integer    recnum 
C Last row in table field
           integer    lastrow

C Utility buffers
C Message buffer
           character*100 msgbuf 
C Response buffer for prompts
           character*20 respbuf
      exec sql end declare section

C Update error from database
      logical updaterr
C Transaction aborted
      logical xaborted

C Function to fill table field
      integer LoadTable

C Table field row states
C Empty or undefined row
      parameter (rowundef = 0)
C Appended by user
      parameter (rownew = 1)
C Loaded by program - not updated
      parameter (rowunchanged = 2)
C Loaded by program - since changed
      parameter (rowchanged = 3)
C Deleted by program
      parameter (rowdeleted = 4)

C SQL value for no rows
      parameter (notfound = 100)

C Set up error handling for main program
      exec sql whenever sqlwarning continue
      exec sql whenever not found continue
      exec sql whenever sqlerror stop

C Start up Ingres and the FORMS system
      exec sql connect 'personnel'
      exec frs forms

C Verify that the user can edit the "person" table 
   exec frs prompt noecho ('Password for table editor: ', :respbuf)

      if (respbuf .ne. 'MASTER_OF_ALL') then
           exec frs endforms
           exec sql disconnect
           stop 'No permission for task. Exiting . . .'
      endif

C Assume no SQL errors can happen during screen updating 
      exec sql whenever sqlerror continue
      exec frs message 'Initializing Person Form . . .' 
      exec frs forminit personfrm

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

    exec frs inittable personfrm persontbl fill (number = integer4)

      maxid = LoadTable()
      exec frs display personfrm update
      exec frs initialize
      exec frs activate menuitem 'Top'
      exec frs begin

C
C Provide menu items to scroll to both extremes of
C the table field.
C
           exec frs scroll personfrm persontbl to 1
      exec frs end
      exec frs activate menuitem 'Bottom'
      exec frs begin
           exec frs scroll personfrm persontbl to end 
      exec frs end
      exec frs activate menuitem 'Remove'
      exec frs begin

C
C Remove the person in the row the user's cursor is on.
C If there are no persons, exit operation with message.
C Note that this check cannot really happen, as there is
C always an UNDEFINED row in FILL mode.
C
           exec frs inquire_frs table personfrm
     1           (lastrow = lastrow(persontbl))
           if (lastrow .eq. 0) then
                exec frs message 'Nobody to Remove'
                exec frs sleep 2
                exec frs resume field persontbl
           endif

C Record it later
           exec frs deleterow personfrm persontbl
      exec frs end
      exec frs activate menuitem 'Find'
      exec frs begin
C
C Scroll user to the requested table field entry.
C Prompt the user for a name, and if one is typed in,
C loop through the data set searching for it.
C
          exec frs prompt ('Person''s name : ', :respbuf)
          if (respbuf(1:1) .eq. ' ') then
               exec frs resume field persontbl
          endif
          exec frs unloadtable personfrm persontbl
     1           (:pname  = name,
     2            :recnum = _record,
     3            :state  = _state)
          exec frs begin

C Do not compare with deleted rows
              if ((pname .eq. respbuf) .and.
     1            (state .ne. rowdeleted)) then
                   exec frs scroll personfrm persontbl
     1                 to :recnum
                   exec frs resume field persontbl
              endif
          exec frs end

C Fell out of loop without finding name
          write (msgbuf, 10) respbuf 
10        format ('Person "', a, 
     1         '" not found in table [HIT RETURN] ')
          exec frs prompt noecho (:msgbuf, :respbuf)

      exec frs end
      exec frs activate menuitem 'Exit'
      exec frs begin
          exec frs validate field persontbl
          exec frs breakdisplay
      exec frs end
      exec frs finalize

C
C Exit person table editor and unload the table field. If any
C updates, deletions or additions were made, duplicate these
C changes in the source table. If the user added new people,
C assign a unique person id to each person before adding the person
C to the table. To do this, increment the previously-saved maximum
C id number with each insert.
C

C Do all the updates in a transaction
      exec sql savepoint savept

C
C Hard code the error handling in the UNLOADTABLE loop, in 
C order to cleanly exit the loop.
C
      exec sql whenever sqlerror continue
      updaterr = .false.
      xaborted = .false.

      exec frs message 'Exiting Person Application . . .'
      exec frs unloadtable personfrm persontbl
     1      (:pname = name, :page = age,
     2       :pnum = number, :state = _state)
      exec frs begin

C Appended by user. Insert with new unique id.
           if (state .eq. rownew) then
                maxid = maxid + 1
                exec sql insert into person (name, age, number)
     1                 values (:pname, :page, :maxid)

C Updated by user. Reflect in table.
           else if (state .eq. rowchanged) then
                exec sql update person set
     1               name = :pname, age = :page
     2               where number = :pnum
C
C Deleted by user, so delete from table. Note that only
C original rows, not rows appended at runtime, are saved
C by the program.
C
           else if (state .eq. rowdeleted) then
                exec sql delete from person
     1               where number = :pnum

C Ignore UNDEFINED or UNCHANGED - No updates
           endif

C
C Handle error conditions -
C If an error occurred, abort the transaction.
C If no rows were updated, inform user and prompt
C for continuation.
C
           if (sqlcod .lt. 0) then 
C SQL error
                exec sql inquire_sql (:msgbuf = errortext)
                exec sql rollback to savept
                updaterr = .true.
                xaborted = .true.
                exec frs endloop
           else if (sqlcod .eq. notfound) then
                write (msgbuf, 11) pname 
11              format ('Person "', a, 
     1                        '" not updated. Abort all updates?')
                exec frs prompt (:msgbuf, :respbuf)
                if ((respbuf(1:1) .eq. 'y') .or.
     1               (respbuf(1:1) .eq. 'y')) then
                     exec sql rollback to savept
                     xaborted = .true.
                     exec frs endloop
                endif
           endif
      exec frs end
      if (.not. xaborted) then
C Commit the updates
            exec sql commit
      endif

C Terminate the FORMS and Ingres
      exec frs endforms
      exec sql disconnect
        if (updaterr) then
            print *, 'Your updates were aborted because of error:'
            print *, msgbuf
        endif
        end

C
C Function:   LoadTable
C Purpose:        Load the table field from the 'person' table. The
C             columns 'name' and 'age' will be displayed, and
C             'number' will be hidden.
C Parameters: None
C Returns:    Maximum employee number
C
      integer function LoadTable()
      exec sql include sqlca
C
C Declare person information:
C The preprocessor already knows that these variables have been
C declared, from their declarations in the main program.
C
      character*20 pname
      integer      page
      integer      pnum

C Max person id number to return
      integer maxid
      exec sql declare loadtab cursor for
     1    select name, age, number
     2    from person

C Set up error handling for loading procedure
C Close loadtab
      exec sql whenever sqlerror go to 100 
C Close loadtab
      exec sql whenever not found go to 100
      exec frs message 'Loading Person Information . . .'
      maxid = 0

C Fetch the maximum person id number for later use 
      exec sql select max(number)
     1      into :maxid
     2      from person
      exec sql open loadtab

55    if (sqlcod .ne. 0) go to 555

C Fetch data into record and load table field
      exec sql fetch loadtab into :pname, :page, :pnum
      exec frs loadtable personfrm persontbl
     1      (name = :pname, age = :page, number = :pnum)

      go to 55

555   continue
      exec sql whenever sqlerror continue

100   exec sql close loadtab
      LoadTable = maxid
      end