[USflag] The American Programmer [USflag]


Home
Books on Mainframe Programming
Mainframe Manuals and Tutorials
System Abend codes, Sqlcodes, VSAM/QSAM codes
Everything about the IBM AS/400 Midrange Computer - iSeries
Everything about CICS
Everything about COBOL
Everything about DB2 and SQL
Everything about IMS
Everything about Java and JavaScript
Everything about JCL and JES
Everything about REXX
  Sorting in REXX: The Bubble Sort
  REXX Password Generator
  Using REXX to capture displayed output of TSO command
  Count records in REXX
  REXX program to calculate present value of money
  REXX function to format a number in currency format
  REXX function to produce a fixed-length number
  REXX program to produce lottery numbers
  REXX: what does your phone number spell?
  REXX Practice Problems.
  Just Enough REXX Tutorial
  Setting up to Execute REXX Programs on TSO/ISPF
  How to execute a REXX program
  REXX Boolean operators
  Comparison of CLIST language and REXX
  REXX Comparison operators
  REXX Debugging: the TRACE verb
  Using REXX OUTTRAP
  Reserved REXX Variables
  Executing REXX through JCL.
  Writing ISPF Edit Macros in REXX
  REXX program to unload a PDS
  REXX book: The REXX Language on TSO
  REXX Functions Book
  QMF Procedures Written in REXX
  Using REXX Subroutines with the QMF Calc panel
  REXX error codes (RC)
  REXX programming language manuals
  Books on REXX programming
  The REXX Files
Everything about zOS, VSAM, Tivoli, Assembler
Everything about TSO, ISPF, Spufi
Site Map and Site Search

           Home   > REXX   > REXX Examples

REXX Example Programs, Macros, and Functions

These examples are all found in the book The REXX Language on TSO. They are explained in the book. You will find them in Chapter 21. Scroll down, or follow the links.

You can also find them on the CBT Tape, Scroll down to File # 911.
This opens a Windows Explorer window containing the above file, unzipped. You will see the file FILE911.XMI. From your Windows machine, upload to the mainframe as BINARY.
Then use the TSO command RECEIVE INDATASET(FILE911.XMI) when it prompts you with "enter upload parameters",
enter the name of the PDS you wish to copy this to. by typing in, for example DATASET(name-of-PDS-you-want)


1. STQUICK Program 
2. CANJOB Program 
3. SUBJCL1 Program		
4. SUBJCL2 Program 		
5. SUBJCL3 Program 		
6. UPDTMEMB Program 
7. CONTAINS Function
8. EQWILD Function		
9. $HIDEALL Macro 		



**** STQUICK REXX Program. ****

/*REXX STQUICK                                                 
 COUNT AND STATUS OF JOBS SUBMITTED BY YOU                     
*/                                                             
CALL OUTTRAP "LINE.","*"                                       
"STATUS"                                                       
CALL OUTTRAP "OFF"                                             
                                                               
EXECUTING_CTR = 0                                              
WAIT_CTR      = 0                                              
OUTPUT_CTR    = 0                                              
                                                               
DO I = 1 TO LINE.0                               
   IF POS("NO JOBS FOUND",LINE.I) > 0            
   THEN                                          
     DO                                          
       SAY "YOU HAVE NO JOBS IN THE SYSTEM NOW"  
       EXIT                                      
     END                                         
END I                                            
                                                 
DO I = 1 TO LINE.0                               
   IF POS("EXECUTING",LINE.I) > 0                
      THEN EXECUTING_CTR =   EXECUTING_CTR + 1   
   IF POS("OUTPUT QUEUE",LINE.I) > 0             
      THEN OUTPUT_CTR =      OUTPUT_CTR    + 1  
   IF POS("WAITING FOR",LINE.I) > 0              
      THEN WAIT_CTR =        WAIT_CTR      + 1   
END I                                            
                                                 
SAY "EXECUTING"             EXECUTING_CTR      
SAY "ON OUTPUT QUEUE"       OUTPUT_CTR       
SAY "WAITING FOR EXECUTION" WAIT_CTR            


Top of Page
**** CANJOB REXX Program. ****

