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

PREFIX ALL THE COPYBOOK VARIABLES


IBM Mainframe Forums -> CLIST & REXX
Post new topic   Reply to topic
View previous topic :: View next topic  
Author Message
MARINA JOSEPH

New User


Joined: 11 Jun 2009
Posts: 61
Location: chennai

PostPosted: Tue Oct 06, 2009 6:16 pm
Reply with quote

Hi,

I have a copybook structure as below:-

Code:
01 Employee.
     05 Empname           PIC X(05).
     05 DOB                   PIC 9(10).
     05 Location              PIC X(20).


I need to prefix 'MAS-' and create a copy of this copybook layout.
Assume i have a bigger layout then this needs to be automated.

Is there any command like 'CHANGE ALL' to do the same or is there any other option?
Back to top
View user's profile Send private message
prino

Senior Member


Joined: 07 Feb 2009
Posts: 1306
Location: Vilnius, Lithuania

PostPosted: Tue Oct 06, 2009 7:20 pm
Reply with quote

An edit macro.

Read every line, parse on level and following data and rewrite.

Not tested! icon_biggrin.gif
Back to top
View user's profile Send private message
MBabu

Active User


Joined: 03 Aug 2008
Posts: 400
Location: Mumbai

PostPosted: Wed Oct 07, 2009 7:34 am
Reply with quote

for this example (but not necessarily all examples)
Code:
 C " 01 " " 01 MAS-" ALL
 C " 05 " " 05 MAS-" ALL

An edit macro is the best option though.
Back to top
View user's profile Send private message
MARINA JOSEPH

New User


Joined: 11 Jun 2009
Posts: 61
Location: chennai

PostPosted: Wed Oct 07, 2009 10:09 am
Reply with quote

Thanks for your replies.

Robert,

How do you REWRITE in REXX?
Is there any specific command for that.

Thanks.
Back to top
View user's profile Send private message
prino

Senior Member


Joined: 07 Feb 2009
Posts: 1306
Location: Vilnius, Lithuania

PostPosted: Wed Oct 07, 2009 10:41 am
Reply with quote

Edit macro:

"isredit line" n "= (LINE)"

REXX:

EXECIO DISKRU + EXECIO DISKW
Back to top
View user's profile Send private message
MARINA JOSEPH

New User


Joined: 11 Jun 2009
Posts: 61
Location: chennai

PostPosted: Wed Oct 07, 2009 2:33 pm
Reply with quote

Code:
IF SYSDSN("'"FILEIN"'") = 'OK' THEN                   
DO                                                   
   "ALLOC DSN('G68462.BCPPOLFC')DDN(INDSET)SHR REUSE"
   "EXECIO * DISKRU INDSET(STEM REC.)"               
    IF REC.0 > 0 THEN                                 
    DO I = 1 TO REC.0                                 
       PARSE VAR REC.I WITH 7 COL7 +1 STRING 73       
       IF COL7 = '*' | COL7 = '-' | COL7 = '/' THEN   
          NOP                                         
       ELSE                                           
       DO                                             
          POS_WORD = FIND(STRING,'PIC')               
          IF POS_WORD <> 0 THEN                       
          DO
                        PARSE VAR REC.I D1 D2 D3                 
         FSTRING.J = WORD(STRING,POS_WORD-1) */   
         T = D2                                   
         T = INSERT('MAS-',T)                     
         D2 =  T                                 
         "EXECIO * DISKW INDSET(STEM REC.)"       
         END                                     
      END                                         
   END                                           
END                                                                         
Back to top
View user's profile Send private message
MARINA JOSEPH

New User


Joined: 11 Jun 2009
Posts: 61
Location: chennai

PostPosted: Wed Oct 07, 2009 2:36 pm
Reply with quote

Sorry i missed the explanation in the code posted.

I am getting the error Record cannot be updated as no record can be read.

I am trying to read the copybook and replace all the variable names in the copy book for which i have used the INSERT command.

Thanks.
Back to top
View user's profile Send private message
prino

Senior Member


Joined: 07 Feb 2009
Posts: 1306
Location: Vilnius, Lithuania

PostPosted: Wed Oct 07, 2009 2:50 pm
Reply with quote

DISKRU should read only one record, which must be written out by DISKWR.
Back to top
View user's profile Send private message
MARINA JOSEPH

New User


Joined: 11 Jun 2009
Posts: 61
Location: chennai

PostPosted: Wed Oct 07, 2009 4:02 pm
Reply with quote

Could you please elaborate on that point.

The records are being read into a stem variable, REC holds each of the records.
So what is the issue with that?
Back to top
View user's profile Send private message
expat

Global Moderator


Joined: 14 Mar 2007
Posts: 8797
Location: Welsh Wales

PostPosted: Wed Oct 07, 2009 4:05 pm
Reply with quote

You have read the data into a stem variable and then try to update lines in the dataset. Two completely different strategies for updating here, and they do not tend to mix well, if at all.

Either read into a stem and process the stem, or read one record at a time using EXECIO, and then write it back when processed.

