/* REXX */
/*                                       */
/* AUTHOR: Charles Fenton                */
/*                                       */
/*********************************************************************/
/* DISPLAY SYSTEM INFORMATION ON TERMINAL                            */
/*********************************************************************/
/*********************************************************************/
/* This script generates analysis of CA1 PDI's                       */
/*********************************************************************/
/* Change summary:                                                   */
/* 02/28/2009 CL Fenton Initial creation of script generate and      */
/*            read CA1 utility reports and process them to create    */
/*            finding details.  Addition processes create to         */
/*            evaluate and generate dataset lists for products.      */
/* 05/08/2009 CL Fenton Removed extra say statements and             */
/*            commented out commands.                                */
/* 06/02/2009 CL Fenton Changes CACT0001 to CACT0000, CACM042T to    */
/*            CACM000T.  Changes for reflect new table               */
/*            information.  Added additional TYPERUNs/products.      */
/* 09/22/2009 CL Fenton Added addition Product collection for        */
/*            ROSCOE, SRRAUDT, TDMF, VTAM, and VSS.                  */
/* 10/01/2009 CL Fenton Added collection for CA1 resource class      */
/*            CATAPE by collecting CA1 passwords and passing         */
/*            information to resource generation process.            */
/* 10/09/2009 CL Fenton Added analysis of CL/SuperSession PDIs,      */
/*            ZCLS0011, ZCLS0012, ZCLS0014, and ZCLS0016.            */
/* 02/16/2010 CL Fenton Added collection of rectype 1 for KLS.       */
/* 02/26/2010 CL Fenton Chgd analysis of CL/SuperSession PDIs,       */
/*            ZCLS0040 for ZCLS0011, ZCLS0041 for ZCLS0012,          */
/*            ZCLS0042 for ZCLS0014, and ZCLS0043 for ZCLS0016.      */
/*            Added analysis for ZFDR0040.                           */
/* 03/18/2010 CL Fenton Added addition Product collection for        */
/*            CLSUPER, NETVIEW, FDR, and TADZ.                       */
/* 07/19/2010 CL Fenton Added addition Product collection for HCD    */
/*            and ICSF.                                              */
/* 10/29/2010 CL Fenton Chgd collection for CA1 to collect           */
/*            additional members and store them as members in        */
/*            CA1RPT.                                                */
/* 04/26/2011 CL Fenton Chgd collection for CA1 to TMOOPTxx          */
/*            member for r12.0 and above for SHUTDWN keyword.        */
/* 06/26/2011 CL Fenton Added collection for BMCMVZ, CSSMTP, and     */
/*            VTAPE.                                                 */
/* 09/12/2011 CL Fenton Added collection for the Zxxx0032 PDIs.      */
/*            Added collection and automation for SDSF.              */
/*            CSD-AR002893724.                                       */
/* 12/13/2011 CL Fenton Added collection changes for to separate     */
/*            products CA1, NC-PASS, and SDSF into independent       */
/*            STIGs and added CA Common Services (CCS) for           */
/*            collection, CSD-AR003079950.                           */
/* 02/13/2012 CL Fenton Added collection for active resource         */
/*            classes of products that have a Zxxx0038               */
/*            vulnerablity, CSD-AR003247757.                         */
/* 02/17/2012 CL Fenton Chged collection of CA1 to reflect chgs      */
/*            to r12.6 use of TMOSYSxx and removed utility calls     */
/*            to separate steps, CSD-AR003275531.                    */
/* 04/26/2012 CL Fenton Corrected problem with different formats     */
/*            of Started task records in the Dialog data set for     */
/*            the collect_stc process, CSD-AR003392779.              */
/* 06/14/2012 CL Fenton Added addition Product collection for        */
/*            Abend-AID and Health Checker, CSD-AR003400260.         */
/* 09/18/2012 CL Fenton Added resource collection for Abend-AID,     */
/*            CSD-AR002266892.                                       */
/* 01/02/2013 CL Fenton Removed ATHOPEN check for SDSF,              */
/*            STS-000914.  Added CAMIM, STS-001238.                  */
/* 02/27/2013 CL Fenton Corrected issue on comments, "*",            */
/*            containing configuration settings, STS-002038.         */
/* 06/06/2013 CL Fenton Added loadlib data set location to           */
/*            RECTYPES to correct issue with CATSOL resources,       */
/*            STS-002427.                                            */
/* 06/24/2013 CL Fenton Added automation for ZNET0040 and new        */
/*            automation for ZNET0020, STS-002881.                   */
/* 09/27/2013 CL Fenton Correct error in collecting ESMTYPE for      */
/*            ZMVZ0040, STS-004200.                                  */
/* 03/14/2014 CL Fenton Chgd "^=" to "<>" to correct upload          */
/*            translation issue.  Add keyword/value process for      */
/*            Netview, and added requirement for                     */
/*            SECOPTS.OPERSEC=SAFPW.  When SAFPW is specified        */
/*            marks ZNET0020 an not applicable, STS-005268 and       */
/*            STS-005281.                                            */
/* 08/15/2014 CL Fenton Chgd keyword/value process for Netview,      */
/*            and removed requirement for SECOPTS.OPERSEC=SAFPW,     */
/*            STS-006431.                                            */
/* 12/03/2014 CL Fenton Chgd requirement for SDSF to restrict use    */
/*            of AUPDT value greater than 0, STS-002801.  Added      */
/*            analysis of ZCICR021 to verify that resources are      */
/*            active.                                                */
/* 12/11/2014 CL Fenton Updated EXIT= entries for CAC enabled in     */
/*            ZCLS0042, STS-007443.                                  */
/* 05/04/2015 CL Fenton Removed IDMS from automation, STS-007219     */
/*            and STS-007637.                                        */
/* 08/19/2015 CL Fenton Added AIDUSER for AbendAID User datasets,    */
/*            STS-011534.                                            */
/* 01/28/2016 CL Fenton Added Not Applicable when SDSF INDEX is      */
/*            not specified in ISFPRMxx member for ZISF0002,         */
/*            STS-013267.                                            */
/* 10/26/2016 CL Fenton Added requirements CA1 Started Tasks         */
/*            dataset, STS-015909.                                   */
/* 07/21/2017 CL Fenton Added requirements CSSMTP Started Tasks      */
/* 01/17/2018 CL Fenton Chgd requirements for ZCLS0042 to allow      */
/*            SAF to be a valid entry for non-CAC definitions        */
/*            within the KLVINNAM member, STS-019168.                */
/* 05/14/2018 CL Fenton Chgd evaluation of ABENDAID to               */
/*            accommodate changes with the release of ABENDAID       */
/*            V17.02, STS-019526.                                    */
/* 08/03/2018 CL Fenton Changed evaluation of $$SECxxx resource      */
/*            to utilize IOASECUR to obtain resource class           */
/*            entries for PDI member that will be merged with        */
/*            Zxxx0020, STS-019703.                                  */
/* 11/30/2018 CL Fenton Corrected change in z/OS 2.3 that caused     */
/*            the dsn not to be available on the PARM: keyword       */
/*            when the F SDSF,D command is issued.                   */
/* 08/19/2019 CL Fenton Changed CA1 CREATE parameter requirement     */
/*            to ALTER for RACF and CREATE for ACF2 and TSS,         */
/*            STS-022991.                                            */
/* 06/19/2020 CL Fenton Changed ZCICR021 to ZCICR038.                */
/* 01/25/2021 CL Fenton Chgs to determine if CHKPOINT DD statement   */
/*            specified in SMTP proc, also changed other similar     */
/*            process areas, STS-025549.                             */
/* 05/26/2021 CL Fenton Make additional script to check for the      */
/*            SMTP evaluation.                                       */
/* 10/18/2021 CL Fenton Chgs to process CACM000T for SDSF after      */
/*            determining if INDEX is specified in the JESPARM       */
/*            member configuration.                                  */
/*                                                                   */
/*                                                                   */
/*                                                                   */
/*                                                                   */
/*********************************************************************/
PGMNAME = 'CACC0009 10/18/21'
TERMMSGS = 'OFF'
COMLIST  = 'OFF'
CONSLIST = 'OFF'
SYMLIST  = 'OFF'
TERMPRO  = 'OFF'
CACT0000 = 'CACT0000'
CACT0008 = 'CACT0008'
CACM000T = 'CACM000T'
DSNLIST  = 'DSNLIST'
CACM000B = 'CACM000B'
CACM000D = 'CACM000D'
lmmfind_dialog = 'N/A'
edit_cact0000  = 'N/A'
edit_dsnlist_ca1rpt = 'N/A'
edit_dsnlist   = 'N/A'
lminit_cntl    = 0
lminit_dialog  = 0
lminit_pdidd   = 0
lminit_table   = 0
lmopen_dialog  = 0
lmopen_pdidd   = 0
lmclose_dialog = 0
lmclose_pdidd  = 0
lmfree_cntl    = 0
lmfree_dialog  = 0
lmfree_pdidd   = 0
lmfree_table   = 0
cact0000_sw = ""
pdi = ''
Numeric digits 10                           /* dflt of 9 not enough  */
Arg OPTION
OPTION = translate(OPTION,'=;','()')
interpret OPTION
if TRACE = 'ON' then do
  TERMMSGS = ON
  COMLIST  = ON
  CONSLIST = ON
  SYMLIST  = ON
  TERMPRO  = ON
  end
Address ISPEXEC
"CONTROL NONDISPL ENTER"
"CONTROL ERRORS RETURN"
"VPUT (CONSLIST COMLIST SYMLIST TERMPRO TERMMSGS TYPERUN CACT0000)"
If CONSLIST = ON | COMLIST = ON | SYMLIST = ON | TRACE = ON ,
  then Trace ?r
"SELECT CMD(CACC1000 ACP)"
"VGET (ACPNAME ACPVERS)"
"lminit dataid(dialog) ddname(dialog)"
lminit_dialog = RC
"lminit dataid(cntlid) ddname(cntl)"
lminit_cntl = RC
"lminit dataid(pdidd) ddname(pdidd)"
lminit_pdidd = RC
"lminit dataid(table) ddname(table)"
lminit_table = RC
"lmopen dataid("dialog")"
lmopen_dialog = RC
"lmopen dataid("pdidd") option(output)"
lmopen_pdidd = RC
if typerun <> "SDSF" then do
  "EDIT DATAID("table") MACRO("CACM000T") MEMBER("CACT0000")"
  edit_cact0000 = RC
  end
