IBM SC33-1683-02 - Manual (Page 441)

DFHEISTG DSECT ,
*
* Insert your own storage definitions here
*
DFHPCOM TYPE=DSECT
***********************************************************************
* * * * * P R O G R A M E R R O R * * * * *
* * * * * P R O G R A M * * * * *
***********************************************************************
DFHPEP CSECT PROGRAM ERROR PROGRAM CSECT
DFHPEP RMODE ANY
DFHREGS , EQUATE REGISTERS
XR R1,R1
ICM R1,B'0011',EIBCALEN Get Commarea length
BZ RETURNX ...no Commarea; exit
EXEC CICS ADDRESS COMMAREA(R2) ,
USING DFHPEP_COMMAREA,R2
*
* Insert your own code here
*
LA R1,PEP_COM_RETURN_OK
B RETURN
DFHEJECT
*
RETURNER DS 0H Return for error cases
LA R1,PEP_COM_RETURN_DISABLE
RETURN DS 0H
ST R1,PEP_COM_RETURN_CODE
RETURNX DS 0H
EXEC CICS RETURN ,
END DFHPEP
Figure 14. Source code of the default program error program (DFHPEP)
DFHPEP_COMMAREA DSECT
*
* Standard header section
*
PEP_COM_STANDARD DS 0F
PEP_COM_FUNCTION DS CL1 Always '1'
PEP_COM_COMPONENT DS CL2 Always 'PC'
PEP_COM_RESERVED DS C Reserved
*
* Abend codes and EIB
*
PEP_COM_CURRENT_ABEND_CODE DS CL4 Current abend code
PEP_COM_ORIGINAL_ABEND_CODE DS CL4 Original abend code
PEP_COM_USERS_EIB DS CL(EIBRLDBK-EIBTIME+L'EIBRLDBK)
* EIB at last EXEC CICS command
Figure 15. Source of DFHPEP communication area (assembler-language) (Part 1 of 2)
the program error program
Chapter 6. Writing a program error program 409