The Professor–Student Mixed Form Application
This application lets the user browse and update information about graduate students who report to a specific professor. The program is structured in a master/detail fashion, with the professor being the master entry, and the students the detail entries. The application uses two forms—one to contain general professor information and another for detailed student information.
The objects used in this application are shown in the following table:
Object | Description |
|---|---|
personnel | The program's database environment. |
professor | A database table with two columns: pname (char(25)) pdept (char(10)). See its declare table statement in the program for a full description. |
student | A database table with seven columns: sname (char(25)) sage (integer1) sbdate (char(25)) sgpa (float4) dofmp (integer) scomment (varchar(200)) sadvisor (char(25)). See its declare table statement for a full description. The sadvisor column is the join field with the pname column in the Professor table. |
masterfrm | The main form has the pname and pdept fields, which correspond to the information in the Professor table, and the studenttbl table field. The pdept field is display‑only. |
studenttbl | A table field in "masterfrm" with two columns, sname and sage. When initialized, it also has five hidden columns corresponding to information in the Student table. |
studentfrm | The detail form, with seven fields, which correspond to information in the Student table. Only the sgpa, scomment, and sadvisor fields are updatable. All other fields are display‑only. |
grad | A structure whose members correspond in name and type to the columns of the Student database table, the studentfrm form and the studenttbl table field. |
The program uses the masterfrm as the general‑level master entry, in which data can only be retrieved and browsed, and the studentfrm as the detailed screen, in which specific student information can be updated.
The runtime user enters a name in the pname field and then selects the Students menu operation. The operation fills the studenttbl table field with detailed information of the students reporting to the named professor. This is done by the database cursor "studentcsr" in the LOAD‑STUDENTS paragraph. The program assumes that each professor is associated with exactly one department. The user may then browse the table field (in read mode), which displays only the names and ages of the students. More information about a specific student may be requested by selecting the Zoom menu operation. This operation displays the form studentfrm (in update mode). The fields of studentfrm are filled with values stored in the hidden columns of studenttbl. The user may make changes to three fields (sgpa, scomment, and sadvisor). If validated, these changes will be written back to the database table (based on the unique student id), and to the table field's data set. This process can be repeated for different professor names.
Windows and UNIX:
IDENTIFICATION DIVISION.
PROGRAM-ID. STUDENT-ADMINISTRATOR.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
WORKING-STORAGE SECTION.
EXEC SQL INCLUDE SQLCA END-EXEC.
* Graduate student table
EXEC SQL DECLARE student TABLE
(sname char(25),
sage integer1,
sbdate char(25),
sgpa float4,
sidno integer,
scomment varchar(200),
sadvisor char(25))
END-EXEC.
EXEC SQL DECLARE student TABLE
(sname char(25),
sage integer1,
sbdate char(25),
sgpa float4,
sidno integer,
scomment varchar(200),
sadvisor char(25))
END-EXEC.
* Professor table
EXEC SQL DECLARE professor TABLE
(pname char(25),
pdept char(10))
END-EXEC.
EXEC SQL DECLARE professor TABLE
(pname char(25),
pdept char(10))
END-EXEC.
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
* Global grad student record maps to database table
01 GRAD.
02 SNAME PIC X(25).
02 SAGE PIC S9(4) USAGE COMP.
02 SBDATE PIC X(25).
02 SGPA PIC S9(10)V9(8) USAGE COMP.
02 SIDNO PIC S9(9) USAGE COMP.
02 SCOMMENT PIC X(200).
02 SADVISOR PIC X(25).
01 GRAD.
02 SNAME PIC X(25).
02 SAGE PIC S9(4) USAGE COMP.
02 SBDATE PIC X(25).
02 SGPA PIC S9(10)V9(8) USAGE COMP.
02 SIDNO PIC S9(9) USAGE COMP.
02 SCOMMENT PIC X(200).
02 SADVISOR PIC X(25).
* Professor info maps to database table
01 PROF.
02 PNAME PIC X(25).
02 PDEPT PIC X(10).
01 PROF.
02 PNAME PIC X(25).
02 PDEPT PIC X(10).
* Row number of last row in student table field
01 LASTROW PIC S9(9) USAGE COMP.
01 LASTROW PIC S9(9) USAGE COMP.
* Is user on a table field?
01 ISTABLE PIC S9 USAGE COMP.
01 ISTABLE PIC S9 USAGE COMP.
* Were changes made to data in "studentfrm"?
01 CHANGED-DATA PIC S9 USAGE COMP.
01 CHANGED-DATA PIC S9 USAGE COMP.
Did user enter a valid advisor name?
01 VALID-ADVISOR PIC S9 USAGE COMP.
01 VALID-ADVISOR PIC S9 USAGE COMP.
* "Studentfrm" loaded?
01 LOADFORM PIC S9 USAGE COMP VALUE IS 0.
01 LOADFORM PIC S9 USAGE COMP VALUE IS 0.
* Local utility buffers
01 MSGBUF PIC X(200).
01 RESPBUF PIC X.
01 OLD-ADVISOR PIC X(25).
01 MSGBUF PIC X(200).
01 RESPBUF PIC X.
01 OLD-ADVISOR PIC X(25).
* Compiled forms are not yet accepted as
* EXTERNAL due to restrictions noted in the chapter
* that describes how to link the RTS with compiled
* forms. Consequently, declarations of external
* form objects and the corresponding ADDFORM
* statement have been commented out and replaced by
* a CALL "add_formname" statement.
* 01 masterfrm PIC S9(9) USAGE COMP-5 IS EXTERNAL.
* 01 studentfrm PIC S9(9) USAGE COMP-5 IS EXTERNAL.
* EXTERNAL due to restrictions noted in the chapter
* that describes how to link the RTS with compiled
* forms. Consequently, declarations of external
* form objects and the corresponding ADDFORM
* statement have been commented out and replaced by
* a CALL "add_formname" statement.
* 01 masterfrm PIC S9(9) USAGE COMP-5 IS EXTERNAL.
* 01 studentfrm PIC S9(9) USAGE COMP-5 IS EXTERNAL.
EXEC SQL END DECLARE SECTION END-EXEC.
**
**
* Procedure Division: STUDENT-ADMINISTRATOR
*
* Start up program, Ingres and the FORMS system and
* call Master driver.
**
PROCEDURE DIVISION.
EXAMPLE SECTION.
XBEGIN.
*
* Start up program, Ingres and the FORMS system and
* call Master driver.
**
PROCEDURE DIVISION.
EXAMPLE SECTION.
XBEGIN.
EXEC FRS FORMS END-EXEC.
EXEC SQL WHENEVER SQLERROR STOP END-EXEC.
EXEC FRS MESSAGE 'Initializing Student
Administrator . .' END-EXEC.
EXEC SQL WHENEVER SQLERROR STOP END-EXEC.
EXEC FRS MESSAGE 'Initializing Student
Administrator . .' END-EXEC.
EXEC SQL CONNECT personnel END-EXEC.
PERFORM MASTER THRU END-MASTER.
EXEC FRS CLEAR SCREEN END-EXEC.
EXEC FRS ENDFORMS END-EXEC.
EXEC SQL DISCONNECT END-EXEC.
STOP RUN.
**
EXEC FRS ENDFORMS END-EXEC.
EXEC SQL DISCONNECT END-EXEC.
STOP RUN.
**
* Paragraph: MASTER
*
* Drive the application, by running "masterfrm", and
* allowing the user to "zoom" into a selected student.
**
MASTER.
* EXEC FRS ADDFORM :masterfrm END-EXEC.
CALL "add_masterfrm".
* Initialize "studenttbl" with a data set in READ mode.
* Declare hidden columns for all the extra fields that the
* program will display when more information is requested
* about a student. Columns "sname" and "sage" are displayed,
* all other columns are hidden, the student information
* form.
*
* Drive the application, by running "masterfrm", and
* allowing the user to "zoom" into a selected student.
**
MASTER.
* EXEC FRS ADDFORM :masterfrm END-EXEC.
CALL "add_masterfrm".
* Initialize "studenttbl" with a data set in READ mode.
* Declare hidden columns for all the extra fields that the
* program will display when more information is requested
* about a student. Columns "sname" and "sage" are displayed,
* all other columns are hidden, the student information
* form.
EXEC FRS INITTABLE masterfrm studenttbl READ
(sbdate = char(25),
sgpa = float4,
sidno = integer,
scomment = char(200),
sadvisor = char(20))
END-EXEC.
EXEC FRS DISPLAY masterfrm UPDATE END-EXEC
EXEC FRS INITIALIZE END-EXEC
(sbdate = char(25),
sgpa = float4,
sidno = integer,
scomment = char(200),
sadvisor = char(20))
END-EXEC.
EXEC FRS DISPLAY masterfrm UPDATE END-EXEC
EXEC FRS INITIALIZE END-EXEC
EXEC FRS BEGIN END-EXEC
EXEC FRS MESSAGE
'Enter an Advisor name . . .' END-EXEC.
EXEC FRS SLEEP 2 END-EXEC.
EXEC FRS END END-EXEC
EXEC FRS MESSAGE
'Enter an Advisor name . . .' END-EXEC.
EXEC FRS SLEEP 2 END-EXEC.
EXEC FRS END END-EXEC
EXEC FRS ACTIVATE MENUITEM
'Students', FIELD 'pname' END-EXEC
EXEC FRS BEGIN END-EXEC
'Students', FIELD 'pname' END-EXEC
EXEC FRS BEGIN END-EXEC
* Load the students of the specified professor
EXEC FRS GETFORM (:PNAME = pname) END-EXEC
EXEC FRS GETFORM (:PNAME = pname) END-EXEC
* If no professor name is given, resume
IF PNAME = SPACES THEN
EXEC FRS RESUME FIELD pname END-EXEC.
IF PNAME = SPACES THEN
EXEC FRS RESUME FIELD pname END-EXEC.
* Verify the professor exists. Local error handling
* just prints the message, and continues. We assume
* that each professor has exactly one department.
* just prints the message, and continues. We assume
* that each professor has exactly one department.
EXEC SQL WHENEVER SQLERROR CALL SQLPRINT END-EXEC.
EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC.
MOVE SPACES TO PDEPT.
EXEC SQL SELECT pdept
INTO :PDEPT
FROM professor
WHERE pname = :PNAME
END-EXEC.
EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC.
MOVE SPACES TO PDEPT.
EXEC SQL SELECT pdept
INTO :PDEPT
FROM professor
WHERE pname = :PNAME
END-EXEC.
IF PDEPT = SPACES THEN
STRING "No professor with name """, PNAME,
""" [RETURN]" DELIMITED BY SIZE
INTO MSGBUF
EXEC FRS PROMPT NOECHO (:MSGBUF, :RESPBUF)
END-EXEC
EXEC FRS CLEAR FIELD ALL END-EXEC
EXEC FRS RESUME FIELD pname END-EXEC.
STRING "No professor with name """, PNAME,
""" [RETURN]" DELIMITED BY SIZE
INTO MSGBUF
EXEC FRS PROMPT NOECHO (:MSGBUF, :RESPBUF)
END-EXEC
EXEC FRS CLEAR FIELD ALL END-EXEC
EXEC FRS RESUME FIELD pname END-EXEC.
* Fill the department field and load students
EXEC FRS PUTFORM (pdept = :PDEPT) END-EXEC.
EXEC FRS PUTFORM (pdept = :PDEPT) END-EXEC.
* Refresh for query
EXEC FRS REDISPLAY END-EXEC.
EXEC FRS REDISPLAY END-EXEC.
PERFORM LOAD-STUDENTS THRU END-LOAD.
EXEC FRS RESUME FIELD studenttbl END-EXEC.
EXEC FRS RESUME FIELD studenttbl END-EXEC.
EXEC FRS END END-EXEC
EXEC FRS ACTIVATE MENUITEM 'Zoom' END-EXEC
EXEC FRS BEGIN END-EXEC
* Confirm that user is on "studenttbl", and that the
* table field is not empty. Collect data from the row
* and zoom for browsing and updating.
EXEC FRS INQUIRE_FRS field
masterfrm (:ISTABLE = table)
END-EXEC.
* table field is not empty. Collect data from the row
* and zoom for browsing and updating.
EXEC FRS INQUIRE_FRS field
masterfrm (:ISTABLE = table)
END-EXEC.
IF ISTABLE = 0 THEN
EXEC FRS PROMPT NOECHO
('Select from the student
table [RETURN]',
:RESPBUF) END-EXEC
EXEC FRS PROMPT NOECHO
('Select from the student
table [RETURN]',
:RESPBUF) END-EXEC
EXEC FRS RESUME FIELD studenttbl END-EXEC.
EXEC FRS INQUIRE_FRS table masterfrm
(:LASTROW = lastrow) END-EXEC.
EXEC FRS INQUIRE_FRS table masterfrm
(:LASTROW = lastrow) END-EXEC.
IF LASTROW = 0 THEN
EXEC FRS PROMPT NOECHO
('There are no students [RETURN]',
:RESPBUF) END-EXEC
EXEC FRS PROMPT NOECHO
('There are no students [RETURN]',
:RESPBUF) END-EXEC
EXEC FRS RESUME FIELD pname END-EXEC.
* Collect all data on student into global record
EXEC FRS GETROW masterfrm studenttbl
(:SNAME = sname,
:SAGE = sage,
:SBDATE = sbdate,
:SGPA = sgpa,
:SIDNO = sidno,
:SCOMMENT = scomment,
:SADVISOR = sadvisor)
END-EXEC.
EXEC FRS GETROW masterfrm studenttbl
(:SNAME = sname,
:SAGE = sage,
:SBDATE = sbdate,
:SGPA = sgpa,
:SIDNO = sidno,
:SCOMMENT = scomment,
:SADVISOR = sadvisor)
END-EXEC.
* Display "studentfrm", and if any changes were made
* make the updates to the local table field row. Only
* updates to the columns corresponding to writable fields
* in "studentfrm". If the student changed advisors, then
* delete this row from the display.
* make the updates to the local table field row. Only
* updates to the columns corresponding to writable fields
* in "studentfrm". If the student changed advisors, then
* delete this row from the display.
MOVE SADVISOR TO OLD-ADVISOR.
PERFORM STUDENT-INFO-CHANGED THRU END-STUDENT.
PERFORM STUDENT-INFO-CHANGED THRU END-STUDENT.
IF CHANGED-DATA = 1 THEN
IF OLD-ADVISOR NOT = SADVISOR THEN
EXEC FRS DELETEROW masterfrm studenttbl
END-EXEC
ELSE
EXEC FRS PUTROW masterfrm studenttbl
(sgpa = :SGPA,
scomment = :SCOMMENT,
sadvisor = :SADVISOR)
END-EXEC
IF OLD-ADVISOR NOT = SADVISOR THEN
EXEC FRS DELETEROW masterfrm studenttbl
END-EXEC
ELSE
EXEC FRS PUTROW masterfrm studenttbl
(sgpa = :SGPA,
scomment = :SCOMMENT,
sadvisor = :SADVISOR)
END-EXEC
END-IF
END-IF.
END-IF.
EXEC FRS END END-EXEC
EXEC FRS ACTIVATE MENUITEM 'Exit' END-EXEC
EXEC FRS BEGIN END-EXEC
EXEC FRS BREAKDISPLAY END-EXEC.
EXEC FRS END END-EXEC
EXEC FRS BEGIN END-EXEC
EXEC FRS BREAKDISPLAY END-EXEC.
EXEC FRS END END-EXEC
EXEC FRS FINALIZE END-EXEC
END-MASTER.
EXIT.
EXIT.
**
* Paragraph: LOAD-STUDENTS
*
* For the current professor name, this paragraph loads into
* the "studenttbl" table field all the students whose
* advisor is the professor with that name.
**
* Paragraph: LOAD-STUDENTS
*
* For the current professor name, this paragraph loads into
* the "studenttbl" table field all the students whose
* advisor is the professor with that name.
**
LOAD-STUDENTS.
EXEC SQL DECLARE studentcsr CURSOR FOR
SELECT sname, sage, sbdate, sgpa,
sidno, scomment, sadvisor
FROM student
WHERE sadvisor = :PNAME
END-EXEC.
SELECT sname, sage, sbdate, sgpa,
sidno, scomment, sadvisor
FROM student
WHERE sadvisor = :PNAME
END-EXEC.
* Clear previous contents of table field. Load the table
* field from the database table based on the advisor name.
* Columns "sname" and "sage" will be displayed, and all
* others will be hidden.
* field from the database table based on the advisor name.
* Columns "sname" and "sage" will be displayed, and all
* others will be hidden.
EXEC FRS MESSAGE 'Retrieving Student Information . . .'
END-EXEC.
EXEC FRS CLEAR FIELD studenttbl END-EXEC.
END-EXEC.
EXEC FRS CLEAR FIELD studenttbl END-EXEC.
EXEC SQL WHENEVER SQLERROR GOTO END-LOAD END-EXEC.
EXEC SQL WHENEVER NOT FOUND GOTO END-LOAD END-EXEC.
EXEC SQL WHENEVER NOT FOUND GOTO END-LOAD END-EXEC.
EXEC SQL OPEN studentcsr END-EXEC.
* Before we start the loop, we know that the OPEN was
* successful and that NOT FOUND was not set.
* successful and that NOT FOUND was not set.
PERFORM UNTIL SQLCODE NOT = 0
EXEC SQL FETCH studentcsr INTO :GRAD END-EXEC
EXEC FRS LOADTABLE masterfrm studenttbl
(sname = :SNAME,
sage = :SAGE,
sbdate = :SBDATE,
sgpa = :SGPA,
sidno = :SIDNO,
scomment = :SCOMMENT,
sadvisor = :SADVISOR)
END-EXEC
END-PERFORM.
END-LOAD.
EXEC SQL FETCH studentcsr INTO :GRAD END-EXEC
EXEC FRS LOADTABLE masterfrm studenttbl
(sname = :SNAME,
sage = :SAGE,
sbdate = :SBDATE,
sgpa = :SGPA,
sidno = :SIDNO,
scomment = :SCOMMENT,
sadvisor = :SADVISOR)
END-EXEC
END-PERFORM.
END-LOAD.
* Clean up on an error, and close cursors
EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC.
EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC.
EXEC SQL CLOSE studentcsr END-EXEC.
**
* Paragraph: STUDENT-INFO-CHANGED
*
* Allow the user to zoom into the details of a selected
* student. Some of the data can be updated by the user.
* If any updates were made, then reflect these back into
* the database table. The paragraph records whether or not
* changes were made via the CHANGED-DATA variable.
EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC.
EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC.
EXEC SQL CLOSE studentcsr END-EXEC.
**
* Paragraph: STUDENT-INFO-CHANGED
*
* Allow the user to zoom into the details of a selected
* student. Some of the data can be updated by the user.
* If any updates were made, then reflect these back into
* the database table. The paragraph records whether or not
* changes were made via the CHANGED-DATA variable.
**
STUDENT-INFO-CHANGED.
STUDENT-INFO-CHANGED.
* Control ADDFORM to only initialize once
IF LOADFORM = 0 THEN
EXEC FRS MESSAGE 'Loading Student form . . .' END-EXEC
EXEC FRS ADDFORM :studentfrm END-EXEC
CALL "add_studentfrm"
MOVE 1 TO LOADFORM.
IF LOADFORM = 0 THEN
EXEC FRS MESSAGE 'Loading Student form . . .' END-EXEC
EXEC FRS ADDFORM :studentfrm END-EXEC
CALL "add_studentfrm"
MOVE 1 TO LOADFORM.
* Local error handle just prints error and continues
EXEC SQL WHENEVER SQLERROR CALL SQLPRINT END-EXEC.
EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC.
EXEC FRS DISPLAY studentfrm FILL END-EXEC
EXEC FRS INITIALIZE
(sname = :SNAME,
sage = :SAGE,
sbdate = :SBDATE,
sgpa = :SGPA,
sidno = :SIDNO,
scomment = :SCOMMENT,
sadvisor = :SADVISOR)
END-EXEC
EXEC SQL WHENEVER SQLERROR CALL SQLPRINT END-EXEC.
EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC.
EXEC FRS DISPLAY studentfrm FILL END-EXEC
EXEC FRS INITIALIZE
(sname = :SNAME,
sage = :SAGE,
sbdate = :SBDATE,
sgpa = :SGPA,
sidno = :SIDNO,
scomment = :SCOMMENT,
sadvisor = :SADVISOR)
END-EXEC
EXEC FRS ACTIVATE MENUITEM 'Write' END-EXEC
EXEC FRS BEGIN END-EXEC
EXEC FRS BEGIN END-EXEC
* If changes were made, update the database table.
* Only bother with the fields that are not read-only.
* Only bother with the fields that are not read-only.
EXEC FRS INQUIRE_FRS form (:CHANGED-DATA = change)
END-EXEC.
END-EXEC.
IF CHANGED-DATA = 0 THEN
EXEC FRS BREAKDISPLAY END-EXEC.
EXEC FRS BREAKDISPLAY END-EXEC.
EXEC FRS VALIDATE END-EXEC.
EXEC FRS MESSAGE
'Writing changes to database. . .' END-EXEC.
EXEC FRS GETFORM
(:SGPA = sgpa,
:SCOMMENT = scomment,
:SADVISOR = sadvisor)
END-EXEC.
EXEC FRS MESSAGE
'Writing changes to database. . .' END-EXEC.
EXEC FRS GETFORM
(:SGPA = sgpa,
:SCOMMENT = scomment,
:SADVISOR = sadvisor)
END-EXEC.
* Enforce integrity of professor name.
MOVE 0 TO VALID-ADVISOR.
EXEC SQL SELECT 1 INTO :VALID-ADVISOR
FROM professor
WHERE pname = :SADVISOR
END-EXEC.
IF VALID-ADVISOR = 0 THEN
EXEC FRS MESSAGE
'Not a valid advisor name'
END-EXEC
EXEC FRS SLEEP 2 END-EXEC
EXEC FRS RESUME FIELD sadvisor END-EXEC
MOVE 0 TO VALID-ADVISOR.
EXEC SQL SELECT 1 INTO :VALID-ADVISOR
FROM professor
WHERE pname = :SADVISOR
END-EXEC.
IF VALID-ADVISOR = 0 THEN
EXEC FRS MESSAGE
'Not a valid advisor name'
END-EXEC
EXEC FRS SLEEP 2 END-EXEC
EXEC FRS RESUME FIELD sadvisor END-EXEC
ELSE
EXEC SQL UPDATE student SET
sgpa = :SGPA,
scomment = :SCOMMENT,
sadvisor = :SADVISOR
WHERE sidno = :SIDNO
END-EXEC
EXEC FRS BREAKDISPLAY END-EXEC
END-IF.
EXEC SQL UPDATE student SET
sgpa = :SGPA,
scomment = :SCOMMENT,
sadvisor = :SADVISOR
WHERE sidno = :SIDNO
END-EXEC
EXEC FRS BREAKDISPLAY END-EXEC
END-IF.
EXEC FRS END END-EXEC
EXEC FRS ACTIVATE MENUITEM 'Quit' END-EXEC
EXEC FRS ACTIVATE MENUITEM 'Quit' END-EXEC
EXEC FRS BEGIN END-EXEC
* Quit without submitting changes
MOVE 0 TO CHANGED-DATA.
EXEC FRS BREAKDISPLAY END-EXEC.
MOVE 0 TO CHANGED-DATA.
EXEC FRS BREAKDISPLAY END-EXEC.
EXEC FRS END END-EXEC
EXEC FRS FINALIZE END-EXEC
END-STUDENT.
EXIT.
EXIT.
VMS:
IDENTIFICATION DIVISION.
PROGRAM-ID. STUDENT-ADMINISTRATOR.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
EXEC SQL INCLUDE SQLCA END-EXEC.
Graduate student table
EXEC SQL DECLARE student TABLE
(sname char(25),
sage integer1,
sbdate char(25),
sgpa float4,
sidno integer,
scomment archars(200),
sadvisor char(25))
END-EXEC.
EXEC SQL DECLARE student TABLE
(sname char(25),
sage integer1,
sbdate char(25),
sgpa float4,
sidno integer,
scomment archars(200),
sadvisor char(25))
END-EXEC.
Professor table
EXEC SQL DECLARE professor TABLE
(pname char(25),
pdept char(10))
END-EXEC.
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
Global grad student record maps to database table
GRAD.
02 SNAME PIC X(25).
02 SAGE PIC S9(4) USAGE COMP.
02 SBDATE PIC X(25).
02 SGPA USAGE COMP-1.
02 SIDNO PIC S9(9) USAGE COMP.
02 SCOMMENT PIC X(200).
02 SADVISOR PIC X(25).
EXEC SQL DECLARE professor TABLE
(pname char(25),
pdept char(10))
END-EXEC.
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
Global grad student record maps to database table
GRAD.
02 SNAME PIC X(25).
02 SAGE PIC S9(4) USAGE COMP.
02 SBDATE PIC X(25).
02 SGPA USAGE COMP-1.
02 SIDNO PIC S9(9) USAGE COMP.
02 SCOMMENT PIC X(200).
02 SADVISOR PIC X(25).
Professor info maps to database table
PROF.
02 PNAME PIC X(25).
02 PDEPT PIC X(10).
Row number of last row in student table field
01 LASTROW PIC S9(9) USAGE COMP.
Is user on a table field?
01 ISTABLE PIC S9 USAGE COMP.
Were changes made to data in "studentfrm"?
01 CHANGED PIC S9 USAGE COMP.
Did user enter a valid advisor name?
VALID-ADVISOR PIC S9 USAGE COMP.
PROF.
02 PNAME PIC X(25).
02 PDEPT PIC X(10).
Row number of last row in student table field
01 LASTROW PIC S9(9) USAGE COMP.
Is user on a table field?
01 ISTABLE PIC S9 USAGE COMP.
Were changes made to data in "studentfrm"?
01 CHANGED PIC S9 USAGE COMP.
Did user enter a valid advisor name?
VALID-ADVISOR PIC S9 USAGE COMP.
"Studentfrm" loaded?
01 LOADFORM PIC S9 USAGE COMP VALUE IS 0.
Local utility buffers
01 MSGBUF PIC X(200).
01 RESPBUF PIC X.
01 OLD-ADVISOR PIC X(25).
Externally compiled forms
01 MASTERF PIC S9(9) USAGE COMP VALUE EXTERNAL Masterfrm.
01 STUDENTF PIC S9(9) USAGE COMP VALUE EXTERNAL Studentfrm.
EXEC SQL END DECLARE SECTION END-EXEC.
PROCEDURE DIVISION.
BEGIN.
01 LOADFORM PIC S9 USAGE COMP VALUE IS 0.
Local utility buffers
01 MSGBUF PIC X(200).
01 RESPBUF PIC X.
01 OLD-ADVISOR PIC X(25).
Externally compiled forms
01 MASTERF PIC S9(9) USAGE COMP VALUE EXTERNAL Masterfrm.
01 STUDENTF PIC S9(9) USAGE COMP VALUE EXTERNAL Studentfrm.
EXEC SQL END DECLARE SECTION END-EXEC.
PROCEDURE DIVISION.
BEGIN.
Start program and call Master driver. First, start Ingres and
the FORMS system.
EXEC FRS FORMS END-EXEC.
EXEC SQL WHENEVER SQLERROR STOP END-EXEC.
EXEC FRS MESSAGE 'Initializing Student Administrator . . .'
END-EXEC.
EXEC SQL CONNECT personnel END-EXEC.
PERFORM MASTER THRU END-MASTER.
EXEC FRS CLEAR SCREEN END-EXEC.
EXEC FRS ENDFORMS END-EXEC.
EXEC SQL DISCONNECT END-EXEC.
STOP RUN.
MASTER.
the FORMS system.
EXEC FRS FORMS END-EXEC.
EXEC SQL WHENEVER SQLERROR STOP END-EXEC.
EXEC FRS MESSAGE 'Initializing Student Administrator . . .'
END-EXEC.
EXEC SQL CONNECT personnel END-EXEC.
PERFORM MASTER THRU END-MASTER.
EXEC FRS CLEAR SCREEN END-EXEC.
EXEC FRS ENDFORMS END-EXEC.
EXEC SQL DISCONNECT END-EXEC.
STOP RUN.
MASTER.
This paragraph drives the application. It runs "masterfrm" and
allows the user to "zoom" in on a selected student.
EXEC FRS ADDFORM :MASTERF END-EXEC.
Initialize "studenttbl" with a data set in READ mode. Declare
hidden columns for all the extra fields that the program will
display when more information is requested about a student.
Columns "sname" ad "sage" are displayed. All other columns are
hidden, to be used in the student information form.
EXEC FRS INITTABLE masterfrm studenttbl READ
(sbdate = char(25),
sgpa = float4,
sidno = integer,
scomment = char(200),
sadvisor = char(20))
END-EXEC.
allows the user to "zoom" in on a selected student.
EXEC FRS ADDFORM :MASTERF END-EXEC.
Initialize "studenttbl" with a data set in READ mode. Declare
hidden columns for all the extra fields that the program will
display when more information is requested about a student.
Columns "sname" ad "sage" are displayed. All other columns are
hidden, to be used in the student information form.
EXEC FRS INITTABLE masterfrm studenttbl READ
(sbdate = char(25),
sgpa = float4,
sidno = integer,
scomment = char(200),
sadvisor = char(20))
END-EXEC.
EXEC FRS DISPLAY masterfrm UPDATE END-EXEC
EXEC FRS INITIALIZE END-EXEC
EXEC FRS BEGIN END-EXEC
EXEC FRS MESSAGE 'Enter an Advisor name . . .'
END-EXEC.
EXEC FRS SLEEP 2 END-EXEC.
EXEC FRS END END-EXEC
EXEC FRS ACTIVATE MENUITEM 'Students', FIELD 'pname'
END-EXEC
EXEC FRS BEGIN END-EXEC
EXEC FRS INITIALIZE END-EXEC
EXEC FRS BEGIN END-EXEC
EXEC FRS MESSAGE 'Enter an Advisor name . . .'
END-EXEC.
EXEC FRS SLEEP 2 END-EXEC.
EXEC FRS END END-EXEC
EXEC FRS ACTIVATE MENUITEM 'Students', FIELD 'pname'
END-EXEC
EXEC FRS BEGIN END-EXEC
* Load the students of the specified professor
EXEC FRS GETFORM (:PNAME = pname) END-EXEC.
* If no professor name is given, resume
IF PNAME = " " THEN
EXEC FRS RESUME FIELD pname END-EXEC.
* Verify that the professor exists. Local error handling just
* prints the message and continues. Assume that each professor
* has exactly one department.
EXEC FRS GETFORM (:PNAME = pname) END-EXEC.
* If no professor name is given, resume
IF PNAME = " " THEN
EXEC FRS RESUME FIELD pname END-EXEC.
* Verify that the professor exists. Local error handling just
* prints the message and continues. Assume that each professor
* has exactly one department.
EXEC SQL WHENEVER SQLERROR CALL SQLPRINT END-EXEC.
EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC.
MOVE SPACES TO PDEPT.
EXEC SQL SELECT pdept
INTO :PDEPT
FROM professor
WHERE pname = :PNAME
END-EXEC.
IF PDEPT = " " THEN
STRING "No professor with name """ PNAME
""" [RETURN]" DELIMITED BY SIZE INTO MSGBUF
EXEC FRS PROMPT NOECHO (:MSGBUF, :RESPBUF)
END-EXEC
EXEC FRS CLEAR FIELD ALL END-EXEC
EXEC FRS RESUME FIELD pname END-EXEC.
* Fill the department field and load students
*
EXEC FRS PUTFORM (pdept = :PDEPT) END-EXEC.
* Refresh for query
EXEC FRS REDISPLAY END-EXEC.
PERFORM LOAD-STUDENTS THRU END-LOAD.
STRING "No professor with name """ PNAME
""" [RETURN]" DELIMITED BY SIZE INTO MSGBUF
EXEC FRS PROMPT NOECHO (:MSGBUF, :RESPBUF)
END-EXEC
EXEC FRS CLEAR FIELD ALL END-EXEC
EXEC FRS RESUME FIELD pname END-EXEC.
* Fill the department field and load students
*
EXEC FRS PUTFORM (pdept = :PDEPT) END-EXEC.
* Refresh for query
EXEC FRS REDISPLAY END-EXEC.
PERFORM LOAD-STUDENTS THRU END-LOAD.
EXEC FRS RESUME FIELD studenttbl END-EXEC.
EXEC FRS END END-EXEC
EXEC FRS ACTIVATE MENUITEM 'Zoom' END-EXEC
EXEC FRS BEGIN END-EXEC
* Confirm that user is in "studenttbl" and that the table field
* is not empty. Collect data from the row and zoom for browsing
* and updating.
EXEC FRS END END-EXEC
EXEC FRS ACTIVATE MENUITEM 'Zoom' END-EXEC
EXEC FRS BEGIN END-EXEC
* Confirm that user is in "studenttbl" and that the table field
* is not empty. Collect data from the row and zoom for browsing
* and updating.
EXEC FRS INQUIRE_FRS field masterfrm
(:ISTABLE = table)
END-EXEC.
IF ISTABLE = 0 THEN
EXEC FRS PROMPT NOECHO
('Select from the student table [RETURN]',
:RESPBUF) END-EXEC
EXEC FRS RESUME FIELD studenttbl END-EXEC.
EXEC FRS INQUIRE_FRS table masterfrm
(:LASTROW = lastrow) END-EXEC.
IF LASTROW = 0 THEN
EXEC FRS PROMPT NOECHO
('There are no students [RETURN]',
:RESPBUF) END-EXEC
EXEC FRS RESUME FIELD pname END-EXEC.
(:LASTROW = lastrow) END-EXEC.
IF LASTROW = 0 THEN
EXEC FRS PROMPT NOECHO
('There are no students [RETURN]',
:RESPBUF) END-EXEC
EXEC FRS RESUME FIELD pname END-EXEC.
* Collect all data on student into global record
EXEC FRS GETROW masterfrm studenttbl
(:SNAME = sname,
:SAGE = sage,
:SBDATE = sbdate,
:SGPA = sgpa,
:SIDNO = sidno,
:SCOMMENT = scomment,
:SADVISOR = sadvisor)
END-EXEC.
EXEC FRS GETROW masterfrm studenttbl
(:SNAME = sname,
:SAGE = sage,
:SBDATE = sbdate,
:SGPA = sgpa,
:SIDNO = sidno,
:SCOMMENT = scomment,
:SADVISOR = sadvisor)
END-EXEC.
* Display "studentfrm," and if any changes were made, make the
* update to the local table field row. Only make updates to the
* columns corresponding to writable fields in "studentfrm." If
* the student changed advisors delete this row from the display.
MOVE SADVISOR TO OLD-ADVISOR.
PERFORM STUDENT-INFO-CHANGED THRU END-STUDENT.
* update to the local table field row. Only make updates to the
* columns corresponding to writable fields in "studentfrm." If
* the student changed advisors delete this row from the display.
MOVE SADVISOR TO OLD-ADVISOR.
PERFORM STUDENT-INFO-CHANGED THRU END-STUDENT.
IF CHANGED = 1 THEN
IF OLD-ADVISOR NOT = SADVISOR THEN
EXEC FRS DELETEROW masterfrm studenttbl
END-EXEC
ELSE
EXEC FRS PUTROW masterfrm studenttbl
(sgpa = :SGPA,
scomment = :SCOMMENT,
sadvisor = :SADVISOR)
END-EXEC
END-IF
END-IF.
EXEC FRS END END-EXEC
EXEC FRS ACTIVATE MENUITEM 'Exit' END-EXEC
EXEC FRS BEGIN END-EXEC
EXEC FRS BREAKDISPLAY END-EXEC.
EXEC FRS END END-EXEC
EXEC FRS FINALIZE END-EXEC
EXEC FRS ACTIVATE MENUITEM 'Exit' END-EXEC
EXEC FRS BEGIN END-EXEC
EXEC FRS BREAKDISPLAY END-EXEC.
EXEC FRS END END-EXEC
EXEC FRS FINALIZE END-EXEC
END-MASTER.
LOAD-STUDENTS.
* For the current professor name, this paragraph loads into the
* "studenttbl" table field all the students whose advisor is the
* professor with that name.
EXEC SQL DECLARE studentcsr CURSOR FOR
SELECT sname, sage, sbdate, sgpa,
sidno, scomment, sadvisor
FROM student
WHERE sadvisor = :PNAME
END-EXEC.
* Clear previous contents of table field. Load the table field
* from the database table based on the advisor name. Columns
* "sname" and "sage" will be displayed, and all others will be
* hidden.
EXEC FRS MESSAGE 'Retrieving Student Information . . '
END-EXEC.
EXEC FRS CLEAR FIELD studenttbl END-EXEC.
EXEC SQL WHENEVER SQLERROR GOTO END-LOAD END-EXEC.
EXEC SQL WHENEVER NOT FOUND GOTO END-LOAD END-EXEC.
EXEC SQL OPEN studentcsr END-EXEC.
* from the database table based on the advisor name. Columns
* "sname" and "sage" will be displayed, and all others will be
* hidden.
EXEC FRS MESSAGE 'Retrieving Student Information . . '
END-EXEC.
EXEC FRS CLEAR FIELD studenttbl END-EXEC.
EXEC SQL WHENEVER SQLERROR GOTO END-LOAD END-EXEC.
EXEC SQL WHENEVER NOT FOUND GOTO END-LOAD END-EXEC.
EXEC SQL OPEN studentcsr END-EXEC.
* Before we start the loop, we know that the OPEN was
* successful and that NOT FOUND was not set.
PERFORM UNTIL SQLCODE NOT = 0
EXEC SQL FETCH studentcsr INTO :GRAD END-EXEC
EXEC FRS LOADTABLE masterfrm studenttbl
(sname = :SNAME,
sage = :SAGE,
sbdate = :SBDATE,
sgpa = :SGPA,
sidno = :SIDNO,
scomment = :SCOMMENT,
sadvisor = :SADVISOR)
END-EXEC
END-PERFORM.
END-LOAD.
* successful and that NOT FOUND was not set.
PERFORM UNTIL SQLCODE NOT = 0
EXEC SQL FETCH studentcsr INTO :GRAD END-EXEC
EXEC FRS LOADTABLE masterfrm studenttbl
(sname = :SNAME,
sage = :SAGE,
sbdate = :SBDATE,
sgpa = :SGPA,
sidno = :SIDNO,
scomment = :SCOMMENT,
sadvisor = :SADVISOR)
END-EXEC
END-PERFORM.
END-LOAD.
* Clean up on an error, and close cursors
EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC.
EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC.
EXEC SQL CLOSE studentcsr END-EXEC.
STUDENT-INFO-CHANGED.
* This paragraph allows the user to zoom in on the details of a
* selected student. Some of the data can be updated by the
* user. If any updates were made, they are reflected back into
* the database table. The paragraph records whether or not
* changes were made via the CHANGED variable.
EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC.
EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC.
EXEC SQL CLOSE studentcsr END-EXEC.
STUDENT-INFO-CHANGED.
* This paragraph allows the user to zoom in on the details of a
* selected student. Some of the data can be updated by the
* user. If any updates were made, they are reflected back into
* the database table. The paragraph records whether or not
* changes were made via the CHANGED variable.
* Control ADDFORM to only initialize once
IF LOADFORM = 0 THEN
EXEC FRS MESSAGE 'Loading Student form . . .' END-EXEC
EXEC FRS ADDFORM :STUDENTF END-EXEC
MOVE 1 TO LOADFORM.
* Local error handle just prints error and continues
EXEC SQL WHENEVER SQLERROR CALL SQLPRINT END-EXEC.
EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC.
EXEC FRS DISPLAY studentfrm FILL END-EXEC
EXEC FRS INITIALIZE
(sname = :SNAME,
sage = :SAGE,
sbdate = :SBDATE,
sgpa = :SGPA,
sidno = :SIDNO,
scomment = :SCOMMENT,
sadvisor = :SADVISOR)
END-EXEC
EXEC FRS ACTIVATE MENUITEM 'Write' END-EXEC
EXEC FRS BEGIN END-EXEC
EXEC SQL WHENEVER SQLERROR CALL SQLPRINT END-EXEC.
EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC.
EXEC FRS DISPLAY studentfrm FILL END-EXEC
EXEC FRS INITIALIZE
(sname = :SNAME,
sage = :SAGE,
sbdate = :SBDATE,
sgpa = :SGPA,
sidno = :SIDNO,
scomment = :SCOMMENT,
sadvisor = :SADVISOR)
END-EXEC
EXEC FRS ACTIVATE MENUITEM 'Write' END-EXEC
EXEC FRS BEGIN END-EXEC
* If changes were made, update the database table. Only bother
* with the fields that are not read-only.
EXEC FRS INQUIRE_FRS form (:CHANGED = change) END-EXEC.
IF CHANGED = 0 THEN
EXEC FRS BREAKDISPLAY END-EXEC.
EXEC FRS VALIDATE END-EXEC.
EXEC FRS MESSAGE
'Writing changes to database. . .'
END-EXEC.
* with the fields that are not read-only.
EXEC FRS INQUIRE_FRS form (:CHANGED = change) END-EXEC.
IF CHANGED = 0 THEN
EXEC FRS BREAKDISPLAY END-EXEC.
EXEC FRS VALIDATE END-EXEC.
EXEC FRS MESSAGE
'Writing changes to database. . .'
END-EXEC.
EXEC FRS GETFORM
(:SGPA = sgpa,
:SCOMMENT = scomment,
:SADVISOR = sadvisor)
END-EXEC.
* Enforce integrity of professor name.
(:SGPA = sgpa,
:SCOMMENT = scomment,
:SADVISOR = sadvisor)
END-EXEC.
* Enforce integrity of professor name.
MOVE 0 TO VALID-ADVISOR.
EXEC SQL SELECT 1 INTO :VALID-ADVISOR
FROM professor
WHERE pname = :SADVISOR
END-EXEC.
IF VALID-ADVISOR = 0 THEN
EXEC FRS MESSAGE 'Not a valid advisor name'
END-EXEC
EXEC FRS SLEEP 2 END-EXEC
EXEC FRS RESUME FIELD sadvisor END-EXEC
ELSE
EXEC SQL UPDATE student SET
sgpa = :SGPA,
scomment = :SCOMMENT,
sadvisor = :SADVISOR
WHERE sidno = :SIDNO
END-EXEC
EXEC FRS BREAKDISPLAY END-EXEC
END-IF.
EXEC FRS END END-EXEC
EXEC FRS ACTIVATE MENUITEM 'Quit' END-EXEC
EXEC FRS BEGIN END-EXEC
EXEC SQL UPDATE student SET
sgpa = :SGPA,
scomment = :SCOMMENT,
sadvisor = :SADVISOR
WHERE sidno = :SIDNO
END-EXEC
EXEC FRS BREAKDISPLAY END-EXEC
END-IF.
EXEC FRS END END-EXEC
EXEC FRS ACTIVATE MENUITEM 'Quit' END-EXEC
EXEC FRS BEGIN END-EXEC
* Quit without submitting changes
MOVE 0 TO CHANGED.
EXEC FRS BREAKDISPLAY END-EXEC.
EXEC FRS END END-EXEC
EXEC FRS FINALIZE END-EXEC
END-STUDENT.
EXIT.
MOVE 0 TO CHANGED.
EXEC FRS BREAKDISPLAY END-EXEC.
EXEC FRS END END-EXEC
EXEC FRS FINALIZE END-EXEC
END-STUDENT.
EXIT.
Last modified date: 08/28/2024