3. Embedded QUEL for COBOL : Sample Applications : UNIX and VMS—The Employee Query Interactive Forms Application
 
Share this page                  
UNIX and VMS—The Employee Query Interactive Forms Application
This EQUEL/FORMS application uses a form in query mode to view a subset of the Employee table in the Personnel database. An Ingres query qualification is built at runtime using values entered in fields of the form "empform."
The objects used in this application are:
Object
Description
personnel
The program's database environment.
employee
A table in the database, with six columns:
name (c20)
age (i1)
idno (i4)
hired (date)
dept (c10)
salary (money)
empform
A VIFRED form with fields corresponding in name and type to the columns in the Employee database table. The name and idno fields are used to build the query and are the only updatable fields. Empform is a compiled form.
The application is driven by a display statement that allows the runtime user to enter values in the two fields that will build the query. The Build_Query and Exec_Query procedures make up the core of the query that is run as a result. Note the way the values of the query operators determine the logic used to build the where clause in Build_Query. The retrieve statement encloses a submenu block that allows the user to step through the results of the query.
No updates are performed on the values retrieved, but any particular employee screen may be saved in a log file through the printscreen statement.
For readability, all EQUEL reserved words are in uppercase.
UNIX: The following create statement describes the format of the Employee database table:
##  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)   /* Annual salary */

        IDENTIFICATION DIVISION.
        PROGRAM-ID. EMPLOYEE-QUERY.

        ENVIRONMENT DIVISION.

        DATA DIVISION.
        WORKING-STORAGE SECTION.
##      DECLARE

*       For WHERE clause qualification
##      01      WHERE-CLAUSE         PIC X(100).

*       Query operators
##      01       NAME-OP             PIC S9(8) USAGE COMP.
##      01       ID-OP               PIC S9(8) USAGE COMP.

*       Were rows found?
##      01 ROWS PIC S9(8) USAGE COMP.

##      01  FORM-VALUES.
##          02 ENAME                 PIC X(20).
##          02 EIDNO                 PIC S9(8) USAGE COMP.
##          02 EAGE                  PIC S9(2) USAGE COMP.
##          02 EHIRED                PIC X(25).
##          02 ESALARY               PIC S9(6)V9(2) USAGE COMP-3.
##          02 DISP-IDNO             PIC ZZZZZ9.
*       Compiled forms are not yet accepted as EXTERNAL due
*       to restrictions noted in the chapter
*       that describes how to link the RTS with compiled forms.
*       Consequently the declarations of external form
*       objects and the corresponding ADDFORM statement 
*       have been commented out and replaced by a CALL 
*       "add_formname" statement.
##      01 empform PIC S9(9) USAGE COMP-5 IS EXTERNAL.

*       Query operator table that maps integer values to string
*       query operators

        01 OPER-MASKS. 
            02 FILLER VALUE "= "  PIC X(3).
            02 FILLER VALUE "!= " PIC X(3).
            02 FILLER VALUE "< "  PIC X(3).
            02 FILLER VALUE "> "  PIC X(3).
            02 FILLER VALUE "<= " PIC X(3).
            02 FILLER VALUE ">= " PIC X(3).
         01 OPER-TABLE REDEFINES OPER-MASKS.
            02 OPER OCCURS 6 TIMES  PIC X(3).

         PROCEDURE DIVISION.
         EXAMPLE SECTION.
         XBEGIN.

*        Initialize WHERE clause qualification buffer to be an 
*        Ingres default qualification that is always true

         MOVE "1=1" TO WHERE-CLAUSE.

##       FORMS
##       MESSAGE "Accessing Employee Query Application..."
##       INGRES "personnel"
* ##     ADDFORM empform
         CALL "add_empform".

##       DISPLAY #empform QUERY
##       INITIALIZE
##       ACTIVATE MENUITEM "Reset"
##       {
##              CLEAR FIELD ALL
##       }
##       ACTIVATE MENUITEM "Query"
##       {      

*               Verify validity of data
##              VALIDATE

                PERFORM BUILD-QUERY THROUGH ENDBUILD-QUERY.
                PERFORM EXEC-QUERY THROUGH ENDEXEC-QUERY.
##       }
##       ACTIVATE MENUITEM "LastQuery"
##       {
              PERFORM EXEC-QUERY THROUGH ENDEXEC-QUERY.
##       }
##            ACTIVATE MENUITEM "End", FRSKEY3
##       {
##              BREAKDISPLAY
##       }
##       FINALIZE

##       ENDFORMS
##       EXIT
         STOP RUN.
**
* Paragraph: BUILD-QUERY
*
*        Build a query from the values in the "name and "idno"
*        fields in "empform."
**

         BUILD-QUERY.

##       GETFORM #empform (
##             ENAME = name, NAME-OP = GETOPER(name),
##             EIDNO = idno, ID-OP = GETOPER(idno)
##       )

