Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XTVSSVR

XTVSSVR.m

Go to the documentation of this file. 
  1. XTVSSVR ;ALB/GTS - VistA Package Sizing Manager; 26-FEB-2020
  1.  ;;7.3;TOOLKIT;**143,152**;Apr 25, 1995;Build 3
  1.  ;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1. SRVREXT ; Entry point - Process XTVS Request Message
  1.  ; -- Server Option: XTVS PKG EXTRACT SERVER
  1.  ;
  1.  ; Message Form:
  1.  ;  REQUESTED BY: {Email address} - Recipient of size report
  1.  ;  Extract Indicator: {0 OR 1} - 0 means no extract; 1 means extract Package file data
  1.  ;  Report Indicator: {1 or 2} - 1 means All Packages Size rpt; 2 means Single Package Size rpt
  1.  ;  Package Parameters: Line 1 is the package parameters for the selected package to report
  1.  ;                       followed by parameters for all packages
  1.  ;
  1.  NEW XTVSLN,XMRG,XMY,XMER,XTVSEXTP,XTVSSNDR,XTVSRPTP,SELPKGPM
  1.  NEW SELPKGPM,LNITMCT,XTPPARM,XTPKGLN
  1.  SET (XTPKGLN,SELPKGPM)=""
  1.  SET (LNITMCT,XTPPARM)=0
  1.  SET XMER=1
  1.  FOR  Q:XMER<0  X XMREC DO
  1.  . IF XMER'<0 DO
  1.  .. SET XTVSLN=XMRG
  1.  .. DO PARSLN ;Process msg line to rebuild single pkg parameter def line (XT*7.3*152)
  1.  ;
  1.  IF XTVSEXTP=1 DO EXTPKG(XTVSSNDR) DO EEXT(XTVSSNDR,+$GET(XTVSRPTP)) ; Extract Package and send
  1.  ;
  1.  IF $GET(XTVSRPTP)=2 DO
  1.  . IF SELPKGPM]"" DO ONEPKGSZ(XTVSSNDR,SELPKGPM) ; Return size report for single package
  1.  . IF SELPKGPM="" DO WRERR("SRVREXT^XTVSSVR : Package Size Rpt error","Parameters for a selected package not sent in server request.",XTVSSNDR,"{MISSING PACKAGE NAME}")
  1.  ;
  1.  KILL ^TMP("XTVS-FORUMPKG",$J)
  1.  QUIT
  1.  ;
  1. PARSLN ; Parse message line of package parameters (XT*7.3*152)
  1.  ;
  1.  ; The following partition variables must be set by/for calling procedure:
  1.  ;  XTVSLN   - Curr line from rcved msg
  1.  ;  XTVSSNDR - Mailman address of report requester
  1.  ;  XTVSEXTP - Extract Indicator
  1.  ;  XTVSRPTP - Requested Report type
  1.  ;  XTPKGLN  - Current Parameter String concatonated from message lines
  1.  ;  LNITMCT  - Last Array node number set in result array with complete package def on single node
  1.  ;  SELPKGPM - Package requested for a Single Size report.
  1.  ;  XTPPARM  - Indicator:
  1.  ;                1 - SELPKGPM is being/has been defined
  1.  ;                0 - SELPKGPM has not started/completed definition
  1.  ;
  1.  IF XTVSLN["REQUESTED BY:" SET XTVSSNDR=$P(XTVSLN,"REQUESTED BY: ",2) ;Addressee for report
  1.  ;
  1.  IF XTVSLN["Extract Indicator:" SET XTVSEXTP=+($PIECE($GET(XTVSLN),": ",2)) ;1 - Extract Packages
  1.  IF XTVSLN["Report Indicator:" SET XTVSRPTP=+($PIECE($GET(XTVSLN),": ",2)) ;0/NULL - No Size rpt; 1 - All Packages Size rpt; 2 - Single Package Size rpt
  1.  ;
  1.  ; The full Package Parameter file is needed for TALLYRPT^XTVSRFL to set create ^TMP("XTVS-IDX-PKG",$J,PKGPFX,PKGNAME)
  1.  ; for packages in the Param file with value = 1 when KIDS Prefix, Null when not KIDS Prefix. Package
  1.  ; Component counting is prevented from counting an Additional Prefix in a package when it is another
  1.  ; packages primary prefix
  1.  ;
  1.  ; Parse out all packages in server message; server message needs all packages so Create ^TMP("XTVS-IDX-PKG",$J) array for MULTX^XTVSRFL1
  1.  ;    If SELPKGPM has been defined and has 9 ^ pces, 1oad XTVSLN into ^TMP("XTVS-FORUMPKG",$J,TMPSUB)
  1.  IF (XTPPARM) DO
  1.  . IF $L(SELPKGPM,"^")'<9 DO PKGLNRBD("XTVS-FORUMPKG",XTVSLN,.XTPKGLN,.LNITMCT) ; Rebuild Param file string
  1.  . IF $L(SELPKGPM,"^")<9 SET SELPKGPM=SELPKGPM_XTVSLN ;Concat the msg lines compising the selected Package Params
  1.  IF XTVSLN["Package Parameters:" SET XTPPARM=1 SET SELPKGPM=$P(XTVSLN,"Package Parameters: ",2)
  1.  QUIT
  1.  ;
  1. PKGLNRBD(ARRYNAME,XTVSLN,XTPKGLN,LNITMCT) ;Rebuild multiple message lines into single pkg param line (XT*7.3*152)
  1.  ; Input:
  1.  ;  ARRYNAME - First Subscript of ^TMP array [VAL] 
  1.  ;  XTVSLN   - Current message line [VAL]
  1.  ;  XTPKGLN  - Package line being created [VAL]
  1.  ;  LNITMCT  - Node # to store complete Package String in ^TMP array [REF]
  1.  ;
  1.  IF $L(XTPKGLN,"^")<9 SET XTPKGLN=XTPKGLN_XTVSLN
  1.  IF $L(XTPKGLN,"^")'<9 DO
  1.  . SET LNITMCT=LNITMCT+1
  1.  . SET ^TMP(ARRYNAME,$J,LNITMCT)=XTPKGLN ; Add Package to Parameter Array node
  1.  . SET XTPKGLN=""
  1.  QUIT
  1.  ;
  1. EXTPKG(XTVSSNDR) ; Extract Package File
  1.  ;
  1.  ;Input
  1.  ; XTVSSNDR - Requesters VA Mailman address
  1.  ;
  1.  NEW VPNAME,VPIEN,VPNAT,VPN,VPNATRSLT,VPCURST,ACTIVST
  1.  KILL ^XTMP("XTSIZE",$J)
  1.  ;NOTE: First pce of 0 node sets ^XTMP purge date 90 days from 'Today'
  1.  SET ^XTMP("XTSIZE",$J,0)=$$FMADD^XLFDT($P($$NOW^XLFDT,"."),90)_"^"_$P($$NOW^XLFDT,".")_"^"_$$NOW^XLFDT_"-Kernel ToolKit Package File Extract by "_$S($G(XTVSUNME)]"":XTVSUNME,1:"{unknown user}")_"^"_^%ZOSF("PROD")
  1.  ;
  1.  SET VPIEN=0
  1.  FOR  SET VPIEN=$ORDER(^DIC(9.4,VPIEN)) QUIT:'VPIEN  SET VPNAME=$P($G(^DIC(9.4,VPIEN,0)),"^") IF VPNAME]"" DO
  1.  . SET VPNAT=$G(^DIC(9.4,VPIEN,7)),VPNAT=$P(VPNAT,"^",3)
  1.  . SET VPNATRSLT=((VPNAT="I")!(VPNAT="Ia")!(VPNAT="Ib")!(VPNAT="Ic"))  ;Only extract Class I, Ia, Ib and Ic packages
  1.  . SET VPN=$P($G(^DIC(9.4,VPIEN,0)),"^",2) ; PREFIX, Required, Do not extract if missing PREFIX
  1.  . SET VPCURST=$P($G(^DIC(9.4,VPIEN,15002)),"^",3) ;Get CURRENT STATUS
  1.  . SET ACTIVST=((VPCURST'="X")&(VPCURST'="D")) ;If CURRENT STATUS '= NO LONGER USED and '= DECOMMISSIONED
  1.  . IF VPNATRSLT,VPN]"",ACTIVST DO  ;National pkg, Has prefix, Not inactive pkg
  1.  .. IF VPNAME["""" DO
  1.  ... SET VPNAME=$REPLACE(VPNAME,"""","''")
  1.  ... DO NOTCE^XTVSLAPI("Double Quotes changed to 2 single quotes in the "_VPNAME_" Package name.~EXTPKG^XTVSSVR",XTVSSNDR,VPNAME)
  1.  .. DO SETXTMP^XTVSLNA1 ;Extract Packages
  1.  ;
  1.  QUIT
  1.  ;
  1. EEXT(XTVSSNDR,XTVSSIZE) ; Email ^XTMP("XTSIZE") extract global
  1.  ;
  1.  ;Input
  1.  ; XTVSSNDR - Requesters VA Mailman address
  1.  ; XTVSSIZE - 1: Create Size Report for all package; Null: No report
  1.  ;
  1.  NEW XPID,QCHK
  1.  SET QCHK=0
  1.  SET XPID=$JOB ;Process ID
  1.  SET XTVSSIZE=+$GET(XTVSSIZE)
  1.  ;
  1.  IF '$D(^XTMP("XTSIZE",XPID)) DO WRERR("EEXT^XTVSSVR : Package extract error","Extract failed!  ^XTMP(""XTSIZE"","_XPID_") not created on Server!",XTVSSNDR,"")
  1.  IF $D(^XTMP("XTSIZE",XPID)) DO
  1.  . NEW XMERR,XMY,XMTEXT,XMDUZ,XMSUB,XDATE
  1.  . SET XMDUZ=DUZ
  1.  . SET XMY(XTVSSNDR)=""
  1.  . SET XMTEXT="^XTMP(""XTSIZE"","_XPID_","
  1.  . SET XDATE=$P($P(^XTMP("XTSIZE",XPID,0),"^",3),"-")
  1.  . SET XDATE=$$FMTE^XLFDT(XDATE,"1P")
  1.  . SET XMSUB="PACKAGE FILE EXTRACT ("_$P(^XTMP("XTSIZE",XPID,0),"^",4)_" ; "_XDATE_" ; $JOB#: "_XPID_")"
  1.  . DO ENT^XMPG
  1.  . IF +XMZ'>0 DO WRERR("EEXT^XTVSSVR : Package extract error","Error: ^XTMP(""XTSIZE"","_XPID_") not sent in Packman to "_XTVSSNDR_"!",XTVSSNDR,"")
  1.  . IF XTVSSIZE=1 DO SIZERPT(XTVSSNDR) ; Create size report for all packages
  1.  KILL ^XTMP("XTSIZE",XPID)
  1.  ;
  1.  QUIT
  1.  ;
  1. WRERR(HDRTEXT,ERRTEXT,XTVSSNDR,PKGNAME) ; Write Server Mail extract send error to Error Trap & return msg to requester
  1.  DO APPERROR^%ZTER(HDRTEXT) ;Write error to Error Trap
  1.  ;
  1.  ; Send size report request failure message
  1.  NEW XMERR,XMY,XMTEXT,XMDUZ,XMSUB
  1.  KILL ^TMP("XTVS-REMOTE-ERROR",$JOB)
  1.  IF PKGNAME]"" DO
  1.  . SET ^TMP("XTVS-REMOTE-ERROR",$JOB,1)="Notice for Remote Package size report on "_^%ZOSF("PROD")_"."
  1.  . SET ^TMP("XTVS-REMOTE-ERROR",$JOB,2)="Remote size report request FAILED for "_PKGNAME_"."
  1.  . SET ^TMP("XTVS-REMOTE-ERROR",$JOB,3)=ERRTEXT
  1.  IF PKGNAME']"" DO
  1.  . SET ^TMP("XTVS-REMOTE-ERROR",$JOB,1)="Remote package size report on "_^%ZOSF("PROD")_" failed!!"
  1.  . SET ^TMP("XTVS-REMOTE-ERROR",$JOB,2)=ERRTEXT
  1.  SET XMDUZ=DUZ
  1.  SET XMY(XTVSSNDR)=""
  1.  SET XMTEXT="^TMP(""XTVS-REMOTE-ERROR"","_$JOB_","
  1.  SET XMSUB="PACKAGE SIZE REPORT ("_^%ZOSF("PROD")_") ; remote request FAILED!"
  1.  DO ^XMD
  1.  IF +XMZ'>0 DO
  1.  . SET ERRTEXT="'Failed extract error message' FAILED to return to "_XTVSSNDR_"."
  1.  . DO APPERROR^%ZTER("WRERR^XTVSSVR : Package extract error")
  1.  KILL ^TMP("XTVS-REMOTE-ERROR",$JOB)
  1.  QUIT
  1.  ;
  1. SIZERPT(XTVSSNDR) ; Create Size Report and return to user
  1.  ; Requires ^XTMP("XTSIZE")
  1.  NEW PKGNMEL1,PKGNMEL2,PKGNMEL3,LNNUM
  1.  DO XTMPORD^XTVSLNA1($JOB,0,1) ; Create ^TMP("XTSIZE") Parameter file, Do Not create Change Report arrays, Create ^TMP("XTVS-FORUMPKG",$J)
  1.  ;
  1.  DO KIDSIDX^XTVSRFL1 ;Create Prefix-Package Indicies from KIDS
  1.  ;
  1.  DO TALLYRPT^XTVSRFL(1,1) ; Needs ^TMP("XTVS-FORUMPKG",$J,TMPSUB) and DO KIDSIDX^XTVSRFL1
  1.  DO RPTSIZE(XTVSSNDR) ; Set report into Mail Message array
  1.  ;
  1.  KILL ^XTMP("XTSIZE",$J)
  1.  KILL ^TMP("XTVS-VPS",$JOB),^TMP("XTVS-FORUMPKG",$JOB),^TMP("XTVS-PREFIX-IDX",$JOB),^TMP("XTVS-FORUM-PFXS",$JOB)
  1.  KILL ^TMP("XTVS-VPS0",$JOB),^TMP("XTVS-IDX-PKG",$JOB),^TMP("XTVS-KIDSPFX-IDX",$JOB),^TMP("XTVS-FORUM2TMP",$JOB) ;,^TMP("XTSIZE","IDX",$JOB)
  1.  KILL ^TMP("XTVS-FILERPT",$JOB),^TMP("XTSIZE",$JOB),^TMP("XTSIZE","IDX",$JOB),^TMP("XTVS-REMOTE-SIZE",$JOB) ; KILL ^TMP globals
  1.  QUIT
  1.  ;
  1. RPTSIZE(XTVSSNDR) ; Create message with report
  1.  NEW LINECNT,RUNDT
  1.  SET LINECNT=0
  1.  ;
  1.  DO ADDLNE("^TMP(""XTVS-REMOTE-SIZE"")",.LINECNT,"VistA Application Sizing Information                               Sort Type: 1")
  1.  DO ADDLNE("^TMP(""XTVS-REMOTE-SIZE"")",.LINECNT,"   Site Domain: "_$P($$NETNAME^XMXUTIL(DUZ),"@",2))
  1.  DO NOW^%DTC S Y=X D DD^%DT
  1.  SET RNDT=Y
  1.  DO ADDLNE("^TMP(""XTVS-REMOTE-SIZE"")",.LINECNT,"      Run Date: "_RNDT)
  1.  DO ADDLNE("^TMP(""XTVS-REMOTE-SIZE"")",.LINECNT," ")
  1.  DO ADDLNE("^TMP(""XTVS-REMOTE-SIZE"")",.LINECNT,"                       Total")
  1.  DO ADDLNE("^TMP(""XTVS-REMOTE-SIZE"")",.LINECNT,"Application             Rtn")
  1.  DO ADDLNE("^TMP(""XTVS-REMOTE-SIZE"")",.LINECNT,"(Namespace)  Routines  Size  Files  Fields  Options  Protocols  RPCs  Templates")
  1.  DO ADDLNE("^TMP(""XTVS-REMOTE-SIZE"")",.LINECNT,"===============================================================================")
  1.  ;
  1.  ; Add report lines to display array
  1.  NEW PKGNAME,PKGPFX
  1.  SET PKGNAME=""
  1.  FOR  SET PKGNAME=$O(^TMP("XTVS-VPS",$J,PKGNAME)) QUIT:PKGNAME=""  SET PKGPFX="" DO
  1.  . FOR  SET PKGPFX=$O(^TMP("XTVS-VPS",$J,PKGNAME,PKGPFX)) QUIT:PKGPFX=""  DO
  1.  .. DO PDAD($G(^(PKGPFX)),PKGNAME,PKGPFX,.LINECNT)
  1.  ;
  1.  ; Send size report message
  1.  NEW XMERR,XMY,XMTEXT,XMDUZ,XMSUB
  1.  SET XMDUZ=DUZ
  1.  SET XMY(XTVSSNDR)=""
  1.  SET XMTEXT="^TMP(""XTVS-REMOTE-SIZE"","_$JOB_","
  1.  SET XMSUB="PACKAGE SIZE REPORT ("_^%ZOSF("PROD")_" ; "_$$FMTE^XLFDT($$NOW^XLFDT,"1P")_" ; $JOB#: "_$JOB_")"
  1.  DO ^XMD
  1.  IF +XMZ'>0 DO WRERR("RPTSIZE^XTVSSVR : Package extract error","Error: ^XTMP(""XTVS-REMOTE-SIZE"","_$JOB_") not sent in Packman to "_XTVSSNDR_"!",XTVSSNDR,"ALL Packages")
  1.  ;
  1.  QUIT
  1.  ;
  1. PDAD(DATA,PKGNAME,PKGPFX,LINECNT) ; Add data to message global
  1.  NEW RTOT,TLCNT,FTOT,FLDTOT,OTOT,PTOT,RPTOT,TPLTTOT,DATANDE,SPCT
  1.  SET RTOT=+DATA
  1.  SET TLCNT=$P(DATA,"^",2)
  1.  SET FTOT=$P(DATA,"^",3)
  1.  SET FLDTOT=$P(DATA,"^",4)
  1.  SET OTOT=$P(DATA,"^",5)
  1.  SET PTOT=$P(DATA,"^",6)
  1.  SET RPTOT=$P(DATA,"^",7)
  1.  SET TPLTTOT=$P(DATA,"^",8)
  1.  ;
  1.  DO ADDLNE("^TMP(""XTVS-REMOTE-SIZE"")",.LINECNT,PKGNAME)
  1.  SET DATANDE=""
  1.  SET DATANDE="("_PKGPFX_")"
  1.  FOR SPCT=1:1:11-$LENGTH(DATANDE) SET DATANDE=DATANDE_" " ;Space out 2nd data element
  1.  SET DATANDE=DATANDE_$J(RTOT,6)_"  "_$J(TLCNT,9)_"  "_$J(FTOT,4)_"  "_$J(FLDTOT,6)_"   "_$J(OTOT,6)_"    "_$J(PTOT,6)_" "_$J(RPTOT,6)_"  "_$J(TPLTTOT,6)
  1.  DO ADDLNE("^TMP(""XTVS-REMOTE-SIZE"")",.LINECNT,DATANDE)
  1.  DO ADDLNE("^TMP(""XTVS-REMOTE-SIZE"")",.LINECNT,"-------------------------------------------------------------------------------")
  1.  QUIT
  1.  ;
  1. ADDLNE(TMPARY,LINECNT,MSG) ; Add line to global
  1.  ;Input
  1.  ; TMMPARY - Array name to add a line (Closed root)
  1.  ; LINECNT - Current array node number
  1.  ; MSG     - Message to add to ListMan Display
  1.  ;
  1.  SET LINECNT=LINECNT+1
  1.  SET @TMPARY@($J,LINECNT)=MSG
  1.  QUIT
  1.  ;
  1.  ; Called by SRVREXT for a single package, SELPKGPM contains package parameters
  1. ONEPKGSZ(XTVSSNDR,SELPKGPM) ; Report Package
  1.  ;Input
  1.  ; XTVSSNDR - Requesters VA Mailman address
  1.  ; SELPKGPM - Selected package parameters
  1.  ;
  1.  NEW PKGNAME,PKGNUM,PKGPFX,PKGERR,PCENUM,PREFIX,ADDPRFX
  1.  SET PKGERR=0
  1.  KILL ^TMP("XTVS-PREFIX-IDX",$J),^TMP("XTVS-FORUM-PFXS",$J),^TMP("XTVS-IDX-PKG",$J)
  1.  ;
  1.  ;Create Prefix Indicies
  1.  SET PKGNAME=$P(SELPKGPM,"^")
  1.  ;
  1.  SET PKGPFX=$P(SELPKGPM,"^",2)
  1.  IF PKGPFX="" DO
  1.  . SET PKGERR=1
  1.  . DO WRERR("ONEPKGSZ^XTVSSVR : Package Size Rpt error","PREFIX not found for package selected.",XTVSSNDR,PKGNAME)
  1.  IF 'PKGERR DO
  1.  . ;
  1.  . DO KIDSIDX^XTVSRFL1 ;Create Prefix-Package Indicies from KIDS
  1.  . ;
  1.  . DO TALLYRPT^XTVSRFL(1,1,SELPKGPM) ; Needs ^TMP("XTVS-FORUMPKG",$J,TMPSUB) and DO KIDSIDX^XTVSRFL1; p152 - v2 ba changed PKGNAME to SELPKGPM 
  1.  . ;
  1.  . DO ONERPT(XTVSSNDR,SELPKGPM,PKGNAME,PKGPFX) ;Report stat's for a single package
  1.  ;
  1.  KILL ^TMP("XTVS-VPS",$JOB),^TMP("XTVS-PREFIX-IDX",$JOB),^TMP("XTVS-FORUM-PFXS",$JOB)
  1.  KILL ^TMP("XTVS-VPS0",$JOB),^TMP("XTVS-IDX-PKG",$JOB),^TMP("XTVS-KIDSPFX-IDX",$JOB)
  1.  KILL ^TMP("XTVS-FILERPT",$JOB),^TMP("XTSIZE","IDX",$JOB),^TMP("XTVS-REMOTE-SIZE",$JOB)
  1.  QUIT
  1.  ;
  1. ONERPT(XTVSSNDR,SELPKGPM,PKGNAME,PKGPFX) ; Report a single package
  1.  ;;INPUT:
  1.  ;   XTVSSNDR  - Requesting user Email address
  1.  ;   SELPKGPM  - Package Parameters (single package)
  1.  ;   PKGNAME   - Package name to report
  1.  ;   PKGPFX    - Package Prefix
  1.  ;
  1.  NEW Q,PCENUM,ADP,RDP,FTOT,FLDTOT,FFCTRSLT,RTOT,OTOT,PRCTOT,RPTOT,TPLTTOT,PKGIEN,RNDT,TLCNT
  1.  NEW PARMDAT,PARMDAT3,PARMDAT4,PARMDAT7,PARMDAT8,LINECNT
  1.  SET (PKGIEN,LINECNT)=0
  1.  IF PKGNAME["''" DO
  1.  . IF $D(^DIC(9.4,"B",$REPLACE(PKGNAME,"''",""""))) SET PKGIEN=$O(^DIC(9.4,"B",$REPLACE(PKGNAME,"''",""""),""))
  1.  . IF '$D(^DIC(9.4,"B",$REPLACE(PKGNAME,"''",""""))),$D(^DIC(9.4,"B",PKGNAME)) SET PKGIEN=$O(^DIC(9.4,"B",PKGNAME,""))
  1.  IF PKGNAME'["''" SET PKGIEN=+$O(^DIC(9.4,"B",PKGNAME,""))
  1.  ;
  1.  ; Piece # on SELPKGPM = node # on ^TMP("XTVS-PARAM-CAP",$J)
  1.  ;
  1.  SET PARMDAT=$P(SELPKGPM,"^",5) ;Additional Prefixes
  1.  SET (ADP,Q,PCENUM)=0
  1.  FOR  SET PCENUM=PCENUM+1 SET Q=$P(PARMDAT,"|",PCENUM) Q:Q=""  IF $$MULTX^XTVSRFL1(Q,PKGNAME) SET ADP=ADP+1 SET ADP(ADP)=Q
  1.  ;
  1.  SET PARMDAT=$P(SELPKGPM,"^",6) ;Excepted Prefixes
  1.  SET (RDP,Q,PCENUM)=0
  1.  FOR  SET PCENUM=PCENUM+1 SET Q=$P(PARMDAT,"|",PCENUM) Q:Q=""  SET RDP=RDP+1 SET RDP(RDP)=Q
  1.  ;
  1.  ; counting files and fields
  1.  SET PARMDAT3=$P(SELPKGPM,"^",3) ;*Lowest File#
  1.  SET PARMDAT4=$P(SELPKGPM,"^",4) ;*Highest File#
  1.  SET PARMDAT7=$P(SELPKGPM,"^",7) ;File Numbers
  1.  SET PARMDAT8=$P(SELPKGPM,"^",8) ;File Ranges
  1.  SET FFCTRSLT=$$COUNTFLS^XTVSRFL1(PKGPFX,PARMDAT3,PARMDAT4,PARMDAT7,PARMDAT8) ; Count Files^Fields
  1.  SET FTOT=$P(FFCTRSLT,"^") ;Extract File ctr
  1.  SET FLDTOT=$P(FFCTRSLT,"^",2) ;Extract Field ctr
  1.  ;
  1.  ; counting routines
  1.  S TLCNT=0
  1.  S RTOT=$$ROUTINE^XTVSRFL1(PKGPFX,.TLCNT,.RDP,.ADP)
  1.  I ADP F Q=1:1:ADP I ADP(Q)'="" S RTOT=RTOT+$$ROUTINE^XTVSRFL1(ADP(Q),.TLCNT,.RDP,.ADP) ;ADP(Q) added prefixes called individually
  1.  ;
  1.  ; counting options
  1.  S OTOT=0
  1.  D CNTR^XTVSRFL1("^DIC(19,",.OTOT,PKGPFX,.RDP,.ADP)
  1.  I ADP F Q=1:1:ADP I ADP(Q)'="" D CNTR^XTVSRFL1("^DIC(19,",.OTOT,ADP(Q),.RDP,.ADP)
  1.  ;
  1.  ; counting protocols
  1.  S PRCTOT=$$PROTOCOL^XTVSRFL1(PKGPFX,PKGIEN,.RDP)
  1.  I ADP F Q=1:1:ADP I ADP(Q)'="" S PRCTOT=PRCTOT+$$PROTOCOL^XTVSRFL1(ADP(Q),PKGIEN,.RDP)
  1.  ;
  1.  ; counting remote procedures
  1.  S RPTOT=0
  1.  D CNTR^XTVSRFL1("^XWB(8994,",.RPTOT,PKGPFX,.RDP,.ADP)
  1.  I ADP F Q=1:1:ADP I ADP(Q)'="" D CNTR^XTVSRFL1("^XWB(8994,",.RPTOT,ADP(Q),.RDP,.ADP)
  1.  ;
  1.  ; counting edit, print, & sort templates
  1.  S TPLTTOT=0
  1.  D CNTR^XTVSRFL1("^DIPT(",.TPLTTOT,PKGPFX,.RDP,.ADP) ;Print Templates
  1.  I ADP F Q=1:1:ADP I ADP(Q)'="" D CNTR^XTVSRFL1("^DIPT(",.TPLTTOT,ADP(Q),.RDP,.ADP)
  1.  ;
  1.  D CNTR^XTVSRFL1("^DIBT(",.TPLTTOT,PKGPFX,.RDP) ;Sort Templates
  1.  I ADP F Q=1:1:ADP I ADP(Q)'="" D CNTR^XTVSRFL1("^DIBT(",.TPLTTOT,ADP(Q),.RDP,.ADP)
  1.  ;
  1.  D CNTR^XTVSRFL1("^DIE(",.TPLTTOT,PKGPFX,.RDP) ;Input Templates
  1.  I ADP F Q=1:1:ADP I ADP(Q)'="" D CNTR^XTVSRFL1("^DIE(",.TPLTTOT,ADP(Q),.RDP,.ADP)
  1.  ;
  1.  DO ADDLNE("^TMP(""XTVS-REMOTE-RPT"")",.LINECNT," ")
  1.  DO ADDLNE("^TMP(""XTVS-REMOTE-RPT"")",.LINECNT,"  VistA Application Sizing Information")
  1.  DO ADDLNE("^TMP(""XTVS-REMOTE-RPT"")",.LINECNT," ")
  1.  DO ADDLNE("^TMP(""XTVS-REMOTE-RPT"")",.LINECNT,"    Site Domain: "_$P($$NETNAME^XMXUTIL(DUZ),"@",2))
  1.  DO NOW^%DTC S Y=X D DD^%DT
  1.  SET RNDT=Y
  1.  DO ADDLNE("^TMP(""XTVS-REMOTE-RPT"")",.LINECNT,"       Run Date: "_RNDT)
  1.  DO ADDLNE("^TMP(""XTVS-REMOTE-RPT"")",.LINECNT," ")
  1.  DO ADDLNE("^TMP(""XTVS-REMOTE-RPT"")",.LINECNT,"VistA Application: "_PKGNAME)
  1.  DO ADDLNE("^TMP(""XTVS-REMOTE-RPT"")",.LINECNT,"==================")
  1.  DO ADDLNE("^TMP(""XTVS-REMOTE-RPT"")",.LINECNT,"Number of Routines:     "_RTOT)
  1.  DO ADDLNE("^TMP(""XTVS-REMOTE-RPT"")",.LINECNT,"Size of Routines:       "_TLCNT)
  1.  DO ADDLNE("^TMP(""XTVS-REMOTE-RPT"")",.LINECNT,"Number of Files:        "_FTOT)
  1.  DO ADDLNE("^TMP(""XTVS-REMOTE-RPT"")",.LINECNT,"Number of Fields:       "_FLDTOT)
  1.  DO ADDLNE("^TMP(""XTVS-REMOTE-RPT"")",.LINECNT,"Number of Options:      "_OTOT)
  1.  DO ADDLNE("^TMP(""XTVS-REMOTE-RPT"")",.LINECNT,"Number of Protocols:    "_PRCTOT)
  1.  DO ADDLNE("^TMP(""XTVS-REMOTE-RPT"")",.LINECNT,"Number of RPCs:         "_RPTOT)
  1.  DO ADDLNE("^TMP(""XTVS-REMOTE-RPT"")",.LINECNT,"Number of Templates:    "_TPLTTOT)
  1.  ;
  1.  ; Send size report message
  1.  NEW XMERR,XMY,XMTEXT,XMDUZ,XMSUB
  1.  SET XMDUZ=DUZ
  1.  SET XMY(XTVSSNDR)=""
  1.  SET XMTEXT="^TMP(""XTVS-REMOTE-RPT"","_$JOB_","
  1.  SET XMSUB="PACKAGE SIZE REPORT ("_^%ZOSF("PROD")_" ; "_$$FMTE^XLFDT($$NOW^XLFDT,"1P")_" ; $JOB#: "_$JOB_")"
  1.  DO ^XMD
  1.  IF +XMZ'>0 DO WRERR("ONERPT^XTVSSVR : Package extract error","Error: ^XTMP(""XTVS-REMOTE-RPT"") not sent in Packman to "_XTVSSNDR_"!",XTVSSNDR,PKGNAME)
  1.  ;
  1.  QUIT