/* REXX */
/* CLS2REXXed by FSOX001 on 25 Aug 2017 at 11:00:04  */
Signal On NoValue
Call On Error
Signal On Failure
Signal On Syntax
Parse source opsys . exec_name .
 
/*********************************************************************/
/* 04/22/2005 JL.Nelson Created for dialog - select only OPEN PDIs   */
/* 05/05/2005 JL.Nelson Added creation date to display               */
/* 05/23/2005 JL.Nelson Check for environment TSO or BATCH           */
/* 06/22/2005 JL.Nelson Set return_code after SYSDSN                 */
/* 07/08/2005 JL.Nelson Modified for FSO PDI short dataset name.     */
/* 11/08/2005 JL.NELSON Re-did data set checks with error panel.     */
/* 03/07/2006 C. Stern  Minor text change and support for LPAR node. */
/* 01/31/2008 CL.Fenton Chg to issue VGET of tracing variables.      */
/* 07/16/2009 CL.Fenton Chg to allow for multiple selections.        */
/* 08/25/2017 CL.FENTON Converted script from CLIST to REXX.         */
/* 04/26/2018 CL.FENTON Striped trailing spaces for pdiname,         */
/*            STS-019405.                                            */
/* 05/24/2018 CL.Fenton Chgs made to identify status of PDI mbrs,    */
/*            status reported are open (O) and not reviewed (NR),    */
/*            STS-019713.                                            */
/*                                                                   */
/*                                                                   */
/*********************************************************************/
pgmname = "SRR$PDI  05/24/18"
pgm8 = substr(pgmname,1,8)
cacm0424 = "SRRMPDI"          /* Edit MACRO for PDI    */
cacp0424 = "SRRPPDI"          /* Dialog panel name     */
jobrpts  = "CACJ041R"         /* BATCH Reports job     */
/*******************************************/
/* CONSLIST = CONLIST                      */
/* COMLIST = LIST                          */
/* SYMLIST = SYMLIST                       */
/* TERMPRO = PROMPT                        */
/* TERMMSGS = MESSAGES                     */
/* TRACE TURNS ON MESSAGING                */
/*******************************************/
Address ISPEXEC
"VGET (CONSLIST COMLIST SYMLIST TERMMSGS) ASIS"
 
If CONSLIST = "ON" | COMLIST = "ON" | SYMLIST = "ON" then,
  Trace r
 
syssymlist = symlist           /* CONTROL SYMLIST/NOSYMLIST */
sysconlist = conslist          /* CONTROL CONLIST/NOCONLIST */
syslist = comlist              /* CONTROL LIST/NOLIST       */
sysmsg = termmsgs              /* CONTROL MSG/NOMSG         */
sysprompt = "OFF"              /* CONTROL NOPROMPT          */
sysflush = "OFF"               /* CONTROL NOFLUSH           */
sysasis = "ON"                 /* CONTROL ASIS - CAPS OFF   */
"CONTROL NONDISPL ENTER"
"CONTROL ERRORS RETURN"
If SysVar('SysEnv') <> "FORE" then do
  Say pgmname "CLIST running in background, can not receive input",
    "SYSENV =" SysVar('SysEnv')
  return_code = 8
  SIGNAL  ERR_EXIT
  end
return_code = 0
"VGET (SRRINST SRRUSER) PROFILE"
/*******************************************/
/* VERFIY HLQ FOR PDI dataset              */
/*******************************************/
return_code = 0
pdidsn = srruser".PDI"     /* For FSO*/
locate = sysdsn("'"pdidsn"'")
If locate <> "OK" then do
  pdidsn = srruser"."jobrpts".PDI"
  locate = sysdsn("'"pdidsn"'")
  end
If locate <> "OK" then do
  pdidsn = srruser"."jobrpts"."sysname".PDI"
  locate = sysdsn("'"pdidsn"'")
  end
If locate <> "OK" then do
  pdidsn = srruser"."jobrpts"."sysplex".PDI"
  locate = sysdsn("'"pdidsn"'")
  end
If locate <> "OK" then do
  srrerr = "Dataset PDI is missing, batch job" jobrpts "must",
    "first be run to create the file."
  srrerc = return_code
  zerrlm = pdidsn
  srrmsg1 = locate
  srrmsg2 = " "
  "DISPLAY PANEL(SRRPERR)"
  SIGNAL  ERR_EXIT
  end
"LMINIT DATAID(PDIID) DATASET('"pdidsn"')"
lminit_pdiid_rc = return_code
If return_code <> 0 then do
  Say pgmname "LMINIT_PDIID_RC" return_code zerrsm
  Say pgmname "DSN="pdidsn "Data Set Error"
  SIGNAL  ERR_EXIT
  end