*        Fill in the WHERE clause
         MOVE SPACES TO WHERE-CLAUSE.

         IF NAME-OP = 0 AND ID-OP = 0 THEN

                MOVE "1 = 1" TO WHERE-CLAUSE

         ELSE IF NAME-OP NOT = 0 AND ID-OP NOT = 0 THEN

*                        Query on both fields
                MOVE EIDNO TO DISP-IDNO
                STRING "e.name " DELIMITED BY SIZE,
                        OPER(NAME-OP) DELIMITED BY " ",
                        """" DELIMITED BY SIZE,
                        ENAME DELIMITED BY SIZE,
                        """" DELIMITED BY SIZE,
                        " and e.idno " DELIMITED BY SIZE,
                        OPER(ID-OP) DELIMITED BY " ",
                      DISP-IDNO DELIMITED BY SIZE INTO WHERE-CLAUSE
         ELSE IF NAME-OP NOT = 0 THEN

*               Query on the 'name' field
                STRING "e.name " DELIMITED BY SIZE,
                        OPER(NAME-OP) DELIMITED BY " ",
                        """" DELIMITED BY SIZE,
                        ENAME DELIMITED BY SIZE,
                        """" DELIMITED BY SIZE INTO WHERE-CLAUSE

         ELSE

*               Query on the 'idno' field
                MOVE EIDNO TO DISP-IDNO
                STRING "e.idno " DELIMITED BY SIZE,
                        OPER(ID-OP) DELIMITED BY " ",
                      DISP-IDNO DELIMITED BY SIZE INTO WHERE-CLAUSE

         END-IF.

         ENDBUILD-QUERY.
           EXIT.
**
* Paragraph: EXEC-QUERY
*
*        Given a query buffer defining a WHERE clause, issue a
*        RETRIEVE to allow the runtime user to browse the employee
*        found with the given qualification.
**

         EXEC-QUERY.

##       RANGE OF e IS employee

##       RETRIEVE (EIDNO = e.idno, ENAME = e.name, EAGE = e.age,
##                EHIRED = e.hired, ESALARY = e.salary)
##                WHERE WHERE-CLAUSE
##       {  

*              Put values onto form and display them

##             PUTFORM #empform (
##                    idno = EIDNO, name = ENAME, age = EAGE,
##                    hired = EHIRED, salary = ESALARY)

##             REDISPLAY

##             SUBMENU
##             ACTIVATE MENUITEM "Next", FRSKEY4
##             {

*                  Do nothing, and continue with the RETRIEVE loop.
*                  The last one will drop out.

##              }
##              ACTIVATE MENUITEM "Save", FRSKEY8
##              {

*                  Save screen data in log file
##                 PRINTSCREEN (FILE = "query.log")
*                  Drop through to next employee

##               }
##               ACTIVATE MENUITEM "End", FRSKEY3
##               {

*                         Terminate the RETRIEVE loop
##                        ENDRETRIEVE

##               }

##       }
##     INQUIRE_EQUEL (ROWS = ROWCOUNT)
       IF ROWS = 0 THEN
##         MESSAGE "No rows found for this query."
       ELSE
##         CLEAR FIELD ALL
##         MESSAGE "No more rows. Reset for next query."
       END-IF.
##     SLEEP 2

       ENDEXEC-QUERY.
         EXIT. 

VMS: The create statement describing the format of the Employee database table is shown first:
              ##     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)    /* Annual salary */

IDENTIFICATION DIVISION.
PROGRAM-ID. EMPLOYEE-QUERY.

ENVIRONMENT DIVISION.

DATA DIVISION.
WORKING-STORAGE SECTION.
##      DECLARE
* Compiled form
##      01  EMPFORM-ID PIC S9(9) USAGE COMP VALUE IS EXTERNAL empform.

* For WHERE clause qualification
##      01  WHERE-CLAUSE PIC X(100).

* Query operators
##      01  NAME_OP      PIC S9(8) USAGE COMP.
##      01  ID_OP        PIC S9(8) USAGE COMP.

* Were rows found?
##      01  ROWS         PIC S9(8) USAGE COMP.

##      01  FORM_VALUES.
##          02      ENAME PIC X(20).
##          02      EIDNO PIC S9(8) USAGE COMP.
##          02      EAGE PIC S9(2) USAGE COMP.
##          02      EHIRED PIC X(25).
##          02      EDEPT PIC X(10).
##          02      ESALARY USAGE COMP-2.
##          02      DISP_IDNO PIC ZZZZZ9.

* Query operator table that maps integer values to string 
* query operators
        01  OPER_MASKS.
            02     FILLER VALUE "= "     PIC X(3).
            02     FILLER VALUE "!= "    PIC X(3).
            02     FILLER VALUE "< "     PIC X(3).
            02     FILLER VALUE "> "     PIC X(3).
            02     FILLER VALUE "<= "    PIC X(3).
            02     FILLER VALUE ">= "    PIC X(3).
        01  OPER_TABLE REDEFINES OPER_MASKS.
            02     OPER OCCURS 6 TIMES   PIC X(3).

