/* REXX */
Signal On NoValue
Call On Error
Signal On Failure
Signal On Syntax
Parse source opsys . exec_name .
Address ISPEXEC
 
/*********************************************************************/
/* AUTHOR: Charles Fenton                                            */
/*                                                                   */
/*********************************************************************/
/* DISPLAY SYSTEM INFORMATION ON TERMINAL                            */
/*********************************************************************/
/* This generates the xml output file.                               */
/*********************************************************************/
/* Change summary:                                                   */
/* 03/31/2005 JL Nelson Created for XML output                       */
/* 04/05/2005 JL Nelson Added XML version per Jim Watkins            */
/* 05/02/2005 JL Nelson Changes for VMS Import XML version 1.3 -     */
/*            draft.                                                 */
/* 06/09/2005 JL Nelson Pass MAXCC in ZISPFRC variable.              */
/* 06/15/2005 JL Nelson Reset return code to end job step.           */
/* 10/21/2005 CL Fenton Modified for v5.11.                          */
/* 03/09/2006 JL Nelson Set/test RCode for every ISPEXEC command.    */
/* 03/20/2006 JL Nelson Use NRSTR avoid abend 900 if ampersand in    */
/*            data.                                                  */
/* 03/22/2006 JL Nelson Made changes to avoid SUBSTR abend 920/932.  */
/* 06/05/2006 CL Fenton Changes made for use in Asset creation       */
/*            process.                                               */
/* 08/07/2006 CL Fenton Removed TYPERUN tests from process.          */
/* 02/28/2009 CL Fenton Added TYPERUN tests product analysis to      */
/*            obtain ELEMENT_KEY for products.                       */
/* 10/08/2009 CL Fenton Changed ASSET ID "OS390" to "SYSNAME"        */
/*            change requires that field also be changed in VMS      */
/*            before script change can go into affect.               */
/* 01/10/2013 CL Fenton Added test to bypass members that begins     */
/*            with '$', STS-001588.                                  */
/* 09/14/2017 CL Fenton Converted for Clist script to REXX script.   */
/*            Removed other information used in Clist that are not   */
/*            needed in REXX.                                        */
/* 10/03/2017 CL Fenton Changed OS390 key field name to z/OS,        */
/*            STS-018513.                                            */
/* 06/14/2018 CL Fenton Deleted varible CACM0403.                    */
/*                                                                   */
/*                                                                   */
/*                                                                   */
/*                                                                   */
/*********************************************************************/
pgmname  = "CACC041X 06/14/18"
CONSLIST = 'OFF'                   /* DEFAULT IS OFF                       */
COMLIST  = 'OFF'                   /* DEFAULT IS OFF                       */
SYMLIST  = 'OFF'                   /* DEFAULT IS OFF                       */
TERMMSGS = 'OFF'                   /* DEFAULT IS OFF                       */
CACC1000 = 'CACC1000'              /* Security check program               */
CACM041X = 'CACM041X'              /* VIEW PDI* members program            */
CACT0003 = 'CACT0003'              /* PDI KEY table for 5.11               */
DESC     =                         /* Asset Description                    */
CLASS    =                         /* 0-Secret, 1-Confidential, 2-Unclass  */
MAC      =                         /* 0-MAC I, 1-MAC II, 2-MAC III         */
CONF     =                         /* 1-Public, 2-Sensitive, 3-Confidential*/
STATUS   =                         /* 1-Online, 2-Offline                  */
USE      =                         /* 1-Prod, 2-Support, 3-Test/Develop    */
BLDG     =                         /* Building asset resides               */
ROOM     =                         /* Room asset resides                   */
SERNR    =                         /* Asset's Serial Number                */
BARCD    =                         /* Asset's Bar Code                     */
MAKE     =                         /* The Make of Asset                    */
MODEL    =                         /* The Model of Asset                   */
MANUF    =                         /* The Manufacturer of the Asset        */
PDIDDN   = 'PDIDD'                 /* PDI DDNAME                           */
XMLDDN   = 'XMLDD'                 /* XML DDNAME                           */
CNTLDDN  = 'CNTL'                  /* CNTL DDNAME                          */
DATADDN  = 'DIALOG'                /* Dialog DD name for review            */
PRODUCTS = 'PRODUCTS'              /* Dialog product member name           */
CACM000C = 'CACM000C'              /* Script to review products            */
TRACE    = 'OFF'                   /* TRACE ACTIONS AND ERRORS */
sysname  = MVSVAR('SYSNAME')
Numeric digits 10                           /* dflt of 9 not enough  */
 
