Portal | Manuals | References | Downloads | Info | Programs | JCLs | Master the Mainframes
IBM Mainframe Computers Forums Index
 
Register
 
IBM Mainframe Computers Forums Index Mainframe: Search IBM Mainframe Forum: FAQ Memberlist Usergroups Profile Log in to check your private messages Log in
 

 

Translating Eibresp codes

 
Post new topic   Reply to topic    IBMMAINFRAMES.com Support Forums -> CICS
View previous topic :: :: View next topic  
Author Message
Antonio Barata
Warnings : 1

New User


Joined: 04 Apr 2007
Posts: 37
Location: Lisbon, Portugal

PostPosted: Thu Jun 19, 2008 11:52 pm    Post subject: Translating Eibresp codes
Reply with quote

Hello
Is there anyway of obtaining the description of Eibresp values, other than having an internal table and performing a search on it?

Thanks

António Barata
Back to top
View user's profile Send private message

Earl Haigh

Active User


Joined: 25 Jul 2006
Posts: 475

PostPosted: Fri Jun 20, 2008 12:13 am    Post subject:
Reply with quote

NO
Back to top
View user's profile Send private message
Bill O'Boyle

CICS Moderator


Joined: 14 Jan 2008
Posts: 2502
Location: Atlanta, Georgia, USA

PostPosted: Fri Jun 20, 2008 12:53 am    Post subject:
Reply with quote

Here's an Assembler sub-program (KIKSDESC, my own creation) which returns the description of a particular EIBRESP. It uses the CICS In-Core program "DFHEITAB" to find this description. Comments in the program-source should suffice for usage. Converting this to a HLL should not pose a major challenge.

Code:

*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             
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               
         L     R9,24(,R9)              RE-CALCULATE STARTING-ADDRESS   
         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             
         B     FIRSTEYE                CONTINUE LOOP                   
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?       
         BZ    NODSCRPT                NO, DESCRIPTION NOT FOUND       
         BM    NODSCRPT                SAME                             
         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'                   
         
Back to top
View user's profile Send private message
dbzTHEdinosauer

Global Moderator


Joined: 20 Oct 2006
Posts: 6968
Location: porcelain throne

PostPosted: Fri Jun 20, 2008 10:45 am    Post subject:
Reply with quote

Thx Bill,

stolen and implemented.
Back to top
View user's profile Send private message
Antonio Barata
Warnings : 1

New User


Joined: 04 Apr 2007
Posts: 37
Location: Lisbon, Portugal

PostPosted: Fri Jun 20, 2008 1:25 pm    Post subject:
Reply with quote

Hi
Thanks Bill
If you don't mind, same as dbzTHEdinosauer

António
Back to top
View user's profile Send private message
View previous topic :: :: View next topic  
Post new topic   Reply to topic    IBMMAINFRAMES.com Support Forums -> CICS All times are GMT + 6 Hours
Page 1 of 1

 

Search our Forum:

Similar Topics
Topic Author Forum Replies Posted
No new posts Translating Quotes Khadhar Basha CLIST & REXX 6 Tue May 09, 2017 11:52 am
No new posts EIBRESP 13 on Alternate Index amitc23 CICS 7 Wed Feb 18, 2015 6:33 pm
No new posts How do I get the Response from EIBRESP Robert.Barnes COBOL Programming 1 Sat Oct 25, 2014 9:21 am
No new posts eibresp = 16 and eibresp2 = 28. abhishek chhawcharia CICS 1 Fri Apr 25, 2014 9:37 pm
No new posts CICS eibresp 22 while reading VSAM Fi... abhishek chhawcharia CICS 18 Tue Apr 22, 2014 1:38 am


Facebook
Back to Top
 
Mainframe Wiki | Forum Rules | Bookmarks | Subscriptions | FAQ | Tutorials | Contact Us