/* REXX */
/* CLS2REXXed by FSOX001 on 9 May 2017 at 15:37:40  */
/*trace ?r*/
Signal On NoValue
Call On Error
Signal On Failure
Signal On Syntax
Parse source opsys . exec_name .
Address ISREDIT
 
"MACRO"               /* CAAM0102 EDIT MACRO */
/*********************************************************************/
/* 01/31/2008 CL.FENTON Copied from CAAM0002.                        */
/* 02/28/2009 CL FENTON Chgs made to include REC 1 for NEXTKEY.      */
/* 03/22/2010 CL FENTON Corrected inclusion of resources when        */
/*            rule does not match.                                   */
/* 06/06/2012 CL Fenton Corrected 852 and 932 errors on REC2TBL      */
/*            on resources that have special characters (+, -, *,    */
/*            and /), CSD-AR003419256.                               */
/* 03/14/2013 CL Fenton Added changes to process masking             */
/*            characters in $KEY to accommodate ACF0870,             */
/*            STS-001935.                                            */
/* 10/02/2013 CL Fenton Test for finding RESOURCE in                 */
/*            PROCESS_MASK_KEY.                                      */
/* 10/18/2013 CL Fenton Corrected 860 erron on RESOURCE.             */
/* 04/19/2017 CL.FENTON Converted script from CLIST to REXX.         */
/* 04/08/2019 CL.FENTON Chgs to evaluate ZCIC0021 for system that    */
/*            are running both production and test/developement      */
/*            CICS regions, STS-021044.                              */
/* 04/08/2019 CL.FENTON Chgs to ensure that rule $key field matches  */
/*            resource, STS-022261.                                  */
/*                                                                   */
/*                                                                   */
/*********************************************************************/
pgmname = "CAAM0102 04/08/19"
return_code = 0   /* SET RETURN CODE TO 0 */
key = ""
keynum = 0
Address ISPEXEC "CONTROL NONDISPL ENTER"
Address ISPEXEC "CONTROL ERRORS RETURN"
/*******************************************/
/* VARIABLES ARE PASSED TO THIS MACRO      */
/*******************************************/
Address ISPEXEC "VGET (CONSLIST COMLIST SYMLIST TERMPRO TERMMSGS",
  "CAAM0013 RESTYPE PDINAME OUTPUT TEMP4 CNTL) ASIS"
am5vge = return_code
If CONSLIST = "ON" | COMLIST = "ON" | SYMLIST = "ON" ,
  then Trace ?r
 
return_code = 0   /* SET RETURN CODE TO 0 */
sysasis = "ON"
/*******************************************/
/* TURN ON MESSAGES                        */
/*******************************************/
syssymlist = symlist          /* CONTROL SYMLIST/NOSYMLIST */
sysconlist = conslist         /* CONTROL CONLIST/NOCONLIST */
syslist = comlist             /* CONTROL LIST/NOLIST       */
sysmsg = termmsgs             /* CONTROL MSG/NOMSG         */
uidkey = "UID("
bkey = "("
ekey = ")"
rescnt = 0
Address ISPEXEC "LMOPEN DATAID("temp4") OPTION(OUTPUT)"
lmopen_temp4_rc = return_code
If return_code <> 0 then do
  Say pgmname "LMOPEN_TEMP4_RC" return_code  zerrsm
  SIGNAL  ERR_EXIT
  end
return_code = 0   /* SET RETURN CODE TO 0 */
rectype = 2
resname = ""
Address ISPEXEC "VPUT (RECTYPE PDINAME RESNAME) ASIS"
cmd = date("u")"   "pdiname
Address ISPEXEC "LMPUT DATAID("output") MODE(INVAR) DATALOC(CMD)",
  "DATALEN("length(cmd)")"
am2lmp = return_code
return_code = 0
Address ISPEXEC "VIEW DATAID("cntl") MEMBER(CACT0008) MACRO(CACM042R)"
view_cact0008_rc = return_code
If view_cact0008_rc > 4 then do
  Say pgmname "VIEW CNTL" cact0008  "RC =" view_cact0008_rc
  return_code = return_code + 16
  SIGNAL  ERR_EXIT
  end
