1 CBL-EXCEPTION-ID PIC X(7).
1 VALID-RESPONSES PIC X(6).
1 PGM-IN-ERROR.
5 PGM-NAME PIC X(1).
5 LIB-NAME PIC X(1).
1 SYS-EXCEPTION-ID PIC X(7).
1 MESSAGE-TEXT PIC X(1).
1 MESSAGE-LENGTH PIC S9(9) BINARY.
1 SYS-OPTION PIC X(1).
1 ERR-MODULE-NAME PIC X(1).
1 CBL-PGM-NAME PIC X(256).
ᑍ
ᑍ Beginning of mainline
ᑍ
PROCEDURE DIVISION USING CBL-EXCEPTION-ID,
VALID-RESPONSES,
PGM-IN-ERROR,
SYS-EXCEPTION-ID,
MESSAGE-LENGTH,
SYS-OPTION,
MESSAGE-TEXT,
ERR-MODULE-NAME,
CBL-PGM-NAME.
MAIN-LINE.
ᑍ
ᑍ Initialize the error code parameter. To signal exceptions to
ᑍ this program by the API, you need to set the bytes provided
ᑍ field of the error code to zero. Because this program has
ᑍ exceptions sent back through the error code parameter, it sets
ᑍ the bytes provided field to the number of bytes it gives the
ᑍ API for the parameter.
ᑍ
MOVE 16 TO BYTES-PROVIDED.
ᑍ
ᑍ Record the COBOL Program and Library names
ᑍ
MOVE 11 TO KEY-FIELD OF QPD-SUSPECTED-PROGRAM.
MOVE 1 TO PROGRAM-NAME-LENGTH OF QPD-SUSPECTED-PROGRAM.
MOVE 1 TO LIBRARY-NAME-LENGTH OF QPD-SUSPECTED-PROGRAM.
SET PROGRAM-NAME OF QPD-SUSPECTED-PROGRAM 2
TO ADDRESS OF PGM-NAME OF PGM-IN-ERROR.
SET LIBRARY-NAME OF QPD-SUSPECTED-PROGRAM
TO ADDRESS OF LIB-NAME OF PGM-IN-ERROR.
ADD 1 TO NBR-OF-RECORDS.
SET PROBLEM-POINTER (NBR-OF-RECORDS) TO
ADDRESS OF QPD-SUSPECTED-PROGRAM.
ᑍ
ᑍ Record the message id
ᑍ
MOVE 2 TO KEY-FIELD OF QPD-SYMPTOM.
MOVE 3 TO KEYWORD-LENGTH OF QPD-SYMPTOM.
MOVE 7 TO DATA-LENGTH OF QPD-SYMPTOM.
MOVE "C" TO DATA-TYPE OF QPD-SYMPTOM.
SET KEYWORD OF QPD-SYMPTOM TO ADDRESS OF MSG-KEYWORD.
SET DATA-FIELD OF QPD-SYMPTOM TO ADDRESS OF SYS-EXCEPTION-ID.
ADD 1 TO NBR-OF-RECORDS.
SET PROBLEM-POINTER (NBR-OF-RECORDS) TO
ADDRESS OF QPD-SYMPTOM.
Appendix B. Original Examples in Additional Languages B-125