MVSFORUMS.com :: View topic - Regarding the calling of the Cobol-CICS-DB2 program

MVSFORUMS.com
A Community of and for MVS Professionals

FAQ

Quick Manuals

Profile

Regarding the calling of the Cobol-CICS-DB2 program

MVSFORUMS.com Forum Index -> Application Programming

View previous topic :: View next topic

Author

Message

kpriya6
Beginner

Joined: 28 May 2004
Posts: 1
Topics: 1
Location: India

Posted: Fri May 28, 2004 9:51 am Post subject: Regarding the calling of the Cobol-CICS-DB2 program

Hi, I have a Cobol-DB2 batch program which calls another Cobl-CICS-DB2 program through cobol call statement. Is it possible to call the CICS program from batch program? Will it give any problem while executing the same? Are there any prerequisites to do the same? Kindly provide your answers.

powerhawk
Beginner

Joined: 08 Nov 2004
Posts: 28
Topics: 4
Location: Stockholm

Posted: Tue Dec 07, 2004 9:44 am Post subject:

Late answer.
I attach a sample program for this.

Code:

000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID. WMCSOPBI.
000300** *************************************************************
000400* *
000500* *
000600* SPECIAL REQUIREMENTS: THE PROGRAM MUST BE TRANSLATED WITH *
000700* THE EXCI OPTION, AND RUN AMODE 31 TO *
000800* USE THE EXTERNAL CICS INTERFACE. *
000900* *
001000* INPUT: THE TARGET CICS SYSTEM WITH WHICH THIS *
001100* BATCH CLIENT PROGRAM COMMUNICATES CAN BE *
001200* SPECIFIED VIA THE JCL PARM STATEMENT *
001300* INPUT FILE WITH COMMANDS. *
001400* *
001500* OUTPUT: STATUS INFORMATION FROM COMMAND. *
001600* *
001700****************************************************************
001800 ENVIRONMENT DIVISION.
001900*==============================================================*
002000 INPUT-OUTPUT SECTION.
002100 FILE-CONTROL.
002200 SELECT PRINTER ASSIGN TO SYSPRINT.
002300 SELECT INFIL ASSIGN TO SYSIN.
002400 DATA DIVISION.
002500*==============================================================*
002600 FILE SECTION.
002700*==============================================================*
002800 FD PRINTER BLOCK CONTAINS 128 CHARACTERS
002900 RECORDING MODE S
003000 LABEL RECORDS OMITTED.
003100 01 OUTPUT-RECORD PIC X(128).
003200 FD INFIL
003300 BLOCK CONTAINS 0 CHARACTERS
003400 LABEL RECORDS OMITTED.
003500 01 INP1.
003600 02 INPDATA.
003700 03 INFUNK PIC X(2).
003800 03 FILLER PIC X.
003900 03 INRES PIC X(8).
004000 03 FILLER PIC X(69).
004100 WORKING-STORAGE SECTION.
004200*==============================================================*
004300* DECLARE CALL LEVEL,DPL, AND EXEC LEVEL RETURN CODE AREAS. *
004400*==============================================================*
004500 COPY DFHXCPLO.
004600 01 SUB PIC S9(8) COMP.
004700 01 IX PIC S9(8) COMP.
004800*==============================================================*
004900* INITIALISE TARGET INFORMATION VARIABLES. *
005000*==============================================================*
005100 01 TARGET-PROGRAM PIC X(8) VALUE 'WMCSOP00'.
005200 01 TARGET-TRANSID PIC X(4) VALUE 'EXCI'.
005300 01 TARGET-SYSTEM.
005400 05 TARGET-SYS-ELEM PIC X OCCURS 8 TIMES.
005500*==============================================================*
005600* DEFINE COMMAREA STRUCT. *
005700*==============================================================*
005800 01 COMMAREA.
005900 05 CAFUNK PIC X(2).
006000 05 CARES PIC X(8).
006100 05 CARESP PIC 9(4).
006200 05 CARESP2 PIC 9(4).
006300*==============================================================*
006400* INITIALISE COMMAREA LENGTH AND DATA LENGTH(IN BYTES). *
006500*==============================================================*
006600 01 LINK-COM-LEN PIC S9(4) COMP VALUE 18.
006700 01 LINK-DAT-LEN PIC S9(4) COMP VALUE 18.
006800*==============================================================*
006900* INITIALISE PROGRAM SPECIFIC VARIABLES AND FLAGS. *
007000*==============================================================*
007100 01 PGM-RESPONSE PIC 9(8) COMP VALUE ZERO.
007110 01 SAVED-RESPONSE PIC 9(8) COMP VALUE ZERO.
007120 01 MAX-RESPONSE PIC 9(8) COMP VALUE ZERO.
007200 01 PROGRAM-MESSAGES.
007300 05 MSG00.
007400 10 FILLER PIC X(16) VALUE 'WMCSOPBI CICS='.
007500 10 M00CICS PIC X(8).
007600 10 FILLER PIC X(10) VALUE ' FUNCTION='.
007700 10 M00FUNK PIC X(2).
007800 10 FILLER PIC X(8) VALUE ' OBJECT='.
007900 10 M00RES PIC X(8).
008000 10 FILLER PIC X(7) VALUE ' RESP='.
008100 10 M00RESP PIC 9(4).
008200 10 FILLER PIC X(7) VALUE ' RESP2='.
008300 10 M00RESP2 PIC 9(4).
008400 10 FILLER PIC X(64) VALUE SPACES.
008500 05 MSG01.
008600 10 FILLER PIC X(27) VALUE 'WMCSOPBI LINKERROR CICS='.
008700 10 M01CICS PIC X(8).
008800 10 FILLER PIC X(8) VALUE ' RETUR='.
008900 10 M01RESP PIC 9(4).
009000 10 FILLER PIC X VALUE ' '.
009100 10 M01RESP2 PIC 9(4).
009200 10 FILLER PIC X(8) VALUE ' ABCODE='.
009300 10 M01ABCODE PIC X(4).
009400 10 FILLER PIC X(4) VALUE SPACES.
009401 10 M01MSG PIC X(60) VALUE SPACES.
009410 05 MSG02.
009420 10 FILLER PIC X(27) VALUE 'WMCSOPBI SET SYSTEM CICS='.
009430 10 M02CICS PIC X(8).
009491 10 FILLER PIC X(93) VALUE SPACES.
009492 05 MSGETEXT.
009493 10 MSGE1 PIC X OCCURS 128.
009500
010110 LINKAGE SECTION.
010120 01 MSGAREA.
010130 05 MSGA1 PIC X OCCURS 128.
010131
010140 PROCEDURE DIVISION.
010200 MAIN SECTION.
010300 OPEN OUTPUT PRINTER.
010400*
011500 MOVE 'DBDCCICS' TO TARGET-SYSTEM.
011600
011700 OPEN INPUT INFIL.
012100*
012200 A100.
012400 READ INFIL
012500 AT END GO A110.
012600*
012700 IF INFUNK = 'CC'
012710 MOVE INRES TO TARGET-SYSTEM
012712 MOVE TARGET-SYSTEM TO M02CICS
012717 WRITE OUTPUT-RECORD FROM MSG02
012720 GO TO A100.
012730*
012800 MOVE INFUNK TO CAFUNK
012900 MOVE INRES TO CARES
013000 PERFORM PGM-LINK
013010 MOVE PGM-RESPONSE TO SAVED-RESPONSE.
013011 IF PGM-RESPONSE > MAX-RESPONSE
013012 MOVE PGM-RESPONSE TO MAX-RESPONSE.
013013*
013020 IF PGM-RESPONSE < 16
013200 GO TO A100.
013300*
013400 A110.
013500 CLOSE INFIL.
013600*
017500 CLOSE PRINTER.
017600* MOVE SAVED-RESPONSE TO RETURN-CODE.
017610 MOVE MAX-RESPONSE TO RETURN-CODE.
017700 STOP RUN.
017800 A999.
017900 EXIT.
018000 EJECT
018100 PGM-LINK SECTION.
018200 PL00.
018300*
018400 EXEC CICS LINK PROGRAM(TARGET-PROGRAM)
018500 TRANSID(TARGET-TRANSID)
018600 APPLID(TARGET-SYSTEM)
018700 COMMAREA(COMMAREA)
018800 LENGTH(LINK-COM-LEN)
018900 DATALENGTH(LINK-DAT-LEN)
019000 RETCODE(EXCI-EXEC-RETURN-CODE)
019100 SYNCONRETURN
019200 END-EXEC.
019300
019310 MOVE SPACE TO M01MSG.
019400 IF EXEC-RESP = 0
019500 GO TO PL70.
019600
019700 MOVE 16 TO PGM-RESPONSE.
019701* TROLIGAST CICSEN EJ UPPE
019710 IF EXEC-RESP = 88 AND
019720 EXEC-RESP2 = 203
019730 MOVE 2 TO PGM-RESPONSE
019740 MOVE 'CICS IS DOWN' TO M01MSG.
019800
019900 MOVE TARGET-SYSTEM TO M01CICS
020000 MOVE EXEC-RESP TO M01RESP
020100 MOVE EXEC-RESP2 TO M01RESP2
020200 MOVE EXEC-ABCODE TO M01ABCODE
020210 IF EXEC-MSG-LEN < 1
020211 GO TO PL60
020212 END-IF
020213
020220 SET ADDRESS OF MSGAREA TO EXEC-MSG-PTR
020221 MOVE SPACES TO MSGETEXT
020222 MOVE ZERO TO IX.
020223 PL40.
020224 ADD 1 TO IX.
020225 IF IX > EXEC-MSG-LEN OR
020226 IX > 128
020227 GO TO PL50
020228 END-IF
020229 MOVE MSGA1 (IX) TO MSGE1 (IX)
020230 GO TO PL40.
020231 PL50.
020232 MOVE 'SE FEL NEDAN' TO M01MSG.
020240
020293 PL60.
020300 WRITE OUTPUT-RECORD FROM MSG01.
020310 IF EXEC-MSG-LEN > 0
020320 WRITE OUTPUT-RECORD FROM MSGETEXT
020330 END-IF
020400 GO TO PL99.
020500
020600 PL70.
020700 IF CARESP = 0
020800 MOVE 0 TO PGM-RESPONSE
020900 ELSE
021000 MOVE 8 TO PGM-RESPONSE
021100 END-IF
021200
021300 MOVE TARGET-SYSTEM TO M00CICS
021400 MOVE CAFUNK TO M00FUNK
021500 MOVE CARES TO M00RES
021600 MOVE CARESP TO M00RESP
021700 MOVE CARESP2 TO M00RESP2
021800 WRITE OUTPUT-RECORD FROM MSG00.
021900*
022100 PL99.
022200 EXIT.
022300 EJECT

This is a compile JCL for the program. Don't know how it works.

[code:1:81068b1db0]
//WMJOOLSX JOB (IMCOTF),'JONAS O',CLASS=B,MSGCLASS=X,
// NOTIFY=WMJOOLS
//*
//**** ****************************************************************
//* COBOL FOR MVS CICS TS BATCH MED EXCI *
//* *
//*********************************************************************
//SCAN EXEC PGM=ISRLEMX,COND=(12,LE),
// PARM='COB,WMCSOPBI,B,N,E,2,,,ENG,,,,,,'
//ISRLCODE DD DSN=WMM.TEST.COBOL,DISP=SHR
//ISRLEXPD DD UNIT=VIO,DISP=(NEW,PASS),SPACE=(CYL,(2,2)),
// DSN=&TEMP3
//ISRLMSG DD SYSOUT=*
//*
//TRN EXEC PGM=DFHECP1

Display posts from previous:

	MVSFORUMS.com Forum Index -> Application Programming	All times are GMT - 5 Hours
Page 1 of 1

You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum