/* REXX */                                                                      
/*                                       */                                     
/* AUTHOR: Mark Zelden                   */                                     
/*                                       */                                     
/* Trace ?r */                                                                  
/*********************************************************************/         
/*                                                                   */         
/*   D I S C L A I M E R                                             */         
/*   -------------------                                             */         
/*                                                                   */         
/* This program is FREEWARE. Use at your own risk.  Neither Mark     */         
/* Zelden, nor other contributing organizations or individuals       */         
/* accept any liability of any kind howsoever arising out of the use */         
/* of this program. You are free to use and modify this program as   */         
/* you desire, however, the author does ask that you leave his name  */         
/* in the source and give credit to him as the original programmer.  */         
/*                                                                   */         
/*********************************************************************/         
/* IPLINFO:  DISPLAY SYSTEM INFORMATION ON TERMINAL                  */         
/*********************************************************************/         
/*                                                                   */         
/* IPLINFO can be called as an interactive exec / ISPF edit macro    */         
/* or in batch to display various system information.  The result    */         
/* will be displayed in an ISPF browse data set if ISPF is active.   */         
/* IPLINFO can also be called as a REXX function to return from 1    */         
/* to 20 variables used in the exec at their final value.  If more   */         
/* than one variable is requested the variables are returned with    */         
/* a space between each variable so they may be parsed if desired.   */         
/* See below for the syntax of each method.                          */         
/*                                                                   */         
/*********************************************************************/         
/*                                                                   */         
/* EXECUTION SYNTAX:                                                 */         
/*                                                                   */         
/* TSO %IPLINFO <option>                                             */         
/*                                                                   */         
/* VALID OPTIONS ARE 'ALL', 'IPL', 'VERsion', 'STOrage', 'CPU',      */         
/*                   'IPA', 'SYMbols', 'VMAp', 'PAGe', 'SMF', 'SUB', */         
/*                   'ASId', 'LPA', 'LNKlst or LINklist' and 'APF'   */         
/*                                                                   */         
/* ** 'ALL' is the default option                                    */         
/* ** OPTIONS may be abbreviated by using 3 or more characters       */         
/*                                                                   */         
/* ** A 2nd parameter option of 'NOBrowse' may also be specified to  */         
/*    eliminate browsing the output even when ISPF is active. This   */         
/*    will allow any IPLINFO output to be trapped and parsed from    */         
/*    another exec or edit macro if desired.  The 'NOBrowse' option  */         
/*    can also be specified as the only option and it will produce   */         
/*    all IPLINFO output without browsing it.                        */         
/*                                                                   */         
/* Examples:                                                         */         
/*  TSO %IPLINFO         (Display all information)                   */         
/*  TSO %IPLINFO VMAP    (Display a Virtual Storage Map)             */         
/*  TSO %IPLINFO SYM     (Display Static System Symbols)             */         
/*  TSO %IPLINFO SUB     (Display Subsystem Information)             */         
/*  TSO %IPLINFO APF     (Display APF Library List)                  */         
/*  TSO %IPLINFO ALL NOB (Display all infomation, don't browse O/P)  */         
/*  TSO %IPLINFO SUB NOB (Display subsys info, don't browse O/P)     */         
/*  TSO %IPLINFO NOBROWSE (Display all infomation, don't browse O/P) */         
/*                                                                   */         
/* Edit macro invocation:                                            */         
/*  IPLINFO              (Display all information)                   */         
/*  IPLINFO VMAP         (Display a Virtual Storage Map)             */         
/*  IPLINFO SYM          (Display Static System Symbols)             */         
/*  IPLINFO SUB          (Display Subsystem Information)             */         
/*  IPLINFO APF          (Display APF Library List)                  */         
/*  IPLINFO ALL NOB      (Display all infomation, don't browse O/P)  */         
/*  IPLINFO SUB NOB      (Display subsys info, don't browse O/P)     */         
/*  IPLINFO NOBROWSE     (Display all infomation, don't browse O/P)  */         
/*                                                                   */         
/* Sample Unix System Services WEB Server execution via links:       */         
/*  <a href="/cgi-bin/iplinfo">MVS Information</a>                   */         
/*  <a href="/cgi-bin/iplinfo?vmap">Virtual Storage Map</a>          */         
/*  <a href="/cgi-bin/iplinfo?symbols">Static System Symbols</a>     */         
/*  <a href="/cgi-bin/iplinfo?sub">Subsystem Information</a>         */         
/*  <a href="/cgi-bin/iplinfo?apf">APF Library List</a>              */         
/*                                                                   */         
/*********************************************************************/         
/*                                                                   */         
/* FUNCTION SYNTAX:                                                  */         
/*                                                                   */         
/* IPLINFO(VAR,var1_name)                                            */         
/* IPLINFO(VAR,var1_name,var2_name,var3_name, ... var20_name)        */         
/*                                                                   */         
/* Examples:                                                         */         
/*  sysname = IPLINFO(VAR,GRSNAME)                                   */         
/*  pvtsize = IPLINFO(VAR,GDAPVTSZ)                                  */         
/*                                                                   */         
/*                                                                   */         
/*  /* REXX one line IPL information using IPLINFO rexx function */  */         
/*  IPL_SUM  = IPLINFO(var,ipldate,ipltime,iplvol,ipladdr,iplparm)   */         
/*  Parse var IPL_SUM ipldate ipltime iplvol ipladdr iplparm         */         
/*  Say 'Date:'ipldate  ' Time:'ipltime ' Vol:'iplvol ,              */         
/*      ' Load addr:'ipladdr ' LOADPARM:'iplparm                     */         
/*                                                                   */         
/*********************************************************************/         
/*                                                                   */         
/* NOTE: The dynamic APF and dynamic LNKLST code in this exec        */         
/*       use undocumented IBM control blocks and may break at        */         
/*       any time!                                                   */         
/*     ... tested on MVS ESA V4.3 up through z/OS 1.9.               */         
/*                                                                   */         
/* NOTE: The LNKLST SET displayed is the LNKLST SET of the address   */         
/*       space running this exec, not necessarily the most           */         
/*       current one. For the current LNKLST SET either:             */         
/*       1) Run this exec in batch.                                  */         
/*       2) Log off and on TSO before executing this exec.           */         
/*       3) Issue SETPROG LNKLST,UPDATE,JOB=userid  (B4 execution)   */         
/*                                                                   */         
/* NOTE: The APF flag in the LNKLST display is the status if the     */         
/*       data set is accessed VIA LNKLST. Therefore, if IEASYSxx     */         
/*       specifies LNKAUTH=LNKLST, all entires are marked as APF=Y.  */         
/*                                                                   */         
/*********************************************************************/         
LASTUPD = '07/23/2008'                       /* date of last update  */         
/*********************************************************************/         
/*                                                                   */         
/* B E G I N    C U S T O M I Z A T I O N    S E C T I O N           */         
/*                                                                   */         
/*   You may changes the variables below to your preference.         */         
/*   You may only choose the options that are commented out.         */         
/*                                                                   */         
/*  DATEFMT - Controls date format:   ISO ; USA ; EUR                */         
/*  VMAP    - Controls VMAP order:    HIGHFIRST ; LOWFIRST           */         
/*                                                                   */         
/*********************************************************************/         
DATEFMT = 'ISO'          /* ISO 8601 format YYYY-MM-DD (new default) */         
/* DATEFMT = 'USA' */    /* USA format MM/DD/YYYY (original format)  */         
/* DATEFMT = 'EUR' */    /* EUR format DD/MM/YYYY                    */         
/*********************************************************************/         
VMAP = 'HIGHFIRST'       /* new default - show VMAP from top down    */         
/* VMAP = 'LOWFIRST' */  /* the old way - show from bottom up        */         
/*  Please let me know if you "need" the old way (LOWFIRST) as I     */         
/*  will probably remove the duplicate code in the future.           */         
/*********************************************************************/         
/*                                                                   */         
/* E N D    C U S T O M I Z A T I O N    S E C T I O N               */         
/*                                                                   */         
/*********************************************************************/         
Signal On  Syntax  name SIG_ALL     /* trap syntax errors            */         
Signal On  Novalue name SIG_ALL     /* trap uninitialized variables  */         
Arg OPTION,VAR.1,VAR.2,VAR.3,VAR.4,VAR.5,VAR.6,VAR.7,VAR.8,VAR.9, ,             
  VAR.10,VAR.11,VAR.12,VAR.13,VAR.14,VAR.15,VAR.16,VAR.17,VAR.18, ,             
  VAR.19,VAR.20                                                                 
Parse source . EXEC_TYPE . . . . . ENV . .                                      
MML      = Substr(LASTUPD,1,2)             /* MM from MM/DD/YYYY     */         
DDL      = Substr(LASTUPD,4,2)             /* DD from MM/DD/YYYY     */         
YYYYL    = Substr(LASTUPD,7,4)             /* YYYY from MM/DD/YYYY   */         
If DATEFMT = 'USA' then ,                  /* USA format date?       */         
  LASTUPD  = LASTUPD                       /* date as MM/DD/YYYY     */         
If DATEFMT = 'EUR' then ,                  /* EUR format date?       */         
  LASTUPD  = DDL'/'MML'/'YYYYL             /* date as DD/MM/YYYY     */         
If DATEFMT = 'ISO' then ,                  /* ISO format date?       */         
  LASTUPD  = YYYYL'-'MML'-'DDL             /* date as YYYY-MM-DD     */         
SYSISPF = 'NOT ACTIVE'                     /* set SYSISPF=NOT ACTIVE */         
If ENV <> 'OMVS' then                      /* are we under unix ?    */         
  If Sysvar('SYSISPF')='ACTIVE' then do    /* no, is ISPF active?    */         
    If Pos('NOB',OPTION) = 0 then ,        /* NOBrowse not used?     */         
      Address ISREDIT "MACRO (OPTION)"     /* YES,allow use as macro */         
    OPTION = Translate(OPTION)   /* ensure upper case for edit macro */         
    Address ISPEXEC "VGET ZENVIR"          /* ispf version           */         
    SYSISPF = 'ACTIVE'                     /* set SYSISPF = ACTIVE   */         
  End                                                                           
/*********************************************************************/         
BROWSEOP = 'YES'            /* default is to browse OP under ISPF    */         
If OPTION = '' then OPTION = 'ALL' /* Default option. Change to IPL  */         
     /* or something else - may want to change help panel if changed */         
If Abbrev('NOBROWSE',OPTION,3) = 1 then ,   /* NOBROWSE only opt?    */         
  OPTION = 'ALL NOBROWSE'                /* yes, use all option      */         
If Abbrev('NOBROWSE',Word(OPTION,2),3) = 1 then do /* NOBROWSE USED? */         
  OPTION = Word(OPTION,1)                /* separate out option      */         
  BROWSEOP = 'NO'                        /* set BROWSEOP flag to NO  */         
End                                                                             
/*********************************************************************/         
If OPTION <> 'IPL'                 & ,   /* check for IPL option     */         
   Abbrev('VERSION',OPTION,3) <> 1 & ,   /* check for VERsion option */         
   Abbrev('STORAGE',OPTION,3) <> 1 & ,   /* check for STOrage option */         
   OPTION <> 'CPU'                 & ,   /* check for CPU option     */         
   OPTION <> 'IPA'                 & ,   /* check for IPA option     */         
   Abbrev('SYMBOLS',OPTION,3) <> 1 & ,   /* check for SYMbols option */         
   Abbrev('VMAP',OPTION,3) <> 1    & ,   /* check for VMAp option    */         
   Abbrev('PAGE',OPTION,3) <> 1    & ,   /* check for PAGe option    */         
   OPTION <> 'SMF'                 & ,   /* check for SMF option     */         
   OPTION <> 'SUB'                 & ,   /* check for SUB option     */         
   Abbrev('ASID',OPTION,3) <> 1    & ,   /* check for ASId option    */         
   Abbrev('ASVT',OPTION,3) <> 1    & ,   /* check for ASVt option    */         
   OPTION <> 'LPA'                 & ,   /* check for LPA option     */         
   Abbrev('LNKLST',OPTION,3) <> 1  & ,   /* check for LNKlst option  */         
   Abbrev('LINKLIST',OPTION,3) <> 1 & ,  /* check for LINklist option*/         
   OPTION <> 'APF'                 & ,   /* check for APF option     */         
   OPTION <> 'ALL'                 & ,   /* check for ALL option     */         
   Substr(OPTION,1,3) <> 'VAR'       ,   /* check for VAR option     */         
   then call INVALID_OPTION              /* no valid option...       */         
Numeric digits 10                           /* dflt of 9 not enough  */         
Call COMMON            /* control blocks needed by multiple routines */         
Call HEADING                                /* Heading sub-routine   */         
Select                                                                          
  When OPTION = 'ALL' |  Substr(OPTION,1,3) = 'VAR' then do                     
    Call IPL                                /* IPL information       */         
    Call VERSION                            /* Version information   */         
    Call STOR                               /* Storage information   */         
    Call CPU                                /* CPU information       */         
    Call IPA                                /* Initialization info.  */         
    Call SYMBOLS                            /* Symbols information   */         
    Call VMAP                               /* Virt. Storage Map     */         
    Call PAGE                               /* Page DSN information  */         
    Call SMF                                /* SMF DSN information   */         
    Call SUB                                /* Subsystem information */         
    Call ASID                               /* ASID usage information*/         
    Call LPA                                /* LPA List information  */         
    Call LNKLST                             /* LNKLST information    */         
    Call APF                                /* APF List information  */         
  End /* when OPTION = 'ALL' */                                                 
  When Abbrev('VERSION',OPTION,3)  = 1 then call VERSION                        
  When Abbrev('STORAGE',OPTION,3)  = 1 then call STOR                           
  When Abbrev('SYMBOLS',OPTION,3)  = 1 then call SYMBOLS                        
  When Abbrev('VMAP',OPTION,3)     = 1 then call VMAP                           
  When Abbrev('PAGE',OPTION,3)     = 1 then call PAGE                           
  When Abbrev('ASID',OPTION,3)     = 1 then call ASID                           
  When Abbrev('ASVT',OPTION,3)     = 1 then call ASID                           
  When Abbrev('LNKLST',OPTION,3)   = 1 then call LNKLST                         
  When Abbrev('LINKLIST',OPTION,3) = 1 then call LNKLST                         
  Otherwise interpret "Call" OPTION                                             
End /* select */                                                                
/*********************************************************************/         
/* Done looking at all control blocks                                */         
/*********************************************************************/         
/*********************************************************************/         
/* IPLINFO called as a function. Return variable names and exit      */         
/*********************************************************************/         
If Substr(OPTION,1,3) = 'VAR' & EXEC_TYPE='FUNCTION' then do                    
  "DROPBUF"                                   /* remove data stack   */         
  ALL_VARS = Value(VAR.1)                     /* at least one var    */         
  Do V = 2 to 20                              /* check for others    */         
    If VAR.V = '' then leave                  /* done, leave loop    */         
    Else ALL_VARS = ALL_VARS Value(VAR.V)     /* concat var at end   */         
  End  /* end Do V */                                                           
  Return ALL_VARS                             /* return vars         */         
  Exit 0                                      /* End IPLINFO - RC 0  */         
