Was this helpful?
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:
If a department has made less than $50,000 in sales, the department is dissolved.
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.
Each row that is scanned, from both the "department" table and the "employee" table, is recorded in an 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.
If your application requires the use of structures, see Fortran Variables and Data Types in this chapter for more information.
This application runs in UNIX, VMS, and Windows environments.
C  Program: ProcessExpenses
C  Purpose: Main entry point to process department and employee expenses
      program ProcessExpenses
      exec sql include sqlca
      exec sql declare dept table
     1 (name          char(12) not null,
     2 totsales       decimal(14,2) not null,
     3 employees      integer2 not null) 
      exec sql declare employee table
     1 (name          char(20) not null, 
     2 age            integer1 not null, 
     3 idno           integer4 not null,
     4 hired          date not null, 
     5 dept           char(12) not null, 
     6 salary         decimal(14,2)  not null)
C "State-of-Limbo" for employees who lose their departments 
      exec sql declare toberesolved table
     1 (name        char(20) not null, 
     2 age          integer1 not null,
     3 idno         integer4 not null,
     4 hired        date not null, 
     5 dept         char(12) not null, 
     6 salary       decimal(14,2) not null)
      print *, 'Entering application to process expenses.' 
      open(unit = 1, file = 'expenses.log', status = 'new')
      call InitDb
      call ProcessDepts
      call EndDb
      close(unit = 1, status = 'keep')
      print *, 'Successful completion of application.'
C Subroutine: InitDb
C Purpose:    Initialize the database. Connect to the database and 
C             abort if an error. Before processing employees, 
C             confirm that the table for employees who lose 
C             their departments,"toberesolved," 
C             exists. Initiate multi-statement transaction.
C Parameters: None.
      subroutine InitDb
      exec sql include sqlca
      exec sql whenever sqlerror stop
      exec sql connect personnel
      write (1, 10) 
10    format ('Creating "To_Be_Resolved" table.')
      exec sql create table toberesolved
     1     (name       char(20) not null,  
     2      age        integer1 not null,
     3      idno       integer4 not null,
     4      hired      date not null,
     5      dept       char(10) not null,
     6      salary     decimal(14,2) not null)

C Subroutine:     EndDb
C Purpose:        End the multi-statement transaction and access
C                 to the database.
C Parameters:     None.
      subroutine EndDb
      exec sql include sqlca
      exec sql commit
      exec sql disconnect
C Subroutine: ProcessDepts
C Purpose:    Scan through all the departments, processing each
C             one. If the department has made less than $50,000 
C             in sales,then the department is 
C             dissolved. For each department, process all the
C             employees (they may even be moved to
C             another table.) If an employee was terminated,
C             update the department's employee counter.
C Parameters: None
      subroutine ProcessDepts
      exec sql include sqlca
      exec sql begin declare section
           character*12        dname
           double precision    dsales
           integer*2           demps
C Employees terminated
           integer*2           dterm
      exec sql end declare section
C Minimum sales of department
      parameter (mindeptsales = 50000.00)
C Was the dept deleted?
      logical deldept 
C Formatting value
      character*20 deptformat
      exec sql declare deptcsr cursor for
     1    select name, totsales, employees
     2    from dept
     3    for direct update of name, employees
C All errors from this point on close down the application 
      exec sql whenever sqlerror call closedown
C Close deptcsr
      exec sql whenever not found go to 100
      exec sql open deptcsr
      dterm = 0
55    if (sqlcod .ne. 0) go to 555
      exec sql fetch deptcsr into :dname, :dsales, :demps
C Did the department reach minimum sales?
      if (dsales .lt. mindeptsales) then
          exec sql delete from dept
     1          where current of deptcsr
          deldept = .true.
          deptformat = ' -- DISSOLVED --'
          deldept = .false.
          deptformat = ' '
C Log what we have just done
       write (1, 11) dname, dsales, deptformat
11     format ('Department: ', a14, ', Total Sales: ', f12.3, a)
C Now process each employee in the department
      call ProcessEmployees(dname, deldept, dterm)

