UNIX and VMS--The Department-Employee Master/Detail Application
This section contains a sample master/detail application that uses two database tables joined on a specific column. This typical example of a department and its employees demonstrates how to process two tables as a master and a detail.
The program scans through all the departments in a database table, in order to reduce expenses. Department information is stored in program variables. Based on certain criteria, the program updates department and employee records. The conditions for updating the data are the following:
Departments:
• If a department has made less than $50,000 in sales, the department is dissolved.
Employees:
• If an employee was hired since the start of 1985, the employee is terminated.
• If the employee's yearly salary is more than the minimum company wage of $14,000 and the employee is not nearing retirement (over 58 years of age), the employee takes a 5% pay cut.
• If the employee's department is dissolved and the employee is not terminated, the employee is moved into a state of limbo (the Toberesolved database table, which is described later) to be resolved by a supervisor.
This program uses two cursors in a master/detail fashion. The first cursor is for the Department table, and the second is for the Employee table. The create statements used to create the tables are shown below. The cursors retrieve all the information in their respective tables, some of which is updated. The cursor for the Employee table also retrieves an integer date interval whose value is positive if the employee was hired after January 1, 1985.
Each row that is scanned, both from the Department table and the Employee table, is recorded into the system output file. This file serves as a log of the session and as a simplified report of the updates.
Each section of code is commented for the purpose of the application and to clarify some of the uses of the EQUEL statements. The program illustrates table creation, multi-query transactions, all cursor statements and direct updates. For purposes of brevity, error handling on data manipulation statements is simply to close down the application.
For readability, all EQUEL reserved words are in uppercase.
The two create statements describing the Employee and Department database tables are shown at the start of the program.
UNIX:
## CREATE dept
## (name = c12, /* Department name */
## totsales = money, /* Total sales */
## employees = i2) /* Number of employees */
## CREATE employee
## (name = c20, /* Employee name */
## age = i1, /* Employee age */
## idno = i4, /* Unique employee id */
## hired = date, /* Date of hire */
## dept = c10, /* Employee department */
## salary = money) /* Yearly salary */
IDENTIFICATION DIVISION.
PROGRAM-ID. EXPENSE-PROCESS.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
## (name = c12, /* Department name */
## totsales = money, /* Total sales */
## employees = i2) /* Number of employees */
## CREATE employee
## (name = c20, /* Employee name */
## age = i1, /* Employee age */
## idno = i4, /* Unique employee id */
## hired = date, /* Date of hire */
## dept = c10, /* Employee department */
## salary = money) /* Yearly salary */
IDENTIFICATION DIVISION.
PROGRAM-ID. EXPENSE-PROCESS.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
## DECLARE
*Cursor loop control
## 01 NO-ROWS PIC S9(2) USAGE COMP.
* Minimum sales of department
## 01 MIN-DEPT-SALES PIC S9(5)V9(2) USAGE COMP
## VALUE IS 50000.00.
* Minimum employee salary
## 01 MIN-EMP-SALARY PIC S9(5)v9(2) USAGE COMP
## VALUE IS 14000.00.
* Age above which no salary-reduction will be made
## 01 NEARLY-RETIRED PIC S9(2) USAGE COMP
## VALUE IS 58.
* Salary-reduction percentage
## 01 SALARY-REDUC PIC S9(1)V9(2) USAGE COMP
## VALUE IS 0.95.
*Cursor loop control
## 01 NO-ROWS PIC S9(2) USAGE COMP.
* Minimum sales of department
## 01 MIN-DEPT-SALES PIC S9(5)V9(2) USAGE COMP
## VALUE IS 50000.00.
* Minimum employee salary
## 01 MIN-EMP-SALARY PIC S9(5)v9(2) USAGE COMP
## VALUE IS 14000.00.
* Age above which no salary-reduction will be made
## 01 NEARLY-RETIRED PIC S9(2) USAGE COMP
## VALUE IS 58.
* Salary-reduction percentage
## 01 SALARY-REDUC PIC S9(1)V9(2) USAGE COMP
## VALUE IS 0.95.
* Record corresponding to the "dept" table.
## 01 DEPT.
## 02 DNAME PIC X(12).
## 02 TOTSALES PIC S9(7)V9(2) USAGE COMP.
## 02 EMPLOYEES PIC S9(4) USAGE COMP.
* Record corresponding to the "employee" table
## 01 EMP.
## 02 ENAME PIC X(20).
## 02 AGE PIC S9(2) USAGE COMP.
## 02 IDNO PIC S9(8) USAGE COMP.
## 02 HIRED PIC X(26).
## 02 SALARY PIC S9(6)V9(2) USAGE COMP.
## 02 HIRED-SINCE-85 PIC S9(4) USAGE COMP.
* Count of employees terminated.
## 01 EMPS-TERM PIC S99 USAGE COMP.
* Indicates whether the employee's dept was deleted
## 01 DELETED-DEPT PIC S9 USAGE COMP.
## 01 DEPT.
## 02 DNAME PIC X(12).
## 02 TOTSALES PIC S9(7)V9(2) USAGE COMP.
## 02 EMPLOYEES PIC S9(4) USAGE COMP.
* Record corresponding to the "employee" table
## 01 EMP.
## 02 ENAME PIC X(20).
## 02 AGE PIC S9(2) USAGE COMP.
## 02 IDNO PIC S9(8) USAGE COMP.
## 02 HIRED PIC X(26).
## 02 SALARY PIC S9(6)V9(2) USAGE COMP.
## 02 HIRED-SINCE-85 PIC S9(4) USAGE COMP.
* Count of employees terminated.
## 01 EMPS-TERM PIC S99 USAGE COMP.
* Indicates whether the employee's dept was deleted
## 01 DELETED-DEPT PIC S9 USAGE COMP.
* Error message buffer used by CHECK-ERRORS.
## 01 ERRBUF PIC X(200).
* Error number
## 01 ERRNUM PIC S9(8) USAGE COMP.
* Formatting values for output
## 01 DEPT-OUT.
## 02 FILLER PIC X(12) VALUE "Department: ".
## 02 DNAME-OUT PIC X(12).
## 02 FILLER PIC X(13) VALUE "Total Sales: ".
## 02 TOTSALES-OUT PIC $,$$$,$$9.9(2) USAGE DISPLAY.
## 02 DEPT-FORMAT PIC X(19).
## 01 EMP-OUT.
## 02 FILLER PIC XX VALUE SPACES.
## 02 TITLE PIC X(11).
## 02 IDNO-OUT PIC Z9(6) USAGE DISPLAY.
## 02 FILLER PIC X VALUE SPACE.
## 02 ENAME-OUT PIC X(20).
## 02 AGE-OUT PIC Z9(2) USAGE DISPLAY.
## 02 FILLER PIC XX VALUE SPACES.
## 02 SALARY-OUT PIC $$$,$$9.9(2) USAGE DISPLAY.
## 02 FILLER PIC XX VALUE SPACES.
## 02 DESCRIPTION PIC X(24).
## 01 ERRBUF PIC X(200).
* Error number
## 01 ERRNUM PIC S9(8) USAGE COMP.
* Formatting values for output
## 01 DEPT-OUT.
## 02 FILLER PIC X(12) VALUE "Department: ".
## 02 DNAME-OUT PIC X(12).
## 02 FILLER PIC X(13) VALUE "Total Sales: ".
## 02 TOTSALES-OUT PIC $,$$$,$$9.9(2) USAGE DISPLAY.
## 02 DEPT-FORMAT PIC X(19).
## 01 EMP-OUT.
## 02 FILLER PIC XX VALUE SPACES.
## 02 TITLE PIC X(11).
## 02 IDNO-OUT PIC Z9(6) USAGE DISPLAY.
## 02 FILLER PIC X VALUE SPACE.
## 02 ENAME-OUT PIC X(20).
## 02 AGE-OUT PIC Z9(2) USAGE DISPLAY.
## 02 FILLER PIC XX VALUE SPACES.
## 02 SALARY-OUT PIC $$$,$$9.9(2) USAGE DISPLAY.
## 02 FILLER PIC XX VALUE SPACES.
## 02 DESCRIPTION PIC X(24).
**
* Procedure Division
*
* Initialize the database, process each department and
* terminate the session.
**
PROCEDURE DIVISION.
EXAMPLE SECTION.
XBEGIN.
DISPLAY "Entering application to process expenses".
PERFORM INIT-DB THRU END-INITDB.
PERFORM PROCESS-DEPTS THRU END-PROCDEPTS.
PERFORM END-DB THRU END-ENDDB.
DISPLAY "Successful completion of application".
STOP RUN.
* Procedure Division
*
* Initialize the database, process each department and
* terminate the session.
**
PROCEDURE DIVISION.
EXAMPLE SECTION.
XBEGIN.
DISPLAY "Entering application to process expenses".
PERFORM INIT-DB THRU END-INITDB.
PERFORM PROCESS-DEPTS THRU END-PROCDEPTS.
PERFORM END-DB THRU END-ENDDB.
DISPLAY "Successful completion of application".
STOP RUN.
**
* Paragraph: INIT-DB
*
* Start up the database, and abort if there is an error
* Before processing employees, create the table for
* employees who losetheir department,
* "toberesolved". Initiate the multi-statement
* transaction.
**
INIT-DB.
## INGRES "personnel"
* Silence Ingres error printing
## SET_EQUEL (ERRORMODE = 0)
DISPLAY "Creating ""To_Be_Resolved"" table".
## CREATE toberesolved
## (#name = char(20),
## #age = smallint,
## #idno = integer,
## #hired = date,
## #dept = char(10),
## #salary = money)
## INQUIRE_EQUEL (ERRNUM = ERRORNO)
IF ERRNUM NOT = 0 THEN
## INQUIRE_INGRES (ERRBUF = ERRORTEXT)
DISPLAY "Fatal error on creation:"
DISPLAY ERRBUF
## EXIT
STOP RUN
END-IF.
## BEGIN TRANSACTION
END-INITDB.
EXIT.
* Paragraph: INIT-DB
*
* Start up the database, and abort if there is an error
* Before processing employees, create the table for
* employees who losetheir department,
* "toberesolved". Initiate the multi-statement
* transaction.
**
INIT-DB.
## INGRES "personnel"
* Silence Ingres error printing
## SET_EQUEL (ERRORMODE = 0)
DISPLAY "Creating ""To_Be_Resolved"" table".
## CREATE toberesolved
## (#name = char(20),
## #age = smallint,
## #idno = integer,
## #hired = date,
## #dept = char(10),
## #salary = money)
## INQUIRE_EQUEL (ERRNUM = ERRORNO)
IF ERRNUM NOT = 0 THEN
## INQUIRE_INGRES (ERRBUF = ERRORTEXT)
DISPLAY "Fatal error on creation:"
DISPLAY ERRBUF
## EXIT
STOP RUN
END-IF.
## BEGIN TRANSACTION
END-INITDB.
EXIT.
**
* Paragraph: END-DB
*
* Closes off the multi-statement transaction and access to
* the database after successful completion of the application
**
END-DB.
## END TRANSACTION
## EXIT
END-ENDDB.
EXIT.
* Paragraph: END-DB
*
* Closes off the multi-statement transaction and access to
* the database after successful completion of the application
**
END-DB.
## END TRANSACTION
## EXIT
END-ENDDB.
EXIT.
**
* Paragraph: PROCESS-DEPTS
*
* Scan through all the departments, processing each one.
* If the department has made less than $50,000 in sales, then
* the department is dissolved. For each department process
* all the employees (they may even be moved to another
table).
* If an employee was terminated, then update the department's
* employee counter.
**
PROCESS-DEPTS.
## RANGE OF d IS #dept
## DECLARE CURSOR deptcsr FOR
## RETRIEVE (d.#name, d.#totsales, d.#employees)
## FOR DIRECT UPDATE OF (#name, #employees)
## OPEN CURSOR deptcsr
PERFORM CHECK-ERRORS.
MOVE 0 TO NO-ROWS.
PERFORM UNTIL NO-ROWS = 1
## RETRIEVE CURSOR deptcsr (DNAME, TOTSALES, EMPLOYEES)
## INQUIRE_EQUEL (NO-ROWS = ENDQUERY)
IF NO-ROWS = 0 THEN
* Did the department reach minimum sales?
IF TOTSALES < MIN-DEPT-SALES THEN
## DELETE CURSOR deptcsr
PERFORM CHECK-ERRORS
MOVE 1 TO DELETED-DEPT
MOVE " -- DISSOLVED --" TO DEPT-FORMAT
ELSE
MOVE 0 TO DELETED-DEPT
MOVE SPACES TO DEPT-FORMAT
END-IF
* Log what we have just done
MOVE DNAME TO DNAME-OUT
MOVE TOTSALES TO TOTSALES-OUT
DISPLAY DEPT-OUT
* Now process each employee in the department
PERFORM PROCESS-EMPLOYEES THRU
END-PROCEMPLOYEES
MOVE 0 TO NO-ROWS
* If some employees were terminated, record this
* fact
IF EMPS-TERM > 0 AND DELETED-DEPT = 0 THEN
## REPLACE CURSOR deptcsr
## (#employees = EMPLOYEES - EMPS-TERM)
PERFORM CHECK-ERRORS
END-IF
END-IF
END-PERFORM.
## CLOSE CURSOR deptcsr
END-PROCDEPTS.
EXIT.
* Paragraph: PROCESS-DEPTS
*
* Scan through all the departments, processing each one.
* If the department has made less than $50,000 in sales, then
* the department is dissolved. For each department process
* all the employees (they may even be moved to another
table).
* If an employee was terminated, then update the department's
* employee counter.
**
PROCESS-DEPTS.
## RANGE OF d IS #dept
## DECLARE CURSOR deptcsr FOR
## RETRIEVE (d.#name, d.#totsales, d.#employees)
## FOR DIRECT UPDATE OF (#name, #employees)
## OPEN CURSOR deptcsr
PERFORM CHECK-ERRORS.
MOVE 0 TO NO-ROWS.
PERFORM UNTIL NO-ROWS = 1
## RETRIEVE CURSOR deptcsr (DNAME, TOTSALES, EMPLOYEES)
## INQUIRE_EQUEL (NO-ROWS = ENDQUERY)
IF NO-ROWS = 0 THEN
* Did the department reach minimum sales?
IF TOTSALES < MIN-DEPT-SALES THEN
## DELETE CURSOR deptcsr
PERFORM CHECK-ERRORS
MOVE 1 TO DELETED-DEPT
MOVE " -- DISSOLVED --" TO DEPT-FORMAT
ELSE
MOVE 0 TO DELETED-DEPT
MOVE SPACES TO DEPT-FORMAT
END-IF
* Log what we have just done
MOVE DNAME TO DNAME-OUT
MOVE TOTSALES TO TOTSALES-OUT
DISPLAY DEPT-OUT
* Now process each employee in the department
PERFORM PROCESS-EMPLOYEES THRU
END-PROCEMPLOYEES
MOVE 0 TO NO-ROWS
* If some employees were terminated, record this
* fact
IF EMPS-TERM > 0 AND DELETED-DEPT = 0 THEN
## REPLACE CURSOR deptcsr
## (#employees = EMPLOYEES - EMPS-TERM)
PERFORM CHECK-ERRORS
END-IF
END-IF
END-PERFORM.
## CLOSE CURSOR deptcsr
END-PROCDEPTS.
EXIT.
**
* Paragraph: PROCESS-EMPLOYEES
*
* Scan through all the employees for a particular department.
* Based on given conditions the employee may be terminated,
* or given a salary reduction:
* 1.If an employee was hired since 1985 then the employee is
* terminated.
* 2.If the employee's yearly salary is more than the minimum
* company wage of $14,000 and the employee is not close to
* retirement (over 58 years of age), then the employee take
* takes a 5% salary reduction.
* 3.If the employee's department is dissolved and the
* employee is not terminated, then the employee is moved
* into the "toberesolved" table.
**
PROCESS-EMPLOYEES.
* Note the use of the Ingres functions to find out
* who was hired since 1985.
## RANGE OF e IS #employee
## DECLARE CURSOR empcsr FOR
## RETRIEVE (e.#name, e.#age, e.#idno, e.#hired ##
e.#salary,res = int4(
## interval("days",e.#hired - date("01-jan-1985"))
## )
## )
## WHERE e.#dept = DNAME
## FOR DIRECT UPDATE OF (#name, #salary)
## OPEN CURSOR empcsr
PERFORM CHECK-ERRORS.
* Paragraph: PROCESS-EMPLOYEES
*
* Scan through all the employees for a particular department.
* Based on given conditions the employee may be terminated,
* or given a salary reduction:
* 1.If an employee was hired since 1985 then the employee is
* terminated.
* 2.If the employee's yearly salary is more than the minimum
* company wage of $14,000 and the employee is not close to
* retirement (over 58 years of age), then the employee take
* takes a 5% salary reduction.
* 3.If the employee's department is dissolved and the
* employee is not terminated, then the employee is moved
* into the "toberesolved" table.
**
PROCESS-EMPLOYEES.
* Note the use of the Ingres functions to find out
* who was hired since 1985.
## RANGE OF e IS #employee
## DECLARE CURSOR empcsr FOR
## RETRIEVE (e.#name, e.#age, e.#idno, e.#hired ##
e.#salary,res = int4(
## interval("days",e.#hired - date("01-jan-1985"))
## )
## )
## WHERE e.#dept = DNAME
## FOR DIRECT UPDATE OF (#name, #salary)
## OPEN CURSOR empcsr
PERFORM CHECK-ERRORS.
* Record how many employees are terminated
MOVE 0 TO EMPS-TERM.
MOVE 0 TO NO-ROWS.
PERFORM UNTIL NO-ROWS = 1
## RETRIEVE CURSOR empcsr
## (ENAME, AGE, IDNO, HIRED, SALARY, HIRED-SINCE-85)
## INQUIRE_EQUEL (NO-ROWS = ENDQUERY)
IF NO-ROWS = 0 THEN
IF HIRED-SINCE-85 > 0 THEN
## DELETE CURSOR empcsr
PERFORM CHECK-ERRORS
MOVE "Terminated:" TO TITLE
MOVE "Reason: Hired since 1985." TO DESCRIPTION
ADD 1 TO EMPS-TERM
ELSE
MOVE 0 TO EMPS-TERM.
MOVE 0 TO NO-ROWS.
PERFORM UNTIL NO-ROWS = 1
## RETRIEVE CURSOR empcsr
## (ENAME, AGE, IDNO, HIRED, SALARY, HIRED-SINCE-85)
## INQUIRE_EQUEL (NO-ROWS = ENDQUERY)
IF NO-ROWS = 0 THEN
IF HIRED-SINCE-85 > 0 THEN
## DELETE CURSOR empcsr
PERFORM CHECK-ERRORS
MOVE "Terminated:" TO TITLE
MOVE "Reason: Hired since 1985." TO DESCRIPTION
ADD 1 TO EMPS-TERM
ELSE
* Reduce salary if not nearly retired
IF SALARY > MIN-EMP-SALARY THEN
IF AGE < NEARLY-RETIRED THEN
## REPLACE CURSOR empcsr
## (#salary = #salary * SALARY-REDUC)
PERFORM CHECK-ERRORS
MOVE "Reduction: " TO TITLE
MOVE "Reason: Salary." TO DESCRIPTION
ELSE
* Do not reduce salary
MOVE "No Changes:" TO TITLE
MOVE "Reason: Retiring." TO DESCRIPTION
END-IF
* Leave employee alone
ELSE
MOVE "No Changes:" TO TITLE
MOVE "Reason: Salary." TO DESCRIPTION
END-IF
* Was employee's department dissolved?
IF DELETED-DEPT = 1 THEN
## RANGE OF e IS #employee
## APPEND TO toberesolved (e.all)
## WHERE e.#idno = IDNO
PERFORM CHECK-ERRORS
## DELETE CURSOR empcsr
END-IF
END-IF
* Log the employee's information
MOVE IDNO TO IDNO-OUT
MOVE ENAME TO ENAME-OUT
MOVE AGE TO AGE-OUT
MOVE SALARY TO SALARY-OUT
DISPLAY EMP-OUT
END-IF
END-PERFORM.
## CLOSE CURSOR empcsr
MOVE 0 TO ERRNUM.
END-PROCEMPLOYEES.
EXIT.
IF SALARY > MIN-EMP-SALARY THEN
IF AGE < NEARLY-RETIRED THEN
## REPLACE CURSOR empcsr
## (#salary = #salary * SALARY-REDUC)
PERFORM CHECK-ERRORS
MOVE "Reduction: " TO TITLE
MOVE "Reason: Salary." TO DESCRIPTION
ELSE
* Do not reduce salary
MOVE "No Changes:" TO TITLE
MOVE "Reason: Retiring." TO DESCRIPTION
END-IF
* Leave employee alone
ELSE
MOVE "No Changes:" TO TITLE
MOVE "Reason: Salary." TO DESCRIPTION
END-IF
* Was employee's department dissolved?
IF DELETED-DEPT = 1 THEN
## RANGE OF e IS #employee
## APPEND TO toberesolved (e.all)
## WHERE e.#idno = IDNO
PERFORM CHECK-ERRORS
## DELETE CURSOR empcsr
END-IF
END-IF
* Log the employee's information
MOVE IDNO TO IDNO-OUT
MOVE ENAME TO ENAME-OUT
MOVE AGE TO AGE-OUT
MOVE SALARY TO SALARY-OUT
DISPLAY EMP-OUT
END-IF
END-PERFORM.
## CLOSE CURSOR empcsr
MOVE 0 TO ERRNUM.
END-PROCEMPLOYEES.
EXIT.
**
* Paragraph: CHECK-ERRORS
*
* This paragraph serves as an error handler called any time
* after INIT-DB has successfully completed
* In all cases, it prints the cause of the error, and
* aborts the transaction, backing out changes.
* Note that disconnecting from the database will
* implicitly close any open cursors too. If an error is found
* the application is aborted.
**
CHECK-ERRORS.
MOVE 0 TO ERRNUM.
## INQUIRE_EQUEL (ERRNUM = ERRORNO)
IF ERRNUM NOT = 0 THEN
* Restore Ingres error printing
## SET_EQUEL (ERRORMODE = 1)
## INQUIRE_INGRES (ERRBUF = ERRORTEXT)
## ABORT
## EXIT
DISPLAY "Closing Down because of database error:"
DISPLAY ERRBUF
STOP RUN
END-IF.
* Paragraph: CHECK-ERRORS
*
* This paragraph serves as an error handler called any time
* after INIT-DB has successfully completed
* In all cases, it prints the cause of the error, and
* aborts the transaction, backing out changes.
* Note that disconnecting from the database will
* implicitly close any open cursors too. If an error is found
* the application is aborted.
**
CHECK-ERRORS.
MOVE 0 TO ERRNUM.
## INQUIRE_EQUEL (ERRNUM = ERRORNO)
IF ERRNUM NOT = 0 THEN
* Restore Ingres error printing
## SET_EQUEL (ERRORMODE = 1)
## INQUIRE_INGRES (ERRBUF = ERRORTEXT)
## ABORT
## EXIT
DISPLAY "Closing Down because of database error:"
DISPLAY ERRBUF
STOP RUN
END-IF.
VMS:
## CREATE dept
## (name = c12, /* Department name */
## totsales = money, /* Total sales */
## employees = i2) /* Number of employees */
## CREATE employee
## (name = c20, /* Employee name */
## age = i1, /* Employee age */
## idno = i4, /* Unique employee id */
## hired = date, /* Date of hire */
## dept = c10, /* Employee department */
## salary = money) /* Yearly salary */
IDENTIFICATION DIVISION.
PROGRAM-ID. EXPENSE-PROCESS.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
## DECLARE
* Cursor loop control
## 01 NO-ROWS PIC S9(2) USAGE COMP.
* Minimum sales of department
## 01 MIN-DEPT-SALES USAGE COMP-2 VALUE IS 50000.00.
* Minimum employee salary
## 01 MIN-EMP-SALARY USAGE COMP-2 VALUE IS 14000.00.
* Age above which no salary-reduction will be made
## 01 NEARLY-RETIRED PIC S9(2) USAGE COMP VALUE IS 58.
* Salary-reduction percentage
## 01 SALARY-REDUC USAGE COMP-1 VALUE IS 0.95.
* Indicates whether "toberesolved" table exists in INIT-DB
* paragraph.
## 01 FOUND-TABLE PIC S9 USAGE COMP.
* Record corresponding to the "dept" table.
## 01 DEPT.
## 02 NAME PIC X(12).
## 02 TOTSALES USAGE COMP-2.
## 02 EMPLOYEES PIC S9(4) USAGE COMP.
## (name = c12, /* Department name */
## totsales = money, /* Total sales */
## employees = i2) /* Number of employees */
## CREATE employee
## (name = c20, /* Employee name */
## age = i1, /* Employee age */
## idno = i4, /* Unique employee id */
## hired = date, /* Date of hire */
## dept = c10, /* Employee department */
## salary = money) /* Yearly salary */
IDENTIFICATION DIVISION.
PROGRAM-ID. EXPENSE-PROCESS.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
## DECLARE
* Cursor loop control
## 01 NO-ROWS PIC S9(2) USAGE COMP.
* Minimum sales of department
## 01 MIN-DEPT-SALES USAGE COMP-2 VALUE IS 50000.00.
* Minimum employee salary
## 01 MIN-EMP-SALARY USAGE COMP-2 VALUE IS 14000.00.
* Age above which no salary-reduction will be made
## 01 NEARLY-RETIRED PIC S9(2) USAGE COMP VALUE IS 58.
* Salary-reduction percentage
## 01 SALARY-REDUC USAGE COMP-1 VALUE IS 0.95.
* Indicates whether "toberesolved" table exists in INIT-DB
* paragraph.
## 01 FOUND-TABLE PIC S9 USAGE COMP.
* Record corresponding to the "dept" table.
## 01 DEPT.
## 02 NAME PIC X(12).
## 02 TOTSALES USAGE COMP-2.
## 02 EMPLOYEES PIC S9(4) USAGE COMP.
* Record corresponding to the "employee" table
## 01 EMP.
## 02 NAME PIC X(20).
## 02 AGE PIC S9(2) USAGE COMP.
## 02 IDNO PIC S9(8) USAGE COMP.
## 02 HIRED PIC X(26).
## 02 SALARY USAGE COMP-2.
## 02 HIRED-SINCE-85 PIC S9(4) USAGE COMP.
* Count of employees terminated.
## 01 EMPS-TERM PIC S99 USAGE COMP.
* Indicates whether the employee's dept was deleted
## 01 DELETED-DEPT PIC S9 USAGE COMP.
* Error message buffer used by CLOSE-DOWN
## 01 ERRBUF PIC X(100).
* Error number
## 01 ERRNUM PIC S9(8) USAGE COMP.
## 01 EMP.
## 02 NAME PIC X(20).
## 02 AGE PIC S9(2) USAGE COMP.
## 02 IDNO PIC S9(8) USAGE COMP.
## 02 HIRED PIC X(26).
## 02 SALARY USAGE COMP-2.
## 02 HIRED-SINCE-85 PIC S9(4) USAGE COMP.
* Count of employees terminated.
## 01 EMPS-TERM PIC S99 USAGE COMP.
* Indicates whether the employee's dept was deleted
## 01 DELETED-DEPT PIC S9 USAGE COMP.
* Error message buffer used by CLOSE-DOWN
## 01 ERRBUF PIC X(100).
* Error number
## 01 ERRNUM PIC S9(8) USAGE COMP.
* Formatting values for output
## 01 DEPT-OUT.
## 02 FILLER PIC X(12) VALUE "Department: ".
## 02 DNAME PIC X(12).
## 02 FILLER PIC X(13) VALUE "Total Sales: ".
## 02 TOTSALES-OUT PIC $,$$$,$$9.9(2) USAGE DISPLAY.
## 02 DEPT-FORMAT PIC X(19).
## 01 EMP-OUT.
## 02 FILLER PIC XX VALUE SPACES.
## 02 TITLE PIC X(11).
## 02 IDNO-OUT PIC Z9(6) USAGE DISPLAY.
## 02 FILLER PIC X VALUE SPACE.
## 02 ENAME PIC X(20).
## 02 AGE-OUT PIC Z9(2) USAGE DISPLAY.
## 02 FILLER PIC XX VALUE SPACES.
## 02 SALARY-OUT PIC $$$,$$9.9(2) USAGE DISPLAY.
## 02 FILLER PIC XX VALUE SPACES.
## 02 DESCRIPTION PIC X(24).
## 01 DEPT-OUT.
## 02 FILLER PIC X(12) VALUE "Department: ".
## 02 DNAME PIC X(12).
## 02 FILLER PIC X(13) VALUE "Total Sales: ".
## 02 TOTSALES-OUT PIC $,$$$,$$9.9(2) USAGE DISPLAY.
## 02 DEPT-FORMAT PIC X(19).
## 01 EMP-OUT.
## 02 FILLER PIC XX VALUE SPACES.
## 02 TITLE PIC X(11).
## 02 IDNO-OUT PIC Z9(6) USAGE DISPLAY.
## 02 FILLER PIC X VALUE SPACE.
## 02 ENAME PIC X(20).
## 02 AGE-OUT PIC Z9(2) USAGE DISPLAY.
## 02 FILLER PIC XX VALUE SPACES.
## 02 SALARY-OUT PIC $$$,$$9.9(2) USAGE DISPLAY.
## 02 FILLER PIC XX VALUE SPACES.
## 02 DESCRIPTION PIC X(24).
**
* Procedure Division
*
* Initialize the database, process each department and
* terminate the session.
**
PROCEDURE DIVISION.
SBEGIN.
DISPLAY "Entering application to process expenses".
PERFORM INIT-DB THRU END-INITDB.
PERFORM PROCESS-DEPTS THRU END-PROCDEPTS.
PERFORM END-DB THRU END-ENDDB.
DISPLAY "Successful completion of application".
STOP RUN.
* Procedure Division
*
* Initialize the database, process each department and
* terminate the session.
**
PROCEDURE DIVISION.
SBEGIN.
DISPLAY "Entering application to process expenses".
PERFORM INIT-DB THRU END-INITDB.
PERFORM PROCESS-DEPTS THRU END-PROCDEPTS.
PERFORM END-DB THRU END-ENDDB.
DISPLAY "Successful completion of application".
STOP RUN.
**
* Paragraph: INIT-DB
*
* Start up the database, and abort if there is an error.
* Before processing employees, create the table for employees
* who lose their department, "toberesolved". Initiate the
* multi-statement transaction.
**
INIT-DB.
## INGRES "personnel"
* Silence INGRES error printing
## SET_EQUEL (ERRORMODE = 0)
DISPLAY "Creating ""To_Be_Resolved"" table".
## CREATE toberesolved
## (#name = char(20),
## #age = smallint,
## #idno = integer,
## #hired = date,
## #dept = char(10),
## #salary = money)
## INQUIRE_EQUEL (ERRNUM = ERRORNO)
IF ERRNUM NOT = 0 THEN
## INQUIRE_INGRES (ERRBUF = ERRORTEXT)
DISPLAY "Fatal error on creation:"
DISPLAY ERRBUF
## EXIT
STOP RUN
END-IF.
## BEGIN TRANSACTION
END-INITDB.
* Paragraph: INIT-DB
*
* Start up the database, and abort if there is an error.
* Before processing employees, create the table for employees
* who lose their department, "toberesolved". Initiate the
* multi-statement transaction.
**
INIT-DB.
## INGRES "personnel"
* Silence INGRES error printing
## SET_EQUEL (ERRORMODE = 0)
DISPLAY "Creating ""To_Be_Resolved"" table".
## CREATE toberesolved
## (#name = char(20),
## #age = smallint,
## #idno = integer,
## #hired = date,
## #dept = char(10),
## #salary = money)
## INQUIRE_EQUEL (ERRNUM = ERRORNO)
IF ERRNUM NOT = 0 THEN
## INQUIRE_INGRES (ERRBUF = ERRORTEXT)
DISPLAY "Fatal error on creation:"
DISPLAY ERRBUF
## EXIT
STOP RUN
END-IF.
## BEGIN TRANSACTION
END-INITDB.
**
* Paragraph: END-DB
*
* Closes off the multi-statement transaction and access to
* the database after successful completion of the application.
**
END-DB.
## END TRANSACTION
## EXIT
END-ENDDB.
**
* Paragraph: PROCESS-DEPTS
*
* Scan through all the departments, processing each one.
* If the department has made less than $50,000 in sales, then
* the department is dissolved. For each department process
* all the employees (they may even be moved to another table).
* If an employee was terminated, then update the department's
* employee counter.
**
PROCESS-DEPTS.
## RANGE OF d IS #dept
## DECLARE CURSOR deptcsr FOR
## RETRIEVE (d.#name, d.#totsales, d.#employees)
## FOR DIRECT UPDATE OF (#name, #employees)
## OPEN CURSOR deptcsr
PERFORM CHECK-ERRORS.
MOVE 0 TO NO-ROWS.
PERFORM UNTIL NO-ROWS = 1
## RETRIEVE CURSOR deptcsr
## (NAME IN DEPT, TOTSALES, EMPLOYEES)
## INQUIRE_EQUEL (NO-ROWS = ENDQUERY)
IF NO-ROWS = 0 THEN
* Paragraph: END-DB
*
* Closes off the multi-statement transaction and access to
* the database after successful completion of the application.
**
END-DB.
## END TRANSACTION
## EXIT
END-ENDDB.
**
* Paragraph: PROCESS-DEPTS
*
* Scan through all the departments, processing each one.
* If the department has made less than $50,000 in sales, then
* the department is dissolved. For each department process
* all the employees (they may even be moved to another table).
* If an employee was terminated, then update the department's
* employee counter.
**
PROCESS-DEPTS.
## RANGE OF d IS #dept
## DECLARE CURSOR deptcsr FOR
## RETRIEVE (d.#name, d.#totsales, d.#employees)
## FOR DIRECT UPDATE OF (#name, #employees)
## OPEN CURSOR deptcsr
PERFORM CHECK-ERRORS.
MOVE 0 TO NO-ROWS.
PERFORM UNTIL NO-ROWS = 1
## RETRIEVE CURSOR deptcsr
## (NAME IN DEPT, TOTSALES, EMPLOYEES)
## INQUIRE_EQUEL (NO-ROWS = ENDQUERY)
IF NO-ROWS = 0 THEN
* Did the department reach minimum sales?
IF TOTSALES < MIN-DEPT-SALES THEN
## DELETE CURSOR deptcsr
PERFORM CHECK-ERRORS
MOVE 1 TO DELETED-DEPT
MOVE " -- DISSOLVED --" TO DEPT-FORMAT
ELSE
MOVE 0 TO DELETED-DEPT
MOVE "" TO DEPT-FORMAT
END-IF
* Log what we have just done
MOVE NAME IN DEPT TO DNAME
MOVE TOTSALES TO TOTSALES-OUT
DISPLAY DEPT-OUT
* Now process each employee in the department
PERFORM PROCESS-EMPLOYEES THRU END-PROCEMPLOYEES
MOVE 0 TO NO-ROWS
* If some employees were terminated, record this fact
IF EMPS-TERM > 0 AND DELETED-DEPT = 0 THEN
## REPLACE CURSOR deptcsr
## (#employees = EMPLOYEES - EMPS-TERM)
PERFORM CHECK-ERRORS
END-IF
END-IF
END-PERFORM.
## CLOSE CURSOR deptcsr
END-PROCDEPTS.
IF TOTSALES < MIN-DEPT-SALES THEN
## DELETE CURSOR deptcsr
PERFORM CHECK-ERRORS
MOVE 1 TO DELETED-DEPT
MOVE " -- DISSOLVED --" TO DEPT-FORMAT
ELSE
MOVE 0 TO DELETED-DEPT
MOVE "" TO DEPT-FORMAT
END-IF
* Log what we have just done
MOVE NAME IN DEPT TO DNAME
MOVE TOTSALES TO TOTSALES-OUT
DISPLAY DEPT-OUT
* Now process each employee in the department
PERFORM PROCESS-EMPLOYEES THRU END-PROCEMPLOYEES
MOVE 0 TO NO-ROWS
* If some employees were terminated, record this fact
IF EMPS-TERM > 0 AND DELETED-DEPT = 0 THEN
## REPLACE CURSOR deptcsr
## (#employees = EMPLOYEES - EMPS-TERM)
PERFORM CHECK-ERRORS
END-IF
END-IF
END-PERFORM.
## CLOSE CURSOR deptcsr
END-PROCDEPTS.
**
* Paragraph: PROCESS-EMPLOYEES
*
* Scan through all the employees for a particular department.
* Based on given conditions the employee may be terminated,
* or given a salary reduction:
* 1. If an employee was hired since 1985 then the employee
* is terminated.
* 2. If the employee's yearly salary is more than the
* minimum company wage of $14,000 and the employee
* is not close to retirement (over 58 years of age),
* then the employee takes a 5% salary reduction
* 3. If the employee's department is dissolved and the
* employee is not terminated, then the employee
* is moved into the "toberesolved" table.
**
PROCESS-EMPLOYEES.
* Paragraph: PROCESS-EMPLOYEES
*
* Scan through all the employees for a particular department.
* Based on given conditions the employee may be terminated,
* or given a salary reduction:
* 1. If an employee was hired since 1985 then the employee
* is terminated.
* 2. If the employee's yearly salary is more than the
* minimum company wage of $14,000 and the employee
* is not close to retirement (over 58 years of age),
* then the employee takes a 5% salary reduction
* 3. If the employee's department is dissolved and the
* employee is not terminated, then the employee
* is moved into the "toberesolved" table.
**
PROCESS-EMPLOYEES.
* Note the use of the INGRES functions to find out who was hired
* since 1985.
## RANGE OF e IS #employee
## DECLARE CURSOR empcsr FOR
## RETRIEVE (e.#name, e.#age, e.#idno, e.#hired,
## e.#salary, res = int4(
## interval("days",e.#hired - date("01-jan-1985"))
## )
## )
## WHERE e.#dept = NAME IN DEPT
## FOR DIRECT UPDATE OF (#name, #salary)
## OPEN CURSOR empcsr
PERFORM CHECK-ERRORS.
* Record how many employees terminated
MOVE 0 TO EMPS-TERM.
MOVE 0 TO NO-ROWS.
PERFORM UNTIL NO-ROWS = 1
## RETRIEVE CURSOR empcsr
## (NAME IN EMP, AGE, IDNO, HIRED, SALARY, HIRED-SINCE-85)
## INQUIRE_EQUEL (NO-ROWS = ENDQUERY)
IF NO-ROWS = 0 THEN
IF HIRED-SINCE-85 > 0 THEN
## DELETE CURSOR empcsr
PERFORM CHECK-ERRORS
MOVE "Terminated:" TO TITLE
MOVE "Reason: Hired since 1985."TO DESCRIPTION
ADD 1 TO EMPS-TERM
ELSE
* since 1985.
## RANGE OF e IS #employee
## DECLARE CURSOR empcsr FOR
## RETRIEVE (e.#name, e.#age, e.#idno, e.#hired,
## e.#salary, res = int4(
## interval("days",e.#hired - date("01-jan-1985"))
## )
## )
## WHERE e.#dept = NAME IN DEPT
## FOR DIRECT UPDATE OF (#name, #salary)
## OPEN CURSOR empcsr
PERFORM CHECK-ERRORS.
* Record how many employees terminated
MOVE 0 TO EMPS-TERM.
MOVE 0 TO NO-ROWS.
PERFORM UNTIL NO-ROWS = 1
## RETRIEVE CURSOR empcsr
## (NAME IN EMP, AGE, IDNO, HIRED, SALARY, HIRED-SINCE-85)
## INQUIRE_EQUEL (NO-ROWS = ENDQUERY)
IF NO-ROWS = 0 THEN
IF HIRED-SINCE-85 > 0 THEN
## DELETE CURSOR empcsr
PERFORM CHECK-ERRORS
MOVE "Terminated:" TO TITLE
MOVE "Reason: Hired since 1985."TO DESCRIPTION
ADD 1 TO EMPS-TERM
ELSE
* Reduce salary if not nearly retired
IF SALARY > MIN-EMP-SALARY THEN
IF AGE < NEARLY-RETIRED THEN
## REPLACE CURSOR empcsr
## (#salary = #salary * SALARY-REDUC)
PERFORM CHECK-ERRORS
MOVE "Reduction: " TO TITLE
MOVE "Reason: Salary."TO DESCRIPTION
ELSE
* Do not reduce salary
MOVE "No Changes:" TO TITLE
MOVE "Reason: Retiring."TO DESCRIPTION
END-IF
* Leave employee alone
ELSE
MOVE "No Changes:" TO TITLE
MOVE "Reason: Salary."TO DESCRIPTION
END-IF
IF SALARY > MIN-EMP-SALARY THEN
IF AGE < NEARLY-RETIRED THEN
## REPLACE CURSOR empcsr
## (#salary = #salary * SALARY-REDUC)
PERFORM CHECK-ERRORS
MOVE "Reduction: " TO TITLE
MOVE "Reason: Salary."TO DESCRIPTION
ELSE
* Do not reduce salary
MOVE "No Changes:" TO TITLE
MOVE "Reason: Retiring."TO DESCRIPTION
END-IF
* Leave employee alone
ELSE
MOVE "No Changes:" TO TITLE
MOVE "Reason: Salary."TO DESCRIPTION
END-IF
* Was employee's department dissolved?
IF DELETED-DEPT = 1 THEN
## RANGE OF e IS #employee
## APPEND TO toberesolved (e.all)
## WHERE e.#idno = IDNO
PERFORM CHECK-ERRORS
## DELETE CURSOR empcsr
END-IF
END-IF
* Log the employee's information
MOVE IDNO TO IDNO-OUT
MOVE NAME IN EMP TO ENAME
MOVE AGE TO AGE-OUT
MOVE SALARY TO SALARY-OUT
DISPLAY EMP-OUT
END-IF
END-PERFORM.
## CLOSE CURSOR empcsr
MOVE 0 TO ERRNUM.
END-PROCEMPLOYEES.
IF DELETED-DEPT = 1 THEN
## RANGE OF e IS #employee
## APPEND TO toberesolved (e.all)
## WHERE e.#idno = IDNO
PERFORM CHECK-ERRORS
## DELETE CURSOR empcsr
END-IF
END-IF
* Log the employee's information
MOVE IDNO TO IDNO-OUT
MOVE NAME IN EMP TO ENAME
MOVE AGE TO AGE-OUT
MOVE SALARY TO SALARY-OUT
DISPLAY EMP-OUT
END-IF
END-PERFORM.
## CLOSE CURSOR empcsr
MOVE 0 TO ERRNUM.
END-PROCEMPLOYEES.
**
* Paragraph: CHECK-ERRORS
*
* This paragraph serves as an error handler called any time
* after INIT-DB has successfully completed. In all cases,
* it prints the cause of the error, and aborts the
* transaction, backing out changes. Note that disconnecting
* from the database will implicitly close any open cursors
* too is aborted. If an error is found the application
**
CHECK-ERRORS.
MOVE 0 TO ERRNUM.
## INQUIRE_EQUEL (ERRNUM = ERRORNO)
IF ERRNUM NOT = 0 THEN
* Restore INGRES error printing
## SET_EQUEL (ERRORMODE = 1)
## INQUIRE_INGRES (ERRBUF = ERRORTEXT)
## ABORT
## EXIT
DISPLAY "Closing Down because of database error:"
DISPLAY ERRBUF
STOP RUN
END-IF.
* Paragraph: CHECK-ERRORS
*
* This paragraph serves as an error handler called any time
* after INIT-DB has successfully completed. In all cases,
* it prints the cause of the error, and aborts the
* transaction, backing out changes. Note that disconnecting
* from the database will implicitly close any open cursors
* too is aborted. If an error is found the application
**
CHECK-ERRORS.
MOVE 0 TO ERRNUM.
## INQUIRE_EQUEL (ERRNUM = ERRORNO)
IF ERRNUM NOT = 0 THEN
* Restore INGRES error printing
## SET_EQUEL (ERRORMODE = 1)
## INQUIRE_INGRES (ERRBUF = ERRORTEXT)
## ABORT
## EXIT
DISPLAY "Closing Down because of database error:"
DISPLAY ERRBUF
STOP RUN
END-IF.
Last modified date: 08/28/2024