Basically, I would prefer to create a new dataset / member rather than in place updates, it tends to preserve data integrity.
Back to top
View user's profile Send private message
MARINA JOSEPH

New User


Joined: 11 Jun 2009
Posts: 61
Location: chennai

PostPosted: Thu Oct 08, 2009 5:58 pm
Reply with quote

Code:
IF SYSDSN("'"FILEIN"'") = 'OK' THEN                     
DO                                                       
   "ALLOC DSN('G68462.BCPPOLFC')DDN(INDSET)SHR REUSE"   
                                                         
   "EXECIO * DISKR INDSET(STEM REC.)"                   
                                                         
   IF REC.0 > 0 THEN                                     
    DO I = 1 TO REC.0                                   
       "EXECIO * DISKRU INDSET(STEM REC.I)"             
       PARSE VAR REC.I WITH 7 COL7 +1 STRING 73         
       IF COL7 = '*' | COL7 = '-' | COL7 = '/' THEN     
          NOP                                           
       ELSE                                             
       DO                                             
       POS_WORD = FIND(STRING,'PIC')               
       IF POS_WORD <> 0 THEN                       
       DO                                           
         PARSE VAR REC.I D1 D2 D3                   
          T = WORD(STRING,POS_WORD-1)               
          T = INSERT('MAS-',T)                     
          D3 =  T                                   
          "EXECIO * DISKW INDSET(STEM REC.I)"       
          END                                       
       END                                         
    END                                             
 END                                               



I have done the prefix for the variables but it is not getting written back on the file. I have executed the code in TRACE mode and it runs fine.
Could somebody please help on this?

Thanks.
Back to top
View user's profile Send private message
prino

Senior Member


Joined: 07 Feb 2009
Posts: 1306
Location: Vilnius, Lithuania

PostPosted: Thu Oct 08, 2009 6:37 pm
Reply with quote

A snippet of working code,

Code:
"alloc f(xmi) da("xlib.i"."friday".xmit) reu"

"execio 10 diskr xmi (stem inrec. finis"

/*
* Data can span multiple records
*/
s = ''
do r = 1 to inrec.0 until pos('INMR03', inrec.r) \= 0
  s = s !! inrec.r
end

/*
* Some processing...
*/

do q = 1 to r
  "execio 1 diskru xmi" q
  pull zap /* discard record just read */

  out = substr(s, 1 + 80 * (q - 1), 80)

  push out  /* updated record */
  "execio 1 diskw xmi"
end             
                                       
"free f(xmi)"
Back to top
View user's profile Send private message
expat

Global Moderator


Joined: 14 Mar 2007
Posts: 8797
Location: Welsh Wales

PostPosted: Thu Oct 08, 2009 7:10 pm
Reply with quote

Quote:
I have done the prefix for the variables but it is not getting written back on the file. I have executed the code in TRACE mode and it runs fine.
Could somebody please help on this?

If you look at your code, you read in REC.I update variables outside of REC.I and then write REC.I back out. Just because you parse a record into variables it doesn't mean that when you change one of those variables the whole shebang changes with it.

You need to update the stem variable and then you can write it out correctly
Code:

/* REXX *** REPLACE WORD WITHIN A STEM VARIABLE                      */
A.1 = "        03 VARDDTRX               COMP   PIC S9(04)."           
A.2 = "        03 VARXBNET               COMP-3 PIC S9(12)V9(03)."     
A.3 = "        03 VARPRNET               COMP-3 PIC S9(12)V9(03)."     
A.4 = "        03 VARETXXX               COMP-3 PIC S9(12)V9(03)."     
A.5 = "        03 VARRUTXX               COMP-3 PIC S9(12)V9(03)."     
A.0 = 5                                                               
                                                                       
DO AA = 1 TO A.0                                                       
  IF POS(' PIC ',A.AA) > 0                                       
     THEN A.AA = OVERLAY("XYZ+"||WORD(A.AA,2),A.AA,POS(WORD(A.AA,2),A.AA))
END                                                                   
                                                                       
DO A = 1 TO A.0                                                       
  SAY A.A                                                             
END                                                                   
Back to top
View user's profile Send private message
MARINA JOSEPH

New User


Joined: 11 Jun 2009
Posts: 61
Location: chennai

PostPosted: Fri Oct 09, 2009 10:19 am
Reply with quote

Thanks for all your replies.


WHAT DOES S= S!! INREC.R mean? Is it for concatenation?

Also what does PULL ZAP indicate?
Back to top
View user's profile Send private message
prino

Senior Member


Joined: 07 Feb 2009
Posts: 1306
Location: Vilnius, Lithuania

PostPosted: Fri Oct 09, 2009 10:45 am
Reply with quote

MARINA JOSEPH wrote:
WHAT DOES S= S!! INREC.R mean? Is it for concatenation?

Also what does PULL ZAP indicate?


Yes, '!!' is concatenation for me. 'Pull zap' is the same as 'pull fluf' or 'pull porkies', I just clear the record I read onto the stack with the previous execio.
Back to top
View user's profile Send private message
MARINA JOSEPH

