Sample program EYUAAPI3

Program EYUAAPI3 is written in Assembler for the MVS/ESA batch environment.

EYUxAPI3
This program does the following: Commands Used: CONNECT, CREATE, DISCARD, DISCONNECT, FETCH, GET, PERFORM OBJECT, QUALIFY, QUERY, REMOVE

*
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
[[ Contents Previous Page | Next Page Index ]]