C

C Program: ProfessorStudent
C Purpose: Main entry point into "Professor-Student" mixed-form 
C              master-detail application.
C
      program ProfessorStudent
      exec sql include sqlca

 

C Graduate student table
      exec sql declare student table
     1    (sname     char(25), 
     2     sage      integer1,
     3     sbdate    char(25), 
     4     sgpa      float4,
     5     sidno     integer4,
     6     scomment  char(200),
     7     sadvisor  char(25))

C Professor table
      exec sql declare professor table
     1     (pname    char(25), 
     2      pdept    char(10))

      exec sql begin declare section

C Externally compiled master and student form
           integer masterfrm, studentfrm
      exec sql end declare section
      external masterfrm, studentfrm

C Start up Ingres and the FORMS system
      exec frs forms
      exec sql whenever sqlerror stop
      exec frs message 'Initializing Student Administrator . . .'
      exec sql connect personnel
      exec frs addform :masterfrm
      exec frs addform :studentfrm
      call Master
      exec frs clear screen
      exec frs endforms
      exec sql disconnect
      end

C
C Subroutine: Master
C Purpose:    Drive the application, by running "masterfrm" and
C              allowing the user to "zoom" into a selected student.
C Parameters:
C              None - Uses the global student "grad" common area. 
C

      subroutine Master
      exec sql include sqlca
      exec sql begin declare section

 

C Global grad common area maps to database table
            character*25    sname
            integer*2       sage
            character*25    sbdate
            real            sgpa
            integer         sidno
            character*200   scomment
            character*25    sadvisor

 

C Professor info maps to database table
            character*25 pname
            character*10 pdept

C Useful forms system information
C Lastrow in table field
            integer lastrow 
C Is a table field?
            integer istable

C Local utility buffers
C Message buffer
            character*100 msgbuf 
C Response buffer
            character respbuf 
C Old advisor before ZOOM
            character*25 oldavisor
      exec sql end declare section

C Make definition global
      common /grad/ sgpa, sidno, sage, sname, sbdate, scomment, 
     1     sadvisor

C Function defined below
      logical StudentInfoChanged

C
C Initialize "studenttbl" with a data set in READ mode.
C Declare hidden columns for all the extra fields that
C the program will display when more information is
C requested about a student. Columns "sname" and "sage"
C are displayed. All other columns are hidden, to be
C used in the student information form.
C
      exec frs inittable masterfrm studenttbl read
     1    (sbdate = char(25),
     2     sgpa   = float4,
     3     sidno    = integer4,
     4     scomment = char(200),
     5     sadvisor = char(25))

      exec frs display masterfrm update
      exec frs initialize
      exec frs begin
          exec frs message 'Enter an Advisor name . . .'
          exec frs sleep 2
      exec frs end
      exec frs activate menuitem 'Students', field 'pname' 
      exec frs begin

C Load the students of the specified professor
           exec frs getform (:pname = pname)

C If no professor name is given, resume
           if (pname(1:1) .eq.' ') then
               exec frs resume field pname
           endif

C
C Verify that the professor exists. Local error
C handling just prints the message and continues.
C Assume that each professor has exactly one
C department.
C
           exec sql whenever sqlerror call sqlprint
           exec sql whenever not found continue
           pdept = ' '
           exec sql select pdept
     1          into :pdept
     2          from professor
     3          where pname = :pname
           if (pdept(1:1) .eq.' ') then
                write (msgbuf, 10) pname
10              format ('No professor with name "', a, 
     1                   '" [Press RETURN]')
                exec frs prompt noecho (:msgbuf, :respbuf)
                exec frs clear field all
                exec frs resume field pname
           endif

C Fill the department field and load students
           exec frs putform (pdept = :pdept)
C Refresh for query
           exec frs redisplay
           call loadstudents(pname)

           exec frs resume field studenttbl
      exec frs end
      exec frs activate menuitem 'Zoom'
      exec frs begin

C
C Confirm that user is in "studenttbl" and that
C the table field is not empty. Collect data from
C the row and zoom for browsing and updating.
C
           exec frs inquire_frs field masterfrm
     1         (:istable = table)

           if (istable .eq. 0) then
               exec frs prompt noecho
     1             ('Select from the student table [Press RETURN]',
     2               :respbuf)
               exec frs resume field studenttbl
           endif
           exec frs inquire_frs table masterfrm
     1          (:lastrow = lastrow)

           if (lastrow .eq. 0) then
                exec frs prompt noecho
     1              ('There are no students [Press RETURN]',
     2                :respbuf)
                exec frs resume field pname
           endif

C Collect all data on student into global record
           exec frs getrow masterfrm studenttbl
     1          (:sname = sname,
     2           :sage = sage,
     3           :sbdate = sbdate,
     4           :sgpa = sgpa,
     5           :sidno = sidno,
     6           :scomment = scomment,
     7           :sadvisor = sadvisor)