Arg OPTION
If option <> "" then do until OPTION = ""
  parse var OPTION key"("val")" OPTION
  val = strip(val,"b","'")
  val = strip(val,"b",'"')
  optcmd = key '= "'val'"'
  interpret optcmd
  end
 
return_code = 0
If trace = "ON" then do            /* TURN messages on          */
  termmsgs = "ON"                  /* CONTROL MSG               */
  comlist = "ON"                   /* CONTROL LIST              */
  conslist = "ON"                  /* CONTROL CONLIST           */
  symlist = "ON"                   /* CONTROL SYMLIST           */
  end
 
If CONSLIST = "ON" | COMLIST = "ON" | SYMLIST = "ON" | TRACE = "ON",
  then Trace r
 
syssymlist = symlist          /* CONTROL SYMLIST/NOSYMLIST */
sysconlist = conslist         /* CONTROL CONLIST/NOCONLIST */
syslist = comlist             /* CONTROL LIST/NOLIST       */
sysmsg = termmsgs             /* CONTROL MSG/NOMSG         */
zispfrc = 0
"CONTROL NONDISPL ENTER"
"CONTROL ERRORS RETURN"
"VPUT (ZISPFRC) SHARED"
return_code = 0
"VPUT (CONSLIST COMLIST SYMLIST TERMMSGS CACT0003) ASIS"
If return_code <> 0 then do
  If termmsgs = "ON" then,
    say pgmname "DELETE RC =" return_code zerrsm
  return_code = return_code + 16
  SIGNAL ERR_EXIT
  end
table. = ""
stigid. = ""
targvul. = ""
tblcnt = 0
return_code = 0
/* Determine which security system is running */
If SysVar('SysEnv') <> "FORE" then do
  "SELECT CMD("cacc1000 "HOST)"
  end
else do
  "VGET (DESC CLASS MAC CONF STATUS USE BLDG ROOM SERNR BARCD",
    "MAKE MODEL MANUF CNTLDSN DATADSN SRRUSER) ASIS"
  address tso "alloc fi("CNTLDDN") da('"CNTLDSN"') shr reuse"
  address tso "alloc fi("DATADDN") da('"DATADSN"') shr reuse"
  x = outtrap("data.")
  Address TSO "DELETE '"srruser".XMLASSET'"
  y = outtrap("off")
  if return_code > 8 then do
    If termmsgs = "ON" then,
      say pgmname "DELETE RC =" return_code zerrsm
    return_code = return_code + 16
    SIGNAL ERR_EXIT
    end
  return_code = 0
  Address TSO "ALLOC FI("xmlddn") DA('"srruser".XMLASSET') NEW,
    SPACE(1 1 ) TRACK LRECL(500) RECFM(V B) DSORG(PS)"
  If return_code <> 0 then do
    If termmsgs = "ON" then,
      Say pgmname "ALLOCATE RC =" return_code zerrsm
    return_code = return_code + 16
    SIGNAL ERR_EXIT
    end
  return_code = 0
  end
"VGET (ACPNAME ACPVERS OPSNAME OPSVERS SRRVERS SRRRELS HOSTNAME",
  "HOSTADDR) ASIS"
 
 
/* *************************************** */
/* INITIALIZE LIBRARY MANAGEMENT           */
/* *************************************** */
return_code = 0
If SysVar('SysEnv') <> "FORE" then do
  "LMINIT DATAID(CNTLID) DDNAME("cntlddn")"
  lminit_cntl_rc = return_code
  If return_code <> 0 then do
    If termmsgs = "ON" then,
      Say pgmname "LMINIT_CNTL_RC" return_code zerrsm
    return_code = return_code + 16
    SIGNAL ERR_EXIT
    end
  end
