IBM Mainframe Forum

by **lucapuntom** » Fri Jan 30, 2015 4:58 pm

Hi there...

Is there an IBM module that, given the area dfheiblk, provides the descriptions of the errors?
I thought of something that makes, for CICS instructions, what makes the DSNTIAR for SQL statements passing the SQLCA...

Thanks

Luca

by **Mickeydusaor** » Fri Jan 30, 2015 8:04 pm

CMAC

by **lucapuntom** » Fri Jan 30, 2015 8:48 pm

I don't think I can use CMAC via CALL from a CICS program, like I do with DSNTIAR (or DSNTIAC).
Or am I wrong?

What I'm looking for is a module callable from a CICS source, if exists, to whom I'd pass the dfheiblk and I'd obtain the description of the error received in RESP and in RESP2.

Thank you

by **Mickeydusaor** » Fri Jan 30, 2015 9:52 pm

This source is from Bill O'Boyle posted on the other IBM help board

Select all

*PROCESS RENT PROGRAM IS RE-ENTRANT
*ASM XOPTS(NOEPILOG) SUPPRESS EPILOGUE
***********************************************************************
*---------------------------------------------------------------------*
* *
* THIS SUB-PROGRAM WILL RETURN THE DESCRIPTION ASSOCIATED WITH *
* A PARTICULAR EIBRESP VALUE AS WELL AS THE EIBFN AND EIBRCODE *
* IN READABLE-HEX FORMAT (EXTRACTED FROM COMMAREA-DFHEIBLK). *
* *
* EXAMPLE COMMAREA - *
* *
* 03 WS-KIKSDESC-COMMAREA. *
* 05 WS-KIKSDESC-RESP-CODE *
* PIC 9(05). *
* 05 WS-KIKSDESC-DFHEIBLK *
* PIC X(85). *
* 05 WS-KIKSDESC-EIBFN PIC X(04). *
* 05 WS-KIKSDESC-EIBRCODE *
* PIC X(12). *
* 05 WS-KIKSDESC-DESCRIPTION-LGTH *
* PIC 9(02). *
* 05 WS-KIKSDESC-DESCRIPTION *
* PIC X(12). *
* 03 WS-KIKSDESC PIC X(08) VALUE 'KIKSDESC'. *
* *
* MOVE EIBRESP TO WS-KIKSDESC-RESP-CODE. *
* MOVE DFHEIBLK TO WS-KIKSDESC-DFHEIBLK. *
* *
* EXEC CICS LINK *
* PROGRAM (WS-KIKSDESC) *
* COMMAREA(WS-KIKSDESC-COMMAREA) *
* LENGTH (LENGTH OF WS-KIKSDESC-COMMAREA) *
* END-EXEC. *
* *
* UPON RETURN, 'WS-KIKSDESC-DESCRIPTION' WILL CONTAIN THE *
* DECRIPTION-TEXT ASSOCIATED WITH THE PASSED 'EIBRESP'. ALSO, *
* 'WS-KIKSDESC-DESCRIPTION-LGTH' WILL CONTAIN THE ACTUAL *
* LENGTH OF THE DESCRIPTION. FOR EXAMPLE, THE 'EIBRESP' VALUE *
* THAT WAS PASSED WAS 19 AND ITS ASSOCIATED DESCRIPTION WILL *
* BE 'NOTOPEN'. THE DESCRIPTION-LGTH WILL EQUAL 07. *
* *
* THE RETURN-CODE IS RETURNED IN R15 TO THE CALLER, OTHERWISE *
* KNOWN AS THE RETURN-CODE SPECIAL-REGISTER FOR COBOL-CALLERS. *
* *
*---------------------------------------------------------------------*
***********************************************************************
PRINT GEN ACTIVATE MACRO-EXPANSION
COMDSECT DSECT COMMAREA DSECT (R7)
USING *,R7 INFORM ASSEMBLER
COMMAREA EQU * BEGIN COMMAREA
COMMRSPC DS CL5 RESPONSE-CODE (DISPLAY-NUMERIC)
COMMAEIB DS CL(EIBLENG) CALLER'S DFHEIBLK
COMMFCTN DS CL(L'EIBFN*2) CALLER'S 'EIBFN' (READABLE HEX)
COMMRCDE DS CL(L'EIBRCODE*2) CALLER'S 'EIBRCODE' (SAME)
COMMDLEN DS CL2 DESCRIPTN-LGTH (DISPLAY-NUMERIC)
COMMDESC DS CL(L'EIBRCODE*2) DESCRIPTN-TEXT
COMMLGTH EQU *-COMMAREA COMMAREA-LGTH
TBLDSECT DSECT DFHEITAB DSECT (R9)
USING *,R9 INFORM ASSEMBLER
TBLENTRY EQU * BEGIN ENTRY
TBLDESC DS CL(L'COMMDESC) ASSOCIATED-DESCRIPTION
TBLEYECT DS XL2 EYECATCHER (X'50C0')
DS XL4 NOT USED
TBLRSPCD DS XL2 RESPONSE-CODE (UNALIGNED HWORD)
DS XL2 NOT USED
TBLLGTH EQU *-TBLENTRY LENGTH OF TBL-DSECT
DFHEISTG DSECT DYNAMIC-STG DSECT (R13)
DWORD DS D DOUBLEWORD WORK-AREA
SANITYMX DS F SANITY-MAX FWORD
RETNCODE DS H RETURN-CODE HWORD
RESPCODE DS XL2 RESPONSE-CODE FROM CALLER
WORKDESC DS CL(L'COMMDESC+1) DESCRIPTION-WORKAREA
UNPKAREA DS CL16 MULTI-USE UNPACK-AREA
HEXAREA DS CL(L'COMMFCTN+L'COMMRCDE)
TRANSTBL DS XL256 DYNAMIC TRANSLATE-TBL
KIKSDESC DFHEIENT CODEREG=R3,DATAREG=R13,EIBREG=R11
LA R14,4095 PREPARE FOR 'STH'
STH R14,RETNCODE STORE IN HWORD
LH R14,EIBCALEN LOAD COMMAREA-LGTH
CHI R14,COMMLGTH MINIMUM-LGTH?
BL CICSRETN NO, RETURN TO CALLER
XC DFHEIUSR(L'TRANSTBL),DFHEIUSR
XC DFHEIUSR+L'TRANSTBL((DFHEIEND-DFHEIUSR)-L'TRANSTBL),DFHEX
IUSR+L'TRANSTBL
L R7,DFHEICAP COMMAREA ADDRESSABILITY
LA R14,L'COMMDESC PREPARE FOR 'CVD'
CVD R14,DWORD MAKE IT DECIMAL
OI DWORD+L'DWORD-1,X'0F' ENSURE 'F' SIGN-NIBBLE
UNPK COMMDLEN,DWORD UNPACK MAXIMUM-LGTH
PACK DWORD,COMMRSPC COMMAREA RESPONSE-CODE
OI DWORD+L'DWORD-1,X'0F' ENSURE 'F' SIGN-NIBBLE
CVB R14,DWORD MAKE IT BINARY
STCM R14,B'0011',RESPCODE STORE AS UNALIGNED-HWORD
LA R14,COMMAEIB POINT TO COMMAREA-DFHEIBLK
UNPK UNPKAREA(L'COMMFCTN+1),EIBFN-DFHEIBLK(L'EIBFN+1,R14)
MVC HEXAREA(L'COMMFCTN),UNPKAREA
UNPK UNPKAREA(L'COMMRCDE+1),EIBRCODE-DFHEIBLK(L'EIBRCODE+1,R1X
4)
MVC HEXAREA+L'COMMFCTN(L'COMMRCDE),UNPKAREA
TR HEXAREA,=CL16'0123456789ABCDEF'-240
MVC COMMFCTN,HEXAREA POPULATE AS READABLE-HEX
MVC COMMRCDE,HEXAREA+L'COMMFCTN
MVI WORKDESC,C' ' ENSURE ALL SPACES
MVC WORKDESC+1(L'WORKDESC-1),WORKDESC
MVC COMMDESC,WORKDESC SAME
OC RESPCODE,RESPCODE NON-ZERO RESPONSE-CODE?
BNZ LOADPGM YES, LOAD PROGRAM
MVC COMMDESC(L'EIBRCODE),=C'NORMAL'
B CALCLGTH CALCULATE DESCRIPTION-LGTH
LOADPGM EQU *
*
EXEC CICS LOAD NOHANDLE, ESTABLISH ADDRESSABILITY TO THE X
PROGRAM('DFHEITAB'), CICS IN-CORE TABLE X
SET (R9),
*
ICM R15,B'1111',EIBRESP TABLE LOAD OK?
STH R15,RETNCODE STORE IN HWORD
BNZ BADLOAD NO, BAD TABLE LOAD
LM R14,R15,24(R9) PREPARE FOR 'MHI' (HURSLEY CODE)
MHI R15,TBLLGTH CALCULATE 'SANITY-MAX'
L R9,24(,R9) RE-CALCULATE STARTING-ADDRESS
LA R1,0(R14,R15) COMPLETE SANITY-MAX
ST R1,SANITYMX STORE IN FWORD
B FIRSTEYE FIND FIRST 'EYECATCHER'
BADLOAD EQU *
MVC COMMDESC,=C'@TBLDERR000@'
CVD R15,DWORD MAKE IT DECIMAL
OI DWORD+L'DWORD-1,X'0F' ENSURE 'F' SIGN-NIBBLE
UNPK COMMDESC+8(3),DWORD UNPACK 'EIBRESP' FROM LOAD
B CICSRETN RETURN TO CALLER
FIRSTEYE EQU *
CLC =X'50C0',TBLENTRY FIRST EYECATCHER FOUND?
BNE BUMP4EYE NO, CHECK 'NEXT' BYTE
AHI R9,-L'TBLDESC REPOSITION AT ENTRY-START
B SRCHDESC BEGIN DESCRIPTION-SEARCH
BUMP4EYE EQU *
LA R9,1(,R9) BUMP TO 'NEXT' BYTE
CL R9,SANITYMX EXCEEDS 'SANITY-MAX'?
BNH FIRSTEYE NO, CONTINUE LOOP
B NORESPCD RESPONSE-CODE NOT FOUND
SRCHDESC EQU *
CLC =X'50C0',TBLEYECT ANY MORE ENTRIES?
BNE NORESPCD NO, RESPONSE-CODE NOT FOUND
CLC RESPCODE,TBLRSPCD RESPONSE-CODES MATCH?
BNE BUMPDESC NO, CHECK 'NEXT' ENTRY
MVC COMMDESC,TBLDESC POPULATE DESCRIPTION
B CALCLGTH CALCULATE DESCRIPTION-LGTH
BUMPDESC EQU *
LA R9,TBLLGTH(,R9) BUMP TO 'NEXT' TBL-ENTRY
B SRCHDESC KEEP SEARCHING
NORESPCD EQU *
MVI RETNCODE+L'RETNCODE-1,X'08'
MVC COMMDESC,=C'@@NORESPCD@@'
B CICSRETN RETURN TO CALLER
CALCLGTH EQU *
MVI TRANSTBL+64,X'FF' SET SPACE-SLOT TO X'FF'
MVC WORKDESC(L'COMMDESC),COMMDESC
TRT WORKDESC,TRANSTBL FIND FIRST-SPACE
LA R2,WORKDESC POINT TO STARTING-ADDRESS
SR R1,R2 NON-ZERO DESCRIPTION-LGTH?
BNP NODSCRPT NO, DESCRIPTION NOT FOUND
CVD R1,DWORD MAKE IT DECIMAL
OI DWORD+L'DWORD-1,X'0F' ENSURE 'F' SIGN-NIBBLE
UNPK COMMDLEN,DWORD UNPACK INTO COMMAREA
MVI RETNCODE+L'RETNCODE-1,X'00'
B CICSRETN RETURN TO CALLER
NODSCRPT EQU *
MVI RETNCODE+L'RETNCODE-1,X'08'
MVC COMMDESC,=C'@NODESCRPTN@'
CICSRETN EQU *
LH R15,RETNCODE LOAD RETURN-CODE
*
DFHEIRET RCREG=R15 RETURN TO CALLER
*
DFHREGS , CICS REGISTER-MACRO
*
LTORG ,
*
KIKSDESC AMODE 31 ,
KIKSDESC RMODE ANY ,
*
END , END 'KIKSDESC'

by **lucapuntom** » Fri Jan 30, 2015 10:35 pm

In our shop we use Cobol, not Assembler... We have not even the assembler compiler! So i cannot even call this module of mr. Bill O'Boyle.
I'm not an assembler programmer, but I saw that the module you proposed, uses the DFHEITAB program.
I'll try to find some info about it: I promise I will be more accurate from the start about my need, next time...

Thank you very much.

Luca

by **Stefan** » Fri Feb 13, 2015 2:56 pm

Here is a COBOL solution by MARTIN TRUBNER posted at http://bit.listserv.vse-l.narkive.com/B ... or-eibresp

Select all

01 DFHEITAB.
05 PIC X(24).
05 EIBTAB-PNTR POINTER.
05 EIBTAB-MAX PIC S9(5) BINARY.
01 EIBTAB.
05 OCCURS 1000.
10 EIBTAB-TEXT PIC X(12).
10 PIC XX.
88 EIBTAB-OKAY VALUE X'50C0'.
10 PIC XXXX.
10 EIBTAB-RESP PIC S9(4) BINARY.
10 PIC XX.

EXEC CICS LOAD PROGRAM('DFHEITAB')
SET(ADDRESS OF DFHEITAB)
END-EXEC

SET ADDRESS OF EIBTAB TO EIBTAB-PNTR
PERFORM VARYING INDX FROM 1 BY 1
UNTIL INDX > EIBTAB-MAX
OR ( EIBTAB-OKAY (INDX) AND
RESP-L = EIBTAB-RESP (INDX))
END-PERFORM
IF EIBTAB-OKAY (INDX) THEN
STRING ' EXEC LINK RESPONSE IS: '
EIBTAB-TEXT (INDX) DELIMITED BY SIZE
INTO CFK-LINE (3)
END-IF

by **lucapuntom** » Mon Feb 16, 2015 4:59 pm

Thank you, Stefan...

I'll try it as soon as possible

Luca

IBM Mainframe Forum

IBM Routine for description of CICS errors

IBM Routine for description of CICS errors

Re: IBM Routine for description of CICS errors

Re: IBM Routine for description of CICS errors

Re: IBM Routine for description of CICS errors

Re: IBM Routine for description of CICS errors

Re: IBM Routine for description of CICS errors

Re: IBM Routine for description of CICS errors