Address ISPEXEC "VGET (REC2TBL) ASIS"
rec2tbla = strip(rec2tbl,"T")
"CURSOR = .ZLAST 1"
"(ROW,COL) = CURSOR"
"CURSOR = 1 0"
return_code = 0   /* SET RETURN CODE TO 0 */
If pdiname = "ZCIC0021" then do
  call collect_restypes
  do rcnt = 1 to words(restypes)
    restype = word(restypes,rcnt)
    call main_loop
    end
  end
Else,
  call main_loop
 
 
END_IT:
return_code = 0
Address ISPEXEC "LMMADD DATAID("temp4") MEMBER("pdiname")"
If return_code > 0 then,
  Address ISPEXEC "LMMREP DATAID("temp4") MEMBER("pdiname")"
Address ISPEXEC "LMCLOSE DATAID("temp4")"
Address ISPEXEC "EDIT DATAID("temp4") MACRO("caam0013")",
  "MEMBER("pdiname")"
Address ISPEXEC "LMCOMP DATAID("temp4")"
return_code = 0
Address ISPEXEC "LMMADD DATAID("output") MEMBER("pdiname")"
If return_code > 0 then,
  Address ISPEXEC "LMMREP DATAID("output") MEMBER("pdiname")"
ERR_EXIT:
Address ISPEXEC "VPUT (AM5VGE) ASIS"
"CANCEL"
Exit
 
 
/*   MAIN INFORMATION*/
MAIN_LOOP:
do until return_code <> 0
  "FIND 'TYPE("restype")' NEXT"
  If return_code > 0 then,
    leave
  "LABEL .ZCSR = .ST 0"
  return_code = 0
  "FIND 'ACF75051' NEXT"
  If return_code = 0 then,
    "LABEL .ZCSR = .EN 0"
  Else
    "LABEL .ZLAST = .EN 0"
  "(STLN) = LINENUM .ST"
  "(ENLN) = LINENUM .EN"
/*say "RESTYPE:"restype "STLN:"stln "ENLN:"enln*/
  return_code = 0
  "CURSOR = .ST 0"
  key = ""
  prefix = ""
  "FIND '$KEY(' .ST .EN"
  If return_code = 0 then do
    "(DATA) = LINE .ZCSR"
    parse var data . "(" key ")" .
    end
  return_code = 0
  "FIND '$PREFIX(' .ST .EN"
  If return_code = 0 then do
    "(DATA) = LINE .ZCSR"
    parse var data . "(" prefix ")" .
    end
  If prefix = " " then,
    prefix = key
/*say "prefix:"prefix "key:"key "pos1:"pos(" "prefix,rec2tbl),
     "pos2:"pos("*",prefix) "pos3:"pos("*",key)*/
  return_code = 0
  If pos(" "prefix,rec2tbl) = 0 &,
     pos("*",prefix) = 0 &,
     pos("*",key) = 0 then do
    "CURSOR = .EN 0"
    iterate
    end
  If pos("*",prefix) > 0 | pos("*",key) > 0 then do
    keynum = right(keynum,2,"0")
    Call process_mask_key
    keynum = keynum + 1
    If return_code = 4 then
      Say pgmname "Unable to process KEY or PREFIX with an *.  ",
        "KEY :"key "PREFIX:"prefix
    end
  Else,
    If pos(" "prefix,rec2tbl) > 0 then do
      keynum = right(keynum,2,"0")
        Call process_information
      keynum = keynum + 1
      end
  BYPASS_KEY:
  return_code = 0
  "CURSOR = .EN 0"
  end
return
 
 
PROCESS_INFORMATION:
rescnt = rescnt
uidnum = 0
lp = "("
rp = ")"
uidkey = "UID("
spc = "          "
spc = spc""spc""spc""spc""spc
cmd1 = left(key"|",42)
uidnum = right(uidnum,4,"0")
cmd = keynum""uidnum""cmd1"0TYPE("restype")"
If prefix <> key then,
  cmd = cmd "$PREFIX("prefix")"
Address ISPEXEC "LMPUT DATAID("temp4") MODE(INVAR) DATALOC(CMD)",
  "DATALEN("length(cmd)")"
 