"LMINIT DATAID(XMLID) DDNAME("xmlddn")"
lminit_xml_rc = return_code
If return_code <> 0 then do
  Say pgmname "LMINIT_XML_RC" return_code zerrsm
  return_code = return_code + 16
  SIGNAL ERR_EXIT
  end
If SysVar('SysEnv') <> "FORE" then do
  "LMINIT DATAID(PDIID) DDNAME("pdiddn")"
  lminit_pdi_rc = return_code
  If return_code <> 0 then do
    Say pgmname "LMINIT_PDI_RC" return_code zerrsm
    return_code = return_code + 16
    SIGNAL ERR_EXIT
    end
  x = listdsi(pdiddn "file")
  pdidsn = sysdsname
  "LMOPEN DATAID("cntlid") OPTION(INPUT)"
  lmopen_cntl_rc = return_code
  If return_code <> 0 then do
    Say pgmname "LMOPEN_CNTL_RC" return_code zerrsm
    return_code = return_code + 16
    SIGNAL ERR_EXIT
    end
  typerun = "INSTALL"
  cactprod = "CACTPROD"
  tblid = ""
  cact0008 = "CACT0008"
  "VPUT (TYPERUN CNTLID CACTPROD CACT0008 TBLID) ASIS"
 
  "LMOPEN DATAID("pdiid") OPTION(INPUT)"
  lmopen_pdi_rc = return_code
  If return_code <> 0 then do
    Say pgmname "LMOPEN_PDI_RC" return_code zerrsm
    return_code = return_code + 16
    SIGNAL ERR_EXIT
    end
  end
call read_dsnmbr dataddn products
instprod = left(OPSNAME,8)" "left(ACPNAME,8)" "
do x = 1 to rec.0
  if substr(rec.x,10,4) = "0 Y " then do
    instprod = instprod""substr(rec.x,1,8)" "
    end
  end
rec. = ""
"LMOPEN DATAID("xmlid") OPTION(OUTPUT)"
lmopen_xml_rc = return_code
If return_code <> 0 then do
  Say pgmname "LMOPEN_XML_RC" return_code zerrsm
  return_code = return_code + 16
  SIGNAL ERR_EXIT
  end
return_code = 0
"VPUT (XMLID) ASIS"
call read_dsnmbr cntlddn cact0003
Select
  When opsname = "z/OS" Then do
    os_element = 106
    os_targ = 55
    end
  When opsname = "OS390" Then do
    os_element = 105
    os_targ = 50
    end
  When opsname = "Z/OS" Then do
    os_element = 106
    os_targ = 55
    end
  When opsname = "OS/390" Then do
    os_element = 105
    os_targ = 50
    end
  Otherwise nop
  end
 
Select
  When acpname = "ACF2" Then do
    acp_element = 198
    a_targ = 60
    end
  When acpname = "RACF" Then do
    acp_element = 197
    a_targ = 65
    end
  When acpname = "TSS" Then do
    acp_element = 199
    a_targ = 70
    end
  Otherwise nop
  end
 
do x = 1 to rec.0
  if substr(rec.x,1,1) = "*" then iterate
  if length(rec.x) > 45 then do
    targ = "0000"
    if substr(rec.x,os_targ,4) <> "0000" then,
      targ = substr(rec.x,os_targ,4)
    if substr(rec.x,a_targ,4) <> "0000" then,
      targ = substr(rec.x,a_targ,4)
    if targ = "0000" then iterate
    end
  parse var rec.x vul 10 stigs 50 .
  do xx = 1 to words(stigs)
    targ = strip(targ,'l','0')
    call process_table word(stigs,xx) targ strip(vul,'t')
    end
  end
xmldata = '<?xml version="1.0" encoding="UTF-8" standalone="yes"?>'
xmldata = '<?xml version="1.0"?>'
"LMPUT DATAID("xmlid") MODE(INVAR) DATALOC(XMLDATA)",
  "DATALEN("length(xmldata)") NOBSCAN"
