Manipulate REXX variables from a COBOL program

The IRXEXCOM variable access routine allows COBOL programs to manipulate REXX variables.
 
Documentation for IRXEXCOM  can be found at
https://www.ibm.com/docs/en/zos/2.4.0?topic=services-variable-access-routine-irxexcom
 
For COBOL program to manipulate REXX variables, it must be invoked by a REXX routine.
 
The REXX program presented below calls a COBOL program. This COBOL program retrieves the value of the REXX variable "LEREXX" and displays it. Subsequently, the COBOL program modifies the value of "LEREXX". When control returns to the REXX program, the updated value set by the COBOL program is visible in the REXX program.
 
 
REXX program
 
/* REXX */       
/* CODE FOR REXCOB PROGRAM */                
SAY "THIS IS FROM REXX "          
LEREXX = "VALUE IS SET IN REXX"   
SAY  'LEREXX: ' LEREXX            
SAY 'CALLING COBREXL..'           
"CALL *(COBREXL)"                 
SAY "RC : " RC                    
SAY "BACK FROM COBREXL"           
SAY  'LEREXX: ' LEREXX            
 
Run JCL for the REXX program
 
//STEP10   EXEC PGM=IKJEFT01               
//STEPLIB DD DISP=SHR,DSN=MY.COBOL.LOAD     
//SYSTSPRT DD SYSOUT=*                     
//SYSOUT   DD SYSOUT=*                     
//SYSTSIN  DD   *                          
 EX 'MY.REXX.PDS(REXCOB)'               