/* REXX NAME: CANJOB                                             
                                                                 
   PURPOSE: DOES A STATUS, THEN ASKS YOU FOR JOB SUFFIX,         
            AND JES JOB NUMBER                                   
            THEN CANCELS THE JOB WITH A PURGE                    
                                                                 
   USE: %CANJOB                                                  
        THEN REPLY WITH JOB SUFFIX,                              
        I.E. LETTER/NUMBER APPENDED TO YOUR USERID ON JOB NAME   
        AND JES JOB NUMBER, NUMERIC PART ONLY                    
                                                                 
        FOR EXAMPLE:                                             
                                                                 
         %CANJOB                                                 
         - MESSAGE APPEARS: TSOU01A(JOB01234) EXECUTING          
         A   1234                                                
*/                                                               
"STATUS"                                                
 SAY "TO CANCEL ONE OF YOUR JOBS,"                       
 SAY "- TYPE IN:"                                        
 SAY "- JOB SUFFIX     JES JOB NUMBER "                  
 SAY "- EXAMPLE:     P  1234 "                           
 SAY                                                     
 PULL SUFFIX NUMBER                                      
 IF SUFFIX = ""                                          
 THEN                                                    
    DO                                                   
      SAY "NEED JOB SUFFIX AND JOB NUMBER, NO COMMAS"    
      EXIT                                               
    END                                                  
 IF SUFFIX = "" THEN EXIT                                
 IF SUFFIX = "STOP"  THEN EXIT                           
                                                
TRACE C      

                                            
"CANCEL" USERID() || SUFFIX || "(JOB" || NUMBER"), PURGE"
/* ALTERNATIVELY, YOU COULD HAVE DONE IT THIS WAY:       
"CANCEL" USERID()""SUFFIX"(JOB"NUMBER"), PURGE"          
*/


Top of Page
**** SUBJCL1 REXX Program. ****

/* REXX SUBJCL1
   SUBMITTING JCL FOR BATCH PROCESSING.
   INSERTING VARIABLE VALUES INTO THE JCL
   USING THE INTERNAL DATA QUEUE

   QUEUE LINES OF JCL, THEN WRITE TO A FILE
   FROM THE DATA QUEUE.
   SUBMIT THE FILE, THEN DELETE IT
*/

TEMP_FILE_NAME = "'userid.TEMP.SUBMIT.CNTL'"
PROGRAM_TO_EXECUTE = "MYPROG1"

CALL MSG "OFF"
"DELETE" TEMP_FILE_NAME
CALL MSG "ON"

SIGNAL ON ERROR
"ALLOC DDN(TEMPFILE) NEW REUSE DSN("TEMP_FILE_NAME")",
   "SPACE(3,1) TRACKS"
SIGNAL OFF ERROR

"NEWSTACK"
QUEUE "//useridA  JOB (0),'TSO USER',"
QUEUE "//         TYPRUN=SCAN,  "
QUEUE "//         MSGLEVEL=1,CLASS=A,NOTIFY=userid"
QUEUE "//STEP1    EXEC PGM="PROGRAM_TO_EXECUTE
QUEUE "//INFILE   DD DSN=userid.INPUT.FILE,DISP=SHR "
QUEUE "//OUTFILE  DD SYSOUT=A "
QUEUE "//SYSIN    DD * "
QUEUE DATE() TIME()
QUEUE "/*"


"EXECIO" QUEUED() "DISKW TEMPFILE (FINIS)"
"DELSTACK"
"FREE DDNAME(TEMPFILE)"
"SUBMIT" TEMP_FILE_NAME
CALL MSG "OFF"
"DELETE" TEMP_FILE_NAME
CALL MSG "ON"
EXIT

ERROR:
SAY "UNABLE TO ALLOCATE TEMPORARY FILE" TEMP_FILE_NAME
SAY "TERMINATING"
EXIT


Top of Page
**** SUBJCL2 REXX Program. ****

/* rexx subjcl2
   submitting JCL for batch processing.
   Inserting variable values into the JCL
   using a compound, or stem variable

   place lines of jcl into the stem variable
   write the file,
   submit the file, then delete it
*/

Temp_file_name = "'userid.TEMP.SUBMIT.CNTL'"
Program_to_execute = "MYPROG1"

call msg "off"
"delete" Temp_file_name
call msg "on"

signal on error
"alloc ddn(tempfile) new reuse dsn("Temp_file_name")",
   "space(3,1) tracks"
signal off error

line_counter = 0
call add_line_to_array,
     "//useridA JOB (0),'TSO USER',"
call add_line_to_array,
     "//         TYPRUN=SCAN,  "
call add_line_to_array,
     "//         MSGLEVEL=1,CLASS=A,NOTIFY=userid"
call add_line_to_array,
     "//STEP1    EXEC PGM="PROGRAM_TO_EXECUTE
call add_line_to_array,
     "//INFILE   DD DSN=userid.INPUT.FILE,DISP=SHR "
call add_line_to_array,
     "//OUTFILE  DD SYSOUT=A "
call add_line_to_array,
     "//SYSIN    DD * "
call add_line_to_array,
     DATE() TIME()
call add_line_to_array,     
     "/*"

