The SARSAMRX Program Source

Document ID : KB000006561
Last Modified Date : 14/02/2018
Show Technical Document Details
Issue:

Provided herein is the source code for program SARSAMRX.

Environment:
CA View - All Releases
Resolution:

The source code for program SARSAMRX:

 

         TITLE 'SARSAMRX - PERFORMS SAR DATABASE I/0 FOR REXX PROGRAMS'

         PUNCH ' MODE AMODE(31),RMODE(ANY)'                            

***********************************************************************

**                                                                   **

**                                                                   **

**           *     *   *****   *******  ***   *****  *****           **

**           **    *  *     *     *      *   *       *               **

**           * *   *  *     *     *      *   *       *               **

**           *  *  *  *     *     *      *   *       ***             **

**           *   * *  *     *     *      *   *       *               **

**           *    **  *     *     *      *   *       *               **

**           *     *   *****      *     ***   *****  *****           **

**                                                                   **

**                                                                   **

**-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-**

**                                                                   **

**   THESE USER CONTRIBUTED EXITS ARE DISTRIBUTED AS A COURTESY      **

**   ONLY.                                                           **

**                                                                   **

**   THEY MAY OR MAY NOT HAVE BEEN TESTED BY COMPUTER ASSOCIATES     **

**   INTERNATIONAL, INC.; THEY ARE NOT CERTIFIED THAT THEY WILL      **

**   FUNCTION IN ANY FASHION WHATSOEVER, AND THEY ARE NOT SUPPORTED  **

**   BY COMPUTER ASSOCIATES INTERNATIONAL, INC.                      **

**                                                                   **

**   THERE IS NO WARRANTY, EXPRESS OR IMPLIED, AS TO THEIR           **

**   USABILITY IN YOUR ENVIRONMENT.                                  **

**                                                                   **

**   USE AT YOUR OWN DISCRETION AND RISK.                            **

**                                                                   **

***********************************************************************

SARSAMRX CSECT ,                                                       

SARSAMRX AMODE 31                                                      

SARSAMRX RMODE ANY                                                     

***********************************************************************

*                                                                     *

* SARSAMRX -                                                          *

*        PERFORMS SAR DATABASE I/O FOR REXX PROGRAMS.                 *

*                                                                     *

* INPUTS -                                                            *

*        R0 - ADDRESS OF THE ENVIRONMENT BLOCK (IRXENVB)              *

*        R1 - ADDRESS OF THE EXTERNAL FUNCTION PARM LIST (IRXEFPL)    *

*                                                                     *

* RETURN CODES -                                                      *

*        ALWAYS ZERO                                                  *

*                                                                     *

* ATTRIBUTES -                                                        *

*        RENT, REUS                                                   *

*                                                                     *

* SAMPLE REXX CALL -                                                  *

*        CALL SARSAMRX 'OPEN', 'SARP.SYSTEM1', 'FREE'                 *

*        CALL SARSAMRX 'CLOSE'                                        *

*        CALL SARSAMRX 'GET', KEY, 'EQ'                               *

*        CALL SARSAMRX 'INVL'                                         *

*        CALL SARSAMRX 'MSG'                                          *

*        CALL SARSAMRX 'SOPN', GCR                                    *

*        CALL SARSAMRX 'SGET'                                         *

*        CALL SARSAMRX 'SCLS'                                         *

*        CALL SARSAMRX 'AOPN', GCR                                    *

*        CALL SARSAMRX 'AGET'                                         *

*        CALL SARSAMRX 'ACLS'                                         *

*                                                                     *

* VALUES RETURNED IN THE REXX RESULT VARIABLE -                       *

*        01-02     RETURN CODE FROM SARSAM (IN DECIMAL 00-99)         *

*        03-32762  RECORD RETURNED FROM SARSAM                        *

*                                                                     *

*       WARNING! IF YOU ARE RUNNING SARSAM 6.1 OR LATER, VERIFY       *

*       THE LINK ATTRIBUTES.                                          *

*                                                                     *

