3. Embedded QUEL for COBOL : Sample Applications : UNIX and VMS--The Department-Employee Master/Detail Application
 
Share this page                  
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.
##      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.
        * 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).

        * 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.
**
* 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: 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.
*       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
*               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.
**
* 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.
* 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.
* 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).
**
* 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: 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.
**
* 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
* 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 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.