/* REXX */
/* CLS2REXXed by UMLA01S on 6 Feb 2026 at 14:24:53  */
/*trace r?*/
Signal On NoValue
Call On Error
Signal On Failure
Signal On Syntax
Parse source opsys . exec_name .
Address ISREDIT
 
"MACRO"             /* CATM0401 EDIT TEMP3 */
/*********************************************************************/
/* 06/16/2004 JL Nelson Added EXIT CODE                              */
/* 07/08/2004 JL Nelson Added quotes to WHOHAS - CORRECT OUTPUT      */
/* 07/20/2004 JL Nelson Added whoami to get return code of zero.     */
/* 10/26/2004 JL Nelson Shift ID DSNAME (left blank for expansion).  */
/* 11/30/2004 JL Nelson Changed to use CACM042T for table TBLMBR.    */
/* 02/08/2005 JL Nelson Changed constants to variables before        */
/*            rename.                                                */
/* 06/01/2005 JL Nelson Changed DSN truncation to avoid 860 errors.  */
/* 06/08/2005 JL Nelson Pass MAXCC in ZISPFRC variable.              */
/* 06/15/2005 JL Nelson Set return code to end job step.             */
/* 03/15/2006 JL Nelson Made changes to avoid SUBSTR abend 920/932.  */
/* 03/21/2006 JL Nelson Use NRSTR avoid abend 900 if ampersand in    */
/*            data.                                                  */
/* 03/30/2006 JL Nelson Test for empty member LINENUM Rcode = 4.     */
/* 04/19/2006 JL Nelson Added TRUNC_DATA routine to drop blanks      */
/*            RC=864.                                                */
/* 05/23/2008 C Stern Check for new V528 SMS identifiers in TEMP3    */
/*            and, prevent them from being inserted into TEMP4.      */
/* 06/02/2009 CL Fenton Changes on how TBLMBR is processed.          */
/* 04/19/2011 CL Fenton Changed generation of cmd when masking       */
/*            characters or ending with a period in OLD field.  If   */
/*            masking character or ending period is available, cmd   */
/*            specified without quotes and with DATA(MASK).          */
/* 08/29/2016 CL Fenton Correct issue with TBLMBR.                   */
/* 02/06/2026 CL Fenton Converted script from CLIST to REXX.         */
/*                                                                   */
/*                                                                   */
/*                                                                   */
/*********************************************************************/
pgmname = "CATM0001 02/06/26"
sysprompt = "OFF"                       /* CONTROL NOPROMPT          */
sysflush = "OFF"                        /* CONTROL NOFLUSH           */
sysasis = "ON"                          /* CONTROL ASIS - caps off   */
return_code = 0
maxcc = 0
/******************************************/
/* VARIABLES ARE PASSED TO THIS MACRO     */
/* CONSLIST                               */
/* COMLIST                                */
/* SYMLIST                                */
/* TERMMSGS                               */
/******************************************/
Address ISPEXEC "CONTROL NONDISPL ENTER"
Address ISPEXEC "CONTROL ERRORS RETURN"
 
tm01lmcl = 12
tm01lmfr = 12
tm01lmin = 12
tm01lmop = 12
tm01lmpe = 12
tm01vget = 12
 
Address ISPEXEC "VGET (CONSLIST COMLIST SYMLIST TERMMSGS TBLMBR) ASIS"
tm01vget = return_code
If return_code <> 0 then do
  Say pgmname "VGET RC =" return_code zerrsm
  Say pgmname "CONSLIST/"conslist "COMLIST/"comlist
    "SYMLIST/"symlist "TERMMSGS/"termmsgs
  Say pgmname "TBLMBR/"tblmbr
  return_code = return_code + 16
  SIGNAL ERR_EXIT
  End
 
syssymlist = symlist                    /* CONTROL SYMLIST/NOSYMLIST */
sysconlist = conslist                   /* CONTROL CONLIST/NOCONLIST */
syslist = comlist                       /* CONTROL LIST/NOLIST       */
sysmsg = termmsgs                       /* CONTROL MSG/NOMSG         */
 
/*******************************************/
/* MAIN PROCESS                            */
/*******************************************/
"(MEMBER) = MEMBER"
"(DSNAME) = DATASET"
 
return_code = 0
"(LASTLINE) = LINENUM .ZLAST"
If return_code <> 0 then do
  If lastline = 0 then,
    Say pgmname "Empty file RCode =" return_code "DSN="dsname,
      "MEMBER="member zerrsm
  Else,
    Say pgmname "LINENUM Error RCode =" return_code "DSN="dsname
      "MEMBER="member zerrsm
    return_code = return_code +16
  SIGNAL ERR_EXIT
  End
 
return_code = 0
Address ISPEXEC "LMINIT DATAID(TEMP4) DDNAME(TSSALL) ENQ(EXCLU)"
tm01lmin = return_code
If return_code <> 0 then do
  Say pgmname "LMINIT_TEMP4_RC" return_code zerrsm
  return_code = return_code + 16
  SIGNAL ERR_EXIT
  End
 
