/* REXX */
/* CLS2REXXed by FSOX001 on 4 Apr 2017 at 10:02:53  */
/*trace ?r*/
Signal On NoValue
Call On Error
Signal On Failure
Signal On Syntax
Parse source opsys . exec_name .
Address ISREDIT
 
"MACRO"               /* CAAM0013 EDIT MACRO */
/*********************************************************************/
/* 06/07/2006 C. STERN  Updated ERROR ROUTINE.                       */
/* 01/26/2007 CL.FENTON Resolved error code 932.                     */
/* 06/27/2007 CL.FENTON Resolved several rc 20 error on ISREDIT      */
/*            cmds.                                                  */
/* 01/31/2008 CL.FENTON Added details to process resources.  Chgs    */
/*            made to format of flds it TEMP4.                       */
/* 04/14/2008 CL.FENTON Corrected extract of UID string with space   */
/* 04/14/2008 CL.FENTON Corrected evaluation of REC 1 records.       */
/* 07/16/2009 CL.FENTON Corrected the elimination of records.        */
/* 03/31/2011 CL.FENTON Chgd " to ' in all TEMP4 members.            */
/*            Ensured that when UID(*) PREVENT is specified for      */
/*            resource all other entries are deleted.                */
/* 09/27/2011 CL.FENTON Corrected 912 error in setting KEY1.         */
/* 03/14/2013 CL.FENTON Corrected 804 error caused by masking        */
/*            character in KEY field.                                */
/* 03/29/2013 CL Fenton Added changes to process masking characters. */
/* 07/05/2013 CL Fenton Changes made in information saved in TEMP4.  */
/* 10/04/2013 CL Fenton Changes made to correct use of hilvl qual.   */
/* 11/18/2013 CL Fenton Changes made to remove unused and            */
/*            unneccessary RECTYP 1 records, STS-003381,             */
/*            STS-003761, ...                                        */
/* 05/09/2017 CL.FENTON Converted script from CLIST to REXX.         */
/* 11/02/2017 CL Fenton Correct issue with "CURSOR = 1 0" after      */
/*            all records are deleted, causing "LASTCC = 12..."      */
/*            messages, STS-018616,                                  */
/* 04/17/2019 CL.FENTON Chgs to evaluate ZCIC0021 for system that    */
/*            are running both production and test/developement      */
/*            CICS regions, STS-021044.                              */
/* 05/22/2020 CL.FENTON Minor chgs to bypass process under certain   */
/*            conditions.                                            */
/*                                                                   */
/*                                                                   */
/*                                                                   */
/*                                                                   */
/*********************************************************************/
pgmname = "CAAM0013 05/22/20"
sysprompt = "OFF"                /* CONTROL NOPROMPT          */
sysflush = "OFF"                 /* CONTROL NOFLUSH           */
sysasis = "ON"                   /* CONTROL ASIS - caps off   */
Address ISPEXEC "CONTROL NONDISPL ENTER"
Address ISPEXEC "CONTROL ERRORS RETURN"
 
/*******************************************/
/* VARIABLES ARE PASSED TO THIS MACRO      */
/*******************************************/
key = ""
return_code = 0                  /* SET RETURN CODE TO 0 */
Address ISPEXEC "VGET (CONSLIST COMLIST SYMLIST TERMMSGS OUTPUT",
  "RESTYPE) ASIS"
am13vge = 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         */
zerrlm = ""
acc_tbl = "READ WRITE ALLOC EXEC"
"(MEMBER) = MEMBER"
 
If member = "LIDS" then do
  Address ISPEXEC "VGET (TESTUID LIDRC LIDLINE) ASIS"
  return_code = 0
  If lidline = 0 then do
    "CHANGE ALL X'50' '+'"
    If return_code = 0 then,
      "SAVE"
    return_code = 0
    "CHANGE ALL '""' ""'"""
    If return_code = 0 then,
      "SAVE"
    end
  else do
    return_code = 0
    call PROCESS_LID
    end
  "CANCEL"
  exit
  end
 