New User


Joined: 11 Jun 2009
Posts: 61
Location: chennai

PostPosted: Fri Oct 09, 2009 10:50 am
Reply with quote

Code:
S = ' '                                                 

 IF SYSDSN("'"FILEIN"'") = 'OK' THEN                     

 DO                                                     

    "ALLOC DSN('NEW.BCPPOLFC')DDN(INDSET)SHR REUSE"   

                                                         

    "EXECIO * DISKR INDSET(STEM REC.FINIS"               

                                                         

    IF REC.0 > 0 THEN                                   

     DO I = 1 TO REC.0 UNTIL POS('PIC',REC.I \=0)       

        S = S || REC.I                                   

     END

                                               

    DO                             

       Q = 1  TO I                 

       "EXECIO 1 DISKRU INDSET"   

        PULL ZAP                   

        OUT = INSERT('MAS-',S)     

        PUSH OUT                   

        "EXECIO 1 DISKW INDSET"   

     END                           

                                   

     "FREE F(INDSET)"             

 END                               


I still get the following error
IRX0503E An attempt was made to 'WRITE' to file INDSET which is opened, but not

for output. 'WRITE' is not allowed.

IRX0670E EXECIO error while trying to GET or PUT a record.

IKJ56861I FILE INDSET NOT FREED, DATA SET IS OPEN.
Back to top
View user's profile Send private message
expat

Global Moderator


Joined: 14 Mar 2007
Posts: 8797
Location: Welsh Wales

PostPosted: Fri Oct 09, 2009 11:27 am
Reply with quote

Yes, the dataset would be open. You have not closed it.
When you have finished with the dataset, use
Code:

"EXECIO 0 DISW INDSET ( FINIS"
"FREE  FI(INDSET)"
Back to top
View user's profile Send private message
MARINA JOSEPH

New User


Joined: 11 Jun 2009
Posts: 61
Location: chennai

PostPosted: Fri Oct 09, 2009 11:34 am
Reply with quote

Thanks. one error is resolved.

The other still persists.
IRX0503E An attempt was made to 'WRITE' to file INDSET which is opened, but not

for output. 'WRITE' is not allowed.

IRX0670E EXECIO error while trying to GET or PUT a record.
Back to top
View user's profile Send private message
prino

Senior Member


Joined: 07 Feb 2009
Posts: 1306
Location: Vilnius, Lithuania

PostPosted: Fri Oct 09, 2009 11:45 am
Reply with quote

My working code was just a demo of how to use EXECIO to REWRITE data. It is NOT suitable for your change-every-line requirements... Sigh...
Back to top
View user's profile Send private message
MARINA JOSEPH

New User


Joined: 11 Jun 2009
Posts: 61
Location: chennai

PostPosted: Wed Oct 14, 2009 5:34 pm
Reply with quote

Hi,

I am trying to prefix 'S-' to the variables in a copybook and modify it.

For eg:-
Code:
001200         10  ACT-POLICY-NUMBER                PIC 9(9) COMP-3.



Code:
DO                           
  "EXECIO 1 DISKRU INDSET "R
  PULL REC.R                 
  OUT = REC.R               
  PARSE VAR OUT D1 D2 D3     
  SAY D1                     
  SAY D2                     
  D3 = INSERT('S-',D3)       
  SAY D3                     
  OUT = D1||T||D2||T||D3     
  PUSH OUT                   
  "EXECIO 1 DISKW INDSET "   
END                         




I ran it in TRACE mode and i find that while parsing D3 appears as " ACT-POLICY-NUMBER". Its taking a space along with it while parsing.

This is what i get after running the code.

Code:
001200  10  S- ACT-POLICY-NUMBER                PIC 9(9) COMP-3.


Can somebody please tell how to remove the space before prefixing?
Back to top
View user's profile Send private message
MARINA JOSEPH

New User


Joined: 11 Jun 2009
Posts: 61
Location: chennai

PostPosted: Wed Oct 14, 2009 5:53 pm
Reply with quote

I got the command. STRIP can be used.

Thanks.
Back to top
View user's profile Send private message
Marso

REXX Moderator


Joined: 13 Mar 2006
Posts: 1353
Location: Israel

PostPosted: Thu Oct 15, 2009 2:57 am
Reply with quote

From all the code snippets I see, I guess that you have given up using a macro.
Is that right ?
Back to top
View user's profile Send private message
expat

Global Moderator


Joined: 14 Mar 2007
Posts: 8797
Location: Welsh Wales

PostPosted: Thu Oct 15, 2009 11:25 am
Reply with quote

Did you look at the example I posted on the previous page.
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 -> CLIST & REXX

 


Similar Topics
Topic Forum Replies
No new posts Substring number between 2 characters... DFSORT/ICETOOL 2
No new posts REXX code to expand copybook in a cob... CLIST & REXX 2
No new posts Trying to change copybook in online c... CICS 4
No new posts Help to Filter File Manager Copybook ... DFSORT/ICETOOL 14
No new posts JCL with variables JCL & VSAM 1
Search our Forums:

Back to Top