signal on syntax name error
TYPRUN=left(TYPERUN,8,"9")
interpret call TYPRUN
continue:
"lmclose dataid("dialog")"
lmclose_dialog = RC
"lmclose dataid("pdidd")"
lmclose_pdidd = RC
"lmfree dataid("cntlid")"
lmfree_cntl = RC
"lmfree dataid("dialog")"
lmfree_dialog = RC
"lmfree dataid("pdidd")"
lmfree_pdidd = RC
"lmfree dataid("table")"
lmfree_table = RC
If TERMMSGS = ON then do
  say
  say '==============================================================='
  say PGMNAME 'LMINIT_CNTL                   ' lminit_cntl
  say PGMNAME 'LMINIT_DIALOG                 ' lminit_dialog
  say PGMNAME 'LMINIT_PDIDD                  ' lminit_pdidd
  say PGMNAME 'LMINIT_TABLE                  ' lminit_table
  say PGMNAME 'LMOPEN_DIALOG                 ' lmopen_dialog
  say PGMNAME 'LMOPEN_PDIDD                  ' lmopen_pdidd
  say PGMNAME 'LMMFIND_DIALOG                ' lmmfind_dialog
  say PGMNAME 'EDIT_CACT0000                 ' edit_cact0000
  if TYPERUN = 'CA1' then do
    say PGMNAME 'EDIT_DSNLIST_CA1RPT           ' edit_dsnlist_ca1rpt
    say PGMNAME 'EDIT_DSNLIST_CA1PROD          ' edit_dsnlist
    end
  else say PGMNAME 'EDIT_DSNLIST                  ' edit_dsnlist
  say PGMNAME 'LMCLOSE_DIALOG                ' lmclose_dialog
  say PGMNAME 'LMCLOSE_PDIDD                 ' lmclose_pdidd
  say PGMNAME 'LMFREE_CNTL                   ' lmfree_cntl
  say PGMNAME 'LMFREE_DIALOG                 ' lmfree_dialog
  say PGMNAME 'LMFREE_PDIDD                  ' lmfree_pdidd
  say PGMNAME 'LMFREE_TABLE                  ' lmfree_table
  say '==============================================================='
  end
/*********************************************************************/
/* Done looking at all control blocks                                */
/*********************************************************************/
Exit 0                                       /* End CACC1001 - RC 0  */
 
 
/*********************************************************************/
/*  Start of sub-routines                                            */
/*********************************************************************/
process_pdi:
Address ISPEXEC
parse arg pdi "#" findtxt "$" finding
os = "999999"
bl = " "
say PGMNAME 'Processing PDI' pdi'.'
if findtxt = "" then do
  ac = 'Not a Finding'
  "LMPUT DATAID("pdidd") MODE(INVAR) DATALOC(ac)",
    "DATALEN("length(ac)") MEMBER("pdi")"
/*"LMPUT DATAID("pdidd") MODE(INVAR) DATALOC(bl)",
    "DATALEN("length(bl)") MEMBER("pdi")"
  ac = '     'finding
  "LMPUT DATAID("pdidd") MODE(INVAR) DATALOC(ac)",
    "DATALEN("length(ac)") MEMBER("pdi")"
  signal replace */
  end
else ,
  "LMPUT DATAID("pdidd") MODE(INVAR) DATALOC(findtxt)",
    "DATALEN("length(findtxt)") MEMBER("pdi")"
sp = '    '
do until finding = ""
if finding = "" then leave
parse value finding with s"{"text"}"finding
if s <> os then do
  "LMPUT DATAID("pdidd") MODE(INVAR) DATALOC(bl)",
    "DATALEN("length(bl)") MEMBER("pdi")"
  if s <> '' then do
    ac = '    ' s
    "LMPUT DATAID("pdidd") MODE(INVAR) DATALOC(ac)",
      "DATALEN("length(ac)") MEMBER("pdi")"
    sp = '         '
    end
  os = s
  end
if text <> "" then do
  ac = sp text
  "LMPUT DATAID("pdidd") MODE(INVAR) DATALOC(ac)",
    "DATALEN("length(ac)") MEMBER("pdi")"
  end
end
replace:
"LMMADD DATAID("pdidd") MEMBER("pdi")"
if RC = 4 then do
  "LMMREP DATAID("pdidd") MEMBER("pdi")"
  if RC <> 0 then,
    say PGMNAME 'LMMREP_PDIDD =' RC PDI ZERRSM
  end
return
 
 
collect_stc:
Address ISPEXEC
parse arg pdi
if pdi = '' | ACPNAME = "ACF2" then return
otermmsgs = TERMMSGS
TERMMSGS = "OFF"
"vput (termmsgs)"
"SELECT CMD(CACC1000 MSTRJCL)"
"VGET (PROC)"
procdsns = PROC
"SELECT CMD(CACC1000 JESPROC)"
TERMMSGS = otermmsgs
"vput (termmsgs)"
"VGET (PROC)"
procdsns = procdsns PROC
rectype = "1"
call COLLECT_REC
DSNS =
do until recs = ''
  parse var recs . .  mbr dsn usr 81 recs
  usr = strip(usr)
  if length(usr) > 8 then do
    mbr = dsn
    parse var usr dsn usr
    end
  usr = strip(usr)
  if wordpos(dsn,procdsns) <> 0 then ,
    DSNS = DSNS""left(left(pdi,8)left(mbr,8)left(usr,8),80)
end
ttyperun = TYPERUN
TYPERUN = "TEXT"
"VPUT (TYPERUN DSNS)"
"EDIT dataid("table") member("CACTSTCS") macro("CACM000D")"
TYPERUN = strip(ttyperun)
"VPUT (TYPERUN)"
return
 
 
process_cls:
Address ISPEXEC
parse arg pdi
if pdi = '' | ACPNAME <> "RACF" then return
DSNS =
if cls = "" then do
  rectype = "3"
  call COLLECT_REC
  cls =
  do until recs = ''
    parse var recs . . mbr dsn 81 recs
    cls = cls strip(dsn)
  end
end
cls = strip(cls)
do until cls = ''
  parse var cls mbr cls
  DSNS = DSNS""left(left(pdi,8)left(mbr,8),80)
end
ttyperun = TYPERUN
TYPERUN = "TEXT"
"VPUT (TYPERUN DSNS)"
"EDIT dataid("table") member("CART0000") macro("CACM000D")"
TYPERUN = strip(ttyperun)
"VPUT (TYPERUN)"
return
 
 
novalue:
syntax:
failure:
halt:
error:
say
say pgmname TYPERUN "ERRORTEXT"(rc) 'for this processing.'
signal continue
 
 
ABNDAID9:
dsns = "AIDRPT"
rectype = "D"
call COLLECT_DSN
dsns = "AIDSTC"
rectype = "E"
call COLLECT_DSN
dsns = "AIDUSER"
rectype = "F"
call COLLECT_DSN
call collect_stc ZAID0032
rectype = "1"
call COLLECT_REC
DSNS =
ac =
line =
newline =
obtain_line =
ind =
svrname = ""
mbrsuf  = ""
dsnmbr  = ""
do until recs = ''
  parse var recs . .  mbr dsn usr 81 recs
  usr = strip(usr)
  if length(usr) > 8 then do
    mbr = dsn
    parse var usr dsn usr
    end
  if sysdsn("'"dsn"("mbr")'") = "OK" then do
    "VGET (PROC)"
    oproc = PROC
    stcproc = dsn
    proc = dsn
    procvol = ""
    "VPUT (STCPROC PROC PROCVOL)"
    otermmsgs = TERMMSGS
    oconlist  = CONLIST
    oconslist = CONSLIST
    osymlist  = SYMLIST
    otermpro  = TERMPRO
    TERMMSGS = "OFF"
    COMLIST  = "OFF"
    CONSLIST = "OFF"
    SYMLIST  = "OFF"
    TERMPRO  = "OFF"
    "VPUT (CONSLIST COMLIST SYMLIST TERMPRO TERMMSGS)"
    x = outtrap("data.")
    a = CACC1000('DDP JESPROC' mbr)
    y = outtrap(off)
    TERMMSGS = otermmsgs
    CONLIST  = oconlist
    CONSLIST = oconslist
    SYMLIST  = osymlist
    TERMPRO  = otermpro
    "VPUT (CONSLIST COMLIST SYMLIST TERMPRO TERMMSGS)"
    "vget (STCPROC PROC dddsns) asis"
    PROC = oproc
    "vput (PROC)"
/*  say dddsns*/
/*  do i = 1 to data.0
      say data.i
      end*/
    start   = "OFF"
    do i = 1 to data.0
      if pos("PGM=FDBMMPLU",data.i)<>0 then,
        start = "ON"
      if start = "ON" & pos("PARM=",data.i)<>0 then do
        parse var data.i ."PARM="parminfo
        if parminfo <> "" then do
          parminfo = strip(parminfo,'T')
          parminfo = strip(parminfo,,"'")
          parminfo = strip(parminfo,,'"')
          if words(parminfo) = 3 & ,
             word(parminfo,2) = "VIEWER" then do
            svrname = word(parminfo,1)
            mbrsuf = word(parminfo,3)
            "vput (svrname)"
            end
          end
        start = "OFF"
        leave
        end
      end
    if pos("//FDBDPARM",dddsns) > 0 then do
      parse var dddsns . "//FDBDPARM" dsnmbr "//"
      say pgmname "Found DD FDBPARM" dsnmbr"."
      end
    else do
      if datatype(mbrsuf,"N") = 1 then do
        a = CACC1000('DD JESPROC CMSC')
        "vget (STCPROC PROC dddsns) asis"
        parse var dddsns . "//CWPARM" dsnmbr "//"
        say pgmname "Found DD CWPARM" strip(dsnmbr)"."
        dsnmbr = strip(dsnmbr)"(AAVW"mbrsuf")"
        mbrsuf = ""
        end
      end
    dsnmbr = strip(dsnmbr)
    tmsg = msg("off")
    if sysdsn("'"dsnmbr"'") = "OK" then do
      say pgmname "Processing dataset/member" dsnmbr "for" dsn"("mbr")."
      pdi = ""
      line =
      keywords = "EXTERNAL_SECURITY_FUNCTION_CHECK",
        "EXTERNAL_SECURITY_RESOURCE_CLASS EXTERNAL_SECURITY_PREFIX",
        "EXTERNAL_SECURITY_DATASET_CHECK USER_TIMEOUT"
      values   = ""
      call process_config "COMMA"
      b =
      if wordpos("is not",line) = 0 then do
        do until line = ''
          parse var line . "{" a "}" line
          b = b"{"a"}"
          if pos("EXTERNAL_SECURITY_RESOURCE_CLASS",a) = 1 then do
            parse var a ."="RESCLASS
            "vput (resclass)"
            end
          if pos("EXTERNAL_SECURITY_PREFIX",a) = 1 then do
            parse var a ."="PREFIX
            "vput (prefix)"
            end
          end
        if b <> " " then obtain_line = obtain_line""mbr dsnmbr b
        end
      pdi = "ZAID0040"
      line =
      keywords = "EXTERNAL_SECURITY_ENABLED"
      values   = 'YES'
      call process_config "COMMA"
      dsnmbr = ""
      end
    if line <> " " then newline = newline""mbr" "line
    line =
    end
  end
