IBM Mainframe Forum Index
 
Log In
 
IBM Mainframe Forum Index Mainframe: Search IBM Mainframe Forum: FAQ Register
 

Passing pack-data in CHAR format var to Cobol Stored proc


IBM Mainframe Forums -> COBOL Programming
Post new topic   Reply to topic
View previous topic :: View next topic  
Author Message
DS
Warnings : 1

New User


Joined: 09 Jun 2005
Posts: 25
Location: Bangalore

PostPosted: Fri Aug 15, 2014 9:29 am
Reply with quote

Hi,

I need to pass X(17) bytes data from a Native SQL stored procedure to a COBOL stored procedure to get back four individual fields.
Cobol stored proc not sending data properly in to COBOL program. Try to use NUMVAL function, it's not working, it will not. NUMVAL use is to
capture numeric data in X(NN) data type.

Scenario: Distributed system .Net application contains this Native SQL procedure, Native SQL procedure get TRAN_DATA CHAR(17) from a DB2 table and passing to DSP35 cobol stored proc from there it will get in to COBSP35 to parse / split it in to 4 individual fields as follows

IN-PARM PIC X(17)

OUT-FLD-1 PIC S9(05) COMP-3. -- 3 bytes
OUT-FLD-2 PIC X(02). -- 2 bytes
OUT-FLD-3 PIC S9(9)V99 COMP-3. -- 6 bytes
OUT-FLD-4 PIC S9(9)V99 COMP-3. -- 6 bytes


Definition: (DSP35 member)
----------------------------
Code:
--#SET TERMINATOR ?
  SET CURRENT SQLID='DB2DWTS1'?
  CREATE PROCEDURE WECDWTS1.COBSP35
    (IN  ESP_IN_TRAN_DATA            CHAR(17)

    , OUT  DISP_MESSAGE              CHAR(10)

    , OUT  ESP_OUT_JFMT_NO           DECIMAL(5,0)
    , OUT  ESP_OUT_BCD_USED  CHAR(2)
    , OUT  ESP_OUT_AMOUNT_ENTERED    DECIMAL(11,2)
    , OUT  ESP_OUT_AMT_POSTED        DECIMAL(11,2)
    )

    EXTERNAL NAME 'PSPTEST'
    LANGUAGE COBOL
    PARAMETER CCSID EBCDIC
    PARAMETER STYLE GENERAL
    DETERMINISTIC
    FENCED
    CALLED ON NULL INPUT
    NO SQL
    NO PACKAGE PATH
    NO DBINFO
    NO COLLID
    WLM ENVIRONMENT DB2DWAP1
    ASUTIME  NO LIMIT
    STAY RESIDENT NO
    PROGRAM TYPE MAIN
    SECURITY DB2
    DEFAULT SPECIAL REGISTERS
    STOP AFTER SYSTEM DEFAULT FAILURES
    COMMIT ON RETURN NO ?
--#SET TERMINATOR ;
--#SET TERMINATOR ;
  COMMIT;


COBOL program - COBSP35:
Code:
. . . .
. . . .

       01  WS-MISC-ITEMS.
           05  WS-IS-OK-TO-GO              PIC X(01)  VALUE 'Y'.
               88  WS-YES-TO-GO            VALUE  'Y'.
               88  WS-BAD-DATA             VALUE  'N'.

       01  WS-RECVD-PARM.
           03 WS-RECEIVD-INPUT             PIC X(17).
           03 WS-IN-4FIELDS-DATA   REDEFINES  WS-RECEIVD-INPUT.
              05 IN-102-JFMT-NO                PIC S9(05)     COMP-3.
              05 IN-102-BCD-USED               PIC X(02).
              05 IN-102-AMOUNT-ENTERED         PIC S9(09)V99  COMP-3.
              05 IN-102-AMT-POSTED             PIC S9(09)V99  COMP-3.

       01  WS-DATA-REC.
           05 WS-IN-JFMT-NO                PIC S9(05)     COMP-3.                 
           05 WS-IN-BCD-USED               PIC X(02).
           05 WS-IN-AMOUNT-ENTERED         PIC S9(09)V99  COMP-3.
           05 WS-IN-AMT-POSTED             PIC S9(09)V99  COMP-3.
