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