pdi = "ZAID0040"
if newline <> "" then ac = "The following Abend-AID parameter(s) is",
  "(are) improperly defined:"
call process_pdi pdi"#"ac"$"newline
 
"EDIT dataid("table") member("CACT0008") macro("CACM000B")"
return
 
 
BMCCTD99:
dsns = "CTDRPT"
rectype = "D"
call COLLECT_DSN
dsns = "CTDSTC"
rectype = "E"
call COLLECT_DSN
dsns = "CTDUSER"
rectype = "F"
call COLLECT_DSN
call collect_stc ZCTD0032
rectype = "5"
call COLLECT_REC
ca1mbrs =
do until recs = ''
  parse var recs . . . mbr dsn . 81 recs
  ca1mbrs = ca1mbrs dsn'('mbr')'
end
ca1mbrs = strip(ca1mbrs)
call print_dsnmbr ioarpt
ac =
line =
ind =
RESCLASS =
keywords = '%QNAME%'
values   = 'xxxxxxxx'
dsnmbr = dsn"(DEFPARM)"
if sysdsn("'"dsnmbr"'") = "OK" then,
  call process_config
parse var line . "=" QNAME "}" .
QNAME = strip(QNAME)
 
keywords = 'DEFMCHKD SECTOLD DFMD01 DFMD04 DFMD08 DFMD19 DFMD23',
           'DFMD24 DFMD26 DFMD27'
values   = '$$CTDEDM NO EXTEND EXTEND EXTEND EXTEND EXTEND EXTEND',
           'EXTEND EXTEND'
pdi = "ZCTD0040"
ac =
line =
ind =
tmsg = msg("off")
do until ca1mbrs = ''
  parse var ca1mbrs dsnmbr ca1mbrs
  if sysdsn("'"dsnmbr"'") = "OK" then,
    call process_config
end
if line <> "" then ,
  ac = "The following BMC CONTROL-D parameter(s) is (are)",
       "improperly defined:"
else ,
  do x = 1 to words(keywords)
    line = strip(line)"{"left(word(keywords,x),12) word(values,x)"}"
  end
call process_pdi pdi"#"ac"$"line
call process_ioasecur
"VPUT (PRESCL RESCLASS QNAME)"
"EDIT dataid("table") member("CACT0008") macro("CACM000B")"
return
 
 
BMCCTM99:
dsns = "CTMRPT"
rectype = "D"
call COLLECT_DSN
dsns = "CTMSTC"
rectype = "E"
call COLLECT_DSN
dsns = "CTMUSER"
rectype = "F"
call COLLECT_DSN
dsns = "CTMJCL"
rectype = "G"
call COLLECT_DSN
call collect_stc ZCTM0032
rectype = "5"
call COLLECT_REC
ca1mbrs =
do until recs = ''
  parse var recs . . . mbr dsn . 81 recs
  ca1mbrs = ca1mbrs dsn'('mbr')'
end
ca1mbrs = strip(ca1mbrs)
call print_dsnmbr ioarpt
ac =
line =
ind =
RESCLASS =
QNAME =
keywords = '%QNAME%'
values   = 'xxxxxxxx'
dsnmbr = dsn"(DEFPARM)"
if sysdsn("'"dsnmbr"'") = "OK" then,
  call process_config
parse var line . "=" QNAME "}" .
QNAME = strip(QNAME)
 
keywords = 'DEFMCHKM SECTOLM DFMM01 DFMM02 DFMM08 MSUBCHK'
values   = '$$CTMEDM NO EXTEND EXTEND EXTEND NO'
select
  when ACPNAME = 'ACF2' then do
    keywords = keywords 'SAFJCARD'
    values   = values 'U'
    end
  when ACPNAME = 'RACF' then do
    keywords = keywords 'RACJCARD'
    values   = values 'U'
    end
  when ACPNAME = 'TSS' then do
    keywords = keywords 'TSSJCARD'
    values   = values 'U'
    end
  end
pdi = "ZCTM0040"
ac =
line =
ind =
tmsg = msg("off")
do until ca1mbrs = ''
  parse var ca1mbrs dsnmbr ca1mbrs
  if sysdsn("'"dsnmbr"'") = "OK" then,
    call process_config
end
if line <> "" then ,
  ac = "The following BMC CONTROL-M parameter(s) is (are)",
       "improperly defined:"
else ,
  do x = 1 to words(keywords)
    line = strip(line)"{"left(word(keywords,x),12) word(values,x)"}"
   end
call process_pdi pdi"#"ac"$"line
call process_ioasecur
"VPUT (PRESCL RESCLASS QNAME)"
"EDIT dataid("table") member("CACT0008") macro("CACM000B")"
return
 
 
BMCCTO99:
dsns = "CTORPT"
rectype = "D"
call COLLECT_DSN
dsns = "CTOSTC"
rectype = "E"
call COLLECT_DSN
call collect_stc ZCTO0032
rectype = "5"
call COLLECT_REC
ca1mbrs =
do until recs = ''
  parse var recs . . . mbr dsn . 81 recs
  ca1mbrs = ca1mbrs dsn'('mbr')'
end
ca1mbrs = strip(ca1mbrs)
call print_dsnmbr ioarpt
ac =
line =
ind =
RESCLASS =
QNAME =
keywords = '%QNAME%'
values   = 'xxxxxxxx'
dsnmbr = dsn"(DEFPARM)"
if sysdsn("'"dsnmbr"'") = "OK" then,
  call process_config
parse var line . "=" QNAME "}" .
QNAME = strip(QNAME)
 
tmsg = msg("off")
do until ca1mbrs = ''
  ac =
  line =
  ind =
  parse var ca1mbrs dsnmbr ca1mbrs
  if pos('SECPARM',dsnmbr) <> 0 then do
    pdi = "ZCTO0040"
    keywords = 'DEFMCHKO SECTOLO DFMO01 DFMO02 DFMO03 DFMO04 DFMO08',
               'DFMO10 DFMO15'
    values   = '$$CTOEDM NO EXTEND EXTEND EXTEND EXTEND EXTEND PROD',
               'EXTEND'
    end
  else do
    pdi = "ZCTO0041"
    keywords = 'RUNTDFT RUNTCACH AUTOMLOG'
    values   = 'OWNER 100 V'
    end
  if sysdsn("'"dsnmbr"'") = "OK" then,
    call process_config
  if line <> "" then ,
    ac = "The following BMC CONTROL-O parameter(s) is (are)",
         "improperly defined:"
  else ,
    do x = 1 to words(keywords)
      line = strip(line)"{"left(word(keywords,x),12) word(values,x)"}"
     end
  call process_pdi pdi"#"ac"$"line
end
call process_ioasecur
"VPUT (PRESCL RESCLASS QNAME)"
"EDIT dataid("table") member("CACT0008") macro("CACM000B")"
return
 
 
BMCCTR99:
dsns = "CTRRPT"
rectype = "D"
call COLLECT_DSN
dsns = "CTRUSER"
rectype = "F"
call COLLECT_DSN
call collect_stc
return
 
 
BMCIOA99:
dsns = "IOARPT"
rectype = "D"
call COLLECT_DSN
dsns = "IOASTC"
rectype = "E"
call COLLECT_DSN
dsns = "IOAUSER"
rectype = "F"
call COLLECT_DSN
call collect_stc ZIOA0032
rectype = "5"
call COLLECT_REC
ca1mbrs =
do until recs = ''
  parse var recs . . . mbr dsn . 81 recs
  ca1mbrs = ca1mbrs dsn'('mbr')'
end
ca1mbrs = strip(ca1mbrs)
call print_dsnmbr ioarpt
ac =
line =
ind =
RESCLASS =
QNAME =
keywords = '%QNAME%'
values   = 'xxxxxxxx'
dsnmbr = dsn"(DEFPARM)"
if sysdsn("'"dsnmbr"'") = "OK" then,
  call process_config
parse var line . "=" QNAME "}" .
QNAME = strip(QNAME)
 
keywords = 'DEFMCHKI SECTOLI DFMI06 DFMI07 DFMI09 DFMI12 DFMI16',
           'DFMI32 DFMI40 DFMI42 IOATCBS'
values   = '$$IOAEDM NO EXTEND EXTEND EXTEND EXTEND EXTEND EXTEND',
           'EXTEND EXTEND YES'
select
  when ACPNAME = 'ACF2' then do
    keywords = keywords 'IOACLASS SAFSCLAS'
    values   = values 'IOAFAC SURROGAT'
    end
  when ACPNAME = 'RACF' then do
    keywords = keywords 'IOACLASS RACSCLAS'
    values   = values '$IOA SURROGAT'
    end
  when ACPNAME = 'TSS' then do
    keywords = keywords 'IOACLASS TSSSCLAS'
    values   = values 'IOA ACIDCHK'
    end
  end
pdi = "ZIOA0040"
ac =
line =
ind =
tmsg = msg("off")
do until ca1mbrs = ''
  parse var ca1mbrs dsnmbr ca1mbrs
  if sysdsn("'"dsnmbr"'") = "OK" then,
    call process_config
end
if line <> "" then ,
  ac = "The following BMC IOA parameter(s) is (are) improperly defined:"
else ,
  do x = 1 to words(keywords)
    line = strip(line)"{"left(word(keywords,x),12) word(values,x)"}"
   end
call process_pdi pdi"#"ac"$"line
call process_ioasecur
"VPUT (PRESCL RESCLASS QNAME)"
"EDIT dataid("table") member("CACT0008") macro("CACM000B")"
return
 
 
BMCMVZ99:
dsns = "MVZRPT"
rectype = "D"
call COLLECT_DSN
dsns = "MVZSTC"
rectype = "E"
call COLLECT_DSN
call collect_stc ZMVZ0032
cls =
call process_cls ZMVZ0038
rectype = "5"
call COLLECT_REC
ca1mbrs =
do until recs = ''
  parse var recs . . . mbr dsn . 81 recs
  ca1mbrs = ca1mbrs dsn'('mbr')'