"LMOPEN DATAID("pdiid") OPTION(INPUT)"
lmopen_pdiid_rc = return_code
If return_code <> 0 then do
  Say pgmname "LMOPEN_PDIID_RC" return_code zerrsm
  Say pgmname "DSN="pdidsn "Data Set Error"
  SIGNAL  ERR_EXIT
  end
 
return_code = 0
"TBCREATE PDITABLE REPLACE NOWRITE KEYS(PDINAME)",
  "NAMES(S PDIINFO ST)"
 
If return_code > 4 then do
  Say pgmname "TBCREATE  RC =" return_code zerrsm
  SIGNAL  ERR_EXIT
  end
return_code = 0
 
"LMMLIST DATAID("pdiid") OPTION(LIST) MEMBER(PDINAME) STATS(NO)"
lmmlist_pdiid_rc = return_code
Do while return_code = 0
  return_code = 0
  pdiname = strip(pdiname,"T")
  "VIEW DATAID("pdiid") MACRO("cacm0424") MEMBER("pdiname")"
  view_pdiid_rc = return_code
  If return_code > 4 then do
    Say pgmname "VIEW_PDIID_RC =" return_code member zerrsm
    SIGNAL  ERR_EXIT
    end
  "VGET (PDIINFO ST CM24VGET) ASIS"
  If st <> "" then do
    s = " "
    pdiinfo = left(pdiinfo,60)
    "TBADD PDITABLE"
    end
  return_code = 0
  "LMMLIST DATAID("pdiid") OPTION(LIST) MEMBER(PDINAME)",
    "STATS(NO)"
  end
"LMMLIST DATAID("pdiid") OPTION(FREE)"
return_code = 0
"LMCLOSE DATAID("pdiid")"
lmclose_pdiid_rc = return_code
return_code = 0
"LMFREE DATAID("pdiid")"
lmfree_pdiid_rc = return_code
return_code = 0
"DSINFO DATASET('"pdidsn"')"
return_code = 0
"TBTOP PDITABLE"
"TBDISPL PDITABLE PANEL("cacp0424") AUTOSEL(NO)"
curnr = 1
 
 
TBDISPL:
do until return_code > 0
  return_code = 0
  pdiname = " "
  "TBDISPL PDITABLE PANEL("cacp0424") AUTOSEL(NO)"
  curnr = ztdtop
  If return_code = 8 then,
    leave
  "VGET (ZVERB ZSCROLLN) ASIS"
  return_code = 0
  Do until ztdsels = 0
    pdiname = pdiname
    s = s
    "TBMOD PDITABLE"
    if ztdsels > 1 then,
      "TBDISPL PDITABLE"
    else,
      ztdsels = 0
    end /* Do while ztdsels = 0 */
  if zverb <> "" then do
    iterate
    end
 
 
PROCESS_TABLE:
  tbl_nr = 1
  tblnr = 1
  return_code = 0
  "TBTOP PDITABLE"
  "TBSKIP PDITABLE ROW("tbl_nr")"
  "TBGET PDITABLE POSITION(TBLNR)"
  return_code = 0
  Do while return_code = 0
    pdisel = s
    If pdisel = "B" | pdisel = "S" then do
      "CONTROL DISPLAY SAVE"
      "BROWSE DATASET('"pdidsn"("pdiname")')"
      "CONTROL DISPLAY RESTORE"
      end
    If pdisel = "E" then do
      "CONTROL DISPLAY SAVE"
      "EDIT DATASET('"pdidsn"("pdiname")')"
      "CONTROL DISPLAY RESTORE"
      end
    If pdisel = "V" then do
      "CONTROL DISPLAY SAVE"
      "VIEW DATASET('"pdidsn"("pdiname")')"
      "CONTROL DISPLAY RESTORE"
      end
    If s <> "" then do
      s = " "
      "TBMOD PDITABLE SAVE("pdiname")"
      end /* If s <> "" */
/*  "TBDISPL PDITABLE"*/
    return_code = 0
    tblnr = tblnr + 1
    "TBSKIP PDITABLE ROW("tblnr")"
    end /* Do while return_code = 0 */
  return_code = 0
  "TBTOP PDITABLE"
  "TBSKIP PDITABLE ROW("curnr")"
  end
 
 
END_EXIT:
return_code = 0
"TBEND PDITABLE"
 
 
ERR_EXIT:
zispfrc = return_code
"VPUT (ZISPFRC) SHARED"
Exit
 
 
NoValue:
Failure:
Syntax:
say pgmname 'REXX error' rc 'in line' sigl':' strip(ERRORTEXT(rc))
say SOURCELINE(sigl)
Exit
 
 
Error:
return_code = RC
return
 
 