C If some employees were terminated, record this fact 
      if (dterm .gt. 0 .and. .not. deldept) then
          exec sql update dept
     1         set employees = :demps - :dterm
     2         where current of deptcsr
      go to 55
555   continue
      exec sql whenever not found continue

100   exec sql close deptcsr
C Subroutine:  ProcessEmployees
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, the employee
C               is terminated.
C            2. If the employee's yearly salary is more than the
C               minimum company wage of $14,000 and the employee
C               is not close to retirement (over 58 years of age),
C               the employee takes a 5% salary reduction.
C            3. If the employee's department is dissolved and the
C               employee is not terminated, then the employee is
C               moved into the "toberesolved" table.
C Parameters: sname      - Name of current department
C             sdel       - Is current department being dissolved?
C             sterm      - Set locally to record how many employees
C                           were terminated for the current 
C                           department.
      subroutine ProcessEmployees(sname, sdel, sterm)
      exec sql include sqlca
      exec sql begin declare section
           character*12     sname
           character*20     name
           integer*2        age
           integer*4        idno
           character*25     chired
           real             salary
           integer*4        ihired
           parameter (salreduc = 0.95)
      exec sql end declare section
C Minimum employee salary
      parameter        (minsal = 14000.00)
      parameter        (nearlyretired = 58)
C Formatting values
      character*12 title
      character*25 description
C Subroutine arguments
      logical        sdel
      integer*2      sterm
C Note the use of the Ingres function to find out who
C has been hired since 1985.
      exec sql declare empcsr cursor for
     1   select name, age, idno, hired, salary,
     2     int4(interval('days', hired-date('01-jan-1985')))
     3   from employee
     4   where dept = :sname
     5   for direct update of name, salary
C  All errors from this point on close down the application 
      exec sql whenever sqlerror call closedown
C Close empcsr
      exec sql whenever not found go to 200
      exec sql open empcsr
      sterm = 0 
66    if (sqlcod .ne. 0) go to 666
      exec sql fetch empcsr into :name, :age, :idno,  
     1     :chired, :salary, :ihired
      if (ihired .gt. 0) then
           exec sql delete from employee
     1          where current of empcsr
           title = 'Terminated:'
           description = 'Reason: Hired since 1985.'
           sterm = sterm + 1
      else if (salary .gt. minsal) then
C Reduce salary if not nearly retired
           if (age .lt. nearlyretired) then
               exec sql update employee
    1                 set salary = salary * :salreduc  
    2                 where current of empcsr
               title = 'Reduction:'
               description = 'Reason: Salary.'  
C  Do not reduce salary
               title = 'No Changes:'
               description = 'Reason: Retiring.'
C  Leave employee alone
           title = 'No Changes:'
           description = 'Reason: Salary.'
C  Was employee's department dissolved?
      if (deldept) then
          exec sql insert into toberesolved
    1          select *
    2          from employee
    3          where idno = :idno
          exec sql delete from employee
    1          where current OF empcsr
C  Log the employee's information
      write (1, 12) title, idno, name, age, salary, description
12    format (' ', a, ' ', i6, ', ', a, ', ', i2, ', ', f8.2, ';', 
     1        ' ' a)
      go to 66
666   continue
      exec sql whenever not found continue
200   exec sql close empcsr
C Subroutine:   CloseDown
C Purpose:      Error handler called any time after InitDb has been
C               successfully completed. In all cases, print the
C               cause of the error and abort the transaction, 
C               backing out 
C               change Note that disconnecting from the database
C               will implicitly close any open cursors.
C Parameters:   None
      subroutine CloseDown
      exec sql include sqlca
      exec sql begin declare section
          character*100 errbuf
      exec sql end declare section
C  Turn off error handling
      exec sql whenever sqlerror continue
      exec sql copy sqlerror into :errbuf with 100
      write (1, 13)
13    format ('Closed down because of database error:')
      write (1, 14) errbuf
14    format (a)
      close(unit = 1, status = 'keep')
      exec sql rollback
      exec sql disconnect
      print *, stop 'An SQL error occurred - Check the log file.'
Last modified date: 06/10/2024