Sample program to pass TSS commands via RACROUTE

Document ID : KB000074538
Last Modified Date : 22/03/2018
Show Technical Document Details
Introduction:
Sample program to pass TSS commands using the IBM RACROUTE macro.
Question:
Sample program to pass TSS commands using the IBM RACROUTE macro.
Answer:
Sample code to pass TSS commands using IBM's RACROUTE macro:
 
S2222200 TITLE 'ISSUE TSS COMMAND VIA R_ADMIN'
S2222200 CSECT
*---------------------------------------------------------------------*
*                                                                     *
* ++  OUTPUT FROM TEST PROGRAMS SHOULD BE WRITTEN TO A PDS DATASET IF *
* ++  POSSIBLE AS IT IS DIFFICULT TO MAINTAIN SAVED OUTPUT WHEN       *
* ++  A WTO.                                                          *
*                                                                     *
*     MODULE    - S2222200                                            *
*                                                                     *
*     FUNCTION  - ISSUE R_ADMIN CALL                                  *
*                                                                     *
*     INPUT     - NONE                                                *
*                                                                     *
*     OUTPUT    - NONE                                                *
*                 RC WILL BE SET TO 0                                 *
*                                                                     *
* ** NOTE, COMMAND OUTPUT WILL SHOW IN SYSLOG AND IN THE JOB MESSAGES *
* ** IF THIS IS RUN AS A BATCH JOB.                                   *
*                                                                     *
* STANDARD REGISTER EQUATES                                           *
*     REGISTER                                                        *
*     USAGE     - R12 = BASE                                          *
*                 R11 = SECOND BASE                                   *
*                 R13 = STANDARD SAVEAREA                             *
*                                                                     *
*                                                                     *
*                                                                     *
*     CHANGE                                                          *
*     LEVEL     - 03/05/18  BIRTH                                     *
*---------------------------------------------------------------------*
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
* BEGIN STANDARD MODULE INITIALIZATION
START    STM   R14,R12,12(R13)    SAVE REGISTERS
         LR    R2,R1              POINT AT PARMLIST
         LR    R12,R15            BASE REGISTER
         LA    R11,4095(R12)      2ND BASE
         LA    R11,1(,R11)        2ND BASE
         USING S2222200,R12,R11   SET ADDRESSABILITY
         L     R0,AWORKLEN        LENGTH FOR WORKAREA GETMAIN
         GETMAIN RU,LV=(0)        ISSUE GETMAIN
         LR    R10,R1             R10 POINTS TO GETMAINED AREA
         USING WORKAREA,R10       ADDRESSABILITY FOR WORKAREA
         ST    R10,8(R13)         FORWARD CHAIN SAVEAREA
         ST    R13,SAVEAREA+4     BACKWARD CHAIN SAVEAREA
         LR    R13,R10            POINT AT MY NEW SAVEAREA
         L     R2,0(,R2)          POINT AT PARM
         LH    R3,0(,R2)          POINT AT PARM
         B     INIT               TO INITIALIZATION
