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

packed decimal field value in table to file


IBM Mainframe Forums -> DB2
Post new topic   Reply to topic
View previous topic :: View next topic  
Author Message
sakrat

Active User


Joined: 05 Feb 2014
Posts: 164
Location: India

PostPosted: Thu Jun 25, 2015 12:22 pm
Reply with quote

Hi,
How can i fetch the packed decimal field value from table and write it in the ps file using REXX... using the SQL TYPE i found if the field is packed decimal and then i used the calculation (2n-1) to find the length of packed decimal ,then i used this resultant length to write the field in the file but what happens is the data is truncated to that length and its not in packed format in file like how we will get when unloaging the table using JCL.

Example field1 ---length specified in Table is DEC(11,0)
USING FORMULA found the length to be (11/2) + 05 = 6 and gave this much position to insert the field1 to the file. but now the data in that field is truncated rather than being packed format.

I why this hasnt worked out when we specify the position it is just like truncation.

But I want to know is there any way that we can the packed decimal format of value of a field in table to be written same to the file in packed format using REXX....

Got stuck with this problem....please help.....
Back to top
View user's profile Send private message
enrico-sorichetti

Superior Member


Joined: 14 Mar 2007
Posts: 10872
Location: italy

PostPosted: Thu Jun 25, 2015 12:27 pm
Reply with quote

see here how to pack

ibmmainframes.com/viewtopic.php?t=31547&postdays=0&postorder=asc&start=15


and here how to unpack

ibmmainframes.com/viewtopic.php?t=27921&highlight=rexx+pack+unpack
Back to top
View user's profile Send private message
sakrat

Active User


Joined: 05 Feb 2014
Posts: 164
Location: India

PostPosted: Thu Jun 25, 2015 12:44 pm
Reply with quote

enrico-sorichetti wrote:
see here how to pack

ibmmainframes.com/viewtopic.php?t=31547&postdays=0&postorder=asc&start=15


and here how to unpack

ibmmainframes.com/viewtopic.php?t=27921&highlight=rexx+pack+unpack



I tried your code like below :

Code:


PACKED = PACK(1234567890,10)
PACK: PROCEDURE
   PARSE ARG NUMB , LENG
   SIGN = LEFT(NUMB,1)
   IF    SIGN = "-"  THEN DO
      SIGN = "D"
      NUMB = SUBSTR(NUMB,2)
   END
   ELSE ,
   IF    SIGN = "+"  THEN DO
      SIGN = "C"
      NUMB = SUBSTR(NUMB,2)
       END
        ELSE ,
           SIGN = "C"
        SIZE = LENG * 2 - 1
        TEMP = RIGHT(NUMB,SIZE,"0") || SIGN
        PACK = X2C(TEMP)
        RETURN PACK


and I get trace output like below :

Code:


*-* PACKED = PACK(1234567890,10)
>L>   "1234567890"
>L>   "10"
*-*  PACK:
*-*  PROCEDURE
*-*  PARSE ARG NUMB , LENG
>>>    "1234567890"
>>>    "10"
*-*  SIGN = LEFT(NUMB,1)
>V>    "1234567890"
>L>    "1"
>F>    "1"
*-*  IF    SIGN = "-"
>V>    "1"
>L>    "-"
>O>    "0"
*-*  ELSE ,
*-*   IF    SIGN = "+"
>V>     "1"
>L>     "+"
>O>     "0"
*-*   ELSE ,
*-*    SIGN = "C"
>L>      "C"
*-*  SIZE = LENG * 2 - 1
>V>    "10"
>L>    "2"
>O>    "20"
>L>    "1"
>O>    "19"
*-*  TEMP = RIGHT(NUMB,SIZE,"0") || SIGN
 >V>    "1234567890"
 >V>    "19"
 >L>    "0"
 >F>    "0000000001234567890"
 >V>    "C"
 >O>    "0000000001234567890C"
 *-*  PACK = X2C(TEMP)
 >V>    "0000000001234567890C"
 >F>    "??????::i?"
 *-*  RETURN PACK
 >V>    "??????::i?"
 >F>   "??????::i?"
 *-* PACK:
 +++ PROCEDURE