COLLECT_LOOP:
do until return_code <> 0
  return_code = 0
  "FIND NEXT '"uidkey"' .ST .EN"
  If return_code > 0 then leave
  "(DATA) = LINE .ZCSR"
  uidnum = right(uidnum,4,"0")
  parse var data data " DATA(" .
  data = strip(data,"B")
  parse var data key_suf "UID(" uid ")" data1
  uid = "UID("uid")"
  If key_suf = " " then,
    tkey = prefix
  Else
    tkey = prefix"."key_suf
  tkey = strip(tkey,"T")
  tkey = strip(tkey,"T","-")
  if right(tkey,2) = "-." then do
    tkey = strip(tkey,"T",".")
    tkey = strip(tkey,"T","-")
    end
  parse var data1 . "SERVICE(" data2 ") " .
  if pos(" NEXTKEY("," "data1) > 0 then do
    parse var data1 . "NEXTKEY(" nkey ") " .
    nkey = "NEXTKEY("nkey")"
    end
  else
    nkey = "     "
  If data2 = "" then,
    service = "     "
  Else do
    If pos("READ",data2) = 0 then,
      service = " "
    Else,
      service = "R"
    If pos("ADD",data2) = 0 then,
      service = service" "
    Else,
      service = service"A"
    If pos("UPDATE",data2) = 0 then,
      service = service" "
    Else
      service = service"U"
    If pos("DELETE",data2) = 0 then,
      service = service" "
    Else
      service = service"D"
    If pos("EXECUTE",data2) = 0 then,
      service = service" "
    Else
      service = service"E"
    end
  access = "P"
  If pos(" PREVENT" ," "data1" ") > 0 then,
    access = "P"
  If pos(" LOG" ," "data1" ") > 0 then,
    access = "L"
  If pos(" ALLOW" ," "data1" ") > 0 then,
    access = "A"
  rt = 0
  tr = 0
  If rescnt > 0 then do
    If pdiname = "ZCIC0021" then do
      parse var rec2tbla . =(rescnt) . +9 . resource .
      b = pos(" ",rec2tbla" ",rescnt+13)
      end
    Else do
      parse var rec2tbla . =(rescnt) . +9 resource .
      b = pos(" ",rec2tbla" ",rescnt+9)
      end
    cmd1 = left(key"|"key_suf,42)
    cmd = keynum""uidnum""cmd1"1"resource
    Address ISPEXEC "LMPUT DATAID("temp4") MODE(INVAR)",
      "DATALOC(CMD) DATALEN("length(cmd)")"
    tr = 1
    rt = 1
    end
  Else,
    Do a = 1 to length(rec2tbla)
      If pdiname = "ZCIC0021" then do
        parse var rec2tbla . =(a) . +9 . resource .
        b = pos(" ",rec2tbla" ",a+13)
        end
      Else do
        parse var rec2tbla . =(a) . +9 resource .
        b = pos(" ",rec2tbla" ",a+9)
        end
      a = b + 1
      If pos(resource,tkey) > 0 then,
        tr = 1
      If pos(tkey,resource) > 0 then,
        rt = 1
      cmd1 = left(key"|"key_suf,42)
      If pdiname = "ZCIC0021" then,
        cmd = keynum""uidnum""cmd1"1"restype resource
      Else,
        cmd = keynum""uidnum""cmd1"1"resource
      if pos(resource,tkey) > 1 |,
         pos(tkey,resource) > 1 then iterate
      if pos(resource,tkey) = 0 &,
         pos(tkey,resource) = 0 then iterate
/*    say resource":"tkey":"key_suf":"pos(resource,tkey) pos(tkey,resource),
        pos(key_suf,tkey) pos(key_suf" ",resource" ") compare(resource,tkey)*/
      xx = compare(resource,tkey)
/*    if xx > 1 then,
        say resource tkey compare(resource,tkey),
          length(resource) right(resource,1),
          substr(resource,xx-1,1) right(key_suf,3)
        else
        say resource tkey compare(resource,tkey),
          length(resource) right(resource,1)*/
      If (pos(resource,tkey) > 0 |,
        (pos(tkey,resource) > 0 &,
        pos(key_suf,tkey) = 0) |,
        (pos(tkey,resource) > 0 &,
        pos(key_suf" ",resource" ") > 0)) then do
        if xx = 0 then,        /* resource and tkey match */
          Address ISPEXEC "LMPUT DATAID("temp4") MODE(INVAR)",
            "DATALOC(CMD) DATALEN("length(cmd)")"
        else do