end
ca1mbrs = strip(ca1mbrs)
rectype = "S"
call COLLECT_REC
ssid =
do until recs = ''
  parse var recs . . ssid . 81 recs
end
rectype = "3"
call COLLECT_REC
resclass =
do until recs = ''
  parse var recs . . . resclass . 81 recs
end
"VPUT (SSID RESCLASS)"
ac =
line =
ind =
keywords =
 
pdi = "ZMVZ0040"
ac =
line =
ind =
tmsg = msg("off")
do until ca1mbrs = ''
  parse var ca1mbrs dsnmbr ca1mbrs
  if sysdsn("'"dsnmbr"'") = "OK" then do
/*  call process_config "(" ")"*/
    address tso "alloc fi(sysin) da('"dsnmbr"') shr reuse"
    address tso "execio * diskr sysin (finis stem out."
    if pdi <> "" then,
      say pgmname "Processing contents of" dsnmbr "for" pdi"."
    c = 1
    do a = 1 to out.0
      parse upper var out.a out.a "/""*" .
      if out.a = "" then iterate
      if pos("ESMTYPE",out.a) > 0 then do
        keydata = substr(out.a,pos("ESMTYPE",out.a))
        end
      else iterate
      parse var keydata keyword "(" value ")" .
      keyword = strip(keyword)
      if words(keyword) > 1 then keyword = word(keyword,words(keyword))
      keyword = strip(keyword)
      if wordpos("ESMTYPE",keyword) > 0 then do
        ind = "found"
        if value <> "AUTO" & ,
           value <> ACPNAME then,
          line = line''dsnmbr'{'keyword'('value')}'
        iterate
        end
      end
    if ind = "" then,
      line = dsnmbr'{ESMTYPE is not specified.}'
    end
end
if line <> "" then ,
  ac = "The following BMC MAINVIEW parameter is improperly defined:"
else ,
  line = "{ESMTYPE(AUTO|"ACPNAME")}"
call process_pdi pdi"#"ac"$"line
 
"EDIT dataid("table") member("CACT0008") macro("CACM000B")"
return
 
 
CAMIM999:
dsns = "MIMRPT"
rectype = "D"
call COLLECT_DSN
dsns = "MIMSTC"
rectype = "E"
call COLLECT_DSN
call collect_stc ZMIM0032
rectype = "1"
call COLLECT_REC
DSNS =
ac =
line =
newline =
obtain_line =
ind =
do until recs = ''
  parse var recs . .  mbr dsn usr 81 recs
  usr = strip(usr)
  if length(usr) > 8 then do
    mbr = dsn
    parse var usr dsn usr
    end
  if sysdsn("'"dsn"("mbr")'") = "OK" then do
    "VGET (PROC)"
    oproc = PROC
    stcproc = dsn
    proc = dsn
    procvol = ""
    "VPUT (STCPROC PROC PROCVOL)"
    otermmsgs = TERMMSGS
    oconlist  = CONLIST
    oconslist = CONSLIST
    osymlist  = SYMLIST
    otermpro  = TERMPRO
    TERMMSGS = "OFF"
    COMLIST  = "OFF"
    CONSLIST = "OFF"
    SYMLIST  = "OFF"
    TERMPRO  = "OFF"
    "VPUT (CONSLIST COMLIST SYMLIST TERMPRO TERMMSGS)"
    x = outtrap("data.")
    a = CACC1000('DDP JESPROC' mbr)
    y = outtrap(off)
    TERMMSGS = otermmsgs
    CONLIST  = oconlist
    CONSLIST = oconslist
    SYMLIST  = osymlist
    TERMPRO  = otermpro
    "VPUT (CONSLIST COMLIST SYMLIST TERMPRO TERMMSGS)"
    "vget (STCPROC PROC dddsns) asis"
    PROC = oproc
    "vput (PROC)"
    do i = 1 to data.0
      if pos("PGM=MIMDRBGN",data.i)<>0 then,
        start = "ON"
      if start = "ON" & pos("PARM=",data.i)<>0 then do
        parse var data.i ."PARM="PARMDATA .
        do j = i+1 to data.0
          if pos('// ',data.j) = 0 then leave
          parmdatatest = strip(data.j,,"/")
          parmdatatest = strip(parmdatatest)
          PARMDATA = PARMDATA parmdatatest
        end
        PARMDATA = strip(PARMDATA,,"'")
        PARMDATA = strip(PARMDATA,,'"')
        say pgmname PARMDATA
        start = "OFF"
        leave
        end
      end
    end
    parse var parmdata ."MEM="mbr .
    mbr = strip(mbr,,"'")
    mbr = strip(mbr,,'"')
    parse var dddsns . '//MIMPARMS' dsnmbr '//'
    dsnmbr = strip(dsnmbr)
    dsnmbr = dsnmbr"("mbr")"
    tmsg = msg("off")
    if sysdsn("'"dsnmbr"'") = "OK" then do
      pdi = ""
      line =
      keywords = "SAFPREFIX"
      values   = ""
      call process_config
      b =
      if wordpos("is not",line) = 0 then do
        do until line = ''
          parse var line . "{" a "}" line
          b = b"{"a"}"
          if pos("SAFPREFIX",a) = 1 then do
            parse var a ."="PREFIX","
            "vput (prefix)"
            end
        end
        if b <> " " then obtain_line = obtain_line""mbr dsnmbr b
        end
      pdi = "ZMIM0040"
      line =
      keywords = "SAFCMDAUTH"
      values   = 'ON'
      call process_config
      end
    if line <> " " then newline = newline""mbr" "line
    line =
  end
pdi = "ZMIM0040"
if newline <> "" then ac = "The following CA MIM parameter(s) is",
  "(are) improperly defined:"
call process_pdi pdi"#"ac"$"newline
 
"EDIT dataid("table") member("CACT0008") macro("CACM000B")"
return
 
 
CA199999:
x = listdsi("ca1rpt" "file")
address tso "alloc fi(tmsrpt) da('"SYSDSNAME"(tmscklvl)')shr"
/*"SELECT PGM(TMSCKLVL)"*/
if RC <> 0 then do
  say pgmname 'Error in using program TMSCKLVL RC ='RC'.'
  signal continue
  end
address tso "alloc fi(tmsrpt) da('"SYSDSNAME"(tmsstats)')shr reuse"
/*"SELECT PGM(TMSSTATS)"*/
if RC <> 0 then do
  say pgmname 'Error in using program TMSSTATS RC ='RC'.'
  signal continue
  end
address tso "execio * diskr TMSRPT (finis stem out."
keywords = 'BATCH CMD CREATE DSNB FUNC PMASK PSWD SCRTCH SECWTO',
           'UNDEF UX0AUPD YSVC'
if ACPNAME = "RACF" then,
  values   = 'YES YES ALTER YES YES #@!?*- YES NO YES FAIL NO YES'
else,
  values   = 'YES YES CREATE YES YES #@!?*- YES NO YES FAIL NO YES'
if ACPNAME = 'TSS' then do
  keywords = keywords 'CATSEC OCEOV'
  values   = values 'YES YES'
  end
else do
  keywords = keywords 'CATSEC OCEOV'
  values   = values 'NO NO'
  end
ac =
line =
ind =
c = 1
do a = 1 to out.0
  out.a = substr(out.a,2)
  if pos('CA 1/MVS GENLEVEL',out.a) = 2 then ,
    parse var out.a 25 ca1rel .
  parse var out.a keyword value .
  if wordpos(keyword,keywords) <> 0 then do
    ikey = wordpos(keyword,keywords)
    ival = word(values,ikey)
    if value <> ival then do
      line = line'{'keyword '=' value'}'
      end
    iterate
    end
  end
if line <> "" then ,
  ac = "The following CA 1 parameter(s) is (are) improperly defined:"
else ,
  do x = 1 to words(keywords)
    line = strip(line)"{"left(word(keywords,x),12) word(values,x)"}"
   end
call process_pdi ZCA10040"#"ac"$"line
dsns = "CA1STC"
rectype = "F"
call COLLECT_DSN
dsns = 'CA1RPT'
say PGMNAME 'Collecting' dsns 'datasets.'
do a = 1 to out.0
  out.a = substr(out.a,2)
  parse var out.a keyword value .
  if keyword = 'TMCDSN' |,
     keyword = 'AUDDSN' then do
    dsns = dsns value
    iterate
    end
end
rectype = "E"
call COLLECT_DSN
edit_dsnlist_ca1rpt = edit_dsnlist
dsns = "CA1PROD"
rectype = "D"
call COLLECT_DSN
rectype = "2"
call COLLECT_REC
if ACPNAME = "RACF" then ,
  cls = "CA@APE CA@MD"
else ,
  cls = "CATAPE CACMD"
call process_cls ZCA10038
ca1mbrs =
do until recs = ''
  parse var recs . . . mbr dsn . 81 recs
  ca1mbrs = ca1mbrs dsn'('mbr')'
end
ca1mbrs = strip(ca1mbrs)
call print_dsnmbr ca1rpt
ac =
ca1pw =
ca1pwdsn =
ca1pass =
do ca1cnt = 1 to words(ca1mbrs)
  ca1mbr = word(ca1mbrs,ca1cnt)
  Address TSO "alloc fi(file) da('"ca1mbr"') shr reuse"
  x = outtrap("out.")
  Address TSO "Print infile(file) hex"
  x = OUTTRAP("OFF")
  say PGMNAME 'Processing dataset member' ca1mbr'.'
  line =
  ind =
  c = 0
  do b = 1 to out.0 - 1
    out.b = strip(out.b,t,' ')
    if pos('RECORD SEQUENCE NUMBER -',out.b) = 1 then do
      c = c + 1
      data.c = ''
      end
    else do
      data.c = data.c''x2c(out.b)
      end
  end /* do b = 1 to out.0 - 1 */
