UNIX and VMS--The Department-Employee Master/Detail Application
This application runs in a master/detail fashion, using 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 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, described below) 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 also 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.
The application runs in the UNIX and VMS environments.
UNIX: The following two create statements describe the Employee and Department database tables:
## create dept
## (name = c1 /* 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 */
## (name = c1 /* 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 */
C
C Procedure: MAIN
Purpose: Main body of the application. Initialize the
C database, process each department,
C and terminate the session.
C
program main
print *, 'Entering application to process expenses.'
call InitDb()
call PrcDpt()
call EndDb()
print *, 'Successful completion of application.'
end
C
C Procedure: InitDb
C Purpose: Initialize the database.
C Start up the database, and abort if an error.
C Before processing employees, create the table for
C employees who lose their department, 'toberesolved'.
C Initiate the multi-statement transaction.
C
C Procedure: MAIN
Purpose: Main body of the application. Initialize the
C database, process each department,
C and terminate the session.
C
program main
print *, 'Entering application to process expenses.'
call InitDb()
call PrcDpt()
call EndDb()
print *, 'Successful completion of application.'
end
C
C Procedure: InitDb
C Purpose: Initialize the database.
C Start up the database, and abort if an error.
C Before processing employees, create the table for
C employees who lose their department, 'toberesolved'.
C Initiate the multi-statement transaction.
C
## subroutine InitDb()
## declare
## integer*4 errnum
## character*256 errtxt
external ErrEnd
integer*4 ErrEnd
## ingres personnel
print *, ' Creating "To_Be_Resolved" table.'
## create toberesolved
## (name = char(20),
## age = smallint,
## idno = integer,
## hired = date,
## dept = char(10),
## salary = money)
## declare
## integer*4 errnum
## character*256 errtxt
external ErrEnd
integer*4 ErrEnd
## ingres personnel
print *, ' Creating "To_Be_Resolved" table.'
## create toberesolved
## (name = char(20),
## age = smallint,
## idno = integer,
## hired = date,
## dept = char(10),
## salary = money)
## inquire_ingres (errnum = errorno)
if (errnum .NE. 0) then
## inquire_ingres (errtxt = ERRORTEXT)
print *, ' Fatal error on creation:'
print *, errtxt
## exit
call exit(-1)
endif
C
C Inform Ingres runtime system about error handler.
C All subsequent errors close down the application.
C
call IIserr(ErrEnd)
## begin transaction
## end
C
C Procedure: EndDb
C Purpose: Close off the multi-statement transaction and access
C to the database after successful completion of the
C application.
C
## subroutine EndDb()
## declare
## end transaction
## exit
## end
if (errnum .NE. 0) then
## inquire_ingres (errtxt = ERRORTEXT)
print *, ' Fatal error on creation:'
print *, errtxt
## exit
call exit(-1)
endif
C
C Inform Ingres runtime system about error handler.
C All subsequent errors close down the application.
C
call IIserr(ErrEnd)
## begin transaction
## end
C
C Procedure: EndDb
C Purpose: Close off the multi-statement transaction and access
C to the database after successful completion of the
C application.
C
## subroutine EndDb()
## declare
## end transaction
## exit
## end
C
C Procedure: PrcDpt
C Purpose: Scan through all the departments, processing each
C one. If the department has made less than
C $50,000 in sales, then the department is dissolved.
C For each department process all the employees
C (they may even be moved to another table).
C If an employee was terminated,
C then update the department'employee counter. No
C error checking is done for cursor updates.
C
## subroutine PrcDpt()
## declare
C Corresponds to the 'dept' table
## character*12 dptnam
## double precision dptsal
## integer*2 dptemp
C Cursor loop control
## integer*4 nmrows
C Minimum sales goal for department
## parameter (SALMIN = 50000.00)
C Number of terminated employees
## integer*2 emptrm
C Department deleted indicator
integer*2 deldpt
C Formatting value
character*21 dptfmt
emptrm = 0
nmrows = 0
## 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
100 continue
C Procedure: PrcDpt
C Purpose: Scan through all the departments, processing each
C one. If the department has made less than
C $50,000 in sales, then the department is dissolved.
C For each department process all the employees
C (they may even be moved to another table).
C If an employee was terminated,
C then update the department'employee counter. No
C error checking is done for cursor updates.
C
## subroutine PrcDpt()
## declare
C Corresponds to the 'dept' table
## character*12 dptnam
## double precision dptsal
## integer*2 dptemp
C Cursor loop control
## integer*4 nmrows
C Minimum sales goal for department
## parameter (SALMIN = 50000.00)
C Number of terminated employees
## integer*2 emptrm
C Department deleted indicator
integer*2 deldpt
C Formatting value
character*21 dptfmt
emptrm = 0
nmrows = 0
## 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
100 continue
## retrieve cursor deptcsr
## (dptnam, dptsal, dptemp)
## inquire_equel (nmrows = ENDQUERY)
if (nmrows .EQ. 0) then
C Did the department reach minimum sales?
if (dptsal .LT. SALMIN) then
## delete cursor deptcsr
deldpt = 1
dptfmt = ' -- DISSOLVED --'
else
deldpt = 0
dptfmt = ' '
endif
C Log what we have just done
print 11, dptnam, dptsal, dptfmt 11
format (' Department: ', a14, ', Total Sales: ',
f12.3, a)
C Now process each employee in the department
call PrcEmp( dptnam, deldpt, emptrm )
C If some employees were terminated, record this fact
if (emptrm .GT. 0 .AND. deldpt .EQ. 0) then
## replace cursor deptcsr
## (employees = dptemp - emptrm)
endif
endif
if (nmrows .EQ. 0) goto 100
## close cursor deptcsr
## end
## (dptnam, dptsal, dptemp)
## inquire_equel (nmrows = ENDQUERY)
if (nmrows .EQ. 0) then
C Did the department reach minimum sales?
if (dptsal .LT. SALMIN) then
## delete cursor deptcsr
deldpt = 1
dptfmt = ' -- DISSOLVED --'
else
deldpt = 0
dptfmt = ' '
endif
C Log what we have just done
print 11, dptnam, dptsal, dptfmt 11
format (' Department: ', a14, ', Total Sales: ',
f12.3, a)
C Now process each employee in the department
call PrcEmp( dptnam, deldpt, emptrm )
C If some employees were terminated, record this fact
if (emptrm .GT. 0 .AND. deldpt .EQ. 0) then
## replace cursor deptcsr
## (employees = dptemp - emptrm)
endif
endif
if (nmrows .EQ. 0) goto 100
## close cursor deptcsr
## end
C
C Procedure: PrcEmp
C Purpose: Scan through all the employees for a particular
C department. Based on given conditions the employee
C may be terminated or given a salary reduction.
C 1. If an employee was hired since 1985 then the
C employee is terminated.
C 2. If the employee's yearly salary is more than
C the minimum company wage of $14,000 and the
C employee is not close to Retirement (over 58
C years of age), then the employee takes a 5%
C salary reduction.
C 3. If the employee's department is dissolved and
C the employee is not terminated, then the
C employee is moved into the
C 'toberesolved' table.
C Parameters:
C dptnam - Name of current department.
C deldpt - Is current department being dissolved?
C emptrm - Set locally to record how many
C employees were terminated for the
C current department.
C
## subroutine PrcEmp( dptnam, deldpt, emptrm )
## character*12 dptnam
integer*2 deldpt
C Number of terminated employees
integer*2 emptrm
## declare
C Corresponds to 'employee' table
## character*20 empnam
## integer*2 empage
## integer*4 empid
## character*25 emphir
## real*4 emppay
## integer*4 emp85
C Cursor loop control
## integer*4 nmrows
C Minimum employee salary
## parameter (MINPAY = 14000.00)
C Age of employees near to retirement
## parameter (NEAR65 = 58)
C Percentage of current salary to receive
## parameter (SALRED = 0.95)
C Formatting values
character*14 title
character*25 desc
nmrows = 0
C
C Note the use of the Ingres function to find out who was
C hired since 1985.
C
## 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 = dptnam
## for direct update of (name, salary)
## open cursor empcsr
emptrm = 0
10 continue
C Procedure: PrcEmp
C Purpose: Scan through all the employees for a particular
C department. Based on given conditions the employee
C may be terminated or given a salary reduction.
C 1. If an employee was hired since 1985 then the
C employee is terminated.
C 2. If the employee's yearly salary is more than
C the minimum company wage of $14,000 and the
C employee is not close to Retirement (over 58
C years of age), then the employee takes a 5%
C salary reduction.
C 3. If the employee's department is dissolved and
C the employee is not terminated, then the
C employee is moved into the
C 'toberesolved' table.
C Parameters:
C dptnam - Name of current department.
C deldpt - Is current department being dissolved?
C emptrm - Set locally to record how many
C employees were terminated for the
C current department.
C
## subroutine PrcEmp( dptnam, deldpt, emptrm )
## character*12 dptnam
integer*2 deldpt
C Number of terminated employees
integer*2 emptrm
## declare
C Corresponds to 'employee' table
## character*20 empnam
## integer*2 empage
## integer*4 empid
## character*25 emphir
## real*4 emppay
## integer*4 emp85
C Cursor loop control
## integer*4 nmrows
C Minimum employee salary
## parameter (MINPAY = 14000.00)
C Age of employees near to retirement
## parameter (NEAR65 = 58)
C Percentage of current salary to receive
## parameter (SALRED = 0.95)
C Formatting values
character*14 title
character*25 desc
nmrows = 0
C
C Note the use of the Ingres function to find out who was
C hired since 1985.
C
## 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 = dptnam
## for direct update of (name, salary)
## open cursor empcsr
emptrm = 0
10 continue
## retrieve cursor empcsr (empnam, empage, empid,
## emphir, emppay, emp85)
## inquire_equel (nmrows = ENDQUERY)
if (nmrows .EQ. 0) then
if (emp85 .GT. 0) then
## delete cursor empcsr
title = 'Terminated:'
desc = 'Reason: Hired since 1985.'
emptrm = emptrm + 1
else
C Reduce salary if not near retirement
if (emppay .GT. MINPAY) then
if (empage .LT. NEAR65) the
## replace cursor empcsr
## (salary = salary * SALRED)
title = 'Reduction: '
desc = 'Reason: Salary.'
C Do not reduce salary
else
title = 'No Changes:'
desc = 'Reason: Retiring.'
endif
C Make no changes in salary
else
title = 'No Changes:'
desc = 'Reason: Salary.'
endif
## emphir, emppay, emp85)
## inquire_equel (nmrows = ENDQUERY)
if (nmrows .EQ. 0) then
if (emp85 .GT. 0) then
## delete cursor empcsr
title = 'Terminated:'
desc = 'Reason: Hired since 1985.'
emptrm = emptrm + 1
else
C Reduce salary if not near retirement
if (emppay .GT. MINPAY) then
if (empage .LT. NEAR65) the
## replace cursor empcsr
## (salary = salary * SALRED)
title = 'Reduction: '
desc = 'Reason: Salary.'
C Do not reduce salary
else
title = 'No Changes:'
desc = 'Reason: Retiring.'
endif
C Make no changes in salary
else
title = 'No Changes:'
desc = 'Reason: Salary.'
endif
C Was employee's department dissolved ?
if (deldpt .NE. 0) then
## append to toberesolved (e.all)
## where e.idno = empid
## delete cursor empcsr
endif
endif
C Log the employee's information
print 12, title, empid, empnam, empage, emppay,
& desc
12 format (' ', a, ' ', i6, ', ', a, ', ', i2, ', ', f8.2,
& ';', ' ' a)
endif
if (nmrows .EQ. 0) goto 10
## close cursor empcsr
## end
if (deldpt .NE. 0) then
## append to toberesolved (e.all)
## where e.idno = empid
## delete cursor empcsr
endif
endif
C Log the employee's information
print 12, title, empid, empnam, empage, emppay,
& desc
12 format (' ', a, ' ', i6, ', ', a, ', ', i2, ', ', f8.2,
& ';', ' ' a)
endif
if (nmrows .EQ. 0) goto 10
## close cursor empcsr
## end
C
C Procedure: ErrEnd
C Purpose: If an error occurs during the execution of an EQUEL
C statement, this error handler is called. Errors are
C printed and the current database session is terminated.
C Any open transactions are implicitly closed.
C Parameters:
C ingerr - Integer containing Ingres error number.
C
## integer function ErrEnd(ingerr)
integer*4 ingerr
## declare
## character*256 errtxt
## inquire_ingres (errtxt = errortext)
print *, ' Closing down because of database error:'
print *, errtxt
## abort
## exit
call exit(-1)
ErrEnd = 0
## end
C Procedure: ErrEnd
C Purpose: If an error occurs during the execution of an EQUEL
C statement, this error handler is called. Errors are
C printed and the current database session is terminated.
C Any open transactions are implicitly closed.
C Parameters:
C ingerr - Integer containing Ingres error number.
C
## integer function ErrEnd(ingerr)
integer*4 ingerr
## declare
## character*256 errtxt
## inquire_ingres (errtxt = errortext)
print *, ' Closing down because of database error:'
print *, errtxt
## abort
## exit
call exit(-1)
ErrEnd = 0
## end
VMS: The following two create statements describe the Employee and Department database tables:
## 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 */
!
! Procedure: MAIN
! Purpose: Main body of the application. Initialize the
! database, process each department, and terminate
! the session.
!
program main
print *, 'Entering application to process expenses.'
call Init_Db()
call Process_Depts()
call End_Db()
print *, 'Successful completion of application.'
end
!
! Procedure: Init_Db
! Purpose: Initialize the database.
! Start up the database, and abort if an error.
! Before processing employees, create the table for
! employees who lose their department,
! 'toberesolved'. Initiate the multi-statement
! transaction.
!
## subroutine Init_Db()
## declare
## integer*4 err_no
## character*256 err_text
external Close_Down
integer*4 Close_Down
## (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 */
!
! Procedure: MAIN
! Purpose: Main body of the application. Initialize the
! database, process each department, and terminate
! the session.
!
program main
print *, 'Entering application to process expenses.'
call Init_Db()
call Process_Depts()
call End_Db()
print *, 'Successful completion of application.'
end
!
! Procedure: Init_Db
! Purpose: Initialize the database.
! Start up the database, and abort if an error.
! Before processing employees, create the table for
! employees who lose their department,
! 'toberesolved'. Initiate the multi-statement
! transaction.
!
## subroutine Init_Db()
## declare
## integer*4 err_no
## character*256 err_text
external Close_Down
integer*4 Close_Down
## ingres personnel
print *, ' Creating "To_Be_Resolved" table.'
## create toberesolved
## (name = c20,
## age = smallint,
## idno = integer,
## hired = date,
## dept = c10,
## salary = money)
## inquire_ingres (err_no = errorno)
if (err_no .NE. 0) then
## inquire_ingres (err_text = errortext)
print *, ' Fatal error on creation:'
print *, err_text
## exit
call exit(-1)
endif
!
! Inform Ingres runtime system about error handler.
! All subsequent errors close down the application.
!
call IIseterr(Close_Down)
## begin transaction
## end
print *, ' Creating "To_Be_Resolved" table.'
## create toberesolved
## (name = c20,
## age = smallint,
## idno = integer,
## hired = date,
## dept = c10,
## salary = money)
## inquire_ingres (err_no = errorno)
if (err_no .NE. 0) then
## inquire_ingres (err_text = errortext)
print *, ' Fatal error on creation:'
print *, err_text
## exit
call exit(-1)
endif
!
! Inform Ingres runtime system about error handler.
! All subsequent errors close down the application.
!
call IIseterr(Close_Down)
## begin transaction
## end
!
! Procedure: End_Db
! Purpose: Close off the multi-statement transaction and
! access to the database after successful completion
! of the application.
!
## subroutine End_Db()
## declare
## end transaction
## exit
## end
!
! Procedure: Process_Depts
! Purpose: 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. No error checking is done for cursor
! updates.
!
## subroutine Process_Depts()
## declare
## structure /department/ !Corresponds to the 'dept' table
## character*12 name
## double precision totsales
## integer*2 employees
## end structure
## record /department/ dpt
## integer*4 no_rows ! Cursor loop control
## parameter MIN_DEPT_SALES = 50000.00 ! Min department sales
## integer*2 emps_term ! Employees terminated
integer*2 deleted_dept ! Was the dept deleted?
character*21 dept_format ! Formatting value
emps_term = 0
no_rows = 0
! Procedure: End_Db
! Purpose: Close off the multi-statement transaction and
! access to the database after successful completion
! of the application.
!
## subroutine End_Db()
## declare
## end transaction
## exit
## end
!
! Procedure: Process_Depts
! Purpose: 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. No error checking is done for cursor
! updates.
!
## subroutine Process_Depts()
## declare
## structure /department/ !Corresponds to the 'dept' table
## character*12 name
## double precision totsales
## integer*2 employees
## end structure
## record /department/ dpt
## integer*4 no_rows ! Cursor loop control
## parameter MIN_DEPT_SALES = 50000.00 ! Min department sales
## integer*2 emps_term ! Employees terminated
integer*2 deleted_dept ! Was the dept deleted?
character*21 dept_format ! Formatting value
emps_term = 0
no_rows = 0
## 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
do while (no_rows .EQ. 0)
## retrieve cursor deptcsr
## (dpt.name, dpt.totsales, dpt.employees)
## inquire_equel (no_rows = endquery)
if (no_rows .EQ. 0) then
! Did the department reach minimum sales?
if (dpt.totsales .LT. MIN_DEPT_SALES) then
## delete cursor deptcsr
deleted_dept = 1
dept_format = ' -- DISSOLVED --'
else
deleted_dept = 0
dept_format = ' '
endif
! Log what we have just done
! Log what we have just done
print 11, dpt.name, dpt.totsales, dept_format
11 format
(' Department: ', a14, ', Total Sales: ', f12.3, a)
! Now process each employee in the department
call Process_Employees( dpt.name, deleted_dept,
1 emps_term )
! If some employees were terminated, record this fact
if (emps_term .GT. 0 .AND.
1 deleted_dept .EQ. .FALSE.) then
## replace cursor deptcsr
## (employees = dpt.employees - emps_term)
endif
endif
end do
## close cursor deptcsr
## end
## declare cursor deptcsr for
## retrieve (d.name, d.totsales, d.employees)
## for direct update of (name, employees)
## open cursor deptcsr
do while (no_rows .EQ. 0)
## retrieve cursor deptcsr
## (dpt.name, dpt.totsales, dpt.employees)
## inquire_equel (no_rows = endquery)
if (no_rows .EQ. 0) then
! Did the department reach minimum sales?
if (dpt.totsales .LT. MIN_DEPT_SALES) then
## delete cursor deptcsr
deleted_dept = 1
dept_format = ' -- DISSOLVED --'
else
deleted_dept = 0
dept_format = ' '
endif
! Log what we have just done
! Log what we have just done
print 11, dpt.name, dpt.totsales, dept_format
11 format
(' Department: ', a14, ', Total Sales: ', f12.3, a)
! Now process each employee in the department
call Process_Employees( dpt.name, deleted_dept,
1 emps_term )
! If some employees were terminated, record this fact
if (emps_term .GT. 0 .AND.
1 deleted_dept .EQ. .FALSE.) then
## replace cursor deptcsr
## (employees = dpt.employees - emps_term)
endif
endif
end do
## close cursor deptcsr
## end
!
! Procedure: Process_Employees
! Purpose: 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.
! Parameters:
! dept_name - Name of current department.
! deleted_dept - Is current department being
! dissolved?
! emps_term - Set locally to record how many
! employees were terminated for
! the current department.
!
!
## subroutine Process_Employees( dept_name, deleted_dept,
1 emps_term )
## character*12 dept_name
integer*2 deleted_dept
integer*2 emps_term
## declare
## structure /employee/ !Corresponds to 'employee' table
## character*20 name
## integer*2 age
## integer*4 idno
## character*25 hired
## real*4 salary
## integer*4 hired_since_85
## end structure
## record /employee/ emp
! Procedure: Process_Employees
! Purpose: 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.
! Parameters:
! dept_name - Name of current department.
! deleted_dept - Is current department being
! dissolved?
! emps_term - Set locally to record how many
! employees were terminated for
! the current department.
!
!
## subroutine Process_Employees( dept_name, deleted_dept,
1 emps_term )
## character*12 dept_name
integer*2 deleted_dept
integer*2 emps_term
## declare
## structure /employee/ !Corresponds to 'employee' table
## character*20 name
## integer*2 age
## integer*4 idno
## character*25 hired
## real*4 salary
## integer*4 hired_since_85
## end structure
## record /employee/ emp
## integer*4 no_rows ! Cursor loop control
## parameter MIN_EMP_SALARY = 14000.00
! Minimum employee salary
## parameter NEARLY_RETIRED = 58
## parameter SALARY_REDUC = 0.95
character*14 title ! Formatting values
character*25 description
no_rows = 0
!
! Note the use of the Ingres function 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 = dept_name
## for direct update of (name, salary)
## parameter MIN_EMP_SALARY = 14000.00
! Minimum employee salary
## parameter NEARLY_RETIRED = 58
## parameter SALARY_REDUC = 0.95
character*14 title ! Formatting values
character*25 description
no_rows = 0
!
! Note the use of the Ingres function 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 = dept_name
## for direct update of (name, salary)
## open cursor empcsr
emps_term = 0 ! Record how many
do while (no_rows .EQ. 0)
## retrieve cursor empcsr (emp.name, emp.age, emp.idno,
## emp.hired, emp.salary, emp.hired_since_85)
## inquire_equel (no_rows = endquery)
if (no_rows .EQ. 0) then
if (emp.hired_since_85 .GT. 0) then
## delete cursor empcsr
title = 'Terminated:'
description = 'Reason: Hired since 1985.'
emps_term = emps_term + 1
else
! Reduce salary if not nearly retired
if (emp.salary .GT. MIN_EMP_SALARY) then
if (emp.age .LT. NEARLY_RETIRED) then
## replace cursor empcsr
## (salary = salary * SALARY_REDUC)
title = 'Reduction: '
description = 'Reason: Salary.'
else
! Do not reduce salary
title = 'No Changes:'
description = 'Reason: Retiring.'
endif
else ! Leave employee alone
title = 'No Changes:'
description = 'Reason: Salary.'
endif
! Was employee's department dissolved ?
if (deleted_dept .NE. 0) then
## append to toberesolved (e.all)
## where e.idno = emp.idno
## delete cursor empcsr
endif
endif
emps_term = 0 ! Record how many
do while (no_rows .EQ. 0)
## retrieve cursor empcsr (emp.name, emp.age, emp.idno,
## emp.hired, emp.salary, emp.hired_since_85)
## inquire_equel (no_rows = endquery)
if (no_rows .EQ. 0) then
if (emp.hired_since_85 .GT. 0) then
## delete cursor empcsr
title = 'Terminated:'
description = 'Reason: Hired since 1985.'
emps_term = emps_term + 1
else
! Reduce salary if not nearly retired
if (emp.salary .GT. MIN_EMP_SALARY) then
if (emp.age .LT. NEARLY_RETIRED) then
## replace cursor empcsr
## (salary = salary * SALARY_REDUC)
title = 'Reduction: '
description = 'Reason: Salary.'
else
! Do not reduce salary
title = 'No Changes:'
description = 'Reason: Retiring.'
endif
else ! Leave employee alone
title = 'No Changes:'
description = 'Reason: Salary.'
endif
! Was employee's department dissolved ?
if (deleted_dept .NE. 0) then
## append to toberesolved (e.all)
## where e.idno = emp.idno
## delete cursor empcsr
endif
endif
! Log the employee's information
print 12, title, emp.idno, emp.name, emp.age,
emp.salary,
1 description
12 format (' ', a, ' ', i6, ', ', a, ', ', i2, ', ',
1 f8.2, ';', 1 ' ' a)
endif
end do
## close cursor empcsr
## end
print 12, title, emp.idno, emp.name, emp.age,
emp.salary,
1 description
12 format (' ', a, ' ', i6, ', ', a, ', ', i2, ', ',
1 f8.2, ';', 1 ' ' a)
endif
end do
## close cursor empcsr
## end
!
! Procedure: Close_Down
! Purpose: If an error occurs during the execution of an
! EQUEL statement, this error handler is called.
! Errors are printed and the current database session
! is terminated.
! Any open transactions are implicitly closed.
! Parameters:
! ingerr - Integer containing Ingres error
! number.
!
## integer function Close_Down(ingerr)
integer*4 ingerr
## declare
## character*256 err_text
## inquire_ingres (err_text = errortext)
print *, ' Closing down because of database error:'
print *, err_text
## abort
## exit
call exit(-1)
Close_Down = 0
## end
! Procedure: Close_Down
! Purpose: If an error occurs during the execution of an
! EQUEL statement, this error handler is called.
! Errors are printed and the current database session
! is terminated.
! Any open transactions are implicitly closed.
! Parameters:
! ingerr - Integer containing Ingres error
! number.
!
## integer function Close_Down(ingerr)
integer*4 ingerr
## declare
## character*256 err_text
## inquire_ingres (err_text = errortext)
print *, ' Closing down because of database error:'
print *, err_text
## abort
## exit
call exit(-1)
Close_Down = 0
## end
Last modified date: 08/28/2024