Need to interact with 3rd Party Software.
Release : 12.0
Component : ESP WORKLOAD AUTOMATION
To work with ESP Workload Automation it is a common need to issue commands to a third party software.
In this example, CA WA EE command ESP (ESP is the executable in prefix.SSCPLINK library) is used as an API to be called from a third party software. The following can be done with minor format changes based on what programming language is used:
CALL ESP 'SUBSYS(subsys);LDSN;END'
Note: Commands in single quotes are like commands issued in CA WA EE line mode. The last command should be END.
Example to use REXX:
/* REXX CODE */
X=OUTTRAP('A.')
QUEUE "LDSN"
QUEUE “END”
"ESP SUB(sub_sys)"
X=OUTTRAP('OFF')
Example to use COBOL:
Note: The parm field has to begin with a binary length field, like FILLER in the example below.
IDENTIFICATION DIVISION.
PROGRAM-ID. MYCOBOL.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
INPUT-OUTPUT SECTION.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 PARMS
05 PARM-LEN PIC 9(4) BINARY VALUE ZEROS
05 PARM-STR PIC X(68) VALUE
"SUBSYS(ESPM);TRIGGER PROD.TESTCOBL ADD USER1(TESTCOBL); END;"
LINKAGE SECTION.
PROCEDURE DIVISION.
MOVE LENGTH OF PARM-STR TO PARM-LEN
CALL "ESP" USING PARMS
STOP RUN.
Example to use Assembler:
ESPCODE LA 1,ESPPARMS
LINK EP=ESP,PARAM=((1)),VL=1
LTR 15,15
BZ RETURN
MVC WTO1+46(8),PROGRAM
WTO1 WTO 'KSCX02 NDM ERROR IN ESPD CALL - JOB: ', X
DESC=(11)
ESPPARMS DS 0CL54
ORG ESPPARMS
DC H'52'
DC CL13'SUBSYS(ESDP);'
DC CL16'TRIGGER CESD205.NDMDV#'
* DC CL25'ESPNOMSG TRIGGER CESD205.NDMDV#'
PROGRAM DC CL8' '
DC CL9' ADD;END;'
PROGRAM is filled in as it is the parameter passed to this routine from the NDM process.
What is important is the VL=1 on the link to tell ESP that this is the only parm being passed. Otherwise it tries to grab a bunch of storage behind the passed parm and process that too