/* display contents of stem variable */
do i = 1 to line.0
   say line.i
end i

"execio" line.0   "diskw tempfile (stem line. finis)"

"free ddname(tempfile)"

"submit" Temp_file_name

call msg "off"
"delete" Temp_file_name
call msg "on"
exit

error:
say "Unable to allocate temporary file" Temp_file_name
say "terminating"
exit

add_line_to_array:
arg line_to_add
line_counter      = line_counter + 1
line.0            = line_counter
line.line_counter = line_to_add
return


Top of Page
**** SUBJCL3 REXX Program. ****

/* REXX SUBJCL3
   SUBMITTING JCL FOR BATCH PROCESSING.
   INSERTING VARIABLE VALUES INTO THE JCL.
   USING THE TSO LINE MODE EDITOR TO CREATE
   A TEMPORARY FILE, SUBMIT IT,
   AND EXIT WITHOUT SAVING IT
*/
/* TRACE C  */
TEMP_FILE_NAME = "'userid.TEMP.SUBMIT.CNTL'"
PROGRAM_TO_EXECUTE = "MYPROG1"
JCL_DELIMITER = "/*"

/* DELETE, IF IT EXISTS. IT'S A TEMP FILE.

   YOU SHOULD HAVE NOTHING GOOD IN A TEMP FILE. GOODBYE.
*/
CALL MSG "OFF"
"DELETE" TEMP_FILE_NAME
CALL MSG "ON"

"ALLOCATE DSN("TEMP_FILE_NAME") NEW REUSE TRACKS",
   "SPACE(3,1) LRECL(80) RECFM(F,B) BLKSIZE(8000)"

QUEUE "//useridA JOB (0),'TSO USER',"
QUEUE "//         TYPRUN=SCAN,  "
QUEUE "//         MSGLEVEL=1,CLASS=A,NOTIFY=USERID"
QUEUE "//STEP1    EXEC PGM="PROGRAM_TO_EXECUTE
QUEUE "//INFILE   DD DSN=USERID.INPUT.FILE,DISP=SHR "
QUEUE "//OUTFILE  DD SYSOUT=A "
QUEUE "//SYSIN    DD * "
QUEUE DATE() TIME()
QUEUE JCL_DELIMITER
QUEUE "" /* NULL LINE EXITS INPUT MODE */
QUEUE "TOP"
QUEUE "LIST"
QUEUE "SUBMIT"
QUEUE "END NOSAVE"
"EDIT" TEMP_FILE_NAME "CNTL OLD NONUM"
"STATUS"


Top of Page
**** UPDTMEMB REXX Program. ****

/* REXX UPDTMEMB
   OBTAIN MEMBER INFORMATION ABOUT A PDS,
   UPDATE A MEMBER IN THAT PDS NAMED ##INFO
   WITH THAT INFORMATION.
   1 PARAMETER REQUIRED TO BE ENTERED ON THE COMMAND LINE:
   PDS
   IF IT IS NOT ENTERED ON THE COMMAND LINE,
   THE PROGRAM WILL ASK FOR IT.
*/

ARG PDS .
DEBUG = "NO"                    /* YES OR NO */

IF PDS = "" THEN CALL GET_INPUT  /* NO ARG, ASK FOR INFO */

/* INITIALIZE VARIABLES */
MEMBER_NAME = "##INFO"

/* VERIFY PDS */
RET_CODE = LISTDSI(PDS)
IF RET_CODE <> 0 THEN SIGNAL BAD_DSN

IF SYSDSORG <> "PO" THEN SIGNAL NOT_PDS

/* BUILD FULL DSN + MEMBER NAME
   LISTDSI RETURNS THE FULL NAME OF THE PDS
   IN THE RESERVED VARIABLE SYSDSNAME
*/
PDS_AND_MEMB = "'"SYSDSNAME"("##INFO")'"
IF DEBUG = "YES" THEN SAY "FULL NAME IS " PDS_AND_MEMB

/* CAPTURE OUTPUT OF LISTDS */
CALL OUTTRAP "LINE.","*"

"LISTDS" PDS
CALL OUTTRAP "OFF"
IF DEBUG = "YES" THEN CALL DISPLAY_LINE_ARRAY

WRITE_TO_FILE:
IF DEBUG = "YES" THEN TRACE C
"ALLOCATE DDNAME(OUT) DSNAME("PDS_AND_MEMB") SHR REUSE"
IF DEBUG = "YES" THEN SAY "GOING TO WRITE " LINE.0 " RECORDS"