"(A) = LINENUM .ZL"
uidkey = "UID("
"CHANGE ALL '""' ""'"""
"(ROW) = LINENUM .ZLAST"
If row = 0 then,
  SIGNAL EXIT_IT
"SORT"
 
DUPLICATE_LOOP:
do count = 1 to row
  "(XSTAT) = XSTATUS" count
 
  If xstat = "NX" then do
    "(DATA) = LINE" count
    "EXCLUDE ALL '"substr(data,7,87)"' 7 93"
    "FIND FIRST '"substr(data,7,87)"' 7 93"
    end
 
  end /* do count */
 
"DELETE ALL X"
If restype <> "DSN" then do
  Call exclude_rec1
  "DELETE ALL X"
  "SORT"
  Call remove_unused
  "DELETE ALL NX"
  "RESET"
  end
"(ROW) = LINENUM .ZLAST"
if row > 0 then,
  "CURSOR = 1 0"
count = 1
 
/* Pass information is to delete duplicate records */
COLLECT_LOOP:
return_code = 0
"SAVE"
Call move_rec 93
Call move_rec 49
Call move_rec 14
if row > 0 then,
  "CURSOR = 1 0"
 
/* Exclude duplicate UID strings */
UIDKEY_LOOP:
do until return_code > 0
  return_code = 0
  "FIND '"uidkey"' NX 50"
  If return_code > 0 then,
    leave
 
  "(DATA) = LINE .ZCSR"
  key2 = substr(data,50,44)
  If pos("UID(*)",key2) = 0 then do
    "EXCLUDE ALL '"key2"' 50"
    "FIND FIRST '"key2"' 50"
    end /* if pos("UID(*)" */
 
  "CURSOR = .ZCSR 100"
  end /* do until return_code > 0 */
 
if row > 0 then,
  "CURSOR = 1 0"
 
/* Obtain LIDS for UID strings without repeating */
UIDKEY_LID_LOOP:
do until return_code > 0
  return_code = 0
  "FIND NEXT '"uidkey"' NX 50"
  If return_code > 0 then do
    "(ROW) = LINENUM .ZLAST"
    iterate
    end
  "(DATA) = LINE .ZCSR"
  "(COUNT) = LINENUM .ZCSR"
  "CURSOR =" count 100
  parse var data . 7 key 49 .
  parse var data key1 49 rectype 50 key2 100 .
  parse var key2 . "(" testuid ")" .
 
  If testuid = "*" then do
    data = key1"3"key2"ALL LOGONIDS MATCH SPECIFIED UID STRING"
    "LINE_AFTER" count "= (DATA)"
    end
  Else do
    testuid = translate(testuid,"=","*")
    lidrc = 0
    lidline = 1
 
    GET_LID_LOOP:
    do while lidrc = 0
      Address ISPEXEC "VPUT (TESTUID LIDRC LIDLINE) ASIS"
      "VIEW LIDS"
      Address ISPEXEC "VGET (TESTUID LIDRC LIDLINE LIDNAME) ASIS"
      If lidline = 1 then do
        data = key1"3"key2"NO LOGONIDS MATCH"
        "LINE_AFTER" count "= (DATA)"
        end
      Else,
        Do X = 1 to length(lidname) by 30
          data = key1"3"key2""substr(lidname,x,30)
          "LINE_AFTER" count "= (DATA)"
          end
      end
    end
 
  UIDKEY_LID_NEXT:
  return_code = 0
  "EXCLUDE ALL '"key1"3"key2"' 1"
  end
 
 
