- XTVSRFL ;BHAM/MAM/GTS - VistA Package Sizing Manager;
- ;;7.3;TOOLKIT;**143,152**;Apr 25, 1995;Build 3
- ;;Per VA Directive 6402, this routine should not be modified.
- ;;
- INIT(VALMCNT,XTVPSPRM) ;;VistA Size Report entry point
- ;;INPUT:
- ; VALMCNT - Current Node # on ListMan ^TMP("XTVS PKG MGR RPT",$JOB) global
- ; XTVPSPRM - 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,)
- ;; PTOT = 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 ; Select All or Single report
- W !!,"VistA Package Sizing Report",!
- S EXTDIR=$$GET^XPAR("SYS","XTVS 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..."
- S DIR("?",2)=" "_XTVPSPRM
- S DIR("?",3)=" ...file to be stored in "_EXTDIR_"."
- S DIR("?",4)=""
- S DIR("?",5)=" "_XTVPSPRM
- S DIR("?",6)=" is sourced from Package file data in Forum or other VistA instance."
- S DIR("?",7)=" The report will count package components on local VistA based on the"
- S DIR("?",8)=" parameters defined in the Package Parameter file for the package."
- S DIR("?",9)=""
- 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 ; Select Sort for All report
- 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(DISSORT,.VALMCNT)
- QUIT
- ;
- LOOP(DISSORT,VALMCNT) ; Loop through all entries in the Package parameters file
- NEW POPERR
- SET POPERR=0
- DO OPEN^%ZISH("XTMP",EXTDIR,XTVPSPRM,"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("XTVS-FORUMPKG",$J,LNNUM)=LINEITEM
- D CLOSE^%ZISH("XTMP")
- ;
- DO KIDSIDX^XTVSRFL1 ;Create Prefix-Package Indicies from KIDS
- ;
- ;Create Prefix Indicies
- DO TALLYRPT(DISSORT,0)
- ;
- ;Check existence of Packages
- DO PKGFLCK
- ;
- DISALL ; Set report into display array
- ; 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^XTVSLAPI(.VALMCNT,"VistA Application Sizing Information Sort Type: "_DISSORT)
- . DO ADD^XTVSLAPI(.VALMCNT," ")
- . DO ADD^XTVSLAPI(.VALMCNT," Total")
- . DO ADD^XTVSLAPI(.VALMCNT,"Application Rtn")
- . DO ADD^XTVSLAPI(.VALMCNT,"(Namespace) Routines Size Files Fields Options Protocols RPCs Templates")
- . DO ADD^XTVSLAPI(.VALMCNT,"================================================================================")
- ;
- DAD ; Add report lines to display array
- NEW S3
- I DISSORT=2!(DISSORT=3) DO
- . S S3=""
- . F S S3=$O(^TMP("XTVS-VPS0",$J,S3),-1) S D3=S3 Q:S3="" S D1="" F S D1=$O(^TMP("XTVS-VPS0",$J,S3,D1)) Q:D1="" S D2="" F S D2=$O(^TMP("XTVS-VPS0",$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^XTVSLAPI(.VALMCNT,"{package name}^{prefix}^{#rtns}^{size of rtns}^{#files}^{#fields}^{#options}^{#protocols}^{#RPCs}^{#templates}")
- .. FOR S D1=$O(^TMP("XTVS-VPS",$J,D1)) Q:D1="" S D2="" DO
- ... F S D2=$O(^TMP("XTVS-VPS",$J,D1,D2)) Q:D2="" DO
- .... D PDAD(DISSORT,$G(^(D2)),D1,D2,"",.VALMCNT)
- . ;
- . IF DISSORT=5 DO
- .. DO ADD^XTVSLAPI(.VALMCNT,"{package name}^{prefix}^{#rtns}^{size of rtns}^{#files}^{#fields}^{#options}^{#protocols}^{#RPCs}^{#templates}^{parent pkg}")
- .. S TMPSUB=""
- .. F S TMPSUB=$O(^TMP("XTVS-VPS",$J,TMPSUB)) Q:TMPSUB="" S D1="" DO
- ... F S D1=$O(^TMP("XTVS-VPS",$J,TMPSUB,D1)) Q:D1="" S D2="" DO
- .... F S D2=$O(^TMP("XTVS-VPS",$J,TMPSUB,D1,D2)) Q:D2="" DO
- ..... D PDAD(DISSORT,$G(^(D2)),D1,D2,"",.VALMCNT)
- ;
- KILL ^TMP("XTVS-VPS",$J),^TMP("XTVS-PREFIX-IDX",$J),^TMP("XTVS-FORUM-PFXS",$J)
- KILL ^TMP("XTVS-VPS0",$J),^TMP("XTVS-KIDSPFX-IDX",$J),^TMP("XTVS-FORUM2TMP",$J)
- KILL ^TMP("XTVS-FORUMPKG",$J),^TMP("XTVS-IDX-PKG",$J)
- ;
- KWIT ; QUIT Report
- QUIT
- ;
- PDAD(DISSORT,DATA,D1,D2,D3,VALMCNT) ; print actual data (finally)
- N D4,D5,D6,D7,D8,D9,D10,DATANDE,SPCT
- I (DISSORT=1)!(DISSORT=4)!(DISSORT=5) DO
- . S D4=$P(DATA,"^",2),D5=$P(DATA,"^",3),D6=$P(DATA,"^",4),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^XTVSLAPI(.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),D6=$P(DATA,"^",3),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^XTVSLAPI(.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^XTVSLAPI(.VALMCNT,DATANDE)
- DO ADD^XTVSLAPI(.VALMCNT,"--------------------------------------------------------------------------------")
- QUIT
- ;
- TALLYRPT(DISSORT,XTVSSILN,SELPKGNM) ; Compile component totals
- ; INPUT:
- ; DISSORT -
- ; 1: Sorted on PACKAGE NAME [Default]
- ; 2: Sorted on NUMBER of ROUTINES (Highest to Lowest)
- ; 3: Sorted on TOTAL ROUTINE SIZE (Highest to Lowest)
- ; 4: Delimited (^) Data, Sorted on PACKAGE NAME
- ; 5: Delimited (^) Data with PARENT PKG, Sorted by PACKAGE NAME
- ;
- ; XTVSSILN - Silent mode
- ; 0: Show HangChar
- ; 1: Silent [Default]
- ;
- ; SELPKGNM - Selected package name
- ; Define when called from ONEPKGSZ^XTVSSVR to only check & send message
- ; when selected package is missing
- ;
- ; Requires the following TMP globals are defined before execution:
- ; ^TMP("XTVS-FORUMPKG",$J)
- ; ^TMP("XTVS-KIDSPFX-IDX",$J)
- ;
- ;Create Prefix Indicies
- ;
- IF $GET(DISSORT)="" SET DISSORT=1
- IF $GET(XTVSSILN)'=0 SET XTVSSILN=1
- ;
- NEW D1,D2,D3,XTCHAR,TMPSUB,PCENUM,LINEITEM,PKGNAME,PKGPFX,LINECNT
- NEW PREFIX,PKGIEN,FFCTRSLT
- SET (D1,D2,D3)=0
- ;
- ; Create ^TMP("XTVS-IDX-PKG",$J) array for MULTX^XTVSRFL1
- SET TMPSUB=0
- FOR SET TMPSUB=$O(^TMP("XTVS-FORUMPKG",$J,TMPSUB)) QUIT:TMPSUB="" DO
- .SET LINEITEM=^TMP("XTVS-FORUMPKG",$J,TMPSUB)
- .SET PKGNAME=$P(LINEITEM,"^")
- .SET PKGPFX=$P(LINEITEM,"^",2)
- .SET ^TMP("XTVS-PREFIX-IDX",$J,PKGPFX,PKGNAME)="" ;Prefix,Pkg-Name
- .SET ^TMP("XTVS-FORUM-PFXS",$J,PKGPFX)="" ;Prefix
- .; Following ^TMP for PACKAGES in Param file: Prefix,Pkg-Name = 1 when KIDS Prefix, Null when not KIDS Prefix
- .IF '$D(^TMP("XTVS-KIDSPFX-IDX",$J,PKGPFX)) SET ^TMP("XTVS-IDX-PKG",$J,PKGPFX,PKGNAME)=""
- .IF $D(^TMP("XTVS-KIDSPFX-IDX",$J,PKGPFX)) SET ^TMP("XTVS-IDX-PKG",$J,PKGPFX,PKGNAME)=$S(^TMP("XTVS-KIDSPFX-IDX",$J,PKGPFX)=PKGNAME:1,1:"")
- .;
- .SET ADDPRFX=$P(LINEITEM,"^",5)
- .SET LPCNT=0
- .FOR PCENUM=1:1 SET PREFIX=$P(ADDPRFX,"|",PCENUM) Q:PREFIX="" DO
- .. SET ^TMP("XTVS-FORUM-PFXS",$J,PREFIX)="" ;Prefix
- .. ; Following ^TMP for PACKAGES in Param file : Prefix,Pkg-Name = 1 when KIDS Prefix, Null when not KIDS Prefix
- .. SET ^TMP("XTVS-IDX-PKG",$J,PREFIX,PKGNAME)=$S($D(^TMP("XTVS-KIDSPFX-IDX",$J,PREFIX)):1,1:"")
- ;
- ;Count components - ^TMP Global loop
- WRITE:'XTVSSILN !,"Compiling component totals for selected Package data file... "
- SET (TMPSUB,XTCHAR)=0
- FOR SET TMPSUB=$O(^TMP("XTVS-FORUMPKG",$J,TMPSUB)) QUIT:TMPSUB="" DO:'XTVSSILN HANGCHAR^XTVSLAPI(.XTCHAR) DO
- .SET PKGIEN=0
- .SET LINEITEM=^TMP("XTVS-FORUMPKG",$J,TMPSUB)
- .SET PKGNAME=$P(LINEITEM,"^")
- .;
- .IF PKGNAME["''" DO
- .. IF $D(^DIC(9.4,"B",$REPLACE(PKGNAME,"''",""""))) SET PKGIEN=$O(^DIC(9.4,"B",$REPLACE(PKGNAME,"''",""""),""))
- .. IF '$D(^DIC(9.4,"B",$REPLACE(PKGNAME,"''",""""))),$D(^DIC(9.4,"B",PKGNAME)) SET PKGIEN=$O(^DIC(9.4,"B",PKGNAME,""))
- .IF PKGNAME'["''" SET PKGIEN=+$O(^DIC(9.4,"B",PKGNAME,""))
- .;
- .IF (PKGIEN=0),(PKGNAME=$P($G(SELPKGNM),"^",1)) DO RMTPKGMG^XTVSLAPI("Package: "_PKGNAME_" ...not found! Protocol count may be incorrect.",$S($G(XTVSSNDR)]"":XTVSSNDR,1:$$NETNAME^XMXUTIL(DUZ)),PKGNAME) ;p152 v2 ba
- .DO COMPNTCT(PKGNAME,PKGIEN,LINEITEM,DISSORT)
- ;
- I DISSORT=2 S D1="" F S D1=$O(^TMP("XTVS-VPS",$J,D1)) Q:D1="" S D2="" F S D2=$O(^TMP("XTVS-VPS",$J,D1,D2)) Q:D2="" S X=$G(^(D2)),^TMP("XTVS-VPS0",$J,+X,D1,D2)=$P(X,"^",2,8)
- I DISSORT=3 S D1="" F S D1=$O(^TMP("XTVS-VPS",$J,D1)) Q:D1="" S D2="" F S D2=$O(^TMP("XTVS-VPS",$J,D1,D2)) Q:D2="" S X=$G(^(D2)),^TMP("XTVS-VPS0",$J,+$P(X,"^",2),D1,D2)=+X_"^"_$P(X,"^",3,8)
- ;
- QUIT
- ;
- COMPNTCT(PKGNAME,PKGIEN,LINEITEM,DISSORT) ;Count components for package
- ;Input:
- ; PKGNAME - Package Name
- ; PKGIEN - Package File IEN for Package
- ; LINEITEM - Package Parameters from Parameter file
- ; DISSORT - Report Type (Sort) selected
- ;
- NEW APFXLST,RPFXLST,PCENUM,PKGPFX,LPA,APFX,RPFX,ADDPRFX,PRNTPKG
- NEW FTOT,OTOT,PTOT,RPTOT,RTOT,TLCNT,TPLTTOT,FLDTOT
- ;
- SET PKGPFX=$P(LINEITEM,"^",2)
- ;
- SET (FTOT,FLDTOT,OTOT,PTOT,RPTOT,RTOT,TLCNT,TPLTTOT)=0
- ;Count files & fields - entry in ^TMP global loop
- SET FFCTRSLT=$$COUNTFLS^XTVSRFL1(PKGPFX,$P(LINEITEM,"^",3),$P(LINEITEM,"^",4),$P(LINEITEM,"^",7),$P(LINEITEM,"^",8)) ; Files^Fields
- SET FTOT=$P(FFCTRSLT,"^") ;Extract File ctr
- SET FLDTOT=$P(FFCTRSLT,"^",2) ;Extract Field ctr
- ;
- ;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(RDP)=RPFX ;RDP = Excepted Namespace
- ;
- SET APFXLST=$P(LINEITEM,"^",5)
- SET (ADP,PCENUM)=0
- ; NOTE: MULTX screens a Primary or KIDS Prefix for another package from inclusion as an added prefix to current package
- FOR SET PCENUM=PCENUM+1 SET APFX=($P(APFXLST,"|",PCENUM)) QUIT:APFX="" IF $$MULTX^XTVSRFL1(APFX,PKGNAME) SET ADP=ADP+1 SET ADP(ADP)=APFX ;ADP = Added Namespace
- ;
- SET RTOT=$$ROUTINE^XTVSRFL1(PKGPFX,.TLCNT,.RDP,.ADP) ;Count routines
- I ADP F LPA=1:1:ADP I ADP(LPA)'="" S RTOT=RTOT+$$ROUTINE^XTVSRFL1(ADP(LPA),.TLCNT,.RDP,.ADP) ;ADP(LPA) added prefixes called individually
- ;
- DO CNTR^XTVSRFL1("^DIC(19,",.OTOT,PKGPFX,.RDP,.ADP) ;Count Options
- I ADP F LPA=1:1:ADP I ADP(LPA)'="" D CNTR^XTVSRFL1("^DIC(19,",.OTOT,ADP(LPA),.RDP,.ADP)
- ;
- SET PTOT=$$PROTOCOL^XTVSRFL1(PKGPFX,PKGIEN,.RDP) ;Count Protocols
- I ADP F LPA=1:1:ADP I ADP(LPA)'="" SET PTOT=PTOT+$$PROTOCOL^XTVSRFL1(ADP(LPA),PKGIEN,.RDP)
- ;
- DO CNTR^XTVSRFL1("^XWB(8994,",.RPTOT,PKGPFX,.RDP,.ADP) ;Count Remote Procedure Calls
- I ADP F LPA=1:1:ADP I ADP(LPA)'="" D CNTR^XTVSRFL1("^XWB(8994,",.RPTOT,ADP(LPA),.RDP,.ADP)
- ;
- ; Count Templates
- DO CNTR^XTVSRFL1("^DIPT(",.TPLTTOT,PKGPFX,.RDP,.ADP) ;Print Templates
- I ADP F LPA=1:1:ADP I ADP(LPA)'="" D CNTR^XTVSRFL1("^DIPT(",.TPLTTOT,ADP(LPA),.RDP,.ADP)
- ;
- DO CNTR^XTVSRFL1("^DIBT(",.TPLTTOT,PKGPFX,.RDP,.ADP) ;Sort Templates
- I ADP F LPA=1:1:ADP I ADP(LPA)'="" D CNTR^XTVSRFL1("^DIBT(",.TPLTTOT,ADP(LPA),.RDP,.ADP)
- ;
- DO CNTR^XTVSRFL1("^DIE(",.TPLTTOT,PKGPFX,.RDP,.ADP) ;Input Templates
- I ADP F LPA=1:1:ADP I ADP(LPA)'="" D CNTR^XTVSRFL1("^DIE(",.TPLTTOT,ADP(LPA),.RDP,.ADP)
- ;
- SET:DISSORT'=5 ^TMP("XTVS-VPS",$J,PKGNAME,PKGPFX)=RTOT_"^"_TLCNT_"^"_FTOT_"^"_FLDTOT_"^"_OTOT_"^"_PTOT_"^"_RPTOT_"^"_TPLTTOT
- IF DISSORT=5 DO
- .SET PRNTPKG=$P(LINEITEM,"^",9)
- .SET ^TMP("XTVS-VPS",$J,TMPSUB,PKGNAME,PKGPFX)=RTOT_"^"_TLCNT_"^"_FTOT_"^"_FLDTOT_"^"_OTOT_"^"_PTOT_"^"_RPTOT_"^"_TPLTTOT_$S(PRNTPKG'=""&PRNTPKG'=PKGNAME:"^"_PRNTPKG,1:"")_$S($P(LINEITEM,"^",10)'="":"^"_$P(LINEITEM,"^",10),1:"")
- ;
- KILL ADP,RDP
- ;
- QUIT
- ;
- PKGFLCK ; Check for Package File entries matching Parameter names, send report message
- ;Requires the ^TMP("XTVS-FORUMPKG",$J) global
- ;
- NEW TMPSUB,PKGIEN,PKGNAME,MSGNDENM
- KILL ^TMP("XTVS-LOCAL-ERROR",$JOB)
- SET (MSGNDENM,TMPSUB)=0
- FOR SET TMPSUB=$O(^TMP("XTVS-FORUMPKG",$J,TMPSUB)) QUIT:TMPSUB="" DO
- . SET PKGIEN=0
- . SET PKGNAME=$P(^TMP("XTVS-FORUMPKG",$J,TMPSUB),"^")
- . ;
- . IF PKGNAME["''" DO
- .. IF $D(^DIC(9.4,"B",$REPLACE(PKGNAME,"''",""""))) SET PKGIEN=$O(^DIC(9.4,"B",$REPLACE(PKGNAME,"''",""""),""))
- .. IF '$D(^DIC(9.4,"B",$REPLACE(PKGNAME,"''",""""))),$D(^DIC(9.4,"B",PKGNAME)) SET PKGIEN=$O(^DIC(9.4,"B",PKGNAME,""))
- . IF PKGNAME'["''" SET PKGIEN=+$O(^DIC(9.4,"B",PKGNAME,""))
- . ;
- . IF PKGIEN=0 DO
- .. IF MSGNDENM=0 DO
- ... SET ^TMP("XTVS-LOCAL-ERROR",$JOB,1)="Package Size Report warning for "_^%ZOSF("PROD")_"."
- ... SET ^TMP("XTVS-LOCAL-ERROR",$JOB,2)=" The following package(s) are not found on this VistA."
- ... SET ^TMP("XTVS-LOCAL-ERROR",$JOB,3)=" (The number of protocols reported may be incorrect.)"
- .. SET MSGNDENM=$ORDER(^TMP("XTVS-LOCAL-ERROR",$JOB,""),-1)+1
- .. SET ^TMP("XTVS-LOCAL-ERROR",$JOB,MSGNDENM)=" - "_PKGNAME
- ;
- IF $D(^TMP("XTVS-LOCAL-ERROR",$JOB)) DO
- . NEW XMDUZ,XMY,XMTEXT,XMSUB
- . SET XMDUZ="VistA Package Size Analysis Manager"
- . SET XMY($$NETNAME^XMXUTIL(DUZ))=""
- . SET XMTEXT="^TMP(""XTVS-LOCAL-ERROR"","_$JOB_","
- . SET XMSUB="PACKAGE REPORT NOTICE ("_^%ZOSF("PROD")_") ; Report process warning."
- . DO ^XMD
- . IF +XMZ'>0 DO
- .. SET ERRTEXT="'Package Report Notice' FAILED to return to "_$$NETNAME^XMXUTIL(DUZ)_"."
- .. DO APPERROR^%ZTER("PKGFLCK^XTFSRFL : Package extract error")
- ;
- KILL ^TMP("XTVS-LOCAL-ERROR",$JOB)
- QUIT
- ;
- ONEPKG ; Select a package to report
- NEW PKGNAME,LINEITEM
- KILL ^TMP("XTVS-PARAM-CAP",$J),^TMP("XTVS-PREFIX-IDX",$J),^TMP("XTVS-FORUM-PFXS",$J),^TMP("XTVS-IDX-PKG",$J)
- DO OPEN^%ZISH("XTMP",EXTDIR,XTVPSPRM,"R")
- U IO
- SET VALMCNT=0
- FOR S LINEITEM="" READ LINEITEM:5 Q:$$STATUS^%ZISH DO
- . IF LINEITEM]"" DO SCAPARY^XTVSLP(LINEITEM) ;Creates ^TMP("XTVS-PARAM-CAP",$J) array
- DO CLOSE^%ZISH("XTMP")
- ;
- DO KIDSIDX^XTVSRFL1 ;Create Prefix-Package Indicies from KIDS [^TMP("XTVS-KIDSPFX-IDX")]
- ;
- SET PKGNAME=$$SELPKG^XTVSLPDC(0) ; Select the package to report
- ;
- IF PKGNAME=0 W !!,"VistA Package Not Selected!"
- IF PKGNAME'=0 DO
- . DO PARAMIDX^XTVSRFL1 ;Create Prefix Indicies
- . ;
- . DO ONERPT^XTVSRFL1(PKGNAME,.VALMCNT) ;Report stat's for a single package
- ;
- KILL ^TMP("XTVS-PREFIX-IDX",$J),^TMP("XTVS-FORUM-PFXS",$J),^TMP("XTVS-KIDSPFX-IDX",$J)
- KILL ^TMP("XTVS-PARAM-CAP",$J),^TMP("XTVS-IDX-PKG",$J)
- QUIT
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTVSRFL 16088 printed Feb 19, 2025@00:08:48 Page 2
- XTVSRFL ;BHAM/MAM/GTS - VistA Package Sizing Manager;
- +1 ;;7.3;TOOLKIT;**143,152**;Apr 25, 1995;Build 3
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;;
- INIT(VALMCNT,XTVPSPRM) ;;VistA Size Report entry point
- +1 ;;INPUT:
- +2 ; VALMCNT - Current Node # on ListMan ^TMP("XTVS PKG MGR RPT",$JOB) global
- +3 ; XTVPSPRM - 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 ;; PTOT = 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 ; Select All or Single report
- +1 WRITE !!,"VistA Package Sizing Report",!
- +2 ;EXTDIR = Directory storing XTMPSIZE.DAT
- SET EXTDIR=$$GET^XPAR("SYS","XTVS 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..."
- +6 SET DIR("?",2)=" "_XTVPSPRM
- +7 SET DIR("?",3)=" ...file to be stored in "_EXTDIR_"."
- +8 SET DIR("?",4)=""
- +9 SET DIR("?",5)=" "_XTVPSPRM
- +10 SET DIR("?",6)=" is sourced from Package file data in Forum or other VistA instance."
- +11 SET DIR("?",7)=" The report will count package components on local VistA based on the"
- +12 SET DIR("?",8)=" parameters defined in the Package Parameter file for the package."
- +13 SET DIR("?",9)=""
- +14 SET DIR("?")="Enter Yes to report All packages; No to report a Single package."
- +15 DO ^DIR
- IF Y'=1
- IF Y'=0
- GOTO KWIT
- +16 IF Y'=1
- GOTO ONEPKG
- +17 ;
- SORT ; Select Sort for All report
- +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(DISSORT,.VALMCNT)
- +16 QUIT
- +17 ;
- LOOP(DISSORT,VALMCNT) ; Loop through all entries in the Package parameters file
- +1 NEW POPERR
- +2 SET POPERR=0
- +3 DO OPEN^%ZISH("XTMP",EXTDIR,XTVPSPRM,"R")
- +4 if POP
- SET POPERR=POP
- +5 if POPERR
- QUIT
- +6 USE IO
- +7 SET LNNUM=0
- +8 FOR
- SET LINEITEM=""
- READ LINEITEM:5
- if $$STATUS^%ZISH
- QUIT
- Begin DoDot:1
- +9 IF LINEITEM]""
- Begin DoDot:2
- +10 SET LNNUM=LNNUM+1
- +11 SET ^TMP("XTVS-FORUMPKG",$JOB,LNNUM)=LINEITEM
- End DoDot:2
- End DoDot:1
- +12 DO CLOSE^%ZISH("XTMP")
- +13 ;
- +14 ;Create Prefix-Package Indicies from KIDS
- DO KIDSIDX^XTVSRFL1
- +15 ;
- +16 ;Create Prefix Indicies
- +17 DO TALLYRPT(DISSORT,0)
- +18 ;
- +19 ;Check existence of Packages
- +20 DO PKGFLCK
- +21 ;
- DISALL ; Set report into display array
- +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^XTVSLAPI(.VALMCNT,"VistA Application Sizing Information Sort Type: "_DISSORT)
- +5 DO ADD^XTVSLAPI(.VALMCNT," ")
- +6 DO ADD^XTVSLAPI(.VALMCNT," Total")
- +7 DO ADD^XTVSLAPI(.VALMCNT,"Application Rtn")
- +8 DO ADD^XTVSLAPI(.VALMCNT,"(Namespace) Routines Size Files Fields Options Protocols RPCs Templates")
- +9 DO ADD^XTVSLAPI(.VALMCNT,"================================================================================")
- End DoDot:1
- +10 ;
- DAD ; Add report lines to display array
- +1 NEW S3
- +2 IF DISSORT=2!(DISSORT=3)
- Begin DoDot:1
- +3 SET S3=""
- +4 FOR
- SET S3=$ORDER(^TMP("XTVS-VPS0",$JOB,S3),-1)
- SET D3=S3
- if S3=""
- QUIT
- SET D1=""
- FOR
- SET D1=$ORDER(^TMP("XTVS-VPS0",$JOB,S3,D1))
- if D1=""
- QUIT
- SET D2=""
- FOR
- SET D2=$ORDER(^TMP("XTVS-VPS0",$JOB,S3,D1,D2))
- if D2=""
- QUIT
- DO PDAD(DISSORT,$GET(^(D2)),D1,D2,D3,.VALMCNT)
- End DoDot:1
- +5 IF DISSORT=1!(DISSORT=4)!(DISSORT=5)
- Begin DoDot:1
- +6 SET D1=""
- +7 ;
- +8 IF DISSORT'=5
- Begin DoDot:2
- +9 IF DISSORT=4
- Begin DoDot:3
- +10 DO ADD^XTVSLAPI(.VALMCNT,"{package name}^{prefix}^{#rtns}^{size of rtns}^{#files}^{#fields}^{#options}^{#protocols}^{#RPCs}^{#templates}")
- End DoDot:3
- +11 FOR
- SET D1=$ORDER(^TMP("XTVS-VPS",$JOB,D1))
- if D1=""
- QUIT
- SET D2=""
- Begin DoDot:3
- +12 FOR
- SET D2=$ORDER(^TMP("XTVS-VPS",$JOB,D1,D2))
- if D2=""
- QUIT
- Begin DoDot:4
- +13 DO PDAD(DISSORT,$GET(^(D2)),D1,D2,"",.VALMCNT)
- End DoDot:4
- End DoDot:3
- End DoDot:2
- +14 ;
- +15 IF DISSORT=5
- Begin DoDot:2
- +16 DO ADD^XTVSLAPI(.VALMCNT,"{package name}^{prefix}^{#rtns}^{size of rtns}^{#files}^{#fields}^{#options}^{#protocols}^{#RPCs}^{#templates}^{parent pkg}")
- +17 SET TMPSUB=""
- +18 FOR
- SET TMPSUB=$ORDER(^TMP("XTVS-VPS",$JOB,TMPSUB))
- if TMPSUB=""
- QUIT
- SET D1=""
- Begin DoDot:3
- +19 FOR
- SET D1=$ORDER(^TMP("XTVS-VPS",$JOB,TMPSUB,D1))
- if D1=""
- QUIT
- SET D2=""
- Begin DoDot:4
- +20 FOR
- SET D2=$ORDER(^TMP("XTVS-VPS",$JOB,TMPSUB,D1,D2))
- if D2=""
- QUIT
- Begin DoDot:5
- +21 DO PDAD(DISSORT,$GET(^(D2)),D1,D2,"",.VALMCNT)
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +22 ;
- +23 KILL ^TMP("XTVS-VPS",$JOB),^TMP("XTVS-PREFIX-IDX",$JOB),^TMP("XTVS-FORUM-PFXS",$JOB)
- +24 KILL ^TMP("XTVS-VPS0",$JOB),^TMP("XTVS-KIDSPFX-IDX",$JOB),^TMP("XTVS-FORUM2TMP",$JOB)
- +25 KILL ^TMP("XTVS-FORUMPKG",$JOB),^TMP("XTVS-IDX-PKG",$JOB)
- +26 ;
- KWIT ; QUIT Report
- +1 QUIT
- +2 ;
- PDAD(DISSORT,DATA,D1,D2,D3,VALMCNT) ; print actual data (finally)
- +1 NEW D4,D5,D6,D7,D8,D9,D10,DATANDE,SPCT
- +2 IF (DISSORT=1)!(DISSORT=4)!(DISSORT=5)
- Begin DoDot:1
- +3 SET D4=$PIECE(DATA,"^",2)
- SET D5=$PIECE(DATA,"^",3)
- SET D6=$PIECE(DATA,"^",4)
- 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
- +4 ;
- +5 ;Following code only executes when a caret (^) delimited report is selected
- +6 ;;Quit reporting sort types 4 & 5
- IF (DISSORT=4)!(DISSORT=5)
- Begin DoDot:1
- +7 SET DATANDE=""
- +8 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:"")
- +9 DO ADD^XTVSLAPI(.VALMCNT,DATANDE)
- End DoDot:1
- QUIT
- +10 ;
- +11 ;Following code only executes when user readable report selected (sort types 1, 2, or 3)
- +12 IF DISSORT=2!(DISSORT=3)
- Begin DoDot:1
- +13 SET D5=$PIECE(DATA,"^",2)
- SET D6=$PIECE(DATA,"^",3)
- SET D7=$PIECE(DATA,"^",4)
- SET D8=$PIECE(DATA,"^",5)
- SET D9=$PIECE(DATA,"^",6)
- SET D10=$PIECE(DATA,"^",7)
- +14 if DISSORT=2
- SET D4=+DATA
- +15 if DISSORT=3
- SET D4=D3
- SET D3=+DATA
- End DoDot:1
- +16 ;
- +17 DO ADD^XTVSLAPI(.VALMCNT,D1)
- +18 SET DATANDE=""
- +19 SET DATANDE="("_D2_")"
- +20 ;Space out 2nd data element
- FOR SPCT=1:1:11-$LENGTH(DATANDE)
- SET DATANDE=DATANDE_" "
- +21 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)
- +22 DO ADD^XTVSLAPI(.VALMCNT,DATANDE)
- +23 DO ADD^XTVSLAPI(.VALMCNT,"--------------------------------------------------------------------------------")
- +24 QUIT
- +25 ;
- TALLYRPT(DISSORT,XTVSSILN,SELPKGNM) ; Compile component totals
- +1 ; INPUT:
- +2 ; DISSORT -
- +3 ; 1: Sorted on PACKAGE NAME [Default]
- +4 ; 2: Sorted on NUMBER of ROUTINES (Highest to Lowest)
- +5 ; 3: Sorted on TOTAL ROUTINE SIZE (Highest to Lowest)
- +6 ; 4: Delimited (^) Data, Sorted on PACKAGE NAME
- +7 ; 5: Delimited (^) Data with PARENT PKG, Sorted by PACKAGE NAME
- +8 ;
- +9 ; XTVSSILN - Silent mode
- +10 ; 0: Show HangChar
- +11 ; 1: Silent [Default]
- +12 ;
- +13 ; SELPKGNM - Selected package name
- +14 ; Define when called from ONEPKGSZ^XTVSSVR to only check & send message
- +15 ; when selected package is missing
- +16 ;
- +17 ; Requires the following TMP globals are defined before execution:
- +18 ; ^TMP("XTVS-FORUMPKG",$J)
- +19 ; ^TMP("XTVS-KIDSPFX-IDX",$J)
- +20 ;
- +21 ;Create Prefix Indicies
- +22 ;
- +23 IF $GET(DISSORT)=""
- SET DISSORT=1
- +24 IF $GET(XTVSSILN)'=0
- SET XTVSSILN=1
- +25 ;
- +26 NEW D1,D2,D3,XTCHAR,TMPSUB,PCENUM,LINEITEM,PKGNAME,PKGPFX,LINECNT
- +27 NEW PREFIX,PKGIEN,FFCTRSLT
- +28 SET (D1,D2,D3)=0
- +29 ;
- +30 ; Create ^TMP("XTVS-IDX-PKG",$J) array for MULTX^XTVSRFL1
- +31 SET TMPSUB=0
- +32 FOR
- SET TMPSUB=$ORDER(^TMP("XTVS-FORUMPKG",$JOB,TMPSUB))
- if TMPSUB=""
- QUIT
- Begin DoDot:1
- +33 SET LINEITEM=^TMP("XTVS-FORUMPKG",$JOB,TMPSUB)
- +34 SET PKGNAME=$PIECE(LINEITEM,"^")
- +35 SET PKGPFX=$PIECE(LINEITEM,"^",2)
- +36 ;Prefix,Pkg-Name
- SET ^TMP("XTVS-PREFIX-IDX",$JOB,PKGPFX,PKGNAME)=""
- +37 ;Prefix
- SET ^TMP("XTVS-FORUM-PFXS",$JOB,PKGPFX)=""
- +38 ; Following ^TMP for PACKAGES in Param file: Prefix,Pkg-Name = 1 when KIDS Prefix, Null when not KIDS Prefix
- +39 IF '$DATA(^TMP("XTVS-KIDSPFX-IDX",$JOB,PKGPFX))
- SET ^TMP("XTVS-IDX-PKG",$JOB,PKGPFX,PKGNAME)=""
- +40 IF $DATA(^TMP("XTVS-KIDSPFX-IDX",$JOB,PKGPFX))
- SET ^TMP("XTVS-IDX-PKG",$JOB,PKGPFX,PKGNAME)=$SELECT(^TMP("XTVS-KIDSPFX-IDX",$JOB,PKGPFX)=PKGNAME:1,1:"")
- +41 ;
- +42 SET ADDPRFX=$PIECE(LINEITEM,"^",5)
- +43 SET LPCNT=0
- +44 FOR PCENUM=1:1
- SET PREFIX=$PIECE(ADDPRFX,"|",PCENUM)
- if PREFIX=""
- QUIT
- Begin DoDot:2
- +45 ;Prefix
- SET ^TMP("XTVS-FORUM-PFXS",$JOB,PREFIX)=""
- +46 ; Following ^TMP for PACKAGES in Param file : Prefix,Pkg-Name = 1 when KIDS Prefix, Null when not KIDS Prefix
- +47 SET ^TMP("XTVS-IDX-PKG",$JOB,PREFIX,PKGNAME)=$SELECT($DATA(^TMP("XTVS-KIDSPFX-IDX",$JOB,PREFIX)):1,1:"")
- End DoDot:2
- End DoDot:1
- +48 ;
- +49 ;Count components - ^TMP Global loop
- +50 if 'XTVSSILN
- WRITE !,"Compiling component totals for selected Package data file... "
- +51 SET (TMPSUB,XTCHAR)=0
- +52 FOR
- SET TMPSUB=$ORDER(^TMP("XTVS-FORUMPKG",$JOB,TMPSUB))
- if TMPSUB=""
- QUIT
- if 'XTVSSILN
- DO HANGCHAR^XTVSLAPI(.XTCHAR)
- Begin DoDot:1
- +53 SET PKGIEN=0
- +54 SET LINEITEM=^TMP("XTVS-FORUMPKG",$JOB,TMPSUB)
- +55 SET PKGNAME=$PIECE(LINEITEM,"^")
- +56 ;
- +57 IF PKGNAME["''"
- Begin DoDot:2
- +58
- *** ERROR ***
- IF $DATA(^DIC(9.4,"B",$REPLACE(PKGNAME,"''","""")))