/* REXX */
/* CLS2REXXed by FSOX001 on 20 Apr 2017 at 11:33:22  */
Signal On NoValue
Call On Error
Signal On Failure
Signal On Syntax
Parse source opsys . exec_name .
Address ISREDIT
 
"MACRO" /* CAAM0003 EDIT MACRO */
/*********************************************************************/
/* 04/25/2006 CL.FENTON MODIFICATIONS.                               */
/* 06/06/2006 C. STERN  Updated ERROR ROUTINE.                       */
/* 06/07/2006 C. STERN  Resolved error code 860.  Added truncate     */
/*            subroutine.                                            */
/* 06/07/2006 CL.FENTON Resolved error code 712.                     */
/* 01/17/2007 CL.FENTON Resolved error code 932.                     */
/* 01/31/2008 CL.FENTON Chgs made to format of flds it TEMP4         */
/* 03/31/2008 CL.FENTON Added OUTWRITE var for no output written.    */
/*            Corrected 920 error on undefined dsn.                  */
/* 04/14/2008 CL.FENTON Corrected extract of UID string with space   */
/* 04/24/2017 CL.FENTON Converted script from CLIST to REXX.         */
/* 05/21/2020 CL.FENTON Corrected issues with exiting processing     */
/*            loop within LOOP paragraph.                            */
/*                                                                   */
/*                                                                   */
/*                                                                   */
/*                                                                   */
/*********************************************************************/
pgmname = "CAAM0003 05/21/20"
return_code = 0   /* SET RETURN CODE TO 0 */
key = ""
zerrlm = ""
Address ISPEXEC "CONTROL NONDISPL ENTER"
Address ISPEXEC "CONTROL ERRORS RETURN"
/*******************************************/
/* VARIABLES ARE PASSED TO THIS MACRO      */
/*******************************************/
Address ISPEXEC "VGET (CONSLIST COMLIST SYMLIST TERMMSGS TEMP4",
  "KEYNUM OUTWRITE) ASIS"
am3vge = return_code
 
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         */
rec0_sw = ""
nkey = "NEXTKEY("
uidkey = "UID("
"CURSOR = 1 0"
 
 
/*   MAIN INFORMATION */
MAIN_LOOP:
"FIND '----------' 2 11 FIRST"
"DEL .ZF .ZCSR"
"X 'STORED:' 2 8 ALL"
"X '1' 1 1 ALL"
"X ' DATE ' 1 6 ALL"
"X '                    ' 1 20 ALL"
"DEL ALL X"
return_code = 0
uidrow = 0
"CURSOR = .ZLAST 1"
"(ROW,COL) = CURSOR"
"FIND '"uidkey"' FIRST"
If return_code = 0 then do
  outwrite = "YES"
  "(UIDROW,COL) = CURSOR"
  end
Else
  SIGNAL END_IT
return_code = 0
nrow = 0
"FIND '"nkey"' FIRST"
If return_code = 0 then,
  "(NROW,COL) = CURSOR"
return_code = 0
"CURSOR = 1 1"
uidnum = 0
 
 
LOOP:
do counter = 1 to row
  If counter > row then leave
  "CURSOR =" counter 1
  "(DATA) = LINE" counter
  ac = strip(data,"T")
  If uidrow = nrow then do
    call NEXTKEY_RTN
    leave
    end
  If "-LOGONIDS THAT HAVE ACCESS WITHOUT RULES" = ac then do
    counter = uidrow
    iterate counter
    end
  If pos("DATASET:",ac) <> 0 then do
    parse var ac . "DATASET: " dsn " RKEY: " outkey .
    dsn = strip(dsn,"T","-")
    If pos("UID(*)",ac) > 0 then leave
    iterate
    end
  CNTL_TEST:
  If pos(uidkey,ac) = 0 then do
    parse var ac . 11 controls
    If controls <> " " then,
      controls = strip(controls,"B")
    iterate
    end
  UID_TEST:
  If rec0_sw = " " then do
    cmd1 = left(outkey,42)
    uidnum = right(uidnum,4,"0")
    cmd = keynum""uidnum""cmd1"0"controls
    Address ISPEXEC "LMPUT DATAID("temp4") MODE(INVAR) DATALOC(CMD)",
      "DATALEN("length(cmd)")"
    rec0_sw = "X"
    end
  If pos(nkey,data) > 0 then do
    call NEXTKEY_RTN
    leave
    end
  ac = substr(ac,2)
  parse var ac x0 "UID(" xa uidacc "DATA(" xb
  if xa <> "" then,
    xa = "UID("xa
  if xb <> "" then,
    xb = "DATA("xb
  x = pos(uidkey,ac)
  y = length(ac)
  If pos(uidkey,ac) = 0 then,
    iterate
  cmd1 = left(outkey,8)left(x0,34)
  uidnum = right(uidnum,4,"0")
  cmd = keynum""uidnum""cmd1"1"left(dsn,44)
  Address ISPEXEC "LMPUT DATAID("temp4") MODE(INVAR) DATALOC(CMD)",
    "DATALEN("length(cmd)")"
  access = "    "
  Call set_acc
  cmd = keynum""uidnum""cmd1"2"left(xa,44)
  cmd = cmd""access
  Address ISPEXEC "LMPUT DATAID("temp4") MODE(INVAR) DATALOC(CMD)",
    "DATALEN("length(cmd)")"
  uidnum = uidnum + 1
  END_TEST:
  If pos("UID(*)",ac) > 0 then leave
  end
 
 
END_IT:
Address ISPEXEC "VPUT (KEY AM3VGE OUTWRITE) ASIS"
 
"CANCEL"
Exit
 
 
/*******************************************/
/*  SYSCALL SUBPROCEDURE                   */
/*******************************************/
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
 
 
NEXTKEY_RTN:
"FIND '"nkey"'"
"(DATA) = LINE .ZCSR"
data = strip(data,"T")
parse var data . (nkey) key ")" .
return
 
 
SET_ACC:    /* "UIDACC ACCESS" */
return_code = 0
acc_tbl = "READ WRITEALLOCEXEC"
uidacc = uidacc
x1 = 1
Do X = 1 to length(acc_tbl) by 5
  acc_t = substr(acc_tbl,x,5)
  acc_t = strip(acc_t)
  y = pos(acc_t,uidacc)
  If y > 0 then do
    y1 = pos("(",uidacc,y) + 1
    acc = substr(uidacc,y1,1)
    access = substr(access,1,x1)acc
    end
  x1 = x1 + 1
  end
uidacc = uidacc
access = substr(access,2,4)
Return