WRITE_LOOP:
do count = 1 to row
  If count > row then,
    iterate
  "(DATA) = LINE" count
  x = pos("|",data,7)
  if pos("|",data,7) > 0 then,
    parse var data . 7 key "|" key1 49 rectype 50 key2 94 .
  Else,
    parse var data . 7 key 15 key1 49 rectype 50 key2 94 .
  key = strip(key)
  key1 = strip(key1)" "
  key2 = strip(key2)" "
  Select
    When rectype = "0" then,
      Call WRITE_REC0
    When rectype = "1" then,
      Call WRITE_REC1
    When rectype = "2" then,
      Call WRITE_REC2
    When rectype = "3" then,
      Call WRITE_REC3
    Otherwise say pgmname "INVALID RECORD TYPE" rectype"."
    end
  end
 
EXIT_IT:
Address ISPEXEC "VPUT (AM13VGE) ASIS"
"CANCEL"
Exit
 
 
PROCESS_LID:
lidname = ""
/*If lidline = 0 then,
  SIGNAL  LID_EXIT*/
cnt = 0
"CURSOR =" lidline 0
 
 
LOOP_LID:
do forever
  If lidline = 0 then leave
  If pos("=",testuid) > 0 then,
    "FIND PREV P'"testuid"' 37"
  Else,
    "FIND PREV '"testuid"' 37"
  If return_code > 0 then do
    lidrc = return_code
    leave
    end
  "(DATA) = LINE .ZCSR"
  "(LIDLINE) = LINENUM .ZCSR"
  lidname = lidname""substr(data,6,30)
  cnt = cnt + 1
  If cnt = 250 then,
    leave
  end
 
 
LID_EXIT:
Address ISPEXEC "VPUT (TESTUID LIDRC LIDLINE LIDNAME) ASIS"
return
 
 
WRITE_REC0:
cmd = " "
Address ISPEXEC "LMPUT DATAID("output") MODE(INVAR) DATALOC(CMD)",
  "DATALEN("length(cmd)")"
cmd = "     $KEY("key") "substr(data,50)
Address ISPEXEC "LMPUT DATAID("output") MODE(INVAR) DATALOC(CMD)",
  "DATALEN("length(cmd)")"
return
 
 
WRITE_REC1:
If member = "ZCIC0021" then,
  cmd = "          "word(key2,2)
Else,
  cmd = "          "key2
Address ISPEXEC "LMPUT DATAID("output") MODE(INVAR) DATALOC(CMD)",
  "DATALEN("length(cmd)")"
return
 
 
WRITE_REC2:
access = substr(data,94,6)
If restype = "DSN" then do
  exp_acc = ""
  Do X = 1 to 4
    If substr(access,x,1) <> " " then do
      acc_t = word(acc_tbl,x)
      exp_acc = exp_acc""acc_t"("substr(access,x,1)") "
      end
    end
    cmd = "               "key1""key2""exp_acc
  end
Else do
  svc = right(access,5)
  parse var data . 100 nkey .
  nkey = nkey" "
  If nkey = " " then,
    nkey = ""
  svc_acc = ""
  Do x = 1 to 5
    Select
      When substr(svc,x,1) = "R" then,
        svc_acc = svc_acc"READ,"
      When substr(svc,x,1) = "A" then,
        svc_acc = svc_acc"ADD,"
      When substr(svc,x,1) = "U" then,
        svc_acc = svc_acc"UPDATE,"
      When substr(svc,x,1) = "D" then,
        svc_acc = svc_acc"DELETE,"
      When substr(svc,x,1) = "E" then,
        svc_acc = svc_acc"EXECUTE,"
      Otherwise nop
      end
    end
  Select
    When left(access,1) = "A" then,
      access = "ALLOW"
    When left(access,1) = "L" then,
      access = "LOG"
    When left(access,1) = "P" then,
      access = "PREVENT"
    Otherwise nop
    End
  x = length(svc_acc)
  If x > 0 then
    svc_acc = "SERVICE("substr(svc_acc,1,x-1)") "
  cmd = "               "key1""key2""svc_acc""nkey""access
  end
Address ISPEXEC "LMPUT DATAID("output") MODE(INVAR) DATALOC(CMD)",
  "DATALEN("length(cmd)")"