End                                                                             
/*********************************************************************/         
/* If ISPF is active and the BROWSEOP option is set (default) then   */         
/* browse the output - otherwise write to the terminal               */         
/*********************************************************************/         
If SYSISPF = 'ACTIVE' & BROWSEOP = 'YES' ,   /* ISPF active and      */         
 then call BROWSE_ISPF                       /* BROWSEOP option set? */         
Else do queued()                             /* ISPF is not active   */         
  Parse pull line                            /* pull queued lines    */         
  Say line                                   /* say lines            */         
End /* else do  */                                                              
Exit 0                                       /* End IPLINFO - RC 0   */         
/*********************************************************************/         
/*  End of main IPLINFO code                                         */         
/*********************************************************************/         
/*********************************************************************/         
/*  Start of sub-routines                                            */         
/*********************************************************************/         
INVALID_OPTION:      /* Invalid option sub-routine                   */         
If SYSISPF = 'ACTIVE' then do                                                   
  Queue ' '                                                                     
  Queue '   ******************************************************'             
  Queue '   *            Invalid IPLINFO option.                 *'             
  Queue '   *   Please hit PF1/HELP two times for valid options. *'             
  Queue '   ******************************************************'             
  Queue ' '                                                                     
  OPTION = 'Invalid'                                                            
  Call BROWSE_ISPF                                                              
  Exit 16                                                                       
  End                                                                           
Else do                                                                         
Call CKWEB                                 /* call CKWEB sub-routine */         
  End                                                                           
  Say Copies('*',79)                                                            
  Say " "                                                                       
  Say "Invalid IPLINFO option."                                                 
  Say " "                                                                       
  Say "EXECUTION SYNTAX: %IPLINFO <option>"                                     
  Say " "                                                                       
  Say "VALID OPTIONS ARE 'ALL', 'IPL', 'VERsion'," ,                            
      "'STOrage', 'CPU', 'IPA', 'SYMbols',"                                     
  Say " 'VMAp', 'PAGe', 'SMF', 'SUB'," ,                                        
      "'ASId', 'LPA', 'LNKlst' or 'LINklist' and 'APF'"                         
  Say " "                                                                       
  Say "** 'ALL' is the default option"                                          
  Say "** OPTIONS may be abbreviated by using 3 or more characters"             
  Say " "                                                                       
  Say Copies('*',79)                                                            
  Exit 16                                                                       
End                                                                             
return                                                                          
                                                                                
HEADING:             /* Heading sub-routine                          */         
Call CKWEB                                 /* call CKWEB sub-routine */         
Call RDATE 'TODAY'                         /* call RDATE sub-routine */         
DAY      = Word(RESULT,3)                  /* weekday from RDATE     */         
MMT      = Substr(RESULT,1,2)              /* MM from MM/DD/YYYY     */         
DDT      = Substr(RESULT,4,2)              /* DD from MM/DD/YYYY     */         
YYYYT    = Substr(RESULT,7,4)              /* YYYY from MM/DD/YYYY   */         
If DATEFMT = 'USA' then ,                  /* USA format date?       */         
  DATE     = Substr(RESULT,1,10)           /* date as MM/DD/YYYY     */         
If DATEFMT = 'EUR' then ,                  /* EUR format date?       */         
  DATE     = DDT'/'MMT'/'YYYYT             /* date as DD/MM/YYYY     */         
If DATEFMT = 'ISO' then ,                  /* ISO format date?       */         
  DATE     = YYYYT'-'MMT'-'DDT             /* date as YYYY-MM-DD     */         
JUL      = Substr(RESULT,7,8)              /* date as YYYY.DDD       */         
CURNNNNN = Substr(RESULT,16,5)             /* date as NNNNN          */         
Queue Copies('*',79)                                                            
Queue Copies('*',15) || ,                                                       
      Center('IPLINFO - SYSTEM INFORMATION FOR' GRSNAME,49) || ,                
      Copies('*',15)                                                            
Queue Copies('*',79)                                                            
Queue ' '                                                                       
Queue 'Today is 'DAY DATE '('JUL'). The local time is 'TIME()'.'                
Return                                                                          
                                                                                
CKWEB:         /* Create HTML needed for web page output sub-routine */         
If ENV = 'OMVS' then do                    /* Are we under OMVS?     */         
  Do CKWEB = __ENVIRONMENT.0 to 1 by -1    /* check env. vars        */         
     If pos('HTTP_',__ENVIRONMENT.CKWEB) <> 0 then do  /* web server */         
       Say 'Content-type: text/html'                                            
       Say ''                                                                   
       Say '<title>Mark''s MVS Utilities - IPLINFO</title>'                     
       Say '<meta name="author" content="Mark Zelden -' ,                       
           'mzelden@flash.net">'                                                
       Say '<meta name="description" content="' || ,                            
           'IPLINFO -' OPTION 'option.' ,                                       
           'Last updated on' LASTUPD ||'. Written by' ,                         
           'Mark Zelden. Mark''s MVS Utilities -' ,                             
           'http://home.flash.net/~mzelden/mvsutil.html">'                      
       Say '<meta http-equiv="pragma" content="no-cache">'                      
       Say '<body BGCOLOR="#000000" TEXT="#00FFFF">'                            
       Say '<pre>'                                                              
       Leave                               /* exit loop              */         
     End /* if pos */                                                           
  End /* do CKWEB */                                                            
End                                                                             
Return                                                                          
                                                                                
COMMON:              /* Control blocks needed by multiple routines   */         
CVT      = C2d(Storage(10,4))                /* point to CVT         */         
CVTEXT2  = C2d(Storage(D2x(CVT + 328),4))    /* point to CVTEXT2     */         
PRODNAME = Storage(D2x(CVT - 40),7)          /* point to mvs version */         
If Substr(PRODNAME,3,1) >= 3 then do         /* HBB3310 ESA V3 & >   */         
  CVTOSLV0   = Storage(D2x(CVT + 1264),1)    /* Byte 0 of CVTOSLVL   */         
  CVTOSLV1   = Storage(D2x(CVT + 1265),1)    /* Byte 1 of CVTOSLVL   */         
  CVTOSLV2   = Storage(D2x(CVT + 1266),1)    /* Byte 2 of CVTOSLVL   */         
  CVTOSLV3   = Storage(D2x(CVT + 1267),1)    /* Byte 3 of CVTOSLVL   */         
  CVTOSLV4   = Storage(D2x(CVT + 1268),1)    /* Byte 4 of CVTOSLVL   */         
  CVTOSLV5   = Storage(D2x(CVT + 1269),1)    /* Byte 5 of CVTOSLVL   */         
End                                                                             
If Bitand(CVTOSLV0,'08'x) = '08'x then ,     /* HBB4410 ESA V4 & >   */         
  ECVT     = C2d(Storage(D2x(CVT + 140),4))  /* point to CVTECVT     */         
FMIDNUM  = Storage(D2x(CVT - 32),7)          /* point to fmid        */         
JESCT    = C2d(Storage(D2x(CVT + 296),4))    /* point to JESCT       */         
JESPJESN = Storage(D2x(JESCT + 28),4)        /* name of primary JES  */         
CVTSNAME = Storage(D2x(CVT + 340),8)         /* point to system name */         
GRSNAME  = Strip(CVTSNAME,'T')               /* del trailing blanks  */         
CSD      = C2d(Storage(D2x(CVT + 660),4))    /* point to CSD         */         
SMCA     = Storage(D2x(CVT + 196),4)         /* point to SMCA        */         
SMCA     = Bitand(SMCA,'7FFFFFFF'x)          /* zero high order bit  */         
SMCA     = C2d(SMCA)                         /* convert to decimal   */         
CVTSCPIN = D2x(CVT+832)                      /* point to SCPINFO     */         
SCCB     = C2d(Storage(CVTSCPIN,4))          /* Service Call Cntl Blk*/         
MODEL    = C2d(Storage(D2x(CVT - 6),2))      /* point to cpu model   */         
/*********************************************************************/         
/*  The CPU model is stored in packed decimal format with no sign,   */         
/*  so to make the model printable, it needs to be converted back    */         
/*  to hex.                                                          */         
/*********************************************************************/         
MODEL    = D2x(MODEL)                        /* convert back to hex  */         
PCCAVT    = C2d(Storage(D2x(CVT + 764),4))   /* point to PCCA vect tb*/         
If Bitand(CVTOSLV1,'01'x) = '01'x then do    /* OS/390 R2 and above  */         
  ECVTIPA  = C2d(Storage(D2x(ECVT + 392),4)) /* point to IPA         */         
  IPASCAT  = Storage(D2x(ECVTIPA + 224),63)  /* SYSCAT  card image   */         
End                                                                             
zARCH = 1                                    /* default ARCHLVL      */         
If Bitand(CVTOSLV2,'01'x) = '01'x then do    /* OS/390 R10 and above */         
  FLCARCH  = Storage('A3',1)                 /* FLCARCH in PSA       */         
  If C2d(FLCARCH) <> 0 then zARCH=2          /* non-zero is z/Arch.  */         
End                                                                             
Return                                                                          
                                                                                
IPL:                 /* IPL information sub-routine                  */         
Queue ' '                                                                       
/*********************************************************************/         
/*  The IPL date is stored in packed decimal format - so to make     */         
/*  the date printable, it needs to be converted back to hex and     */         
/*  the packed sign needs to be removed.                             */         
/*********************************************************************/         
IPLTIME  = C2d(Storage(D2x(SMCA + 336),4))   /* IPL Time - binary    */         
IPLDATE  = C2d(Storage(D2x(SMCA + 340),4))   /* IPL Date - 0CYYDDDF  */         
If IPLDATE  >= 16777231 then do              /*          is C = 1 ?  */         
  IPLDATE  = D2x(IPLDATE)                    /* convert back to hex  */         
  IPLDATE  = Substr(IPLDATE,2,5)             /* keep YYDDD           */         
  IPLDATE  = '20'IPLDATE                     /* use 21st century date*/         
End                                                                             
Else do                                                                         
  IPLDATE  = D2x(IPLDATE)                    /* convert back to hex  */         
  IPLDATE  = Left(IPLDATE,5)                 /* keep YYDDD           */         
  IPLDATE  = '19'IPLDATE                     /* use 20th century date*/         
End                                                                             
IPLYYYY  = Substr(IPLDATE,1,4)               /* YYYY portion of date */         
IPLDDD   = Substr(IPLDATE,5,3)               /* DDD  portion of date */         
Call RDATE IPLYYYY IPLDDD                    /* call RDATE subroutine*/         
IPLDAY   = Word(RESULT,3)                    /* weekday from RDATE   */         
MMI      = Substr(RESULT,1,2)                /* MM from MM/DD/YYYY   */         
DDI      = Substr(RESULT,4,2)                /* DD from MM/DD/YYYY   */         
YYYYI    = Substr(RESULT,7,4)                /* YYYY from MM/DD/YYYY */         
If DATEFMT = 'USA' then ,                    /* USA format date?     */         
  IPLDATE  = Substr(RESULT,1,10)             /* date as MM/DD/YYYY   */         
If DATEFMT = 'EUR' then ,                    /* EUR format date?     */         
  IPLDATE  = DDI'/'MMI'/'YYYYI               /* date as DD/MM/YYYY   */         
If DATEFMT = 'ISO' then ,                    /* ISO format date?     */         
  IPLDATE  = YYYYI'-'MMI'-'DDI               /* date as YYYY-MM-DD   */         
