A1VSRFL ;Bham FO/CML3{Albany FO/GTS} - VistA Package Sizing Manager; 27-JUN-2016
;;1.0;VistA Package Sizing;;Oct 10, 2016;Build 25
;;
INIT(VALMCNT,A1VPSPRM) ;;
;;INPUT:
; VALMCNT - Current Node # on ListMan ^TMP("A1VS PKG MGR RPT",$JOB) global
; A1VPSPRM - Package Parameter file to report against
;
;; 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,)
;; TPLTTOT = total Fileman Templates
;;
I $G(DUZ)="" W !!,"DUZ must be defined." Q
;
N X,Y,EXTDIR,DISSORT
;
ALL ;
W !!,"VistA Package Sizing Report",!
S EXTDIR=$$GET^XPAR("SYS","A1VS PACKAGE MGR DEFAULT DIR",1,"I") ;EXTDIR = Directory storing XTMPSIZE.DAT
N DIR S DIR(0)="YA",DIR("B")="NO"
S DIR("A")="Do you want to display Sizing Information for ALL VistA Packages? "
S DIR("?",1)="A Size report for ALL VistA Packages requires the "_A1VPSPRM_"file"
S DIR("?",2)=" to be stored in "_EXTDIR_"."
S DIR("?",3)=A1VPSPRM_" is an extract of Package file data from Forum or other VistA."
S DIR("?",4)=" Reporting a single package will count components on VistA based on"
S DIR("?",5)=" the local VistA Package file parameters defined for the package."
S DIR("?",6)=""
S DIR("?")="Enter Yes to report All packages; No to report a Single package."
D ^DIR I Y'=1,Y'=0 G KWIT
IF Y'=1 GOTO ONEPKG
;
SORT ;
N DIR S DIR("A")="Select VistA Size Report"
S DIR(0)="S^1:SORT ON PKG NAMES;2:SORT ON # OF ROUTINES - HIGH TO LOW;"
S DIR(0)=DIR(0)_"3:SORT ON PKG ROUTINES SIZE TOTAL - HIGH TO LOW;"
S DIR(0)=DIR(0)_"4:SORT ON PKG NAME, CARET DELIMITED DATA;"
S DIR(0)=DIR(0)_"5:SORT ON PKG NAME INCLUDE PARENT PKG, CARET DELIMITED DATA"
S DIR("L")=" 5. Delimited (^) Data with PARENT PKG, Sorted by PACKAGE NAME"
S DIR("L",1)="Select which method to display the package size data: "
S DIR("L",2)=""
S DIR("L",3)=" 1. Sorted on PACKAGE NAME"
S DIR("L",4)=" 2. Sorted on NUMBER of ROUTINES (Highest to Lowest)"
S DIR("L",5)=" 3. Sorted on TOTAL ROUTINE SIZE (Highest to Lowest)"
S DIR("L",6)=" 4. Delimited (^) Data, Sorted on PACKAGE NAME"
D ^DIR G:'Y KWIT S DISSORT=+Y
;
DO LOOP(.VALMCNT)
QUIT
;
LOOP(VALMCNT) ; Loop through all entries in the Package parameters file
KILL ^TMP("ZZVPS",$J),^TMP("A1VS-FORUMPKG",$J),^TMP("A1VS-PREFIX-IDX",$J),^TMP("A1VS-FORUM-PFXS",$J)
KILL ^TMP("ZZVPS0",$J),^TMP("A1VS-IDX-PKG",$J),^TMP("A1VS-KIDSPFX-IDX",$J)
NEW D1,D2,D3,POPERR,LNNUM,A1CHAR,TMPSUB,APFXLST,RPFXLST,PCENUM,LINEITEM,PKGNAME,PKGPFX
NEW APFX,RPFX,ADDPRFX,PREFIX,PRNTPKG,FTOT,OTOT,PTOT,RPTOT,RTOT,TLCNT,TPLTTOT,FLDTOT,PKGIEN
SET (D1,D2,D3)=0
SET POPERR=0
DO OPEN^%ZISH("XTMP",EXTDIR,A1VPSPRM,"R")
SET:POP POPERR=POP
QUIT:POPERR
U IO
SET LNNUM=0
FOR S LINEITEM="" READ LINEITEM:5 Q:$$STATUS^%ZISH DO
.IF LINEITEM]"" DO
..S LNNUM=LNNUM+1
..SET ^TMP("A1VS-FORUMPKG",$J,LNNUM)=LINEITEM
D CLOSE^%ZISH("XTMP")
;
DO KIDSIDX^A1VSRFL1() ;Create Prefix-Package Indicies from KIDS
;
;Create Prefix Indicies
SET TMPSUB=0
FOR SET TMPSUB=$O(^TMP("A1VS-FORUMPKG",$J,TMPSUB)) QUIT:TMPSUB="" DO
.SET LINEITEM=^TMP("A1VS-FORUMPKG",$J,TMPSUB)
.SET PKGNAME=$P(LINEITEM,"^")
.SET PKGPFX=$P(LINEITEM,"^",2)
.SET ^TMP("A1VS-PREFIX-IDX",$J,PKGNAME,PKGPFX)="" ;Pkg-Name,Prefix
.SET ^TMP("A1VS-FORUM-PFXS",$J,PKGPFX)="" ;Prefix
.SET ^TMP("A1VS-IDX-PKG",$J,$P(LINEITEM,"^",2),$P(LINEITEM,"^"))=$S($D(^TMP("A1VA-KIDSPFX-IDX",$J,$P(LINEITEM,"^",2))):1,1:"") ;Prefix,Pkg-Name ;GTS - TO DO: Determine if want this Index
.;
.SET ADDPRFX=$P(LINEITEM,"^",5)
.SET LPCNT=0
.FOR PCENUM=1:1 SET PREFIX=$P(ADDPRFX,"|",PCENUM) Q:PREFIX="" DO
.. SET ^TMP("A1VS-PREFIX-IDX",$J,$P(LINEITEM,"^"),PREFIX)="" ;Pkg-Name,Prefix
.. SET ^TMP("A1VS-FORUM-PFXS",$J,PREFIX)="" ;Prefix
.. SET ^TMP("A1VS-IDX-PKG",$J,PREFIX,$P(LINEITEM,"^"))="" ;Prefix,Pkg-Name (add Prefix) ;GTS - TO DO: Determine if want this Index
;
;Count components - ^TMP Global loop
WRITE !,"Compiling component totals for selected Package data file... "
SET (TMPSUB,A1CHAR)=0
FOR SET TMPSUB=$O(^TMP("A1VS-FORUMPKG",$J,TMPSUB)) QUIT:TMPSUB="" DO HANGCHAR^A1VSLAPI(.A1CHAR) DO
.SET LINEITEM=^TMP("A1VS-FORUMPKG",$J,TMPSUB)
.SET PKGNAME=$P(LINEITEM,"^")
.SET PKGIEN=$O(^DIC(9.4,"B",PKGNAME,""))
.SET PKGPFX=$P(LINEITEM,"^",2)
.SET (FTOT,OTOT,PTOT,RPTOT,RTOT,TLCNT,TPLTTOT)=0,FLDTOT="TBD"
.;
.;Count files - entry in ^TMP global loop
.SET FTOT=$$COUNTFLS^A1VSRFL1(PKGPFX,$P(LINEITEM,"^",3),$P(LINEITEM,"^",4),$P(LINEITEM,"^",7),$P(LINEITEM,"^",8))
.;
.;Define Excepted & Additional Prefix Arrays
.KILL RDP,ADP
.SET RPFXLST=$P(LINEITEM,"^",6)
.SET (RDP,PCENUM)=0
.FOR SET PCENUM=PCENUM+1 SET RPFX=($P(RPFXLST,"|",PCENUM)) QUIT:RPFX']"" DO
.. SET RDP=RDP+1,RDP(RPFX)="" ;RDP = Excepted Namespace
.;
.SET APFXLST=$P(LINEITEM,"^",5)
.SET (ADP,PCENUM)=0
.;
.; NOTE: MULTX will prevent a Primary Prefix for another package from being included as an added prefix to current package
.FOR SET PCENUM=PCENUM+1 SET APFX=($P(APFXLST,"|",PCENUM)) QUIT:APFX']"" S:$$MULTX^A1VSRFL1(APFX,PKGNAME) ADP=ADP+1,ADP(APFX)="" ;ADP = Added Namespace
.;
.SET RTOT=$$ROUTINE^A1VSRFL1(PKGPFX,.TLCNT,.RDP,.ADP)
.;
.SET OTOT=$$OPTION^A1VSRFL1(PKGPFX,PKGNAME,.RDP)
.SET ADDPRFX=""
.FOR SET ADDPRFX=$O(ADP(ADDPRFX)) Q:ADDPRFX="" SET OTOT=OTOT+$$OPTION^A1VSRFL1(ADDPRFX,PKGNAME,.RDP)
.;
.SET PTOT=$$PROTOCOL^A1VSRFL1(PKGPFX,PKGIEN,.RDP,.ADP) ;;Should this loop on Prefix or is Package pointer ok? ;;PKGIEN would not be set for FORUM packages not on local PKG file
.DO CNTR^A1VSRFL1("^XWB(8994,",.RPTOT,PKGPFX,PKGNAME,.RDP,.ADP) ;Count Remote Procedure Calls
.DO CNTR^A1VSRFL1("^DIPT(",.TPLTTOT,PKGPFX,PKGNAME,.RDP,.ADP) ;Count Print Templates
.DO CNTR^A1VSRFL1("^DIBT(",.TPLTTOT,PKGPFX,PKGNAME,.RDP,.ADP) ;Count Sort Templates
.DO CNTR^A1VSRFL1("^DIE(",.TPLTTOT,PKGPFX,PKGNAME,.RDP,.ADP) ;Count Input Templates
.;
.SET:DISSORT'=5 ^TMP("ZZVPS",$J,PKGNAME,PKGPFX)=RTOT_"^"_TLCNT_"^"_FTOT_"^^"_OTOT_"^"_PTOT_"^"_RPTOT_"^"_TPLTTOT
.IF DISSORT=5 DO
..SET PRNTPKG=$P(LINEITEM,"^",9)
..SET ^TMP("ZZVPS",$J,TMPSUB,PKGNAME,PKGPFX)=RTOT_"^"_TLCNT_"^"_FTOT_"^^"_OTOT_"^"_PTOT_"^"_RPTOT_"^"_TPLTTOT_$S(PRNTPKG'=""&PRNTPKG'=PKGNAME:"^"_PRNTPKG,1:"")_$S($P(LINEITEM,"^",10)'="":"^"_$P(LINEITEM,"^",10),1:"")
;
I DISSORT=2 S D1="" F S D1=$O(^TMP("ZZVPS",$J,D1)) Q:D1="" S D2="" F S D2=$O(^TMP("ZZVPS",$J,D1,D2)) Q:D2="" S X=$G(^(D2)),^TMP("ZZVPS0",$J,+X,D1,D2)=$P(X,"^",2,8)
I DISSORT=3 S D1="" F S D1=$O(^TMP("ZZVPS",$J,D1)) Q:D1="" S D2="" F S D2=$O(^TMP("ZZVPS",$J,D1,D2)) Q:D2="" S X=$G(^(D2)),^TMP("ZZVPS0",$J,+$P(X,"^",2),D1,D2)=+X_"^"_$P(X,"^",3,8)
;
DISALL ;
; display option 4 & 5 have no formatting, and are used for creating spreadsheets,
; for which the following heading lines are not needed
I (DISSORT'=4)&(DISSORT'=5) D ;
. DO ADD^A1VSLAPI(.VALMCNT,"VistA Application Sizing Information Sort Type: "_DISSORT)
. DO ADD^A1VSLAPI(.VALMCNT," ")
. DO ADD^A1VSLAPI(.VALMCNT," Total")
. DO ADD^A1VSLAPI(.VALMCNT,"Application Rtn")
. DO ADD^A1VSLAPI(.VALMCNT,"(Namespace) Routines Size Files Fields Options Protocols RPCs Templates")
. DO ADD^A1VSLAPI(.VALMCNT,"================================================================================")
;
DAD ;
NEW S3
I DISSORT=2!(DISSORT=3) S S3="" F S S3=$O(^TMP("ZZVPS0",$J,S3),-1) S D3=S3 Q:S3="" S D1="" F S D1=$O(^TMP("ZZVPS0",$J,S3,D1)) Q:D1="" S D2="" F S D2=$O(^TMP("ZZVPS0",$J,S3,D1,D2)) Q:D2="" D PDAD(DISSORT,$G(^(D2)),D1,D2,D3,.VALMCNT)
I DISSORT=1!(DISSORT=4)!(DISSORT=5) DO
. SET D1=""
. ;
. IF DISSORT'=5 DO
.. IF DISSORT=4 DO
... DO ADD^A1VSLAPI(.VALMCNT,"{package name}^{prefix}^{#rtns}^{size of rtns}^{#files}^{#fields}^{#options}^{#protocols}^{#RPCs}^{#templates}")
.. FOR S D1=$O(^TMP("ZZVPS",$J,D1)) Q:D1="" S D2="" DO
... F S D2=$O(^TMP("ZZVPS",$J,D1,D2)) Q:D2="" DO
.... D PDAD(DISSORT,$G(^(D2)),D1,D2,"",.VALMCNT)
. ;
. IF DISSORT=5 DO
.. DO ADD^A1VSLAPI(.VALMCNT,"{package name}^{prefix}^{#rtns}^{size of rtns}^{#files}^{#fields}^{#options}^{#protocols}^{#RPCs}^{#templates}^{parent pkg}")
.. S TMPSUB=""
.. F S TMPSUB=$O(^TMP("ZZVPS",$J,TMPSUB)) Q:TMPSUB="" S D1="" DO
... F S D1=$O(^TMP("ZZVPS",$J,TMPSUB,D1)) Q:D1="" S D2="" DO
.... F S D2=$O(^TMP("ZZVPS",$J,TMPSUB,D1,D2)) Q:D2="" DO
..... D PDAD(DISSORT,$G(^(D2)),D1,D2,"",.VALMCNT)
;
KILL ^TMP("ZZVPS",$J),^TMP("A1VS-FORUMPKG",$J),^TMP("A1VS-PREFIX-IDX",$J),^TMP("A1VS-FORUM-PFXS",$J)
KILL ^TMP("ZZVPS0",$J),^TMP("A1VS-IDX-PKG",$J),^TMP("A1VS-KIDSPFX-IDX",$J),^TMP("A1VS-FORUM2TMP",$J)
KILL ADP,RDP
;
KWIT ; QUIT Report
QUIT
;
;Report APIs
; ^TMP("A1VS-IDX-PKG",$J,PREFIX,PKGNME)="" OR 1 ; 1 if Main Prefix for Package
;
PDAD(DISSORT,DATA,D1,D2,D3,VALMCNT) ; print actual data (finally)
N D4,D5,D6,D7,D8,D9,D10,DATANDE,SPCT
S D6="TBD"
I (DISSORT=1)!(DISSORT=4)!(DISSORT=5) DO
. ;N D3
. S D4=$P(DATA,"^",2),D5=$P(DATA,"^",3),D7=$P(DATA,"^",5),D8=$P(DATA,"^",6),D9=$P(DATA,"^",7),D10=$P(DATA,"^",8),D3=+DATA
;
;Following code only executes when a caret (^) delimited report is selected
I (DISSORT=4)!(DISSORT=5) DO QUIT ;;Quit reporting sort types 4 & 5
. SET DATANDE=""
. SET DATANDE=D1_"^"_D2_"^"_D3_"^"_D4_"^"_D5_"^"_D6_"^"_D7_"^"_D8_"^"_D9_"^"_D10_$S($P(DATA,"^",9)'="":"^"_$P(DATA,"^",9),1:"")_$S($P(DATA,"^",10)'="":"^"_$P(DATA,"^",10),1:"")
. DO ADD^A1VSLAPI(.VALMCNT,DATANDE)
;
;Following code only executes when user readable report selected (sort types 1, 2, or 3)
I DISSORT=2!(DISSORT=3) DO
. S D5=$P(DATA,"^",2),D7=$P(DATA,"^",4),D8=$P(DATA,"^",5),D9=$P(DATA,"^",6),D10=$P(DATA,"^",7)
. S:DISSORT=2 D4=+DATA
. S:DISSORT=3 D4=D3,D3=+DATA
;
DO ADD^A1VSLAPI(.VALMCNT,D1)
SET DATANDE=""
SET DATANDE="("_D2_")"
FOR SPCT=1:1:11-$L(DATANDE) SET DATANDE=DATANDE_" " ;Space out 2nd data element
SET DATANDE=DATANDE_$J(D3,6)_" "_$J(D4,9)_" "_$J(D5,4)_" "_$J(D6,6)_" "_$J(D7,6)_" "_$J(D8,6)_" "_$J(D9,6)_" "_$J(D10,6)
DO ADD^A1VSLAPI(.VALMCNT,DATANDE)
DO ADD^A1VSLAPI(.VALMCNT,"--------------------------------------------------------------------------------")
QUIT
;
ONEPKG ; Select a package to report
NEW CAPNODE,PKGNAME
KILL ^TMP("A1VS-PARAM-CAP",$J)
DO OPEN^%ZISH("XTMP",EXTDIR,A1VPSPRM,"R")
U IO
SET (CAPNODE,VALMCNT)=0
FOR S LINEITEM="" READ LINEITEM:5 Q:$$STATUS^%ZISH DO
. IF LINEITEM]"" DO SCAPARY^A1VSLP(LINEITEM,.CAPNODE) ;Creates ^TMP("A1VS-PARAM-CAP",$J) array
D CLOSE^%ZISH("XTMP")
;
SET PKGNAME=$$SELPKG^A1VSLPDC(0) ; Select the package to report
DO ONERPT^A1VSRFL1(PKGNAME,.VALMCNT) ;Report stat's for a single package
;
KILL ^TMP("A1VS-PARAM-CAP",$J)
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HA1VSRFL 11161 printed Nov 22, 2024@16:49:03 Page 2
A1VSRFL ;Bham FO/CML3{Albany FO/GTS} - VistA Package Sizing Manager; 27-JUN-2016
+1 ;;1.0;VistA Package Sizing;;Oct 10, 2016;Build 25
+2 ;;
INIT(VALMCNT,A1VPSPRM) ;;
+1 ;;INPUT:
+2 ; VALMCNT - Current Node # on ListMan ^TMP("A1VS PKG MGR RPT",$JOB) global
+3 ; A1VPSPRM - Package Parameter file to report against
+4 ;
+5 ;; data variables (local, for each package)
+6 ;; PKGIEN = Package IEN
+7 ;; PKGNAME = Package NAME (.01 - $P(^(0),"^",1))
+8 ;; PKGPFX = Package PREFIX / NAMESPACE (1 - $P(^(0),"^",2))
+9 ;;
+10 ;; RTOT = total ROUTINEs
+11 ;; TLCNT = total SIZE of all ROUTINES
+12 ;; FTOT = total FILEs
+13 ;; FLDTOT = total FIELDs of all FILES
+14 ;; OTOT = total OPTIONs (^DIC(19,)
+15 ;; PRCTOT = total PROTOCOLs (^ORD(101,)
+16 ;; RPTOT = total REMOTE PROCEDUREs (^XWB(8994,)
+17 ;; TPLTTOT = total Fileman Templates
+18 ;;
+19 IF $GET(DUZ)=""
WRITE !!,"DUZ must be defined."
QUIT
+20 ;
+21 NEW X,Y,EXTDIR,DISSORT
+22 ;
ALL ;
+1 WRITE !!,"VistA Package Sizing Report",!
+2 ;EXTDIR = Directory storing XTMPSIZE.DAT
SET EXTDIR=$$GET^XPAR("SYS","A1VS PACKAGE MGR DEFAULT DIR",1,"I")
+3 NEW DIR
SET DIR(0)="YA"
SET DIR("B")="NO"
+4 SET DIR("A")="Do you want to display Sizing Information for ALL VistA Packages? "
+5 SET DIR("?",1)="A Size report for ALL VistA Packages requires the "_A1VPSPRM_"file"
+6 SET DIR("?",2)=" to be stored in "_EXTDIR_"."
+7 SET DIR("?",3)=A1VPSPRM_" is an extract of Package file data from Forum or other VistA."
+8 SET DIR("?",4)=" Reporting a single package will count components on VistA based on"
+9 SET DIR("?",5)=" the local VistA Package file parameters defined for the package."
+10 SET DIR("?",6)=""
+11 SET DIR("?")="Enter Yes to report All packages; No to report a Single package."
+12 DO ^DIR
IF Y'=1
IF Y'=0
GOTO KWIT
+13 IF Y'=1
GOTO ONEPKG
+14 ;
SORT ;
+1 NEW DIR
SET DIR("A")="Select VistA Size Report"
+2 SET DIR(0)="S^1:SORT ON PKG NAMES;2:SORT ON # OF ROUTINES - HIGH TO LOW;"
+3 SET DIR(0)=DIR(0)_"3:SORT ON PKG ROUTINES SIZE TOTAL - HIGH TO LOW;"
+4 SET DIR(0)=DIR(0)_"4:SORT ON PKG NAME, CARET DELIMITED DATA;"
+5 SET DIR(0)=DIR(0)_"5:SORT ON PKG NAME INCLUDE PARENT PKG, CARET DELIMITED DATA"
+6 SET DIR("L")=" 5. Delimited (^) Data with PARENT PKG, Sorted by PACKAGE NAME"
+7 SET DIR("L",1)="Select which method to display the package size data: "
+8 SET DIR("L",2)=""
+9 SET DIR("L",3)=" 1. Sorted on PACKAGE NAME"
+10 SET DIR("L",4)=" 2. Sorted on NUMBER of ROUTINES (Highest to Lowest)"
+11 SET DIR("L",5)=" 3. Sorted on TOTAL ROUTINE SIZE (Highest to Lowest)"
+12 SET DIR("L",6)=" 4. Delimited (^) Data, Sorted on PACKAGE NAME"
+13 DO ^DIR
if 'Y
GOTO KWIT
SET DISSORT=+Y
+14 ;
+15 DO LOOP(.VALMCNT)
+16 QUIT
+17 ;
LOOP(VALMCNT) ; Loop through all entries in the Package parameters file
+1 KILL ^TMP("ZZVPS",$JOB),^TMP("A1VS-FORUMPKG",$JOB),^TMP("A1VS-PREFIX-IDX",$JOB),^TMP("A1VS-FORUM-PFXS",$JOB)
+2 KILL ^TMP("ZZVPS0",$JOB),^TMP("A1VS-IDX-PKG",$JOB),^TMP("A1VS-KIDSPFX-IDX",$JOB)
+3 NEW D1,D2,D3,POPERR,LNNUM,A1CHAR,TMPSUB,APFXLST,RPFXLST,PCENUM,LINEITEM,PKGNAME,PKGPFX
+4 NEW APFX,RPFX,ADDPRFX,PREFIX,PRNTPKG,FTOT,OTOT,PTOT,RPTOT,RTOT,TLCNT,TPLTTOT,FLDTOT,PKGIEN
+5 SET (D1,D2,D3)=0
+6 SET POPERR=0
+7 DO OPEN^%ZISH("XTMP",EXTDIR,A1VPSPRM,"R")
+8 if POP
SET POPERR=POP
+9 if POPERR
QUIT
+10 USE IO
+11 SET LNNUM=0
+12 FOR
SET LINEITEM=""
READ LINEITEM:5
if $$STATUS^%ZISH
QUIT
Begin DoDot:1
+13 IF LINEITEM]""
Begin DoDot:2
+14 SET LNNUM=LNNUM+1
+15 SET ^TMP("A1VS-FORUMPKG",$JOB,LNNUM)=LINEITEM
End DoDot:2
End DoDot:1
+16 DO CLOSE^%ZISH("XTMP")
+17 ;
+18 ;Create Prefix-Package Indicies from KIDS
DO KIDSIDX^A1VSRFL1()
+19 ;
+20 ;Create Prefix Indicies
+21 SET TMPSUB=0
+22 FOR
SET TMPSUB=$ORDER(^TMP("A1VS-FORUMPKG",$JOB,TMPSUB))
if TMPSUB=""
QUIT
Begin DoDot:1
+23 SET LINEITEM=^TMP("A1VS-FORUMPKG",$JOB,TMPSUB)
+24 SET PKGNAME=$PIECE(LINEITEM,"^")
+25 SET PKGPFX=$PIECE(LINEITEM,"^",2)
+26 ;Pkg-Name,Prefix
SET ^TMP("A1VS-PREFIX-IDX",$JOB,PKGNAME,PKGPFX)=""
+27 ;Prefix
SET ^TMP("A1VS-FORUM-PFXS",$JOB,PKGPFX)=""
+28 ;Prefix,Pkg-Name ;GTS - TO DO: Determine if want this Index
SET ^TMP("A1VS-IDX-PKG",$JOB,$PIECE(LINEITEM,"^",2),$PIECE(LINEITEM,"^"))=$SELECT($DATA(^TMP("A1VA-KIDSPFX-IDX",$JOB,$PIECE(LINEITEM,"^",2))):1,1:"")
+29 ;
+30 SET ADDPRFX=$PIECE(LINEITEM,"^",5)
+31 SET LPCNT=0
+32 FOR PCENUM=1:1
SET PREFIX=$PIECE(ADDPRFX,"|",PCENUM)
if PREFIX=""
QUIT
Begin DoDot:2
+33 ;Pkg-Name,Prefix
SET ^TMP("A1VS-PREFIX-IDX",$JOB,$PIECE(LINEITEM,"^"),PREFIX)=""
+34 ;Prefix
SET ^TMP("A1VS-FORUM-PFXS",$JOB,PREFIX)=""
+35 ;Prefix,Pkg-Name (add Prefix) ;GTS - TO DO: Determine if want this Index
SET ^TMP("A1VS-IDX-PKG",$JOB,PREFIX,$PIECE(LINEITEM,"^"))=""
End DoDot:2
End DoDot:1
+36 ;
+37 ;Count components - ^TMP Global loop
+38 WRITE !,"Compiling component totals for selected Package data file... "
+39 SET (TMPSUB,A1CHAR)=0
+40 FOR
SET TMPSUB=$ORDER(^TMP("A1VS-FORUMPKG",$JOB,TMPSUB))
if TMPSUB=""
QUIT
DO HANGCHAR^A1VSLAPI(.A1CHAR)
Begin DoDot:1
+41 SET LINEITEM=^TMP("A1VS-FORUMPKG",$JOB,TMPSUB)
+42 SET PKGNAME=$PIECE(LINEITEM,"^")
+43 SET PKGIEN=$ORDER(^DIC(9.4,"B",PKGNAME,""))
+44 SET PKGPFX=$PIECE(LINEITEM,"^",2)
+45 SET (FTOT,OTOT,PTOT,RPTOT,RTOT,TLCNT,TPLTTOT)=0
SET FLDTOT="TBD"
+46 ;
+47 ;Count files - entry in ^TMP global loop
+48 SET FTOT=$$COUNTFLS^A1VSRFL1(PKGPFX,$PIECE(LINEITEM,"^",3),$PIECE(LINEITEM,"^",4),$PIECE(LINEITEM,"^",7),$PIECE(LINEITEM,"^",8))
+49 ;
+50 ;Define Excepted & Additional Prefix Arrays
+51 KILL RDP,ADP
+52 SET RPFXLST=$PIECE(LINEITEM,"^",6)
+53 SET (RDP,PCENUM)=0
+54 FOR
SET PCENUM=PCENUM+1
SET RPFX=($PIECE(RPFXLST,"|",PCENUM))
if RPFX']""
QUIT
Begin DoDot:2
+55 ;RDP = Excepted Namespace
SET RDP=RDP+1
SET RDP(RPFX)=""
End DoDot:2
+56 ;
+57 SET APFXLST=$PIECE(LINEITEM,"^",5)
+58 SET (ADP,PCENUM)=0
+59 ;
+60 ; NOTE: MULTX will prevent a Primary Prefix for another package from being included as an added prefix to current package
+61 ;ADP = Added Namespace
FOR
SET PCENUM=PCENUM+1
SET APFX=($PIECE(APFXLST,"|",PCENUM))
if APFX']""
QUIT
if $$MULTX^A1VSRFL1(APFX,PKGNAME)
SET ADP=ADP+1
SET ADP(APFX)=""
+62 ;
+63 SET RTOT=$$ROUTINE^A1VSRFL1(PKGPFX,.TLCNT,.RDP,.ADP)
+64 ;
+65 SET OTOT=$$OPTION^A1VSRFL1(PKGPFX,PKGNAME,.RDP)
+66 SET ADDPRFX=""
+67 FOR
SET ADDPRFX=$ORDER(ADP(ADDPRFX))
if ADDPRFX=""
QUIT
SET OTOT=OTOT+$$OPTION^A1VSRFL1(ADDPRFX,PKGNAME,.RDP)
+68 ;
+69 ;;Should this loop on Prefix or is Package pointer ok? ;;PKGIEN would not be set for FORUM packages not on local PKG file
SET PTOT=$$PROTOCOL^A1VSRFL1(PKGPFX,PKGIEN,.RDP,.ADP)
+70 ;Count Remote Procedure Calls
DO CNTR^A1VSRFL1("^XWB(8994,",.RPTOT,PKGPFX,PKGNAME,.RDP,.ADP)
+71 ;Count Print Templates
DO CNTR^A1VSRFL1("^DIPT(",.TPLTTOT,PKGPFX,PKGNAME,.RDP,.ADP)
+72 ;Count Sort Templates
DO CNTR^A1VSRFL1("^DIBT(",.TPLTTOT,PKGPFX,PKGNAME,.RDP,.ADP)
+73 ;Count Input Templates
DO CNTR^A1VSRFL1("^DIE(",.TPLTTOT,PKGPFX,PKGNAME,.RDP,.ADP)
+74 ;
+75 if DISSORT'=5
SET ^TMP("ZZVPS",$JOB,PKGNAME,PKGPFX)=RTOT_"^"_TLCNT_"^"_FTOT_"^^"_OTOT_"^"_PTOT_"^"_RPTOT_"^"_TPLTTOT
+76 IF DISSORT=5
Begin DoDot:2
+77 SET PRNTPKG=$PIECE(LINEITEM,"^",9)
+78 SET ^TMP("ZZVPS",$JOB,TMPSUB,PKGNAME,PKGPFX)=RTOT_"^"_TLCNT_"^"_FTOT_"^^"_OTOT_"^"_PTOT_"^"_RPTOT_"^"_TPLTTOT_$SELECT(PRNTPKG'=""&PRNTPKG'=PKGNAME:"^"_PRNTPKG,1:"")_$SELECT($PIECE(LINEITEM,"^",10)'="":"^"_$PIECE(LINEITEM,"^",10)
,1:"")
End DoDot:2
End DoDot:1
+79 ;
+80 IF DISSORT=2
SET D1=""
FOR
SET D1=$ORDER(^TMP("ZZVPS",$JOB,D1))
if D1=""
QUIT
SET D2=""
FOR
SET D2=$ORDER(^TMP("ZZVPS",$JOB,D1,D2))
if D2=""
QUIT
SET X=$GET(^(D2))
SET ^TMP("ZZVPS0",$JOB,+X,D1,D2)=$PIECE(X,"^",2,8)
+81 IF DISSORT=3
SET D1=""
FOR
SET D1=$ORDER(^TMP("ZZVPS",$JOB,D1))
if D1=""
QUIT
SET D2=""
FOR
SET D2=$ORDER(^TMP("ZZVPS",$JOB,D1,D2))
if D2=""
QUIT
SET X=$GET(^(D2))
SET ^TMP("ZZVPS0",$JOB,+$PIECE(X,"^",2),D1,D2)=+X_"^"_$PIECE(X,"^",3,8)
+82 ;
DISALL ;
+1 ; display option 4 & 5 have no formatting, and are used for creating spreadsheets,
+2 ; for which the following heading lines are not needed
+3 ;
IF (DISSORT'=4)&(DISSORT'=5)
Begin DoDot:1
+4 DO ADD^A1VSLAPI(.VALMCNT,"VistA Application Sizing Information Sort Type: "_DISSORT)
+5 DO ADD^A1VSLAPI(.VALMCNT," ")
+6 DO ADD^A1VSLAPI(.VALMCNT," Total")
+7 DO ADD^A1VSLAPI(.VALMCNT,"Application Rtn")
+8 DO ADD^A1VSLAPI(.VALMCNT,"(Namespace) Routines Size Files Fields Options Protocols RPCs Templates")
+9 DO ADD^A1VSLAPI(.VALMCNT,"================================================================================")
End DoDot:1
+10 ;
DAD ;
+1 NEW S3
+2 IF DISSORT=2!(DISSORT=3)
SET S3=""
FOR
SET S3=$ORDER(^TMP("ZZVPS0",$JOB,S3),-1)
SET D3=S3
if S3=""
QUIT
SET D1=""
FOR
SET D1=$ORDER(^TMP("ZZVPS0",$JOB,S3,D1))
if D1=""
QUIT
SET D2=""
FOR
SET D2=$ORDER(^TMP("ZZVPS0",$JOB,S3,D1,D2))
if D2=""
QUIT
DO PDAD(DISSORT,$GET(^(D2)),D1,D2,D3,.VALMCNT)
+3 IF DISSORT=1!(DISSORT=4)!(DISSORT=5)
Begin DoDot:1
+4 SET D1=""
+5 ;
+6 IF DISSORT'=5
Begin DoDot:2
+7 IF DISSORT=4
Begin DoDot:3
+8 DO ADD^A1VSLAPI(.VALMCNT,"{package name}^{prefix}^{#rtns}^{size of rtns}^{#files}^{#fields}^{#options}^{#protocols}^{#RPCs}^{#templates}")
End DoDot:3
+9 FOR
SET D1=$ORDER(^TMP("ZZVPS",$JOB,D1))
if D1=""
QUIT
SET D2=""
Begin DoDot:3
+10 FOR
SET D2=$ORDER(^TMP("ZZVPS",$JOB,D1,D2))
if D2=""
QUIT
Begin DoDot:4
+11 DO PDAD(DISSORT,$GET(^(D2)),D1,D2,"",.VALMCNT)
End DoDot:4
End DoDot:3
End DoDot:2
+12 ;
+13 IF DISSORT=5
Begin DoDot:2
+14 DO ADD^A1VSLAPI(.VALMCNT,"{package name}^{prefix}^{#rtns}^{size of rtns}^{#files}^{#fields}^{#options}^{#protocols}^{#RPCs}^{#templates}^{parent pkg}")
+15 SET TMPSUB=""
+16 FOR
SET TMPSUB=$ORDER(^TMP("ZZVPS",$JOB,TMPSUB))
if TMPSUB=""
QUIT
SET D1=""
Begin DoDot:3
+17 FOR
SET D1=$ORDER(^TMP("ZZVPS",$JOB,TMPSUB,D1))
if D1=""
QUIT
SET D2=""
Begin DoDot:4
+18 FOR
SET D2=$ORDER(^TMP("ZZVPS",$JOB,TMPSUB,D1,D2))
if D2=""
QUIT
Begin DoDot:5
+19 DO PDAD(DISSORT,$GET(^(D2)),D1,D2,"",.VALMCNT)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+20 ;
+21 KILL ^TMP("ZZVPS",$JOB),^TMP("A1VS-FORUMPKG",$JOB),^TMP("A1VS-PREFIX-IDX",$JOB),^TMP("A1VS-FORUM-PFXS",$JOB)
+22 KILL ^TMP("ZZVPS0",$JOB),^TMP("A1VS-IDX-PKG",$JOB),^TMP("A1VS-KIDSPFX-IDX",$JOB),^TMP("A1VS-FORUM2TMP",$JOB)
+23 KILL ADP,RDP
+24 ;
KWIT ; QUIT Report
+1 QUIT
+2 ;
+3 ;Report APIs
+4 ; ^TMP("A1VS-IDX-PKG",$J,PREFIX,PKGNME)="" OR 1 ; 1 if Main Prefix for Package
+5 ;
PDAD(DISSORT,DATA,D1,D2,D3,VALMCNT) ; print actual data (finally)
+1 NEW D4,D5,D6,D7,D8,D9,D10,DATANDE,SPCT
+2 SET D6="TBD"
+3 IF (DISSORT=1)!(DISSORT=4)!(DISSORT=5)
Begin DoDot:1
+4 ;N D3
+5 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 D10=$PIECE(DATA,"^",8)
SET D3=+DATA
End DoDot:1
+6 ;
+7 ;Following code only executes when a caret (^) delimited report is selected
+8 ;;Quit reporting sort types 4 & 5
IF (DISSORT=4)!(DISSORT=5)
Begin DoDot:1
+9 SET DATANDE=""
+10 SET DATANDE=D1_"^"_D2_"^"_D3_"^"_D4_"^"_D5_"^"_D6_"^"_D7_"^"_D8_"^"_D9_"^"_D10_$SELECT($PIECE(DATA,"^",9)'="":"^"_$PIECE(DATA,"^",9),1:"")_$SELECT($PIECE(DATA,"^",10)'="":"^"_$PIECE(DATA,"^",10),1:"")
+11 DO ADD^A1VSLAPI(.VALMCNT,DATANDE)
End DoDot:1
QUIT
+12 ;
+13 ;Following code only executes when user readable report selected (sort types 1, 2, or 3)
+14 IF DISSORT=2!(DISSORT=3)
Begin DoDot:1
+15 SET D5=$PIECE(DATA,"^",2)
SET D7=$PIECE(DATA,"^",4)
SET D8=$PIECE(DATA,"^",5)
SET D9=$PIECE(DATA,"^",6)
SET D10=$PIECE(DATA,"^",7)
+16 if DISSORT=2
SET D4=+DATA
+17 if DISSORT=3
SET D4=D3
SET D3=+DATA
End DoDot:1
+18 ;
+19 DO ADD^A1VSLAPI(.VALMCNT,D1)
+20 SET DATANDE=""
+21 SET DATANDE="("_D2_")"
+22 ;Space out 2nd data element
FOR SPCT=1:1:11-$LENGTH(DATANDE)
SET DATANDE=DATANDE_" "
+23 SET DATANDE=DATANDE_$JUSTIFY(D3,6)_" "_$JUSTIFY(D4,9)_" "_$JUSTIFY(D5,4)_" "_$JUSTIFY(D6,6)_" "_$JUSTIFY(D7,6)_" "_$JUSTIFY(D8,6)_" "_$JUSTIFY(D9,6)_" "_$JUSTIFY(D10,6)
+24 DO ADD^A1VSLAPI(.VALMCNT,DATANDE)
+25 DO ADD^A1VSLAPI(.VALMCNT,"--------------------------------------------------------------------------------")
+26 QUIT
+27 ;
ONEPKG ; Select a package to report
+1 NEW CAPNODE,PKGNAME
+2 KILL ^TMP("A1VS-PARAM-CAP",$JOB)
+3 DO OPEN^%ZISH("XTMP",EXTDIR,A1VPSPRM,"R")
+4 USE IO
+5 SET (CAPNODE,VALMCNT)=0
+6 FOR
SET LINEITEM=""
READ LINEITEM:5
if $$STATUS^%ZISH
QUIT
Begin DoDot:1
+7 ;Creates ^TMP("A1VS-PARAM-CAP",$J) array
IF LINEITEM]""
DO SCAPARY^A1VSLP(LINEITEM,.CAPNODE)
End DoDot:1
+8 DO CLOSE^%ZISH("XTMP")
+9 ;
+10 ; Select the package to report
SET PKGNAME=$$SELPKG^A1VSLPDC(0)
+11 ;Report stat's for a single package
DO ONERPT^A1VSRFL1(PKGNAME,.VALMCNT)
+12 ;
+13 KILL ^TMP("A1VS-PARAM-CAP",$JOB)
+14 QUIT
