The Department-Employee Master/Detail Application
This application 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. 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 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 cursor is for the Employee table. Both tables are described in declare table statements at the start of the program. The cursors retrieve all the information in the 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. The tables contain no null values.
Each row that is scanned, from both the Department table and the Employee table, is recorded into the system output file. This file serves both as a log of the session and as a simplified report of the updates that were made.
Each section of code is commented for the purpose of the application and also to clarify some of the uses of the Embedded SQL statements. The program illustrates table creation, multi‑statement transactions, all cursor statements, direct updates and error handling.
Windows and UNIX:
IDENTIFICATION DIVISION.
PROGRAM-ID. EXPENSE-PROCESS.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
WORKING-STORAGE SECTION.
EXEC SQL INCLUDE SQLCA END-EXEC.
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
* The department table
EXEC SQL DECLARE dept TABLE
(name char(12) NOT NULL,
totsales decimal(9,2) NOT NULL,
employees smallint NOT NULL)
END-EXEC.
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
* The department table
EXEC SQL DECLARE dept TABLE
(name char(12) NOT NULL,
totsales decimal(9,2) NOT NULL,
employees smallint NOT NULL)
END-EXEC.
* The employee table
EXEC SQL DECLARE employee TABLE
(name char(20) NOT NULL,
age integer1 NOT NULL,
idno integer NOT NULL,
hired date NOT NULL,
dept char(12) NOT NULL,
salary decimal(8,2) NOT NULL)
END-EXEC.
EXEC SQL DECLARE employee TABLE
(name char(20) NOT NULL,
age integer1 NOT NULL,
idno integer NOT NULL,
hired date NOT NULL,
dept char(12) NOT NULL,
salary decimal(8,2) NOT NULL)
END-EXEC.
* "State-of-Limbo" for employees who lose their department
EXEC SQL DECLARE toberesolved TABLE
(name char(20) NOT NULL,
age integer1 NOT NULL,
idno integer NOT NULL,
hired date NOT NULL,
dept char(12) NOT NULL,
salary decimal(8,2) NOT NULL)
END-EXEC.
EXEC SQL DECLARE toberesolved TABLE
(name char(20) NOT NULL,
age integer1 NOT NULL,
idno integer NOT NULL,
hired date NOT NULL,
dept char(12) NOT NULL,
salary decimal(8,2) NOT NULL)
END-EXEC.
* 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.
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.
* Error message buffer used by CHECK-ERRORS.
01 ERRBUF PIC X(200).
* Formatting values for output
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).
* 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).
EXEC SQL END DECLARE SECTION END-EXEC.
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).
EXEC SQL END DECLARE SECTION END-EXEC.
**
* 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 lose their department, "toberesolved".
**
* 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 lose their department, "toberesolved".
**
INIT-DB.
EXEC SQL WHENEVER SQLERROR STOP END-EXEC.
EXEC SQL CONNECT personnel END-EXEC.
DISPLAY "Creating ""To_Be_Resolved"" table".
EXEC SQL CREATE TABLE toberesolved
(name char(20),
age integer1,
idno integer,
hired date,
dept char(12),
salary decimal(8,2)
END-EXEC.
END-INITDB.
EXIT.
**
* Paragraph: END-DB
*
* Commit the multi-statement transaction and close access to
* the database after successful completion of the application.
**
EXEC SQL WHENEVER SQLERROR STOP END-EXEC.
EXEC SQL CONNECT personnel END-EXEC.
DISPLAY "Creating ""To_Be_Resolved"" table".
EXEC SQL CREATE TABLE toberesolved
(name char(20),
age integer1,
idno integer,
hired date,
dept char(12),
salary decimal(8,2)
END-EXEC.
END-INITDB.
EXIT.
**
* Paragraph: END-DB
*
* Commit the multi-statement transaction and close access to
* the database after successful completion of the application.
**
END-DB.
EXEC SQL COMMIT END-EXEC.
EXEC SQL DISCONNECT END-EXEC.
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.
EXEC SQL DECLARE deptcsr CURSOR FOR
SELECT name, totsales, employees
FROM dept
FOR DIRECT UPDATE OF name, employees
END-EXEC.
EXEC SQL COMMIT END-EXEC.
EXEC SQL DISCONNECT END-EXEC.
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.
EXEC SQL DECLARE deptcsr CURSOR FOR
SELECT name, totsales, employees
FROM dept
FOR DIRECT UPDATE OF name, employees
END-EXEC.
* All errors from this point on close down the application.
EXEC SQL WHENEVER SQLERROR GOTO CLOSE-DOWN END-EXEC.
EXEC SQL WHENEVER NOT FOUND GOTO CLOSE-DEPT-CSR END-EXEC.
EXEC SQL OPEN deptcsr END-EXEC.
PERFORM UNTIL SQLCODE NOT = 0
EXEC SQL FETCH deptcsr INTO :DEPT END-EXEC
* Did the department reach minimum sales?
IF TOTSALES < MIN-DEPT-SALES THEN
EXEC SQL DELETE FROM dept
WHERE CURRENT OF deptcsr END-EXEC
MOVE 1 TO DELETED-DEPT
MOVE " -- DISSOLVED --" TO DEPT-FORMAT
ELSE
MOVE 0 TO DELETED-DEPT
MOVE SPACES TO DEPT-FORMAT
END-IF
EXEC SQL WHENEVER SQLERROR GOTO CLOSE-DOWN END-EXEC.
EXEC SQL WHENEVER NOT FOUND GOTO CLOSE-DEPT-CSR END-EXEC.
EXEC SQL OPEN deptcsr END-EXEC.
PERFORM UNTIL SQLCODE NOT = 0
EXEC SQL FETCH deptcsr INTO :DEPT END-EXEC
* Did the department reach minimum sales?
IF TOTSALES < MIN-DEPT-SALES THEN
EXEC SQL DELETE FROM dept
WHERE CURRENT OF deptcsr END-EXEC
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
* If some employees were terminated, record this fact
IF EMPS-TERM > 0 AND DELETED-DEPT = 0 THEN
EXEC SQL UPDATE dept
SET employees = :EMPLOYEES - :EMPS-TERM
WHERE CURRENT OF deptcsr END-EXEC
END-IF
END-PERFORM.
CLOSE-DEPT-CSR.
EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC.
EXEC SQL CLOSE deptcsr END-EXEC.
END-PROCDEPTS.
EXIT.
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
* If some employees were terminated, record this fact
IF EMPS-TERM > 0 AND DELETED-DEPT = 0 THEN
EXEC SQL UPDATE dept
SET employees = :EMPLOYEES - :EMPS-TERM
WHERE CURRENT OF deptcsr END-EXEC
END-IF
END-PERFORM.
CLOSE-DEPT-CSR.
EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC.
EXEC SQL CLOSE deptcsr END-EXEC.
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 employe
* 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.
* 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 employe
* 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.
EXEC SQL DECLARE empcsr CURSOR FOR
SELECT name, age, idno, hired, salary,
int4(interval('days', hired -
date('01-jan-1985')))
FROM employee
WHERE dept = :DNAME
FOR DIRECT UPDATE OF name, salary
END-EXEC.
* All errors from this point on close down the application.
EXEC SQL WHENEVER SQLERROR GOTO CLOSE-DOWN END-EXEC.
EXEC SQL WHENEVER NOT FOUND GOTO CLOSE-EMP-CSR END-EXEC.
EXEC SQL OPEN empcsr END-EXEC.
* Record how many employees are terminated
MOVE 0 TO EMPS-TERM.
PERFORM UNTIL SQLCODE NOT = 0
EXEC SQL FETCH empcsr INTO :EMP END-EXEC
IF HIRED-SINCE-85 > 0 THEN
EXEC SQL DELETE FROM employee
WHERE CURRENT OF empcsr END-EXEC
MOVE "Terminated:" TO TITLE
MOVE "Reason: Hired since 1985." TO DESCRIPTION
ADD 1 TO EMPS-TERM
ELSE
SELECT name, age, idno, hired, salary,
int4(interval('days', hired -
date('01-jan-1985')))
FROM employee
WHERE dept = :DNAME
FOR DIRECT UPDATE OF name, salary
END-EXEC.
* All errors from this point on close down the application.
EXEC SQL WHENEVER SQLERROR GOTO CLOSE-DOWN END-EXEC.
EXEC SQL WHENEVER NOT FOUND GOTO CLOSE-EMP-CSR END-EXEC.
EXEC SQL OPEN empcsr END-EXEC.
* Record how many employees are terminated
MOVE 0 TO EMPS-TERM.
PERFORM UNTIL SQLCODE NOT = 0
EXEC SQL FETCH empcsr INTO :EMP END-EXEC
IF HIRED-SINCE-85 > 0 THEN
EXEC SQL DELETE FROM employee
WHERE CURRENT OF empcsr END-EXEC
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
EXEC SQL UPDATE employee
SET salary = salary * :SALARY-REDUC
WHERE CURRENT OF empcsr END-EXEC
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
EXEC SQL UPDATE employee
SET salary = salary * :SALARY-REDUC
WHERE CURRENT OF empcsr END-EXEC
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
EXEC SQL INSERT INTO toberesolved
SELECT * FROM employee
WHERE idno = :IDNO END-EXEC
EXEC SQL DELETE FROM employee
WHERE CURRENT OF empcsr END-EXEC
END-IF
END-IF
IF DELETED-DEPT = 1 THEN
EXEC SQL INSERT INTO toberesolved
SELECT * FROM employee
WHERE idno = :IDNO END-EXEC
EXEC SQL DELETE FROM employee
WHERE CURRENT OF empcsr END-EXEC
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-PERFORM.
MOVE IDNO TO IDNO-OUT
MOVE ENAME TO ENAME-OUT
MOVE AGE TO AGE-OUT
MOVE SALARY TO SALARY-OUT
DISPLAY EMP-OUT
END-PERFORM.
CLOSE-EMP-CSR.
EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC
EXEC SQL CLOSE empcsr END-EXEC.
END-PROCEMPLOYEES.
EXIT.
EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC
EXEC SQL CLOSE empcsr END-EXEC.
END-PROCEMPLOYEES.
EXIT.
**
* Paragraph: CLOSE-DOWN
*
* 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 ou changes. Note that disconnecting from the
* database will implicitly close any open cursors too.
**
CLOSE-DOWN.
* Turn off error handling
EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC.
EXEC SQL INQUIRE_SQL(:ERRBUF = ERRORTEXT) END-EXEC.
DISPLAY "Closing Down because of database error:".
DISPLAY ERRBUF.
EXEC SQL ROLLBACK END-EXEC.
EXEC SQL DISCONNECT END-EXEC.
STOP RUN.
* Paragraph: CLOSE-DOWN
*
* 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 ou changes. Note that disconnecting from the
* database will implicitly close any open cursors too.
**
CLOSE-DOWN.
* Turn off error handling
EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC.
EXEC SQL INQUIRE_SQL(:ERRBUF = ERRORTEXT) END-EXEC.
DISPLAY "Closing Down because of database error:".
DISPLAY ERRBUF.
EXEC SQL ROLLBACK END-EXEC.
EXEC SQL DISCONNECT END-EXEC.
STOP RUN.
VMS:
IDENTIFICATION DIVISION.
PROGRAM-ID. EXPENSE-PROCESS.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT OUT-FILE ASSIGN TO "EXPENSES.LOG".
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT OUT-FILE ASSIGN TO "EXPENSES.LOG".
DATA DIVISION.
FILE SECTION.
FD OUT-FILE
LABEL RECORD IS OMITTED.
01 PRINT-OUT PIC X(80).
WORKING-STORAGE SECTION.
EXEC SQL INCLUDE SQLCA END-EXEC.
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
* The department table
EXEC SQL DECLARE dept TABLE
(name char(12) NOT NULL,
totsales decimal(14,2) NOT NULL,
employees smallint NOT NULL)
END-EXEC.
FILE SECTION.
FD OUT-FILE
LABEL RECORD IS OMITTED.
01 PRINT-OUT PIC X(80).
WORKING-STORAGE SECTION.
EXEC SQL INCLUDE SQLCA END-EXEC.
EXEC SQL BEGIN DECLARE SECTION END-EXEC.
* The department table
EXEC SQL DECLARE dept TABLE
(name char(12) NOT NULL,
totsales decimal(14,2) NOT NULL,
employees smallint NOT NULL)
END-EXEC.
* The employee table
EXEC SQL DECLARE employee TABLE
(name char(20) NOT NULL,
age integer1 NOT NULL,
idno integer NOT NULL,
hired date NOT NULL,
dept char(12) NOT NULL,
salary decimal(14,2) NOT NULL)
END-EXEC.
EXEC SQL DECLARE employee TABLE
(name char(20) NOT NULL,
age integer1 NOT NULL,
idno integer NOT NULL,
hired date NOT NULL,
dept char(12) NOT NULL,
salary decimal(14,2) NOT NULL)
END-EXEC.
* "State-of-Limbo" for employees who lose their department
EXEC SQL DECLARE toberesolved TABLE
(name char(20) NOT NULL,
age integer1 NOT NULL,
idno integer NOT NULL,
hired date NOT NULL,
dept char(12) NOT NULL,
salary decimal(14,2) NOT NULL)
END-EXEC.
EXEC SQL DECLARE toberesolved TABLE
(name char(20) NOT NULL,
age integer1 NOT NULL,
idno integer NOT NULL,
hired date NOT NULL,
dept char(12) NOT NULL,
salary decimal(14,2) NOT NULL)
END-EXEC.
* 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.
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.
* 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(6) USAGE COMP.
02 HIRED PIC X(26).
02 SALARY USAGE COMP-2.
02 HIRED-SINCE-85 PIC S9(4) USAGE COMP.
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(6) 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.
* Indicates whether "toberesolved" table exists in INIT-DB paragraph.
01 FOUND-TABLE PIC S9 USAGE COMP.
* Error message buffer used by CLOSE-DOWN
01 ERRBUF PIC X(200).
EXEC SQL END DECLARE SECTION END-EXEC.
01 EMPS-TERM PIC S99 USAGE COMP.
* Indicates whether the employee's dept was deleted
01 DELETED-DEPT PIC S9 USAGE COMP.
* Indicates whether "toberesolved" table exists in INIT-DB paragraph.
01 FOUND-TABLE PIC S9 USAGE COMP.
* Error message buffer used by CLOSE-DOWN
01 ERRBUF PIC X(200).
EXEC SQL END DECLARE SECTION END-EXEC.
* 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 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.
SBEGIN.
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 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.
SBEGIN.
* Initialize the database, process each department and
* terminate the session.
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.
INIT-DB.
* terminate the session.
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.
INIT-DB.
* This paragraph connects to the database and aborts if an error.
* Before processing employees, create the table for employees who
* lose their department, "toberesolved".
OPEN OUTPUT OUT-FILE.
MOVE SPACES TO PRINT-OUT.
EXEC SQL WHENEVER SQLERROR STOP END-EXEC.
EXEC SQL CONNECT personnel END-EXEC.
MOVE ZERO TO FOUND-TABLE.
* Before processing employees, create the table for employees who
* lose their department, "toberesolved".
OPEN OUTPUT OUT-FILE.
MOVE SPACES TO PRINT-OUT.
EXEC SQL WHENEVER SQLERROR STOP END-EXEC.
EXEC SQL CONNECT personnel END-EXEC.
MOVE ZERO TO FOUND-TABLE.
* Does the table exist?
EXEC SQL SELECT 1
INTO :FOUND-TABLE
FROM iitables
WHERE table_name = 'toberesolved'
END-EXEC.
EXEC SQL SELECT 1
INTO :FOUND-TABLE
FROM iitables
WHERE table_name = 'toberesolved'
END-EXEC.
* If not, then create it.
IF FOUND-TABLE = 0 THEN
DISPLAY "Creating ""To_Be_Resolved"" table."
EXEC SQL CREATE TABLE toberesolved
(name char(20) NOT NULL,
age integer1 NOT NULL,
idno integer NOT NULL,
hired date NOT NULL,
dept char(12) NOT NULL,
salary decimal(14,2) NOT NULL)
END-EXEC.
END-INITDB.
END-DB.
IF FOUND-TABLE = 0 THEN
DISPLAY "Creating ""To_Be_Resolved"" table."
EXEC SQL CREATE TABLE toberesolved
(name char(20) NOT NULL,
age integer1 NOT NULL,
idno integer NOT NULL,
hired date NOT NULL,
dept char(12) NOT NULL,
salary decimal(14,2) NOT NULL)
END-EXEC.
END-INITDB.
END-DB.
* Commit the multi-statement transaction and access to the
* database.
EXEC SQL COMMIT END-EXEC.
EXEC SQL DISCONNECT END-EXEC.
CLOSE OUT-FILE.
END-ENDDB.
PROCESS-DEPTS.
* This paragraph scans through all the departments, processing
* each one. If the department has made less than $50,000 in
* sales, then the department is dissolved. All employees in each
* department are processed (they may even be moved to another
* table). If an employee is terminated, the department's employee
* counter is updated.
EXEC SQL DECLARE deptcsr CURSOR FOR
SELECT name, totsales, employees
FROM dept
FOR DIRECT UPDATE OF name, employees
END-EXEC.
* database.
EXEC SQL COMMIT END-EXEC.
EXEC SQL DISCONNECT END-EXEC.
CLOSE OUT-FILE.
END-ENDDB.
PROCESS-DEPTS.
* This paragraph scans through all the departments, processing
* each one. If the department has made less than $50,000 in
* sales, then the department is dissolved. All employees in each
* department are processed (they may even be moved to another
* table). If an employee is terminated, the department's employee
* counter is updated.
EXEC SQL DECLARE deptcsr CURSOR FOR
SELECT name, totsales, employees
FROM dept
FOR DIRECT UPDATE OF name, employees
END-EXEC.
* All errors from this point on close down the application.
EXEC SQL WHENEVER SQLERROR GOTO CLOSE-DOWN END-EXEC.
EXEC SQL WHENEVER NOT FOUND GOTO CLOSE-DEPT-CSR END-EXEC.
EXEC SQL OPEN deptcsr END-EXEC.
PERFORM UNTIL SQLCODE NOT = 0
EXEC SQL FETCH deptcsr INTO :DEPT END-EXEC
EXEC SQL WHENEVER SQLERROR GOTO CLOSE-DOWN END-EXEC.
EXEC SQL WHENEVER NOT FOUND GOTO CLOSE-DEPT-CSR END-EXEC.
EXEC SQL OPEN deptcsr END-EXEC.
PERFORM UNTIL SQLCODE NOT = 0
EXEC SQL FETCH deptcsr INTO :DEPT END-EXEC
* Did the department reach minimum sales?
IF TOTSALES < MIN-DEPT-SALES THEN
EXEC SQL DELETE FROM dept
WHERE CURRENT OF deptcsr
END-EXEC
MOVE 1 TO DELETED-DEPT
MOVE " -- DISSOLVED --" TO DEPT-FORMAT
ELSE
MOVE 0 TO DELETED-DEPT
MOVE " " TO DEPT-FORMAT
END-IF
IF TOTSALES < MIN-DEPT-SALES THEN
EXEC SQL DELETE FROM dept
WHERE CURRENT OF deptcsr
END-EXEC
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
WRITE PRINT-OUT FROM DEPT-OUT
* Now process each employee in the department.
PERFORM PROCESS-EMPLOYEES THRU END-PROCEMPLOYEES
MOVE NAME IN DEPT TO DNAME
MOVE TOTSALES TO TOTSALES-OUT
WRITE PRINT-OUT FROM DEPT-OUT
* Now process each employee in the department.
PERFORM PROCESS-EMPLOYEES THRU END-PROCEMPLOYEES
* If some employees were terminated, record this fact.
IF EMPS-TERM > 0 AND DELETED-DEPT = 0 THEN
EXEC SQL UPDATE dept
SET employees = :EMPLOYEES - :EMPS-TERM
WHERE CURRENT OF deptcsr
END-EXEC
END-IF
END-PERFORM.
CLOSE-DEPT-CSR.
EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC.
EXEC SQL CLOSE deptcsr END-EXEC.
END-PROCDEPTS.
PROCESS-EMPLOYEES.
IF EMPS-TERM > 0 AND DELETED-DEPT = 0 THEN
EXEC SQL UPDATE dept
SET employees = :EMPLOYEES - :EMPS-TERM
WHERE CURRENT OF deptcsr
END-EXEC
END-IF
END-PERFORM.
CLOSE-DEPT-CSR.
EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC.
EXEC SQL CLOSE deptcsr END-EXEC.
END-PROCDEPTS.
PROCESS-EMPLOYEES.
* This paragraph scans 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.
* 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.
* 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.
*
* Note the use of the Ingres functions to find out who has
* been hired since 1985.
EXEC SQL DECLARE empcsr CURSOR FOR
SELECT name, age, idno, hired, salary,
int4(interval('days', hired -
date('01-jan-1985')))
FROM employee
WHERE dept = :DEPT.NAME
FOR DIRECT UPDATE OF name, salary
END-EXEC.
* All errors from this point on close down the application.
EXEC SQL WHENEVER SQLERROR GOTO CLOSE-DOWN END-EXEC.
EXEC SQL WHENEVER NOT FOUND GOTO CLOSE-EMP-CSR END-EXEC.
EXEC SQL OPEN empcsr END-EXEC.
* Note the use of the Ingres functions to find out who has
* been hired since 1985.
EXEC SQL DECLARE empcsr CURSOR FOR
SELECT name, age, idno, hired, salary,
int4(interval('days', hired -
date('01-jan-1985')))
FROM employee
WHERE dept = :DEPT.NAME
FOR DIRECT UPDATE OF name, salary
END-EXEC.
* All errors from this point on close down the application.
EXEC SQL WHENEVER SQLERROR GOTO CLOSE-DOWN END-EXEC.
EXEC SQL WHENEVER NOT FOUND GOTO CLOSE-EMP-CSR END-EXEC.
EXEC SQL OPEN empcsr END-EXEC.
* Record how many employees are terminated.
MOVE 0 TO EMPS-TERM.
PERFORM UNTIL SQLCODE NOT = 0
EXEC SQL FETCH empcsr INTO :EMP END-EXEC
IF HIRED-SINCE-85 > 0 THEN
EXEC SQL DELETE FROM employee
WHERE CURRENT OF empcsr;
MOVE "Terminated:" TO TITLE
MOVE "Reason: Hired since 1985."TO DESCRIPTION
ADD 1 TO EMPS-TERM
ELSE
MOVE 0 TO EMPS-TERM.
PERFORM UNTIL SQLCODE NOT = 0
EXEC SQL FETCH empcsr INTO :EMP END-EXEC
IF HIRED-SINCE-85 > 0 THEN
EXEC SQL DELETE FROM employee
WHERE CURRENT OF empcsr;
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
EXEC SQL UPDATE employee
SET salary = salary *
:SALARY-REDUC
WHERE CURRENT OF empcsr
END-EXEC
MOVE "Reduction: " TO TITLE
MOVE "Reason: Salary."TO DESCRIPTION
ELSE
IF SALARY > MIN-EMP-SALARY THEN
IF AGE < NEARLY-RETIRED THEN
EXEC SQL UPDATE employee
SET salary = salary *
:SALARY-REDUC
WHERE CURRENT OF empcsr
END-EXEC
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
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
EXEC SQL INSERT INTO toberesolved
SELECT *
FROM employee
WHERE idno = :IDNO
END-EXEC
EXEC SQL DELETE FROM employee
WHERE CURRENT OF empcsr END-EXEC
END-IF
END-IF
IF DELETED-DEPT = 1 THEN
EXEC SQL INSERT INTO toberesolved
SELECT *
FROM employee
WHERE idno = :IDNO
END-EXEC
EXEC SQL DELETE FROM employee
WHERE CURRENT OF empcsr END-EXEC
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
WRITE PRINT-OUT FROM EMP-OUT
END-PERFORM.
CLOSE-EMP-CSR.
EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC
EXEC SQL CLOSE empcsr END-EXEC.
END-PROCEMPLOYEES.
CLOSE-DOWN.
MOVE IDNO TO IDNO-OUT
MOVE NAME IN EMP TO ENAME
MOVE AGE TO AGE-OUT
MOVE SALARY TO SALARY-OUT
WRITE PRINT-OUT FROM EMP-OUT
END-PERFORM.
CLOSE-EMP-CSR.
EXEC SQL WHENEVER NOT FOUND CONTINUE END-EXEC
EXEC SQL CLOSE empcsr END-EXEC.
END-PROCEMPLOYEES.
CLOSE-DOWN.
* 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.
* 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.
* Turn off error handling
EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC
EXEC SQL INQUIRE_SQL(:ERRBUF = ERRORTEXT) END-EXEC.
DISPLAY "Closing Down because of database error:".
DISPLAY ERRBUF.
EXEC SQL ROLLBACK END-EXEC.
EXEC SQL DISCONNECT END-EXEC.
STOP RUN.
EXEC SQL WHENEVER SQLERROR CONTINUE END-EXEC
EXEC SQL INQUIRE_SQL(:ERRBUF = ERRORTEXT) END-EXEC.
DISPLAY "Closing Down because of database error:".
DISPLAY ERRBUF.
EXEC SQL ROLLBACK END-EXEC.
EXEC SQL DISCONNECT END-EXEC.
STOP RUN.
Last modified date: 01/30/2023