return
 
 
WRITE_REC3:
x = length(data)
cmd = "                    "substr(data,100,41)
Address ISPEXEC "LMPUT DATAID("output") MODE(INVAR) DATALOC(CMD)",
  "DATALEN("length(cmd)")"
return
 
 
MOVE_REC:
l = arg(1)-6
"(ROW) = LINENUM .ZLAST"
 
 
COLLECT_LOOP:
do count = 1 to row
  return_code = 0
  "(DATA) = LINE" count
  "CURSOR =" count 100
  "FIND .ZCSR .ZL '"substr(data,7,l)"' 7" arg(1)
  If return_code = 0 then do
    "(X) = LINENUM .ZCSR"
    "(DATA1) = LINE .ZCSR"
    "DELETE .ZCSR"
    "LINE_AFTER" count "= (DATA1)"
    end
  end
Return (0)
 
 
EXCLUDE_REC1:
"CURSOR = 1 0"
"SORT 7 48 D 49 120 D"
 
 
PREFIX_LOOP:
do forever
  return_code = 0
  "FIND '$PREFIX('"
  If return_code <> 0 then,
    leave
  "(UIDLINE) = CURSOR"
  "(DATA) = LINE .ZCSR"
  parse var data . 7 key01 "|" .
  key0 = key01"|"
  "SEEK 'NEXTKEY("key01")' ALL 100"
  If return_code <> 0 then,
    "EXCLUDE '"key0"' 7 ALL"
  "CURSOR =" uidline 110
  end
 
 
PREFIX_END:
"CURSOR = 1 0"
"DELETE ALL X"
 
 
NEXTKEY_LOOP:
do forever
  return_code = 0
  "FIND 'NEXTKEY('"
  If return_code <> 0 then,
    leave
  "(UIDLINE) = CURSOR"
  "(DATA) = LINE .ZCSR"
  parse var data . "NEXTKEY(" nextkey ")" .
  parse var data . "|" tkey .
  nkey = tkey
  nkey = trunc_mask(nkey) /* SYSCALL 1 */
  nkey = nkey
  If nkey = " " then,
    iterate
  key0 = substr(data,7,42)
  resgrp = ""
 
 
NEXT_LOOP:
  return_code = 0
  "FIND '"nextkey"| ' 7 FIRST"
  If return_code <> 0 then do
    "CURSOR =" uidline 110
    iterate
    end
  "(NEXTLINE) = CURSOR"
  "(DATA) = LINE .ZCSR"
  data = data
  parse var data . "$PREFIX(" prfx ")" .
  If nkey = " " then,
    nkey = prfx
  Else,
    nkey = prfx"."nkey
  return_code = 0
  "SEEK '"nextkey"|' 7 ALL NX"
  new_nextkey = " "
  Do until return_code > 0
    "(CURLINE) = CURSOR"
    "(DATA) = LINE .ZCSR"
    typ = substr(data,49,1)
    If typ = 2 & pos("NEXTKEY",data,100) > 0 then do
      parse var data . "NEXTKEY(" new_nextkey ")" .
      end
    If typ = 1 then do
      parse var data . "|" sprfx .
      x = pos("|",data,7)
      y = pos(" ",data,a)
      If y = x+1 then,
        tkey = ""
      Else,
        tkey = prfx""sprfx
      rkey = tkey
      tkey = trunc_mask(tkey) /* SYSCALL 1 */
      tkey = tkey
      If tkey = " " then,
        tkey = prfx
      Else,
        tkey = prfx"."tkey
      parse var data . 50 key1 .
      If pos(tkey,key1) = 0 & pos(nkey,key1) = 0 & pos(key1,tkey) = 0 then,
        "XSTATUS" curline "= X"
      If pos(nkey,key1) = 0 then do
        If tkey <> prfx & pos(key1" ",resgrp" ") = 0 then,
          resgrp = resgrp||key1" "
        If tkey = prfx & pos(key1" ",resgrp" ") = 0 then,
          "XSTATUS" curline "= X"
        end
      If pos(nkey,key1) > 0 then do
        If pos(key1" ",resgrp" ") = 0 then,
          resgrp = resgrp||key1" "
        end
      end
 
    do until return_code > 0
 
 