return_code = 0
Address ISPEXEC "LMOPEN DATAID("temp4") OPTION(OUTPUT)"
tm01lmop = return_code
If return_code <> 0 then do
  Say pgmname "LMOPEN_TEMP4_RC" return_code zerrsm
  return_code = return_code + 16
  SIGNAL ERR_EXIT
  End
 
/*********************************************************************/
/*  THE FOLLOWING ISREDIT X STATEMENTS ARE USED TO EXCLUDE           */
/*  DATASETS COVERED BY OTHER FINDINGS.                              */
/*********************************************************************/
Say pgmname "Number of records before DELETE =" lastline
 
/*******************************************/
/* PROCESS TABLE VARIBLES                  */
/*******************************************/
 
tblmbr = tblmbr
tcnt = 2
tlen = length(tblmbr)
 
 
TABLE_LOOP:
Do X = 2 to length(tblmbr)
  parse var tblmbr . =(x) iter +3 .
  x = pos("#",tblmbr,x)
 
  return_code = 0
  "X ALL '"iter"' 1"
  If return_code > 4 then,
    Say pgmname "X ALL '"iter"' RC" return_code zerrsm
 
  End
 
"DELETE ALL NX"
"RESET"
 
 
START_SORT:
return_code = 0
"SORT 1 50 A"
If return_code > 4 then do
  Say pgmname "SORT TEMP3 RC" return_code zerrsm
  return_code = return_code + 16
  SIGNAL ERR_EXIT
  End
 
"RESET"
"(LASTLINE) = LINENUM .ZLAST"
Say pgmname "Number of records after SORT =" lastline
 
member = " "
tss = " "
wcnt = 0
line = 0
 
 
LOOP:
Do forever
  return_code = 0
  line = line + 1
  If line > lastline then,
    leave
  /*SIGNAL END_EDIT*/
  "(DATA) = LINE" line
 
  old = substr(data,4,47)
  If old = " " |,
     old = tss |,
     old = "IGDCSSGA" |,
     old = "IGDCSSCA" |,
     old = "IGDCSMCA" |,
     old = "IGDCSDCA" |,
     old = "IGDICMDS" then,
    iterate
 
  If substr(data,1,2) <> member then do
    member = substr(data,1,2)
    cmd = "TSS WHOAMI ITER("member")"
    return_code = 0
    Address ISPEXEC "LMPUT DATAID("temp4") MODE(INVAR) DATALOC(CMD)",
      "DATALEN("length(cmd)")"
    tm01lmpe = return_code
    End
 
  If old <> " " then,
    old = strip(old,"B")
  Else,
    iterate
 
  tss = old
  If pos("*",old) = 0 &,
     pos("+",old) = 0 &,
     pos("%",old) = 0 &,
     pos(". ",old" ") = 0 then,
    cmd = "TSS WHOH DSN('"old"')"
  Else,
    cmd = "TSS WHOH DSN("old")DATA(MASK)"
 
  return_code = 0
  Address ISPEXEC "LMPUT DATAID("temp4") MODE(INVAR) DATALOC(CMD)",
    "DATALEN("length(cmd)")"
  tm01lmpe = return_code
  If return_code > 4 then do
    Say pgmname "LMPUT_TEMP4_RC" return_code zerrsm
    return_code = return_code + 16
    SIGNAL ERR_EXIT
    End
  wcnt = wcnt + 1
  End
/*SIGNAL LOOP*/
 
 
END_EDIT:
Say pgmname "Number of records written to TEMP4 =" wcnt
 
return_code = 0
Address ISPEXEC "LMCLOSE DATAID("temp4")"
tm01lmcl = return_code
 
return_code = 0
Address ISPEXEC "LMFREE DATAID("temp4")"
tm01lmfr = return_code
 
return_code = 0
 
 
ERR_EXIT:
If maxcc >= 16 | return_code > 0 then do
  Address ISPEXEC "VGET (ZISPFRC) SHARED"
  If maxcc > zispfrc then,
    zispfrc = maxcc
  Else
    zispfrc = return_code
  Address ISPEXEC "VPUT (ZISPFRC) SHARED"
  Say pgmname "ZISPFRC =" zispfrc
  End
 
tm001rc = return_code
Address ISPEXEC "VPUT (TM01LMCL TM01LMFR TM01LMIN TM01LMOP TM01LMPE",
  "TM01VGET TM001RC) ASIS"
"SAVE"
"END"
Exit (0)
 
 
/******************************************/
/* SYSCALL SUBROUTINES                    */
/******************************************/
 
 
NoValue:
Failure:
Syntax:
say pgmname 'REXX error' rc 'in line' sigl':' strip(ERRORTEXT(rc))
say SOURCELINE(sigl)
SIGNAL ERR_EXIT
 
 
Error:
return_code = RC
if RC > 4 & RC <> 8 then do
  say pgmname "LASTCC =" RC strip(zerrlm)
  say pgmname 'REXX error' rc 'in line' sigl':' ERRORTEXT(rc)
  say SOURCELINE(sigl)
  end
if return_code > maxcc then
  maxcc = return_code
return
 
 
