Developing Compaq COBOL Programs
1.4 Program Run Messages
Example 1–5 (Cont.) Using RMS Special Registers to Detect Errors (OpenVMS)
REPORT SECTION.
RD
RPT
PAGE 26 LINES HEADING 1
FIRST DETAIL 5.
01
TYPE IS PAGE HEADING.
02
LINE IS PLUS 1.
03
COLUMN 1
PIC X(16)
VALUE "Employee File on".
03
COLUMN 18
PIC Z9/99/99 SOURCE D-DATE.
02
LINE IS PLUS 2.
03
COLUMN 2
PIC X(5)
VALUE "emp
".
03
COLUMN 22
PIC X(4)
VALUE "name".
03
COLUMN 42
PIC X(7)
VALUE "address".
03
COLUMN 70
PIC ZZ9
SOURCE PAGE-COUNTER.
01
REPORT-LINE
TYPE IS DETAIL.
02
LINE IS PLUS 1.
03
COLUMN IS 1 PIC 9(7)
SOURCE EMP-ID.
03
COLUMN IS 20 PIC X(15)
SOURCE IS EMP-NAME.
03
COLUMN IS 42 PIC X(30)
SOURCE IS EMP-ADDRESS.
PROCEDURE DIVISION.
DECLARATIVES.
USE-SECT SECTION.
USE AFTER STANDARD ERROR PROCEDURE ON EMP-FILE.
CHECK-RMS-SPECIAL-REGISTERS.
SET OP-FAILED TO TRUE.
EVALUATE RMS-STS OF EMP-FILE
TRUE
WHEN (END-OF-FILE)
OP-READ
SET VALID-OP TO TRUE
SET E-O-F TO TRUE
WHEN (BADNAME)
OP-OPEN
WHEN (FILE-NOT-FOUND)
OP-OPEN
WHEN (DIR-NOT-FOUND)
OP-OPEN
WHEN (INV-DEVICE)
OP-OPEN
DISPLAY
"File cannot be found or file spec is invalid"
DISPLAY RMS-FILENAME OF EMP-FILE
DISPLAY "Enter corrected file (cntrl-z to STOP RUN): "
WITH NO ADVANCING
ACCEPT VAL-OF-ID AT END STOP RUN END-ACCEPT
WHEN ANY
OP-CLOSE
CONTINUE
WHEN ANY
RMS-STS OF EMP-FILE IS SUCCESS
SET VALID-OP TO TRUE
WHEN OTHER
IF RMS-STV OF EMP-FILE NOT = ZERO
THEN
CALL "LIB$STOP" USING
BY VALUE RMS-STS OF EMP-FILE,
BY VALUE RMS-STV OF EMP-FILE
ELSE
CALL "LIB$STOP" USING
BY VALUE RMS-STS OF EMP-FILE
END-IF
END-EVALUATE.
END DECLARATIVES.
MAIN-PROG SECTION.
000-DRIVER.
PERFORM 100-INITIALIZE.
PERFORM WITH TEST AFTER UNTIL E-O-F
GENERATE REPORT-LINE
READ EMP-FILE
END-PERFORM
PERFORM 200-CLEANUP.
STOP RUN.
(continued on next page)
Developing Compaq COBOL Programs 1–57