xmldata = "<IMPORT_FILE xmlns=""urn:FindingImport"">"
"LMPUT DATAID("xmlid") MODE(INVAR) DATALOC(XMLDATA)",
  "DATALEN("length(xmldata)") NOBSCAN"
xmldata = "<AUTHENTICATED>true</AUTHENTICATED>"
"LMPUT DATAID("xmlid") MODE(INVAR) DATALOC(XMLDATA)",
  "DATALEN("length(xmldata)") NOBSCAN"
xmldata = "<ASSET>"
"LMPUT DATAID("xmlid") MODE(INVAR) DATALOC(XMLDATA)",
  "DATALEN("length(xmldata)") NOBSCAN"
/*xmldata = "<ASSET_TS>"timestamp()"</ASSET_TS>"
  "LMPUT DATAID("xmlid") MODE(INVAR) DATALOC(XMLDATA)",
    "DATALEN("length(xmldata)") NOBSCAN")*/
upper hostname
xmldata = "<ASSET_ID TYPE=""ASSET NAME"">"hostname"</ASSET_ID>"
"LMPUT DATAID("xmlid") MODE(INVAR) DATALOC(XMLDATA)",
  "DATALEN("length(xmldata)") NOBSCAN"
xmldata = "<ASSET_ID TYPE=""HOST NAME"">"hostname"</ASSET_ID>"
"LMPUT DATAID("xmlid") MODE(INVAR) DATALOC(XMLDATA)",
  "DATALEN("length(xmldata)") NOBSCAN"
do x = 1 to words(hostaddr)
  hostadd = word(hostaddr,x)
  xmldata = "<ASSET_ID TYPE=""IP ADDRESS"">"hostadd"</ASSET_ID>"
  "LMPUT DATAID("xmlid") MODE(INVAR) DATALOC(XMLDATA)",
    "DATALEN("length(xmldata)") NOBSCAN"
  end
xmldata = '<ASSET_ID TYPE="z/OS">'sysname'</ASSET_ID>'
"LMPUT DATAID("xmlid") MODE(INVAR) DATALOC(XMLDATA)",
  "DATALEN("length(xmldata)") NOBSCAN"
If sernr <> " " then do
  xmldata = "<ASSET_ID TYPE=""SERIAL NUMBER"">"sernr"</ASSET_ID>"
  "LMPUT DATAID("xmlid") MODE(INVAR) DATALOC(XMLDATA)",
    "DATALEN("length(xmldata)") NOBSCAN"
  end
xmldata = "<ASSET_TOOL>MVSSCRIPTS</ASSET_TOOL>"
"LMPUT DATAID("xmlid") MODE(INVAR) DATALOC(XMLDATA)",
  "DATALEN("length(xmldata)") NOBSCAN"
xmldata = "<ASSET_TOOL_VERSION>"srrvers" "srrrels"</ASSET_TOOL_VERSION>"
"LMPUT DATAID("xmlid") MODE(INVAR) DATALOC(XMLDATA)",
  "DATALEN("length(xmldata)") NOBSCAN"
xmldata = "<ASSET_TYPE><ASSET_TYPE_KEY>1</ASSET_TYPE_KEY></ASSET_TYPE>"
/*"LMPUT DATAID("xmlid") MODE(INVAR) DATALOC(XMLDATA)",
  "DATALEN("length(xmldata)") NOBSCAN"*/
Do X = 1 to words(instprod)
  installed = word(instprod,x)
  installed = strip(installed,'t')
  a = stigid.installed
  if a <> "" then do
    parse var table.a . key .
    key = strip(key,'l','0')
    xmldata = "<ELEMENT><ELEMENT_KEY>"key"</ELEMENT_KEY></ELEMENT>"
    "LMPUT DATAID("xmlid") MODE(INVAR) DATALOC(XMLDATA)",
      "DATALEN("length(xmldata)") NOBSCAN"
    end
  end
