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.