/*                                         
 
 
 
Below is the COBOL program
 
VARNAME1V refers to the name of the "REXX" variable to be manipulated.
VARNAME1L refers to the length of the "REXX" variable name.
 
VARVALUE1V refers to the value of the "REXX" variable.
VARVALUE1L refers to length of the "REXX" variable value.
 
SHVBLOCK is the communication area used by IRXEXCOM routine.
 
Function code such "fetch", "store" need to be populated in the SHVCODE of SHVBLOCK before the IRXEXCOM routine call.
 
       ID DIVISION.
       PROGRAM-ID.  COBREXL.
       ENVIRONMENT DIVISION.
       DATA DIVISION.
       WORKING-STORAGE SECTION.
 
      *****************************************************
      * SHARED VARIABLE REQUEST BLOCK
      *****************************************************
       01 SHVBLOCK.
      * CHAIN POINTER TO NEXT SHVBLOCK
          02 SHVNEXT         USAGE POINTER.
      * USED DURING "FETCH NEXT"
      * CONTAINS LENGTH OF BUFFER
      * POINTED TO BY SHVNAMA
          02 SHVUSER         PIC S9(9) BINARY.
          02 SHVCODES.
      * FUNCTION CODE - INDICATES TYPE
             03 SHVCODE      PIC A.
      * RETURN CODES
             03 SHVRET       PIC X.
      * RESERVED (SHOULD BE 0)
          02 PIC             X(2).
      * LENGTH OF FETCH VALUE BUFFER
          02 SHVBUFL         PIC S9(9) BINARY.
      * ADDRESS OF VARIABLE NAME
          02 SHVNAMA         USAGE POINTER.
      * LENGTH OF VARIABLE NAME
      * (SET ON FETCH)
          02 SHVNAML         PIC S9(9) BINARY .
      * ADDRESS OF VALUE BUFFER
          02 SHVVALA         USAGE POINTER.
      * LENGTH OF VALUE BUFFER
          02 SHVVALL         PIC S9(9) BINARY .
 
      * LENGTH OF SHVBLOCK
       77 SHVBLEN            PIC 9(9) BINARY VALUE IS 32.
 
      *******************************************************
      * SHARED VARIABLE REQUEST BLOCK - FUNCTION CODES
      *******************************************************
      * SET VARIABLE FROM GIVEN VALUE
       77 SHVSTORE           PIC A VALUE IS 'S'.
      * COPY VALUE OF VARIABLE TO BUFFER
       77 SHVFETCH           PIC A VALUE IS 'F'.
      * DROP VARIABLE
       77 SHVDROPV           PIC A VALUE IS 'D'.
      * SYMBOLIC NAME SET VARIABLE
       77 SHVSYSET           PIC A VALUE IS 's'.
      * SYMBOLIC NAME FETCH VARIABLE
       77 SHVSYFET           PIC A VALUE IS 'f'.
      * SYMBOLIC NAME DROP VARIABLE
       77 SHVSYDRO           PIC A VALUE IS 'd'.
      * FETCH NEXT VARIABLE
       77 SHVNEXTV           PIC A VALUE IS 'N'.
      * FETCH PRIVATE INFORMATION
       77 SHVPRIV            PIC A VALUE IS 'P'.
 
      **********************************************************
      * SHARED VARIABLE REQUEST BLOCK - RETURN CODES (SHVRET)
      **********************************************************
      * EXECUTION WAS OK
       77 SHVCLEAN           PIC X VALUE IS X'00'.
      * VARIABLE DID NOT EXIST
       77 SHVNEWV            PIC X VALUE IS X'01'.
      * LAST VARIABLE TRANSFERRED ("N")
       77 SHVLVAR            PIC X VALUE IS X'02'.
      * TRUNCATION OCCURRED FOR "FETCH"
       77 SHVTRUNC           PIC X VALUE IS X'04'.
      * INVALID VARIABLE NAME
       77 SHVBADN            PIC X VALUE IS X'08'.
      * INVALID VALUE SPECIFIED
       77 SHVBADV            PIC X VALUE IS X'10'.
      * INVALID FUNCTION CODE (SHVCODE)
       77 SHVBADF            PIC X VALUE IS X'80'.
 
       77 REXXRTN            PIC X(8) VALUE "IRXEXCOM".
       77 REXXRC             PIC S9(9) BINARY.
       77 REXXRTNRC          PIC S9(9) BINARY.
       77 SHVRETB            PIC S9(9) BINARY.
 
       77 NULADDR            PIC 9(9)  BINARY VALUE 0.
 
       01 VARNAME1.
          02 VARNAME1L       PIC 999 VALUE 6.
          02 VARNAME1V       PIC X(250) VALUE 'LEREXX'.
 
       01 VARVALUE1.
          02 VARVALUE1L      PIC 999.
          02 VARVALUE1V      PIC X(250).
 
       PROCEDURE DIVISION.
 
           PERFORM INIT-AREA
           MOVE 250        TO SHVBUFL OF SHVBLOCK.
      * FETCH (DIRECT NOT SYMBOLIC) THE VARIABLE
           MOVE SHVFETCH TO SHVCODE OF SHVBLOCK.
           PERFORM INVOKE-IRXEXCOM
           DISPLAY 'FETCHING LEREXX FROM COBOL: '
           DISPLAY 'LEREXX: ' VARVALUE1V
      * STORE (DIRECT NOT SYMBOLIC) THE VARIABLE
           MOVE 20         TO SHVVALL OF SHVBLOCK.
           MOVE 'VALUE SET IN COBOL..' TO VARVALUE1V
           MOVE SHVSTORE TO SHVCODE OF SHVBLOCK.
           PERFORM INVOKE-IRXEXCOM
           STOP RUN.
 
       INIT-AREA.
 
           INITIALIZE SHVBLOCK REPLACING ALPHANUMERIC BY X'00'.
      * THE VARIABLE NAME
           SET SHVNAMA OF SHVBLOCK TO ADDRESS OF VARNAME1V.
           MOVE VARNAME1L TO SHVNAML OF SHVBLOCK.
      * THE VARIABLE VALUE
           SET SHVVALA OF SHVBLOCK TO ADDRESS OF VARVALUE1V.
 
       INVOKE-IRXEXCOM.
      * CALL THE REXX SERVICE AS A SUBPROGRAM TO SET THE
      * shared variable
           CALL REXXRTN USING REXXRTN ,
           OMITTED , OMITTED ,
           SHVBLOCK ,
           NULADDR , REXXRC
           Returning REXXRTNRC.
      *
           MOVE SHVRET TO SHVRETB
           DISPLAY "REXX RC IS " REXXRC ","
           " IRXEXCOM RC IS " REXXRTNRC ","
           " SHVRET IS " SHVRETB "." .
 
             
 
Output of the REXX routine
 
******************************** Top of Data ***********************************
ACF0C038 ACF2 LOGONID ATTRIBUTES HAVE REPLACED DEFAULT USER ATTRIBUTES         
READY                                                                          
 EX 'MY.REXX.PDS(REXCOB)'                                                   
THIS IS FROM REXX                                                              
LEREXX:  VALUE IS SET IN REXX                                                  
CALLING COBREXL..                                                              
RC :  0                                                                        
BACK FROM COBREXL                                                              
LEREXX:  VALUE SET IN COBOL..                                                  
READY                                                                          
END                                                                            
 ******************************* Bottom of Data ********************************
 
Output of the COBOL program
 
******************************** Top of Data ***********************************
REXX RC IS 000000000, IRXEXCOM RC IS 000000000, SHVRET IS 000000000.           
FETCHING LEREXX FROM COBOL:                                                    
LEREXX: VALUE IS SET IN REXX                                                   
                                                                               
                                                                               
REXX RC IS 000000000, IRXEXCOM RC IS 000000000, SHVRET IS 000000000.           
 ******************************* Bottom of Data ********************************