IRX0017I Error running SAMPLE, line 23: Unexpected PROCEDURE



the number and the length meand the number to be packed and the original length of the number right....?
Back to top
View user's profile Send private message
sakrat

Active User


Joined: 05 Feb 2014
Posts: 164
Location: India

PostPosted: Thu Jun 25, 2015 12:52 pm
Reply with quote

whatever number i give i get only like below based on the length

Code:


???:??

Back to top
View user's profile Send private message
enrico-sorichetti

Superior Member


Joined: 14 Mar 2007
Posts: 10872
Location: italy

PostPosted: Thu Jun 25, 2015 12:57 pm
Reply with quote

the length for the PACK refer to the length of the PACKED format,
no need of the length for the UNPACK because the length is assumed from the variable

no need for the length for the CLEAR representation because
the numbers in rexx are represented as strings of digits in variable length
Back to top
View user's profile Send private message
enrico-sorichetti

Superior Member


Joined: 14 Mar 2007
Posts: 10872
Location: italy

PostPosted: Thu Jun 25, 2015 1:07 pm
Reply with quote

it is odd that
for somebody who wants to do some advanced rexx programming
You are not able to find out that PROCEDURES must be outside of the main instruction path

at least after an EXIT

the snippets I post are snippets and often they must be integrated in the proper places in a full Rexx scripts


anyway, since today I am n a very good mood, here is a TESTED FULL PROGRAM

Code:

#!  /usr/bin/rexx
Trace "O"
signal on novalue name novalue

do  i = 0 to 100 by 11
    say right(i,  4) c2x(pack(i,4))
    say right(-i, 4) c2x(pack(-i,4))
end

exit

/*  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*/
pack: procedure
    parse arg chars , lpackd
    sign = left(chars,1)
    if  sign = "-"  then do
        sign = "D"
        chars = substr(chars,2)
    end
    else ,
    if  sign = "+"  then do
        sign = "C"
        chars = substr(chars,2)
    end
    else ,
        sign = "C"

    packd = right(chars, lpackd * 2 - 1, "0") || sign

    return x2c(packd)

/*  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*/
unpack: procedure
    parse arg packd

    /* Convert packed data to hex and split */
    chars = c2x(packd)
    sign = right( chars, 1 )
    chars = left( chars, length(chars)-1 )

    /* Check sign and numeric sections */
    if  verify(sign, "ABCDEF" ) > 0 then ,
        return ""
    if  verify( numbr, "0123456789" ) > 0 then ,
        return ""

    /* Check negative sign */
    if  pos(sign, "BD" ) > 0 then,
        return -chars
    else ,
        return  chars

/*  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*/
logic_error:
say "**"copies(" -", 35)
say "**"
say "**" "Logic error at line '"sigl"' "
say "**"
say "**"copies(" -", 35)
exit

/*  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*/
novalue:
say "**"copies(" -", 35)
say "**"
say "**" "Novalue trapped, line '"sigl"' var '"condition("D")"' "
say "**"
say "**"copies(" -", 35)
exit




the result
[enrico@enrico-mbp mainframe_forums]$./pack.rx
Code:
   0 0000000C
   0 0000000C
  11 0000011C
 -11 0000011D
  22 0000022C
 -22 0000022D
  33 0000033C
 -33 0000033D
  44 0000044C
 -44 0000044D
  55 0000055C
 -55 0000055D
  66 0000066C
 -66 0000066D
  77 0000077C
 -77 0000077D
  88 0000088C
 -88 0000088D
  99 0000099C
 -99 0000099D
Back to top
View user's profile Send private message
Marso

REXX Moderator


Joined: 13 Mar 2006
Posts: 1353
Location: Israel

PostPosted: Thu Jun 25, 2015 1:08 pm
Reply with quote

sakrat wrote:
I tried your code like below :

Code:


