Program EYUAAPI3 is written in Assembler for the MVS/ESA batch environment.
*
EYUAAPI3 TITLE 'EYUAAPI3 - CPSM SAMPLE API PROGRAM 3 - ASSEMBLER'
***********************************************************************
* *
* MODULE NAME = EYUAAPI3 *
* *
* DESCRIPTIVE NAME = API sample program 3 ASSEMBLER Version *
* *
* 5695-081 *
* COPYRIGHT = NONE *
* *
* STATUS = %CP00 *
* *
* FUNCTION = *
* *
* To mirror an existing PLEX to a new PLEX. *
* *
* When invoked, the program depends upon the values held in the *
* OLDPLEX, NEWPLEX, and MPCMAS variables. They must be set to *
* the following values: *
* *
* OLDPLEX = The name of an existing PLEX that will be mirrored. *
* *
* NEWPLEX = The name that will be given to the new PLEX. *
* *
* MPCMAS = The maintenance point CMAS of the OLDPLEX. This *
* will also be the MP for the NEWPLEX. *
* *
* This sample requires no parameters at invocation time. *
* *
* The sample processes as follows: *
* *
* - a CONNECTion is established to CPSM, with the CONTEXT and *
* SCOPE of the OLDPLEX. *
* *
* - since a PLEX can be either a CONTEXT or SCOPE, we verify *
* that the NEWPLEX is not already a valid CONTEXT (i.e, an *
* existing CICSplex or CMAS) or SCOPE in the OLDPLEX (i.e, *
* an existing CICS system or CICS system group). *
* *
* - we GET the CPLEXDEF record for the OLDPLEX, and use this as *
* a module to CREATE the NEWPLEX. *
* *
* - we GET the CICSPLEX records for the OLDPLEX, and use these *
* to add the CMASs in the OLDPLEX to the NEWPLEX. *
* *
* - using a list that contains all possible CICSplex definitions, *
* we GET and FETCH the records from the OLDPLEX, and CREATE *
* them in the NEWPLEX. *
* *
* - we then DISCONNECT from CPSM. *
* *
* --------------------------------------------------------------------*
* *
* NOTES : *
* DEPENDENCIES = S/370 *
* RESTRICTIONS = None *
* REGISTER CONVENTIONS = *
* R0 Workarea / external call parameter pointer *
* R1 Workarea / external call parameter pointer *
* R2 Resource Table record pointer *
* R3 Loop counter *
* R4 List pointer *
* R5 Loop counter *
* R6 Unused *
* R7 Unused *
* R8 Unused *
* R9 Subroutine linkage *
* R10 Subroutine linkage *
* R11 Base register *
* R12 Base register *
* R13 Workarea pointer *
* R14 External call linkage *
* R15 External call linkage *
* *
* MODULE TYPE = Executable *
* PROCESSOR = Assembler *
* ATTRIBUTES = Read only, Serially Reusable *
* AMODE(31), RMODE(ANY) *
* *
* --------------------------------------------------------------------*
* *
* ENTRY POINT = EYUAAPI3 *
* *
* PURPOSE = All Functions *
* *
* LINKAGE = Executed as a batch program. *
* *
* INPUT = None *
* *
* OUTPUT = File for messages. *
* DDNAME = SYSPRINT *
* DSORG = PS *
* RECFM = FB *
* LRECL = 80 *
* BLKSIZE = as desired (a multiple of 80) *
* *
* --------------------------------------------------------------------*
EJECT
EYUAAPI3 CSECT
STM R14,R12,12(R13)
LR R12,R15
USING EYUAAPI3,R12
*---------------------------------------------------------------------*
* GETMAIN working storage and set up SA chain. *
*---------------------------------------------------------------------*
GETMAIN R,LV=WORKLEN
ST R13,4(,1)
ST R1,8(,R13)
L R1,24(,R13)
L R13,8(,R13)
USING SAVEAREA,R13
*---------------------------------------------------------------------*
* Preset return code to error - will change to 0 if all ok. *
*---------------------------------------------------------------------*
MVC RETCODE,=F'8'
*---------------------------------------------------------------------*
* OPEN file for error messages. *
*---------------------------------------------------------------------*
OPEN (SYSPRINT,OUTPUT)
*---------------------------------------------------------------------*
* Specify variables: OLDPLEX, NEWPLEX, MPCMAS *
* *
* Insure that the values specified are valid NAME type (i.e, *
* valid member name) or following code will fail. *
*---------------------------------------------------------------------*
MVC OLDPLEX,=CL8'plexold' *** SPECIFY AS DESIRED ***
MVC NEWPLEX,=CL8'plexnew' *** SPECIFY AS DESIRED ***
MVC MPCMAS,=CL8'mpcmas' *** SPECIFY AS DESIRED ***
*---------------------------------------------------------------------*
* Connect to CPSM API via OLDPLEX. *
*---------------------------------------------------------------------*
MVC CONTEXT,OLDPLEX
EXEC CPSM CONNECT X
CONTEXT(CONTEXT) X
VERSION(=CL4'0130') X
THREAD(THREAD) X
RESPONSE(RESPONSE) X
REASON(REASON)
CLC RESPONSE,EYUVALUE(OK) RESPONSE OK?
BNE ERRCON No - msgs and out
*---------------------------------------------------------------------*
* Verify that the desired NEWPLEX name is not already a *
* PLEX or CMAS. We do this by trying to set the CONTEXT *
* to the NEWPLEX name. If successful (NEWPLEX already exists *
* as a CONTEXT) issue messages and get out. *
*---------------------------------------------------------------------*
EXEC CPSM QUALIFY X
CONTEXT(NEWPLEX) X
THREAD(THREAD) X
RESPONSE(RESPONSE) X
REASON(REASON)
CLC RESPONSE,EYUVALUE(OK) RESPONSE OK?
BE ERRNISPC Yes - already a CONTEXT
*---------------------------------------------------------------------*
* Verify that the desired NEWPLEX name is not already a *
* CSYSDEF or CSYSGRP in the old, soon to be new, CICSplex. *
* *
* Here we will start issuing EXEC CPSM GET requests, to *
* get result sets of different Resource Tables. We make *
* the call through the GETOBJ subroutine. Variable OBJECT *
* must be set with the Resource Table name. If we only want *
* a subset of the records for a given Resource Table, we also *
* set variable CRITERIA with a selection criteria string. *
* This string can contain references to any fields in the *
* Resource Table, connected by logical operators, and must *
* end with a period - . -. Variable CRITLEN must be loaded *
* with the length of the criteria string. *
* *
* We will check the RESPONSE from GET calls inline, instead *
* of in the subroutine. The reason for this is that sometimes *
* a RESPONSE of OK will mean that we have a problem (e.g., *
* the NEWPLEX name already exists as a CICS System name). *
*---------------------------------------------------------------------*
*
* Ask for a CSYSSYS record equal to the NEWPLEX name.
*
MVC OBJECT,=CL8'CSYSDEF'
MVC CRITERIA(5),=CL5'NAME='
MVC CRITERIA+5(8),NEWPLEX
MVI CRITERIA+13,C'.'
MVC CRITLEN,=F'14'
BAS R10,GETOBJ Build result set
CLC RESPONSE,EYUVALUE(OK) RESPONSE OK?
BE ERRNISC Yes - already a CICS system
CLC RESPONSE,EYUVALUE(NODATA) No CSYSDEF with NEWPLEX name?
BE NOTCSYS Yes - continue
B ERRGETO No - some error - msgs and out
NOTCSYS DS 0H
*
* Ask for a CSYSGRP record equal to the NEWPLEX name.
*
MVC OBJECT,=CL8'CSYSGRP'
MVC CRITERIA(6),=CL6'GROUP='
MVC CRITERIA+6(8),NEWPLEX
MVI CRITERIA+14,C'.'
MVC CRITLEN,=F'15'
BAS R10,GETOBJ Build the result set
CLC RESPONSE,EYUVALUE(OK) RESPONSE OK?
BE ERRNISS Yes - already a system group
CLC RESPONSE,EYUVALUE(NODATA) No CSYSGRP with NEWPLEX name?
BE NOTCGRP Yes - continue
B ERRGETO No - some error - msgs and out
NOTCGRP DS 0H
*---------------------------------------------------------------------*
* If we have gotten this far, we know that NEWPLEX is not *
* already the name of a CICSplex, CMAS, CICS System, or *
* CICS System group - so we can start building the NEWPLEX. *
* *
* Switch CONTEXT to MPCMAS to build NEWPLEX and add CMASs. *
*---------------------------------------------------------------------*
MVC CONTEXT,MPCMAS
*---------------------------------------------------------------------*
* Build new plex using OLDPLEX as a model. *
* *
* The record that defines a CICSplex is the CPLEXDEF Resource *
* Table. We will GET the OLDPLEX CPLEXDEF record, modify *
* it as needed, and then CREATE the NEWPLEX CPLEXDEF records. *
* This creates the NEWPLEX. *
*---------------------------------------------------------------------*
MVI PLEXBLT,C'N' Indicate NEWPLEX not built yet
*
* First GET CPLEXDEF record for the OLDPLEX.
*
MVC OBJECT,=CL8'CPLEXDEF'
MVC CRITERIA(9),=CL9'CICSPLEX='
MVC CRITERIA+9(8),OLDPLEX
MVI CRITERIA+17,C'.'
MVC CRITLEN,=F'18'
BAS R10,GETOBJ Build result set
CLC RESPONSE,EYUVALUE(OK) RESPONSE OK?
BNE ERRGETO No - msgs and out
*
* Here we start using the GETBUF subroutine. This subroutine
* GETMAINs a buffer into which we can FETCH the records of the
* result set that we last issued a GET for.
*
BAS R10,GETBUF Get storage to receive recs
*
* Here we start using the FETCH subroutine. This subroutine
* reads all the records from the result set into the buffer.
* On return to mainline, R2 points to the first record in
* the buffer.
*
BAS R10,FETCH Sets R2 to fetched record
*
* Change the OLDPLEX CPLEXDEF record into the NEWPLEX
* CPLEXDEF record.
*
USING CPLEXDEF,R2 Map the record
MVC CPLEXDEF_CICSPLEX,NEWPLEX X
Set CICSplex name to NEWPLEX
MVC CPLEXDEF_DESC,=CL30'API cloned from' X
Modify CICSPlex ....
MVC CPLEXDEF_DESC+16(8),OLDPLEX X
.... description
MVC NEWPLXD(CPLEXDEF_TBL_LEN),0(R2) X
Save NEWPLEX def and len ....
MVC NEWPLXDL,=A(CPLEXDEF_TBL_LEN) X
.... for possible later REMOVE
*
* Here we start using the CREATE subroutine. This subroutine
* will cause a CPSM Resource Table record to be built. Variable
* OBJECT needs to be preset to the Resource Table name, the
* Resource Table record to be built must be pointed to by R2
* and must be filled out prior to called CREATE.
*
BAS R10,CREATE CREATE NEWPLEX
MVI PLEXBLT,C'Y' Indicate NEWPLEX now built
*
* Here we start using the FREEBUF subroutine. This subroutine
* FREEMAINs the buffer into which we FETCHed the records.
*
BAS R10,FREEBUF Free record storage
*
* When a result set is built (in our program by either GET or
* PERFORM) an id is associated with the result set and placed
* into the variable pointed to by keyword RESULT (for GET we
* are using variable RESULT - for PERFORM, RESULT2). This is
* done so that subsequent calls can reference the result set
* built (e.g, FETCH can retrieve records for GET). When we
* are done using a result set, we must DISCARD it, so that
* CPSM frees us resources allocated for the result set.
* Note that we have not done this with the 2 previous GETs
* we did since the object of them was to NOT get a result set.
* If any of the previous GETs caused a result set to get built,
* we DISCONNECT from CPSM - which causes all our resources to
* be released - and exit.
*
MVC RESULTD,RESULT Copy GET result set id for X
DISCARD
BAS R10,DISCARD Discard the GET result set
DROP R2 Drop mapping to CPLEXDEF rec
*---------------------------------------------------------------------*
* Add CMASs in OLDPLEX to NEWPLEX. *
* *
* There is a CICSPLEX Resource Table record for each CMAS *
* that participates in the management of a plex. We first *
* ask for all the CICSPLEX records for OLDPLEX, and use *
* this info to add the CMASs to the NEWPLEX. *
*---------------------------------------------------------------------*
* Ask for the CICSPLEX records from the OLDPLEX.
*
MVC OBJECT,=CL8'CICSPLEX'
MVC CRITERIA(9),=CL9'PLEXNAME='
MVC CRITERIA+9(8),OLDPLEX
MVI CRITERIA+17,C'.'
MVC CRITLEN,=F'18'
BAS R10,GETOBJ Build result set
CLC RESPONSE,EYUVALUE(OK) RESPONSE OK?
BNE ERRGETO no - msgs and out
BAS R10,GETBUF Get storage for records
BAS R10,FETCH Points R2 to first record
USING CICSPLEX,R2 Map the Resource Table
L R5,COUNT Will loop the number of X
returned CMASs
* The MP CMAS is added to the CICSplex when the CPLEXDEF
* record was CREATEd. To add any other CMASs to the CICSplex
* we issue a PERFORM against the CPLEXDEF record for NEWPLEX,
* with a parm = CICSPLEX(newplex) CMAS(cmasname).
*
MVC ADDCPARM(ADDCLEN),ADDC Build most of parm
MVC PARMLEN,=A(ADDCLEN) Set its length
MVC ADDCPLEX,NEWPLEX Add CICSplex name to parm
MVC OBJECT,=CL8'CPLEXDEF' PERFORM against CPLEXDEF
ADDCMAS DS 0H
CLC CICSPLEX_CMASNAME,MPCMAS CMAS = MPCMAS?
BE NOADDMP Yes - don't add it then
MVC ADDCCMAS,CICSPLEX_CMASNAME X
Add CMAS name to PARM X
This comes from the CICSPLEX X
records.
*
* Note that we already have the CICSPLEX result set active,
* with the id in RESULT. So here we will use RESULT2 for
* result set that is built for each PERFORM.
*
MVC RESULT2,=F'0' Always build new result set
EXEC CPSM PERFORM X
OBJECT(OBJECT) X
ACTION(=CL12'ASSIGN') X
PARM(ADDCPARM) X
PARMLEN(PARMLEN) X
RESULT(RESULT2) X
CONTEXT(CONTEXT) X
THREAD(THREAD) X
RESPONSE(RESPONSE) X
REASON(REASON)
CLC RESPONSE,EYUVALUE(OK) RESPONSE OK?
BNE ERRPERF no - msgs and out
MVC RESULTD,RESULT2 Copy PERFORM result set id for X
DISCARD
BAS R10,DISCARD Discard the PERFORM result set
NOADDMP DS 0H
*
* We need to get to the next CICSPLEX record for the next CMAS.
* The GETBUF subroutine places into variable RECLEN the length
* of the Resource Table record. We now add this to the address
* of the current record to point to the next record.
*
A R2,RECLEN
BCT R5,ADDCMAS Add the next CMAS
*
* No more CICSPLEX records - discard the CICSPLEX result set
* and continue on.
*
BAS R10,FREEBUF Free FETCHed record storage
MVC OBJECT,=CL8'CICSPLEX' For possible DISCARD error msg
MVC RESULTD,RESULT Copy GET result set id for X
DISCARD
BAS R10,DISCARD Discard the GET result set
DROP R2 Drop mapping to CICSPLEX rec
*---------------------------------------------------------------------*
* Take all defs in OLDPLEX and put into NEWPLEX. *
* *
* We have a list of all CICSplex Resource Table names. We *
* loop through this list, getting all the records for a *
* specific Resource Table from the OLDPLEX and adding them *
* to the NEWPLEX. *
*---------------------------------------------------------------------*
MVC CRITLEN,=F'0' Want all records from each X
Resource Table - so we don't X
want a CRITERIA for GET.
LA R3,DEFNUM Get number of Resource Tables
LA R4,DEFLIST Point R4 to first Resource X
Table in list
BLDLOOP DS 0H
MVC OBJECT,0(R4) Move in Resource Table name
*
* Get old data - set CONTEXT to OLDPLEX.
*
MVC CONTEXT,OLDPLEX
MVC SCOPE,OLDPLEX
BAS R10,GETOBJ Build result set
CLC RESPONSE,EYUVALUE(OK) RESPONSE OK?
BE GOTDEFS Yes - FETCH and add
CLC RESPONSE,EYUVALUE(NODATA) No records returned?
BE NODATA Yes - on to next Resource Tab
B ERRGETO GET error - msgs and out
GOTDEFS DS 0H
BAS R10,GETBUF Get storage for records
BAS R10,FETCH Point R2 to first record
L R5,COUNT Load number of records for loop
*
* Add new data - set CONTEXT to NEWPLEX.
*
MVC CONTEXT,NEWPLEX
CRELOOP DS 0H
*
* We need to check if the object being created is a RTAINAPS
* table. If it is, we need to check if the SCOPE is the
* OLDPLEX name - and if so, change it to the NEWPLEX name.
* The RTAINAPS table is the only resource table in our list
* that may have the OLDPLEX specified as a SCOPE.
*
CLC OBJECT,=CL8'RTAINAPS' Creating an RTAINAPS?
BNE CRELOOP2 No, just CREATE it
USING RTAINAPS,R2 May to the record
CLC RTAINAPS_SCOPE,OLDPLEX Is SCOPE equal to OLDPLEX?
BNE CRELOOP2 No, don't change record
MVC RTAINAPS_SCOPE,NEWPLEX Alter SCOPE to NEWPLEX
DROP R2 Drop mapping to RTAINAPS rec
CRELOOP2 DS 0H
BAS R10,CREATE CREATE record in NEWPLEX
A R2,RECLEN Point to next record
BCT R5,CRELOOP Loop
BAS R10,FREEBUF Release record storage
MVC RESULTD,RESULT Copy GET result set id for X
DISCARD
BAS R10,DISCARD Discard the GET result set
NODATA DS 0H
LA R4,8(,R4) Point to next Resource Table
BCT R3,BLDLOOP Do next Resource Table
*
* We have gone through all the Resource Tables ok. Set
* the return code to 0.
*
MVC RETCODE,=F'0'
*---------------------------------------------------------------------*
* Disconnect the connection and exit the program. *
*---------------------------------------------------------------------*
EXITDISC DS 0H
EXEC CPSM DISCONNECT X
THREAD(THREAD) X
RESPONSE(RESPONSE) X
REASON(REASON)
EXIT DS 0H
CLOSE (SYSPRINT)
*---------------------------------------------------------------------*
* Unchain save area, FREEMAIN working storage, and restore *
* registers. *
*---------------------------------------------------------------------*
L R2,RETCODE Retrieve return code
L R13,4(,R13)
L R1,8(,R13)
FREEMAIN R,A=(R1),LV=WORKLEN
L R14,12(,R13)
LR R15,R2
LM R0,R12,20(R13)
LA R15,0
BR R14
*---------------------------------------------------------------------*
* Error routines. *
*---------------------------------------------------------------------*
ERRCON DS 0H
MVC OUTLINE,=CL80'Error: Connecting to the API'
BAS R9,PUTMSG
BAS R10,DORR Format and msg RESPONSE/REASON
B EXIT Exit
ERRNISPC DS 0H
MVC OUTLINE,=CL80'Error: NEWPLEX is already defined as a CICX
Splex or CMAS'
BAS R9,PUTMSG
B EXITDISC DISCONNECT and exit
ERRNISC DS 0H
MVC OUTLINE,=CL80'Error: NEWPLEX is already defined as a CICX
S system in the OLDPLEX'
BAS R9,PUTMSG
B EXITDISC DISCONNECT and exit
ERRNISS DS 0H
MVC OUTLINE,=CL80'Error: NEWPLEX is already defined as a CICX
S system group in the OLDPLEX'
BAS R9,PUTMSG
B EXITDISC DISCONNECT and exit
ERRPERF DS 0H
MVC OUTLINE,=CL80'Error: Adding a CMAS to the NEWPLEX'
BAS R9,PUTMSG
MVC OUTLINE,=CL80' '
MVC OUTTXT1,=CL10'CMASNAME:'
MVC OUTDAT1,ADDCCMAS
BAS R9,PUTMSG
BAS R10,DORR Format and msg RESPONSE/REASON
B EXITERR
ERRGETO DS 0H
MVC OUTLINE,=CL80'Error: GETting an object'
BAS R9,PUTMSG
B DOOBJMSG
ERRQUERY DS 0H
MVC OUTLINE,=CL80'Error: QUERYing a record size.'
BAS R9,PUTMSG
B DOOBJMSG
ERRFETCH DS 0H
MVC OUTLINE,=CL80'Error: FETCHing an object.'
BAS R9,PUTMSG
B DOOBJMSG
ERRCREAT DS 0H
MVC OUTLINE,=CL80'Error: CREATEing an object.'
BAS R9,PUTMSG
B DOOBJMSG
ERRDISCA DS 0H
MVC OUTLINE,=CL80'Error: DISCARDing object.'
BAS R9,PUTMSG
DOOBJMSG DS 0H
MVC OUTLINE,=CL80' '
MVC OUTTXT1,=CL10'OBJECT:'
MVC OUTDAT1,OBJECT
BAS R9,PUTMSG
BAS R10,DORR
EXITERR DS 0H
CLI PLEXBLT,C'Y' Did we CREATE the NEWPLEX?
BNE EXITDISC No - just DISCONNECT and exit
*
* We had already CREATEd the NEWPLEX when an error occurred
* so we want to delete the NEWPLEX before ending our program.
*
EXEC CPSM REMOVE X
OBJECT(=CL8'CPLEXDEF') X
FROM(NEWPLXD) X
LENGTH(NEWPLXDL) X
CONTEXT(MPCMAS) X
THREAD(THREAD) X
RESPONSE(RESPONSE) X
REASON(REASON)
CLC RESPONSE,EYUVALUE(OK) RESPONSE OK?
BE EXITDISC Yes - DISCONNECT and exit
MVC OUTLINE,=CL80'Error: REMOVEing NEWPLEX.'
BAS R9,PUTMSG
BAS R10,DORR
B EXITDISC DISCONNECT and exit
*---------------------------------------------------------------------*
* End of error routines. *
*---------------------------------------------------------------------*
* Subroutines. *
*---------------------------------------------------------------------*
PUTMSG DS 0H
PUT SYSPRINT,OUTLINE
BR R9
DORR DS 0H
*---------------------------------------------------------------------*
* Subroutine: DORR *
* Entry: Via BAS R10,DORR *
* Function: Put out error messages indicating what function *
* failed and the RESPONSE and REASON from that *
* function. *
* Processing: - Format the EXEC CPSM RESPONSE and move to the *
* OUTLINE. *
* - Format the EXEC CPSM REASON and move to the *
* OUTLINE. *
* - Call the PUTMSG subroutine to send the *
* RESPONSE/REASON data to SYSPRINT. *
* - Return to caller. *
*---------------------------------------------------------------------*
MVC OUTLINE,=CL80' ' clear format area
MVC OUTTXT1,=CL10'RESPONSE:' move in ....
L R3,RESPONSE load up the RESPONSE
CVD R3,DOUBLE convert to decimal
MVC OUTDAT1(6),=XL6'402020202120' move in EDIT pattern
ED OUTDAT1(6),DOUBLE+5 EDIT RESPONSE to format area
MVC OUTTXT2,=CL10'REASON:' .... constant data
L R3,REASON load up the REASON
CVD R3,DOUBLE convert to decimal
MVC OUTDAT2(6),=XL6'402020202120' move in EDIT pattern
ED OUTDAT2(6),DOUBLE+5 EDIT REASON to format area
BAS R9,PUTMSG SEND it
MVC OUTLINE,=CL80' ' clear out OUTLINE again
BAS R9,PUTMSG put out blank line
BR R10 return to caller
GETOBJ DS 0H
*---------------------------------------------------------------------*
* Subroutine: GETOBJ *
* Entry: Via BAS R10,GETOBJ *
* Function: Issue the EXEC CPSM GET command to create a *
* result set for a specific object. Note that *
* all operands for GET must be preset in *
* mainline code - except for RESULT. *
* Processing: - Clear out the result set id - RESULT - so *
* that a new result set is always built. It *
* is the responsibility of mainline to DISCARD *
* any previous result set for GET. *
* - Determine if the GET request has a CRITERIA *
* and use the proper EXEC CPSM GET call. *
* - Note that GETOBJ does not check the RESPONSE *
* from CPSM - this is done in mainline. *
* - Return to caller. *
*---------------------------------------------------------------------*
MVC RESULT,=F'0' Always get new result set
CLC CRITLEN,=F'0'
BE GETNOCRT
EXEC CPSM GET X
OBJECT(OBJECT) X
CRITERIA(CRITERIA) X
LENGTH(CRITLEN) X
COUNT(COUNT) X
RESULT(RESULT) X
THREAD(THREAD) X
CONTEXT(CONTEXT) X
RESPONSE(RESPONSE) X
REASON(REASON)
BR R10
GETNOCRT DS 0H
EXEC CPSM GET X
OBJECT(OBJECT) X
COUNT(COUNT) X
RESULT(RESULT) X
THREAD(THREAD) X
CONTEXT(CONTEXT) X
RESPONSE(RESPONSE) X
REASON(REASON)
BR R10
GETBUF DS 0H
*---------------------------------------------------------------------*
* Subroutine: GETBUF *
* Entry: Via BAS R10,GETBUF *
* Function: Get a buffer to hold all the records contained *
* in the last result set we build though GET. *
* Processing: - Issue EXEC CPSM QUERY to get the length of *
* the Resource Table record. We use the same *
* OBJECT and RESULT from the GET. Variable *
* RECLEN gets the record length. *
* - Check the RESPONSE from QUERY and issue msgs *
* and EXIT if not OK. *
* - Multiple the RECLEN times the COUNT (returned *
* from last GET) to determine the buffer size *
* required and GETMAIN it. *
* - Save the buffer length (BUFLEN) and buffer *
* address (BUFFER) for the FREEMAIN call in *
* the FREEBUF subroutine. *
* - Return to caller. *
*---------------------------------------------------------------------*
EXEC CPSM QUERY X
OBJECT(OBJECT) X
DATALENGTH(RECLEN) X
RESULT(RESULT) X
THREAD(THREAD) X
RESPONSE(RESPONSE) X
REASON(REASON)
CLC RESPONSE,EYUVALUE(OK) RESPONSE OK?
BNE ERRQUERY No - msgs and out
L R0,RECLEN
L R1,COUNT
MR R0,R0
GETMAIN R,LV=(R1)
ST R0,BUFLEN
ST R1,BUFFER
BR R10
FREEBUF DS 0H
*---------------------------------------------------------------------*
* Subroutine: FREEBUF *
* Entry: Via BAS R10,FREEBUF *
* Function: To FREEMAIN the buffer created to hold the *
* records from the last result set we built . *
* through GET. *
* Processing: - Use BUFLEN and BUFFER from GETBUF, FREEMAIN *
* the buffer area. *
* - Return to caller. *
*---------------------------------------------------------------------*
L R0,BUFLEN
L R1,BUFFER
FREEMAIN R,A=(R1),LV=(R0)
BR R10
FETCH DS 0H
*---------------------------------------------------------------------*
* Subroutine: FETCH *
* Entry: Via BAS R10,FETCH *
* Function: Issue the EXEC CPSM FETCH command to retrieve *
* the result set created by the last GET. *
* mainline code - except for RESULT. *
* Processing: - For FETCH we must provide a receiving area *
* and length. We put in the area length into *
* R2 and the area length in variable LENGTH. *
* Note that we got both the area and length *
* in the GETBUF routine. *
* - Issue the FETCH request using the result set *
* id - RESULT - from the last GET. *
* - Check the RESPONSE - if not OK, issue msgs *
* and exit. *
* - Return to caller. *
*---------------------------------------------------------------------*
L R2,BUFFER
MVC LENGTH,BUFLEN
EXEC CPSM FETCH X
ALL X
INTO(0(,R2)) X
LENGTH(LENGTH) X
COUNT(COUNT) X
RESULT(RESULT) X
THREAD(THREAD) X
RESPONSE(RESPONSE) X
REASON(REASON)
CLC RESPONSE,EYUVALUE(OK)
BNE ERRFETCH
BR R10
CREATE DS 0H
*---------------------------------------------------------------------*
* Subroutine: CREATE *
* Entry: Via BAS R10,CREATE *
* Function: Issue the EXEC CPSM CREATE to build a Resource *
* Table record. *
* Processing: - Place the length of the record to be build *
* (RECLEN from GETBUF) into variable LENGTH. *
* R2 should have been set by mainline to point *
* to the record itself. *
* - When CREATEing a LNKxxCG record (spec to *
* group link) we need to specify a parm - *
* NONE. - to indicate that we only want the *
* CREATE to associate the spec to the group. *
* Any systems in the group that need to be *
* added to the spec have already been done *
* by CREATE of LNKxxCS records (spec to *
* system link). If this is a LNKxxCG record, *
* set the PARM and PARMLENgth. *
* - Issue the proper format of EXEC CPSM CREATE *
* (either with PARM/PARMLEN or without). *
* - Check the RESPONSE - if not OK, issue msgs *
* and exit. *
* - Return to caller. *
*---------------------------------------------------------------------*
MVC LENGTH,RECLEN
CLC OBJECT(4),=CL4'LNKS'
BNE CRENOPRM
CLC OBJECT+6(2),=CL2'CG'
BNE CRENOPRM
MVC PARM,=CL5'NONE.'
MVC PARMLEN,=F'5'
EXEC CPSM CREATE X
OBJECT(OBJECT) X
FROM(0(,R2)) X
LENGTH(LENGTH) X
PARM(PARM) X
PARMLEN(PARMLEN) X
THREAD(THREAD) X
CONTEXT(CONTEXT) X
RESPONSE(RESPONSE) X
REASON(REASON)
B CRECHKRR
CRENOPRM DS 0H
EXEC CPSM CREATE X
OBJECT(OBJECT) X
FROM(0(,R2)) X
LENGTH(LENGTH) X
THREAD(THREAD) X
CONTEXT(CONTEXT) X
RESPONSE(RESPONSE) X
REASON(REASON)
CRECHKRR DS 0H
CLC RESPONSE,EYUVALUE(OK)
BNE ERRCREAT
BR R10
DISCARD DS 0H
*---------------------------------------------------------------------*
* Subroutine: DISCARD *
* Entry: Via BAS R10,DISCARD *
* Function: Issue the EXEC CPSM DISCARD to discard a result *
* set built by CPSM. In our program, both GET *
* and PERFORM build result sets. *
* Processing: - Issue EXEC CPSM DISCARD for the result set. *
* The result set id must be placed into *
* RESULTD by mainline. *
* - Check the RESPONSE - if not OK, issue msgs *
* and exit. *
* - Return to caller. *
*---------------------------------------------------------------------*
EXEC CPSM DISCARD X
RESULT(RESULTD) X
THREAD(THREAD) X
RESPONSE(RESPONSE) X
REASON(REASON)
CLC RESPONSE,EYUVALUE(OK)
BNE ERRDISCA
BR R10
*---------------------------------------------------------------------*
* End of subroutines. *
*---------------------------------------------------------------------*
*---------------------------------------------------------------------*
* Following is a list of all CPSM Resource Tables that can *
* be part of a CICSplex. The order that they are in (which *
* is the order they will be built in our program) is *
* important, since some Resource Tables will reference other *
* Resource Tables previously built. The following list is *
* complete and the order OK for the current release of *
* CPSM (V1R3M0). *
*---------------------------------------------------------------------*
DEFLIST DS 0C
DC CL8'PERIODEF' Time period definitions
DC CL8'ACTION ' RTA action definitions
DC CL8'CSYSDEF ' CICS system definitions
DC CL8'CSYSGRP ' CICS system group definitions
DC CL8'CSGLCGCS' CICS systems in groups links
DC CL8'CSGLCGCG' CICS groups in groups links
DC CL8'MONDEF ' Monitor definitions
DC CL8'MONGROUP' MON group definitions
DC CL8'MONSPEC ' MON specification definitions
DC CL8'MONINGRP' MON def in MON group links
DC CL8'MONINSPC' MON spec to MON group links
DC CL8'LNKSMSCS' MON spec to CICS system links
DC CL8'LNKSMSCG' MON spec to CICS group links
DC CL8'EVALDEF ' RTA evaluation definitions
DC CL8'RTADEF ' Real time analysis definitions
DC CL8'STATDEF ' User status probe definitions
DC CL8'RTAGROUP' RTA group definitions
DC CL8'RTASPEC ' RTA specification definitions
DC CL8'RTAINGRP' RTADEF in RTA group links
DC CL8'STAINGRP' STATDEF in RTA group links
DC CL8'RTAINSPC' RTA spec to RTA group links
DC CL8'LNKSRSCS' RTA spec to CICS group links
DC CL8'LNKSRSCG' RTA spec to CICS system links
DC CL8'APSPEC ' RTA/APM specification defs
DC CL8'RTAINAPS' RTA/APM spec to RTA group links
DC CL8'CMDMPAPS' RTA spec to primary CMAS links
DC CL8'CMDMSAPS' RTA spec to secondary CMAS links
DC CL8'TRANGRP ' transaction group definitions
DC CL8'WLMDEF ' Workload definitions
DC CL8'WLMGROUP' WLM group definitions
DC CL8'WLMSPEC ' WLM specification definitions
DC CL8'DTRINGRP' Transactions in trangrp links
DC CL8'WLMINGRP' WLM def in WLM group links
DC CL8'WLMINSPC' WLM spec to WLM group links
DC CL8'LNKSWSCS' WLM spec to CICS group links
DC CL8'LNKSWSCG' WLM spec to CICS system links
DEFNUM EQU (*-DEFLIST)/8
ADDC DS 0X
DC CL09'CICSPLEX('
DC CL08' '
DC CL07') CMAS('
DC CL08' '
DC CL02').'
ADDCLEN EQU *-ADDC
SYSPRINT DCB DDNAME=SYSPRINT,DSORG=PS,MACRF=PM
WORKSTOR DSECT
SAVEAREA DS 18F
DFHEIPL DS 13F
DS 51F
DOUBLE DS D
RETCODE DS F
RESPONSE DS F
REASON DS F
THREAD DS F
RESULT DS F
RESULT2 DS F
RESULTD DS F
COUNT DS F
LENGTH DS F
PARMLEN DS F
BUFLEN DS F
BUFFER DS F
RECLEN DS F
NEWPLXDL DS F
CRITLEN DS F
CRITERIA DS CL80
CONTEXT DS CL8
SCOPE DS CL8
OBJECT DS CL8
OLDPLEX DS CL8
NEWPLEX DS CL8
MPCMAS DS CL8
OUTLINE DS 0CL80
OUTTXT1 DS CL10
OUTDAT1 DS CL8
DS CL2
OUTTXT2 DS CL10
OUTDAT2 DS CL8
DS CL42
PARM DS CL5
PLEXBLT DS CL1
ADDCPARM DS 0XL(ADDCLEN)
DS CL09
ADDCPLEX DS CL08
DS CL07
ADDCCMAS DS CL08
DS CL02
DS D
NEWPLXD DS XL(CPLEXDEF_TBL_LEN)
WORKLEN EQU *-WORKSTOR
COPY CPLEXDEF
COPY CICSPLEX
COPY RTAINAPS
R0 EQU 0
R1 EQU 1
R2 EQU 2
R3 EQU 3
R4 EQU 4
R5 EQU 5
R6 EQU 6
R7 EQU 7
R8 EQU 8
R9 EQU 9
R10 EQU 10
R11 EQU 11
R12 EQU 12
R13 EQU 13
R14 EQU 14
R15 EQU 15
END EYUAAPI3