/*outx.0 = 0*/
/*x = outtrap("outx.")*/
/*Address TSO "Print infile(file)"*/
/*x = OUTTRAP("OFF")*/
/*parse var ca1mbr x '(' member ')' .*/
/*address tso "alloc fi(tmsrpt) da('"SYSDSNAME"("member")')shr reuse"*/
/*address tso "execio * diskw TMSRPT (finis stem outx."*/
  if pos('TMSTMVT',ca1mbr) <> 0 then do
    do x = 1 to c
      if pos('TVT',data.x) = 1 then do
        ca1pw = substr(data.x,25,8)
        ca1pwdsn = SYSDSNAME"("member")"
        leave
        end
      end
    end
  else do
    do x = 1 to c
      if pos('TYPE 1',data.x) <> 0 then do
        a = pos('TYPE 1',data.x)
        do until a = 0
          b = a + 10
          pswd = substr(data.x,b,8)
          a = pos('TYPE 3',data.x,a)
          b = a + 8
          char = substr(data.x,b,2)
/*        say pswd c2x(char) "1" c2x(bitor(char,'300'x)) ,
            "2" c2x(bitxor(char,'300'x)) "3" c2x(bitor('300'x,char)) */
          a = pos('TYPE 1',data.x,a)
          ca1pass = ca1pass""pswd""char
          end
        end
      end
    end
  end /* do ca1cnt = 1 to words(ca1mbrs) */
if ca1rel > 'r11.5' then do
  otermmsgs = TERMMSGS
  TERMMSGS = "OFF"
  "vput (termmsgs)"
  "SELECT CMD(CACC1000 DD JESPROC TMSINIT)"
  TERMMSGS = otermmsgs
  "vput (termmsgs)"
  "vget (dddsns) asis"
  parse var dddsns . '//TMSPARM' dsns '//'
  rectype = "5"
  call COLLECT_REC
  ca1mbrs =
  do until recs = ''
    parse var recs . . . mbr dsn . 81 recs
    ca1mbrs = ca1mbrs dsn'('mbr')'
  end
  ca1mbrs = strip(ca1mbrs)
  call print_dsnmbr ca1rpt
  if words(ca1mbrs) = 1 then do
    say PGMNAME 'Processing dataset member' ca1mbrs'.'
    Address TSO "alloc fi(file) da('"ca1mbrs"') shr reuse"
    address Tso "execio * diskr file (finis stem out."
    do x = 1 to out.0
      parse var out.x out.x '*' .
      parse var out.x k '=' v .
      if v <> '' then value.k = k||v
      end
    do a = 1 to words(dsns)
      dsn = "'"word(dsns,a)"(TMO"value.OPT")'"
      if sysdsn(dsn) <> "OK" then iterate
      ca1mbrs = word(dsns,a)"(TMO"value.OPT")"
      say PGMNAME 'Processing dataset member' ca1mbrs'.'
      call print_dsnmbr ca1rpt
      ca1pwdsn = ca1mbrs
      Address TSO "alloc fi(file) da('"ca1mbrs"') shr reuse"
      address Tso "execio * diskr file (finis stem out."
      do x = 1 to out.0
        if pos('SHUTDWN ',out.x) > 0 then,
          parse var out.x 'SHUTDWN' ca1pw .
      end
      leave
    end /* do a = 1 to words(dsns) */
  if ca1rel > 'r12.0' then do
    do a = 1 to words(dsns)
      dsn = "'"word(dsns,a)"(TMO"value.SEC")'"
      if sysdsn(dsn) <> "OK" then iterate
      ca1mbrs = word(dsns,a)"(TMO"value.SEC")"
      say PGMNAME 'Processing dataset member' ca1mbrs'.'
      call print_dsnmbr ca1rpt
      Address TSO "alloc fi(file) da('"ca1mbrs"') shr reuse"
      address Tso "execio * diskr file (finis stem out."
      profile =
      ca1pass =
      ic = 0
      uc = 0
      do x = 1 to out.0
        parse var out.x out.x "*" .
        if out.x = "" then iterate
        parse var out.x keyword "=" value
        select
          when keyword = "PROFILE" then do
            if profile <> '' then do
              ca1pass = ca1pass""left(profile,8)
              ca1pass = ca1pass""d2c(ic,1)d2c(uc,1)
              end
            profile = value
            ic = 0
            uc = 0
            end /* when keyword = "PROFILE" */
          when keyword = "TINQ" | keyword = "TUPD" then do
            cnt = 0
            if pos("TMC",value) > 0 then cnt = cnt + 1
            if pos("DSNB",value) > 0 then cnt = cnt + 2
            if pos("CTL",value) > 0 then cnt = cnt + 4
            if pos("OPT",value) > 0 then cnt = cnt + 8
            if pos("SEC",value) > 0 then cnt = cnt + 16
            if pos("SCR",value) > 0 then cnt = cnt + 32
            if pos("ALL",value) > 0 then cnt = 255
            if keyword = "TINQ" then ic = cnt
            else uc = cnt
            end
          otherwise nop
        end /* select */
        end /* do x = 1 to out.0 */
      leave
      end /* do a = 1 to words(dsns) */
    end /* if ca1rel > 'r12.0' */
  end /* if ca1rel > 'r11.5' */
 
/* finish ca1 with ca1 system password. */
char  = 'ffff'x
/*say ca1pw c2x(char) "1" c2x(bitor(char,'300'x)) ,
  "2" c2x(bitxor(char,'300'x)) "3" c2x(bitor('300'x,char)) */
if ca1pw = 'CA1(TMS)' then ,
  ac = "The CA 1 default system password is being utilized."
if ca1pw = 'SSOCA1DF' |,
   ca1pw = 'SSOC@1DF' then ,
  ac = "The CA 1 default system password from SSO is being utilized."
ca1pass = ca1pass""left(ca1pw,8)""char
call process_pdi ZCA10041"#"ac"$"ca1pw "from" ca1pwdsn"."
ca1pass = strip(ca1pass)
"VPUT (ca1pass) ASIS"
address tso "execio 0 diskw TMSRPT (finis"
call collect_stc ZCA10032
"EDIT dataid("table") member("CACT0008") macro("CACM000B")"
return
 
 
/* ********************************************************** */
/* Repeat the following section CATSOL thru 'return' for      */
/* generation of dsnlist information                          */
/* ********************************************************** */
CATSOL99:
dsns = "CSLPROD"
rectype = "D"
call COLLECT_DSN
rectype = "6"
call COLLECT_REC
prefix =
parse var recs . . . dsn . 81 recs
if sysdsn("'"dsn"(CSLMAIN)'") = "OK" then,
  prefix = "EMC.CSL"
if sysdsn("'"dsn"(RCSMAIN)'") = "OK" then,
  prefix = "ROCKET.RCS"
if prefix <> " " then,
  "vput (prefix)"
else,
  say pgmname dsn "does on have either CSLMAIN or RCSMAIN modules."
"EDIT dataid("table") member("CACT0008") macro("CACM000B")"
return
 
 
CAAUDTR9:
dsns = "ADTRPT"
rectype = "D"
call COLLECT_DSN
dsns = "ADTUSER"
rectype = "F"
call COLLECT_DSN
return
 
 
CAMICS99:
dsns = "MICSRPT"
rectype = "D"
call COLLECT_DSN
dsns = "MICSUSER"
rectype = "F"
call COLLECT_DSN
return
 
 
CCS99999:
dsns= "CCSRPT"
rectype = "D"
call COLLECT_DSN
call collect_stc ZCCS0032
return
 
 
CICS9999:
dsns= "CICSRPT"
rectype = "D"
call COLLECT_DSN
dsns= "CICSSTC"
rectype = "E"
call COLLECT_DSN
call collect_stc
cls =
call process_cls ZCICR038
return
 
 
CLSUPER9:
dsns = "KLSRPT"
rectype = "D"
call COLLECT_DSN
dsns = "KLSSTC"
rectype = "E"
call COLLECT_DSN
call collect_stc ZCLS0032
rectype = "4"
call COLLECT_REC
settings = substr(recs,12)
parse var settings aa cm as rv tih ":" tim gp 24 ma at mo st ps .
ac =
data =
if aa <> "N" then ,
  data = data"{Administrator authority     :" aa'}'
if cm <> "Y" then ,
  data = data"{Maintain customized menu    :" cm'}'
if as <> "N" then ,
  data = data"{Add sessions to the menu    :" as'}'
if rv <> "A" then ,
  data = data"{Resource validation         :" rv'}'
ti = tih""tim
if ti > 15 then ,
  data = data"{Timeout interval            :" tih":"tim'}'
if gp <> "N/A" then ,
  data = data"{Group profile name          :" gp'}'
if ma <> "N" then ,
  data = data"{Maintain trigger profile    :" ma'}'
if at <> "N" then ,
  data = data"{Add triggers to profile     :" at'}'
if mo <> "N" then ,
  data = data"{Modify triggers in profile  :" mo'}'
if st <> "Y" then ,
  data = data"{Switch terminals            :" st'}'
if ps <> "N" then ,
  data = data"{Preserve Sessions upon exit :" ps'}'
if data<>"" then ,
  ac = "The following CL/SUPERSESSION PROFILE option(s)" ,
    "is (are) improperly specified:"
else ,
  data = settings
 
call process_pdi ZCLS0040"#"ac"$"data
rectype = "1"
Call COLLECT_REC
ac =
do until recs = ''
  parse var recs . .  mbr dsn usr 81 recs
  usr = strip(usr)
  if length(usr) > 8 then do
    mbr = dsn
    parse var usr dsn usr
    end
  usr = strip(usr)
  if sysdsn("'"dsn"("mbr")'") = "OK" then do
    "VGET (PROC)"
    oproc = PROC
    stcproc = dsn
    proc = dsn
    procvol = ""
    "VPUT (STCPROC PROC PROCVOL)"
    oldmsgs = TERMMSGS
    TERMMSGS = "OFF"
    "vput (TERMMSGS) asis"
    TERMMSGS = oldmsgs
    "select cmd(CACC1000 DD JESPROC" mbr")"
    "vget (dddsns) asis"
    PROC = oproc
    "vput (PROC)"
    parse var dddsns . "//TLVPARM" tlvparmdsns "//"
    KLVINNAF_mem =
    KLVINNAM_mem =
    do i = 1 to words(tlvparmdsns)
      if "OK" = sysdsn("'"strip(word(tlvparmdsns,i))"(KLVINNAF)'") & ,
        KLVINNAF_mem = "" then ,
        KLVINNAF_mem = "'"strip(word(tlvparmdsns,i))"(KLVINNAF)'"
      if "OK" = sysdsn("'"strip(word(tlvparmdsns,i))"(KLVINNAM)'") & ,
        KLVINNAM_mem = "" then ,
        KLVINNAM_mem = "'"strip(word(tlvparmdsns,i))"(KLVINNAM)'"
      end
    end
  end