If class <> " " & class >= 0 & class < 3 then do
  xmldata = "<CLASSIFICATION><CLASS_KEY>"class"</CLASS_KEY></CLASSIFICATION>"
  "LMPUT DATAID("xmlid") MODE(INVAR) DATALOC(XMLDATA)",
    "DATALEN("length(xmldata)") NOBSCAN"
  end
If mac <> " " & mac >= 0 & mac < 3 then do
  xmldata = "<MAC_LEVEL><MAC_LEVEL_KEY>"mac"</MAC_LEVEL_KEY></MAC_LEVEL>"
  "LMPUT DATAID("xmlid") MODE(INVAR) DATALOC(XMLDATA)",
    "DATALEN("length(xmldata)") NOBSCAN"
  end
If conf <> " " & conf > 0 & conf <= 3 then do
  xmldata = "<CONF_LEVEL><CONF_KEY>"conf"</CONF_KEY></CONF_LEVEL>"
  "LMPUT DATAID("xmlid") MODE(INVAR) DATALOC(XMLDATA)",
    "DATALEN("length(xmldata)") NOBSCAN"
  end
If use <> " " & use > 0 & use <= 3 then do
  xmldata = "<USE><USE_KEY>"use"</USE_KEY></USE>"
  "LMPUT DATAID("xmlid") MODE(INVAR) DATALOC(XMLDATA)",
    "DATALEN("length(xmldata)") NOBSCAN"
  end
If status <> " " & status > 0 & status < 3 then do
  xmldata = "<STATUS><STATUS_KEY>"status"</STATUS_KEY></STATUS>"
  "LMPUT DATAID("xmlid") MODE(INVAR) DATALOC(XMLDATA)",
    "DATALEN("length(xmldata)") NOBSCAN"
  end
If desc <> " " then do
  xmldata = "<ASSET_DESCRIPTION>"desc"</ASSET_DESCRIPTION>"
  "LMPUT DATAID("xmlid") MODE(INVAR) DATALOC(XMLDATA)",
    "DATALEN("length(xmldata)") NOBSCAN"
  end
If bldg <> " " then do
  xmldata = "<BUILDING>"bldg"</BUILDING>"
  "LMPUT DATAID("xmlid") MODE(INVAR) DATALOC(XMLDATA)",
    "DATALEN("length(xmldata)") NOBSCAN"
  end
If room <> " " then do
  xmldata = "<ROOM>"room"</ROOM>"
  "LMPUT DATAID("xmlid") MODE(INVAR) DATALOC(XMLDATA)",
    "DATALEN("length(xmldata)") NOBSCAN"
  end
If barcd <> " " then do
  xmldata = "<BARCODE>"barcd"</BARCODE>"
  "LMPUT DATAID("xmlid") MODE(INVAR) DATALOC(XMLDATA)",
    "DATALEN("length(xmldata)") NOBSCAN"
  end
If make <> " " then do
  xmldata = "<MAKE>"make"</MAKE>"
  "LMPUT DATAID("xmlid") MODE(INVAR) DATALOC(XMLDATA)",
    "DATALEN("length(xmldata)") NOBSCAN"
  end
If model <> " " then do
  xmldata = "<MODEL>"model"</MODEL>"
  "LMPUT DATAID("xmlid") MODE(INVAR) DATALOC(XMLDATA)",
    "DATALEN("length(xmldata)") NOBSCAN"
  end
If manuf <> " " then do
  xmldata = "<MANUFACTURER>"manuf"</MANUFACTURER>"
  "LMPUT DATAID("xmlid") MODE(INVAR) DATALOC(XMLDATA)",
    "DATALEN("length(xmldata)") NOBSCAN"
  end
