3. Embedded SQL for COBOL : Sample Applications : The Department-Employee Master/Detail Application
 
Share this page                  
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.
        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.
*       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.
*       "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.
*      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).
*      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.
**
* 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.
**
      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.
*     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
*          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.
**
* 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
*                 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
*                 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
*           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.
CLOSE-EMP-CSR.
      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. 
 
VMS:
IDENTIFICATION DIVISION.
PROGRAM-ID. EXPENSE-PROCESS.
ENVIRONMENT DIVISION.
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.
* 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.
* "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.
* 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.
* 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.
* 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.
* 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.
* 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.
* 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.
* Does the table exist?
    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.
* 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.
* 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 " " 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
* 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.
* 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.
*
* 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.
* 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
* 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
* 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
* 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.
* 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.
* 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.