In essence, I've not used this since about forever, but when we, as in I,
decided we needed to start using parametrized procs at Willis around the
Y2K  time, and people were frustrated by not being able to see the wood
from the trees, I very quickly knocked up the code below, I have no clue if
it's still working, but we used it in SDSF on the JCL of TYPRUN=SCAN
submitted jobs, to get rid of all the IEF653I messages. Feel free to play
around with it, if you see to improve it, please share your code, and if
you don't like GPL'ed code, though!

Robert

/* REXX edit macro to clean up JCL                                    */
/*** trace ?r ***************************************************** \| *
*               (C) Copyright Robert AH Prins, 1995-2015               *
************************************************************************
*  ------------------------------------------------------------------  *
* | Date       | By   | Remarks                                      | *
* |------------+------+----------------------------------------------| *
* |            |      |                                              | *
* |------------+------+----------------------------------------------| *
* | 2015-12-28 | RAHP | Add routine to find SET symbols              | *
* |------------+------+----------------------------------------------| *
* | 2001-06-04 | RAHP | New version of SDSF (column changes)         | *
* |------------+------+----------------------------------------------| *
* | 1997-05-16 | RAHP | Cater for just one parameter on proc         | *
* |------------+------+----------------------------------------------| *
* | 1995-04-06 | RAHP | Initial version                              | *
* |------------+------+----------------------------------------------| *
************************************************************************
* EUNSUB is a REXX edit macro to remove IEFC653I substitution          *
* messages from submitted JCL.                                         *
************************************************************************
* Send questions, suggestions and/or bug reports to:                   *
*                                                                      *
* [email protected] / [email protected]                         *
*                                                                      *
* Robert AH Prins                                                      *
* Ozkiniu gatve 48                                                     *
* Vilnius 08405                                                        *
* Lithuania                                                            *
************************************************************************
* This program is free software: you can redistribute it and/or        *
* modify it under the terms of the GNU General Public License as       *
* published by the Free Software Foundation, either version 3 of       *
* the License, or (at your option) any later version.                  *
*                                                                      *
* This program is distributed in the hope that it will be useful,      *
* but WITHOUT ANY WARRANTY; without even the implied warranty of       *
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the         *
* GNU General Public License for more details.                         *
*                                                                      *
* You should have received a copy of the GNU General Public License    *
* along with this program. If not, see <http://www.gnu.org/licenses/>  *
***********************************************************************/
"ISREDIT MACRO (PARM)"
parm  = translate(parm)
/*
signal get_set
exit
*/

"isredit (L) = line 1"
if pos(' JOB ', l) = 0 then
  exit 1

p = pos('//', l)

numeric digits 32

iefc653i= 'IEFC653I'

lin = right('//', p + 1)
"isredit line_after .zl = (LIN)"

"isredit x 'EXEC PGM=' all"
"isredit x '*' all" p + 2

"isredit f ' EXEC ' first nx"
do while rc = 0
  "isredit LABEL .zcsr = .EF 0"
  "isredit (EF) = linenum .EF"
  "isredit f ' EXEC ' next nx"

  if rc = 0 then
    "isredit LABEL .zcsr = .EL 0"
  else
    "isredit LABEL .zl   = .EL 0"

  "isredit (EL) = linenum .EL"

  "isredit (EXEC) = line .EF"

  parse value exec with '//' . 'EXEC ' proc ',' .
  if length(proc) > 8 then
    parse value exec with '//' . 'EXEC ' proc ' ' .

  "isredit f 'XX"proc"' .EF .EL first"
  "isredit LABEL .zcsr = .EP 0"
  "isredit (EP) = linenum .EP"

  if ep - ef > 1 then
    rc = process(+ef + 1, +ep - 1)

  "isredit f p'^'" p + 2 ".EP .EL first"
  "isredit f p'^'" p + 2 ".EP .EL next"
  "isredit LABEL .zcsr = .EE 0"
  "isredit (EE) = linenum .EE"

  if ee - ep >= 1 then
    rc = process(+ep, +ee - 1)

  call delete_iefc653i

  "isredit f ' EXEC ' first nx .EL .ZL"
end

"isredit reset"
exit