If SysVar('SysEnv') <> "FORE" then do
  member = ""
  return_code = 0
  "LMMLIST DATAID("pdiid") OPTION(LIST) MEMBER(MEMBER) STATS(NO)"
  lmmlist_pdi_rc = return_code
  If return_code <> 0 then do
    Say pgmname "LMMLIST PDI RC" return_code zerrsm
    return_code = return_code + 16
    SIGNAL ERR_EXIT
    end
  oldtarg = ""
  Do while return_code = 0
    member = strip(member,"T")
    return_code = 0
    if substr(member,1,1) <> "$" then do
      if stigid.member = "" then do
        say pgmname "STIGID" member "does not have an entry in",
          cact0003"."
        end
      else do
        a = stigid.member
        parse var table.a stigid targ vul rule .
        if targ <> oldtarg then do
          if oldtarg <> " " then do
            xmldata = "</TARGET>"
            "LMPUT DATAID("xmlid") MODE(INVAR) DATALOC(XMLDATA)",
              "DATALEN("length(xmldata)") NOBSCAN"
            end
          b = targvul.targ
          xmldata = "<TARGET><TARGET_KEY>"targ"</TARGET_KEY>"
          "LMPUT DATAID("xmlid") MODE(INVAR) DATALOC(XMLDATA)",
            "DATALEN("length(xmldata)") NOBSCAN"
          oldtarg = targ
          end
        xmldata = '<FINDING><FINDING_ID TYPE="VK">'vul'</FINDING_ID>'
        "LMPUT DATAID("xmlid") MODE(INVAR) DATALOC(XMLDATA)",
          "DATALEN("length(xmldata)") NOBSCAN"
        "VIEW DATAID("pdiid") MACRO("cacm041x") MEMBER("member")"
        xmldata = "</FINDING>"
        "LMPUT DATAID("xmlid") MODE(INVAR) DATALOC(XMLDATA)",
          "DATALEN("length(xmldata)") NOBSCAN"
        view_pdi_rc = return_code
        If return_code > 4 then do
          Say pgmname "VIEW_PDI_RC =" return_code member zerrsm
          end
/*      call read_dsnmbr pdiddn member
        do x = 1 to rec.0
          say pgmname rec.x
          end*/
        end
      end
    return_code = 0
    "LMMLIST DATAID("pdiid") OPTION(LIST) MEMBER(MEMBER) STATS(NO)"
    return_code = return_code
    end
  xmldata = "</TARGET>"
  "LMPUT DATAID("xmlid") MODE(INVAR) DATALOC(XMLDATA)",
    "DATALEN("length(xmldata)") NOBSCAN"
  end
xmldata = "</ASSET>"
"LMPUT DATAID("xmlid") MODE(INVAR) DATALOC(XMLDATA)",
  "DATALEN("length(xmldata)") NOBSCAN"
xmldata = "</IMPORT_FILE>"
"LMPUT DATAID("xmlid") MODE(INVAR) DATALOC(XMLDATA)",
  "DATALEN("length(xmldata)") NOBSCAN"
If SysVar('SysEnv') <> "FORE" then do
  "LMMLIST DATAID("pdiid") OPTION(FREE)"
  return_code = 0
  "LMCLOSE DATAID("cntlid")"
  lmclose_cntl_rc = return_code
  return_code = 0
  "LMCLOSE DATAID("pdiid")"
  lmclose_pdi_rc = return_code
  end
return_code = 0
"LMCLOSE DATAID("xmlid")"
lmclose_xml_rc = return_code
return_code = 0
If SysVar('SysEnv') <> "FORE" then do
  "LMFREE  DATAID("cntlid")"
  lmfree_cntl_rc = return_code
  return_code = 0
  "LMFREE  DATAID("pdiid")"
  lmfree_pdi_rc = return_code
  return_code = 0
  end
"LMFREE DATAID("xmlid")"
lmfree_xml_rc = return_code
return_code = 0
/* *************************************** */
/* ERROR EXIT                              */
/* *************************************** */
ERR_EXIT:
If SysVar('SysEnv') = "FORE" then do
  Address TSO "FREE FI("cntlddn")"
  Address TSO "FREE FI("dataddn")"
  Address TSO "FREE FI("xmlddn")"
  end
If return_code > 0 then do
  "VGET (ZISPFRC) SHARED"
  zispfrc = return_code
  "VPUT (ZISPFRC) SHARED"
  Say pgmname "ZISPFRC =" zispfrc
  end