PACKED = PACK(1234567890,10)
PACK: PROCEDURE
   PARSE ARG NUMB , LENG
   SIGN = LEFT(NUMB,1)
   IF    SIGN = "-"  THEN DO
      SIGN = "D"
      NUMB = SUBSTR(NUMB,2)
   END
   ELSE ,
   IF    SIGN = "+"  THEN DO
      SIGN = "C"
      NUMB = SUBSTR(NUMB,2)
       END
        ELSE ,
           SIGN = "C"
        SIZE = LENG * 2 - 1
        TEMP = RIGHT(NUMB,SIZE,"0") || SIGN
        PACK = X2C(TEMP)
        RETURN PACK
and I get trace output like below :
Code:
*-* PACKED = PACK(1234567890,10)
>L>   "1234567890"
>L>   "10"
*-*  PACK:
*-*  PROCEDURE
*-*  PARSE ARG NUMB , LENG
>>>    "1234567890"
>>>    "10"
...  .................
 *-*  PACK = X2C(TEMP)
 >V>    "0000000001234567890C"
 >F>    "??????::i?"
 *-*  RETURN PACK
 >V>    "??????::i?"
 >F>   "??????::i?"
 *-* PACK:
 +++ PROCEDURE
IRX0017I Error running SAMPLE, line 23: Unexpected PROCEDURE
Yes, and when you run this, you execute the 1st line and then the 2nd line...
The error is correct icon_smile.gif
Back to top
View user's profile Send private message
sakrat

Active User


Joined: 05 Feb 2014
Posts: 164
Location: India

PostPosted: Thu Jun 25, 2015 1:10 pm
Reply with quote

enrico-sorichetti wrote:
the length for the PACK refer to the length of the PACKED format,
no need of the length for the UNPACK because the length is assumed from the variable

no need for the length for the CLEAR representation because
the numbers in rexx are represented as strings of digits in variable length


I changed the length value to 4 here where original length is 6 and the packed value will be of 4. but still i get the same

Code:

PACKED = PACK(142003,4)
PACK: PROCEDURE
   PARSE ARG NUMB , LENG
   SIGN = LEFT(NUMB,1)
   IF    SIGN = "-"  THEN DO
      SIGN = "D"
      NUMB = SUBSTR(NUMB,2)
   END
   ELSE ,
   IF    SIGN = "+"  THEN DO
      SIGN = "C"
      NUMB = SUBSTR(NUMB,2)
     END
       ELSE ,
          SIGN = "C"
       SIZE = LENG * 2 - 1
       TEMP = RIGHT(NUMB,SIZE,"0") || SIGN
       PACK = X2C(TEMP)
       RETURN PACK


trace ouput:

Code:


*-* PACKED = PACK(142003,4)
>L>   "142003"
>L>   "4"
*-*  PACK:
*-*  PROCEDURE
*-*  PARSE ARG NUMB , LENG
>>>    "142003"
>>>    "4"
*-*  SIGN = LEFT(NUMB,1)
>V>    "142003"
>L>    "1"
>F>    "1"
*-*  IF    SIGN = "-"
>V>    "1"
>L>    "-"
>O>    "0"
*-*  ELSE ,
*-*   IF    SIGN = "+"
>V>     "1"
>L>     "+"
>O>     "0"
*-*   ELSE ,
*-*    SIGN = "C"
>L>      "C"
*-*  SIZE = LENG * 2 - 1
>V>    "4"
>L>    "2"
>O>    "8"
>L>    "1"
>O>    "7"
*-*  TEMP = RIGHT(NUMB,SIZE,"0") || SIGN
 >V>    "142003"
 >V>    "7"
 >L>    "0"
 >F>    "0142003"
 >V>    "C"
 >O>    "0142003C"
 *-*  PACK = X2C(TEMP)
 >V>    "0142003C"
 >F>    "?:??"
 *-*  RETURN PACK
 >V>    "?:??"
 >F>   "?:??"
 *-* PACK:
 +++ PROCEDURE
IRX0017I Error running SAMPLE, line 23: Unexpected PROCEDURE

Back to top
View user's profile Send private message
sakrat

Active User


Joined: 05 Feb 2014
Posts: 164
Location: India

PostPosted: Thu Jun 25, 2015 1:22 pm
Reply with quote

