Compaq COBOL AAQ2G1FTK - Manual (Page 87)

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