Using Screen Section Embedded Procedures

The following example shows how to use embedded procedures to provide an automatic look-up function plus field validation on a key field. In this example, an ellipsis in braces indicates omitted code.

IDENTIFICATION DIVISION.
PROGRAM-ID. SCREEN-EXAMPLE.
REMARKS.
This program shows how to use embedded procedures 
in the Screen Section to: 
(a) show a field-specific legend when the user
    arrives at that field, 
(b) perform validation of a key field and, 
(c) perform a look-up procedure when a special
    function key is pressed.  
In this example, a customer-number field is included
in an order-entry screen.  When the user enters a
customer number, the program validates that it's an
existing customer and, if so, displays the customer's
name.  If it's not valid, the user must re-enter the
field.  If the user presses the F1 key, a look-up
procedure locates the desired customer. 
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SPECIAL-NAMES.
   CRT STATUS IS CRT-STATUS
   SCREEN CONTROL IS SCREEN-CONTROL.

INPUT-OUTPUT SECTION.
FILE-CONTROL.
   { . . . }


DATA DIVISION.
FILE SECTION.
   { . . . }


WORKING-STORAGE SECTION.
01  CRT-STATUS            PIC 9(3).
      88  F1-KEY            VALUE 1.
 

01  SCREEN-CONTROL.
    03  ACCEPT-CONTROL    PIC 9.
      88  GOTO-FIELD      VALUE 1.
    03  CONTROL-VALUE     PIC 999.
    03  CONTROL-HANDLE    HANDLE.
    03  CONTROL-ID        PIC XX COMP-X.

{ . . . }

SCREEN SECTION.
01  ORDER-SCREEN.
  { . . . }
  03  "Cust #: ".
  03  USING CUSTOMER-NO 
      BEFORE PROCEDURE IS SHOW-CUST-LEGEND 
      AFTER PROCEDURE IS TEST-CUSTOMER 
      EXCEPTION PROCEDURE IS CHECK-FOR-LOOKUP.
  03  SHOW-CUSTOMER-NAME, PIC X(30) FROM 
      CUSTOMER-NAME, COLUMN + 3.
  { . . . }

PROCEDURE DIVISION.
MAIN-LOGIC.
   { . . . }
   DISPLAY ORDER-SCREEN.
   ACCEPT ORDER-SCREEN 
      ON EXCEPTION CONTINUE
      NOT ON EXCEPTION WRITE ORDER-RECORD
   END-ACCEPT.
   { . . . }
   STOP RUN.

* SHOW-CUST-LEGEND executes whenever the user
* arrives at the customer number field.  It 
* displays a legend. This legend is removed by
* both the AFTER and EXCEPTION procedures
* associated with the customer-number field.

SHOW-CUST-LEGEND.
   DISPLAY "F1 = Customer Lookup", LINE 24,
   ERASE TO END OF LINE.

* TEST-CUSTOMER checks for a valid customer number
* entry by reading the customer file. If it finds a
* customer record, it displays the customer's name.  
* If it does not find a record, it forces the user 
* to re-enter the field by setting the SCREEN-
* CONTROL condition, GOTO-FIELD, to TRUE.  Since 
* the ACCEPT statement initializes CONTROL-VALUE to 
* the field number of the customer number field, 
* setting GOTO-FIELD to TRUE will cause the ACCEPT 
* statement to return to the customer-number field.

TEST-CUSTOMER.
   DISPLAY SPACES, LINE 24, ERASE TO END OF LINE.
   READ CUSTOMER-FILE RECORD
      INVALID KEY
         DISPLAY "CUSTOMER NOT ON FILE - PRESS RETURN", 
         LINE 24, BOLD
         ACCEPT OMITTED
         SET GOTO-FIELD TO TRUE

      NOT INVALID KEY
         DISPLAY SHOW-CUSTOMER-NAME.

* CHECK-FOR-LOOKUP executes when the user types a
* function key when in the customer-number field. 
* It erases the legend and then checks to see if 
* Function Key 1 was pressed.  If it was, it 
* executes a look-up procedure.  If the procedure 
* returns with a valid customer selected, it 
* displays the customer's name and causes control 
* to pass to the next field. Otherwise, it forces 
* the user to re-enter the customer-number field. 
* It does this by setting GOTO-FIELD to TRUE while 
* leaving CONTROL-VALUE unchanged.  

CHECK-FOR-LOOKUP.
   DISPLAY SPACES, LINE 24, ERASE TO END OF LINE.
   IF F1-KEY
      PERFORM CUSTOMER-LOOKUP-PROCEDURE
      IF HAVE-CUSTOMER-NUMBER
         DISPLAY SHOW-CUSTOMER-NAME
         ADD 1 TO CONTROL-VALUE
   END-IF
   SET GOTO-FIELD TO TRUE.