enrico-sorichetti wrote:
it is odd that
for somebody who wants to do some advanced rexx programming
You are not able to find out that PROCEDURES must be outside of the main instruction path

at least after an EXIT

the snippets I post are snippets and often they must be integrated in the proper places in a full Rexx scripts


anyway, since today I am n a very good mood, here is a TESTED FULL PROGRAM

Code:

#!  /usr/bin/rexx
Trace "O"
signal on novalue name novalue

do  i = 0 to 100 by 11
    say right(i,  4) c2x(pack(i,4))
    say right(-i, 4) c2x(pack(-i,4))
end

exit

/*  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*/
pack: procedure
    parse arg chars , lpackd
    sign = left(chars,1)
    if  sign = "-"  then do
        sign = "D"
        chars = substr(chars,2)
    end
    else ,
    if  sign = "+"  then do
        sign = "C"
        chars = substr(chars,2)
    end
    else ,
        sign = "C"

    packd = right(chars, lpackd * 2 - 1, "0") || sign

    return x2c(packd)

/*  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*/
unpack: procedure
    parse arg packd

    /* Convert packed data to hex and split */
    chars = c2x(packd)
    sign = right( chars, 1 )
    chars = left( chars, length(chars)-1 )

    /* Check sign and numeric sections */
    if  verify(sign, "ABCDEF" ) > 0 then ,
        return ""
    if  verify( numbr, "0123456789" ) > 0 then ,
        return ""

    /* Check negative sign */
    if  pos(sign, "BD" ) > 0 then,
        return -chars
    else ,
        return  chars

/*  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*/
logic_error:
say "**"copies(" -", 35)
say "**"
say "**" "Logic error at line '"sigl"' "
say "**"
say "**"copies(" -", 35)
exit

/*  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
*/
novalue:
say "**"copies(" -", 35)
say "**"
say "**" "Novalue trapped, line '"sigl"' var '"condition("D")"' "
say "**"
say "**"copies(" -", 35)
exit




the result
[enrico@enrico-mbp mainframe_forums]$./pack.rx
Code:
   0 0000000C
   0 0000000C
  11 0000011C
 -11 0000011D
  22 0000022C
 -22 0000022D
  33 0000033C
 -33 0000033D
  44 0000044C
 -44 0000044D
  55 0000055C
 -55 0000055D
  66 0000066C
 -66 0000066D
  77 0000077C
 -77 0000077D
  88 0000088C
 -88 0000088D
  99 0000099C
 -99 0000099D



Sorry my bad....
Gave EXIT before the procedure...no I am not getting any error but the number that are packed always returns same kind of value like below :

Code:


 "???:??"
Back to top
View user's profile Send private message
enrico-sorichetti

Superior Member


Joined: 14 Mar 2007
Posts: 10872
Location: italy

PostPosted: Thu Jun 25, 2015 1:29 pm
Reply with quote

did You care to read and TRY TO UNDERSTAND my last working script


packed number usually contain unprintable chars,
expanding the unprintable to their hex representation is what the c2x builtin function does.
Back to top
View user's profile Send private message
sakrat

Active User


Joined: 05 Feb 2014
Posts: 164
Location: India

PostPosted: Thu Jun 25, 2015 1:38 pm
Reply with quote

enrico-sorichetti wrote:
did You care to read and TRY TO UNDERSTAND my last working script


packed number usually contain unprintable chars,
expanding the unprintable to their hex representation is what the c2x builtin function does.


Yes i understood your code, my question was only (?) question mark was displayed for any numbers instead of any other symbols...that is why asked...I tried with different kinds of number ....I dint check it again by converting to C2X.tried that... Its working right now....

Thank you so much for you help.....
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 -> DB2

 


Similar Topics
Topic Forum Replies
No new posts How to split large record length file... DFSORT/ICETOOL 10
No new posts Extracting Variable decimal numbers f... DFSORT/ICETOOL 17
No new posts Load new table with Old unload - DB2 DB2 6
No new posts SFTP Issue - destination file record ... All Other Mainframe Topics 2
No new posts Access to non cataloged VSAM file JCL & VSAM 18
Search our Forums:

Back to Top