. . . .
      ****       START OF LINKAGE SECTION     *****
       LINKAGE SECTION.
       01  IN-ESP-TRAN-DATA                PIC X(17).
      *
       01  OUT-ESP-MESSAGE                 PIC X(10).
       01  OUT-ESP-JFMT-NO                 PIC S9(05)       COMP-3.
       01  OUT-ESP-BCD-USED                PIC X(02).
       01  OUT-ESP-AMOUNT-ENTERED          PIC S9(09)V99    COMP-3.
       01  OUT-ESP-AMT-POSTED              PIC S9(09)V99    COMP-3.

      ****       END OF LINKAGE SECTION     *****

       PROCEDURE DIVISION USING
                             IN-ESP-TRAN-DATA
      *
                           , OUT-ESP-MESSAGE
      *
                           , OUT-ESP-JFMT-NO
                           , OUT-ESP-BCD-USED
                           , OUT-ESP-AMOUNT-ENTERED
                           , OUT-ESP-AMT-POSTED
                           .

       0000-MAINLINE.

           MOVE IN-ESP-TRAN-DATA    TO WS-RECEIVD-INPUT.

           MOVE WS-IN-4FIELDS-DATA  TO WS-DATA-REC.
           MOVE IN-102-JFMT-NO      TO WS-IN-JFMT-NO

           IF WS-IN-JFMT-NO  IS NUMERIC
               MOVE 'Y'             TO  WS-IS-OK-TO-GO
               MOVE 'GOOD-DATA'     TO  OUT-ESP-MESSAGE

           ELSE
               MOVE 'N'             TO  WS-IS-OK-TO-GO
               MOVE 'BAD-DATA'      TO  OUT-ESP-MESSAGE

           END-IF.


           IF ( WS-YES-TO-GO   AND
                ( WS-IN-JFMT-NO  =  102 ) )

              PERFORM 1000-SPLIT-DATA   THRU  1000-EXIT

           ELSE
              COMPUTE  OUT-ESP-JFMT-NO  =
                  FUNCTION NUMVAL (WS-RECEIVD-INPUT(1:3))

              MOVE ZERO                TO OUT-ESP-AMOUNT-ENTERED
                                          OUT-ESP-AMT-POSTED
              MOVE 'IV'                TO OUT-ESP-BCD-USED      <-- IN VALID

           END-IF.

           GOBACK.

       0000-EXIT.
           EXIT.

It is showing BAD-DATA, going to ELSE part and showing unreadable value in OUT-ESP-JFMT-NO. Requesting help to fix this.
If I type 102AA as input through console ADM panel, I can see 102 in OUT-ESP-JFMT-NO but that will not match to x'00102C' so entirely

unable to split.

- What could be the reason for not receiving data?
- How to pass right data (with proper data type) inside cobol program?
- Are we able to test this through DB2 ADM console to pass packed-data x'00102C' kind? (copy + paste)


Note: Earlier we wrote another COBOL stored proc exactly other(reverse) way, receive 4 fields from Native SP, to compress 4 fields into one CHAR field and send response back to Native SQL proc. Worked for packed single field of X(17) bytes perfectly.

Any clue / help and suggetions are much appreciated..


Thanks in advance & appreciate.
Back to top
View user's profile Send private message
DS
Warnings : 1

New User


Joined: 09 Jun 2005
Posts: 25
Location: Bangalore

PostPosted: Fri Aug 15, 2014 9:42 am
Reply with quote

Try to gave x'00102C' which shows 3 spaces (to eye) or similar data, got -310 DB2 error.
Rollback done
SQLCODE : -310 DSNTIAR CODE : 0

DSNT408I SQLCODE = -310, ERROR: DECIMAL HOST VARIABLE OR PARAMETER 003
CONTAINS NON-DECIMAL DATA
DSNT418I SQLSTATE = 22023 SQLSTATE RETURN CODE
DSNT415I SQLERRP = DSNXRGPL SQL PROCEDURE DETECTING ERROR
DSNT416I SQLERRD = -130 0 0 -1 0 0 SQL DIAGNOSTIC INFORMATION
DSNT416I SQLERRD = X'FFFFFF7E' X'00000000' X'00000000' X'FFFFFFFF'
X'00000000' X'00000000' SQL DIAGNOSTIC INFORMATION

Right Input Data: (Copy + Paste in to ADM console)
Code:

000077 A041° c       Ê*     AR13       Ê*C999111              A              *ìø 0   Ê*                 
000078                                 %                                                                 
****** ****************************************************** Bottom of Data ****************************

Some times storage overlap beyond specified length etc.

Not sure this is a right approach. Please correct me. Thanks in advance.


Code:

DB2 Admin ---------- DB2D Call Procedure Input Parameters ---- Row 1 to 1 of 1
Command ===>                                                  Scroll ===> PAGE
                                                                               
Commands:  CALL                                                               
                                                                               
Stored procedure . : DB2DWTS1.COBSP35                                         
Version  . . . . . : n/a                                                       
Invocations  . . . . 1     (number of times to call the procedure)             
Honor max rows . . . YES   (Yes or No to restrict the number of rows to fetch)
                                                                               
Line commands:                                                                 
<value> - Parameter value                                                     
                                                                               
Parameter value                  Parameter name     Type          Length  Scale
                                 *                  *                  *      *
-------------------------------> ------------------ -------- ----------- ------
102AA4324                          ESP_IN_TRAN_DAT CHAR              17      0
******************************* END OF DB2 DATA *******************************
Back to top
View user's profile Send private message
Bill Woodger

Moderator Emeritus