smf =
classes =
if KLVINNAF_mem<>"" then do
  say pgmname "Processing" strip(KLVINNAF_mem,,"'") "for PDI ZCLS0041."
  line = "SMF= is not defined."
  Address TSO "Alloc f(test) ds("KLVINNAF_mem") shr reuse"
  Address TSO "Execio * diskr test (finis stem in."
  do i = 1 to in.0
    if pos("*",in.i)=1 then ,
      in.i =
    if pos("*",in.i)<>0 then ,
      parse var in.i in.i " *" .
    if in.i = "" then ,
      iterate
    if pos("SMF=",in.i)<>0 then do
      parse var in.i . "SMF=" smf .
      if smf = "" then ,
        line = "SMF= is specified without a value."
      else ,
        line = "SMF="smf
      leave
      end
    end
  end
else ,
  say pgmname "Unable to obtain KLVINNAF from //TLVPARM."
if smf="" then do
  ac = "SMF recording is not active for CL/SUPERSESSION."
  call process_pdi ZCLS0041"#"ac"$"line
  end
else do
  Address TSO "Execio * diskr EXAM$OUT (finis stem in."
  start =
  out =
  do i = 1 to in.0
    in.i = strip(in.i)
    if pos("SMF IS GLOBALLY SELECTING",in.i) = 1 then do
      start = x
      iterate
      end
    if start <> "" then do
      out = strip(out) in.i
      if lastpos(",",out) = length(out) then iterate
      else leave
      end
    end
  out = strip(out)
  smf_sw =
  do x = 1 to words(out)
    test = word(out,x)
    parse var test s "-" e ","
    if e = "" & ,
      s = smf then do
      smf_sw = x
      leave
      end
    if e <> "" & ,
      s <= smf & ,
      e >= smf then do
      smf_sw = x
      leave
      end
    end
  if smf_sw = "" then do
    ac = "SMF collection of" smf "records is not occurring for" ,
      "CL/SUPERSESSION."
    end
  call process_pdi ZCLS0041"#"ac"$"line
  end
o = 0
ac =
data =
 
if KLVINNAM_mem<>"" then do
  say pgmname "Processing" strip(KLVINNAM_mem,,"'") "for PDI ZCLS0042."
  out =
  Address TSO "Alloc f(test) ds("KLVINNAM_mem") shr reuse"
  Address TSO "Execio * diskr test (finis stem in."
  do i = 1 to in.0
    if pos("*",in.i)=1 then ,
      in.i =
    if pos("*",in.i)<>0 then ,
      parse var in.i in.i " *" .
    parse var in.i in.i 72 .
    if in.i = "" then ,
      iterate
    in.i = strip(in.i)
    if pos(" -",in.i) = 0 then do
      out = strip(out)" "strip(in.i)
      o = o + 1
      out.0 = o
      out.o = strip(out)
      out =
      end
    else ,
      out = strip(out)" "strip(in.i,"T","-")
    end
  out =
  do i = 1 to out.0
    if pos("DEFAULT",out.i) = 1 then do
      out = out.i" "
      leave
      end
    end
  if pos("CLASSES=",out)<>0 then ,
    parse var out . "CLASSES=" classes .
  ac =
  select
    when acpname = "ACF2" then ,
      if pos("DSNAME(",out) > 0 & ,
         pos(" CLASSES=APPCLASS ",out) > 0 & ,
         pos(" NODB ",out) > 0  then ,
        if (pos(" NORACF ",out) > 0 | ,
            pos(" SAF ",out) > 0) & ,
           pos(" EXIT=KLSA2NEV",out) > 0 then ,
          nop
        else ,
          if pos(" SAF ",out) > 0 & ,
             pos(" EXIT=KLSSFPTX",out) > 0 then ,
            nop
          else ,
            ac = "The following CL/SUPERSESSION KLVINNAM option(s) is (are)",
              "improperly specified:"
    when acpname = "RACF" then ,
      if pos("DSNAME(",out) > 0 & ,
         pos(" CLASSES=APPCLASS ",out) > 0 & ,
         pos(" NODB ",out) > 0 then ,
        if (pos(" RACF ",out) > 0 | ,
            pos(" SAF ",out) > 0) & ,
         pos(" EXIT=",out) = 0 then ,
          nop
        else ,
          if pos(" SAF ",out) > 0 & ,
              pos(" EXIT=KLSNFPTX",out) > 0 then ,
            nop
          else ,
            ac = "The following CL/SUPERSESSION KLVINNAM option(s) is (are)",
              "improperly specified:"
    when acpname = "TSS" then ,
      if pos("DSNAME(",out) > 0 & ,
         pos(" CLASSES=APPCLASS ",out) > 0 & ,
         pos(" NODB ",out) > 0 then ,
        if (pos(" RACF ",out) > 0 | ,
            pos(" SAF ",out) > 0) & ,
         pos(" EXIT=KLSTSNEV",out) > 0 then ,
          nop
        else ,
          if pos(" SAF ",out) > 0 & ,
              pos(" EXIT=KLSTSPTX",out) > 0 then ,
            nop
          else ,
            ac = "The following CL/SUPERSESSION KLVINNAM option(s) is (are)",
              "improperly specified:"
    end
  call process_pdi ZCLS0042"#"ac"$"out
  end
else ,
  say pgmname "Unable to obtain KLVINNAM from //TLVPARM."
ac =
data =
 
classes_mem =
o = 0
do i = 1 to words(tlvparmdsns)
  if "OK" = sysdsn("'"strip(word(tlvparmdsns,i))"("classes")'") & ,
    classes_mem = "" then ,
    classes_mem = "'"strip(word(tlvparmdsns,i))"("classes")'"
  end
if classes_mem<>"" then do
  say pgmname "Processing" strip(classes_mem,,"'") "for PDI ZCLS0043."
  out =
  Address TSO "Alloc f(test) ds("classes_mem") shr reuse"
  Address TSO "Execio * diskr test (finis stem in."
  do i = 1 to in.0
    if pos("*",in.i)=1 then ,
      in.i =
    if pos("*",in.i)<>0 then ,
      parse var in.i in.i " *" .
    if in.i = "" then ,
      iterate
    in.i = strip(in.i)
    if pos(" -",in.i) = 0 then do
      out = strip(out)" "strip(in.i)
      o = o + 1
      out.0 = o
      out.o = strip(out)
      out =
      end
    else ,
      out = strip(out)" "strip(in.i,"T","-")
  end
  out =
  cls =
  do i = 1 to out.0
    if pos("VGWAPLST",out.i) <> 0 then do
      out = out.i
      parse var out . "EXTERNAL=" cls .
      leave
      end
    end
  if acpname = "ACF2" then ,
    ext = "EXTERNAL=APL "
  if acpname = "RACF" then do
    ext = "EXTERNAL=APPL "
    call process_cls ZCLS0038
    end
  if acpname = "TSS" then ,
    ext = "EXTERNAL=KLS "
  if pos(ext,out" ") = 0 then ,
    ac = "The following CL/SUPERSESSION" classes "member option(s) is",
      "(are) improperly specified:"
  else ,
    ac =
  call process_pdi ZCLS0043"#"ac"$"out
  end
else ,
  say pgmname "Unable to obtain" classes "from //TLVPARM."
ac =
data =
 
return
 
 
CSSMTP99:
rectype = "1"
call COLLECT_REC
DSNS =
do until recs = ''
  parse var recs . .  mbr dsn usr 81 recs
  usr = strip(usr)
  "VGET (PROC)"
  oproc = PROC
  stcproc = dsn
  proc = dsn
  procvol = ""
  if length(usr) > 8 then do
    mbr = dsn
    parse var usr dsn usr
    end
  if sysdsn("'"dsn"("mbr")'") = "OK" then do
    "VPUT (STCPROC PROC PROCVOL)"
    a = CACC1000('DD JESPROC' mbr)
    "VGET (FOUND STCPROC PROC dddsns) asis"
    PROC = oproc
    "vput (PROC)"
    dsnmbr = ""
    if pos("//CHKPOINT",dddsns) > 0 then do
      parse var dddsns . "//CHKPOINT" dsnmbr "//"
      say pgmname "Found CHKPOINT DD" dsnmbr"."
      dsns= "SMTSTC" dsnmbr
      "VPUT (DSNS)"
      "EDIT dataid("table") member("DSNLIST") macro("CACM000D")"
      end
    else do
      cact0000_sw = "x"
      call process_pdi "ZSMT0001#$CHKPOINT DD not specifed."
      end
    end
  end
call collect_stc ZSMT0032
return
 
 
FEP99999:
dsns = "NCPRPT"
rectype = "G"
call COLLECT_DSN
return
 
 
HCD99999:
dsns = "HCDRPT"
rectype = "D"
call COLLECT_DSN
dsns = "HCDUSER"
rectype = "F"
call COLLECT_DSN
return
 
 
HLTHCK99:
dsns = "HCKSTC"
rectype = "E"
call COLLECT_DSN
call collect_stc ZHCK0032
return
 
 
ICSF9999:
dsns = "ICSFRPT"
rectype = "D"
call COLLECT_DSN
dsns = "ICSFSTC"
rectype = "E"
call COLLECT_DSN
call collect_stc ZICS0032
return
 
 
MQS99999:
dsns = "MQSRPT"
rectype = "D"
call COLLECT_DSN
dsns = "MQSSTC"
rectype = "E"
call COLLECT_DSN
call collect_stc
return
 
 
NCPASS99:
dsns = "NCPASRPT"
rectype = "D"
call COLLECT_DSN
dsns = "NCPASSTC"
rectype = "E"
call COLLECT_DSN
/*if ACPNAME = "RACF" then ,*/
/*  call collect_stc ZNCPR050*/
/*else ,*/
/*  call collect_stc ZNCPT060*/
call collect_stc ZNCP0032
return
 
 
NETVIEW9:
dsns = "NETVRPT"
rectype = "D"
call COLLECT_DSN
dsns = "NETVSTC"
rectype = "E"
call COLLECT_DSN
call collect_stc ZNET0032
 
/*cls = "NETCMDS"
call process_cls ZNET0038*/
 
