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

How can I pass parms from JCL to an IMS batch program?


IBM Mainframe Forums -> IMS DB/DC
Post new topic   Reply to topic
View previous topic :: View next topic  
Author Message
Douglas Wilder

Active User


Joined: 28 Nov 2006
Posts: 305
Location: Deerfield IL

PostPosted: Thu Jan 31, 2008 5:09 am
Reply with quote

How can I pass parms from JCL to an IMS batch program?

I saw JCL like this on this forum:
Code:
//IMSEXEC PROC MBR=TEMPNAME,PSB=,BUF=8,                           
//             SPIE=0,TEST=0,EXCPVR=0,RST=0,                       
//             PRLD=,SRCH=0,CKPTID=,MON=N,LOGA=0,                 
//             FMTO=T,IMSID=,SWAP=,RGN=1536K,DBRC=N,IRLM=,IRLMNM=,
//             BKO=N,IOB=,SSM=,APARM=                             
//***************************************************             
//STEP20  EXEC PGM=DFSRRC00,REGION=&RGN,                           
//             PARM=(DLI,&MBR,&PSB,&BUF,                           
//             &SPIE&TEST&EXCPVR&RST,&PRLD,                       
//             &SRCH,&CKPTID,&MON,&LOGA,&FMTO,                     
//             &IMSID,&SWAP,&DBRC,&IRLM,&IRLMNM,                   
//             &BKO,&IOB,&SSM,&APARM)                             
//        PEND                                                     
//STEP00  EXEC PROC=IMSEXEC,MBR=IMSPARM,PSB=TESTPSB,APARM=TESTPARM
//

I made the COBOL program like this:
Code:
LINKAGE SECTION.                                           
                                                           
01  PCB1.                                             
    05  PCB1-DBDNAME                PIC X(08).             
    05  PCB1-LEVEL-NUM              PIC X(02).             
    05  PCB1-STATUS-CODE            PIC X(02).             
    05  PCB1-PROC-OPTIONS           PIC X(04).             
    05  PCB1-FILLER                 PIC S9(5) COMP.         
    05  PCB1-SEG-NAME               PIC X(08).             
    05  PCB1-KEY-LNGTH              PIC S9(5) COMP.         
    05  PCB1-NUM-SEGS               PIC S9(5) COMP.         
                                                           
01  PARM-DATA-1.                                           
    05  PARM-LENGTH-1               PIC S9(4) COMP.         
    05  PARM-1.                                             
        10  FILLER                  PIC X(1)               
            OCCURS 1 TO 80 TIMES DEPENDING ON PARM-LENGTH-1.
01  PARM-DATA-2.                                           
    05  PARM-LENGTH-2               PIC S9(4) COMP.         
    05  PARM-2.                                             
        10  FILLER                  PIC X(1)               
            OCCURS 1 TO 80 TIMES DEPENDING ON PARM-LENGTH-2.

PROCEDURE DIVISION.                   
                                     
    ENTRY 'DLITCBL' USING PCB1   
                          PARM-DATA-1
                          PARM-DATA-2.

    DISPLAY 'PARM-1  ='   PARM-1 '='.
    DISPLAY 'PARM-2  ='   PARM-2 '='.
    ...

My results looked like this:
Code:
********************************* TOP OF DATA **********************************
                                                                               
                                                                               
 ------------------------------------------------------------------------------
PARM-1  =          =                                                           
DCDD6F44700003E00007444444444444444444444444444444444444444444444444444444444444
71940100E0001010000E000000000000000000000000000000000000000000000000000000000000
 ------------------------------------------------------------------------------
PARM-2  =          =                                                           
DCDD6F44700003E00007444444444444444444444444444444444444444444444444444444444444
71940200E0001010000E000000000000000000000000000000000000000000000000000000000000
 ------------------------------------------------------------------------------
******************************** BOTTOM OF DATA ********************************


Does anyone see what I am doing wrong?
Back to top
View user's profile Send private message
Bitneuker

CICS Moderator


Joined: 07 Nov 2005
Posts: 1104
Location: The Netherlands at Hole 19

PostPosted: Thu Jan 31, 2008 5:31 pm
Reply with quote