*       FOR BEST PERFORMANCE, USE THE NORENT,NOREUS (THE CORRECT      *

*       ATTRIBUTES). ANY OTHER ATTRIBUTES CAUSE THE ROUTINE TO RUN    *

*       SLOWLY.                                                       *

*                                                                     *

*       SOME VERSIONS OF SARSAM WERE INCORRECTLY LINKED               *

*       AS RENT,REUS.                                                 *

*                                                                     *

***********************************************************************

BEGIN    SAVE  (14,12),,'SARSAMRX &SYSDATE &SYSTIME'                   

         LR    R12,R15             LOAD BASE REGISTER                  

         USING SARSAMRX,R12        ADDRESSABILITY FOR PROGRAM          

*---------------------------------------------------------------------*

*                 ACQUIRE STORAGE AND CHAIN SAVE AREAS                *

*---------------------------------------------------------------------*

         GETMAIN R,LV=AREALEN      GET DYNAMIC STORAGE                 

         LR    R2,R1               SAVE TARGET ADDRESS                 

         LR    R0,R1               SET TARGET ADDRESS                  

         L     R1,=A(AREALEN)      SET TARGET LENGTH                   

         SLR   R14,R14             SET SOURCE ADDRESS                  

         LR    R15,R14             SET SOURCE LENGTH AND PAD           

         MVCL  R0,R14              ZERO OUT WORK AREA                  

         ST    R2,8(R13)           COMPLETE CHAINS                     

         ST    R13,4(R2)           COMPLETE CHAINS                     

         LM    R0,R1,20(R13)       RELOAD R0 - R1                      

         LR    R13,R2              ESTABLISH SAVEAREA                  

         USING AREA,R13                                                

         STM   R0,R1,ADDRENVB                                          

*---------------------------------------------------------------------*

*        USE QUERY FUNCTION TO DETERMINE IF ENTRY ALREADY THERE       *

*---------------------------------------------------------------------*

         MVC   SCMSTR,SCMHCET               INIT HOST CMD TABLE ENTRY  

         LA    R1,SCMSTR                    ADDR OF AREA FOR HCE ENTRY 

         ST    R1,SCMSTRA                   SAVE ADDR                  

         LA    R1,L'SCMSTR                  TABLE ENTRY LENGTH         

         ST    R1,SCMSTRL                   INIT HCE LENGTH PARAMETER  

         L     R0,ADDRENVB                                             

         LA    R1,PARMLIST                                             

         L     R15,ADDRENVB        GET ADDRESS OF ENVIRONMENT BLOCK    

         L     R15,ENVBLOCK_IRXEXTE-ENVBLOCK(,R15) ADDR OF EXT VECTOR  

         L     R15,IRXSUBCM-IRXEXTE(,R15) ADDRESS OF IRXSUBCM ROUTINE  

         CALL  (15),(SCMQRYF,SCMSTRA,SCMSTRL,SCMENV),VL,MF=(E,(R1))    

         LTR   R15,R15             DOES ENVIRONMENT EXIST?             

         BNZ   LOADSAM             NO                                  

         MVC   ADDRSAM,SCMTOK      SAVE ADDRESS OF SARSAM ROUTINE      

         B     GETPARMS            YES - GET PARMS                     

*                                                                      

LOADSAM  LOAD  EP=SARSAM           NO --                               

         ST    R0,ADDRSAM          SAVE THE ADDRESS                    

         MVI   RFRHSAM,C'Y'        INDICATE FRESH COPY                 

*                                                                      

*---------------------------------------------------------------------*

*        USE ADD FUNCTION TO CREATE A NEW TABLE ENTRY                 *