/*        say resource":"tkey":"key_suf":"xx":"length(resource)":",
            right(key_suf,3)":"substr(resource,xx-1,1)":"*/
          if xx > length(resource) &,
            (right(resource,1) = "." |,
            pos(tkey,xx) = ".") then,
            Address ISPEXEC "LMPUT DATAID("temp4") MODE(INVAR)",
              "DATALOC(CMD) DATALEN("length(cmd)")"
          Else,
            if xx > length(resource) &,
              prefix = resource then,
              Address ISPEXEC "LMPUT DATAID("temp4") MODE(INVAR)",
                "DATALOC(CMD) DATALEN("length(cmd)")"
          if xx < length(resource) &,
            substr(prefix"."key_suf,xx) = "-" then,
            Address ISPEXEC "LMPUT DATAID("temp4") MODE(INVAR)",
              "DATALOC(CMD) DATALEN("length(cmd)")"
/*        if xx > length(resource) &,
            (right(resource,1) = "." |,
            right(tkey,1) = ".") then,
            Address ISPEXEC "LMPUT DATAID("temp4") MODE(INVAR)",
              "DATALOC(CMD) DATALEN("length(cmd)")"*/
          if xx > 1 then,
            if xx <= length(resource) &,
              right(key_suf,3) = ".-" then,
              Address ISPEXEC "LMPUT DATAID("temp4") MODE(INVAR)",
                "DATALOC(CMD) DATALEN("length(cmd)")"
/*          if xx <= length(resource) &,
              right(key_suf,3) = ".-" &,
              substr(resource,xx-1,1) = "." then,
              Address ISPEXEC "LMPUT DATAID("temp4") MODE(INVAR)",
                "DATALOC(CMD) DATALEN("length(cmd)")"*/
          end
        end
      If pos(key,resource) = 1 &,
         xx <> 0 then do
        rnr = length(key) + 2
        rnr = length(key)
        mcnt = length(key) + 1
        mcnt = xx
        Do KNR = xx to length(tkey)
          If rnr > length(resource) then do
            knr = length(tkey)
            iterate
            end
          If substr(tkey,knr,1) = "." &,
             substr(tkey,knr,1) <> substr(resource,rnr,1) then do
            knr = length(tkey)
            iterate
            end
          If substr(tkey,knr,1) = "." &,
             substr(tkey,knr,1) <> substr(resource,rnr,1) then do
            knr = length(tkey)
            iterate
            end
          If substr(tkey,knr,1) = substr(resource,rnr,1) then,
            mcnt = mcnt + 1
          If substr(tkey,knr,1) = "-" then do
            Do xa = knr to length(tkey) while substr(tkey,xa,1) = "-"
              end
            rnr = pos(substr(tkey,xa,1),resource,rnr)
            If rnr = 0 then do
              knr = length(tkey)
              mcnt = 0
              end
            Else do
              mcnt = mcnt + xa - knr + 1
              mcnt = mcnt
              knr = xa
              end
            end
          rnr = rnr + 1
  BYPASS_TKEY:
          end
        If mcnt = length(tkey) &,
           substr(tkey,xx,1) = "." &,
           substr(resource,xx,1) = " " then,
          Address ISPEXEC "LMPUT DATAID("temp4") MODE(INVAR)",
            "DATALOC(CMD) DATALEN("length(cmd)")"
        If mcnt = xx &,
           substr(tkey""key_suf,xx,1) = "-" &,
           substr(resource,xx,1) > " " then,
          Address ISPEXEC "LMPUT DATAID("temp4") MODE(INVAR)",
            "DATALOC(CMD) DATALEN("length(cmd)")"
        end
      end
  If rt = 0 & tr = 0 then,
    iterate
  cmd1 = left(key"|"key_suf,42)
  cmd = keynum""uidnum""cmd1"2"left(uid,44)
  cmd = cmd""access""service""nkey
  Address ISPEXEC "LMPUT DATAID("temp4") MODE(INVAR) DATALOC(CMD)",
    "DATALEN("length(cmd)")"
  uidnum = uidnum + 1
  end
 
 