PROCEDURE DIVISION.
SBEGIN.
* Initialize WHERE clause qualification buffer to be a default
* qualification that is always true

      MOVE "1=1" TO WHERE-CLAUSE.

##    FORMS
##    MESSAGE "Accessing Employee Query Application..."
##    INGRES "personnel"

##    ADDFORM EMPFORM-ID

##    DISPLAY #empform QUERY
##    INITIALIZE
##    ACTIVATE MENUITEM "Reset"
##    {
##          CLEAR FIELD ALL
##    }
##    ACTIVATE MENUITEM "Query"
##    {

* Verify validity of data
##             VALIDATE

               PERFORM BUILD-QUERY THROUGH ENDBUILD-QUERY.
               PERFORM EXEC-QUERY THROUGH ENDEXEC-QUERY.
##    }
##    ACTIVATE MENUITEM "LastQuery"
##    {
               PERFORM EXEC-QUERY THROUGH ENDEXEC-QUERY.
##    }
##    ACTIVATE MENUITEM "End", FRSKEY3
##    {
##             BREAKDISPLAY
##    }
##    FINALIZE

##    ENDFORMS
##    EXIT
      STOP RUN.
**
* Paragraph: BUILD-QUERY
*
*     Build a query from the values in the "name and "idno"
*     fields in "empform."
**
BUILD-QUERY.

##    GETFORM #empform (
##            ENAME = name, NAME_OP = GETOPER(name),
##            EIDNO = idno, ID_OP = GETOPER(idno)
##    )

* Fill in the where clause

      IF NAME_OP = 0 AND ID_OP = 0 THEN

             MOVE "1 = 1" TO WHERE-CLAUSE

      ELSE IF NAME_OP NOT = 0 AND ID_OP NOT = 0 THEN

* Query on both fields

              MOVE EIDNO TO DISP_IDNO

              STRING "e.name " DELIMITED BY SIZE,
                      OPER(NAME_OP) DELIMITED BY " ",
                      """" DELIMITED BY SIZE,
                      ENAME DELIMITED BY SIZE,
                      """" DELIMITED BY SIZE,
                      " and e.idno " DELIMITED BY SIZE,
                      OPER(ID_OP) DELIMITED BY " ",
                      DISP_IDNO DELIMITED BY SIZE INTO WHERE-CLAUSE

     ELSE IF NAME_OP NOT = 0 THEN

* Query on the 'name' field

              STRING "e.name " DELIMITED BY SIZE,
                      OPER(NAME_OP) DELIMITED BY " ",
                      """" DELIMITED BY SIZE,
                      ENAME DELIMITED BY SIZE,
                      """" DELIMITED BY SIZE INTO WHERE-CLAUSE

      ELSE

* Query on the 'idno' field

              MOVE EIDNO TO DISP_IDNO

              STRING "e.idno " DELIMITED BY SIZE,
                      OPER(ID_OP) DELIMITED BY " ",
                      DISP_IDNO DELIMITED BY SIZE INTO WHERE-CLAUSE

      END-IF.

ENDBUILD-QUERY.
**
* Paragraph: EXEC-QUERY
*
*     Given a query buffer defining a WHERE clause, issue a
*     RETRIEVE to allow the runtime user to browse the employee
*     found with the given qualification.
**

EXEC-QUERY.

##    RANGE OF e IS employee

##    RETRIEVE (EIDNO = e.idno, ENAME = e.name, EAGE = e.age, 
##          EHIRED = e.hired, ESALARY = e.salary)
##          WHERE WHERE-CLAUSE
##    {

* Put values on to form and display them

##          PUTFORM #empform (
##                    idno = EIDNO, name = ENAME, age = EAGE,
##                    hired = EHIRED, salary = ESALARY)

##          REDISPLAY

##          SUBMENU
##          ACTIVATE MENUITEM "Next", FRSKEY4
##          {

* Do nothing, and continue with the RETRIEVE loop. The last 
* one will drop out.

##          }
##          ACTIVATE MENUITEM "Save", FRSKEY8
##          {
* Save screen data in log file

##                   PRINTSCREEN (FILE = "query.log")

* Drop through to next employee

##          }
##          ACTIVATE MENUITEM "End", FRSKEY3
##          {

* Terminate the RETRIEVE loop

##                   ENDRETRIEVE

##          }

##     }

##     INQUIRE_EQUEL (ROWS = ROWCOUNT)

       IF ROWS = 0 THEN

##              MESSAGE "No rows found for this query."

       ELSE

##              CLEAR FIELD ALL
##              MESSAGE "No more rows. Reset for next query."

       END-IF.
##     SLEEP 2

ENDEXEC-QUERY.