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.
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.
A complete description of the rules that govern the execution of embedded procedures can be found in Book 3, Chapter 5, section 5.9.6, "PROCEDURE Clause." Rules covering the use of event procedures, a variant of embedded procedures, are also found in this discussion of the PROCEDURE clause.