/***********************************************************************
* SUBSTITUTE:                                                          *
*                                                                      *
* Perform changes required by parameters on the EXEC & PROC statements *
***********************************************************************/
substitute:
  "isredit (CR) = line" i
  cr = substr(cr, p + 15)
  j  = pos(',  ', cr)
  if j = 0 then
    j = pos('   ', cr)

  cr = substr(cr, 1, j - 1)

  parse value cr with var '=' value

  if var \= '' then
    do
      from = c2x('&'var'.')
      to   = strip(value,,'''')

      "isredit c x'"from"' '"to"' .EF .EL all"

      from = c2x('&'var)

      "isredit c x'"from"' '"to"' .EF .EL all"
    end
return

/***********************************************************************
* PROCESS:                                                             *
*                                                                      *
* Process the lines containing the parameters                          *
***********************************************************************/
process:
  arg !s, !e

  do i = !s to !e
    "isredit (S) = xstatus" i

    if s \= 'X' then
      call substitute
    end
return 0

/***********************************************************************
* GET_SET:                                                             *
*                                                                      *
* Extract all SET var=value statements                                 *
***********************************************************************/
get_set:
  "isredit (ZL) = linenum .zl"

  var. = 0

  do i = 1 to +zl
    "isredit (L) = line" i

    l = substr(l, 13, 72)

    p = pos(' SET ', l, pos(' ', l))

    if p \= 0 then
      do
        vars = strip(substr(l, p + 5), 'L')' '
        do until left(vars, 1) = ' '
          parse value var.0 + 1 vars with $ var.$ '=' val.$ 1 var.0 .

          s = left(val.$, 1)
          p = 1

          select
            when s = '(' then
              do
                op = 1

                do p = 2 by 1 to length(val.$) until op = 0
                  select
                    when substr(val.$, p, 1) = '(' then op = op + 1
                    when substr(val.$, p, 1) = ')' then op = op - 1
                    otherwise
                  end
                end

                vars  = substr(val.$, p + 1)
                val.$ = left(val.$, p)
say left(var.$, 10) val.$
              end

            when s = '''' then
              do
                src = val.$ '*'

                drop t.
                t = 1

                do until src = '' | left(src, 1) \= "'"
                  parse value src with pre "'" text "'" src

                  if src \= '' then
                    do
                      t.t = text
                      t   = t + 1
                    end
                end

                val = ''
                do !=1 to t-1
                  val = val || "'" || t.! || "'"
                end
                vars  = substr(val.$, length(val) + 1)
                val.$ = val
say left(var.$, 10) val.$
              end

            otherwise
              do
                parse value vars with . '=' val.$ ' ' vars
say left(var.$, 10) val.$
              end
          end
          if left(vars, 1) = ',' then
            vars = substr(vars, 2)

          if right(val.$, 1) = ',' then
            do
              val.$ = strip(val.$,, ',')

              i     = i + 1
              "isredit (L) = line" i
              vars = strip(substr(l, 13), 'L')
            end


        end
      end
  end
return 0

/***********************************************************************
* DELETE_IEFC653I:                                                     *
*                                                                      *
* Delete all 'IEF653I' messages for this procedure                     *
***********************************************************************/
delete_iefc653i:
  "isredit f '"iefc653i"' .EE .EL first"

  do while rc = 0
    "isredit (FI) = linenum .zcsr"
    "isredit f 'XX'" p "next .EE .EL"
    "isredit (LI) = linenum .zcsr"
    "isredit delete" fi li - 1 "all"
    "isredit f '"iefc653i"' .EE .EL first"
  end
return

And yes, it requires, IIRC, nice parameters on procs and the invocation of
procs and on set statements, so one per line. And no, it was a Q&D hack, so
error-checking is non-existent, expect to invoke it lots of times after
uncommenting the "trace ?r" or by preceding it with "EXECUTIL TS"

Enjoy,

Robert

On Fri, 4 Aug 2023 at 11:04, Seymour J Metz <[email protected]> wrote:

> Back in the bad old days, IBM showed the expansion immediately after the
> JCL. Alas, in MVS they chose to show it as a message in a separate JES
> dataset. Have they moved IEF653I to be inline since then?
>
>
> --
> Shmuel (Seymour J.) Metz
> http://mason.gmu.edu/~smetz3
>
> ________________________________________
> From: IBM Mainframe Discussion List [[email protected]] on behalf
> of Paul Gilmartin [[email protected]]
> Sent: Friday, August 4, 2023 12:02 AM
> To: [email protected]
> Subject: Re: Accessing JCL SETs in Rexx
>
> On Fri, 4 Aug 2023 03:32:01 +0000, Jon Perryman wrote:
>
> > > On Thursday, August 3, 2023 at 12:21:34 PM PDT, David Spiegel  wrote:
> >> My intention is to read a Job and make sure that all datasets are
> available,
> >> but, the dsnames contain SET variables.
> >
> >The converter / interpreter will resolve variables. Submit the job with
> typerun scan or hold should generate the information you want.
> >
> I've found SCAN to be almost worthless.  It doesn't always report invalid
> data set names.
>
> >If you're not comfortable with control blocks, IPCS and dumps, then you
> can use SDSF to extract the converted JCL albeit a little funky to process.
> >
> Is there a JES data set accessible by SDSF that shows symbols resolved?
> what does it show if symbol resolution extends a line beyond column 71?
>
> In  fact, any continuation that splits a data set name can be "a little
> funky
> to process."
>
> --
> gil
>
> ----------------------------------------------------------------------
> For IBM-MAIN subscribe / signoff / archive access instructions,
> send email to [email protected] with the message: INFO IBM-MAIN
>
> ----------------------------------------------------------------------
> For IBM-MAIN subscribe / signoff / archive access instructions,
> send email to [email protected] with the message: INFO IBM-MAIN
>


-- 
Robert AH Prins
robert(a)prino(d)org
The hitchhiking grandfather <https://prino.neocities.org/index.html>
Some REXX code for use on z/OS
<https://prino.neocities.org/zOS/zOS-Tools.html>

----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions,
send email to [email protected] with the message: INFO IBM-MAIN

Reply via email to