*
* START THE REAL WORK
*
INIT     DS    0H
*
* UNCOMMENT THE FOLLOWING TO ISSUE A WTO  AT START
*
*        WTO   'GO..  COLLECT $200',ROUTCDE=(1,11)
*
**********************************************************************
*
* THIS PROGRAM WILL CALL THE R_ADMIN CALLABLE SERVICE.  IT TAKES THE
* COMMAND ENTERED IN FIELD TSSMOD AND SENDS IT TO THE R_ADMIN 
* CALLABLE SERVICE.
*
**********************************************************************
*
*--------------------------------------------------------------
*  BUILD A COMMAND BUFFER FROM THE INPUT DATA
*--------------------------------------------------------------
*
         LA    R7,CMDBUFF+4 POINT TO COMMAND BUFFER (PAST LEN)
         MVC   0(L'TSSMOD,R7),TSSMOD COPY IN 'TSS MODIFY'  CMD
         LA    R15,L'TSSMOD GET LENGTH OF COMMAND
         STCM  R15,15,CMDBUFF SET LENGTH IN BUFFER
*
*--------------------------------------------------------------
* CALL R_ADMIN TO ISSUE THE PASSED COMMAND
*--------------------------------------------------------------
*
         USING COMP,R7
         LA    R7,RPARMS                         POINT TO R_ADMIN PARMS
         LA    R1,ALET                          POINT TO R_ADMIN PARMS
         ST    R1,COMP_SAFRC_ALET@
         ST    R1,COMP_RACRC_ALET@
         ST    R1,COMP_RACSC_ALET@
         LA    R1,IRRWRK                        POINT TO R_ADMIN PARMS
         ST    R1,COMP_WORKA_STOR@
         LA    R1,SAFRC                         POINT TO R_ADMIN PARMS
         ST    R1,COMP_SAFRC_STOR@
         LA    R1,RACRC                         POINT TO R_ADMIN PARMS
         ST    R1,COMP_RACRC_STOR@
         LA    R1,RACRS                         POINT TO R_ADMIN PARMS
         ST    R1,COMP_RACSC_STOR@
         LA    R1,ADMN_RUN_COMD                 GET FUNCTION CODE
         STC   R1,FUNC                          SAVE IT
         LA    R1,FUNC                          POINT TO R_ADMIN PARMS
         ST    R1,ADMN_FUNC@
         LA    R1,CMDBUFF+2                     POINT TO R_ADMIN PARMS
         ST    R1,ADMN_PARMLIST@
         LA    R1,ALET                          POINT TO R_ADMIN PARMS
         ST    R1,ADMN_USERID@
         LA    R1,ALET                          POINT TO R_ADMIN PARMS
         ST    R1,ADMN_ACEEP@
         LA    R1,10                            GET A SUBPOOL
         STCM  R1,1,SUBPOOL
         LA    R1,SUBPOOL                       POINT TO R_ADMIN PARMS
         ST    R1,ADMN_OUTPUT_SP@
         LA    R6,MSGBUFF
         ST    R6,ADMN_OUTPUT_MSG@
         OI    ADMN_OUTPUT_MSG@,X'80'          MARK LAST ONE
*
         LOAD  EP=IRRSEQ00
         LR    R15,R0
         LA    R0,IRRSEQ00#
         LA    R1,COMP
         CALL  (15) (IRRWRK,                                           X
                ALET,SAFRC,                                            X
                ALET,RACRC,                                            X
                ALET,RACRS,                                            X
                FUNC,                          FUNCTION CODE           X
                CMDBFLN,                       PARM_LIST               X
                ALET,                          USER_ID                 X
                ALET,                          ACEE_PTR                X
                SUBPOOL,                       OUTPUT SUB-POOL         X
                MSGBUFF),                      MESSAGE BUFFER          X
                MF=(E,PCOMP)
*
         LTR   15,15          CHECK RC FROM R_ADMIN
         BNZ   EXIT08         <>0 RC RETURNED TO CALLER
*
*------------------------------------------------------------------
* WE DISPLAY THE OUTPUT FROM THE COMMAND
*------------------------------------------------------------------
*
         L     R2,MSGBUFF     GET RETURN BUFFER ADDRESS
         USING MSGOUT,R2      ADDRESS IT
         LR    R3,R2          COPY OUTPUT ADDRESS
         LR    R6,R2          COPY OUTPUT ADDRESS
         LA    R6,MSGSTART-MSGOUT(,R6)  BUMP TO FIRST MESSAGE
         A     R3,MSGEND       GET ADDRESS OF END
         MVC   WTOD,WTOL       MOVE LIST FORM OF MACRO TO WORK
*
MSGLOOP  DS    0H
         CR    R6,R3          END OF MESSAGE?
         BNL   EXIT00         YES, ALL DONE
         XR    R4,R4          CLEAR FOR ICM
         ICM   R4,3,0(R6)     GOT LENGTH OF THIS MESSAGE?
         BZ    EXIT00         NO, ALL DONE
         STH   R4,PREFIX      SAVE LENGTH FOR WTO
         BCTR  R4,0           PREP FOR EX
         LA    R6,2(,R6)      GET START OF MESSAGE
         EX    R4,MSG         COPY MESSAGE
         LA    R4,PREFIX      GET PREFIX
         WTO   TEXT=(R4),MF=(E,WTOD)
MSGZERO  DS    0H
         AH    R6,PREFIX      GET NEXT MESSAGE
         B     MSGLOOP        PRINT IT
         B     EXIT00         <>0 WTO RC RETURNED TO CALLER
EXIT00   DS    0H
         SR    R15,R15            RC=00
         B     EXIT
EXIT08   DS    0H
         LA    R15,8              RC=08
         B     EXIT
* STANDARD EXIT LOGIC
EXIT     L     R13,4(R13)         PREV SAVE AREA
         L     R14,12(R13)        RESTORE REG 14
         LM    R0,R12,20(R13)     RESTORE REGS 0-12
         BR    R14                RETURN
         LTORG
ZEROES   DC    F'0'
REQSTOR  DC    CL8'REQ22222'
SUBSYS   DC    CL8'SUB22222'
TIME     DC    A(100*30*2)               60 SECS * 5 = 5 MINS
FDB1     DC    C'TSSF',X'FF',X'00000000',X'00',6X'00',240X'FF'
RACWRK2  DC    512C'F'
AWORKLEN DC    A(WORKLEN)
ALET     DC    F'0'                              PRIMARY AS
WORKLN   DC  F'4096'
QNAM     DC  CL8'ZAP'
RNAM     DC  CL44'COMMON.SUBPOOL.245'
RNAMLN   DC  XL1'18'
BLANKS   DC  CL128' '
TSSMOD   DC    C'TSS ADD(FJAU1) PHRASEONLY'
*SSMOD   DC    C'TSS WHOAMI'
MSG      MVC   BUFFER(*-*),0(6)
WTOL     WTO   TEXT=,ROUTCDE=11,DESC=12,MF=L     LIST FORM
WTOLEN   EQU   *-WTOL
WORKAREA DSECT
SAVEAREA DS    18F
WTOD     DS   CL(WTOLEN)
PREFIX   DS   H
BUFFER   DS   CL126
*
SAVEINPX DS   CL8             PARM LIST ADDRESS
SAVEINP  DS   A               PARM LIST ADDRESS
SAVEREG  DS   A
SAFRC    DS   F
RACRC    DS   F
RACRS    DS   F
FUNC     DS   X
SUBPOOL  DS   X
FLAG     DS   X
F1MULT   EQU  X'80'
         DS   X
OPTIONS  DS   F
MSGBUFF  DS   A
USERID   DS   CL9
RPARMS   DS   30F
MODE     DS   CL9
TYPE     DS   CL9
SYSID    DS   CL9
IRRWRK   DS   CL1024
CMDBUFF  DS   CL1024
WORKLEN  EQU   *-WORKAREA
         IRRPCOMP ,
         IRRPFC ,
*        MACREGS
*
MSGOUT   DSECT
MSGNXTBL DS   F             NEXT OUTPUT MESSAGE BLOCK
MSGEYE   DS   CL4           EYE CATCHER 'RMSG'
MSGSPOOL DS   X             STORAGE SUBPOOL
MSGBLKLN DS   XL3           TOTAL BLOCK LENGTH
MSGEND   DS   F             OFFSET TO FIRST BYTE AFTER LAST MESSAGE
MSGSTART DS   X             START OF THE FIRST MESSAGE
         END


Please not that this is just and example and not supported by CA. It use, maintenance and customization is the sole responsibility of its user.
File Attachments:
RADMIN.txt