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

Split values in COMP-3 thru SORT


IBM Mainframe Forums -> DFSORT/ICETOOL
Post new topic   Reply to topic
View previous topic :: View next topic  
Author Message
balaji81_k

Active User


Joined: 29 Jun 2005
Posts: 155

PostPosted: Tue Jan 06, 2015 6:26 am
Reply with quote

Hi ,

I am trying to split the value stored in comp-3 (WS-AB)(6 DIGITS) to another field which is also declared as comp-3(WS-B)
Here is my record structure.


Code:

01  REC.
   02  FILLER PIC  X(41)
   02  WS-AB  PIC  9(6) COMP-3 value 029999
   02  FILLER PIC  X(31)
   02  WS-B   PIC  9(7) COMP-3.
   02  FILLER PIC  X(8).

//STEP01W  EXEC PGM=SORT
//SORTIN   DD DSN=A.B.C,DISP=SHR
//SORTOUT  DD DSN=A.BC.SORTED,
//             DISP=(NEW,CATLG,DELETE),DCB=(RECFM=FB,LRECL=88,BLKSIZE=0),
//             SPACE=(CYL,(10,10),RLSE)
//SORTWK04 DD DISP=(NEW,DELETE,DELETE),SPACE=(CYL,(10,50)),
//            UNIT=SYSDA
//SORTWK05 DD DISP=(NEW,DELETE,DELETE),SPACE=(CYL,(10,50)),
//            UNIT=SYSDA
//SORTWK06 DD DISP=(NEW,DELETE,DELETE),SPACE=(CYL,(10,50)),
//            UNIT=SYSDA
//SYSIN    DD *
      SORT FIELDS=COPY
      OUTREC OVERLAY=(77:42,4,PD,TO=ZD,LENGTH=4)
//SYSPRINT DD SYSOUT=*
//SYSOUT DD SYSOUT=*


i am trying to MOVE last 4 digits from WS-AB to WS-B .I tried the above code , it works to see the value in FILE-AID only
when i changed the declaration from COMP-3 to numeric in record structure for the field (WS-B) (i,e) PIC 9(4).
can any one help me to see the same value without changing declaration?
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: Tue Jan 06, 2015 1:28 pm
Reply with quote

The most-used way would probably be to multiply by 10 and then divide by 10. The first truncates the leading digit, the second corrects the scale of the field.

Here's a way without mathematics:

Code:
  INREC OVERLAY=(77:42,4,PD,TO=ZD,LENGTH=4,
                 77:77,4,ZD,TO=PD,LENGTH=4)


This works in-place because the length of the packed field is the same as the number of digits required, otherwise it would need to extend the record this way, and the calculation may turn out better (it would have to be tested, and depend on FB vs VB, lengths, size of file, which way the prevailing wind blows at your site, etc).
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 -> DFSORT/ICETOOL

 


Similar Topics
Topic Forum Replies
No new posts How to split large record length file... DFSORT/ICETOOL 10
No new posts INCLUDE OMIT COND for Multiple values... DFSORT/ICETOOL 5
No new posts Replace Multiple Field values to Othe... DFSORT/ICETOOL 12
No new posts JCL sort card - get first day and las... JCL & VSAM 9
No new posts Sort First/last record of a subset th... DFSORT/ICETOOL 7
Search our Forums:

Back to Top