/* Obtain STC information for DOMAIN variable */
rectype = "1"
call COLLECT_REC
DSNS =
ac =
line =
newline =
obtain_line =
ind =
mbr = "CNMPROC"
otermmsgs = TERMMSGS
oconlist  = CONLIST
oconslist = CONSLIST
osymlist  = SYMLIST
otermpro  = TERMPRO
TERMMSGS = "OFF"
COMLIST  = "OFF"
CONSLIST = "OFF"
SYMLIST  = "OFF"
TERMPRO  = "OFF"
"VPUT (CONSLIST COMLIST SYMLIST TERMPRO TERMMSGS)"
x = outtrap("data.")
a = CACC1000('DDP JESPROC' mbr)
y = outtrap(off)
TERMMSGS = otermmsgs
CONLIST  = oconlist
CONSLIST = oconslist
SYMLIST  = osymlist
TERMPRO  = otermpro
"VPUT (CONSLIST COMLIST SYMLIST TERMPRO TERMMSGS)"
execjcl  = ""
procjcl  = ""
 
rectype = "5"
call COLLECT_REC
ca1mbrs =
do until recs = ''
  parse var recs . . . mbr dsn . 81 recs
  ca1mbrs = ca1mbrs dsn'('mbr')'
end
dsnmbr = strip(ca1mbrs)
ac =
line =
ind =
rectype = "7"
call COLLECT_REC
ca1mbrs =
do until recs = ''
  parse var recs . . . key value . 81 recs
  if key = 'DOMAIN' then domain = value
  else netid = value
end
tmsg = msg("off")
 
"vget (STCPROC PROC dddsns) asis"
PROC = STCPROC
"vput (PROC)"
tmsg = msg("off")
if sysdsn("'"dsnmbr"'") = "OK" then do
  line =
  prefix = netid"."domain
  if prefix <> "" then ,
    "vput (prefix)"
  pdi = "ZNET0040"
  line =
  keywords = "SECOPTS.OPERSEC SECOPTS.CMDAUTH"
  values   = ""
  call process_config
  oline = line
  ac = ""
  b = ""
  obtain_line = ""
  do until line = ''
    parse var line . "{" a "}" line
    parse var a key "=" val
    if pos("SECOPTS.OPERSEC",key) = 1 then do
      opersec = val
      if val = "SAFDEF" | ,
         val = "SAFCHECK" then iterate
      end
/*  if pos("SECOPTS.OPERSEC",key) = 1 then ,
      if val = "SAFPW" then do
        line =
        iterate
        end */
    if pos("SECOPTS.CMDAUTH",key) = 1 then do
      parse var val val "." sub
      if val = "SAF" then ,
        if sub <> "" & ,
           sub <> "PASS" then iterate
      end
    b = b"{"a"}"
    end
  if b <> " " then line = b
  end
if line <> "" then ,
  ac = "The following parameter(s) is (are) defined improperly:"
else do
  line = oline
  do until line = ''
    parse var line . "{" a "}" line
    parse var a key "=" val
    b = b"{"a"}"
    end
  if b <> " " then line = b
  end
call process_pdi pdi"#"ac"$"line
line = "SECOPTS.OPERSEC="opersec "is specified."
 
/*if opersec = "SAFPW" then ,
  call process_pdi "ZNET0020#Not Applicable$"line
else ,
  "EDIT dataid("table") member("CACT0008") macro("CACM000B")"*/
"EDIT dataid("table") member("CACT0008") macro("CACM000B")"
return
 
 
ROSCOE99:
dsns = "ROSRPT"
rectype = "D"
call COLLECT_DSN
dsns = "ROSSTC"
rectype = "E"
call COLLECT_DSN
call collect_stc ZROS0032
cls =
call process_cls ZROS0038
rectype = "5"
call COLLECT_REC
ca1mbrs =
do until recs = ''
  parse var recs . . . mbr dsn . 81 recs
  ca1mbrs = ca1mbrs dsn'('mbr')'
end
ca1mbrs = strip(ca1mbrs)
keywords = 'EXTSEC ACFEXT CLLEXT JOBEXT LIBEXT MONEXT PRVEXT',
           'RPFEXT UPSEXT'
values   = ACPNAME 'YES YES YES YES YES YES YES YES'
ac =
line =
ind =
ROSIDS =
tmsg = msg("off")
do until ca1mbrs = ''
  parse var ca1mbrs dsnmbr ca1mbrs
  if sysdsn("'"dsnmbr"'") = "OK" then,
    call ZROS0040
  if reshlq_val = "NONE" then,
    ROSID = ' '
  else ,
    ROSID = rosid_val
  if pos(left(ROSID,9),ROSIDS) = 0 then,
    ROSIDS = ROSIDS''left(ROSID,9)
end
if line <> "" then ,
  ac = "The following ROSCOE parameter(s) is (are) improperly defined:"
else ,
  do x = 1 to words(keywords)
    line = strip(line)"{"left(word(keywords,x),12) word(values,x)"}"
   end
call process_pdi ZROS0040"#"ac"$"line
"VPUT (ROSIDS)"
"EDIT dataid("table") member("CACT0008") macro("CACM000B")"
return
 
 
ZROS0040:
do x = 1 to 9
 dval.x = "*"
 end
address tso "alloc fi(sysin) da('"dsnmbr"') shr reuse"
address tso "execio * diskr sysin (finis stem out."
say pgmname "Processing contents of" dsnmbr "for ZROS0040."
c = 1
do a = 1 to out.0
  parse upper var out.a out.a "*" .
  if out.a = "" then iterate
  parse var out.a keyword "=" value .
  if wordpos(keyword,keywords) <> 0 then do
    ikey = wordpos(keyword,keywords)
    ival = word(values,ikey)
    dval.ikey = ""
    if value <> ival then,
      line = line''dsnmbr'{'keyword '=' value'}'
    iterate
    end
  if keyword = "RESHLQ" then,
    reshlq_val = value
  if keyword = "ROSID" then,
    rosid_val = value
  end
do x = 1 to 9
 if dval.x = "*" then,
   line = line''dsnmbr'{'word(keywords,x) 'is not specified.}'
  end
return
 
 
SDSF9999:
x = outtrap("out.")
test = cacc1010('f sdsf,d')
x = outtrap(off)
lnx = 0
line = null
comm =
if TERMMSGS = ON then do
  say PGMNAME "output from CACC1010 routine:"
  do a = 1 to out.0
    say out.a
    end
  do a = 1 to out.0
    parse upper var out.a keyword ':' value
/*  if keyword = "COMMUNICATIONS" & value = "INACTIVE" then do
      comm = "ZISF0350#Not Applicable$Communications: inactive"
      end*/
    if keyword = "PARMS" then do
      parse var value mbr "/" dsn
      if dsn = "" then do
        rc = CACC1000('DD JESPROC SDSF')
        "vget (STCPROC PROC dddsns) asis"
        if pos("//SDSFPARM",dddsns) > 0 then do
          parse var dddsns . "//SDSFPARM" dsn "//"
          say pgmname "Found DD SDSFPARM" dsn"."
          end
        else do
          rc = CACC1000('FIND PARM' mbr)
          "vget (FOUND) asis"
          dsn = strip(FOUND)
          end
        end
      sdsfdsn = strip(dsn)"("strip(mbr)")"
      end
    end
  end
/*if comm <> "" then ,*/
/*call process_pdi comm*/
if sdsfdsn <> "" then do
  address tso "alloc fi(dd1) da('"sdsfdsn"') reuse shr"
  address tso "execio * diskr dd1 (finis stem out."
  address tso "free fi(dd1)"
  end
haspindx =
oind =
gind =
group =
athopen =
line =
ssn =
x = 0
do a = 1 to out.0
  if pos("/"||"*",out.a) = 1 then out.a =
  if pos("/"||"*",out.a) <> 0 then ,
    parse var out.a out.a"/*".
  if out.a = "" then iterate
  if pos("INDEX(",out.a) <> 0 then ,
    parse var out.a  "("haspindx")" .
/*if pos("OPTIONS",out.a) <> 0 then ,
    oind = "Y"
  if oind = "Y" then do
    if pos("ATHOPEN(",out.a) <> 0 then ,
      athopen = strip(strip(out.a),t,",")
    if pos(", ",out.a) = 0 then ,
      oind =
    end*/
  if pos(" GROUP "," "out.a" ") <> 0 then ,
    gind = "Y"
  if gind = "Y" then do
    group = group""strip(out.a)
    if pos(", ",out.a) = 0 then do
      gind =
      x = x + 1
      group.x = group
      group =
      end
    end
  end
group.0 = x
/*if pos("NO",athopen) = 0 then do
  line = "{ATHOPEN(YES)}"
  end*/
GRP =
do x = 1 to group.0
  group = translate(group.x," ",",")
  if pos(" NAME(",group) <> 0 then ,
    parse var group "NAME(" name ")" .
  else do
    x = right(x,5,"0")
    name = "ISF"||x
    line = line''name'{NAME is not specified.}'
    end
  if pos(" AUPDT(",group) = 0 then ,
    line = line''name'{AUPDT(2) default is being used.}'
  else do
    y = lastpos("AUPDT(",group)
    aupdt = substr(group,y)
    parse var aupdt aupdt .
    parse var aupdt ."("n")".
    if n <> 0 then ,
      line = line''name'{'aupdt 'is specified.}'
    end
  n = 2
  if pos(" AUPDT(",group) > 0 then do
    y = lastpos("AUPDT(",group)
    aupdt = substr(group,y)
    parse var aupdt aupdt .
    parse var aupdt ."("n")".
    end
  if n <> 0 then ,
    GRP = GRP name
  if pos(" AUTH(",group) <> 0 then do
    y = lastpos(" AUTH(",group) + 1
    txt = substr(group,y)
    parse var txt txt")" .
    line = line''name'{'txt') is specified.}'
    end
  if pos(" CMDAUTH(",group) <> 0 then do
    y = lastpos(" CMDAUTH(",group) + 1
    txt = substr(group,y)
    parse var txt txt")" .
    line = line''name'{'txt') is specified.}'
    end
  if pos(" CMDLVL(",group) <> 0 then do
    y = lastpos(" CMDLVL(",group) + 1
    txt = substr(group,y)
    parse var txt txt")" .
    line = line''name'{'txt') is specified.}'
    end
  if pos(" DSPAUTH(",group) <> 0 then do
    y = lastpos(" DSPAUTH(",group) + 1
    txt = substr(group,y)
    parse var txt txt")" .
    line = line''name'{'txt') is specified.}'
    end
  ssn = ssn name
end
ac =
if line <> "" then ,
  ac = "The following configuration for SDSF is incorrect:"
