/* REXX */
/* CLS2REXXed by FSOX001 on 27 Apr 2017 at 12:24:54  */
/*Trace r?*/
Signal On NoValue
Call On Error
Signal On Failure
Signal On Syntax
Parse source opsys . exec_name .
Address ISREDIT
 
"MACRO"               /* CAAM0004 EDIT MACRO */
/*********************************************************************/
/* 06/06/2006 C Stern Updated ERROR ROUTINE.                         */
/* 11/30/2009 CL Fenton Changes made to obtain all resource class    */
/*            for automated analysis.                                */
/* 05/14/2010 CL Fenton Changes made to correct 804 error cause by   */
/*            special char in RESOURCE variable.                     */
/* 04/28/2017 CL Fenton Converted script from CLIST to REXX.         */
/* 09/25/2020 CL Fenton Removed TERMPRO variable.                    */
/* 07/21/2021 CL Fenton Removed caam0013 variable.                   */
/*                                                                   */
/*                                                                   */
/*********************************************************************/
pgmname = "CAAM0004 07/21/21"
return_code = 0   /* SET RETURN CODE TO 0 */
zerrsm      = ""
Address ISPEXEC "CONTROL NONDISPL ENTER"
Address ISPEXEC "CONTROL ERRORS RETURN"
/*******************************************/
/* VARIABLES ARE PASSED TO THIS MACRO      */
/*******************************************/
Address ISPEXEC "VGET (RESOURCE CONSLIST COMLIST SYMLIST",
  "TERMMSGS) ASIS"
am4vge = 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 "RESOURCE/"resource
  end
 
If CONSLIST = "ON" | COMLIST = "ON" | SYMLIST = "ON" ,
  then Trace ?r
 
return_code = 0
 
/*******************************************/
/* TURN ON MESSAGES                        */
/*******************************************/
syssymlist = symlist                    /* CONTROL SYMLIST/NOSYMLIST */
sysconlist = conslist                   /* CONTROL CONLIST/NOCONLIST */
syslist = comlist                       /* CONTROL LIST/NOLIST       */
sysmsg = termmsgs                       /* CONTROL MSG/NOMSG         */
sysprompt = "OFF"                       /* CONTROL PROMPT/NOPROMPT   */
return_code = 0                         /* SET RETURN CODE TO 0      */
resource = resource
/*******************************************/
/* GET TABLE VALUES                        */
/*******************************************/
Do X = 2 to length(resource) by 17
  c = substr(resource,x,16)
  d = substr(c,13,3)
  type = substr(c,16,1)
  return_code = 0
  "FIND '"left(c,8)d""type"' FIRST 1 12"
  If return_code = 0 then,
    iterate
  return_code = 0
  "FIND '"left(c,8)"' FIRST 1 8"
  If return_code = 0 then do
    "(DATA) = LINE .ZCSR"
    If substr(data,9,3) = "   " then,
      "CHANGE '"left(data,12)"' '"left(c,8)d""type"' 1 12"
    Else
      "LINE_AFTER .ZLAST = DATALINE '"left(c,8)d""type"'"
    iterate
    end
  return_code = 0
  "FIND '"d"' FIRST 9 11"
  If return_code > 0 then do
    iterate
    end
  "(DATA) = LINE .ZCSR"
  If left(data,11) = left(c,8)d &,
    substr(data,12,1) <> type then do
    "CHANGE '"left(data,12)"' '"left(c,8)d""type"' PREV 1 12"
    end
  end
 
return_code = 0
"SORT 1 8 12 12 9 11"
"(ENDER) = LINENUM .ZLAST"
trows = ender
resource = ""
o_data = "            "
Do CNT = 1 to ender
  "(DATA) = LINE" cnt
  If substr(data,9,3) = "   " then iterate
  If o_data = left(data,12) then iterate
  If left(o_data,8) = left(data,8) &,
    substr(data,12,1) = "I"  then iterate
  If pos(left(data,11),resource) > 0 then iterate
  resource = resource" "left(data,12)
  o_data = left(data,12)
  end
 
Address ISPEXEC "VPUT (AM4VGE RESOURCE) ASIS"
 
END_IT:
"CANCEL"
Exit
 
 
NoValue:
Failure:
Syntax:
say pgmname 'REXX error' rc 'in line' sigl':' strip(ERRORTEXT(rc))
say SOURCELINE(sigl)
SIGNAL end_it
 
 
Error:
return_code = RC
if RC >= 16 then do
  say pgmname "LASTCC =" RC strip(zerrlm)
  say pgmname 'REXX error' rc 'in line' sigl':' strip(ERRORTEXT(rc))
  say SOURCELINE(sigl)
  end
return