C
C Display "studentfrm", and if any changes were made,
C make the updates to the local table field row.
C Only make updates to the columns corresponding to
C writable fields in "studentfrm". If the student
C changed advisors, then delete the row from the
C display.
C
           oldavisor = sadvisor
           if (StudentInfoChanged()) then
                if (oldavisor .ne. sadvisor) then
                      exec frs deleterow masterfrm studenttbl
                else
                      exec frs putrow masterfrm studenttbl
     1                   (sgpa     = :sgpa,
     2                    scomment = :scomment,
     3                   sadvisor = :sadvisor)
                endif
           endif
      exec frs end
      exec frs activate menuitem 'Exit'
      exec frs begin
             exec frs breakdisplay
      exec frs end
      exec frs finalize
      end

C
C Subroutine:  LoadStudents
C Purpose:     Given an advisor name, load into the "studenttbl"
C              table field all the students who report to the
C              professor with that name.
C Parameters:
C              advisor - User-specified professor name.
C              Uses the global student record.
C
      subroutine LoadStudents(advisor)

      exec sql include sqlca
      exec sql begin declare section
             character*(*) advisor
      exec sql end declare section

C Global "grad" common fields
          character*25     sname
          integer*2        sage
          character*25     sbdate
          real             sgpa
          integer          sidno
          character*200    scomment
          character*25     sadvisor
      common /grad/ sgpa, sidno, sage, sname, sbdate, scomment,
     1           sadvisor
       exec sql declare studentcsr cursor for
     1      select sname, sage, sbdate, sgpa,
     2          sidno, scomment, sadvisor
     3          from student
     4          where sadvisor = :advisor

C
C Clear previous contents of table field. Load the table
C field from the database table based on the advisor name.
C Columns "sname" and "sage" will be displayed, and all
C others will be hidden.
C
      exec frs message 'Retrieving Student Information . . .'
      exec frs clear field studenttbl

C End loading
      exec sql whenever sqlerror go to 100 
      exec sql whenever not found go to 100
      exec sql open studentcsr

C
C Before we start the loop, we know that the OPEN was
C successful and that NOT FOUND was not set.
C
55    if (sqlcod .ne. 0) go to 555
       exec sql fetch studentcsr into :sname, :sage, :sbdate, 
      1     sgpa, :sidno, :scomment, :sadvisor
       exec frs loadtable masterfrm studenttbl
     1   (sname    = :sname,
     2    sage     = :sage,
     3    sbdate   = :sbdate,
     4    sgpa     = :sgpa,
     5    sidno    = :sidno,
     6    scomment = :scomment,
     7    sadvisor = :sadvisor)

      go to 55

555   continue

C Clean up on an error, and close cursors
      exec sql whenever not found continue

100   exec sql whenever sqlerror continue
      exec sql close studentcsr
      end

C
C Function: StudentInfoChanged
C Purpose:  Allow the user to zoom into the details of a selected
C            student. Some of the data can be updated by the user.
C            If any updates were made, then reflect these back into
C            the database table. The procedure returns TRUE if any
C            changes were made.
C Parameters:
C            None - Uses data in the global "grad" common area.
C Returns:
C           true/false - Changes were made to the database.
C           Sets the global "grad" common area with the new data.
C
      logical function StudentInfoChanged()
      exec sql include sqlca
      exec sql begin declare section
C Changes made to data in form
          integer changed 
C Valid advisor name?
          integer validadvisor
      exec sql end declare section

C Global "grad" common fields
      character*25   sname     
      integer*2      sage
      character*25   sbdate
      real           sgpa
      integer        sidno
      character*200  scomment
      character*25   sadvisor
      common /grad/ sgpa, sidno, sage, sname, sbdate, scomment,
     1      sadvisor

C Local error handler just prints error and continues 
      exec sql whenever sqlerror call sqlprint
      exec sql whenever not found continue
      exec frs display studentfrm fill
      exec frs initialize
     1     (sname = :sname,
     2      sage = :sage,
     3      sbdate = :sbdate,
     4      sgpa = :sgpa,
     5      sidno = :sidno,
     6      scomment = :scomment,
     7      sadvisor = :sadvisor)

      exec frs activate menuitem 'Write'
      exec frs begin

C
C If changes were made, then update the database
C table. Only bother with the fields that are not
C read-only.
C
           exec frs inquire_frs form (:changed = change)

           if (changed .eq. 1) then
                exec frs validate
                exec frs getform
     1               (:sgpa = sgpa,
     2                :scomment = scomment,
     3                :sadvisor = sadvisor)

C Enforce integrity of professor name
                validadvisor = 0
                exec sql select 1 into :validadvisor
     1               from professor
     2               where pname = :sadvisor
                if (validadvisor .eq. 0) then
                     exec frs message 'Not a valid advisor name'
                     exec frs sleep 2
                     exec frs resume field sadvisor
                endif
                exec frs message 'Writing changes to database. . .'
                exec sql update student set
     1                sgpa = :sgpa,
     2                scomment = :scomment,
     3                sadvisor = :sadvisor
     4                where sidno = :sidno
           endif
           exec frs breakdisplay
      exec frs end
      exec frs activate menuitem 'Quit'
      exec frs begin
C Quit without submitting changes
           changed = 0
           exec frs breakdisplay
      exec frs end
      exec frs finalize
      StudentInfoChanged = (changed .EQ. 1)

      end