NEXTKEY_BYPASS:
      "CURSOR =" curline 50
      return_code = 0
      "SEEK '"nextkey"|' 7 NX"
      If return_code > 0 then do
        If new_nextkey <> " " then do
          nextkey = new_nextkey
          new_nextkey = ""
          curline = 1
          return_code = 0
          iterate
          end
        end
      Else,
        leave
      end
    end
  "CURSOR =" uidline 110
  end
 
 
NEXTKEY_END:
"CURSOR = 1 0"
"DELETE ALL X"
 
 
UID_LOOP:
do until return_code > 0
  return_code = 0
  "FIND 'UID(*)'"
  If return_code <> 0 then,
    leave
  "(UIDLINE) = CURSOR"
  "(DATA) = LINE .ZCSR"
  n = substr(data,100,1)
  If n <> " " then,
    iterate
  p = substr(data,94,1)
  parse var data . "|" tkey .
  rkey = tkey
  tkey = trunc_mask(tkey) /* SYSCALL 1 */
  tkey = tkey
  key0 = substr(data,7,42)
  resgrp = ""
  return_code = 0
  "SEEK '"key0"1' 7 ALL NX"
  Do until return_code > 0
    "(CURLINE) = CURSOR"
    "(CURSW) = XSTATUS .ZCSR"
    "(DATA) = LINE .ZCSR"
    key1 = substr(data,50,44)
    "SEEK '"key0"1' 7 NX PREV"
    If return_code = 0 then,
      c = 1
    Else,
      c = 0
    return_code = 0
    "SEEK ALL '"key0"1' 7 NX"
    "(A) = SEEK_COUNTS"
    "SEEK ALL '"key0"1' 7"
    "(B) = SEEK_COUNTS"
    return_code = 0
    If tkey = rkey & p = "P" & pos(tkey,key1) > 0 then do
      "EXCLUDE ALL '1"key1"' 49 .ZCSR .ZLAST"
      "XSTATUS" curline "= NX"
      end
    "CURSOR =" curline 50
    "SEEK '"key0"1' 7 NX"
    end
  return_code = 0
  "CURSOR =" uidline 50
  end
 
 
UID_END:
"CURSOR = 1 0"
"DELETE ALL X"
/*"SAVE"*/
 
 
REC1_LOOP:
do until return_code > 0
  return_code = 0
  "SEEK '1' NEXT 49"
  If return_code <> 0 then,
    leave
  "(CURLINE) = CURSOR"
  "(DATA) = LINE .ZCSR"
  key0 = substr(data,7,43)
  key1 = substr(data,49,45)
  parse var key0 skey "|" tkey .
  rkey = tkey
  tkey = trunc_mask(tkey) /* SYSCALL 2 */
  tkey = tkey
  ckey = skey"."rkey
  key2 = substr(key0,1,42)key1
  "SEEK '"key0"' 7 ALL NX"
  "(A) = SEEK_COUNTS"
  "SEEK '"key1"' 49 ALL NX"
  "(B) = SEEK_COUNTS"
  "SEEK '"key1"' 49 ALL"
  "(C) = SEEK_COUNTS"
  "SEEK '"key2 "' 7 ALL"
  "(D) = SEEK_COUNTS"
  "(XSTAT) = XSTATUS" curline