PROCESS_INFO_END:
return_code = 0
Return (0)
 
 
Collect_restypes:
restypes = ""
Do a = 1 to length(rec2tbla)
  parse var rec2tbla . =(a) . +9 rtype resource .
  b = pos(" ",rec2tbla" ",a+13)
  if wordpos(rtype,restypes) = 0 then,
    restypes = restypes""rtype" "
  a = b + 1
  end
restypes = strip(restypes,"T")
return
 
 
PROCESS_MASK_KEY:
  return_code = 0
  "(LNNR,CCNR) = CURSOR"
  /* Count the number of '*' in the PREFIX field. */
  Do a = 1 to length(rec2tbla)
    ast_cnt = 0
    Do X = 1 to length(prefix)
      If substr(prefix,x,1) = "*" then,
        ast_cnt = ast_cnt + 1
      end
    /* Drop the trailing '*' from PREFIX. */
    tkey = strip(prefix,"T","*")
    if tkey = "" then tkey = prefix
    ast_cnt1 = 0
    Do X = 1 to length(tkey)
      If substr(tkey,x,1) = "*" then,
        ast_cnt1 = ast_cnt1 + 1
      end
    restbl = ""
    If pdiname = "ZCIC0021" then do
      parse var rec2tbla . =(a) . +9 . resource extra
      b = pos(" ",rec2tbla" ",a+13)
      end
    Else do
      parse var rec2tbla . =(a) . +9 resource extra
      b = pos(" ",rec2tbla" ",a+9)
      end
/*  parse var rec2tbla . =(a) . +9 resource extra
    b = pos(" ",rec2tbla" ",a+9)*/
    Do C = 1 to length(restbl)
      If length(restbl) > 0 then do
        c1 = pos(" ",restbl" ",c) - 1
/*      restbl_temp = substrc(c,c1,restbl" ")*/
        parse var restbl . =(c) restbl_temp .
        If pos(restbl_temp,resource) > 0 then do
          if extra = "" then a = length(rec2tbla)
          Else a = b + 1
          iterate a
          end
        end
      c = c1 + 1
      end
    mcnt = 0
/*  say "TKEY:"tkey length(tkey) "RESOURCE:"resource length(resource)*/
    If length(tkey) <= length(resource) then do
      Do A1 = 1 to length(tkey)
        If substr(tkey,a1,1) = "*" |,
           substr(tkey,a1,1) = substr(resource,a1,1) then,
              mcnt = mcnt + 1
            Else
              a1 = length(tkey)
        end
      If mcnt = 0 then do
        if extra = "" then a = length(rec2tbla)
        Else a = b + 1
        iterate a
        end
      If length(tkey) = mcnt | ast_cnt = length(prefix) then do
        return_code = 0
        "FIND FIRST '$KEY("resource")'"
        resrc = return_code
        return_code = 0
        rn = pos(".",resource)
        If rn > 0 then do
          tres = left(resource,rn-1)
          "FIND FIRST '$KEY("tres")'"
          end
        tresrc = return_code
        return_code = 0
        /* Test for $KEY(&RESOURCE not found or a period in RESOURCE */
        /* and $KEY(&TRES not found or no period in RESOURCE         */
/*      say "RESOURCE:"resource "PREFIX:"prefix "TKEY:"tkey,
          "AST_CNT:"ast_cnt "MCNT:"mcnt "RESRC:"resrc "RN:"rn,
          "TRESRC:"tresrc "RESTBL:"restbl*/
        If resrc = 0 | (rn > 0 & tresrc = 0) then do
          restbl = restbl""resource" "
          If left(restbl,1) = " " then,
            restbl = substr(restbl,2)
          end
        Else,
          If mcnt = length(tkey) then do
            rescnt = a
            "CURSOR =" lnnr ccnr
            Call process_information
/*          say "RESOURCE:"resource "PREFIX:"prefix "TKEY:"tkey,
              "AST_CNT:"ast_cnt "MCNT:"mcnt*/
            end
        "CURSOR =" lnnr ccnr
        rescnt = 0
        end
      end
BYPREC2TBL:
    if extra = "" then a = length(rec2tbla)
    Else a = b + 1
    end
  "CURSOR =" lnnr ccnr
  Return (return_code)
 
 
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 >= 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