"VGET (CM1XVGET) ASIS"
If termmsgs = "ON" then do
  Say "==============================================================="
  Say pgmname "LMINIT_CNTL_RC            "lminit_cntl_rc
  Say pgmname "LMOPEN_CNTL_RC            "lmopen_cntl_rc
  Say pgmname "LMINIT_XML_RC             "lminit_xml_rc
  Say pgmname "LMOPEN_XML_RC             "lmopen_xml_rc
  Say pgmname "LMINIT_PDI_RC             "lminit_pdi_rc
  Say pgmname "LMOPEN_PDI_RC             "lmopen_pdi_rc
  Say pgmname "LMMLIST_PDI_RC            "lmmlist_pdi_rc
  Say pgmname "VIEW_PDI_RC               "view_pdi_rc
  If view_pdi_rc <> 0 then do
    Say pgmname cacm041x "VGET          "cm1xvget
    end
  Say "==============================================================="
  Say pgmname "LMCLOSE_CNTL_RC           "lmclose_cntl_rc
  Say pgmname "LMFREE_CNTL_RC            "lmfree_cntl_rc
  Say pgmname "LMCLOSE_PDI_RC            "lmclose_pdi_rc
  Say pgmname "LMFREE_PDI_RC             "lmfree_pdi_rc
  Say pgmname "LMCLOSE_XML_RC            "lmclose_xml_rc
  Say pgmname "LMFREE_XML_RC             "lmfree_xml_rc
  Say "==============================================================="
  end /* DO - end */
Exit (0)
 
 
read_dsnmbr:
parse arg ddn m
if ddn = "" & m = "" then return
x = listdsi(ddn "file")
if x > 0 then do
  say PGMNAME 'SYSREASON:' SYSREASON
  say PGMNAME SYSMSGLVL2
  return
  end
If termmsgs = "ON" then,
  say pgmname "Processing dataset:" sysdsname "member:" m"."
dd1 = SYSDSNAME
address tso "alloc fi(dd1) da('"SYSDSNAME"("m")') shr reuse"
address tso "execio * diskr dd1 (finis stem rec."
address tso "free fi(dd1)"
return
 
 
process_table:
parse arg a b c
tblcnt = tblcnt + 1
a = strip(a) /* stigid */
b = strip(b) /* targ   */
c = strip(c) /* vul    */
d = a b c
table.tblcnt = d
stigid.a = tblcnt
if a = c then do
  tv =
  targvul.b = tblcnt
  end
else do
  tv = b""c
  targvul.tv = tblcnt
  end
return
 
 
timestamp:
y = left(date("s"),4)
m = substr(date("s"),5,2)
d = right(date("s"),2)
CVT      = C2d(Storage(10,4))              /* point to CVT         */
CVTTZ      = Storage(D2x(CVT + 304),4)     /* point to cvttz       */
CKTZBYTE   = Storage(D2x(CVT + 304),1)     /* need to chk 1st byte */
If bitand(CKTZBYTE,'80'x) = '80'x then,    /* chk for negative     */
  CVTTZ    = C2d(CVTTZ,4)                  /* negative offset C2d  */
Else CVTTZ = C2d(CVTTZ)                    /* postitive offset C2d */
CVTTZ      = CVTTZ * 1.048576 / 3600       /* convert to hours     */
If Format(CVTTZ,3,1) = Format(CVTTZ,3,0) then do /* don't use decimal if */
 CVTTZ = Format(CVTTZ,2,0)      /* not needed           */
 CVTTZ = insert('0',CVTTZ,1)
 end
Else  CVTTZ = Format(CVTTZ,3,1)     /* display 1 decimal    */
return y'-'m'-'d'T'left(time("l"),12)CVTTZ':00'
 
 
NoValue:
Failure:
Syntax:
say pgmname 'REXX error' rc 'in line' sigl':' strip(ERRORTEXT(rc))
say SOURCELINE(sigl)
Exit
 
 
Error:
return_code = rc
If return_code >= 16 then do
  say pgmname "LASTCC =" RC strip(zerrlm)
  say pgmname 'REXX error' rc 'in line' sigl':' ERRORTEXT(rc)
  end
return