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

A1VSRFL.m

Go to the documentation of this file. 
  1. 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
  1.  ;;
  1. INIT(VALMCNT,A1VPSPRM) ;;
  1.  ;;INPUT:
  1.  ;   VALMCNT  - Current Node # on ListMan ^TMP("A1VS PKG MGR RPT",$JOB) global
  1.  ;   A1VPSPRM - Package Parameter file to report against
  1.  ;
  1.  ;; data variables (local, for each package)
  1.  ;; PKGIEN = Package IEN
  1.  ;; PKGNAME = Package NAME (.01 - $P(^(0),"^",1))
  1.  ;; PKGPFX = Package PREFIX / NAMESPACE (1 - $P(^(0),"^",2))
  1.  ;; 
  1.  ;; RTOT = total ROUTINEs
  1.  ;; TLCNT = total SIZE of all ROUTINES
  1.  ;; FTOT = total FILEs
  1.  ;; FLDTOT = total FIELDs of all FILES
  1.  ;; OTOT = total OPTIONs (^DIC(19,)
  1.  ;; PRCTOT = total PROTOCOLs (^ORD(101,)
  1.  ;; RPTOT = total REMOTE PROCEDUREs (^XWB(8994,)
  1.  ;; TPLTTOT = total Fileman Templates
  1.  ;; 
  1.  I $G(DUZ)="" W !!,"DUZ must be defined." Q
  1.  ;
  1.  N X,Y,EXTDIR,DISSORT
  1.  ;
  1. ALL ;
  1.  W !!,"VistA Package Sizing Report",!
  1.  S EXTDIR=$$GET^XPAR("SYS","A1VS PACKAGE MGR DEFAULT DIR",1,"I") ;EXTDIR = Directory storing XTMPSIZE.DAT
  1.  N DIR S DIR(0)="YA",DIR("B")="NO"
  1.  S DIR("A")="Do you want to display Sizing Information for ALL VistA Packages? "
  1.  S DIR("?",1)="A Size report for ALL VistA Packages requires the "_A1VPSPRM_"file"
  1.  S DIR("?",2)=" to be stored in "_EXTDIR_"."
  1.  S DIR("?",3)=A1VPSPRM_" is an extract of Package file data from Forum or other VistA."
  1.  S DIR("?",4)=" Reporting a single package will count components on VistA based on"
  1.  S DIR("?",5)=" the local VistA Package file parameters defined for the package."
  1.  S DIR("?",6)=""
  1.  S DIR("?")="Enter Yes to report All packages; No to report a Single package."
  1.  D ^DIR I Y'=1,Y'=0 G KWIT
  1.  IF Y'=1 GOTO ONEPKG
  1.  ;
  1. SORT ;
  1.  N DIR S DIR("A")="Select VistA Size Report"
  1.  S DIR(0)="S^1:SORT ON PKG NAMES;2:SORT ON # OF ROUTINES - HIGH TO LOW;"
  1.  S DIR(0)=DIR(0)_"3:SORT ON PKG ROUTINES SIZE TOTAL - HIGH TO LOW;"
  1.  S DIR(0)=DIR(0)_"4:SORT ON PKG NAME, CARET DELIMITED DATA;"
  1.  S DIR(0)=DIR(0)_"5:SORT ON PKG NAME INCLUDE PARENT PKG, CARET DELIMITED DATA"
  1.  S DIR("L")="  5. Delimited (^) Data with PARENT PKG, Sorted by PACKAGE NAME"
  1.  S DIR("L",1)="Select which method to display the package size data: "
  1.  S DIR("L",2)=""
  1.  S DIR("L",3)="  1. Sorted on PACKAGE NAME"
  1.  S DIR("L",4)="  2. Sorted on NUMBER of ROUTINES (Highest to Lowest)"
  1.  S DIR("L",5)="  3. Sorted on TOTAL ROUTINE SIZE (Highest to Lowest)"
  1.  S DIR("L",6)="  4. Delimited (^) Data, Sorted on PACKAGE NAME"
  1.  D ^DIR G:'Y KWIT S DISSORT=+Y
  1.  ;
  1.  DO LOOP(.VALMCNT)
  1.  QUIT
  1.  ;
  1. LOOP(VALMCNT) ; Loop through all entries in the Package parameters file
  1.  KILL ^TMP("ZZVPS",$J),^TMP("A1VS-FORUMPKG",$J),^TMP("A1VS-PREFIX-IDX",$J),^TMP("A1VS-FORUM-PFXS",$J)
  1.  KILL ^TMP("ZZVPS0",$J),^TMP("A1VS-IDX-PKG",$J),^TMP("A1VS-KIDSPFX-IDX",$J)
  1.  NEW D1,D2,D3,POPERR,LNNUM,A1CHAR,TMPSUB,APFXLST,RPFXLST,PCENUM,LINEITEM,PKGNAME,PKGPFX
  1.  NEW APFX,RPFX,ADDPRFX,PREFIX,PRNTPKG,FTOT,OTOT,PTOT,RPTOT,RTOT,TLCNT,TPLTTOT,FLDTOT,PKGIEN
  1.  SET (D1,D2,D3)=0
  1.  SET POPERR=0
  1.  DO OPEN^%ZISH("XTMP",EXTDIR,A1VPSPRM,"R")
  1.  SET:POP POPERR=POP
  1.  QUIT:POPERR
  1.  U IO
  1.  SET LNNUM=0
  1.  FOR  S LINEITEM="" READ LINEITEM:5 Q:$$STATUS^%ZISH  DO
  1.  .IF LINEITEM]"" DO
  1.  ..S LNNUM=LNNUM+1
  1.  ..SET ^TMP("A1VS-FORUMPKG",$J,LNNUM)=LINEITEM
  1.  D CLOSE^%ZISH("XTMP")
  1.  ;
  1.  DO KIDSIDX^A1VSRFL1() ;Create Prefix-Package Indicies from KIDS
  1.  ;
  1.  ;Create Prefix Indicies
  1.  SET TMPSUB=0
  1.  FOR  SET TMPSUB=$O(^TMP("A1VS-FORUMPKG",$J,TMPSUB)) QUIT:TMPSUB=""  DO
  1.  .SET LINEITEM=^TMP("A1VS-FORUMPKG",$J,TMPSUB)
  1.  .SET PKGNAME=$P(LINEITEM,"^")
  1.  .SET PKGPFX=$P(LINEITEM,"^",2)
  1.  .SET ^TMP("A1VS-PREFIX-IDX",$J,PKGNAME,PKGPFX)="" ;Pkg-Name,Prefix
  1.  .SET ^TMP("A1VS-FORUM-PFXS",$J,PKGPFX)="" ;Prefix
  1.  .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
  1.  .;
  1.  .SET ADDPRFX=$P(LINEITEM,"^",5)
  1.  .SET LPCNT=0
  1.  .FOR PCENUM=1:1 SET PREFIX=$P(ADDPRFX,"|",PCENUM) Q:PREFIX=""  DO
  1.  .. SET ^TMP("A1VS-PREFIX-IDX",$J,$P(LINEITEM,"^"),PREFIX)="" ;Pkg-Name,Prefix
  1.  .. SET ^TMP("A1VS-FORUM-PFXS",$J,PREFIX)="" ;Prefix
  1.  .. SET ^TMP("A1VS-IDX-PKG",$J,PREFIX,$P(LINEITEM,"^"))="" ;Prefix,Pkg-Name (add Prefix) ;GTS - TO DO: Determine if want this Index
  1.  ;
  1.  ;Count components - ^TMP Global loop
  1.  WRITE !,"Compiling component totals for selected Package data file... "
  1.  SET (TMPSUB,A1CHAR)=0
  1.  FOR  SET TMPSUB=$O(^TMP("A1VS-FORUMPKG",$J,TMPSUB)) QUIT:TMPSUB=""  DO HANGCHAR^A1VSLAPI(.A1CHAR) DO
  1.  .SET LINEITEM=^TMP("A1VS-FORUMPKG",$J,TMPSUB)
  1.  .SET PKGNAME=$P(LINEITEM,"^")
  1.  .SET PKGIEN=$O(^DIC(9.4,"B",PKGNAME,""))
  1.  .SET PKGPFX=$P(LINEITEM,"^",2)
  1.  .SET (FTOT,OTOT,PTOT,RPTOT,RTOT,TLCNT,TPLTTOT)=0,FLDTOT="TBD"
  1.  .;
  1.  .;Count files - entry in ^TMP global loop
  1.  .SET FTOT=$$COUNTFLS^A1VSRFL1(PKGPFX,$P(LINEITEM,"^",3),$P(LINEITEM,"^",4),$P(LINEITEM,"^",7),$P(LINEITEM,"^",8))
  1.  .;
  1.  .;Define Excepted & Additional Prefix Arrays
  1.  .KILL RDP,ADP
  1.  .SET RPFXLST=$P(LINEITEM,"^",6)
  1.  .SET (RDP,PCENUM)=0
  1.  .FOR  SET PCENUM=PCENUM+1 SET RPFX=($P(RPFXLST,"|",PCENUM)) QUIT:RPFX']""  DO
  1.  .. SET RDP=RDP+1,RDP(RPFX)="" ;RDP = Excepted Namespace
  1.  .;
  1.  .SET APFXLST=$P(LINEITEM,"^",5)
  1.  .SET (ADP,PCENUM)=0
  1.  .;
  1.  .; NOTE: MULTX will prevent a Primary Prefix for another package from being included as an added prefix to current package
  1.  .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
  1.  .;
  1.  .SET RTOT=$$ROUTINE^A1VSRFL1(PKGPFX,.TLCNT,.RDP,.ADP)
  1.  .;
  1.  .SET OTOT=$$OPTION^A1VSRFL1(PKGPFX,PKGNAME,.RDP)
  1.  .SET ADDPRFX=""
  1.  .FOR  SET ADDPRFX=$O(ADP(ADDPRFX)) Q:ADDPRFX=""  SET OTOT=OTOT+$$OPTION^A1VSRFL1(ADDPRFX,PKGNAME,.RDP)
  1.  .;
  1.  .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
  1.  .DO CNTR^A1VSRFL1("^XWB(8994,",.RPTOT,PKGPFX,PKGNAME,.RDP,.ADP) ;Count Remote Procedure Calls
  1.  .DO CNTR^A1VSRFL1("^DIPT(",.TPLTTOT,PKGPFX,PKGNAME,.RDP,.ADP) ;Count Print Templates
  1.  .DO CNTR^A1VSRFL1("^DIBT(",.TPLTTOT,PKGPFX,PKGNAME,.RDP,.ADP) ;Count Sort Templates
  1.  .DO CNTR^A1VSRFL1("^DIE(",.TPLTTOT,PKGPFX,PKGNAME,.RDP,.ADP) ;Count Input Templates
  1.  .;
  1.  .SET:DISSORT'=5 ^TMP("ZZVPS",$J,PKGNAME,PKGPFX)=RTOT_"^"_TLCNT_"^"_FTOT_"^^"_OTOT_"^"_PTOT_"^"_RPTOT_"^"_TPLTTOT
  1.  .IF DISSORT=5 DO
  1.  ..SET PRNTPKG=$P(LINEITEM,"^",9)
  1.  ..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:"")
  1.  ;
  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)
  1.  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)
  1.  ;
  1. DISALL ;
  1.  ; display option 4 & 5 have no formatting, and are used for creating spreadsheets,
  1.  ; for which the following heading lines are not needed
  1.  I (DISSORT'=4)&(DISSORT'=5) D  ;
  1.  . DO ADD^A1VSLAPI(.VALMCNT,"VistA Application Sizing Information                               Sort Type: "_DISSORT)
  1.  . DO ADD^A1VSLAPI(.VALMCNT," ")
  1.  . DO ADD^A1VSLAPI(.VALMCNT,"                       Total")
  1.  . DO ADD^A1VSLAPI(.VALMCNT,"Application             Rtn")
  1.  . DO ADD^A1VSLAPI(.VALMCNT,"(Namespace)  Routines  Size   Files  Fields  Options  Protocols  RPCs  Templates")
  1.  . DO ADD^A1VSLAPI(.VALMCNT,"================================================================================")
  1.  ;
  1. DAD ;
  1.  NEW S3
  1.  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)
  1.  I DISSORT=1!(DISSORT=4)!(DISSORT=5) DO
  1.  . SET D1=""
  1.  . ;
  1.  . IF DISSORT'=5 DO
  1.  .. IF DISSORT=4 DO 
  1.  ... DO ADD^A1VSLAPI(.VALMCNT,"{package name}^{prefix}^{#rtns}^{size of rtns}^{#files}^{#fields}^{#options}^{#protocols}^{#RPCs}^{#templates}")
  1.  .. FOR  S D1=$O(^TMP("ZZVPS",$J,D1)) Q:D1=""  S D2="" DO
  1.  ... F  S D2=$O(^TMP("ZZVPS",$J,D1,D2)) Q:D2=""  DO
  1.  .... D PDAD(DISSORT,$G(^(D2)),D1,D2,"",.VALMCNT)
  1.  . ;
  1.  . IF DISSORT=5 DO
  1.  .. DO ADD^A1VSLAPI(.VALMCNT,"{package name}^{prefix}^{#rtns}^{size of rtns}^{#files}^{#fields}^{#options}^{#protocols}^{#RPCs}^{#templates}^{parent pkg}")
  1.  .. S TMPSUB=""
  1.  .. F  S TMPSUB=$O(^TMP("ZZVPS",$J,TMPSUB)) Q:TMPSUB=""  S D1="" DO
  1.  ... F  S D1=$O(^TMP("ZZVPS",$J,TMPSUB,D1)) Q:D1=""  S D2="" DO
  1.  .... F  S D2=$O(^TMP("ZZVPS",$J,TMPSUB,D1,D2)) Q:D2=""  DO
  1.  ..... D PDAD(DISSORT,$G(^(D2)),D1,D2,"",.VALMCNT)
  1.  ;
  1.  KILL ^TMP("ZZVPS",$J),^TMP("A1VS-FORUMPKG",$J),^TMP("A1VS-PREFIX-IDX",$J),^TMP("A1VS-FORUM-PFXS",$J)
  1.  KILL ^TMP("ZZVPS0",$J),^TMP("A1VS-IDX-PKG",$J),^TMP("A1VS-KIDSPFX-IDX",$J),^TMP("A1VS-FORUM2TMP",$J)
  1.  KILL ADP,RDP
  1.  ;
  1. KWIT ; QUIT Report
  1.  QUIT
  1.  ;
  1.  ;Report APIs
  1.  ; ^TMP("A1VS-IDX-PKG",$J,PREFIX,PKGNME)="" OR 1  ; 1 if Main Prefix for Package
  1.  ;
  1. PDAD(DISSORT,DATA,D1,D2,D3,VALMCNT) ; print actual data (finally)
  1.  N D4,D5,D6,D7,D8,D9,D10,DATANDE,SPCT
  1.  S D6="TBD"
  1.  I (DISSORT=1)!(DISSORT=4)!(DISSORT=5) DO
  1.  . ;N D3
  1.  . 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
  1.  ;
  1.  ;Following code only executes when a caret (^) delimited report is selected
  1.  I (DISSORT=4)!(DISSORT=5) DO  QUIT  ;;Quit reporting sort types 4 & 5
  1.  . SET DATANDE=""
  1.  . 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:"")
  1.  . DO ADD^A1VSLAPI(.VALMCNT,DATANDE)
  1.  ;
  1.  ;Following code only executes when user readable report selected (sort types 1, 2, or 3)
  1.  I DISSORT=2!(DISSORT=3) DO
  1.  . S D5=$P(DATA,"^",2),D7=$P(DATA,"^",4),D8=$P(DATA,"^",5),D9=$P(DATA,"^",6),D10=$P(DATA,"^",7)
  1.  . S:DISSORT=2 D4=+DATA
  1.  . S:DISSORT=3 D4=D3,D3=+DATA
  1.  ;
  1.  DO ADD^A1VSLAPI(.VALMCNT,D1)
  1.  SET DATANDE=""
  1.  SET DATANDE="("_D2_")"
  1.  FOR SPCT=1:1:11-$L(DATANDE) SET DATANDE=DATANDE_" " ;Space out 2nd data element
  1.  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)
  1.  DO ADD^A1VSLAPI(.VALMCNT,DATANDE)
  1.  DO ADD^A1VSLAPI(.VALMCNT,"--------------------------------------------------------------------------------")
  1.  QUIT
  1.  ;
  1. ONEPKG ; Select a package to report
  1.  NEW CAPNODE,PKGNAME
  1.  KILL ^TMP("A1VS-PARAM-CAP",$J)
  1.  DO OPEN^%ZISH("XTMP",EXTDIR,A1VPSPRM,"R")
  1.  U IO
  1.  SET (CAPNODE,VALMCNT)=0
  1.  FOR  S LINEITEM="" READ LINEITEM:5 Q:$$STATUS^%ZISH  DO
  1.  . IF LINEITEM]"" DO SCAPARY^A1VSLP(LINEITEM,.CAPNODE) ;Creates ^TMP("A1VS-PARAM-CAP",$J) array
  1.  D CLOSE^%ZISH("XTMP")
  1.  ;
  1.  SET PKGNAME=$$SELPKG^A1VSLPDC(0) ; Select the package to report
  1.  DO ONERPT^A1VSRFL1(PKGNAME,.VALMCNT) ;Report stat's for a single package
  1.  ;
  1.  KILL ^TMP("A1VS-PARAM-CAP",$J)
  1.  QUIT