[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 CATNATE Program

REXX Built-in Function OUTTRAP

ALLOCATE a PDS/PDSE to a DDNAME that already has PDS's allocated to it. Add the new one.

/*REXX catnate                       last mod dec 99
  Use under OS390/MVS TSO
  this will concatenate
    a dataset name to a currently allocated ddname
  install in a REXX or CLIST library/pds
  execute before getting into ISPF
  it needs two arguments passed to it, DDNAME and DATASETNAME
  to execute from TSO line mode or ready mode:
    %CATNATE DDNAME DSNAME
  for example:
    %CATNATE ISPPLIB 'TEST.ISPF.ISPPLIB'

  if you can't execute by previous method:
  EXEC 'userid.REXX.EXEC(SETUP)' 'ISPPLIB ''TEST.ISPF.ISPPLIB'' ' EXEC

  for REXX information, Sample Code, books see

                    http://theamericanprogrammer.com

  
  may be distributed freely provided this entire comment is included

  It is useful when you want to add your library/pds to the
  list of libraries/pds's currently being used in a TSO session
  for example, REXX libraries (ddname SYSEXEC)
               ISPF panel libraries (ddname ISPPLIB)
  If this doesn't work for your REXX library,
  you can use the TSO command
  ALTLIB ACTIVATE APPLICATION(EXEC) DSN(the library/pds)

*/
arg ddname_to_concatenate dsn_to_concatenate
/* initialize */
array_index = 0
array_index_max = 0
final_dsn = "" /*wot you actually allocate. */
first_dsn = "" /*the first lib/pds currently allocated to ddname*/
display_final_allocate_command = "NO" /*chng to YES if desired*/
found_ddname = "NO"
first_time = "YES"

call get_input_if_needed
call validate_input
call validate_environment
call do_listalc
call read_thru_listalc_output
call build_final_dsn
call try_to_allocate
exit /* logical end of program */

get_input_if_needed:
if ddname_to_concatenate = "" then do
   say "Please type in DDNAME to concatenate to"
   pull ddname_to_concatenate
   end
if dsn_to_concatenate = "" then do
   say "Please type in DATASET NAME to concatenate "
   say "complete name, with apostrophes "
   pull dsn_to_concatenate
   end
return /* get_input_if_needed */

validate_input:
if length(ddname_to_concatenate) = 0 then signal ddname_bad
if length(ddname_to_concatenate) > 8 then signal ddname_bad
if datatype(ddname_to_concatenate) = "NUM" then signal ddname_bad
if length(dsn_to_concatenate) = 0 then signal dsn_bad
if length(dsn_to_concatenate) > 44 then signal dsn_bad
if datatype(dsn_to_concatenate) = "NUM" then signal dsn_bad
if sysdsn(dsn_to_concatenate) <> "OK" then do
   say "Unable to use input dataset name" dsn_to_concatenate
   say sysdsn(dsn_to_concatenate)
   signal dsn_bad
   end /* sysdsn bad*/
call listdsi dsn_to_concatenate
if sysdsorg <> "PO" then do
  say "desired dataset" dsn_to_concatenate "must be a library/pds"
  signal not_a_pds
  end
call check_likely_ispf_ddname
return /* validate input*/

validate_environment:
if address() <> "TSO" then signal not_on_tso
if sysvar(sysispf) = "ACTIVE" ,
   & likely_ispf_ddname = "YES" then do
   say "Warning, ISPF has started. "
   say "may not be able to concatenate as requested"
   say "because ISPF has already allocated and it is impossible"
   say "to free and reallocate"
   end /* give warning*/
return /* validate environment */

do_listalc:
call outtrap "line.", "*"
"LISTALC STATUS"
call outtrap "OFF"
return /* do listalc */

read_thru_listalc_output:
do i = 1 to line.0
  temp_ddname = substr(line.i,3,8)/*if LISTALC changes, this may too*/
  if temp_ddname = ddname_to_concatenate then do
    found_ddname = "YES"
    call load_array
    call have_found_ddname
    leave
    end /* found */
end /* do loop*/
return /* read thru listalc output */

have_found_ddname:
do i = i + 1 to line.0
  /*if LISTALC changes, this may too*/
  if substr(line.i,1,2) == "  ",
    & substr(line.i,3,1) == " " then leave i /* new ddname */
  call load_array
end i
return /* found ddname */

load_array:
i_minus_1 = i - 1
/*if LISTALC changes, this may too*/
if substr(line.i_minus_1,1,2) == "  "  then do/*only if dsn*/
   array_index = array_index + 1
   array_index_max = array_index
   array.array_index = substr(line.i_minus_1,1,44)
   array.array_index = space(array.array_index,0)/*drop spaces*/
   call save_first_dsn array.array_index
   end
return

build_final_dsn:
do i3 = 1 to array_index_max
  final_dsn = final_dsn "'"array.i3"'"
end i3
return /* build_final_dsn */

save_first_dsn:
arg dsn_passed
if first_time = "NO" then NOP
else do /*first time */
  first_time = "NO"
  first_dsn = "'"dsn_passed"'"
  end /* else*/
return /* save_first_dsn */

try_to_allocate: /* think positive!*/
call check_attributes
if found_ddname <> "YES" then signal ddname_not_in_use
if first_dsn = "" then signal no_dsns
if pos(dsn_to_concatenate,final_dsn) > 0 then signal already_allocated
call msg "on"
if display_final_allocate_command = "YES" then
  say,
  "allocate ddname("ddname_to_concatenate") shr reuse",
    "dsname("dsn_to_concatenate  ,
     final_dsn ")"

"allocate ddname("ddname_to_concatenate") shr reuse",
  "dsname("dsn_to_concatenate  ,
   final_dsn ")"
if rc > 0 then signal cannot_concatenate
if rc = 0 then say "concatenation successful",
               ddname_to_concatenate dsn_to_concatenate
return /* try to allocate */

check_attributes:
call listdsi dsn_to_concatenate
save_sysrecfm = sysrecfm;save_sysblksize = sysblksize
call listdsi first_dsn
if save_sysrecfm <> sysrecfm then do
  say "Possible record format incompatiblity, depending on MVS level"
  say "desired dataset has" save_sysrecfm
  say "currently allocated dataset has" sysrecfm
end
if save_sysblksize <> sysblksize then do
  say "Possible blocksize incompatiblity, depending on MVS level"
  say "desired dataset has" save_sysblksize
  say "currently allocated dataset has" sysblksize
end
return /* check attributes*/

check_likely_ispf_ddname:
if ddname_to_concatenate = "ISPPLIB" then likely_ispf_ddname = "YES"
if ddname_to_concatenate = "ISPSLIB" then likely_ispf_ddname = "YES"
if ddname_to_concatenate = "ISPMLIB" then likely_ispf_ddname = "YES"
if ddname_to_concatenate = "ISPLLIB" then likely_ispf_ddname = "YES"
if ddname_to_concatenate = "ISPTLIB" then likely_ispf_ddname = "YES"
if ddname_to_concatenate = "ISPTABL" then likely_ispf_ddname = "YES"
if ddname_to_concatenate = "ISPLLIB" then likely_ispf_ddname = "YES"
return /*check_likely_ispf_ddname*/

ddname_bad:
say "The ddname supplied," ddname_to_concatenate
say "is unusable. ddname must be 1 - 8 characters,"
say "first is a letter, rest letters or numbers"
say "no action taken"
exit

dsn_bad:
say "The dataset name supplied," dsn_to_concatenate
say "is unusable. dsn must be 1 - 44 characters,"
say "and actually exist"
say "no action taken"
exit

no_dsns:
say "There are currently no datasets allocated to"
say "the ddname " ddname_to_concatenate
say "no action taken"
exit

ddname_not_in_use:
say "The ddname " ddname_to_concatenate
say "is not currently being used. Concatenation impossible"
say "no action taken"
exit

not_a_pds:
say "The dataset name supplied," dsn_to_concatenate
say "is not a library/pds"
say "no action taken"
exit

not_on_tso:
say "This REXX program will work only on OS390 TSO"
say "no action taken"
exit
/*** 
    may be freely distributed
    provided that this notice is attached.
    See
    http://theamericanprogrammer.com
    I am an independant consultant and trainer.
    For information visit the site
***/

already_allocated:
say "The dataset name supplied," dsn_to_concatenate
say "is already concatenated as requested. no action taken"
exit

free_failed:
say "The ddname supplied," ddname_to_concatenate
say "cannot be freed and reused"
say "is may be currently open and in use by a program"
say "or not currently in use by your TSO session "
say "concatenation is not possible"
say "no action taken"
exit

cannot_concatenate:
say "The dataset name supplied," dsn_to_concatenate
say "and the the ddname supplied," ddname_to_concatenate
say "have not been concatenated as requested"
say "Possible reasons:"
say "  The ddname was specified in the TSO logon procedure"
say "  ISPF has started and it is impossible to free and reallocate"
say "    files that ISPF is using"
say "  A program is currently using the requested DDNAME or DSN"
say "    and the file is open"
say "no action taken"
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 |