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

XTVSRFL.m

Go to the documentation of this file.
  1. XTVSRFL ;BHAM/MAM/GTS - VistA Package Sizing Manager;
  1. ;;7.3;TOOLKIT;**143,152**;Apr 25, 1995;Build 3
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;
  1. INIT(VALMCNT,XTVPSPRM) ;;VistA Size Report entry point
  1. ;;INPUT:
  1. ; VALMCNT - Current Node # on ListMan ^TMP("XTVS PKG MGR RPT",$JOB) global
  1. ; XTVPSPRM - 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. ;; PTOT = 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 ; Select All or Single report
  1. W !!,"VistA Package Sizing Report",!
  1. S EXTDIR=$$GET^XPAR("SYS","XTVS 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..."
  1. S DIR("?",2)=" "_XTVPSPRM
  1. S DIR("?",3)=" ...file to be stored in "_EXTDIR_"."
  1. S DIR("?",4)=""
  1. S DIR("?",5)=" "_XTVPSPRM
  1. S DIR("?",6)=" is sourced from Package file data in Forum or other VistA instance."
  1. S DIR("?",7)=" The report will count package components on local VistA based on the"
  1. S DIR("?",8)=" parameters defined in the Package Parameter file for the package."
  1. S DIR("?",9)=""
  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 ; Select Sort for All report
  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(DISSORT,.VALMCNT)
  1. QUIT
  1. ;
  1. LOOP(DISSORT,VALMCNT) ; Loop through all entries in the Package parameters file
  1. NEW POPERR
  1. SET POPERR=0
  1. DO OPEN^%ZISH("XTMP",EXTDIR,XTVPSPRM,"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("XTVS-FORUMPKG",$J,LNNUM)=LINEITEM
  1. D CLOSE^%ZISH("XTMP")
  1. ;
  1. DO KIDSIDX^XTVSRFL1 ;Create Prefix-Package Indicies from KIDS
  1. ;
  1. ;Create Prefix Indicies
  1. DO TALLYRPT(DISSORT,0)
  1. ;
  1. ;Check existence of Packages
  1. DO PKGFLCK
  1. ;
  1. DISALL ; Set report into display array
  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^XTVSLAPI(.VALMCNT,"VistA Application Sizing Information Sort Type: "_DISSORT)
  1. . DO ADD^XTVSLAPI(.VALMCNT," ")
  1. . DO ADD^XTVSLAPI(.VALMCNT," Total")
  1. . DO ADD^XTVSLAPI(.VALMCNT,"Application Rtn")
  1. . DO ADD^XTVSLAPI(.VALMCNT,"(Namespace) Routines Size Files Fields Options Protocols RPCs Templates")
  1. . DO ADD^XTVSLAPI(.VALMCNT,"================================================================================")
  1. ;
  1. DAD ; Add report lines to display array
  1. NEW S3
  1. I DISSORT=2!(DISSORT=3) DO
  1. . S S3=""
  1. . 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)
  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^XTVSLAPI(.VALMCNT,"{package name}^{prefix}^{#rtns}^{size of rtns}^{#files}^{#fields}^{#options}^{#protocols}^{#RPCs}^{#templates}")
  1. .. FOR S D1=$O(^TMP("XTVS-VPS",$J,D1)) Q:D1="" S D2="" DO
  1. ... F S D2=$O(^TMP("XTVS-VPS",$J,D1,D2)) Q:D2="" DO
  1. .... D PDAD(DISSORT,$G(^(D2)),D1,D2,"",.VALMCNT)
  1. . ;
  1. . IF DISSORT=5 DO
  1. .. DO ADD^XTVSLAPI(.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("XTVS-VPS",$J,TMPSUB)) Q:TMPSUB="" S D1="" DO
  1. ... F S D1=$O(^TMP("XTVS-VPS",$J,TMPSUB,D1)) Q:D1="" S D2="" DO
  1. .... F S D2=$O(^TMP("XTVS-VPS",$J,TMPSUB,D1,D2)) Q:D2="" DO
  1. ..... D PDAD(DISSORT,$G(^(D2)),D1,D2,"",.VALMCNT)
  1. ;
  1. KILL ^TMP("XTVS-VPS",$J),^TMP("XTVS-PREFIX-IDX",$J),^TMP("XTVS-FORUM-PFXS",$J)
  1. KILL ^TMP("XTVS-VPS0",$J),^TMP("XTVS-KIDSPFX-IDX",$J),^TMP("XTVS-FORUM2TMP",$J)
  1. KILL ^TMP("XTVS-FORUMPKG",$J),^TMP("XTVS-IDX-PKG",$J)
  1. ;
  1. KWIT ; QUIT Report
  1. QUIT
  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. I (DISSORT=1)!(DISSORT=4)!(DISSORT=5) DO
  1. . 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
  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^XTVSLAPI(.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),D6=$P(DATA,"^",3),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^XTVSLAPI(.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^XTVSLAPI(.VALMCNT,DATANDE)
  1. DO ADD^XTVSLAPI(.VALMCNT,"--------------------------------------------------------------------------------")
  1. QUIT
  1. ;
  1. TALLYRPT(DISSORT,XTVSSILN,SELPKGNM) ; Compile component totals
  1. ; INPUT:
  1. ; DISSORT -
  1. ; 1: Sorted on PACKAGE NAME [Default]
  1. ; 2: Sorted on NUMBER of ROUTINES (Highest to Lowest)
  1. ; 3: Sorted on TOTAL ROUTINE SIZE (Highest to Lowest)
  1. ; 4: Delimited (^) Data, Sorted on PACKAGE NAME
  1. ; 5: Delimited (^) Data with PARENT PKG, Sorted by PACKAGE NAME
  1. ;
  1. ; XTVSSILN - Silent mode
  1. ; 0: Show HangChar
  1. ; 1: Silent [Default]
  1. ;
  1. ; SELPKGNM - Selected package name
  1. ; Define when called from ONEPKGSZ^XTVSSVR to only check & send message
  1. ; when selected package is missing
  1. ;
  1. ; Requires the following TMP globals are defined before execution:
  1. ; ^TMP("XTVS-FORUMPKG",$J)
  1. ; ^TMP("XTVS-KIDSPFX-IDX",$J)
  1. ;
  1. ;Create Prefix Indicies
  1. ;
  1. IF $GET(DISSORT)="" SET DISSORT=1
  1. IF $GET(XTVSSILN)'=0 SET XTVSSILN=1
  1. ;
  1. NEW D1,D2,D3,XTCHAR,TMPSUB,PCENUM,LINEITEM,PKGNAME,PKGPFX,LINECNT
  1. NEW PREFIX,PKGIEN,FFCTRSLT
  1. SET (D1,D2,D3)=0
  1. ;
  1. ; Create ^TMP("XTVS-IDX-PKG",$J) array for MULTX^XTVSRFL1
  1. SET TMPSUB=0
  1. FOR SET TMPSUB=$O(^TMP("XTVS-FORUMPKG",$J,TMPSUB)) QUIT:TMPSUB="" DO
  1. .SET LINEITEM=^TMP("XTVS-FORUMPKG",$J,TMPSUB)
  1. .SET PKGNAME=$P(LINEITEM,"^")
  1. .SET PKGPFX=$P(LINEITEM,"^",2)
  1. .SET ^TMP("XTVS-PREFIX-IDX",$J,PKGPFX,PKGNAME)="" ;Prefix,Pkg-Name
  1. .SET ^TMP("XTVS-FORUM-PFXS",$J,PKGPFX)="" ;Prefix
  1. .; Following ^TMP for PACKAGES in Param file: Prefix,Pkg-Name = 1 when KIDS Prefix, Null when not KIDS Prefix
  1. .IF '$D(^TMP("XTVS-KIDSPFX-IDX",$J,PKGPFX)) SET ^TMP("XTVS-IDX-PKG",$J,PKGPFX,PKGNAME)=""
  1. .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:"")
  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("XTVS-FORUM-PFXS",$J,PREFIX)="" ;Prefix
  1. .. ; Following ^TMP for PACKAGES in Param file : Prefix,Pkg-Name = 1 when KIDS Prefix, Null when not KIDS Prefix
  1. .. SET ^TMP("XTVS-IDX-PKG",$J,PREFIX,PKGNAME)=$S($D(^TMP("XTVS-KIDSPFX-IDX",$J,PREFIX)):1,1:"")
  1. ;
  1. ;Count components - ^TMP Global loop
  1. WRITE:'XTVSSILN !,"Compiling component totals for selected Package data file... "
  1. SET (TMPSUB,XTCHAR)=0
  1. FOR SET TMPSUB=$O(^TMP("XTVS-FORUMPKG",$J,TMPSUB)) QUIT:TMPSUB="" DO:'XTVSSILN HANGCHAR^XTVSLAPI(.XTCHAR) DO
  1. .SET PKGIEN=0
  1. .SET LINEITEM=^TMP("XTVS-FORUMPKG",$J,TMPSUB)
  1. .SET PKGNAME=$P(LINEITEM,"^")
  1. .;
  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. .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
  1. .DO COMPNTCT(PKGNAME,PKGIEN,LINEITEM,DISSORT)
  1. ;
  1. 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)
  1. 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)
  1. ;
  1. QUIT
  1. ;
  1. COMPNTCT(PKGNAME,PKGIEN,LINEITEM,DISSORT) ;Count components for package
  1. ;Input:
  1. ; PKGNAME - Package Name
  1. ; PKGIEN - Package File IEN for Package
  1. ; LINEITEM - Package Parameters from Parameter file
  1. ; DISSORT - Report Type (Sort) selected
  1. ;
  1. NEW APFXLST,RPFXLST,PCENUM,PKGPFX,LPA,APFX,RPFX,ADDPRFX,PRNTPKG
  1. NEW FTOT,OTOT,PTOT,RPTOT,RTOT,TLCNT,TPLTTOT,FLDTOT
  1. ;
  1. SET PKGPFX=$P(LINEITEM,"^",2)
  1. ;
  1. SET (FTOT,FLDTOT,OTOT,PTOT,RPTOT,RTOT,TLCNT,TPLTTOT)=0
  1. ;Count files & fields - entry in ^TMP global loop
  1. SET FFCTRSLT=$$COUNTFLS^XTVSRFL1(PKGPFX,$P(LINEITEM,"^",3),$P(LINEITEM,"^",4),$P(LINEITEM,"^",7),$P(LINEITEM,"^",8)) ; Files^Fields
  1. SET FTOT=$P(FFCTRSLT,"^") ;Extract File ctr
  1. SET FLDTOT=$P(FFCTRSLT,"^",2) ;Extract Field ctr
  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(RDP)=RPFX ;RDP = Excepted Namespace
  1. ;
  1. SET APFXLST=$P(LINEITEM,"^",5)
  1. SET (ADP,PCENUM)=0
  1. ; NOTE: MULTX screens a Primary or KIDS Prefix for another package from inclusion as an added prefix to current package
  1. 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
  1. ;
  1. SET RTOT=$$ROUTINE^XTVSRFL1(PKGPFX,.TLCNT,.RDP,.ADP) ;Count routines
  1. 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
  1. ;
  1. DO CNTR^XTVSRFL1("^DIC(19,",.OTOT,PKGPFX,.RDP,.ADP) ;Count Options
  1. I ADP F LPA=1:1:ADP I ADP(LPA)'="" D CNTR^XTVSRFL1("^DIC(19,",.OTOT,ADP(LPA),.RDP,.ADP)
  1. ;
  1. SET PTOT=$$PROTOCOL^XTVSRFL1(PKGPFX,PKGIEN,.RDP) ;Count Protocols
  1. I ADP F LPA=1:1:ADP I ADP(LPA)'="" SET PTOT=PTOT+$$PROTOCOL^XTVSRFL1(ADP(LPA),PKGIEN,.RDP)
  1. ;
  1. DO CNTR^XTVSRFL1("^XWB(8994,",.RPTOT,PKGPFX,.RDP,.ADP) ;Count Remote Procedure Calls
  1. I ADP F LPA=1:1:ADP I ADP(LPA)'="" D CNTR^XTVSRFL1("^XWB(8994,",.RPTOT,ADP(LPA),.RDP,.ADP)
  1. ;
  1. ; Count Templates
  1. DO CNTR^XTVSRFL1("^DIPT(",.TPLTTOT,PKGPFX,.RDP,.ADP) ;Print Templates
  1. I ADP F LPA=1:1:ADP I ADP(LPA)'="" D CNTR^XTVSRFL1("^DIPT(",.TPLTTOT,ADP(LPA),.RDP,.ADP)
  1. ;
  1. DO CNTR^XTVSRFL1("^DIBT(",.TPLTTOT,PKGPFX,.RDP,.ADP) ;Sort Templates
  1. I ADP F LPA=1:1:ADP I ADP(LPA)'="" D CNTR^XTVSRFL1("^DIBT(",.TPLTTOT,ADP(LPA),.RDP,.ADP)
  1. ;
  1. DO CNTR^XTVSRFL1("^DIE(",.TPLTTOT,PKGPFX,.RDP,.ADP) ;Input Templates
  1. I ADP F LPA=1:1:ADP I ADP(LPA)'="" D CNTR^XTVSRFL1("^DIE(",.TPLTTOT,ADP(LPA),.RDP,.ADP)
  1. ;
  1. SET:DISSORT'=5 ^TMP("XTVS-VPS",$J,PKGNAME,PKGPFX)=RTOT_"^"_TLCNT_"^"_FTOT_"^"_FLDTOT_"^"_OTOT_"^"_PTOT_"^"_RPTOT_"^"_TPLTTOT
  1. IF DISSORT=5 DO
  1. .SET PRNTPKG=$P(LINEITEM,"^",9)
  1. .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:"")
  1. ;
  1. KILL ADP,RDP
  1. ;
  1. QUIT
  1. ;
  1. PKGFLCK ; Check for Package File entries matching Parameter names, send report message
  1. ;Requires the ^TMP("XTVS-FORUMPKG",$J) global
  1. ;
  1. NEW TMPSUB,PKGIEN,PKGNAME,MSGNDENM
  1. KILL ^TMP("XTVS-LOCAL-ERROR",$JOB)
  1. SET (MSGNDENM,TMPSUB)=0
  1. FOR SET TMPSUB=$O(^TMP("XTVS-FORUMPKG",$J,TMPSUB)) QUIT:TMPSUB="" DO
  1. . SET PKGIEN=0
  1. . SET PKGNAME=$P(^TMP("XTVS-FORUMPKG",$J,TMPSUB),"^")
  1. . ;
  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. . IF PKGIEN=0 DO
  1. .. IF MSGNDENM=0 DO
  1. ... SET ^TMP("XTVS-LOCAL-ERROR",$JOB,1)="Package Size Report warning for "_^%ZOSF("PROD")_"."
  1. ... SET ^TMP("XTVS-LOCAL-ERROR",$JOB,2)=" The following package(s) are not found on this VistA."
  1. ... SET ^TMP("XTVS-LOCAL-ERROR",$JOB,3)=" (The number of protocols reported may be incorrect.)"
  1. .. SET MSGNDENM=$ORDER(^TMP("XTVS-LOCAL-ERROR",$JOB,""),-1)+1
  1. .. SET ^TMP("XTVS-LOCAL-ERROR",$JOB,MSGNDENM)=" - "_PKGNAME
  1. ;
  1. IF $D(^TMP("XTVS-LOCAL-ERROR",$JOB)) DO
  1. . NEW XMDUZ,XMY,XMTEXT,XMSUB
  1. . SET XMDUZ="VistA Package Size Analysis Manager"
  1. . SET XMY($$NETNAME^XMXUTIL(DUZ))=""
  1. . SET XMTEXT="^TMP(""XTVS-LOCAL-ERROR"","_$JOB_","
  1. . SET XMSUB="PACKAGE REPORT NOTICE ("_^%ZOSF("PROD")_") ; Report process warning."
  1. . DO ^XMD
  1. . IF +XMZ'>0 DO
  1. .. SET ERRTEXT="'Package Report Notice' FAILED to return to "_$$NETNAME^XMXUTIL(DUZ)_"."
  1. .. DO APPERROR^%ZTER("PKGFLCK^XTFSRFL : Package extract error")
  1. ;
  1. KILL ^TMP("XTVS-LOCAL-ERROR",$JOB)
  1. QUIT
  1. ;
  1. ONEPKG ; Select a package to report
  1. NEW PKGNAME,LINEITEM
  1. KILL ^TMP("XTVS-PARAM-CAP",$J),^TMP("XTVS-PREFIX-IDX",$J),^TMP("XTVS-FORUM-PFXS",$J),^TMP("XTVS-IDX-PKG",$J)
  1. DO OPEN^%ZISH("XTMP",EXTDIR,XTVPSPRM,"R")
  1. U IO
  1. SET VALMCNT=0
  1. FOR S LINEITEM="" READ LINEITEM:5 Q:$$STATUS^%ZISH DO
  1. . IF LINEITEM]"" DO SCAPARY^XTVSLP(LINEITEM) ;Creates ^TMP("XTVS-PARAM-CAP",$J) array
  1. DO CLOSE^%ZISH("XTMP")
  1. ;
  1. DO KIDSIDX^XTVSRFL1 ;Create Prefix-Package Indicies from KIDS [^TMP("XTVS-KIDSPFX-IDX")]
  1. ;
  1. SET PKGNAME=$$SELPKG^XTVSLPDC(0) ; Select the package to report
  1. ;
  1. IF PKGNAME=0 W !!,"VistA Package Not Selected!"
  1. IF PKGNAME'=0 DO
  1. . DO PARAMIDX^XTVSRFL1 ;Create Prefix Indicies
  1. . ;
  1. . DO ONERPT^XTVSRFL1(PKGNAME,.VALMCNT) ;Report stat's for a single package
  1. ;
  1. KILL ^TMP("XTVS-PREFIX-IDX",$J),^TMP("XTVS-FORUM-PFXS",$J),^TMP("XTVS-KIDSPFX-IDX",$J)
  1. KILL ^TMP("XTVS-PARAM-CAP",$J),^TMP("XTVS-IDX-PKG",$J)
  1. QUIT