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

Symbolic parameters in IF statements


IBM Mainframe Forums -> JCL & VSAM
Post new topic   Reply to topic
View previous topic :: View next topic  
Author Message
kris_chennai

New User


Joined: 19 Dec 2005
Posts: 7
Location: Chennai

PostPosted: Tue Dec 20, 2005 7:01 pm
Reply with quote

Hi,

I need a small help. The problem is

whenever the Symbolic parameter value is 'R' execute one segment of JCL else execute another segment of JCL

Ex:

// SET CHANNEL='R' can be L some times
//*
// IF &CHANNEL='R' THEN
// do..... process1
//.........
// ELSE
// do .... process2
//..............
// ENDIF.


But while doing JSCAN I am getting an error I believe that we can't do it in this way. Could you suggest me to do this?
Back to top
View user's profile Send private message
superk

Global Moderator


Joined: 26 Apr 2004
Posts: 4652
Location: Raleigh, NC, USA

PostPosted: Tue Dec 20, 2005 7:27 pm
Reply with quote

You need a program that accepts a parameter for the value of &CHANNEL and sets a Return-Code value appropriate for the value.

Here is an example:

Code:

       IDENTIFICATION DIVISION.                                 
       PROGRAM-ID. MYPROG.                                       
                                                                 
       ENVIRONMENT DIVISION.                                     
       INPUT-OUTPUT SECTION.                                     
                                                                 
       DATA DIVISION.                                           
       FILE SECTION.                                             
                                                                 
       WORKING-STORAGE SECTION.                                 
                                                                 
       LINKAGE SECTION.                                         
       01  PARM.                                                 
           03  PARM-LENGTH             PIC S9(04) COMP SYNC.     
           03  THE-PARM.                                         
               05  CHANNEL             PIC X(01).               
                                                                 
       PROCEDURE DIVISION USING PARM.                           
           DISPLAY THE-PARM.                                     
           IF CHANNEL = 'R' THEN MOVE 1 TO RETURN-CODE           
           ELSE IF CHANNEL = 'L' THEN MOVE 2 TO RETURN-CODE     
           ELSE MOVE 4 TO RETURN-CODE.   
           STOP RUN.                     


and the JCL:

Code:

//*                                             
// SET CHANNEL='L'                               
//*                                             
//STEP1    EXEC PGM=MYPROG,PARM='&CHANNEL'       
//STEPLIB  DD   DISP=SHR,DSN=...                 
//SYSOUT   DD   SYSOUT=*                         
//*                                             
// IF (STEP0001.RC = 1) THEN                     
//STEP2A   EXEC PGM=PROCESS1                     
// ENDIF                                         
// IF (STEP0001.RC = 2) THEN                     
//STEP2B   EXEC PGM=PROCESS2                     
// ENDIF                                         
//*                                             
Back to top
View user's profile Send private message
khamarutheen

Active Member


Joined: 23 Aug 2005
Posts: 677
Location: NJ

PostPosted: Tue Dec 20, 2005 7:33 pm
Reply with quote

Hi kris,

// SET CHANNEL='R'

Use
//SET1 SET CHANNEL='R'

Else use in this way
Code:

// SET LOC='O''''HARE'
//S1 EXEC PGM=IEFBR14,PARM='&LOC'


if error let me know what is the error.. it shows
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 -> JCL & VSAM

 


Similar Topics
Topic Forum Replies
No new posts Calling DFSORT from Cobol, using OUTF... DFSORT/ICETOOL 5
No new posts Passing Parameters to Programs Invoke... PL/I & Assembler 5
No new posts Injecting HTTPHEADER parameters in th... PL/I & Assembler 0
No new posts pass data as symbolic parameter from ... CLIST & REXX 2
No new posts Relate COBOL statements to EGL statement All Other Mainframe Topics 0
Search our Forums:

Back to Top