IPLJUL   = Substr(RESULT,7,8)                /* date as YYYY.DDD     */         
IPLNNNNN = Substr(RESULT,16,5)               /* date as NNNNN        */         
IPLHH    = Right(IPLTIME%100%3600,2,'0')     /* IPL hour             */         
IPLMM    = Right(IPLTIME%100//3600%60,2,'0') /* IPL minute           */         
IPLSS    = Right(IPLTIME%100//60,2,'0')      /* IPL seconds          */         
IPLTIME  = IPLHH':'IPLMM':'IPLSS             /* time in HH:MM:SS     */         
/*                                                                   */         
ASMVT    = C2d(Storage(D2x(CVT + 704),4))    /* point to ASMVT       */         
CLPABYTE = Storage(D2x(ASMVT + 1),1)         /* point to CLPA byte   */         
CHKCLPA  = Bitand(CLPABYTE,'8'x)             /* check for B'1000'    */         
CHKCLPA  = C2d(CHKCLPA)                      /* convert to decimal   */         
If CHKCLPA < 8 then IPLCLPA = 'with CLPA'    /* bit off - CLPA       */         
  Else IPLCLPA = 'without CLPA'              /* bit on  - no CLPA    */         
RESUCB   = C2d(Storage(D2x(JESCT + 4),4))    /* point to SYSRES UCB  */         
IPLVOL   = Storage(D2x(RESUCB + 28),6)       /* point to IPL volume  */         
If Bitand(CVTOSLV1,'20'x) <> '20'x then ,    /* Below HBB5510 ESA V5 */         
  IPLADDR  = Storage(D2x(RESUCB + 13),3)     /* point to IPL address */         
Else do                                                                         
  CVTSYSAD = C2d(Storage(D2x(CVT + 48),4))   /* point to UCB address */         
  IPLADDR  = Storage(D2x(CVTSYSAD + 4),2)    /* point to IPL UCB     */         
  IPLADDR  = C2x(IPLADDR)                    /* convert to EBCDIC    */         
End                                                                             
SMFNAME  = Storage(D2x(SMCA + 16),4)         /* point to SMF name    */         
SMFNAME  = Strip(SMFNAME,'T')                /* del trailing blanks  */         
AMCBS    = C2d(Storage(D2x(CVT + 256),4))    /* point to AMCBS       */         
If Bitand(CVTOSLV2,'80'x) <> '80'x then do   /*Use CAXWA B4 OS/390 R4*/         
  ACB      = C2d(Storage(D2x(AMCBS + 8),4))  /* point to ACB         */         
  CAXWA    = C2d(Storage(D2x(ACB + 64),4))   /* point to CAXWA       */         
  MCATDSN  = Storage(D2x(CAXWA + 52),44)     /* master catalog dsn   */         
  MCATDSN  = Strip(MCATDSN,'T')              /* remove trailing blnks*/         
  MCATUCB  = C2d(Storage(D2x(CAXWA + 28),4)) /* point to mcat UCB    */         
  MCATVOL  = Storage(D2x(MCATUCB + 28),6)    /* master catalog VOLSER*/         
End                                                                             
Else do                                      /* OS/390 R4 and above  */         
  MCATDSN  = Strip(Substr(IPASCAT,11,44))    /* master catalog dsn   */         
  MCATVOL  = Substr(IPASCAT,1,6)             /* master catalog VOLSER*/         
  IPASCANL = Storage(d2x(ECVTIPA+231),1)     /* mcat alias level     */         
  IPASCTYP = Storage(d2x(ECVTIPA+230),1)     /* mcat catalog type    */         
  AMCBSFLG = Storage(D2x(AMCBS + 96),1)      /* AMCBS flags          */         
  AMCBSALV = C2d(Storage(D2x(AMCBS + 155),1)) /* AMCBS - alias level */         
  If IPASCTYP = ' ' then IPASCTYP = 0     /* chg blank to 0 for stem */         
  CTYP.0   = 'VSAM'                                                             
  CTYP.1   = 'ICF. SYS%-SYS1 conversion was not active at IPL time'             
  CTYP.2   = 'ICF. SYS%-SYS1 conversion was active at IPL time'                 
End                                                                             
Queue 'The last IPL was 'IPLDAY IPLDATE '('IPLJUL')' ,                          
      'at 'IPLTIME' ('CURNNNNN - IPLNNNNN' days ago).'                          
Queue 'The IPL was done 'IPLCLPA'.'                                             
Queue 'The system IPL address was 'IPLADDR' ('IPLVOL').'                        
If Bitand(CVTOSLV0,'08'x) = '08'x then do    /* HBB4410 ESA V4.1 & > */         
  ECVTSPLX = Storage(D2x(ECVT+8),8)          /* point to SYSPLEX name*/         
  ECVTLOAD = Storage(D2x(ECVT+160),8)        /* point to LOAD PARM   */         
  IPLPARM  = Strip(ECVTLOAD,'T')             /* del trailing blanks  */         
  SEPPARM  = Substr(IPLPARM,1,4) Substr(IPLPARM,5,2),                           
             Substr(IPLPARM,7,1) Substr(IPLPARM,8,1)                            
  SEPPARM  = Strip(SEPPARM,'T')              /* del trailing blanks  */         
  Queue 'The IPL LOAD PARM used was 'IPLPARM' ('SEPPARM').'                     
  If Bitand(CVTOSLV1,'20'x) = '20'x then do  /* HBB5510 ESA V5 & >   */         
    CVTIXAVL = C2d(Storage(D2x(CVT+124),4))      /* point to IOCM    */         
    IOCIOVTP = C2d(Storage(D2x(CVTIXAVL+208),4)) /* IOS Vector Table */         
    CDA      = C2d(Storage(D2x(IOCIOVTP+24),4))  /* point to CDA     */         
  End                                                                           
  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) , /* don't use decimal if */         
   then CVTTZ = Strip(Format(CVTTZ,3,0))     /* not needed           */         
  Else  CVTTZ = Strip(Format(CVTTZ,3,1))     /* display 1 decimal    */         
  Queue 'The local time offset from GMT time is' CVTTZ 'hours.'                 
  If Bitand(CVTOSLV1,'10'x) = '10'x then do  /* HBB5520 ESA V5.2 & > */         
    ECVTHDNM = Storage(D2x(ECVT+336),8)      /* point to hardware nam*/         
    ECVTLPNM = Storage(D2x(ECVT+344),8)      /* point to LPAR name   */         
    If Bitand(CVTOSLV2,'01'x) = '01'x then do  /* OS/390 R10 & above */         
      MIFID    = C2d(Storage(D2X(CDA+252),1))  /* MIF ID in decimal  */         
      MIFID    = D2x(MIFID)                    /* MIF ID in hex      */         
      If Bitand(CVTOSLV3,'04'x) = '04'x then do /* z/OS 1.4 and above*/         
        IOCCSSID = C2d(Storage(d2x(CVTIXAVL+275),1))                            
        IOCCSSID = D2x(IOCCSSID)                /* CSS ID in hex     */         
      End                                                                       
      If zARCH = 2 then ,                    /* z/Architechture      */         
        Queue 'The system is running in z/Architecture mode' ,                  
               '(ARCHLVL = 2).'                                                 
      Else ,                                 /* ESA/390 mode         */         
        Queue 'The system is running in ESA/390 mode (ARCHLVL = 1).'            
    End /* If Bitand(CVTOSLV2,'01'x) = '01'x */                                 
    If ECVTHDNM <> ' ' & ECVTLPNM <> ' ' then do                                
      CSDPLPN  = C2d(Storage(D2x(CSD + 252),1))    /* point to LPAR #*/         
   /* CSDPLPN not valid for z990 (T-REX) or z890 for LPAR number     */         
      CPOFF = 0  /* init offset to next PCCA entry                   */         
      PCCA  = 0  /* init PCCA to 0                                   */         
      Do until PCCA <> 0   /* do until we find a valid PCCA          */         
        PCCA = C2d(Storage(D2x(PCCAVT + CPOFF),4)) /* point to PCCA  */         
        If PCCA <> 0 then do                                                    
          LPAR_#  = X2d(Storage(D2x(PCCA + 7),1))  /*Take first digit*/         
          LPAR_#  = D2x(LPAR_#)                    /* LPAR # in hex  */         
        End /* if PCCA <> 0 */                                                  
        Else CPOFF = CPOFF + 4  /* bump up offset for next PCCA      */         
      End /* do until PCCA <> 0 */                                              
      If Bitand(CVTOSLV2,'01'x) = '01'x then do    /* OS/390 R10 & > */         
        Queue 'The Processor name is' Strip(ECVTHDNM)'.' ,                      
               'The LPAR name is' Strip(ECVTLPNM)'.'                            
        If Bitand(CVTOSLV3,'04'x) = '04'x then  /* z/OS 1.4 and above*/         
          Queue ' ' Strip(ECVTLPNM) 'is (HMC defined) LPAR ID =' ,              
                LPAR_#', MIF ID =' mifid 'and CSS ID = 'IOCCSSID'.'             
        Else ,                                                                  
          Queue ' ' Strip(ECVTLPNM) 'is (HMC defined) LPAR ID =' ,              
                LPAR_# 'and MIF ID =' mifid'.'                                  
        Queue ' ' Strip(ECVTLPNM) 'is PR/SM partition number' ,                 
                   CSDPLPN' (internal value from the CSD).'                     
      End /* If Bitand(CVTOSLV2,'01'x) = '01'x */                               
      Else ,                                                                    
        Queue 'The Processor name is' Strip(ECVTHDNM)'.' ,                      
               'The LPAR name is' Strip(ECVTLPNM)' (LPAR #'CSDPLPN').'          
    End  /* If ECVTHDNM <> ' ' & ECVTLPNM <> ' '   */                           
    Else if ECVTHDNM <> ' ' then ,                                              
      Queue 'The Processor name is' Strip(ECVTHDNM)'.'                          
    If Bitand(CVTOSLV1,'20'x) = '20'x ,   /* HBB5510 ESA V5 & above  */         
       & ECVTSPLX <> 'LOCAL' then do      /* and not a local sysplex */         
      JESCTEXT = C2d(Storage(D2x(JESCT +100),4)) /* point to JESPEXT */         
      JESDSNID = X2d(Storage(D2x(JESCTEXT+120),2)) /*ID for temp dsns*/         
      Queue 'The sysplex name is' Strip(ECVTSPLX)'. This was system' ,          
            'number' Format(JESDSNID) 'added to the sysplex.'                   
    End /* If Bitand(CVTOSLV1,'20'x) = '20'x */                                 
    Else queue 'The sysplex name is' Strip(ECVTSPLX)'.'                         
  End  /* If Bitand(CVTOSLV1,'10'x) = '10'x */                                  
End                                                                             
Queue 'The GRS system id (SYSNAME) is 'GRSNAME'.' ,                             
       'The SMF system id (SID) is 'SMFNAME'.'                                  
If Bitand(CVTOSLV1,'20'x) <> '20'x then do   /* Below HBB5510 ESA V5 */         
  IOCON    = Storage(D2x(CVTEXT2 + 6),2)       /* HCD IODFxx or MVSCP*/         
                                               /* IOCONFIG ID=xx     */         
  Queue 'The currently active IOCONFIG or HCD IODF is 'IOCON'.'                 
End                                                                             
Else do                                                                         
  IODF     = Storage(D2X(CDA+32),44)           /* point to IODF name */         
  IODF     = Strip(IODF,'T')                   /* del trailing blanks*/         
  CONFIGID = Storage(D2X(CDA+92),8)            /* point to CONFIG    */         
  EDT      = Storage(D2X(CDA+104),2)           /* point to EDT       */         
  IOPROC   = Storage(D2X(CDA+124),8)           /* point to IODF Proc */         
  IODATE   = Storage(D2X(CDA+156),8)           /* point to IODF date */         
  IOTIME   = Storage(D2X(CDA+164),8)           /* point to IODF time */         
  IODESC   = Storage(D2X(CDA+172),16)          /* point to IODF desc */         
  Queue 'The currently active IODF data set is 'IODF'.'                         
  Queue '  Configuration ID =' CONFIGID ' EDT ID =' EDT                         
  If Substr(IOPROC,1,1) <> '00'x  & ,                                           
     Substr(IOPROC,1,1) <> '40'x then do       /* is token there?    */         
    Queue '  TOKEN: Processor  Date      Time      Description'                 
    Queue '         'IOPROC'   'IODATE'  'IOTIME'  'IODESC                      
  End                                                                           
End                                                                             
Queue 'The Master Catalog is 'MCATDSN' on 'MCATVOL'.'                           
If Bitand(CVTOSLV2,'80'x) = '80'x then do    /* OS/390 R4 and above  */         
 Queue '  The catalog alias level was 'IPASCANL' at IPL time.'                  
 Queue '    The catalog alias level is currently' AMCBSALV'.'                   
 Queue '  The catalog type is 'CTYP.IPASCTYP'.'                                 
 If Bitand(AMCBSFLG,'40'x) = '40'x then ,                                       
   Queue '    SYS%-SYS1 conversion is currently active.'                        
 Else ,                                                                         
   Queue '    SYS%-SYS1 conversion is not currently active.'                    
End                                                                             
/*If OPTION = 'IPL' then interpret call 'VERSION' */ /* incl version*/          
Return                                                                          
                                                                                
VERSION:             /* Version information sub-routine              */         
Queue ' '                                                                       
Call SUB 'FINDJES'   /* call SUB routine with FINDJES option         */         
If JESPJESN = 'JES3' then do                 /* Is this JES3?        */         
  If ENV = 'OMVS' then do  /* running under Unix System Services     */         
    JES3FMID = Storage(D2x(JESSSVT+644),8)      /* JES3 FMID         */         
    Select  /* determine JES3 version from FMID  */                             
      When JES3FMID = 'HJS5521' then JESLEV = 'SP 5.2.1'                        
      When JES3FMID = 'HJS6601' then JESLEV = 'OS 1.1.0'                        
      When JES3FMID = 'HJS6604' then JESLEV = 'OS 2.4.0'                        
      When JES3FMID = 'HJS6606' then JESLEV = 'OS 2.6.0'                        
      When JES3FMID = 'HJS6608' then JESLEV = 'OS 2.8.0'                        
      When JES3FMID = 'HJS6609' then JESLEV = 'OS 2.9.0'                        
      When JES3FMID = 'HJS7703' then JESLEV = 'OS 2.10.0'                       
      When JES3FMID = 'HJS7705' then JESLEV = 'z 1.2.0'                         
      When JES3FMID = 'HJS7707' then JESLEV = 'z 1.4.0'                         
      When JES3FMID = 'HJS7708' then JESLEV = 'z 1.5.0'                         
      When JES3FMID = 'HJS7720' then JESLEV = 'z 1.7.0'                         
      When JES3FMID = 'HJS7730' then JESLEV = 'z 1.8.0'                         
      When JES3FMID = 'HJS7740' then JESLEV = 'z 1.9.0'                         
      Otherwise JESLEV = JES3FMID /* if not in tbl, use FMID as ver  */         
    End /* select */                                                            
    JESNODE  = '*not_avail*'                 /* can't do under USS   */         
  End /* if env = 'omvs' */                                                     
  Else do /* if not running under Unix System Services, use TSO VARs */         
    JESLEV   = SYSVAR('SYSJES')              /* TSO/E VAR for JESLVL */         
    JESNODE  = SYSVAR('SYSNODE')             /* TSO/E VAR for JESNODE*/         
  End                                                                           
End                                                                             
Else do  /* JES2 */                                                             
  JESLEV   = Strip(Storage(D2x(JESSUSE),8))  /* JES2 Version         */         
  /* offset in $HCCT - CCTNDENM */                                              
  Select                                                                        
    When Substr(JESLEV,1,8) == 'z/OS 1.9' then, /* z/OS 1.9          */         
      JESNODE  = Strip(Storage(D2x(JESSUS2+708),8)) /* JES2 NODE     */         
    When Substr(JESLEV,1,8) == 'z/OS 1.8' then, /* z/OS 1.8          */         
      JESNODE  = Strip(Storage(D2x(JESSUS2+620),8)) /* JES2 NODE     */         
    When Substr(JESLEV,1,8) == 'z/OS 1.7' then, /* z/OS 1.7          */         
      JESNODE  = Strip(Storage(D2x(JESSUS2+616),8)) /* JES2 NODE     */         
    When Substr(JESLEV,1,8) == 'z/OS 1.5' | , /* z/OS 1.5 & 1.6      */         
      Substr(JESLEV,1,8) == 'z/OS 1.4' then   /* z/OS 1.4            */         
      JESNODE  = Strip(Storage(D2x(JESSUS2+532),8)) /* JES2 NODE     */         
    When Substr(JESLEV,1,7) == 'OS 2.10' | ,  /* OS/390 2.10 and     */         
      Substr(JESLEV,1,8) == 'z/OS 1.2' then,  /* z/OS 1.2            */         
      JESNODE  = Strip(Storage(D2x(JESSUS2+452),8)) /* JES2 NODE     */         
    When Substr(JESLEV,1,6) == 'OS 1.1' | , /* OS/390 1.1  or        */         
      Substr(JESLEV,1,4) == 'SP 5' then ,    /* ESA V5 JES2          */         
      JESNODE  = Strip(Storage(D2x(JESSUS2+336),8)) /*   JES2 NODE   */         
    When Substr(JESLEV,1,5) == 'OS 1.' | ,   /* OS/390 1.2           */         
      Substr(JESLEV,1,5) == 'OS 2.' then,    /*  through OS/390 2.9  */         
      JESNODE  = Strip(Storage(D2x(JESSUS2+372),8)) /* JES2 NODE     */         
    Otherwise ,                              /* Lower than ESA V5    */         
      If ENV = 'OMVS' then JESNODE = '*not_avail*'                              
      else JESNODE  = SYSVAR('SYSNODE')      /* TSO/E VAR for JESNODE*/         
  End  /* select */                                                             
End /* else do */                                                               
/*                                                                   */         
CVTVERID = Storage(D2x(CVT - 24),16)         /* "user" software vers.*/         
CVTRAC   = C2d(Storage(D2x(CVT + 992),4))    /* point to RACF CVT    */         
RCVTID   = Storage(D2x(CVTRAC),4)            /* point to RCVTID      */         
                                             /* RCVT, ACF2, or RTSS  */         
SECNAM = RCVTID                              /* ACF2 SECNAME = RCVTID*/         
If RCVTID = 'RCVT' then SECNAM = 'RACF'      /* RCVT is RACF         */         
If RCVTID = 'RTSS' then SECNAM = 'Top Secret'  /* RTSS is Top Secret */         
RACFVRM  = Storage(D2x(CVTRAC + 616),4)      /* RACF Ver/Rel/Mod     */         
RACFVER  = Substr(RACFVRM,1,1)               /* RACF Version         */         
RACFREL  = Substr(RACFVRM,2,2)               /* RACF Release         */         
If Bitand(CVTOSLV2,'01'x) <> '01'x then ,    /* below OS/390 R10     */         
  RACFREL  = Format(RACFREL)                 /* Remove leading 0     */         
RACFMOD  = Substr(RACFVRM,4,1)               /* RACF MOD level       */         
RACFLEV  = RACFVER || '.' || RACFREL || '.' || RACFMOD                          
If RCVTID = 'RCVT' | RCVTID = 'RTSS' then ,                                     
 RCVTDSN = Strip(Storage(D2x(CVTRAC + 56),44))  /* RACF prim dsn or  */         
                                                /* TSS Security File */         
If SECNAM = 'ACF2' then do                                                      
  SSCVT    = C2d(Storage(D2x(JESCT+24),4))   /* point to SSCVT       */         
  Do while SSCVT <> 0                                                           
    SSCTSNAM = Storage(D2x(SSCVT+8),4)       /* subsystem name       */         
    If SSCTSNAM = 'ACF2' then do                                                
      ACCVT    = C2d(Storage(D2x(SSCVT + 20),4)) /* ACF2 CVT         */         
      ACCPFXP  = C2d(Storage(D2x(ACCVT - 4),4))  /* ACCVT prefix     */         
      ACCPIDL  = C2d(Storage(D2x(ACCPFXP + 8),2))  /* Len ident area */         
      LEN_ID   = ACCPIDL-4 /* don't count ACCPIDL and ACCPIDO in len */         
      ACCPIDS  = Strip(Storage(D2x(ACCPFXP + 12),LEN_ID)) /*sys ident*/         
      Leave                                                                     
    End                                                                         
  SSCVT    = C2d(Storage(D2x(SSCVT+4),4))    /* next sscvt or zero   */         
  End  /*  Do while SSCVT <> 0 */                                               
End                                                                             
/*                                                                   */         
CVTDFA   = C2d(Storage(D2x(CVT + 1216),4))   /* point to DFP ID table*/         
DFAPROD  = C2d(Storage(D2x(CVTDFA +16),1))   /* point to product byte*/         
If DFAPROD = 0 then do                       /* DFP not DF/SMS       */         
  DFAREL   = C2x(Storage(D2x(CVTDFA+2),2))   /* point to DFP release */         
  DFPVER   = Substr(DFAREL,1,1)              /* DFP Version          */         
  DFPREL   = Substr(DFAREL,2,1)              /* DFP Release          */         
  DFPMOD   = Substr(DFAREL,3,1)              /* DFP Mod Lvl          */         
  DFPRD    = 'DFP'                           /* product is DFP       */         
  DFLEV    = DFPVER || '.' || DFPREL || '.' || DFPMOD                           
End                                                                             
Else do                                      /* DFSMS not DFP        */         
  DFARELS  = C2x(Storage(D2x(CVTDFA+16),4))  /* point to DF/SMS rel  */         
  DFAVER   = X2d(Substr(DFARELS,3,2))        /* DF/SMS Version       */         
  DFAREL   = X2d(Substr(DFARELS,5,2))        /* DF/SMS Release       */         
  DFAMOD   = X2d(Substr(DFARELS,7,2))        /* DF/SMS Mod Lvl       */         
  DFPRD    = 'DFSMS'                         /* product is DF/SMS    */         
  DFLEV    = DFAVER || '.' || DFAREL || '.' || DFAMOD                           
  If DFAPROD = 2 then DFLEV = 'OS/390' DFLEV                                    
  If DFAPROD = 3 then DFLEV = 'z/OS' DFLEV                                      
End                                                                             
/*                                                                   */         
CVTTVT   = C2d(Storage(D2x(CVT + 156),4))    /* point to TSO vect tbl*/         
TSVTLVER = Storage(D2x(CVTTVT+100),1)        /* point to TSO Version */         
TSVTLREL = Storage(D2x(CVTTVT+101),2)        /* point to TSO Release */         
TSVTLREL = Format(TSVTLREL)                  /* Remove leading 0     */         
TSVTLMOD = Storage(D2x(CVTTVT+103),1)        /* point to TSO Mod Lvl */         
TSOLEV   = TSVTLVER || '.' || TSVTLREL || '.' || TSVTLMOD                       
/*                                                                   */         
CHKVTACT = Storage(D2x(CVTEXT2+64),1)        /* VTAM active flag     */         
If bitand(CHKVTACT,'80'x) = '80'x then do      /* vtam is active     */         
  CVTATCVT = C2d(Storage(D2x(CVTEXT2 + 65),3)) /* point to VTAM AVT  */         
  ISTATCVT = C2d(Storage(D2x(CVTATCVT + 0),4)) /* point to VTAM CVT  */         
  ATCVTLVL = Storage(D2x(ISTATCVT + 0),8)      /* VTAM Rel Lvl VOVRP */         
  VTAMVER  = Substr(ATCVTLVL,3,1)              /* VTAM Version   V   */         
  VTAMREL  = Substr(ATCVTLVL,4,1)              /* VTAM Release    R  */         
  VTAMMOD  = Substr(ATCVTLVL,5,1)              /* VTAM Mod Lvl     P */         
  If VTAMMOD = ' ' then VTAMLEV =  VTAMVER || '.' || VTAMREL                    
    else VTAMLEV =  VTAMVER || '.' || VTAMREL || '.' || VTAMMOD                 
/*                                                                   */         
  ATCNETID = Strip(Storage(D2x(ISTATCVT + 2080),8))  /* VTAM NETID   */         
  ATCNQNAM = Strip(Storage(D2x(ISTATCVT + 2412),17)) /* VTAM SSCPNAME*/         
  VTAM_ACTIVE = 'YES'                                                           
End /* if bitand (vtam is active) */                                            
Else VTAM_ACTIVE = 'NO'                                                         
If Bitand(CVTOSLV1,'02'x) <> '02'x then ,    /* Below OS/390 R1      */         
  Queue 'The MVS version is 'PRODNAME' - FMID 'FMIDNUM'.'                       
Else do                                                                         
  PRODNAM2 = Storage(D2x(ECVT+496),16)       /* point to product name*/         
  PRODNAM2 = Strip(PRODNAM2,'T')             /* del trailing blanks  */         
  VER      = Storage(D2x(ECVT+512),2)        /* point to version     */         
  REL      = Storage(D2x(ECVT+514),2)        /* point to release     */         
  MOD      = Storage(D2x(ECVT+516),2)        /* point to mod level   */         
  VRM      = VER'.'REL'.'MOD                                                    
  Queue 'The OS version is 'PRODNAM2 VRM' - FMID' ,                             
         FMIDNUM' ('PRODNAME').'                                                
End                                                                             
If CVTVERID <> ' ' then ,                                                       
  Queue 'The "user" system software version is' Strip(CVTVERID,'T')'.'          
Queue 'The primary job entry subsystem is 'JESPJESN'.'                          
Queue 'The 'JESPJESN 'level is 'JESLEV'.' ,                                     
      'The 'JESPJESN 'node name is 'JESNODE'.'                                  
If SECNAM <> 'RACF' | RACFVRM < '2608' then do                                  
  Queue 'The security software is 'SECNAM'.'                                    
  If SECNAM = 'ACF2' then queue '  The ACF2 level is' ACCPIDS'.'                
  Queue '  The RACF level is 'RACFLEV'.'                                        
  If SECNAM = 'Top Secret' then ,                                               
   Queue '  The TSS Security File DSN is' RCVTDSN'.'                            
  If SECNAM = 'RACF' then ,                                                     
   Queue '  The RACF Primary DSN is' RCVTDSN'.'                                 
End                                                                             
Else do                                                                         
  Queue 'The security software is' Word(PRODNAM2,1) ,                           
        'Security Server (RACF).' ,                                             
        'The FMID is HRF' || RACFVRM || '.'                                     
  Queue '  The RACF Primary DSN is' RCVTDSN'.'                                  
End                                                                             
Queue 'The' DFPRD 'level is' DFLEV'.'                                           
Queue 'The TSO level is 'TSOLEV'.'                                              
If SYSISPF = 'ACTIVE' then do                /* is ISPF active?      */         
  Address ISPEXEC "VGET ZISPFOS"             /* yes, is it OS?390?   */         
  If RC = 0 then do                          /* yes, get OS/390 var  */         
    ISPFLEV = Strip(Substr(ZISPFOS,10,15))   /* only need version    */         
    Address ISPEXEC "VGET ZENVIR"            /* ispf internal rel var*/         
    ISPFLEVI = Substr(ZENVIR,1,8)            /* internal ISPF release*/         
    Queue 'The ISPF level is 'ISPFLEV' ('ISPFLEVI').'                           
  End  /* if RC */                                                              
  Else do                          /* not OS/390 - use old variables */         
    Address ISPEXEC "VGET ZPDFREL"           /* get pdf release info */         
    ISPFLEV  = Substr(ZENVIR,6,3)            /* ISPF level           */         
    PDFLEV   = Substr(ZPDFREL,5,3)           /* PDF  level           */         
    Queue 'The ISPF level is 'ISPFLEV'. The PDF level is' PDFLEV'.'             
  End /* else do */                                                             
End  /* if SYSISPF */                                                           
If VTAM_ACTIVE = 'YES' then do                                                  
  Queue 'The VTAM level is 'VTAMLEV'.'                                          
  Queue '  The NETID is' ATCNETID'. The SSCPNAME is' ATCNQNAM'.'                
End /* if VTAM_ACTIVE = YES */                                                  
Else Queue 'The VTAM level is not available - VTAM is not active.'              
Return                                                                          
                                                                                
STOR:                /* Storage information sub-routine              */         
Queue ' '                                                                       
CVTRLSTG = C2d(Storage(D2x(CVT + 856),4))    /* point to store at IPL*/         
CVTRLSTG = CVTRLSTG/1024                     /* convert to Megabytes */         
If zARCH <> 2 then do                        /* not valid in 64-bit  */         
  CVTEORM  = C2d(Storage(D2x(CVT + 312),4))  /* potential real high  */         
  CVTEORM  = (CVTEORM+1)/1024/1024           /* convert to Megabytes */         
  RCE      = C2d(Storage(D2x(CVT + 1168),4)) /* point to RCE         */         
  ESTOR    = C2d(Storage(D2x(RCE + 160),4))  /* point to ESTOR frames*/         
  ESTOR    = ESTOR*4/1024                    /* convert to Megabytes */         
End                                                                             
Call STORAGE_GDA_LDA                                                            
If Bitand(CVTOSLV2,'01'x) = '01'x then do    /* OS/390 R10 and above */         
  SCCBSAI  = C2d(Storage(D2x(SCCB + 10),1))  /* real stor incr. in M */         
  If SCCBSAI =  0 then do                    /* If 0, use SCCBSAIX   */         
    SCCBSAIX = C2d(Storage(D2x(SCCB + 100),4)) /* real stor incr in M*/         
    SCCBSAI  = SCCBSAIX                      /* using SCCBSAI later  */         
  End                                                                           
  SCCBSAR  = C2d(Storage(D2x(SCCB + 8),2))   /* # of. incr installed */         
End                                                                             
Queue 'The real storage size at IPL time was 'Format(CVTRLSTG,,0)'M.'           
If zARCH <> 2 then do       /* not valid in 64-bit */                           
  Queue 'The potential real storage size is' ,                                  
         Format(CVTEORM,,0)'M.'                                                 
  If ESTOR > 0 then                                                             
    Queue 'The expanded storage size is 'ESTOR'M.'                              
  Else                                                                          
    Queue 'The system has no expanded storage.'                                 
End                                                                             
If SCCBSAI <> 0 then ,                                                          
  Queue 'The real storage increment size is 'SCCBSAI'M with' ,                  
         SCCBSAR 'increments installed.'                                        
Queue 'The private area size <16M is 'GDAPVTSZ'K.'                              
Queue 'The private area size >16M is 'GDAEPVTS'M.'                              
Queue 'The CSA size <16M is 'GDACSASZ'K.'                                       
Queue 'The CSA size >16M is 'GDAECSAS'K.'                                       
Queue 'The SQA size <16M is 'GDASQASZ'K.'                                       
Queue 'The SQA size >16M is 'GDAESQAS'K.'                                       
Queue 'The maximum V=R region size is 'GDAVRSZ'K.'                              
Queue 'The default V=R region size is 'GDAVREGS'K.'                             
Queue 'The maximum V=V region size is 'LDASIZEA'K.'                             
Return                                                                          
                                                                                
CPU:                 /* CPU information sub-routine                  */         
Queue ' '                                                                       
If Bitand(CVTOSLV3,'01'x) = '01'x then ,  /* z/OS 1.6 & above >16 CPs*/         
  NUMCPU   = C2d(Storage(D2x(CSD + 212),4))  /* point to # of CPUS   */         
Else,                                                                           
  NUMCPU   = C2d(Storage(D2x(CSD + 10),2))   /* point to # of CPUS   */         
SCCBNCPS = C2d(Storage(d2x(SCCB + 16),2))    /* Max No. of CPUs      */         
/*                                                                   */         
Queue 'The CPU model number is 'MODEL'.'                                        
Queue 'The number of online CPUs is 'NUMCPU'.' ,                                
      'The maximum number of CPUs is 'SCCBNCPS'.'                               
If Bitand(CVTOSLV3,'20'x) = '20'x & ,        /* z/OS 1.1 and above   */         
   Bitand(CVTOSLV3,'01'x) <> '01'x then do   /* but below z/OS 1.6   */         
  CSDICPUS = C2d(Storage(D2x(CSD+161),1))    /* CPUs online @ IPL    */         
  Queue '  The number of CPUs online at IPL time was 'CSDICPUS'.'               
End                                                                             
If Bitand(CVTOSLV3,'01'x) = '01'x then do    /* z/OS 1.6 and above   */         
  CSDICPUS = C2d(Storage(D2x(CSD+161),1))    /* CPUs online @ IPL    */         
  CSDIIFAS = C2d(Storage(D2x(CSD+162),1))    /* zAAPs online @ IPL   */         
  Queue '  The number of GPs online at IPL time was 'CSDICPUS'.'                
  If CSDIIFAS <> 0 then ,                                                       
  Queue '  The number of zAAPs online at IPL time was 'CSDIIFAS'.'              
  If Bitand(CVTOSLV4,'02'x) = '02'x then do /* zIIP (SUP) support    */         
    CSDISUPS = C2d(Storage(D2x(CSD+163),1))  /* zIIPs online @ IPL   */         
    If CSDISUPS <> 0 then ,                                                     
    Queue '  The number of zIIPs online at IPL time was 'CSDISUPS'.'            
  End                                                                           
End                                                                             
/*                                                                   */         
CPNUM     = 0                                                                   
FOUNDCPUS = 0                                                                   
FOUNDZAPS = 0                                                                   
FOUNDZIPS = 0                                                                   
Do until FOUNDCPUS = NUMCPU                                                     
PCCA = C2d(Storage(D2x(PCCAVT + CPNUM*4),4)) /* point to PCCA        */         
  If PCCA <> 0 then do                                                          
    CPUVER   = Storage(D2x(PCCA + 4),2)      /* point to VERSION     */         
    CPUID    = Storage(D2x(PCCA + 6),10)     /* point to CPUID       */         
    IDSHORT  = Substr(CPUID,2,5)                                                
    PCCAATTR = Storage(D2x(PCCA + 376),1)    /* attribute byte       */         
    PCCARCFF = Storage(D2x(PCCA + 379),1)    /* reconfig flag        */         
    CP_TYP   = ''                            /* init to null for now */         
    If Bitand(PCCAATTR,'01'x) = '01'x then do  /* check PCCAIFA      */         
       CP_TYP = '(zAAP)'                       /* zAAP / IFA CP      */         
       FOUNDZAPS = FOUNDZAPS + 1                                                
    End                                                                         
    If Bitand(PCCAATTR,'04'x) = '04'x then do  /* check PCCAzIIP     */         
       CP_TYP = '(zIIP)'                       /* zIIP processor     */         
       FOUNDZIPS = FOUNDZIPS + 1                                                
    End                                                                         
    If Bitand(PCCARCFF,'80'x) = '80'x then ,   /* check PCCACWLM     */         
       CP_TYP = '(WLM)'                        /* WLM controlled CP  */         
    CPNUM_M = D2x(CPNUM)                       /* display in hex     */         
    If Bitand(CVTOSLV3,'01'x) = '01'x then ,   /* z/OS 1.6 & above   */         
      CPNUM_M = Right(CPNUM_M,2,'0')           /* display as 2 digits*/         
    Queue 'The CPU serial number for CPU 'CPNUM_M' is ' || ,                    
     CPUID' ('IDSHORT'), version code' CPUVER'.' CP_TYP                         
    FOUNDCPUS = FOUNDCPUS + 1                                                   
  End                                                                           
CPNUM = CPNUM + 1                                                               
End  /* do until  */                                                            
/**************************************************/                            
/* SUs/SEC and MIPS calculations                  */                            
/* SYS1.NUCLEUS(IEAVNP10) CSECT IRARMCPU          */                            
/**************************************************/                            
RMCT     = C2d(Storage(D2x(CVT+604),4))      /* point to RMCT        */         
SU       = C2d(Storage(D2x(RMCT+64),4))      /* CPU Rate Adjustment  */         
SUSEC    = Format((16000000/SU),7,2)         /* SUs per second       */         
MIPSCP   = NUMCPU-FOUNDZAPS-FOUNDZIPS        /* Don't include special*/         
                                             /* processors for MIPs  */         
MIPS     = Format((SUSEC/48.5) * MIPSCP,6,2) /* SRM MIPS calculation */         
Queue 'The service units per second per online CPU is' Strip(SUSEC)'.'          
Queue 'The approximate total MIPS (SUs/SEC / 48.5 * # general CPUs)' ,          
      'is' Strip(MIPS)'.'                                                       
If Bitand(CVTOSLV3,'20'x) = '20'x then do    /* z/OS 1.1 and above   */         
                                             /* w/APAR OW55509       */         
  RCT      = C2d(Storage(D2x(RMCT+228),4))   /* Resource Control Tbl */         
  RCTLACS  = C2d(Storage(D2x(RCT+196),4))    /* 4 hr MSU average     */         
  RCTIMGWU = C2d(Storage(D2x(RCT+28),4))     /* Image defined MSUs   */         
  RCTCECWU = C2d(Storage(D2x(RCT+32),4))     /* CEC MSU Capacity     */         
  If RCTCECWU <> 0 then do                                                      
    Queue 'The MSU capacity for this CEC is' RCTCECWU'.'                        
    Queue 'The defined MSU capacity for this LPAR is' RCTIMGWU'.'               
  End                                                                           
  If RCTLACS <> 0 then do                                                       
    Queue 'The 4 hour MSU average usage is' RCTLACS'.'                          
    If RCTLACS >= RCTIMGWU & RCTIMGWU <> RCTCECWU then ,                        
      Queue ' ** This LPAR is currently being "soft capped". **'                
  End                                                                           
End                                                                             
/**************************************************/                            
/* Central Processing Complex Node Descriptor     */                            
/**************************************************/                            
If Bitand(CVTOSLV1,'20'x) = '20'x then do      /* HBB5510 ESA V5 & > */         
  CVTHID   = C2d(Storage(D2x(CVT + 1068),4))   /* point to SHID      */         
  CPCND_FLAGS = Storage(D2x(CVTHID+22),1)      /* pnt to CPCND FLAGS */         
  If CPCND_FLAGS <> 0 then do                  /* Is there a CPC?    */         
    CPCND_VALID = Bitand(CPCND_FLAGS,'E0'x)    /* Valid flags        */         
    CPCND_INVALID = Bitand('40'x)              /* Invalid flag       */         
    If CPCND_VALID <> CPCND_INVALID then do    /* Is it valid?       */         
      CPCND_TYPE  = Storage(D2x(CVTHID+26),6)  /* Type               */         
      CPCND_MODEL = Storage(D2x(CVTHID+32),3)  /* Model              */         
      CPCND_MAN   = Storage(D2x(CVTHID+35),3)  /* Manufacturer       */         
      CPCND_PLANT = Storage(D2x(CVTHID+38),2)  /* Plant of manufact. */         
      CPCND_SEQNO = Storage(D2x(CVTHID+40),12) /* Sequence number    */         
      CPC_ID      = C2x(Storage(D2x(CVTHID+55),1))  /* CPC ID        */         
      Queue ' '                                                                 
      Queue 'Central Processing Complex (CPC) Node Descriptor:'                 
      Queue '  CPC ND =',                                                       
       CPCND_TYPE'.'CPCND_MODEL'.'CPCND_MAN'.'CPCND_PLANT'.'CPCND_SEQNO         
      Queue '  CPC ID =' CPC_ID                                                 
      Queue '  Type('CPCND_TYPE') Model('CPCND_MODEL')',                        
            'Manufacturer('CPCND_MAN') Plant('CPCND_PLANT')',                   
            'Seq Num('CPCND_SEQNO')'                                            
    End /* if CPCND_VALID <> CPCND_INVALID */                                   
  End  /* if CPCND_FLAGS <>0  */                                                
  If Bitand(CVTOSLV3,'20'x) = '20'x then do    /* z/OS 1.1 and above */         
    RMCTX1M  = Storage(D2x(RMCT+500),4)        /* Microcode address  */         
                                               /* in RMCTX1          */         
    If RMCTX1M  <> '7FFFF000'x then do         /* skip VM, FLEX/ES   */         
      RMCTX1M  = C2d(RMCTX1M)                  /* change to dec.     */         
      MCL      = Storage(D2x(RMCTX1M + 40),8)  /* Microcode level    */         
      MCLDRV   = Format(Substr(MCL,1,4))       /* Driver only...     */         
      Queue ' '                                                                 
      Queue 'The Microcode level of this CPC is' MCL || ,                       
            ' (Driver' MCLDRV').'                                               
    End /* If RMCTX1M  <> '7FFFF000'x */                                        
  End /* If Bitand(CVTOSLV2, ... */                                             
End                                                                             
Return                                                                          
                                                                                
IPA:                 /* IPA information sub-routine                  */         
Queue ' '                                                                       
/*********************************************************************/         
/* IPL parms from the IPA                                            */         
/*********************************************************************/         
If Bitand(CVTOSLV1,'01'x) = '01'x then do    /* OS/390 R2 and above  */         
  IPALPARM = Storage(D2x(ECVTIPA + 16),8)    /* point to LOAD PARM   */         
  IPALPDSN = Storage(D2x(ECVTIPA + 48),44)   /* load parm dsn name   */         
  IPALPDDV = Storage(D2x(ECVTIPA + 92),4)    /* load parm dev number */         
  IPAHWNAM = Storage(D2x(ECVTIPA + 24),8)    /* point to HWNAME      */         
  IPAHWNAM = Strip(IPAHWNAM,'T')             /* del trailing blanks  */         
  IPALPNAM = Storage(D2x(ECVTIPA + 32),8)    /* point to LPARNAME    */         
  IPALPNAM = Strip(IPALPNAM,'T')             /* del trailing blanks  */         
  IPAVMNAM = Storage(D2x(ECVTIPA + 40),8)    /* point to VMUSERID    */         
  /**************************/                                                  
  /* PARMS in LOADxx        */                                                  
  /**************************/                                                  
  IPANUCID = Storage(D2x(ECVTIPA + 23),1)    /* NUCLEUS ID           */         
  IPAIODF  = Storage(D2x(ECVTIPA + 96),63)   /* IODF    card image   */         
  IPASPARM = Storage(D2x(ECVTIPA + 160),63)  /* SYSPARM card image   */         
  /*IPASCAT= Storage(D2x(ECVTIPA + 224),63)*//* SYSCAT  card image   */         
  IPASYM   = Storage(D2x(ECVTIPA + 288),63)  /* IEASYM  card image   */         
  IPAPLEX  = Storage(D2x(ECVTIPA + 352),63)  /* SYSPLEX card image   */         
  IPAPLNUM = Storage(D2x(ECVTIPA + 2148),2)  /* number of parmlibs   */         
  IPAPLNUM = C2d(IPAPLNUM)                   /* convert to decimal   */         
  POFF = 0                                                                      
  Do P = 1 to IPAPLNUM                                                          
    IPAPLIB.P = Storage(D2x(ECVTIPA+416+POFF),63) /* PARMLIB cards   */         
    IPAPLFLG.P = Storage(D2x(ECVTIPA+479+POFF),1)  /* flag bits      */         
    If Bitand(IPAPLFLG.P,'20'x) = '20'x then ,   /* volser from cat? */         
      IPAPLIB.P = Overlay('      ',IPAPLIB.P,46) /* no, clear it     */         
    POFF = POFF + 64                                                            
  End                                                                           
  IPANLID  = Storage(D2x(ECVTIPA + 2144),2)  /* NUCLSTxx member used */         
  IPANUCW  = Storage(D2x(ECVTIPA + 2146),1)  /* load wait state char */         
  Queue 'Initialization information from the IPA:'                              
  Queue '  IPLPARM =' IPALPARM   '(merged)'                                     
  Queue '  IPL load parameter data set name: 'IPALPDSN                          
  Queue '  IPL load parameter data set device address: 'IPALPDDV                
  Queue '  HWNAME='IPAHWNAM '  LPARNAME='IPALPNAM ,                             
        '  VMUSERID='IPAVMNAM                                                   
  Queue '  '                    /* add blank line for readability   */          
  Queue '  LOADxx parameters from the IPA' ,                                    
        '(LOAD' || Substr(IPALPARM,5,2) || '):'                                 
  Queue '    *---+----1----+----2----+----3----+----4' || ,                     
            '----+----5----+----6----+----7'                                    
  If Bitand(CVTOSLV2,'01'x) = '01'x then do    /* OS/390 R10 & above */         
    IPAARCHL = Storage(D2x(ECVTIPA + 2143),1)  /* ARCHLVL (1 or 2)   */         
    Queue '    ARCHLVL  'IPAARCHL                                               
  End                                                                           
  If IPASYM   <> '' then queue '    IEASYM   'IPASYM                            
  If IPAIODF  <> '' then queue '    IODF     'IPAIODF                           
  If IPANUCID <> '' then queue '    NUCLEUS  'IPANUCID                          
  If IPANLID  <> '' then queue '    NUCLST   'IPANLID' 'IPANUCW                 
  Do P = 1 to IPAPLNUM                                                          
    Queue '    PARMLIB  'IPAPLIB.P                                              
  End                                                                           
  If IPASCAT  <> '' then queue '    SYSCAT   'IPASCAT                           
  If IPASPARM <> '' then queue '    SYSPARM  'IPASPARM                          
  If IPAPLEX  <> '' then queue '    SYSPLEX  'IPAPLEX                           
  /**************************/                                                  
  /* PARMS in IEASYSxx      */                                                  
  /**************************/                                                  
  Queue '  '                    /* add blank line for readability   */          
  Queue '  IEASYSxx parameters from the IPA:          ',                        
        '                     (Source)'                                         
  Call BUILD_IPAPDETB    /* Build table for init parms               */         
  TOTPRMS = 0            /* tot num of specified or defaulted parms  */         
  Do I = 1 to IPAPDETB.0                                                        
    Call EXTRACT_SYSPARMS IPAPDETB.I   /* extract parms from the IPA */         
  End                                                                           
 /********************************************************************/         
 /* Uncommment a sample below to test IPA PAGE parm "split" code:    */         
 /*  PRMLINE.32 = 'SWAP SWAP=(SYS1.SWAP.TEST) IEASYSXX'              */         
 /*  PRMLINE.32 = 'NONVIO NONVIO=(SYS1.PAGE.TEST) IEASYSXX'          */         
 /*  PRMLINE.32 = 'NONVIO NONVIO=(SYS1.PAGE1,SYS1.PAGE2) IEASYSXX'   */         
 /*  PRMLINE.32 = 'NONVIO ' || ,                                     */         
 /*  'NONVIO=(SYS1.PAGE1,SYS1.PAGE2,SYS1.PAGE3,SYS1.PAGE4) IEASYSXX' */         
 /********************************************************************/         
  Call SORT_IPA                       /* sort IPA parms              */         
  Call SPLIT_IPA_PAGE                 /* split page/swap dsn parms   */         
  Do I = 1 to TOT_IPALINES            /* add ipa parms               */         
    If I = TOT_IPALINES then ,        /*   to stack and              */         
      IPALINE.I = Translate(IPALINE.I,' ',',') /* remove comma       */         
    Queue IPALINE.I                   /*           from last parm    */         
  End                                                                           
End                                                                             
Return                                                                          
                                                                                
SYMBOLS:             /* System Symbols information sub-routine       */         
Queue ' '                                                                       
/*********************************************************************/         
/* Find System Symbols  - ASASYMBP MACRO                             */         
/*  ECVT+X'128' = ECVTSYMT                                           */         
/*  2nd half word = # of symbols , after that each entry is 4 words  */         
/*  1st word = offset to symbol name                                 */         
/*  2nd word = length of symbol name                                 */         
/*  3rd word = offset to symbol value                                */         
/*  4th word = length of symbol value                                */         
/*********************************************************************/         
If Bitand(CVTOSLV1,'10'x) = '10'x then do    /* HBB5520 ESA V5.2 & > */         
  ECVTSYMT = C2d(Storage(D2x(ECVT + 296),4)) /* point to ECVTSYMT    */         
  NUMSYMBS = C2d(Storage(D2x(ECVTSYMT + 2),2))  /* number of symbols */         
  Queue 'Static System Symbol Values:'                                          
  Do I = 1 to NUMSYMBS                                                          
    SOFF = I*16-16                                                              
    NAMOFF  = C2d(Storage(D2x(ECVTSYMT+4+SOFF),4))  /*offset to name */         
    NAMLEN  = C2d(Storage(D2x(ECVTSYMT+8+SOFF),4))  /*length of name */         
    VALOFF  = C2d(Storage(D2x(ECVTSYMT+12+SOFF),4)) /*offset to value*/         
    VALLEN  = C2d(Storage(D2x(ECVTSYMT+16+SOFF),4)) /*length of value*/         
    SYMNAME = Storage(D2x(ECVTSYMT+4+NAMOFF),NAMLEN) /*symbol name   */         
    If VALLEN = 0 then VALNAME = ''                 /* null value    */         
    Else ,                                                                      
    VALNAME = Storage(D2x(ECVTSYMT+4+VALOFF),VALLEN) /* symbol value */         
    Queue ' ' Left(SYMNAME,10,' ') '=' VALNAME                                  
  End  /* do NUMSYMBS */                                                        
End                                                                             
Return                                                                          
                                                                                
VMAP:                /* Virtual Storage Map sub-routine              */         
Queue ' '                                                                       
If option <> 'ALL' then,                                                        
  Call STORAGE_GDA_LDA                       /* GDA/LDA stor routine */         
SYSEND  = X2d(LDASTRTS) + (LDASIZS*1024) - 1 /* end of system area   */         
SYSEND  = D2x(SYSEND)                        /* display in hex       */         
If GDAVRSZ = 0 then do                       /* no v=r               */         
  VRSTRT = 'N/A     '                                                           
  VREND  = 'N/A     '                                                           
  VVSTRT = LDASTRTA                          /* start of v=v         */         
  VVEND  =  X2d(LDASTRTA) + (LDASIZEA*1024) - 1 /* end of v=v        */         
  VVEND  =  D2x(VVEND)                       /* display in hex       */         
End                                                                             
Else do                                                                         
  VRSTRT =  LDASTRTA                         /* start of v=r         */         
  VREND  =  X2d(LDASTRTA) + (GDAVRSZ*1024) - 1 /* end of v=r         */         
  VREND  =  D2X(VREND)                       /* display in hex       */         
  VVSTRT =  LDASTRTA                         /* start of v=v         */         
  VVEND  =  X2d(LDASTRTA) + (LDASIZEA*1024) - 1 /* end of v=v        */         
  VVEND  =  D2x(VVEND)                       /* display in hex       */         
End                                                                             
GDACSA   = C2d(Storage(D2x(CVTGDA + 108),4)) /* start of CSA addr    */         
GDACSAH  = D2x(GDACSA)                       /* display in hex       */         
CSAEND   = (GDACSASZ*1024) + GDACSA - 1      /* end of CSA           */         
CSAEND   = D2x(CSAEND)                       /* display in hex       */         
CVTSMEXT = C2d(Storage(D2x(CVT +1196),4))    /* point to stg map ext.*/         
CVTMLPAS = C2d(Storage(D2x(CVTSMEXT+ 8),4))  /* start of MLPA addr   */         
CVTMLPAS = D2x(CVTMLPAS)                     /* display in hex       */         
If CVTMLPAS <> 0 then do                                                        
  CVTMLPAE = C2d(Storage(D2x(CVTSMEXT+12),4))  /* end of MLPA addr   */         
  CVTMLPAE = D2x(CVTMLPAE)                     /* display in hex     */         
  MLPASZ   = X2d(CVTMLPAE) - X2d(CVTMLPAS) + 1 /* size of MLPA       */         
  MLPASZ   = MLPASZ/1024                       /* convert to Kbytes  */         
End                                                                             
Else do /* no MLPA */                                                           
  CVTMLPAS = 'N/A     '                                                         
  CVTMLPAE = 'N/A     '                                                         
  MLPASZ   = 0                                                                  
End                                                                             
CVTFLPAS = C2d(Storage(D2x(CVTSMEXT+16),4))  /* start of FLPA addr   */         
CVTFLPAS = D2x(CVTFLPAS)                     /* display in hex       */         
If CVTFLPAS <> 0 then do                                                        
  CVTFLPAE = C2d(Storage(D2x(CVTSMEXT+20),4))  /* end of FLPA addr   */         
  CVTFLPAE = D2x(CVTFLPAE)                     /* display in hex     */         
  FLPASZ   = X2d(CVTFLPAE) - X2d(CVTFLPAS) + 1 /* size of FLPA       */         
  FLPASZ   = FLPASZ/1024                       /* convert to Kbytes  */         
End                                                                             
Else do /* no FLPA */                                                           
  CVTFLPAS = 'N/A     '                                                         
  CVTFLPAE = 'N/A     '                                                         
  FLPASZ   = 0                                                                  
End                                                                             
CVTPLPAS = C2d(Storage(D2x(CVTSMEXT+24),4))  /* start of PLPA addr   */         
CVTPLPAS = D2x(CVTPLPAS)                     /* display in hex       */         
CVTPLPAE = C2d(Storage(D2x(CVTSMEXT+28),4))  /* end of PLPA addr     */         
CVTPLPAE = D2x(CVTPLPAE)                     /* display in hex       */         
PLPASZ   = X2d(CVTPLPAE) - X2d(CVTPLPAS) + 1 /* size of PLPA         */         
PLPASZ   = PLPASZ/1024                       /* convert to Kbytes    */         
GDASQA   = C2d(Storage(D2x(CVTGDA + 144),4)) /* start of SQA addr    */         
GDASQAH  = D2x(GDASQA)                       /* display in hex       */         
SQAEND   = (GDASQASZ*1024) + GDASQA - 1      /* end of SQA           */         
SQAEND   = D2x(SQAEND)                       /* display in hex       */         
CVTRWNS  = C2d(Storage(D2x(CVTSMEXT+32),4))  /* start of R/W nucleus */         
CVTRWNS  = D2x(CVTRWNS)                      /* display in hex       */         
CVTRWNE  = C2d(Storage(D2x(CVTSMEXT+36),4))  /* end of R/W nucleus   */         
CVTRWNE  = D2x(CVTRWNE)                      /* display in hex       */         
RWNUCSZ  = X2d(CVTRWNE)  - X2d(CVTRWNS)  + 1 /* size of R/W nucleus  */         
RWNUCSZ  = Format(RWNUCSZ/1024,,0)           /* convert to Kbytes    */         
CVTRONS  = C2d(Storage(D2x(CVTSMEXT+40),4))  /* start of R/O nucleus */         
CVTRONS  = D2x(CVTRONS)                      /* display in hex       */         
CVTRONE  = C2d(Storage(D2x(CVTSMEXT+44),4))  /* end of R/O nucleus   */         
CVTRONE  = D2x(CVTRONE)                      /* display in hex       */         
RONUCSZ  = X2d(CVTRONE)  - X2d(CVTRONS)  + 1 /* size of R/O nucleus  */         
RONUCSZ  = Format(RONUCSZ/1024,,0)           /* convert to Kbytes    */         
RONUCSZB = X2d('FFFFFF') - X2d(CVTRONS) + 1  /* size of R/O nuc <16M */         
RONUCSZB = Format(RONUCSZB/1024,,0)          /* convert to Kbytes    */         
RONUCSZA = X2d(CVTRONE) - X2d('1000000') + 1 /* size of R/O nuc >16M */         
RONUCSZA = Format(RONUCSZA/1024,,0)          /* convert to Kbytes    */         
CVTERWNS = C2d(Storage(D2x(CVTSMEXT+48),4))  /* start of E-R/W nuc   */         
CVTERWNS = D2x(CVTERWNS)                     /* display in hex       */         
CVTERWNE = C2d(Storage(D2x(CVTSMEXT+52),4))  /* end of E-R/W nuc     */         
CVTERWNE = D2x(CVTERWNE)                     /* display in hex       */         
ERWNUCSZ = X2d(CVTERWNE) - X2d(CVTERWNS) + 1 /* size of E-R/W nuc    */         
ERWNUCSZ = ERWNUCSZ/1024                     /* convert to Kbytes    */         
GDAESQA  = C2d(Storage(D2x(CVTGDA + 152),4)) /* start of ESQA addr   */         
GDAESQAH = D2x(GDAESQA)                      /* display in hex       */         
ESQAEND  = (GDAESQAS*1024) + GDAESQA - 1     /* end of ESQA          */         
ESQAEND  = D2x(ESQAEND)                      /* display in hex       */         
CVTEPLPS = C2d(Storage(D2x(CVTSMEXT+56),4))  /* start of EPLPA addr  */         
CVTEPLPS = D2x(CVTEPLPS)                     /* display in hex       */         
CVTEPLPE = C2d(Storage(D2x(CVTSMEXT+60),4))  /* end of EPLPA addr    */         
CVTEPLPE = D2x(CVTEPLPE)                     /* display in hex       */         
EPLPASZ  = X2d(CVTEPLPE) - X2d(CVTEPLPS) + 1 /* size of EPLPA        */         
EPLPASZ  = EPLPASZ/1024                      /* convert to Kbytes    */         
CVTEFLPS = C2d(Storage(D2x(CVTSMEXT+64),4))  /* start of EFLPA addr  */         
CVTEFLPS = D2x(CVTEFLPS)                     /* display in hex       */         
If CVTEFLPS <> 0 then do                                                        
  CVTEFLPE = C2d(Storage(D2x(CVTSMEXT+68),4))  /* end of EFLPA addr  */         
  CVTEFLPE = D2x(CVTEFLPE)                     /* display in hex     */         
  EFLPASZ  = X2d(CVTEFLPE) - X2d(CVTEFLPS) + 1 /* size of EFLPA      */         
  EFLPASZ  = EFLPASZ/1024                      /* convert to Kbytes  */         
End                                                                             
Else do /* no EFLPA */                                                          
  CVTEFLPS = 'N/A     '                                                         
  CVTEFLPE = 'N/A     '                                                         
  EFLPASZ  = 0                                                                  
End                                                                             
CVTEMLPS = C2d(Storage(D2x(CVTSMEXT+72),4))  /* start of EMLPA addr  */         
CVTEMLPS = D2x(CVTEMLPS)                     /* display in hex       */         
If CVTEMLPS <> 0 then do                                                        
  CVTEMLPE = C2d(Storage(D2x(CVTSMEXT+76),4))  /* end of EMLPA addr  */         
  CVTEMLPE = D2x(CVTEMLPE)                     /* display in hex     */         
  EMLPASZ  = X2d(CVTEMLPE) - X2d(CVTEMLPS) + 1 /* size of EMLPA      */         
  EMLPASZ  = EMLPASZ/1024                      /* convert to Kbytes  */         
End                                                                             
Else do /* no EMLPA */                                                          
  CVTEMLPS = 'N/A     '                                                         
  CVTEMLPE = 'N/A     '                                                         
  EMLPASZ  = 0                                                                  
End                                                                             
GDAECSA  = C2d(Storage(D2x(CVTGDA + 124),4)) /* start of ECSA addr   */         
GDAECSAH = D2x(GDAECSA)                      /* display in hex       */         
ECSAEND  = (GDAECSAS*1024) + GDAECSA - 1     /* end of ECSA          */         
ECSAEND  = D2x(ECSAEND)                      /* display in hex       */         
GDAEPVT  = C2d(Storage(D2x(CVTGDA + 168),4)) /* start of EPVT addr   */         
GDAEPVTH = D2x(GDAEPVT)                      /* display in hex       */         
EPVTEND  = (GDAEPVTS*1024*1024) + GDAEPVT - 1 /* end of EPVT         */         
EPVTEND  = D2x(EPVTEND)                      /* display in hex       */         
Queue 'Virtual Storage Map:'                                                    
Queue '          '                                                              
If VMAP = 'HIGHFIRST' then do                                                   
If Bitand(CVTOSLV2,'01'x) = '01'x then ,     /* OS/390 R10 and above */         
 Queue '     Storage Area     Start      End           Size' ,                  
       '     Used     Conv      HWM'                                            
Else ,                                                                          
 Queue '     Storage Area     Start      End           Size' ,                  
       '     Used     Conv'                                                     
Queue '          '                                                              
Queue '     Ext. Private    '     Right(GDAEPVTH,8,'0') ' ' ,                   
   Right(EPVTEND,8,'0')           Right(GDAEPVTS,8,' ')'M'                      
If Bitand(CVTOSLV2,'01'x) = '01'x then ,     /* OS/390 R10 and above */         
Queue '         Ext. CSA    '     Right(GDAECSAH,8,'0') ' ' ,                   
   Right(ECSAEND,8,'0')           Right(GDAECSAS,8,' ')'K' ,                    
   Right(GDA_ECSA_ALLOC,8,' ')'K         ' ,                                    
   Right(GDAECSAHWM,7,' ')'K'                                                   
Else ,                                                                          
Queue '         Ext. CSA    '     Right(GDAECSAH,8,'0') ' ' ,                   
   Right(ECSAEND,8,'0')           Right(GDAECSAS,8,' ')'K' ,                    
   Right(GDA_ECSA_ALLOC,8,' ')'K'                                               
Queue '        Ext. MLPA    '     Right(CVTEMLPS,8,'0') ' ' ,                   
   Right(CVTEMLPE,8,'0')          Right(EMLPASZ,8,' ')'K'                       
Queue '        Ext. FLPA    '     Right(CVTEFLPS,8,'0') ' ' ,                   
   Right(CVTEFLPE,8,'0')          Right(EFLPASZ,8,' ')'K'                       
Queue '        Ext. PLPA    '     Right(CVTEPLPS,8,'0') ' ' ,                   
   Right(CVTEPLPE,8,'0')          Right(EPLPASZ,8,' ')'K'                       
If Bitand(CVTOSLV2,'01'x) = '01'x then ,     /* OS/390 R10 and above */         
Queue '         Ext. SQA    '     Right(GDAESQAH,8,'0') ' ' ,                   
   Right(ESQAEND,8,'0')           Right(GDAESQAS,8,' ')'K' ,                    
   Right(GDA_ESQA_ALLOC,8,' ')'K' Right(GDA_ECSA_CONV,7,' ')'K',                
   Right(GDAESQAHWM,7,' ')'K'                                                   
Else ,                                                                          
Queue '         Ext. SQA    '     Right(GDAESQAH,8,'0') ' ' ,                   
   Right(ESQAEND,8,'0')           Right(GDAESQAS,8,' ')'K' ,                    
   Right(GDA_ESQA_ALLOC,8,' ')'K' Right(GDA_ECSA_CONV,7,' ')'K'                 
Queue ' Ext. R/W Nucleus    '     Right(CVTERWNS,8,'0') ' ' ,                   
   Right(CVTERWNE,8,'0')          Right(ERWNUCSZ,8,' ')'K'                      
Queue ' Ext. R/O Nucleus    '     Right('1000000',8,'0') ' ' ,                  
   Right(CVTRONE,8,'0')           Right(RONUCSZA,8,' ')'K' ,                    
   '(Total' RONUCSZ'K)'                                                         
Queue '             16M line -----------------------------'                     
Queue '      R/O Nucleus    '     Right(CVTRONS,8,'0') ' ' ,                    
   Right('FFFFFF',8,'0')          Right(RONUCSZB,8,' ')'K',                     
   '(Spans 16M line)'                                                           
Queue '      R/W Nucleus    '     Right(CVTRWNS,8,'0') ' ' ,                    
   Right(CVTRWNE,8,'0')           Right(RWNUCSZ,8,' ')'K'                       
If Bitand(CVTOSLV2,'01'x) = '01'x then ,     /* OS/390 R10 and above */         
Queue '              SQA    '     Right(GDASQAH,8,'0') ' ' ,                    
   Right(SQAEND,8,'0')            Right(GDASQASZ,8,' ')'K' ,                    
   Right(GDA_SQA_ALLOC,8,' ')'K'  Right(GDA_CSA_CONV,7,' ')'K' ,                
   Right(GDASQAHWM,7,' ')'K'                                                    
Else ,                                                                          
Queue '              SQA    '     Right(GDASQAH,8,'0') ' ' ,                    
   Right(SQAEND,8,'0')            Right(GDASQASZ,8,' ')'K' ,                    
   Right(GDA_SQA_ALLOC,8,' ')'K'  Right(GDA_CSA_CONV,7,' ')'K'                  
Queue '             PLPA    '     Right(CVTPLPAS,8,'0') ' ' ,                   
   Right(CVTPLPAE,8,'0')          Right(PLPASZ,8,' ')'K'                        
Queue '             FLPA    '     Right(CVTFLPAS,8,'0') ' ' ,                   
   Right(CVTFLPAE,8,'0')          Right(FLPASZ,8,' ')'K'                        
Queue '             MLPA    '     Right(CVTMLPAS,8,'0') ' ' ,                   
   Right(CVTMLPAE,8,'0')          Right(MLPASZ,8,' ')'K'                        
If Bitand(CVTOSLV2,'01'x) = '01'x then ,     /* OS/390 R10 and above */         
Queue '              CSA    '     Right(GDACSAH,8,'0') ' ' ,                    
   Right(CSAEND,8,'0')            Right(GDACSASZ,8,' ')'K' ,                    
   Right(GDA_CSA_ALLOC,8,' ')'K         ' ,                                     
   Right(GDACSAHWM,7,' ')'K'                                                    
Else ,                                                                          
Queue '              CSA    '     Right(GDACSAH,8,'0') ' ' ,                    
   Right(CSAEND,8,'0')            Right(GDACSASZ,8,' ')'K' ,                    
   Right(GDA_CSA_ALLOC,8,' ')'K'                                                
Queue '      Private V=V    '     Right(VVSTRT,8,'0') ' ' ,                     
   Right(VVEND,8,'0')             Right(LDASIZEA,8,' ')'K'                      
Queue '      Private V=R    '     Right(VRSTRT,8,'0') ' ' ,                     
   Right(VREND,8,'0')             Right(GDAVRSZ,8,' ')'K'                       
Queue '           System    '     Right(LDASTRTS,8,'0') ' ' ,                   
   Right(SYSEND,8,'0')            Right(LDASIZS,8,' ')'K'                       
If zARCH = 2 then ,                                                             
  Queue '              PSA     00000000   00001FFF        8K'                   
Else ,                                                                          
  Queue '              PSA     00000000   00000FFF        4K'                   
End  /* if VMAP = 'HIGHFIRST'  */                                               
Else do  /* VMAP <> 'HIGHFIRST'  */                                             
If Bitand(CVTOSLV2,'01'x) = '01'x then ,     /* OS/390 R10 and above */         
 Queue '     Storage Area     Start      End           Size' ,                  
       '     Used     Conv      HWM'                                            
Else ,                                                                          
 Queue '     Storage Area     Start      End           Size' ,                  
       '     Used     Conv'                                                     
Queue '          '                                                              
If zARCH = 2 then ,                                                             
  Queue '              PSA     00000000   00001FFF        8K'                   
Else ,                                                                          
  Queue '              PSA     00000000   00000FFF        4K'                   
Queue '           System    '     Right(LDASTRTS,8,'0') ' ' ,                   
   Right(SYSEND,8,'0')            Right(LDASIZS,8,' ')'K'                       
Queue '      Private V=R    '     Right(VRSTRT,8,'0') ' ' ,                     
   Right(VREND,8,'0')             Right(GDAVRSZ,8,' ')'K'                       
Queue '      Private V=V    '     Right(VVSTRT,8,'0') ' ' ,                     
   Right(VVEND,8,'0')             Right(LDASIZEA,8,' ')'K'                      
If Bitand(CVTOSLV2,'01'x) = '01'x then ,     /* OS/390 R10 and above */         
Queue '              CSA    '     Right(GDACSAH,8,'0') ' ' ,                    
   Right(CSAEND,8,'0')            Right(GDACSASZ,8,' ')'K' ,                    
   Right(GDA_CSA_ALLOC,8,' ')'K         ' ,                                     
   Right(GDACSAHWM,7,' ')'K'                                                    
Else ,                                                                          
Queue '              CSA    '     Right(GDACSAH,8,'0') ' ' ,                    
   Right(CSAEND,8,'0')            Right(GDACSASZ,8,' ')'K' ,                    
   Right(GDA_CSA_ALLOC,8,' ')'K'                                                
Queue '             MLPA    '     Right(CVTMLPAS,8,'0') ' ' ,                   
   Right(CVTMLPAE,8,'0')          Right(MLPASZ,8,' ')'K'                        
Queue '             FLPA    '     Right(CVTFLPAS,8,'0') ' ' ,                   
   Right(CVTFLPAE,8,'0')          Right(FLPASZ,8,' ')'K'                        
Queue '             PLPA    '     Right(CVTPLPAS,8,'0') ' ' ,                   
   Right(CVTPLPAE,8,'0')          Right(PLPASZ,8,' ')'K'                        
If Bitand(CVTOSLV2,'01'x) = '01'x then ,     /* OS/390 R10 and above */         
Queue '              SQA    '     Right(GDASQAH,8,'0') ' ' ,                    
   Right(SQAEND,8,'0')            Right(GDASQASZ,8,' ')'K' ,                    
   Right(GDA_SQA_ALLOC,8,' ')'K'  Right(GDA_CSA_CONV,7,' ')'K' ,                
   Right(GDASQAHWM,7,' ')'K'                                                    
Else ,                                                                          
Queue '              SQA    '     Right(GDASQAH,8,'0') ' ' ,                    
   Right(SQAEND,8,'0')            Right(GDASQASZ,8,' ')'K' ,                    
   Right(GDA_SQA_ALLOC,8,' ')'K'  Right(GDA_CSA_CONV,7,' ')'K'                  
Queue '      R/W Nucleus    '     Right(CVTRWNS,8,'0') ' ' ,                    
   Right(CVTRWNE,8,'0')           Right(RWNUCSZ,8,' ')'K'                       
Queue '      R/O Nucleus    '     Right(CVTRONS,8,'0') ' ' ,                    
   Right('FFFFFF',8,'0')          Right(RONUCSZB,8,' ')'K',                     
   '(Spans 16M line)'                                                           
Queue '             16M line -----------------------------'                     
Queue ' Ext. R/O Nucleus    '     Right('1000000',8,'0') ' ' ,                  
   Right(CVTRONE,8,'0')           Right(RONUCSZA,8,' ')'K' ,                    
   '(Total' RONUCSZ'K)'                                                         
Queue ' Ext. R/W Nucleus    '     Right(CVTERWNS,8,'0') ' ' ,                   
   Right(CVTERWNE,8,'0')          Right(ERWNUCSZ,8,' ')'K'                      
If Bitand(CVTOSLV2,'01'x) = '01'x then ,     /* OS/390 R10 and above */         
Queue '         Ext. SQA    '     Right(GDAESQAH,8,'0') ' ' ,                   
   Right(ESQAEND,8,'0')           Right(GDAESQAS,8,' ')'K' ,                    
   Right(GDA_ESQA_ALLOC,8,' ')'K' Right(GDA_ECSA_CONV,7,' ')'K',                
   Right(GDAESQAHWM,7,' ')'K'                                                   
Else ,                                                                          
Queue '         Ext. SQA    '     Right(GDAESQAH,8,'0') ' ' ,                   
   Right(ESQAEND,8,'0')           Right(GDAESQAS,8,' ')'K' ,                    
   Right(GDA_ESQA_ALLOC,8,' ')'K' Right(GDA_ECSA_CONV,7,' ')'K'                 
Queue '        Ext. PLPA    '     Right(CVTEPLPS,8,'0') ' ' ,                   
   Right(CVTEPLPE,8,'0')          Right(EPLPASZ,8,' ')'K'                       
Queue '        Ext. FLPA    '     Right(CVTEFLPS,8,'0') ' ' ,                   
   Right(CVTEFLPE,8,'0')          Right(EFLPASZ,8,' ')'K'                       
Queue '        Ext. MLPA    '     Right(CVTEMLPS,8,'0') ' ' ,                   
   Right(CVTEMLPE,8,'0')          Right(EMLPASZ,8,' ')'K'                       
If Bitand(CVTOSLV2,'01'x) = '01'x then ,     /* OS/390 R10 and above */         
Queue '         Ext. CSA    '     Right(GDAECSAH,8,'0') ' ' ,                   
   Right(ECSAEND,8,'0')           Right(GDAECSAS,8,' ')'K' ,                    
   Right(GDA_ECSA_ALLOC,8,' ')'K         ' ,                                    
   Right(GDAECSAHWM,7,' ')'K'                                                   
Else ,                                                                          
Queue '         Ext. CSA    '     Right(GDAECSAH,8,'0') ' ' ,                   
   Right(ECSAEND,8,'0')           Right(GDAECSAS,8,' ')'K' ,                    
   Right(GDA_ECSA_ALLOC,8,' ')'K'                                               
Queue '     Ext. Private    '     Right(GDAEPVTH,8,'0') ' ' ,                   
   Right(EPVTEND,8,'0')           Right(GDAEPVTS,8,' ')'M'                      
End  /* else do (VMAP <> 'HIGHFIRST')  */                                       
Return                                                                          
                                                                                
PAGE:                /* Page Data Sets information sub-routine       */         
Queue ' '                                                                       
Queue 'Page Data Set Usage:'                                                    
Queue '  Type     Full   Slots  Dev   Volser  Data Set Name'                    
CVT      = C2d(Storage(10,4))              /* point to CVT           */         
ASMVT    = C2d(Storage(D2x(CVT + 704),4))  /* point to ASMVT         */         
ASMPART  = C2d(Storage(D2x(ASMVT + 8),4))  /* Pnt to Pag Act Ref Tbl */         
PARTSIZE = C2d(Storage(D2x(ASMPART+4),4))  /* Tot number of entries  */         
PARTDSNL = C2d(Storage(D2x(ASMPART+24),4)) /* Point to 1st pg dsn    */         
PARTENTS = ASMPART+80                      /* Point to 1st parte     */         
Do I = 1 to PARTSIZE                                                            
  If I > 1 then do                                                              
    PARTENTS = PARTENTS + 96                                                    
    PARTDSNL = PARTDSNL + 44                                                    
  End                                                                           
  CHKINUSE = Storage(D2x(PARTENTS+9),1)    /* in use flag            */         
  If Bitand(CHKINUSE,'80'x) = '80'x then iterate /* not in use       */         
  PGDSN    = Storage(D2x(PARTDSNL),44)     /* page data set name     */         
  PGDSN    = Strip(PGDSN,'T')              /* remove trailing blanks */         
  PARETYPE = Storage(D2x(PARTENTS+8),1)    /* type flag              */         
  Select                                                                        
    When Bitand(PARETYPE,'80'x) = '80'x then PGTYPE = ' PLPA    '               
    When Bitand(PARETYPE,'40'x) = '40'x then PGTYPE = ' COMMON  '               
    When Bitand(PARETYPE,'20'x) = '20'x then PGTYPE = ' DUPLEX  '               
    When Bitand(PARETYPE,'10'x) = '10'x then PGTYPE = ' LOCAL   '               
    Otherwise PGTYPE = '??????'                                                 
  End  /* Select */                                                             
  If PGTYPE = ' LOCAL   ' then do                                               
    PAREFLG1  = Storage(D2x(PARTENTS+9),1)    /* PARTE flags         */         
    If Bitand(PAREFLG1,'10'x) = '10'x then PGTYPE = ' LOCAL NV'                 
  End                                                                           
  PAREUCBP = C2d(Storage(D2x(PARTENTS+44),4)) /* point to UCB        */         
  PGUCB    = C2x(Storage(D2x(PAREUCBP+4),2))  /* UCB address         */         
  PGVOL    = Storage(D2x(PAREUCBP+28),6)      /* UCB volser          */         
  PARESZSL = C2d(Storage(D2x(PARTENTS+16),4)) /* total slots         */         
  PARESZSL = Right(PARESZSL,7,' ')            /* ensure 7 digits     */         
  PARESLTA = C2d(Storage(D2x(PARTENTS+20),4)) /* avail. slots        */         
  PGFULL   = ((PARESZSL-PARESLTA) / PARESZSL) * 100 /* percent full  */         
  PGFULL   = Format(PGFULL,3,2)               /* force 2 decimals    */         
  PGFULL   = Left(PGFULL,3)                   /* keep intiger only   */         
  Queue  ' 'PGTYPE' 'PGFULL'% 'PARESZSL'  'PGUCB' ' ,                           
         PGVOL'  'PGDSN                                                         
End  /* do I=1 to partsize */                                                   
Return                                                                          
                                                                                
SMF:                 /* SMF Data Set information sub-routine         */         
Queue ' '                                                                       
Queue 'SMF Data Set Usage:'                                                     
Queue '  Name                      Volser   Size(Blks)  %Full  Status'          
SMCAMISC = Storage(D2x(SMCA + 1),1)          /* misc. indicators     */         
If bitand(SMCAMISC,'80'x) <> '80'x then do   /* smf active ??        */         
  Queue '  *** SMF SYS1.MAN RECORDING NOT BEING USED ***'                       
  Return                                                                        
End                                                                             
SMCAFRDS = C2d(Storage(D2x(SMCA + 244),4))   /* point to first RDS   */         
SMCALRDS = C2d(Storage(D2x(SMCA + 248),4))   /* point to last RDS    */         
Do until SMCAFRDS = SMCALRDS    /* end loop when next rds ptr = last */         
  RDSNAME  =  Strip(Storage(D2x(SMCAFRDS + 16),44))  /* smf dsn      */         
  RDSVOLID = Storage(D2x(SMCAFRDS + 60),6)           /* smf volser   */         
  RDSCAPTY = C2d(Storage(D2x(SMCAFRDS + 76),4))      /* size in blks */         
  RDSNXTBL = C2d(Storage(D2x(SMCAFRDS + 80),4))      /* next avl blk */         
  /* RDSPCT  = (RDSNXTBL / RDSCAPTY) * 100 */ /* not how mvs does it */         
  RDSPCT   = Trunc((RDSNXTBL / RDSCAPTY) * 100) /* same as mvs disp. */         
  RDSFLG1  = Storage(D2x(SMCAFRDS + 12),1)     /* staus flags        */         
  Select                                                                        
    When Bitand(RDSFLG1,'10'x) = '10'x then RDSSTAT = 'FREE REQUIRED'           
    When Bitand(RDSFLG1,'08'x) = '08'x then RDSSTAT = 'DUMP REQUIRED'           
    When Bitand(RDSFLG1,'04'x) = '04'x then RDSSTAT = 'ALTERNATE'               
    When Bitand(RDSFLG1,'02'x) = '02'x then RDSSTAT = 'CLOSE PENDING'           
    When Bitand(RDSFLG1,'01'x) = '01'x then RDSSTAT = 'OPEN REQUIRED'           
    When Bitand(RDSFLG1,'00'x) = '00'x then RDSSTAT = 'ACTIVE'                  
    Otherwise RDSSTAT = '??????'                                                
  End  /* Select */                                                             
  If (RDSSTAT = 'ACTIVE' | RDSSTAT = 'DUMP REQUIRED') , /* display   */         
    & RDSPCT = 0 then RDSPCT = 1    /* %full the same way mvs does   */         
  SMCAFRDS = C2d(Storage(D2x(SMCAFRDS + 4),4)) /* point to next RDS  */         
  If Length(RDSNAME) < 26 then do                                               
    Queue ' ' Left(RDSNAME,25,' ') RDSVOLID  Right(RDSCAPTY,11,' ') ,           
              ' 'Format(RDSPCT,5,0) ' ' RDSSTAT                                 
  End                                                                           
  Else do                                                                       
    Queue ' ' RDSNAME                                                           
    Queue copies(' ',27) RDSVOLID  Right(RDSCAPTY,11,' ') ,                     
              ' 'Format(RDSPCT,5,0) ' ' RDSSTAT                                 
  End                                                                           
End                                                                             
Return                                                                          
                                                                                
SUB:                 /* Subsystem information sub-routine            */         
Arg SUBOPT                                                                      
SSCVT    = C2d(Storage(D2x(JESCT+24),4))     /* point to SSCVT       */         
SSCVT2   = SSCVT           /* save address for second loop           */         
If SUBOPT <> 'FINDJES' then do                                                  
  Queue ' '                                                                     
  Queue 'Subsystem Communications Vector Table:'                                
  Queue '  Name   Hex        SSCTADDR   SSCTSSVT' ,                             
        '  SSCTSUSE   SSCTSUS2   Status'                                        
End /* if subopt */                                                             
Do until SSCVT = 0                                                              
  SSCTSNAM = Storage(D2x(SSCVT+8),4)         /* subsystem name       */         
  SSCTSSVT = C2d(Storage(D2x(SSCVT+16),4))   /* subsys vect tbl ptr  */         
  SSCTSUSE = C2d(Storage(D2x(SSCVT+20),4))   /* SSCTSUSE pointer     */         
  SSCTSUS2 = C2d(Storage(D2x(SSCVT+28),4))   /* SSCTSUS2 pointer     */         
  If SUBOPT = 'FINDJES' & SSCTSNAM = JESPJESN then do                           
     JESSSVT  = SSCTSSVT   /* save SSVTSSVT for "version" section    */         
                           /* this points to JES3 Subsystem Vector   */         
                           /* Table, mapped by IATYSVT               */         
     JESSUSE  = SSCTSUSE   /* save SSCTSUSE for "version" section    */         
                           /* this points to version for JES2        */         
     JESSUS2  = SSCTSUS2   /* save SSCTSUS2 for "version" section    */         
                           /* this points to $HCCT for JES2          */         
     Leave  /* found JES info for version section, exit loop */                 
  End /* if subopt */                                                           
  SSCTSNAX = C2x(SSCTSNAM)    /* chg to EBCDIC for non-display chars */         
  Call XLATE_NONDISP SSCTSNAM /* translate non display chars         */         
  SSCTSNAM = RESULT           /* result from XLATE_NONDISP           */         
  If SSCTSSVT = 0 then SSCT_STAT = 'Inactive'                                   
    Else SSCT_STAT = 'Active'                                                   
  If SUBOPT <> 'FINDJES' then do                                                
    Queue ' ' SSCTSNAM ' ' SSCTSNAX  ,                                          
          ' ' Right(D2x(SSCVT),8,0)    ' ' Right(D2x(SSCTSSVT),8,0) ,           
          ' ' Right(D2x(SSCTSUSE),8,0) ' ' Right(D2x(SSCTSUS2),8,0) ,           
          ' ' SSCT_STAT ' '                                                     
  End /* if SUBOPT */                                                           
 /*SSCTSSID = C2d(Storage(D2x(SSCVT+13),1)) */ /* subsys identifier  */         
 /*If bitand(SSCTSSID,'02'x) = '02'x then JESPJESN = 'JES2' */                  
 /*If bitand(SSCTSSID,'03'x) = '03'x then JESPJESN = 'JES3'*/                   
  SSCVT    = C2d(Storage(D2x(SSCVT+4),4))    /* next sscvt or zero   */         
End /* do until sscvt = 0 */                                                    
If SUBOPT <> 'FINDJES' then do                                                  
  Queue ' '                                                                     
  Queue 'Supported Subsystem Function Codes:'                                   
  Do until SSCVT2 = 0 /* 2nd loop for function codes                 */         
    SSCTSNAM = Storage(D2x(SSCVT2+8),4)        /* subsystem name     */         
    SSCTSSVT = C2d(Storage(D2x(SSCVT2+16),4)) /* subsys vect tbl ptr */         
    SSCTSNAX = C2x(SSCTSNAM)  /* chg to EBCDIC for non-display chars */         
    Call XLATE_NONDISP SSCTSNAM /* translate non display chars       */         
    SSCTSNAM = RESULT           /* result from XLATE_NONDISP         */         
    Queue ' ' SSCTSNAM '(X''' || SSCTSNAX || ''')'                              
    If SSCTSSVT <> 0 then do                                                    
      SSVTFCOD = SSCTSSVT + 4                  /* pt to funct. matrix*/         
      SSFUNCTB = Storage(D2X(SSVTFCOD),255)    /* function matrix    */         
      TOTFUNC = 0       /* counter for total functions per subsystem */         
      Drop FUNC.        /* init stem to null for saved functions     */         
      Do SUPFUNC = 1 TO 255                                                     
        If Substr(SSFUNCTB,SUPFUNC,1) <> '00'x then do /* supported? */         
          TOTFUNC = TOTFUNC + 1 /* tot functions for this subsystem  */         
          FUNC.TOTFUNC = SUPFUNC  /* save function in stem           */         
        End                                                                     
      End /* do supfunc */                                                      
      /***************************************************************/         
      /* The following code is used to list the supported functions  */         
      /* on a single line by ranges. For example: 1-10,13,18-30,35   */         
      /***************************************************************/         
      If TOTFUNC >= 1 then do   /* begin loop to list function codes */         
        ALLCODES = ''                   /* init var to nulls         */         
        NEWRANGE = 'YES'                /* init newrange flag to YES */         
        FIRSTRNG = 'YES'                /* init firstrng flag to YES */         
        Do FCODES = 1 to TOTFUNC        /* loop though codes         */         
          JUNK = TOTFUNC + 1            /* prevent NOVALUE cond.     */         
          FUNC.JUNK = ''                /*  in func.chknext at end   */         
          CHKNEXT = FCODES + 1          /* stem var to chk next code */         
          If FUNC.FCODES + 1 = FUNC.CHKNEXT then do  /* next matches */         
            If NEWRANGE = 'YES' & FIRSTRNG = 'YES' then do /* first  */         
              ALLCODES =  ALLCODES || FUNC.FCODES || '-'   /* in new */         
              NEWRANGE = 'NO'                    /* range - seperate */         
              FIRSTRNG = 'NO'                    /* with a dash      */         
              Iterate                            /* get next code    */         
            End /* if newrange = 'yes' & firstrng = 'yes'            */         
            If NEWRANGE = 'YES' & FIRSTRNG = 'NO' then do /* next    */         
              ALLCODES =  ALLCODES || FUNC.FCODES  /* matches, but   */         
              NEWRANGE = 'NO'   /* is not the first, don't add dash  */         
              Iterate                            /* get next code    */         
            End /* if newrange = 'yes' & firstrng = 'no'             */         
            Else iterate  /* same range + not first - get next code  */         
          End /* func.fcodes + 1 */                                             
          If FCODES = TOTFUNC then , /* next doesn't match and this  */         
            ALLCODES =  ALLCODES || FUNC.FCODES  /* is the last code */         
          Else do /* next code doesn't match - seperate with comma   */         
            ALLCODES =  ALLCODES || FUNC.FCODES || ','                          
            NEWRANGE = 'YES'         /* re-init newrange flag to YES */         
            FIRSTRNG = 'YES'         /* re-init firstrng flag to YES */         
          End                                                                   
        End /* do fcodes = 1 to totfunc */                                      
        Queue '    Codes:' ALLCODES                                             
      End /* if totfunc >= 1 */                                                 
    End                                                                         
    Else queue '    *Inactive*'                                                 
    SSCVT2   = C2d(Storage(D2x(SSCVT2+4),4))   /* next sscvt or zero */         
  End /* do until sscvt2 = 0 */                                                 
End /* if subopt <> 'findjes' */                                                
Return                                                                          
                                                                                
ASID:                /* ASVT Usage sub-routine                       */         
Queue ' '                                                                       
CVTASVT  = C2d(Storage(D2x(CVT+556),4))     /* point to ASVT         */         
ASVTMAXU = C2d(Storage(D2x(CVTASVT+516),4)) /* max number of entries */         
ASVTMAXI = C2d(Storage(D2x(CVTASVT+500),4)) /* MAXUSERS from ASVT    */         
ASVTAAVT = C2d(Storage(D2x(CVTASVT+480),4)) /* free slots in ASVT    */         
ASVTSTRT = C2d(Storage(D2x(CVTASVT+492),4)) /* RSVTSTRT from ASVT    */         
ASVTAST  = C2d(Storage(D2x(CVTASVT+484),4)) /* free START/SASI       */         
ASVTNONR = C2d(Storage(D2x(CVTASVT+496),4)) /* RSVNONR  from ASVT    */         
ASVTANR  = C2d(Storage(D2x(CVTASVT+488),4)) /* free non-reusable     */         
Queue 'ASID Usage Summary from the ASVT:'                                       
Queue '  Maximum number of ASIDs:' Right(ASVTMAXU,5,' ')                        
Queue '                          '                                              
Queue '    MAXUSER from IEASYSxx:' Right(ASVTMAXI,5,' ')                        
Queue '             In use ASIDs:' Right(ASVTMAXI-ASVTAAVT,5,' ')               
Queue '          Available ASIDs:' Right(ASVTAAVT,5,' ')                        
Queue '                          '                                              
Queue '    RSVSTRT from IEASYSxx:' Right(ASVTSTRT,5,' ')                        
Queue '           RSVSTRT in use:' Right(ASVTSTRT-ASVTAST,5,' ')                
Queue '        RSVSTRT available:' Right(ASVTAST,5,' ')                         
Queue '                          '                                              
Queue '    RSVNONR from IEASYSxx:' Right(ASVTNONR,5,' ')                        
Queue '           RSVNONR in use:' Right(ASVTNONR-ASVTANR,5,' ')                
Queue '        RSVNONR available:' Right(ASVTANR,5,' ')                         
Return                                                                          
                                                                                
LPA:                 /* LPA List sub-routine                         */         
CVTSMEXT = C2d(Storage(D2x(CVT + 1196),4))   /* point to stg map ext.*/         
CVTEPLPS = C2d(Storage(D2x(CVTSMEXT+56),4))  /* start vaddr of ELPA  */         
NUMLPA   = C2d(Storage(D2x(CVTEPLPS+4),4))   /* # LPA libs in table  */         
LPAOFF   = 8                                 /* first ent in LPA tbl */         
Queue '     '                                                                   
Queue 'LPA Library List  ('NUMLPA' libraries):'                                 
Queue '  POSITION    DSNAME'                                                    
Do I = 1 to NUMLPA                                                              
  LEN   = C2d(Storage(D2x(CVTEPLPS+LPAOFF),1)) /* length of entry    */         
  LPDSN = Storage(D2x(CVTEPLPS+LPAOFF+1),LEN)  /* DSN of LPA library */         
  LPAOFF = LPAOFF + 44 + 1                     /* next entry in table*/         
  LPAPOS = Right(I,3)                        /* position in LPA list */         
  RELLPPOS = Right('(+'I-1')',6)        /* relative position in list */         
  Queue LPAPOS  RELLPPOS '  ' LPDSN                                             
End                                                                             
Return                                                                          
                                                                                
LNKLST:              /* LNKLST sub-routine                           */         
If Bitand(CVTOSLV1,'01'x) <> '01'x then do    /* below OS/390 R2     */         
  CVTLLTA  = C2d(Storage(D2x(CVT + 1244),4))  /* point to lnklst tbl */         
  NUMLNK   = C2d(Storage(D2x(CVTLLTA+4),4)