/*say curline a b c d "XSTAT:"xstat "KEY0:"key0
  say "KEY1:"key1 "TKEY:"tkey "RKEY:"rkey "CKEY:"ckey*/
  If a > 1 & c > 1 & xstat = "NX" & pos(tkey,key1) = 0 &,
    tkey <> " " then do
    return_code = 0
    "SEEK '"key0"' 7 PREV NX"
    if return_code = 0 then,
      "XSTATUS" curline "= X"
    return_code = 0
    end
  If b = 0 & xstat = "NX" & tkey = rkey & tkey <> " " &,
    pos(tkey" ",key1) = 0 then do
    "FIND '"key1"' 49 ALL"
    "XSTATUS" curline "= X"
    end
  If (c > 1 | (b = 0 & c >= 1)) & xstat = "X" & pos(tkey,key1) > 0 &,
    tkey <> " " then do
    key1a = strip(substr(key1,2),"t")" "
    If pos(key1a,ckey) > 0 then,
      "XSTATUS" curline "= NX"
    "XSTATUS" curline "= NX"
    end
  If d > 1 & xstat = "NX" & pos(tkey,key1) = 0 & tkey <> " " then,
    "EXCLUDE '"key2"' 7 ALL"
  "CURSOR =" curline 50
  end
 
 
REC1_END:
  "CURSOR = 1 0"
 
 
REC1_LOOP1:
do until return_code > 0
  return_code = 0
  "SEEK '1' NEXT 49 X"
  If return_code <> 0 then,
    leave
  "(CURLINE) = CURSOR"
  "(DATA) = LINE .ZCSR"
  parse var data . 7 key0 . 50 key1 94 .
  parse var key1 . "." key1 .
  parse var data . "|" tkey .
  rkey = tkey
  tkey = trunc_mask(tkey) /* SYSCALL 3 */
  tkey = tkey
  If tkey = rkey & key1 <> " " & pos(key1,tkey) > 0 then do
    "SEEK '"key0"' 7 ALL NX"
    "(A) = SEEK_COUNTS"
    If a = 0 then,
      "XSTATUS" curline "= NX"
    end
  If key1 <> " " & pos(key1,tkey) > 0 then do
    "SEEK '"key0"' 7 ALL NX"
    "(A) = SEEK_COUNTS"
    If a = 0 then,
      "XSTATUS" curline "= NX"
    end
  "CURSOR =" curline 50
  end
REC1_END1:
  Return
 
 
TRUNC_MASK:
  string = arg(1)
  return_code = 0
  dl = length(string)
  If dl = 0 then,
    Return string
  If substr(string,dl) = "-" then,
    dl = dl - 1
  If dl > 1 then
    If substr(string,dl-1,2) = "-." then
      dl = dl - 2
  If dl > 0 then,
    If substr(string,dl,1) = "." then,
      dl = dl - 1
  If dl > 0 then,
    string = left(string,dl)
  Else,
    string = ""
  Return string
 
 
REMOVE_UNUSED:
"CURSOR = 1 0"
 
 
FIND_LOOP:
return_code = 0
do until return_code > 0
  "FIND '1' 49 NX"
  If return_code > 0 then do
    "CURSOR = 1 0"
    leave
    end
  "(DATA) = LINE .ZCSR"
  parse var data . 7 key0 "|" .
  parse var data . 7 key1 49 .
  key0 = left(key0"|",42)
  "EXCLUDE ALL '"key0"0' 07"
  "EXCLUDE ALL '"key1"' 07"
  return_code = 0
  end
 
 
FIND_LOOP1:
return_code = 0
do until return_code > 0
  "FIND 'NEXTKEY' 100 NX"
  If return_code > 0 then,
    leave
  "(DATA) = LINE .ZCSR"
  parse var data . 7 key0 "|" .
  parse var data . 7 key1 94 .
  key0 = left(key0"|",42)
  "EXCLUDE ALL '"key0"0' 07"
  "EXCLUDE ALL '"key1"' 07"
  return_code = 0
  end
Return (0)
 
 
NoValue:
Failure:
Syntax:
say pgmname 'REXX error' rc 'in line' sigl':' strip(ERRORTEXT(rc))
say SOURCELINE(sigl)
SIGNAL exit_it
 
 
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
return