*---------------------------------------------------------------------*

         MVC   SCMSTR,SCMHCET      INIT HOST CMD TABLE ENTRY           

         ST    R0,SCMTOK           INITIALIZE ENVIRONMENT TOKEN        

         LA    R1,SCMSTR           ADDR OF AREA FOR HCE ENTRY          

         ST    R1,SCMSTRA          SAVE ADDR                           

         LA    R1,L'SCMSTR         TABLE ENTRY LENGTH                  

         ST    R1,SCMSTRL          INIT HCE LENGTH PARAMETER           

         L     R0,ADDRENVB                                             

         LA    R1,PARMLIST                                             

         L     R15,ADDRENVB        GET ADDRESS OF ENVIRONMENT BLOCK    

         L     R15,ENVBLOCK_IRXEXTE-ENVBLOCK(,R15) ADDR OF EXT VECTOR  

         L     R15,IRXSUBCM-IRXEXTE(,R15) ADDRESS OF IRXSUBCM ROUTINE  

         CALL  (15),(SCMADDF,SCMSTRA,SCMSTRL,SCMENV),VL,MF=(E,(R1))    

         LTR   R15,R15                                                 

         BZ    LOADSAM1                                                

         DC    X'00DEAD'                                               

         DC    AL1(L'ERMSG1)                                           

ERMSG1   DC    C'UNABLE TO ADD SARSAMRX ENVIRONMENT'                   

LOADSAM1 LOAD  EP=SARSAMRX         LOCK SARSAMRX IN MEMORY             

*                                                                      

*---------------------------------------------------------------------*

*                 EXTRACT REXX PARMS                                  *

*---------------------------------------------------------------------*

GETPARMS LM    R0,R1,ADDRENVB      RELOAD R0/ R1                       

         USING EFPL,R1                                                 

         L     R2,EFPLARG          ADDRESS OF PARMS                    

         DROP  R1                                                      

         USING ARGTABLE_ENTRY,R2                                       

         LA    R0,PARMS            INITIALIZE PARMS                    

         LA    R1,PARMLEN                                              

         SLR   R14,R14                                                 

         LR    R15,R14                                                 

         ICM   R15,B'1000',SPACES                                      

         MVCL  R0,R14                                                  

*                                                                      

         CLC   HIVALUES(L'ARGTABLE_END),ARGTABLE_ENTRY                 

         BE    CKRTN                                                   

         LA    R0,PARM1            GET PARM 1                          

         LA    R1,L'PARM1                                              

         L     R14,ARGTABLE_ARGSTRING_PTR                              

         L     R15,ARGTABLE_ARGSTRING_LENGTH                           

         ICM   R15,B'1000',SPACES                                      

         MVCL  R0,R14                                                  

         OC    PARM1,SPACES        CONVERT TO UC                       

         LA    R2,ARGTABLE_NEXT    NEXT ARGTABLE ENTRY                 

*                                                                      

         CLC   HIVALUES(L'ARGTABLE_END),ARGTABLE_ENTRY                 

         BE    CKRTN                                                   

         LA    R0,PARM2            GET PARM 2                          

         LA    R1,L'PARM2                                              

         L     R14,ARGTABLE_ARGSTRING_PTR                              

         L     R15,ARGTABLE_ARGSTRING_LENGTH                           

         ICM   R15,B'1000',SPACES                                      

         MVCL  R0,R14                                                  

         LA    R2,ARGTABLE_NEXT    NEXT ARGTABLE ENTRY                 

*                                                                      

         CLC   HIVALUES(L'ARGTABLE_END),ARGTABLE_ENTRY                 

         BE    CKRTN                                                   

         LA    R0,PARM3            GET PARM 3                          

         LA    R1,L'PARM3                                              

         L     R14,ARGTABLE_ARGSTRING_PTR                              

         L     R15,ARGTABLE_ARGSTRING_LENGTH                           

         ICM   R15,B'1000',SPACES                                      

         MVCL  R0,R14                                                  

         OC    PARM3,SPACES        CONVERT PARM3 TO UC                 

         DROP  R2                                                      

*---------------------------------------------------------------------*

*        SARSAM FUNCTION SELECTION ROUTINE                            *

*---------------------------------------------------------------------*

CKRTN    CLC   PARM1,=CL8'GET'                                         

         BE    GET                                                     

         CLC   PARM1,=CL8'SGET'                                        

         BE    SGET                                                    

         CLC   PARM1,=CL8'SOPN'                                        

         BE    SOPN                                                    

         CLC   PARM1,=CL8'SCLS'                                        

         BE    SCLS                                                   

         CLC   PARM1,=CL8'AGET'                                       

         BE    AGET                                                   

         CLC   PARM1,=CL8'AOPN'                                       

         BE    AOPN                                                   

         CLC   PARM1,=CL8'ACLS'                                       

         BE    ACLS                                                   

         CLC   PARM1,=CL8'INVL'                                       

         BE    INVL                                                   

         CLC   PARM1,=CL8'OPEN'                                       

         BE    OPEN                                                   

         CLC   PARM1,=CL8'CLOSE'                                      

         BE    CLOSE                                                  

         CLC   PARM1,=CL8'MSG'                                        

         BE    MSG                                                    

         CLC   PARM1,=CL8'SAMGET'                                     

         BE    GET                                                    

         CLC   PARM1,=CL8'SAMSGET'                                    

         BE    SGET                                                   

         CLC   PARM1,=CL8'SAMSOPN'                                    

         BE    SOPN                                                   

         CLC   PARM1,=CL8'SAMSCLS'                                    

         BE    SCLS                                                   

         CLC   PARM1,=CL8'SAMINVL'                                    

         BE    INVL                                                   

         CLC   PARM1,=CL8'SAMOPEN'                                    

         BE    OPEN                                                   

         CLC   PARM1,=CL8'SAMCLOSE'                                   

         BE    CLOSE                                                   

         CLC   PARM1,=CL8'SAMMSG'                                      

         BE    MSG                                                     

         B     ERR1                INVALID FUNCTION CALL               

*---------------------------------------------------------------------*

*        SAMOPEN ROUTINE                                              *

*---------------------------------------------------------------------*

OPEN     CLI   RFRHSAM,C'Y'        IS THIS A FRESH COPY?               

         BE    OPEN1               YES                                 

         DELETE EP=SARSAM          REFRESH SARSAM ON EVERY OPEN        

         LOAD  EP=SARSAM                                               

         ST    R0,ADDRSAM                                              

         ST    R0,SCMTOK                                               

         L     R0,ADDRENVB                                             

         LA    R1,PARMLIST                                             

         L     R15,ADDRENVB        GET ADDRESS OF ENVIRONMENT BLOCK    

         L     R15,ENVBLOCK_IRXEXTE-ENVBLOCK(,R15) ADDR OF EXT VECTOR  

         L     R15,IRXSUBCM-IRXEXTE(,R15) ADDRESS OF IRXSUBCM ROUTINE  

         CALL  (15),(SCMUPDF,SCMSTRA,SCMSTRL,SCMENV),VL,MF=(E,(R1))    

         LTR   R15,R15                                                 

         BZ    OPEN1                                                   

         DC    X'00DEAD'                                               

         DC    AL1(L'ERMSG2)                                           

ERMSG2   DC    C'UNABLE TO UPDATE SARSAMRX ENVIRONMENT'                

OPEN1    LA    R1,PARMLIST                                             

         L     R15,ADDRSAM                                             

         OC    PARM2(17),SPACES    CONVERT NAME TO UPPER CASE          

         CALL  (15),(=CL8'SAMOPEN',PARM2,PARM3),VL,MF=(E,(R1))         

         MVC   RETLEN,=A(L'RETRC)  SET RESULT LENGTH                   

         STH   R15,RETRC           SET RESULT RETURN CODE              

         B     EXITPGM                                                 

*---------------------------------------------------------------------*

*        SAMCLOSE ROUTINE                                             *

*---------------------------------------------------------------------*

CLOSE    LA    R1,PARMLIST                                             

         L     R15,ADDRSAM                                             

         CALL  (15),(=CL8'SAMCLOSE'),VL,MF=(E,(R1))                    

         MVC   RETLEN,=A(L'RETRC)  SET RESULT LENGTH                   

         STH   R15,RETRC           SET RESULT RETURN CODE              

         B     EXITPGM                                                 

*---------------------------------------------------------------------*

*        SAMGET ROUTINE                                               *

*---------------------------------------------------------------------*

GET      DS    0H                                                      

*        LOAD  EP=XDC                                                  

*        XC    PARMLIST(24),PARMLIST                                   

*        ESTAE (R0),MF=(E,PARMLIST)                                    

*        DC    X'00DEAD'                                               

*        DC    AL1(L'ERMSG)                                            

* MSG    DC    C'START GET ROUTINE '                                   

*                                                                      

         L     R1,=V(SARIFK)       LOAD ADDRESS OF KEY LENGTH TABLE    

         SLR   R15,R15             ZERO FOR KEY LENGTH                 

         IC    R15,PARM2           GET FIRST CHARACTER OF KEY          

         IC    R15,0(R1,R15)       GET KEY LENGTH                      

         BCTR  R15,0                                                   

         EX    R15,GETMVC          COPY KEY FIELD                       

*                                                                       

         LA    R1,PARMLIST                                              

         L     R15,ADDRSAM                                              

         CALL  (15),                                                   X

               (=CL8'SAMGET',RETRCD,RCDLEN,PARM3,RETLEN),VL,MF=(E,(R1)) 

         STH   R15,RETRC           SET RESULT RETURN CODE               

         LA    R2,2                SET DEFAULT RECORD LENGTH            

         LTR   R15,R15             NON-ZERO RETURN CODE?                

         BNZ   GETX                YES - IGNORE RECORD LENGTH           

         AH    R2,RETLEN           ADD IN RECORD LENGTH                 

GETX     ST    R2,RETLEN           SET RESULT LENGTH                    

         B     EXITPGM                                                  

GETMVC   MVC   RETRCD(*-*),PARM2   COPY KEY FIELD                       

*---------------------------------------------------------------------* 

*        SAMINVL ROUTINE                                              * 

*---------------------------------------------------------------------* 

INVL     LA    R1,PARMLIST                                              

         L     R15,ADDRSAM                                              

         CALL  (15),(=CL8'SAMINVL'),VL,MF=(E,(R1))                      

         MVC   RETLEN,=A(L'RETRC)  SET RESULT LENGTH                    

         STH   R15,RETRC           SET RESULT RETURN CODE               

         B     EXITPGM                                                  

*---------------------------------------------------------------------* 

*        SAMMSG  ROUTINE                                              * 

*---------------------------------------------------------------------* 

MSG      LA    R1,PARMLIST                                              

         L     R15,ADDRSAM                                              

         CALL  (15),(=CL8'SAMMSG',RETRCD,RCDLEN),VL,MF=(E,(R1))        

         MVC   RETLEN,=A(L'RETRC+133)  RESULT LENGTH                   

         STH   R15,RETRC           SET RESULT RETURN CODE              

         B     EXITPGM                                                 

*---------------------------------------------------------------------*

*        SAMSOPN ROUTINE                                              *

*---------------------------------------------------------------------*

SOPN     LA    R1,PARMLIST                                             

         L     R15,ADDRSAM                                             

         CALL  (15),(=CL8'SAMSOPN',PARM2),VL,MF=(E,(R1))               

         MVC   RETLEN,=A(L'RETRC)  SET RESULT LENGTH                   

         STH   R15,RETRC           SET RESULT RETURN CODE              

         B     EXITPGM                                                 

*---------------------------------------------------------------------*

*        SAMSGET ROUTINE                                              *

*---------------------------------------------------------------------*

SGET     LA    R1,PARMLIST                                             

         L     R15,ADDRSAM                                             

         CALL  (15),(=CL8'SAMSGET',RETRCD,RCDLEN,RETLEN),VL,MF=(E,(R1))

         STH   R15,RETRC           SET RESULT RETURN CODE              

         L     R2,=A(L'RETRC)  SET RESULT LENGTH                       

         AH    R2,RETLEN                                               

         ST    R2,RETLEN                                               

         B     EXITPGM                                                 

*---------------------------------------------------------------------*

*        SAMSCLS ROUTINE                                              *

*---------------------------------------------------------------------*

SCLS     LA    R1,PARMLIST                                             

         L     R15,ADDRSAM                                             

         CALL  (15),(=CL8'SAMSCLS'),VL,MF=(E,(R1))                     

         MVC   RETLEN,=A(L'RETRC)             LENGTH                   

         STH   R15,RETRC           SET RESULT RETURN CODE              

         B     EXITPGM                                                 

*---------------------------------------------------------------------*

*        SAMAOPN ROUTINE                                              *

*---------------------------------------------------------------------*

AOPN     LA    R1,PARMLIST                                             

         L     R15,ADDRSAM                                             

         CALL  (15),(=CL8'SAMAOPN',PARM2),VL,MF=(E,(R1))               

         MVC   RETLEN,=A(L'RETRC)  SET RESULT LENGTH                   

         STH   R15,RETRC           SET RESULT RETURN CODE              

         B     EXITPGM                                                 

*---------------------------------------------------------------------*

*        SAMAGET ROUTINE                                              *

*---------------------------------------------------------------------*

AGET     LA    R1,PARMLIST                                             

         L     R15,ADDRSAM                                             

         CALL  (15),(=CL8'SAMAGET',RETRCD,RCDLEN,RETLEN),VL,MF=(E,(R1))

         STH   R15,RETRC           SET RESULT RETURN CODE              

         L     R2,=A(L'RETRC)  SET RESULT LENGTH                       

         AH    R2,RETLEN                                               

         ST    R2,RETLEN                                               

         B     EXITPGM                                                 

*---------------------------------------------------------------------*

*        SAMACLS ROUTINE                                              *

*---------------------------------------------------------------------*

ACLS     LA    R1,PARMLIST                                             

         L     R15,ADDRSAM                                             

         CALL  (15),(=CL8'SAMACLS'),VL,MF=(E,(R1))                     

         MVC   RETLEN,=A(L'RETRC)             LENGTH                   

         STH   R15,RETRC           SET RESULT RETURN CODE              

         B     EXITPGM                                                 

*---------------------------------------------------------------------*

*        ERROR ROUTINE                                                *

*---------------------------------------------------------------------*

ERR1     MVC   RETLEN,=A(L'RETRC)             LENGTH                   

         MVC   RETRC,=H'99'        SET RESULT RETURN CODE              

         B     EXITPGM                                                 

*---------------------------------------------------------------------*

*        EXIT ROUTINE                                                 *

*---------------------------------------------------------------------*

EXITPGM  EQU   *                                                       

         L     R1,ADDREFPL                                             

         USING EFPL,R1                                                 

         L     R2,EFPLEVAL                                             

         L     R3,0(R2)                                                

         DROP  R1                                                      

         USING EVALBLOCK,R3                                            

         L     R4,EVALBLOCK_EVSIZE                                     

         SLL   R4,3                                                    

         S     R4,=A(EVALBLOCK_EVDATA-EVALBLOCK)                       

         C     R4,RETLEN                                               

         BNL   EXITPGM1                                                

* ALLOCATE A NEW EVAL BLOCK                                            

         MVC   RLTPARMS,RLTMODEL   INITIALIZE DYNAMIC STORAGE          

         L     R15,ADDRENVB        GET ADDRESS OF ENVIRONMENT BLOCK    

         L     R15,ENVBLOCK_IRXEXTE-ENVBLOCK(R15) ADDRESS OF EXT VECTOR

         L     R15,IRXRLT-IRXEXTE(R15) ADDRESS OF IRXRLT ROUTINE       

         MVC   RLTNLEN,RETLEN                                          

         LA    R1,PARMLIST                                             

         CALL  (15),(RLTFUNC,RLTADDR,RLTNLEN),VL,MF=(E,(R1))           

         L     R3,RLTADDR                                              

         ST    R3,0(R2)            SET ADDRESS OF NEW EVAL BLOCK       

EXITPGM1 LH    R15,RETRC           CONVERT RC TO DECIMAL               

         CVD   R15,DWORD                                               

         UNPK  RETRC,DWORD                                             

         OI    RETRC+1,X'F0'                                           

         LA    R0,EVALBLOCK_EVDATA                                     

         L     R1,RETLEN                                               

         ST    R1,EVALBLOCK_EVLEN                                      

         LA    R14,RETRC                                               

         LR    R15,R1                                                  

         MVCL  R0,R14              FILL IN EVAL BLOCK                  

         LR    R1,R13              FREE DYNAMIC STORAGE                

         L     R13,4(,R13)         RESTORE LAST SAVE AREA ADDRESS      

         DROP  R13                                                     

         FREEMAIN R,LV=AREALEN,A=(R1)                                  

         SLR   R15,R15                                                 

         RETURN (14,12),RC=(15)    RETURN TO CALLER                    

*---------------------------------------------------------------------*

*        PROGRAM STORAGE (CONSTANTS)                                  *

*---------------------------------------------------------------------*

SPACES   DC    133C' '                                                 

LOVALUES DC    20X'00'                                                 

HIVALUES DC    20X'FF'                                                 

RCDLEN   DC    AL2(L'RETRCD)                                           

*                                                                      

RLTMODEL DS    0CL16                                                   

         DC    CL8'GETBLOCK'                                           

         DC    F'0'                                                    

         DC    F'0'                                                    

*                                                                      

SCMQRYF  DC    CL8'QUERY'                                              

SCMADDF  DC    CL8'ADD'                                                

SCMUPDF  DC    CL8'UPDATE'                                             

SCMHCET  DC    CL8'SARSAMRX',CL8'SARSAMXX',XL16'00'                    

SCMHCEL  EQU   *-SCMHCET                                               

         LTORG                                                         

*---------------------------------------------------------------------*

*        DYNAMIC STORAGE                                              *

*---------------------------------------------------------------------*

AREA     DSECT                                                         

SAVEAREA DS    9D                                                      

ADDRENVB DS    A                                                       

ADDREFPL DS    A                                                       

ADDRSAM  DS    A                                                       

PARMLIST DS    6F                                                      

DWORD    DS    D                                                       

RFRHSAM  DS    CL1                                                     

*                                                                      

PARMS    DS    0CL(PARMLEN)        INPUT PARAMETERS                    

PARM1    DS    CL8                 ROUTINE NAME                        

PARM2    DS    CL300               OPTION_1                            

PARM3    DS    CL6                 OPTION_2                            

PARMLEN  EQU   *-PARM1                                                 

*                                                                      

         DS    0F                                                      

RLTPARMS DS    0CL16               GET RESULT PARAMETER LIST           

RLTFUNC  DC    CL8'GETBLOCK'                                           

RLTADDR  DC    F'0'                                                    

RLTNLEN  DC    F'0'                                                    

*                                                                      

         DS    0F                                                      

SCMPARMS DS    0CL16               IRXSUBCM PARAMETER LIST             

SCMFUNC  DS    CL8                 FUNCTION                            

SCMSTRA  DS    F                   STRING ADDRESS                      

SCMSTRL  DS    F                   STRING LENGTH                       

SCMSTR   DS    0CL(SCMHCEL)        HOST COMMAND ENV STRING             

SCMENV   DS    CL8                 ENVIRONMENT NAME                    

SCMRTN   DS    CL8                 PROCESSING ROUTINE NAME             

SCMTOK   DS    XL16                USER TOKEN                          

*                                                                      

RETLEN   DS    F                                                       

RETRC    DS    H                                                       

RETRCD   DS    CL32760                                                 

AREALEN  EQU   *-AREA                                                  

*                                                                      

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                                                     

         IRXARGTB                                                     

         IRXENVB                                                      

         IRXEXTE                                                      

         IRXEVALB                                                     

         IRXEFPL                                                      

         END   BEGIN