If Cobol code is an acceptable option the below program should do what you want.

It's rather easy to enhance it to split the input parm into multiple lines, 
say, using the "JPx" delimiters, just like in the SORT sample.

HTH,
-Victor-     

000100 IDENTIFICATION DIVISION.                                         
000200 PROGRAM-ID.  PARM2DD.                                            
000400******************************************************************
000500* COPY INPUT PARM='...' TO OUTPARM DD                             
000600******************************************************************
000700 ENVIRONMENT DIVISION.                                            
000800 CONFIGURATION SECTION.                                           
000900 INPUT-OUTPUT SECTION.                                            
001000 FILE-CONTROL.                                                    
001100     SELECT OUTPUT-FILE    ASSIGN TO OUTPARM.                     
001200 DATA DIVISION.                                                   
001300 FILE SECTION.                                                    
001400 FD  OUTPUT-FILE                                                  
001500     BLOCK CONTAINS 0 RECORDS                                     
001600     RECORDING MODE IS F.                                         
001700 01  OUTPUT-FILE-RECORD           PIC X(80).                      
001800                                                                  
001900 WORKING-STORAGE SECTION.                                         
002100******************************************************************
002200 LINKAGE SECTION.                                                 
002400 01  PARM-FROM-EXEC.                                              
002500     05  PARM-LENGTH              PIC S9(04) COMP.                
002600     05  PARM-VALUE.                                              
002700         10  PARM-VALUE-CHAR      PIC X OCCURS 80 TIMES           
002800                                        DEPENDING ON PARM-LENGTH. 
002900******************************************************************
003000 PROCEDURE DIVISION USING PARM-FROM-EXEC.                         
003100                                                                  
003200     OPEN OUTPUT OUTPUT-FILE.                                     
003300                                                                  
003400     MOVE PARM-VALUE               TO OUTPUT-FILE-RECORD.         
003500     DISPLAY OUTPUT-FILE-RECORD  UPON CONSOLE.                    
003600     WRITE   OUTPUT-FILE-RECORD.                                  
003700                                                                  
003800     CLOSE       OUTPUT-FILE.                                     
003900     GOBACK.                                                      


-------------------------------------------------------------------------------
Hello friends!
I have a teammate working on a z/OS 1.12 system and is trying to make a
proc fairly foolproof for his user. He wants to know the easiest way to
convert a SET statement or JCL Parm into a control card.

This proc needs a DSN and a couple other values as part of a SYSIN for the
program, and since we can't use symbolics in pre-z/OS 2.1, I would like a
way using standard IBM utilities to take a PARM symbolic and create an
output file that I can use as input to the program. The parm input would
only be one line, and not longer than 50 chars.

Does anyone have any good ideas? Sort? Gener?

Thank you and best regards,
*Billy Ashton*

----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions,
send email to lists...@listserv.ua.edu with the message: INFO IBM-MAIN

Reply via email to