call process_pdi ZISF0040"#"ac"$"line
dsns =
if haspindx <> "" then do
  dsns = "SDSFRPT" haspindx
  "VPUT (DSNS)"
  "EDIT DATAID("table") MACRO("CACM000T") MEMBER("CACT0000")"
  edit_cact0000 = RC
  "EDIT dataid("table") member("DSNLIST") macro("CACM000D")"
  end
else do
  "VPUT (DSNS)"
  "EDIT DATAID("table") MACRO("CACM000T") MEMBER("CACT0000")"
  call process_pdi "ZISF0002#Not Applicable$INDEX not specifed."
  end
dsns = "ISFRPT" dsn
rectype = "D"
call COLLECT_DSN
call collect_stc ZISF0032
cls = "SDSF"
call process_cls ZISF0038
ssn = strip(ssn)
GRP = strip(GRP)
"VPUT (SSN GRP) ASIS"
"EDIT dataid("table") member("CACT0008") macro("CACM000B")"
return
 
 
SRRAUDT9:
dsns = "SRRPROD"
rectype = "D"
call COLLECT_DSN
dsns = "SRRUSER"
rectype = "F"
call COLLECT_DSN
return
 
 
FDR99999:
TYPERUN = left(TYPERUN,8)
dsns = "FDRRPT"
rectype = "D"
call COLLECT_DSN
rectype = "2"
Call COLLECT_REC
ca1mbrs =
do until recs = ''
  parse var recs . . . mbr dsn . 81 recs
  ca1mbrs = ca1mbrs dsn'('mbr')'
end
ca1mbrs = strip(ca1mbrs)
do ca1cnt = 1 to words(ca1mbrs)
  ca1mbr = word(ca1mbrs,ca1cnt)
  Address TSO "alloc fi(file) da('"ca1mbr"') shr reuse"
  x = outtrap("out.")
  Address TSO "Print infile(file) hex"
  x = OUTTRAP("OFF")
  say PGMNAME 'Processing dataset member' ca1mbr'.'
  line =
  ind =
  c = 0
  do b = 1 to out.0 - 1
    /*say 'out ' b out.b*/
    out.b = strip(out.b,t,' ')
    if pos('RECORD SEQUENCE NUMBER -',out.b) = 1 then do
      c = c + 1
      data.c = ''
      end
    else do
      data.c = data.c''x2c(out.b)
      end
  end
end /* do b = 1 to words(ca1mbrs) */
txt_hex = substr(data.6,'422','1')
/*say c2x(txt_hex) "1" c2x(bitand(txt_hex,'06'x)) ,
  "2" c2x(bitor(txt_hex,'06'x)) "3" c2x(bitor(txt_hex,'06'x)) ,
  "4" c2x(bitxor(txt_hex,'FF'x))*/
txt_hex = C2X(substr(data.6,'422','1'))
ac =
line =
if C2X(substr(data.6,'422','1'))='00' then do
  ac = "The following FDR Option(s) is (are) improperly specified:"
  line = "{ALLCALL = NO}"
  end
else do
  line = "{ALLCALL = YES}"
  end
call process_pdi ZFDR0040"#"ac"$"line
return
 
 
TADZ9999:
dsns = "TADZRPT"
rectype = "D"
call COLLECT_DSN
dsns = "TADZSTC"
rectype = "E"
call COLLECT_DSN
call collect_stc ZTAD0032
return
 
 
TDMF9999:
dsns = "TDMFRPT"
rectype = "G"
call COLLECT_DSN
return
 
 
VSS99999:
dsns = "VSSRPT"
rectype = "D"
call COLLECT_DSN
dsns = "VSSUSER"
rectype = "F"
call COLLECT_DSN
return
 
 
VTAM9999:
dsns = "VTAMRPT"
rectype = "G"
call COLLECT_DSN
call collect_stc
return
 
 
VTAPE999:
dsns = "VTAPERPT"
rectype = "D"
call COLLECT_DSN
dsns = "VTAPESTC"
rectype = "E"
call COLLECT_DSN
call collect_stc ZVTA0032
ssn =
rectype = "S"
call COLLECT_REC
do until recs = ''
  parse var recs . .  mbr . 81 recs
  ssn = ssn mbr
end
ssn = strip(ssn)
"VPUT (SSN) ASIS"
"EDIT dataid("table") member("CACT0008") macro("CACM000B")"
return
 
 
WAS99999:
dsns = "WASRPT"
rectype = "D"
call COLLECT_DSN
dsns = "WASSTC"
rectype = "E"
call COLLECT_DSN
call collect_stc
return
 
 
process_ioasecur:
/* Following to find and contents of IOASECUR */
resfld = ""
prescl = ""
call find_module APF IOASECUR
out. = ""
call print_dsnmbr ioarpt
c = 0
do b = 1 to out.0 - 1
  out.b = strip(out.b,t,' ')
  if pos('RECORD SEQUENCE NUMBER -',out.b) = 1 then do
    c = c + 1
    data.c = ''
    end
  else do
    data.c = data.c''x2c(out.b)
    end
  end /* do b = 1 to out.0 - 1 */
do x = 1 to c
  if lastpos("##SACT##",data.x) > 0 then do
    lpos = pos("##SACT##",data.x) - 3
    parse var data.x . =(lpos) resfld +19 .
    lpos = lastpos("##SACT##",data.x) - 3
    parse var data.x . =(lpos) resfld +19 .
    leave
    end
  end
if acpname = "ACF2" then,
  PRESCL = left(resfld,3)
else,
  PRESCL = right(resfld,8)
PRESCL = left(PRESCL,8)
/* Previous to find and contents of IOASECUR */
return
 
 
print_dsnmbr:
parse arg ddname
if ddname = "" then return
x = listdsi(ddname "file")
if x > 0 then do
  say PGMNAME 'SYSREASON:' SYSREASON
  say PGMNAME SYSMSGLVL2
  return
  end
outdsn = SYSDSNAME
do ca1cnt = 1 to words(ca1mbrs)
  ca1mbr = word(ca1mbrs,ca1cnt)
  Address TSO "alloc fi(file) da('"ca1mbr"') shr reuse"
  x = listdsi("file" "file")
  x = outtrap("out.")
  if sysrecfm = "U" then do
/*  Address TSO "Print infile(file)"*/
    Address TSO "Print infile(file) hex"
    end
  else do
    address tso "execio * diskr file (finis stem out."
    end
  x = OUTTRAP("OFF")
  parse var ca1mbr x '(' member ')' .
  address tso "alloc fi(dd1) da('"outdsn"("member")')shr reuse"
  address tso "execio" out.0 "diskw dd1 (finis stem out."
  say PGMNAME "Printed" ca1mbr"."
  end /* do ca1cnt = 1 to words(ca1mbrs) */
return
 
 
find_module:
parse arg attr module
ca1mbr =
x = outtrap("out.")
test = iplinfo(attr 'NOBROWSE')
do outcnt = 1 to out.0
  out.outcnt = strip(out.outcnt,"B")
  parse var out.outcnt a b c .
  if datatype(a) = "NUM" then do
    if sysdsn("'"c"("module")'") = "OK" then do
      ca1mbrs = c"("module")"
      leave
      end
    end
  end
x = outtrap("OFF")
say PGMNAME "Found member" module "in" c"."
return
 
 
process_config:
arg comma
do x = 1 to words(keywords)
 dval.x = "*"
 end
address tso "alloc fi(sysin) da('"dsnmbr"') shr reuse"
address tso "execio * diskr sysin (finis stem out."
if pdi <> "" then,
  say pgmname "Processing contents of" dsnmbr "for" pdi"."
c = 1
if comma = "COMMA" then ,
  do a = 1 to out.0
    out.a = strip(out.a)
    if right(out.a,1) = "," then do
      b = a + 1
      out.b = strip(out.a)strip(out.b)
      out.a = ""
      end
  end
do a = 1 to out.0
  parse upper var out.a out.a "/" . "*" b
  out.a = strip(out.a)
  if b = "" & pos('*',out.a) > 0 then ,
    parse upper var out.a out.a "*" .
  if out.a = "" then iterate
  parse var out.a keyword "=" value .
  keyword = strip(keyword)
  if comma <> "COMMA" then ,
    parse var value value "," .
  if words(keyword) > 1 then,
    keyword = word(keyword,words(keyword))
  if keyword = "IOACLASS" & left(TYPERUN,3) = "BMC" then,
    RESCLASS = value
  if wordpos(keyword,keywords) <> 0 then do
    ikey = wordpos(keyword,keywords)
    ival = word(values,ikey)
    dval.ikey = ""
    if value <> ival then,
      line = line''dsnmbr'{'keyword'='value'}'
    iterate
    end
  end
do x = 1 to words(keywords)
 if dval.x = "*" then,
   line = line''dsnmbr'{'word(keywords,x) 'is not specified.}'
  end
return
 
 
COLLECT_REC:
Address ISPEXEC
"lmmfind dataid("dialog") member(products)"
lmmfind_dialog = RC
TYPERUN = left(TYPERUN,8)
RC = 0
recs =
do until RC>0
  "lmget dataid("dialog") mode(invar) dataloc(data) datalen(lrecl)",
  "maxlen(80)"
  if RC = 0 & ,
     pos(TYPERUN' 'rectype,data) = 1 then do
    recs = recs""data
    end /* if RC = 0 & */
end /* until RC>0 */
return
 
 
COLLECT_DSN:
"lmmfind dataid("dialog") member(products)"
signal off error
lmmfind_dialog = RC
say PGMNAME 'Collecting' dsns 'datasets.'
TYPERUN = left(TYPERUN,8)
RC = 0
DCNT = 0
do until RC>0
  "lmget dataid("dialog") mode(invar) dataloc(data) datalen(lrecl)",
  "maxlen(80)"
  if RC = 0 & ,
     pos(TYPERUN' 'rectype,data) = 1 then do
    dsn = word(data,3)
    if pos( dsn ,dsns ) = 0 then do
      dsns = dsns dsn
      DCNT = DCNT + 1
      end
    if DCNT = 250 then do
      DCNT = 0
      "VPUT (DSNS)"
      "EDIT dataid("table") member("DSNLIST") macro("CACM000D")"
      dsns = word(dsns,1)
      end /* if DCNT = 250 */
    end /* if RC = 0 & */
end /* until RC>0 */
"VPUT (DSNS)"
"EDIT dataid("table") member("DSNLIST") macro("CACM000D")"
edit_dsnlist = RC
return