The parameters belong to IMS (DFSRRC00). Via the MBR (in your case) you tell DFSRRC00 which program is to be executed. The only parameters you define in your linkage section are the PCB's. This needs to be done to be able to interact with IMS. IMS needs the PCB's in your DLI-call in order to know which database is to be accessed and returning the results to your program. For detailes about the parameters follow the first link in the sticky where to find info about IMS (is also the first link in my signature).
Back to top
View user's profile Send private message
Douglas Wilder

Active User


Joined: 28 Nov 2006
Posts: 305
Location: Deerfield IL

PostPosted: Thu Jan 31, 2008 11:21 pm
Reply with quote

I do not doubt that a description of the parms is there somewhere, but having spent another 2 hours looking around the links in that link I still have not found them.
The DFSRRC00 parms I am looking at are parm 20 '&APARM', parm 27 '&PARM1' & 'parm 28 &PARM2' (parm numbers as I saw them on another WEB site. Will any of these parms allow me to pass my parms from the JCL to my COBOL program? A description of these 3 parms or more specific directions of where to find a description of the DFSRRC00 parms would also be helpful.
Back to top
View user's profile Send private message
Bitneuker

CICS Moderator


Joined: 07 Nov 2005
Posts: 1104
Location: The Netherlands at Hole 19

PostPosted: Fri Feb 01, 2008 12:34 am
Reply with quote

Quote:
APARM=
Specifies the 1 to 32-character parameter that is passed to the application program as part of the information returned in the INQY call with the ENVIRON subfunction. The parameter must be enclosed in single-quotes (') if special characters are used. Embedded commas (,) are not allowed.


As for PARM1 and PARM2 follow this

For the rest look at it this way:
You execute a program with a number of parameters: let's say a, b and c. This would be input to the mainprogram. Then within your mainprogram you call another program which needs parameter d. Since your mainprogram has it's own parameter logic you can't pass additoinal parameters for your subsequently called program. It's the same with IMS. You pass parameters to DFSRRC00 (IMS) in order to tell how to behave. DFSRC00 has no ability to pass additional information to programs called by it.

You may like it or not but if you have to work on IMS you've got to live with it.
Back to top
View user's profile Send private message
Douglas Wilder

Active User


Joined: 28 Nov 2006
Posts: 305
Location: Deerfield IL

PostPosted: Fri Feb 08, 2008 4:23 am
Reply with quote

This will retrieve the Parm passed from the JCL into your COBOL Program.

The JCL above is ok, but I got the COBOL program to work as follows:
Code:
     05  INQY-FUNC           PIC X(4)  VALUE 'INQY'.

 01  INQY-IO-AREA.
     05  INQY-ENVIRON-DATA       PIC X(100) VALUE SPACES.
     05  INQY-LEN-RECOVERY-SEC   PIC S9(04) VALUE 16 COMP.
     05  INQY-RECOVERY-SECTION   PIC X(016) VALUE SPACES.
     05  INQY-LEN-APARM          PIC S9(04) VALUE 32 COMP.
     05  INQY-APARM              PIC X(032) VALUE SPACES.

 01  INQY-ENVIRON.
     05  INQY-IMS-ID             PIC X(08) VALUE SPACES.
     05  INQY-IMS-RELEASE        PIC X(04) VALUE SPACES.
     05  INQY-IMS-CNTRL-TYPE     PIC X(08) VALUE SPACES.
     05  INQY-IMS-APP-REG-TYPE   PIC X(08) VALUE SPACES.
     05  INQY-IMS-REGION-ID      PIC X(04) VALUE SPACES.
     05  INQY-APPLIC-PRGM-NAME   PIC X(08) VALUE SPACES.
     05  INQY-PSB-NAME           PIC X(08) VALUE SPACES.
     05  INQY-TRAN-NAME          PIC X(08) VALUE SPACES.
     05  INQY-USER-ID            PIC X(08) VALUE SPACES.
     05  INQY-GROUP-NAME         PIC X(08) VALUE SPACES.
     05  INQY-STATUS-GRP-IND     PIC X(04) VALUE SPACES.
     05  INQY-ADDR-REC-TOKEN     PIC X(04) VALUE SPACES.
     05  INQY-ADDR-APPLIC-PARM   PIC X(04) VALUE SPACES.
     05  INQY-SHR-QUEUE-IND      PIC X(04) VALUE SPACES.
     05  INQY-USR-ID-ADDR-SP     PIC X(08) VALUE SPACES.
     05  INQY-USR-ID-IND         PIC X(01) VALUE SPACES.
     05  INQY-RRS-IND            PIC X(03) VALUE SPACES.

 01  AIB.
     02 AIBRID             PIC X(8) VALUE 'DFSAIB  '.
     02 AIBRLEN            PIC 9(9) USAGE BINARY VALUE 264.
     02 AIBRSFUNC          PIC X(8) VALUE 'ENVIRON '.
     02 AIBRSNM1           PIC X(8) VALUE 'IOPCB   '.
     02 AIBRSNM2           PIC X(8) VALUE SPACES.
     02 AIBRESV1           PIC X(8).
     02 AIBOALEN           PIC 9(9) USAGE BINARY VALUE 152.
     02 AIBOAUSE           PIC 9(9) USAGE BINARY.
     02 AIBRESV2           PIC X(12).
     02 AIBRETRN           PIC 9(9) USAGE BINARY.
     02 AIBREASN           PIC 9(9) USAGE BINARY.
     02 AIBERRXT           PIC 9(9) USAGE BINARY.
     02 AIBRESA1           USAGE POINTER.
     02 AIBRESA2           USAGE POINTER.
     02 AIBRESA3           USAGE POINTER.
     02 AIBRESV4           PIC X(40).
     02 AIBRSAVE     OCCURS 18 TIMES USAGE POINTER.
     02 AIBRTOKN     OCCURS 6 TIMES  USAGE POINTER.
     02 AIBRTOKC           PIC X(16).
     02 AIBRTOKV           PIC X(16).
     02 AIBRTOKA     OCCURS 2 TIMES PIC 9(9) USAGE BINARY.

/
 LINKAGE SECTION.

 ++INCLUDE IOPCB2

 01  PCB-MAPTR.
     05  MAPTR-DBDNAME               PIC X(08).
     05  MAPTR-LEVEL-NUM             PIC X(02).
     05  MAPTR-STATUS-CODE           PIC X(02).
     05  MAPTR-PROC-OPTIONS          PIC X(04).
     05  MAPTR-FILLER                PIC S9(5) COMP.
     05  MAPTR-SEG-NAME              PIC X(08).
     05  MAPTR-KEY-LNGTH             PIC S9(5) COMP.
     05  MAPTR-NUM-SEGS              PIC S9(5) COMP.
/
 PROCEDURE DIVISION.

     ENTRY 'DLITCBL' USING IO-PCB PCB-MAPTR.

     CALL 'AIBTDLI' USING INQY-FUNC AIB INQY-IO-AREA.


     EVALUATE IO-PCB-STATUS-CODE
     WHEN SPACES
         DISPLAY 'PARM-LEN  =' INQY-LEN-APARM '='
         DISPLAY     ' PARM =' INQY-APARM     '='

         MOVE INQY-ENVIRON-DATA TO INQY-ENVIRON

         DISPLAY 'INQY-IO-AR=' INQY-IO-AREA   '='
         DISPLAY 'INQY-ENV  =' INQY-ENVIRON   '='
         DISPLAY 'AIB  =' AIB       '='
         DISPLAY 'PCB  =' PCB-MAPTR '='
     WHEN OTHER
         DISPLAY 'ERROR ON GET IMS PARM INQY '
                 ' STATUS CODE=' IO-PCB-STATUS-CODE
                 ' PCB=' IO-PCB
         MOVE +16                TO WS-PC-RETURN-CODE
         PERFORM 9000-SHUT-DOWN              THRU 9000-EXIT
     END-EVALUATE.


Thank you for pointing me the right direction, and I thank my co-worker for his aid.
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 -> IMS DB/DC

 


Similar Topics
Topic Forum Replies
No new posts Using API Gateway from CICS program CICS 0
No new posts How to get a stack trace on a looping... ABENDS & Debugging 5
No new posts Calling Java method from batch COBOL ... COBOL Programming 5
No new posts Help in Automating Batch JCL jobs mon... JCL & VSAM 3
No new posts DB2 Event passed to the Application P... DB2 1
Search our Forums:

Back to Top