XUVPS ; Bham FO/CML3/gts - VistA Package Sizing; ; 02 Mar 2016 9:05 AM
;;8.0;KERNEL;;Jul 10, 1995;Build 1
;;
INIT ;;
;; data variables (local, for each package)
;; PKGIEN = Package IEN
;; PKGNAME = Package NAME (.01 - $P(^(0),"^",1))
;; PKGPFX = Package PREFIX / NAMESPACE (1 - $P(^(0),"^",2))
;;
;; RTOT = total ROUTINEs
;; TLCNT = total SIZE of all ROUTINES
;; FTOT = total FILEs
;; FLDTOT = total FIELDs of all FILES
;; OTOT = total OPTIONs (^DIC(19,)
;; PRCTOT = total PROTOCOLs (^ORD(101,)
;; RPTOT = total REMOTE PROCEDUREs (^XWB(8994,)
;;
I $G(DUZ)="" W !!,"DUZ must be defined." Q
;
N X,Y
;
ALL ;
W !!,"VistA Package Sizing Report",!
N DIR S DIR(0)="YA",DIR("B")="NO"
S DIR("A")="Do you want to print Sizing Information for ALL VistA Packages? "
D ^DIR I Y'=1,Y'=0 G QUIT
I Y'=1 G SELPKG
;;S VPSALL=Y ;TO DO: GTS - REMOVE if not needed
;
SORT ;
N DIR,XUVPSORT
S DIR("A")="Select Display Method"
S DIR(0)="S^1:SORTED BY PKG NAMES;2:SORTED BY NUMBER OF ROUTINES - HIGH TO LOW;3:SORTED BY TOTAL SIZE OF PKG ROUTINES - HIGH TO LOW;4:SORTED BY PKG NAME, DATA DELIMITED (BY CARET), NO ADDED SPACING"
S DIR("L")=" 4. Delimited (^) Data, Sorted by PACKAGE NAME"
S DIR("L",1)="Select which method to display the package data: "
S DIR("L",2)=""
S DIR("L",3)=" 1. Sorted by PACKAGE NAME"
S DIR("L",4)=" 2. Sorted by NUMBER of ROUTINES (Highest to Lowest)"
S DIR("L",5)=" 3. Sorted by TOTAL ROUTINE SIZE (Highest to Lowest)"
D ^DIR G:'Y QUIT S XUVPSORT=+Y
;
DEVICE ;
KILL %ZIS,IO("Q"),IOP S %ZIS="MQ",%ZIS("B")=""
NEW CRTHOST,FILENME,STORPATH,TSKD
SET (CRTHOST,FILENME,STORPATH)=""
SET TSKD=0
IF XUVPSORT=4 SET CRTHOST=$$CHKHOST()
IF CRTHOST="YES" DO
. DO SELFILE(.FILENME,.STORPATH)
. IF (FILENME="")!(STORPATH="") DO FILABORT(.CRTHOST,.FILENME,.STORPATH) SET CRTHOST="NO"
. IF (FILENME]""),(STORPATH]"") DO
.. SET ZTIO=""
.. SET ZTRTN="LOOP^XUVPS",ZTDESC="VistA Application Sizing Host File" ;Invoke Loop for report of All packages
.. SET ZTSAVE("*")="" D ^%ZTLOAD
.. WRITE !!,"Host File creation ",$S($D(ZTSK)#2:"Queued.",1:"Aborted.")
;
IF ((XUVPSORT=4)&(CRTHOST="NO"))!(XUVPSORT'=4) DO
. W !!,"It will take a considerable amount of time to run this report for ALL",!,"PACKAGES as you have requested. Therefore it is highly recommended that",!,"you QUEUE this report. The report can be queued to run NOW and queuing "
. W "this",!,"report will free up your terminal, allowing you to continue working while",!,"this report runs."
. W ! D ^%ZIS I POP D HOME^%ZIS W !,"NO DEVICE SELECTED." G QUIT
. I $D(IO("Q")) D G QUIT
.. SET TSKD=1
.. S ZTRTN="LOOP^XUVPS",ZTDESC="VistA Application Sizing Display" ;Invoke Loop for report of All packages
.. S ZTSAVE("*")="" D ^%ZTLOAD W !!,"Display ",$S($D(ZTSK)#2:"Queued.",1:"Aborted.")
. I '$D(IO("Q")) DO LOOP^XUVPS
QUIT
;
LOOP ;
K ^TMP("XUVPS",$J),^TMP("XUVPS0",$J)
N D1,D2,D3,D4,D5,D6,D7,D8,D9,QA,S1,S2,CLASS,FNUM
NEW ADP,FLDTOT,FTOT,PKGIEN,PKGNAME,PKGPFX,PTOT,RPTOT,RTOT,TLCNT,VPSFAT,OTOT
S S1="",(D1,D2,D3,D4,D5,D6)=0
F S S1=$O(^DIC(9.4,"B",S1)) Q:S1="" W:'TSKD "." S S2=0 F S S2=$O(^DIC(9.4,"B",S1,S2)) Q:'S2 DO LPVAR(S2,.PKGNAME,.CLASS) IF PKGNAME]"",CLASS="I" D ;
.S PKGPFX=$P(PKGNAME,"^",2),PKGNAME=$P(PKGNAME,"^"),PKGIEN=S2
.S (FTOT,OTOT,PTOT,RPTOT,RTOT,TLCNT)=0,FLDTOT="TBD"
.S QA=0
.F S QA=$O(^DIC(9.4,PKGIEN,4,QA)) Q:'QA DO
.. K VPSFAT
.. S FNUM=$P($G(^DIC(9.4,PKGIEN,4,QA,0)),"^")
.. D FILE^DID(FNUM,"","NAME","VPSFAT")
.. IF $D(VPSFAT("NAME")) S FTOT=FTOT+1
.S RTOT=$$ROUTINE(PKGPFX,.TLCNT)
.S OTOT=$$OPTION(PKGPFX)
.S PTOT=$$PROTOCOL(PKGPFX,PKGIEN)
.S RPTOT=$$REMPROC(PKGPFX)
.K ADP
.S (ADP,QA)=0
.F S QA=$O(^DIC(9.4,PKGIEN,14,QA)) Q:'QA S ADP=ADP+1,ADP(ADP)=$P($G(^(QA,0)),"^")
.I ADP F QA=1:1:ADP I ADP(QA)]"" D ;
..S RTOT=RTOT+$$ROUTINE(ADP(QA),.TLCNT)
..S OTOT=OTOT+$$OPTION(ADP(QA))
..S RPTOT=RPTOT+$$REMPROC(ADP(QA))
.S D1=$G(^TMP("XUVPS",$J,PKGNAME,PKGPFX)),D9=$P(D1,"^",7),D8=$P(D1,"^",6)
.S D7=$P(D1,"^",5),D5=$P(D1,"^",3),D4=$P(D1,"^",2),D3=+D1
.S ^TMP("XUVPS",$J,PKGNAME,PKGPFX)=(D3+RTOT)_"^"_(D4+TLCNT)_"^"_(D5+FTOT)_"^^"_(D6+OTOT)_"^"_(D7+PTOT)_"^"_(D8+RPTOT)
I XUVPSORT=2 S D1="" F S D1=$O(^TMP("XUVPS",$J,D1)) Q:D1="" S D2="" F S D2=$O(^TMP("XUVPS",$J,D1,D2)) Q:D2="" S X=$G(^(D2)),^TMP("XUVPS0",$J,+X,D1,D2)=$P(X,"^",2,7)
I XUVPSORT=3 S D1="" F S D1=$O(^TMP("XUVPS",$J,D1)) Q:D1="" S D2="" F S D2=$O(^TMP("XUVPS",$J,D1,D2)) Q:D2="" S X=$G(^(D2)),^TMP("XUVPS0",$J,+$P(X,"^",2),D1,D2)=+X_"^"_$P(X,"^",3,7)
;
DISALL ;
; display option 4 has no formatting, and is used for creating
; spreadsheets, for which the following heading lines are not needed
I XUVPSORT'=4 D ;
.W @IOF,"VistA Application Sizing Information"
.W !!!!,"Application",?29,"Routines Total Files Files Fields Options Protocols RPCs"
.W !?2,"(Namespace)",?38,"Routine",!?39,"Size",?60,XUVPSORT
.W !,"================================================================================"
;
DAD ;
I XUVPSORT=2!(XUVPSORT=3) S S3="" F S S3=$O(^TMP("XUVPS0",$J,S3),-1) S D3=S3 Q:S3="" S D1="" F S D1=$O(^TMP("XUVPS0",$J,S3,D1)) Q:D1="" S D2="" F S D2=$O(^TMP("XUVPS0",$J,S3,D1,D2)) Q:D2="" D PDAD(XUVPSORT,$G(^(D2)),D1,D2,D3)
I XUVPSORT=1!(XUVPSORT=4) DO
. NEW POPERR
. SET (D1,POPERR)=""
. ;
. ;If write delimited report to a file
. IF FILENME]"" DO QUIT:POPERR
.. DO OPEN^%ZISH("DELIMFL1",STORPATH,FILENME,"A")
.. SET:POP POPERR=POP
.. QUIT:POPERR
.. U IO
. ;
. FOR S D1=$O(^TMP("XUVPS",$J,D1)) Q:D1="" S D2="" DO
.. F S D2=$O(^TMP("XUVPS",$J,D1,D2)) Q:D2="" DO
... D PDAD(XUVPSORT,$G(^(D2)),D1,D2,"")
. IF FILENME]"" DO CLOSE^%ZISH("DELIMFL1")
;
;If write delimited report to a file
IF (XUVPSORT=4),($G(POPERR)) DO
. W !!,"ERROR: "_FILENME_" file creation in "_STORPATH_" FAILED!!"
. W !," >>Check path and filename.<<"
KILL ^TMP("XUVPS",$J),^TMP("XUVPS0",$J)
QUIT
;
PDAD(XUVPSORT,DATA,D1,D2,D3) ; print actual data (finally)
N D4,D5,D6,D7,D8,D9,DATANDE S D6="TBD"
I XUVPSORT=1!(XUVPSORT=4) S D4=$P(DATA,"^",2),D5=$P(DATA,"^",3),D7=$P(DATA,"^",5),D8=$P(DATA,"^",6),D9=$P(DATA,"^",7),D3=+DATA
I XUVPSORT=4 DO QUIT
. SET DATANDE=""
. SET DATANDE=D1_"^"_D2_"^"_D3_"^"_D4_"^"_D5_"^"_D6_"^"_D7_"^"_D8_"^"_D9
. W !,DATANDE
I XUVPSORT=2!(XUVPSORT=3) S D5=$P(DATA,"^",2),D7=$P(DATA,"^",4),D8=$P(DATA,"^",5),D9=$P(DATA,"^",6) S:XUVPSORT=2 D4=+DATA S:XUVPSORT=3 D4=D3,D3=+DATA
;
;If writing report to printer...
W !,D1,?31,$J(D3,6)," ",$J(D4,9)," ",$J(D5,4)," ",$J(D6,6)," ",$J(D7,6)," ",$J(D8,6)," ",$J(D9,6)
W !,"(",D2,")",!,"--------------------------------------------------------------------------------"
QUIT
;
SELPKG ;
S DIC=9.4,DIC(0)="AEMQ",DIC("S")="I $D(^(7)),$P(^(7),""^"",3)=""I"""
W ! D ^DIC
I Y>0 W !!!!,"...working..." D PRINT(Y)
;
QUIT ;
QUIT
;
PRINT(Y) ;
N ADP,FTOT,RTOT,OTOT,PRCTOT,RPTOT,Q,PKGIEN,PKGNAME,PKGPFX
S PKGNAME=$P(Y,"^",2),PKGIEN=+Y
S PKGPFX=$P($G(^DIC(9.4,PKGIEN,0)),"^",2)
I PKGPFX="" W !!,"PREFIX not found for package selected. Unable to continue." Q
;
S (ADP,Q)=0
F S Q=$O(^DIC(9.4,PKGIEN,14,Q)) Q:'Q S ADP=ADP+1,ADP(ADP)=$P($G(^(Q,0)),"^")
;
W !,"...counting...",!," ...files..."
S (Q,FTOT)=0
F S Q=$O(^DIC(9.4,PKGIEN,4,Q)) Q:'Q S FTOT=FTOT+1
;
W !," ...routines..."
S TLCNT=0,RTOT=$$ROUTINE(PKGPFX,.TLCNT)
I ADP F Q=1:1:ADP I ADP(Q)'="" S RTOT=RTOT+$$ROUTINE(ADP(Q),.TLCNT)
;
W !," ...options..."
S OTOT=$$OPTION(PKGPFX)
I ADP F Q=1:1:ADP I ADP(Q)'="" S OTOT=OTOT+$$OPTION(ADP(Q))
;
S PRCTOT=$$PROTOCOL(PKGPFX,PKGIEN)
I ADP F Q=1:1:ADP I ADP(Q)'="" S PRCTOT=PRCTOT+$$PROTOCOL(ADP(Q),PKGIEN)
;
W !," ...remote procedures..."
S RPTOT=$$REMPROC(PKGPFX)
I ADP F Q=1:1:ADP I ADP(Q)'="" S RPTOT=RPTOT+$$REMPROC(ADP(Q))
;
W !!!,"VistA Application Sizing Information"
W !,"Run Date: " D NOW^%DTC S Y=X D DD^%DT W Y
W !,"VistA Application: ",PKGNAME
W !,"=========================================="
W !,"Number of Routines: ",RTOT
W !,"Size of Routines: ",TLCNT
W !,"Number of Files: ",FTOT
W !,"Number of Fields: TBD"
W !,"Number of Options: ",OTOT
W !,"Number of Protocols: ",PRCTOT
W !,"Number of RPCs: ",RPTOT
W !!
Q
;
ROUTINE(PKGPFX,TLCNT) ; Returns total of all characters in all routines, including line feeds on each line of each routine
; Input - PKGPFX : Prefix for routine in package
; - TLCNT : Sum of routine sizes in package
;
; Output - TLCNT : Sum of routine sizes incremented by routines in PKGPFX
;
NEW CNT,LPPFX,PFXLN,Y,I,X
SET PFXLN=$L(PKGPFX)
SET CNT=0
SET LPPFX=$O(^DIC(9.8,"B",PKGPFX),-1)
FOR SET LPPFX=$O(^DIC(9.8,"B",LPPFX)) Q:$E(LPPFX,1,PFXLN)'=PKGPFX DO
. SET X=LPPFX
. X ^%ZOSF("TEST") IF $T SET TLCNT=TLCNT+$$RSIZE(LPPFX) S CNT=CNT+1
Q CNT
;
PROTOCOL(PKGPFX,PKGIEN) ; ;;TO DO: GTS - REMOVE NOTE **UNIT TESTED**
NEW CNT,Q,QL,ORDIEN
SET CNT=0
SET Q="",QL=$L(PKGPFX)
SET ORDIEN=0
FOR S ORDIEN=$O(^ORD(101,ORDIEN)) Q:+ORDIEN'>0 I ($P(^ORD(101,ORDIEN,0),"^",12)=PKGIEN) S CNT=CNT+1
Q CNT
;
REMPROC(PKGPFX) ;;TO DO: GTS - REMOVE NOTE **UNIT TESTED**
NEW CNT,LPPFX,PFXLN
SET PFXLN=$L(PKGPFX)
SET CNT=0
SET LPPFX=$O(^XWB(8994,"B",PKGPFX),-1)
FOR SET LPPFX=$O(^XWB(8994,"B",LPPFX)) Q:$E(LPPFX,1,PFXLN)'=PKGPFX S CNT=CNT+1
Q CNT
;
OPTION(PKGPFX) ;;TO DO: GTS - REMOVE NOTE **UNIT TESTED**
;
NEW CNT,LPPFX,PFXLN
SET PFXLN=$L(PKGPFX)
SET CNT=0
SET LPPFX=$O(^DIC(19,"B",PKGPFX),-1)
FOR SET LPPFX=$O(^DIC(19,"B",LPPFX)) Q:$E(LPPFX,1,PFXLN)'=PKGPFX S CNT=CNT+1
Q CNT
;
;APIs
LPVAR(PKGIEN,PKGNAME,CLASS) ;Set Package Name and Class for loop
; Input: PKGIEN - Package file 9.4 IEN
;
; Output: PKGNAME - NAME field(#.01) from Package file (9.4) [Return via reference]
; CLASS - CLASS field (#11.3) from Package file [Return via reference]
;
SET PKGNAME=$GET(^DIC(9.4,PKGIEN,0))
SET CLASS=$P($GET(^DIC(9.4,PKGIEN,7)),"^",3)
QUIT
;
CHKHOST() ;Function to prompt user - indicate host file need
;Return Y(0) as defined by ^DIR for a Y/N prompt
;
NEW DIR,Y,X
SET DIR(0)="Y^A^"
SET DIR("A")="Do you want to create a '^' delimited Host File"
SET DIR("A",1)=" "
SET DIR("A",2)="You selected to report Delimted (^) Data, Sorted by PACKAGE NAME."
SET DIR("B")="YES"
SET DIR("?")="Enter 'YES' to create a Host File in addition to the report."
DO ^DIR
QUIT $G(Y(0))
;
SELFILE(FILENME,STORPATH) ; Select Filename and Directory location
NEW DIR,Y,X
SET (FILENME,STORPATH)=""
NEW DIR,Y,X
SET DIR(0)="FAOr^2:60^"
SET DIR("A")="Enter directory to write HOST file: "_$$DEFDIR^%ZISH("")
SET DIR("A",1)=" "
SET DIR("B")=""
SET DIR("?")="Enter '^' to abort Host File creation."
SET DIR("?",1)="Enter a host directory where you have write priveleges"
SET DIR("?",2)=" and at least 10K of space."
SET DIR("?",3)=" "
DO ^DIR
;
IF '$D(DTOUT),'$D(DUOUT),'$D(DIROUT) DO
. SET:X]"" STORPATH=X
. SET:X']"" STORPATH=$$DEFDIR^%ZISH("")
. SET DIR(0)="FAOr^3:30^"
. SET DIR("A")="Enter the name of the Host File: "_STORPATH
. SET DIR("A",1)=" "
. SET DIR("B")="VistAPkgSize_"_$P($$NOW^XLFDT,".",1)_$P($$NOW^XLFDT,".",2)_".txt"
. SET DIR("?")="Enter '^' to abort Host File creation."
. SET DIR("?",1)="the file will be written to "_STORPATH
. DO ^DIR
. IF '$D(DTOUT),'$D(DUOUT),'$D(DIROUT) DO
.. SET FILENME=Y
IF $D(DTOUT)!$D(DUOUT)!$D(DIROUT) SET (FILENME,STORPATH)=""
QUIT
;
FILABORT(CRTHOST,FILENME,STORPATH) ;Host file selected but File name and path not entered
;Return NULL values for CRTHOST, FILENME, & STORPATH via reference
;
NEW DIR,Y,X
SET DIR(0)="E^A^"
SET DIR("A")="Press Enter/Return to continue PRINTING report"
SET DIR("A",1)=" "
SET DIR("A",2)=" You selected to create a Host File but did not enter the file name and path."
SET DIR("A",3)=" <<Host File will NOT be created!>>"
SET DIR("A",4)=" "
DO ^DIR
SET (CRTHOST,FILENME,STORPATH)=""
QUIT
;
RSIZE(RTN) ; Compute routine size (# characters plus line feeds) [^%ZOSF("SIZE") algorithm]
NEW LINE,CT,RSIZEVAL
SET (CT,RSIZEVAL)=0
SET LINE=""
X "ZL @RTN F S CT=CT+1,LINE=$T(+CT) Q:$L(LINE)=0 SET RSIZEVAL=RSIZEVAL+$L(LINE)+2"
QUIT RSIZEVAL
;
RLOAD(PKGPFX) ; Load a routine into ^XTMP("XUVPS") for parsing
SET X=PKGPFX,XCNP=0,DIF="^XTMP(""XUVPS"","_$J_",1,PKGPFX,0," X ^%ZOSF("TEST") Q:'$T X ^%ZOSF("LOAD") S ^XTMP("XUVPS",$J,1,PKGPFX,0,0)=XCNP-1
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUVPS 12604 printed Apr 09, 2024@21:10:09 Page 2
XUVPS ; Bham FO/CML3/gts - VistA Package Sizing; ; 02 Mar 2016 9:05 AM
+1 ;;8.0;KERNEL;;Jul 10, 1995;Build 1
+2 ;;
INIT ;;
+1 ;; data variables (local, for each package)
+2 ;; PKGIEN = Package IEN
+3 ;; PKGNAME = Package NAME (.01 - $P(^(0),"^",1))
+4 ;; PKGPFX = Package PREFIX / NAMESPACE (1 - $P(^(0),"^",2))
+5 ;;
+6 ;; RTOT = total ROUTINEs
+7 ;; TLCNT = total SIZE of all ROUTINES
+8 ;; FTOT = total FILEs
+9 ;; FLDTOT = total FIELDs of all FILES
+10 ;; OTOT = total OPTIONs (^DIC(19,)
+11 ;; PRCTOT = total PROTOCOLs (^ORD(101,)
+12 ;; RPTOT = total REMOTE PROCEDUREs (^XWB(8994,)
+13 ;;
+14 IF $GET(DUZ)=""
WRITE !!,"DUZ must be defined."
QUIT
+15 ;
+16 NEW X,Y
+17 ;
ALL ;
+1 WRITE !!,"VistA Package Sizing Report",!
+2 NEW DIR
SET DIR(0)="YA"
SET DIR("B")="NO"
+3 SET DIR("A")="Do you want to print Sizing Information for ALL VistA Packages? "
+4 DO ^DIR
IF Y'=1
IF Y'=0
GOTO QUIT
+5 IF Y'=1
GOTO SELPKG
+6 ;;S VPSALL=Y ;TO DO: GTS - REMOVE if not needed
+7 ;
SORT ;
+1 NEW DIR,XUVPSORT
+2 SET DIR("A")="Select Display Method"
+3 SET DIR(0)="S^1:SORTED BY PKG NAMES;2:SORTED BY NUMBER OF ROUTINES - HIGH TO LOW;3:SORTED BY TOTAL SIZE OF PKG ROUTINES - HIGH TO LOW;4:SORTED BY PKG NAME, DATA DELIMITED (BY CARET), NO ADDED SPACING"
+4 SET DIR("L")=" 4. Delimited (^) Data, Sorted by PACKAGE NAME"
+5 SET DIR("L",1)="Select which method to display the package data: "
+6 SET DIR("L",2)=""
+7 SET DIR("L",3)=" 1. Sorted by PACKAGE NAME"
+8 SET DIR("L",4)=" 2. Sorted by NUMBER of ROUTINES (Highest to Lowest)"
+9 SET DIR("L",5)=" 3. Sorted by TOTAL ROUTINE SIZE (Highest to Lowest)"
+10 DO ^DIR
if 'Y
GOTO QUIT
SET XUVPSORT=+Y
+11 ;
DEVICE ;
+1 KILL %ZIS,IO("Q"),IOP
SET %ZIS="MQ"
SET %ZIS("B")=""
+2 NEW CRTHOST,FILENME,STORPATH,TSKD
+3 SET (CRTHOST,FILENME,STORPATH)=""
+4 SET TSKD=0
+5 IF XUVPSORT=4
SET CRTHOST=$$CHKHOST()
+6 IF CRTHOST="YES"
Begin DoDot:1
+7 DO SELFILE(.FILENME,.STORPATH)
+8 IF (FILENME="")!(STORPATH="")
DO FILABORT(.CRTHOST,.FILENME,.STORPATH)
SET CRTHOST="NO"
+9 IF (FILENME]"")
IF (STORPATH]"")
Begin DoDot:2
+10 SET ZTIO=""
+11 ;Invoke Loop for report of All packages
SET ZTRTN="LOOP^XUVPS"
SET ZTDESC="VistA Application Sizing Host File"
+12 SET ZTSAVE("*")=""
DO ^%ZTLOAD
+13 WRITE !!,"Host File creation ",$SELECT($DATA(ZTSK)#2:"Queued.",1:"Aborted.")
End DoDot:2
End DoDot:1
+14 ;
+15 IF ((XUVPSORT=4)&(CRTHOST="NO"))!(XUVPSORT'=4)
Begin DoDot:1
+16 WRITE !!,"It will take a considerable amount of time to run this report for ALL",!,"PACKAGES as you have requested. Therefore it is highly recommended that",!,"you QUEUE this report. The report can be queued to run NOW and queuing "
+17 WRITE "this",!,"report will free up your terminal, allowing you to continue working while",!,"this report runs."
+18 WRITE !
DO ^%ZIS
IF POP
DO HOME^%ZIS
WRITE !,"NO DEVICE SELECTED."
GOTO QUIT
+19 IF $DATA(IO("Q"))
Begin DoDot:2
+20 SET TSKD=1
+21 ;Invoke Loop for report of All packages
SET ZTRTN="LOOP^XUVPS"
SET ZTDESC="VistA Application Sizing Display"
+22 SET ZTSAVE("*")=""
DO ^%ZTLOAD
WRITE !!,"Display ",$SELECT($DATA(ZTSK)#2:"Queued.",1:"Aborted.")
End DoDot:2
GOTO QUIT
+23 IF '$DATA(IO("Q"))
DO LOOP^XUVPS
End DoDot:1
+24 QUIT
+25 ;
LOOP ;
+1 KILL ^TMP("XUVPS",$JOB),^TMP("XUVPS0",$JOB)
+2 NEW D1,D2,D3,D4,D5,D6,D7,D8,D9,QA,S1,S2,CLASS,FNUM
+3 NEW ADP,FLDTOT,FTOT,PKGIEN,PKGNAME,PKGPFX,PTOT,RPTOT,RTOT,TLCNT,VPSFAT,OTOT
+4 SET S1=""
SET (D1,D2,D3,D4,D5,D6)=0
+5 ;
FOR
SET S1=$ORDER(^DIC(9.4,"B",S1))
if S1=""
QUIT
if 'TSKD
WRITE "."
SET S2=0
FOR
SET S2=$ORDER(^DIC(9.4,"B",S1,S2))
if 'S2
QUIT
DO LPVAR(S2,.PKGNAME,.CLASS)
IF PKGNAME]""
IF CLASS="I"
Begin DoDot:1
+6 SET PKGPFX=$PIECE(PKGNAME,"^",2)
SET PKGNAME=$PIECE(PKGNAME,"^")
SET PKGIEN=S2
+7 SET (FTOT,OTOT,PTOT,RPTOT,RTOT,TLCNT)=0
SET FLDTOT="TBD"
+8 SET QA=0
+9 FOR
SET QA=$ORDER(^DIC(9.4,PKGIEN,4,QA))
if 'QA
QUIT
Begin DoDot:2
+10 KILL VPSFAT
+11 SET FNUM=$PIECE($GET(^DIC(9.4,PKGIEN,4,QA,0)),"^")
+12 DO FILE^DID(FNUM,"","NAME","VPSFAT")
+13 IF $DATA(VPSFAT("NAME"))
SET FTOT=FTOT+1
End DoDot:2
+14 SET RTOT=$$ROUTINE(PKGPFX,.TLCNT)
+15 SET OTOT=$$OPTION(PKGPFX)
+16 SET PTOT=$$PROTOCOL(PKGPFX,PKGIEN)
+17 SET RPTOT=$$REMPROC(PKGPFX)
+18 KILL ADP
+19 SET (ADP,QA)=0
+20 FOR
SET QA=$ORDER(^DIC(9.4,PKGIEN,14,QA))
if 'QA
QUIT
SET ADP=ADP+1
SET ADP(ADP)=$PIECE($GET(^(QA,0)),"^")
+21 ;
IF ADP
FOR QA=1:1:ADP
IF ADP(QA)]""
Begin DoDot:2
+22 SET RTOT=RTOT+$$ROUTINE(ADP(QA),.TLCNT)
+23 SET OTOT=OTOT+$$OPTION(ADP(QA))
+24 SET RPTOT=RPTOT+$$REMPROC(ADP(QA))
End DoDot:2
+25 SET D1=$GET(^TMP("XUVPS",$JOB,PKGNAME,PKGPFX))
SET D9=$PIECE(D1,"^",7)
SET D8=$PIECE(D1,"^",6)
+26 SET D7=$PIECE(D1,"^",5)
SET D5=$PIECE(D1,"^",3)
SET D4=$PIECE(D1,"^",2)
SET D3=+D1
+27 SET ^TMP("XUVPS",$JOB,PKGNAME,PKGPFX)=(D3+RTOT)_"^"_(D4+TLCNT)_"^"_(D5+FTOT)_"^^"_(D6+OTOT)_"^"_(D7+PTOT)_"^"_(D8+RPTOT)
End DoDot:1
+28 IF XUVPSORT=2
SET D1=""
FOR
SET D1=$ORDER(^TMP("XUVPS",$JOB,D1))
if D1=""
QUIT
SET D2=""
FOR
SET D2=$ORDER(^TMP("XUVPS",$JOB,D1,D2))
if D2=""
QUIT
SET X=$GET(^(D2))
SET ^TMP("XUVPS0",$JOB,+X,D1,D2)=$PIECE(X,"^",2,7)
+29 IF XUVPSORT=3
SET D1=""
FOR
SET D1=$ORDER(^TMP("XUVPS",$JOB,D1))
if D1=""
QUIT
SET D2=""
FOR
SET D2=$ORDER(^TMP("XUVPS",$JOB,D1,D2))
if D2=""
QUIT
SET X=$GET(^(D2))
SET ^TMP("XUVPS0",$JOB,+$PIECE(X,"^",2),D1,D2)=+X_"^"_$PIECE(X,"^",3,7)
+30 ;
DISALL ;
+1 ; display option 4 has no formatting, and is used for creating
+2 ; spreadsheets, for which the following heading lines are not needed
+3 ;
IF XUVPSORT'=4
Begin DoDot:1
+4 WRITE @IOF,"VistA Application Sizing Information"
+5 WRITE !!!!,"Application",?29,"Routines Total Files Files Fields Options Protocols RPCs"
+6 WRITE !?2,"(Namespace)",?38,"Routine",!?39,"Size",?60,XUVPSORT
+7 WRITE !,"================================================================================"
End DoDot:1
+8 ;
DAD ;
+1 IF XUVPSORT=2!(XUVPSORT=3)
SET S3=""
FOR
SET S3=$ORDER(^TMP("XUVPS0",$JOB,S3),-1)
SET D3=S3
if S3=""
QUIT
SET D1=""
FOR
SET D1=$ORDER(^TMP("XUVPS0",$JOB,S3,D1))
if D1=""
QUIT
SET D2=""
FOR
SET D2=$ORDER(^TMP("XUVPS0",$JOB,S3,D1,D2))
if D2=""
QUIT
DO PDAD(XUVPSORT,$GET(^(D2)),D1,D2,D3)
+2 IF XUVPSORT=1!(XUVPSORT=4)
Begin DoDot:1
+3 NEW POPERR
+4 SET (D1,POPERR)=""
+5 ;
+6 ;If write delimited report to a file
+7 IF FILENME]""
Begin DoDot:2
+8 DO OPEN^%ZISH("DELIMFL1",STORPATH,FILENME,"A")
+9 if POP
SET POPERR=POP
+10 if POPERR
QUIT
+11 USE IO
End DoDot:2
if POPERR
QUIT
+12 ;
+13 FOR
SET D1=$ORDER(^TMP("XUVPS",$JOB,D1))
if D1=""
QUIT
SET D2=""
Begin DoDot:2
+14 FOR
SET D2=$ORDER(^TMP("XUVPS",$JOB,D1,D2))
if D2=""
QUIT
Begin DoDot:3
+15 DO PDAD(XUVPSORT,$GET(^(D2)),D1,D2,"")
End DoDot:3
End DoDot:2
+16 IF FILENME]""
DO CLOSE^%ZISH("DELIMFL1")
End DoDot:1
+17 ;
+18 ;If write delimited report to a file
+19 IF (XUVPSORT=4)
IF ($GET(POPERR))
Begin DoDot:1
+20 WRITE !!,"ERROR: "_FILENME_" file creation in "_STORPATH_" FAILED!!"
+21 WRITE !," >>Check path and filename.<<"
End DoDot:1
+22 KILL ^TMP("XUVPS",$JOB),^TMP("XUVPS0",$JOB)
+23 QUIT
+24 ;
PDAD(XUVPSORT,DATA,D1,D2,D3) ; print actual data (finally)
+1 NEW D4,D5,D6,D7,D8,D9,DATANDE
SET D6="TBD"
+2 IF XUVPSORT=1!(XUVPSORT=4)
SET D4=$PIECE(DATA,"^",2)
SET D5=$PIECE(DATA,"^",3)
SET D7=$PIECE(DATA,"^",5)
SET D8=$PIECE(DATA,"^",6)
SET D9=$PIECE(DATA,"^",7)
SET D3=+DATA
+3 IF XUVPSORT=4
Begin DoDot:1
+4 SET DATANDE=""
+5 SET DATANDE=D1_"^"_D2_"^"_D3_"^"_D4_"^"_D5_"^"_D6_"^"_D7_"^"_D8_"^"_D9
+6 WRITE !,DATANDE
End DoDot:1
QUIT
+7 IF XUVPSORT=2!(XUVPSORT=3)
SET D5=$PIECE(DATA,"^",2)
SET D7=$PIECE(DATA,"^",4)
SET D8=$PIECE(DATA,"^",5)
SET D9=$PIECE(DATA,"^",6)
if XUVPSORT=2
SET D4=+DATA
if XUVPSORT=3
SET D4=D3
SET D3=+DATA
+8 ;
+9 ;If writing report to printer...
+10 WRITE !,D1,?31,$JUSTIFY(D3,6)," ",$JUSTIFY(D4,9)," ",$JUSTIFY(D5,4)," ",$JUSTIFY(D6,6)," ",$JUSTIFY(D7,6)," ",$JUSTIFY(D8,6)," ",$JUSTIFY(D9,6)
+11 WRITE !,"(",D2,")",!,"--------------------------------------------------------------------------------"
+12 QUIT
+13 ;
SELPKG ;
+1 SET DIC=9.4
SET DIC(0)="AEMQ"
SET DIC("S")="I $D(^(7)),$P(^(7),""^"",3)=""I"""
+2 WRITE !
DO ^DIC
+3 IF Y>0
WRITE !!!!,"...working..."
DO PRINT(Y)
+4 ;
QUIT ;
+1 QUIT
+2 ;
PRINT(Y) ;
+1 NEW ADP,FTOT,RTOT,OTOT,PRCTOT,RPTOT,Q,PKGIEN,PKGNAME,PKGPFX
+2 SET PKGNAME=$PIECE(Y,"^",2)
SET PKGIEN=+Y
+3 SET PKGPFX=$PIECE($GET(^DIC(9.4,PKGIEN,0)),"^",2)
+4 IF PKGPFX=""
WRITE !!,"PREFIX not found for package selected. Unable to continue."
QUIT
+5 ;
+6 SET (ADP,Q)=0
+7 FOR
SET Q=$ORDER(^DIC(9.4,PKGIEN,14,Q))
if 'Q
QUIT
SET ADP=ADP+1
SET ADP(ADP)=$PIECE($GET(^(Q,0)),"^")
+8 ;
+9 WRITE !,"...counting...",!," ...files..."
+10 SET (Q,FTOT)=0
+11 FOR
SET Q=$ORDER(^DIC(9.4,PKGIEN,4,Q))
if 'Q
QUIT
SET FTOT=FTOT+1
+12 ;
+13 WRITE !," ...routines..."
+14 SET TLCNT=0
SET RTOT=$$ROUTINE(PKGPFX,.TLCNT)
+15 IF ADP
FOR Q=1:1:ADP
IF ADP(Q)'=""
SET RTOT=RTOT+$$ROUTINE(ADP(Q),.TLCNT)
+16 ;
+17 WRITE !," ...options..."
+18 SET OTOT=$$OPTION(PKGPFX)
+19 IF ADP
FOR Q=1:1:ADP
IF ADP(Q)'=""
SET OTOT=OTOT+$$OPTION(ADP(Q))
+20 ;
+21 SET PRCTOT=$$PROTOCOL(PKGPFX,PKGIEN)
+22 IF ADP
FOR Q=1:1:ADP
IF ADP(Q)'=""
SET PRCTOT=PRCTOT+$$PROTOCOL(ADP(Q),PKGIEN)
+23 ;
+24 WRITE !," ...remote procedures..."
+25 SET RPTOT=$$REMPROC(PKGPFX)
+26 IF ADP
FOR Q=1:1:ADP
IF ADP(Q)'=""
SET RPTOT=RPTOT+$$REMPROC(ADP(Q))
+27 ;
+28 WRITE !!!,"VistA Application Sizing Information"
+29 WRITE !,"Run Date: "
DO NOW^%DTC
SET Y=X
DO DD^%DT
WRITE Y
+30 WRITE !,"VistA Application: ",PKGNAME
+31 WRITE !,"=========================================="
+32 WRITE !,"Number of Routines: ",RTOT
+33 WRITE !,"Size of Routines: ",TLCNT
+34 WRITE !,"Number of Files: ",FTOT
+35 WRITE !,"Number of Fields: TBD"
+36 WRITE !,"Number of Options: ",OTOT
+37 WRITE !,"Number of Protocols: ",PRCTOT
+38 WRITE !,"Number of RPCs: ",RPTOT
+39 WRITE !!
+40 QUIT
+41 ;
ROUTINE(PKGPFX,TLCNT) ; Returns total of all characters in all routines, including line feeds on each line of each routine
+1 ; Input - PKGPFX : Prefix for routine in package
+2 ; - TLCNT : Sum of routine sizes in package
+3 ;
+4 ; Output - TLCNT : Sum of routine sizes incremented by routines in PKGPFX
+5 ;
+6 NEW CNT,LPPFX,PFXLN,Y,I,X
+7 SET PFXLN=$LENGTH(PKGPFX)
+8 SET CNT=0
+9 SET LPPFX=$ORDER(^DIC(9.8,"B",PKGPFX),-1)
+10 FOR
SET LPPFX=$ORDER(^DIC(9.8,"B",LPPFX))
if $EXTRACT(LPPFX,1,PFXLN)'=PKGPFX
QUIT
Begin DoDot:1
+11 SET X=LPPFX
+12 XECUTE ^%ZOSF("TEST")
IF $TEST
SET TLCNT=TLCNT+$$RSIZE(LPPFX)
SET CNT=CNT+1
End DoDot:1
+13 QUIT CNT
+14 ;
PROTOCOL(PKGPFX,PKGIEN) ; ;;TO DO: GTS - REMOVE NOTE **UNIT TESTED**
+1 NEW CNT,Q,QL,ORDIEN
+2 SET CNT=0
+3 SET Q=""
SET QL=$LENGTH(PKGPFX)
+4 SET ORDIEN=0
+5 FOR
SET ORDIEN=$ORDER(^ORD(101,ORDIEN))
if +ORDIEN'>0
QUIT
IF ($PIECE(^ORD(101,ORDIEN,0),"^",12)=PKGIEN)
SET CNT=CNT+1
+6 QUIT CNT
+7 ;
REMPROC(PKGPFX) ;;TO DO: GTS - REMOVE NOTE **UNIT TESTED**
+1 NEW CNT,LPPFX,PFXLN
+2 SET PFXLN=$LENGTH(PKGPFX)
+3 SET CNT=0
+4 SET LPPFX=$ORDER(^XWB(8994,"B",PKGPFX),-1)
+5 FOR
SET LPPFX=$ORDER(^XWB(8994,"B",LPPFX))
if $EXTRACT(LPPFX,1,PFXLN)'=PKGPFX
QUIT
SET CNT=CNT+1
+6 QUIT CNT
+7 ;
OPTION(PKGPFX) ;;TO DO: GTS - REMOVE NOTE **UNIT TESTED**
+1 ;
+2 NEW CNT,LPPFX,PFXLN
+3 SET PFXLN=$LENGTH(PKGPFX)
+4 SET CNT=0
+5 SET LPPFX=$ORDER(^DIC(19,"B",PKGPFX),-1)
+6 FOR
SET LPPFX=$ORDER(^DIC(19,"B",LPPFX))
if $EXTRACT(LPPFX,1,PFXLN)'=PKGPFX
QUIT
SET CNT=CNT+1
+7 QUIT CNT
+8 ;
+9 ;APIs
LPVAR(PKGIEN,PKGNAME,CLASS) ;Set Package Name and Class for loop
+1 ; Input: PKGIEN - Package file 9.4 IEN
+2 ;
+3 ; Output: PKGNAME - NAME field(#.01) from Package file (9.4) [Return via reference]
+4 ; CLASS - CLASS field (#11.3) from Package file [Return via reference]
+5 ;
+6 SET PKGNAME=$GET(^DIC(9.4,PKGIEN,0))
+7 SET CLASS=$PIECE($GET(^DIC(9.4,PKGIEN,7)),"^",3)
+8 QUIT
+9 ;
CHKHOST() ;Function to prompt user - indicate host file need
+1 ;Return Y(0) as defined by ^DIR for a Y/N prompt
+2 ;
+3 NEW DIR,Y,X
+4 SET DIR(0)="Y^A^"
+5 SET DIR("A")="Do you want to create a '^' delimited Host File"
+6 SET DIR("A",1)=" "
+7 SET DIR("A",2)="You selected to report Delimted (^) Data, Sorted by PACKAGE NAME."
+8 SET DIR("B")="YES"
+9 SET DIR("?")="Enter 'YES' to create a Host File in addition to the report."
+10 DO ^DIR
+11 QUIT $GET(Y(0))
+12 ;
SELFILE(FILENME,STORPATH) ; Select Filename and Directory location
+1 NEW DIR,Y,X
+2 SET (FILENME,STORPATH)=""
+3 NEW DIR,Y,X
+4 SET DIR(0)="FAOr^2:60^"
+5 SET DIR("A")="Enter directory to write HOST file: "_$$DEFDIR^%ZISH("")
+6 SET DIR("A",1)=" "
+7 SET DIR("B")=""
+8 SET DIR("?")="Enter '^' to abort Host File creation."
+9 SET DIR("?",1)="Enter a host directory where you have write priveleges"
+10 SET DIR("?",2)=" and at least 10K of space."
+11 SET DIR("?",3)=" "
+12 DO ^DIR
+13 ;
+14 IF '$DATA(DTOUT)
IF '$DATA(DUOUT)
IF '$DATA(DIROUT)
Begin DoDot:1
+15 if X]""
SET STORPATH=X
+16 if X']""
SET STORPATH=$$DEFDIR^%ZISH("")
+17 SET DIR(0)="FAOr^3:30^"
+18 SET DIR("A")="Enter the name of the Host File: "_STORPATH
+19 SET DIR("A",1)=" "
+20 SET DIR("B")="VistAPkgSize_"_$PIECE($$NOW^XLFDT,".",1)_$PIECE($$NOW^XLFDT,".",2)_".txt"
+21 SET DIR("?")="Enter '^' to abort Host File creation."
+22 SET DIR("?",1)="the file will be written to "_STORPATH
+23 DO ^DIR
+24 IF '$DATA(DTOUT)
IF '$DATA(DUOUT)
IF '$DATA(DIROUT)
Begin DoDot:2
+25 SET FILENME=Y
End DoDot:2
End DoDot:1
+26 IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
SET (FILENME,STORPATH)=""
+27 QUIT
+28 ;
FILABORT(CRTHOST,FILENME,STORPATH) ;Host file selected but File name and path not entered
+1 ;Return NULL values for CRTHOST, FILENME, & STORPATH via reference
+2 ;
+3 NEW DIR,Y,X
+4 SET DIR(0)="E^A^"
+5 SET DIR("A")="Press Enter/Return to continue PRINTING report"
+6 SET DIR("A",1)=" "
+7 SET DIR("A",2)=" You selected to create a Host File but did not enter the file name and path."
+8 SET DIR("A",3)=" <<Host File will NOT be created!>>"
+9 SET DIR("A",4)=" "
+10 DO ^DIR
+11 SET (CRTHOST,FILENME,STORPATH)=""
+12 QUIT
+13 ;
RSIZE(RTN) ; Compute routine size (# characters plus line feeds) [^%ZOSF("SIZE") algorithm]
+1 NEW LINE,CT,RSIZEVAL
+2 SET (CT,RSIZEVAL)=0
+3 SET LINE=""
+4 XECUTE "ZL @RTN F S CT=CT+1,LINE=$T(+CT) Q:$L(LINE)=0 SET RSIZEVAL=RSIZEVAL+$L(LINE)+2"
+5 QUIT RSIZEVAL
+6 ;
RLOAD(PKGPFX) ; Load a routine into ^XTMP("XUVPS") for parsing
+1 SET X=PKGPFX
SET XCNP=0
SET DIF="^XTMP(""XUVPS"","_$JOB_",1,PKGPFX,0,"
XECUTE ^%ZOSF("TEST")
if '$TEST
QUIT
XECUTE ^%ZOSF("LOAD")
SET ^XTMP("XUVPS",$JOB,1,PKGPFX,0,0)=XCNP-1
+2 QUIT