"EXECIO " LINE.0 "DISKW OUT (STEM LINE. FINIS)"
IF RC = 0 | RC = 1 THEN SAY "MEMBER CREATED SUCCESSFULLY"
ELSE SAY "MEMBER CREATION FAILED"
IF DEBUG = "YES" THEN SAY "RETURN CODE FROM EXECIO " RC
"FREE     DDNAME(OUT)"
RETURN

GET_INPUT:
   SAY "ENTER THE NAME OF A PDS, STANDARD TSO NAMING CONVENTIONS"
   SAY "INFORMATION ABOUT THE PDS WILL BE COLLECTED"
   SAY "AND INSERTED INTO THE PDS IN MEMBER NAME ##STATS"
   PULL PDS
   IF PDS  = "" THEN DO
      SAY "NOTHING ENTERED, ENDING"
      EXIT
      END /* NO PDS  SECOND TIME */

RETURN

DISPLAY_LINE_ARRAY:
DO I = 1 TO LINE.0
   SAY "TRAPPED LISTD" I LINE.I
END I
RETURN

BAD_DSN:
SAY "DATASET NAME ENTERED DOES NOT EXIST" PDS
EXIT

NOT_PDS:
SAY "DATASET NAME ENTERED IS NOT A PDS" PDS
EXIT


Top of Page
**** CONTAINS REXX Function. ****
/* REXX CONTAINS
A REXX internal function that tells you if the first argument
is contained in the second.

If you wish to use it as an external function 
	you need to delete the instruction:
CONTAINS: PROCEDURE 

It is executed this way, as an example: (in another program!)
Haystack = "Hello!"
Needle = "!"
If contains(needle,haystack) = 1 then say "OK"
else say "Must contain exclamation (!) character" 

say contains("cat","reallocate") gives 1
say contains("cat","kate")       gives 0
say contains("cat")              gives -1
*/
CONTAINS: PROCEDURE 


if arg()              < 2 then return -1   /* 2 args required */
if pos(arg(1),arg(2)) > 0 then return 1
return 0


Top of Page
**** EQWILD function. ****

/* REXX EQWILD 
This is an internal function that does a comparison, 
with a wild card character.
The wild card character is always equal to 
the corresponding character in the input strings.
Comparison is done character by character. 
Both strings must be of the same length.
The default wild character is the underscore: (_).
It is used like this:
if eqwild("JO_N", "JOAN", "_")                              
     then say "equal"                                       
     else say "not equal"                                   
The first input string may contain the wild card character. 
*/
EQWILD: PROCEDURE
arg string1, string2, char1_wild .
call validate
if char1_wild = "" then char1_wild = "_"

string1 = strip(string1,b) /* drop lead + trail blanks */
string2 = strip(string2,b)

if length(string1) <> length(string2) then return 0
do i = 1 to length(string1)
   if substr(string1,i,1) = char1_wild then nop
   else if substr(string1,i,1) <> substr(string2,i,1)
   then do
          return 0 /* not equal*/
        end
end i
return 1 /* equal */

validate:
parse source . how_called .
if how_called = "COMMAND" then do                        
   say 'this is a function'                              
   say 'it may not be called from the command line'      
   say 'call it from another REXX program:'              
   say '   if eqwild("JO_N", "JOAN", "_")'               
   say '      then say "equal"'                          
   say '      else say "not equal"'                      
   exit -1 /* give -1 to TSO,                            
         since program was called from command line */   
   end                                                   
return /* was called properly */


Top of Page
**** $HIDEALL macro. ****

/* REXX $hideall
A macro for the TSO/ISPF editor.
Used within a TSO/ISPF edit session.
It excludes (hides) all lines of the file which
contain a specific character string.

To use, within a TSO/ISPF edit session,
type $HIDEALL character-string on the command line.
Example:
$HIDEALL DSN=
*/
ADDRESS ISREDIT                                     
"MACRO (PARM1)"                                     

IF RC > 0 THEN SIGNAL NOT_AS_A_MACRO                
IF PARM1 = "" THEN EXIT                             
ADDRESS ISREDIT "EXCLUDE ALL"                       
ADDRESS ISREDIT "FIND ALL '"PARM1"'"                
ADDRESS ISREDIT "FLIP "                             
EXIT /* NORMAL END OF PROGRAM */                    

NOT_AS_A_MACRO:                                     
SAY "THIS IS A TSO/ISPF EDITOR MACRO"               
SAY "IT MAY BE EXECUTED ONLY IN THE ISPF EDITOR"       
SAY "BY TYPING $HIDEALL char-string ON THE COMMAND LINE"   
EXIT                                                




[Books Computer]

Home Books for Computer Professionals Privacy Terms |
Site Map and Site Search Programming Manuals and Tutorials The REXX Files Top of Page |