This program removes an exit program and deregisters an exit point from the registration facility.
IDENTIFICATION DIVISION.
***************************************************************
***************************************************************
*
* Program: Remove an Exit Program
* Deregister an Exit Point
*
* Language: OPM COBOL
*
* Description: This program removes an exit program and
* deregisters an exit point from the registration
* facility.
*
* APIs Used: QUSRMVEP - Remove Exit Program
* QUSDRGPT - Deregister Exit Point
*
***************************************************************
*
***************************************************************
PROGRAM-ID. REGFAC1.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. IBM-AS400.
OBJECT-COMPUTER. IBM-AS400.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT LISTING ASSIGN TO PRINTER-QPRINT
ORGANIZATION IS SEQUENTIAL.
DATA DIVISION.
FILE SECTION.
FD LISTING RECORD CONTAINS 132 CHARACTERS
LABEL RECORDS ARE STANDARD
DATA RECORD IS LIST-LINE.
01 LIST-LINE PIC X(132).
WORKING-STORAGE SECTION.
*
* Error Code parameter include. As this sample program
* uses COPY to include the error code structure, only the first
* 16 bytes of the error code structure are available. If the
* application program needs to access the variable length
* exception data for the error, the developer should physically
* copy the QSYSINC include and modify the copied include to
* define additional storage for the exception data.
*
COPY QUSEC OF QSYSINC-QLBLSRC.
*
* Error message text
*
01 BAD-EXIT-POINT.
05 TEXT1 PIC X(41)
VALUE "Attempt to deregister exit point failed: ".
05 EXCEPTION-ID PIC X(07).
01 BAD-EXIT-PGM.
05 TEXT1 PIC X(39)
VALUE "Attempt to remove exit program failed: ".
05 EXCEPTION-ID PIC X(07).
*
* Miscellaneous elements
*
01 MISC.
05 PGM-NBR PIC S9(09) VALUE 1 BINARY.
05 EXIT-POINT-NAME PIC X(20) VALUE "EXAMPLE_EXIT_POINT".
05 FORMAT-NAME PIC X(08) VALUE "EXMP0100".
*
* Beginning of mainline
*
PROCEDURE DIVISION.
MAIN-LINE.
*
* Remove an exit program from the exit point and then deregister
* the exit point. It is not necessary to remove exit programs
* from an exit point before deregistering the exit point. It is
* done here only for illustrative purposes.
*
* 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 OF QUS-EC.
*
* Call the API to remove the exit program.
*
CALL "QUSRMVEP" USING EXIT-POINT-NAME, FORMAT-NAME,
PGM-NBR, QUS-EC.
*
* If an exception occurs, the API returns the exception in the
* error code parameter. The bytes available field is set to
* zero if no exception occurs and greater than zero if an
* exception does occur.
*
IF BYTES-AVAILABLE OF QUS-EC > 0
OPEN OUTPUT LISTING,
MOVE EXCEPTION-ID OF QUS-EC
TO EXCEPTION-ID OF BAD-EXIT-POINT,
WRITE LIST-LINE FROM BAD-EXIT-POINT,
STOP RUN.
*
* If the call to remove the exit program is successful,
* deregister the exit point.
*
* Call the API to deregister the exit point.
*
CALL "QUSDRGPT" USING EXIT-POINT-NAME, FORMAT-NAME, QUS-EC.
*
* If an exception occurs, the API returns the exception in the
* error code parameter. The bytes available field is set to
* zero if no exception occurs and greater than zero if an
* exception does occur.
*
IF BYTES-AVAILABLE OF QUS-EC > 0
OPEN OUTPUT LISTING,
MOVE EXCEPTION-ID OF QUS-EC
TO EXCEPTION-ID OF BAD-EXIT-PGM,
WRITE LIST-LINE FROM BAD-EXIT-PGM,
STOP RUN.
*
STOP RUN.
*
* End of MAINLINE
*