Joined: 09 Mar 2011
Posts: 7309
Location: Inside the Matrix

PostPosted: Fri Aug 15, 2014 1:04 pm
Reply with quote

Your program is a bit of a mess. What is the data when it gives you "bad"? DISPLAY WS-DATA-REC, and on the output SET HEX ON and paste the output here, please.
Back to top
View user's profile Send private message
Bill O'Boyle

CICS Moderator


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

PostPosted: Fri Aug 15, 2014 8:42 pm
Reply with quote

The NUMERIC check of the PIC X(17) parm will NEVER be true as the data is NOT Display-Numeric.

Why not increase the PIC X(17) to accommodate the 4 fields, each converted to Display-Numeriic?

Would it be easier to convert each field to Readable-Hex? IE: X'012C' (2-Bytes) converts to C'012C' (4-Bytes).

HTH....
Back to top
View user's profile Send private message
Rohit Umarjikar

Global Moderator


Joined: 21 Sep 2010
Posts: 3048
Location: NYC,USA

PostPosted: Fri Aug 15, 2014 8:45 pm
Reply with quote

I would look at either of the approach below.
1) Define them separately in the signature instead.
Code:
           
01 IN-102-JFMT-NO                    PIC S9(05)       COMP-3.
01 IN-102-BCD-USED                PIC X(02).
01 IN-102-AMOUNT-ENTERED     PIC S9(09)V99  COMP-3.
01 IN-102-AMT-POSTED             PIC S9(09)V99  COMP-3.

2) Or send the data in ESP_IN_TRAN_DATA delimited by pipe (or something) and then in you cobol SP do the unstring into above variables.
Back to top
View user's profile Send private message
DS
Warnings : 1

New User


Joined: 09 Jun 2005
Posts: 25
Location: Bangalore

PostPosted: Thu Aug 21, 2014 6:28 am
Reply with quote

Thanks moderators and Rohit.

In order to do SET HEX ON I've coded EXEC SQL .. SET .. END-EXEC but I couldn't able to display in HEX.

- Clues are much appreciated to get HEX ON data through other ways or some kind of rutines.

Code:

01  DISP-HEXED-TRAN-DATA        PIC  X(34).
....
....
MOVE IN-ESP-TRAN-DATA    TO WS-RECEIVD-DATA,

EXEC SQL
   SET :DISP-HEXED-TRAN-DATA  = HEX(:WS-RECEIVD-DATA)
END-EXEC.


However HEX(TRAN_DATA) is working in QMF/SPUFI. Not sure why it's not displating HERE IN THIS CONTEXT.


Alternately got the HEX data in side the program as follows.
Input: (3 characters passed as parm) - Data: écç (x'518348')
Code:


  ë écç   ë écç
0052584300525843
0037138C0037138C



It is taking as c (x'C3') instead of x'83' that;s where one problem. So DB2 ADM console can not be used.

Output from dump: Data received: écç (x'51C348') copy + paste not working as expected.

Code:

01 WS-IN-4FIELDS-DATA               
 02 WS-102-JFMT-NO                # S9(05)   COMP-3  X'51C348'
 02 WS-102-BCD-USED                 X(02)              SPACES 
 02 WS-102-AMOUNT-ENTERED         # S9(09)V99  COMP-3   
                                                       SPACES
 02 WS-102-AMT-POSTED             # S9(09)V99  COMP-3   
                                                       SPACES



Outcome:
- IS NUMERIC is working for packed decimal fields as expected, please correct me if not.. BTW, tested with sample code.
Can't able to use below kind of one..
IF WS-102-JFMT-NO > 0
This is leading to Soc7 abend.
- Working to convert each field to Readable-Hex, a better way to have control on processing.
- Declared all response variable at 01 level individuallt, this after receiving in single structure (signature) right.
- Can't able to insert delimiters (pipe or other) it's in distributed end, they would like t pass in single string.

Thanks again and appreciate.
Back to top
View user's profile Send private message
DS
Warnings : 1

New User


Joined: 09 Jun 2005
Posts: 25
Location: Bangalore

PostPosted: Thu Aug 21, 2014 6:34 am
Reply with quote

Sorry for the mess of code earlier and hard time. I forget to mention before and regret for typos. Thanks again.
Back to top
View user's profile Send private message
View previous topic :: :: View next topic  
Post new topic   Reply to topic View Bookmarks
All times are GMT + 6 Hours
Forum Index -> COBOL Programming

 


Similar Topics
Topic Forum Replies
No new posts Replace each space in cobol string wi... COBOL Programming 2
No new posts Populate last day of the Month in MMD... SYNCSORT 2
No new posts COBOL -Linkage Section-Case Sensitive COBOL Programming 1
No new posts SFTP Issue - destination file record ... All Other Mainframe Topics 2
No new posts Modifying Date Format Using DFSORT DFSORT/ICETOOL 9
Search our Forums:

Back to Top