A1VSLPER ;Albany FO/GTS - VistA Package Sizing Manager; 7-JUL-2016
;;1.0;VistA Package Sizing;;Oct 10, 2016;Build 25
EN ; -- main entry point for A1VS PKG MGR PARAM ERROR DISP
D EN^VALM("A1VS PKG MGR PARAM ERROR DISP")
Q
;
HDR ; -- header code
NEW DEFDIR,SPCPAD,DIRHEAD
SET SPCPAD=""
SET DEFDIR=$$GET^XPAR("SYS","A1VS PACKAGE MGR DEFAULT DIR",1,"I")
SET VALMHDR(1)=" VistA Package Size Analysis Manager - Prefix/File Overlap"
SET VALMHDR(2)=" Version: "_$$VERNUM^A1VSLM()_" Build: "_$$BLDNUM^A1VSLM()
SET DIRHEAD="Default Directory: "_DEFDIR
SET $P(SPCPAD," ",(80-$L(DIRHEAD))/2)=""
SET VALMHDR(3)=SPCPAD_DIRHEAD
SET SPCPAD=""
SET DIRHEAD="Parameter file: "_A1VPSPRM
SET $P(SPCPAD," ",(80-$L(DIRHEAD))/2)=""
SET VALMHDR(4)=SPCPAD_DIRHEAD
QUIT
;
INIT ; -- init variables and list array
DO KILL
DO INCONSCK ; Check for package Prefix/File Range Overlaps
;
NEW CMBLP
SET CMBLP=""
SET VALMCNT=0
FOR SET CMBLP=$O(^TMP("A1VS-ERROR",$J,"COMB-PFX-FLRNG",CMBLP)) Q:CMBLP="" DO ADD^A1VSLAPI(.VALMCNT,^TMP("A1VS-ERROR",$J,"COMB-PFX-FLRNG",CMBLP))
QUIT
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
DO KILL
Q
;
EXPND ; -- expand code
Q
;
KILL ; - Clean up local and global display arrays
DO CLEAN^VALM10 ;Kill data and video control arrays
DO KILL^VALM10() ;Kill Video attributes
KILL ^TMP("A1VS PKG MGR PARAM ERROR DISP",$JOB),^TMP("A1VS-ERROR",$J)
QUIT
;
;APIs
INCONSCK ;Check for overlaps in Forum Package file data
NEW TMPROOT,PKGNME,PREFIX,ADPFXIND,OLDPKG
SET TMPROOT="^TMP(""A1VS-PKGEDIT"","_$J_")"
SET OLDPKG=$QSUBSCRIPT($QUERY(@TMPROOT),3)
SET ADPFXIND=0
FOR SET TMPROOT=$QUERY(@TMPROOT) QUIT:TMPROOT="" Q:$QSUBSCRIPT(TMPROOT,1)'="A1VS-PKGEDIT" Q:$QSUBSCRIPT(TMPROOT,2)'=$JOB DO
. SET PKGNME=$QSUBSCRIPT(TMPROOT,3)
. SET PREFIX=$QSUBSCRIPT(TMPROOT,4)
. ; Execute "If" code when a new package is encountered
. IF (OLDPKG'=PKGNME) DO
.. ;1st loop on pkg, check primary prefix
.. IF ('ADPFXIND) DO CHKPFX(PKGNME,PREFIX,"^TMP(""A1VS-PKGEDIT"","_$J_","""_PKGNME_""","""_PREFIX_""")",PREFIX)
.. SET ADPFXIND=0 ;Reset the Add Prefix list found indicator after the first pass on the latest package
. SET OLDPKG=PKGNME
. DO FLDDATLP(TMPROOT,PKGNME,PREFIX,.ADPFXIND) ; Loop fields and data to check Prefix and File ranges
KILL ^TMP("A1VS-PKGRPT-PFX-IDX",$J),^TMP("A1VS-PKGRPT-FRNG-IDX",$J),^TMP("A1VS-PKGRPT-CMB-IDX",$J)
QUIT
;
FLDDATLP(TMPROOT,PKGNME,PREFIX,ADPFXIND) ;Check Fields and Data for 'ADDPFX' and 'FLERNG'
; Input: TMPROOT - Package "A1VS-PKGEDIT" array root [^TMP("A1VS-PKGEDIT",$J,PKGNME,PREFIX)]
; PKGNME - Package Name using Prefix
; PREFIX - Additional Prefix used by Package
; ADPFXIND - Indicates that prefix has been checked
;
NEW FLDSUB,DATASUB
SET FLDSUB=""
FOR SET FLDSUB=$O(@TMPROOT@(FLDSUB)) Q:FLDSUB="" DO
. SET DATASUB=""
. FOR SET DATASUB=$O(@TMPROOT@(FLDSUB,DATASUB)) Q:DATASUB="" DO
.. IF FLDSUB="ADDPFX" DO CHKPFX(PKGNME,DATASUB,TMPROOT,PREFIX) SET ADPFXIND=1
.. IF FLDSUB="FLERNG" DO CHKFILE(PKGNME,DATASUB,TMPROOT,PREFIX)
QUIT
;
CHKPFX(PKGNME,PREFIX,TMPROOT,PKGPFX) ; Check Prefix for multiple use
; Input: PKGNME - Package Name using Prefix
; PREFIX - Additional Prefix used by Package
; TMPROOT - Package "A1VS-PKGEDIT" array root [^TMP("A1VS-PKGEDIT",J,PKGNME,PREFIX)]
; PKGPFX - Package Prefix
;
; Output: ^TMP("A1VS-ERROR",$J,"PREFIX") array
;
NEW IDXROOT,PKGSUB,ERRARYCT,FILERPRT,ADDREMPX
SET FILERPRT=0
SET IDXROOT="^TMP(""A1VS-PFXIDX"","_$J_","""_PREFIX_""")" ;Use "PFXIDX" index
SET ADDREMPX=@IDXROOT@(PKGNME)
SET ERRARYCT=+$O(^TMP("A1VS-ERROR",$J,"PREFIX",""),-1)
FOR SET IDXROOT=$QUERY(@IDXROOT) Q:IDXROOT="" Q:$QSUBSCRIPT(IDXROOT,1)'="A1VS-PFXIDX" Q:$QSUBSCRIPT(IDXROOT,3)'[PREFIX Q:$QSUBSCRIPT(IDXROOT,2)'=$JOB DO
. SET PKGSUB=$QSUBSCRIPT(IDXROOT,4)
. IF PKGSUB'=PKGNME DO
.. NEW IDXRT3
.. SET IDXRT3=$QSUBSCRIPT(IDXROOT,3)
.. IF IDXRT3=PREFIX DO MLTPFX(TMPROOT,PKGSUB,PKGNME,IDXRT3,.ERRARYCT,.FILERPRT)
.. IF (IDXRT3'=PREFIX),(ADDREMPX'[IDXRT3) DO MLTPFX(TMPROOT,PKGSUB,PKGNME,IDXRT3,.ERRARYCT,.FILERPRT)
;
QUIT
;
CHKFILE(PKGNME,FLERNG,TMPROOT,PKGPFX) ; Check File range for multiple use
; Input: PKGNME - Package Name using Prefix
; FILRNG - File Range used by Package Name
; TMPROOT - Package "A1VS-PKGEDIT" array root
; PKGPFX - Package Prefix
;
; Output: ^TMP("A1VS-ERROR",$J,"FILERNG") array
;
NEW IDXROOT,STARTSUB,ENDSUB,PKGSUB,ERRARYCT,RNGBEG,RNGEND,PKGRPRT,RNGIND,PARENT,PREFIX,NODETXT,CMBARCT,NDTXTCMB
SET PKGRPRT=0
SET RNGBEG=$P(FLERNG,"-")
SET RNGEND=$P(FLERNG,"-",2)
SET ERRARYCT=+$O(^TMP("A1VS-ERROR",$J,"FILERNG",""),-1)
SET IDXROOT="^TMP(""A1VS-FRIDX"","_$J_")" ;;Use "FRIDX" index
FOR SET IDXROOT=$QUERY(@IDXROOT) Q:IDXROOT="" Q:$QSUBSCRIPT(IDXROOT,1)'="A1VS-FRIDX" Q:$QSUBSCRIPT(IDXROOT,2)'=$JOB DO
. SET STARTSUB=$QSUBSCRIPT(IDXROOT,3)
. SET ENDSUB=$QSUBSCRIPT(IDXROOT,4)
. SET PKGSUB=$QSUBSCRIPT(IDXROOT,5)
. IF PKGSUB'=PKGNME DO
.. SET RNGIND=$$RNGCHK(RNGBEG,RNGEND,STARTSUB,ENDSUB)
.. IF RNGIND DO
... SET ERRARYCT=ERRARYCT+1
... IF ERRARYCT=1 DO SETFLHDR("FILERNG",.ERRARYCT)
... ;
... SET CMBARCT=+$O(^TMP("A1VS-ERROR",$J,"COMB-PFX-FLRNG",""),-1)
... IF +CMBARCT=0 DO CMBARST(.CMBARCT)
... ;
... IF 'PKGRPRT DO NOPKGRT(PKGNME,PKGPFX,.ERRARYCT,.CMBARCT,.PKGRPRT) ;Output Package being reported
... SET PREFIX=$O(^TMP("A1VS-PKGEDIT",$J,PKGSUB,""))
... SET PARENT=^TMP("A1VS-PKGEDIT",$J,PKGSUB,PREFIX,"PARENT")
... SET NODETXT=" . "_PKGSUB_" ["_STARTSUB_"-"_ENDSUB_"]"_$S(PARENT]"":" (Parent: "_PARENT_")",1:"")
... SET NDTXTCMB=NODETXT
... IF ($L(NODETXT)>79),(NODETXT["(Parent") SET NODETXT=$$SPLITNDE(NODETXT,"FILERNG",.ERRARYCT)
... SET ^TMP("A1VS-ERROR",$J,"FILERNG",ERRARYCT)=NODETXT
... SET CMBARCT=CMBARCT+1
... IF ($L(NDTXTCMB)>79),(NDTXTCMB["(Parent") SET NODETXT=$$SPLITNDE(NDTXTCMB,"COMB-PFX-FLRNG",.CMBARCT)
... SET ^TMP("A1VS-ERROR",$J,"COMB-PFX-FLRNG",CMBARCT)=NODETXT
QUIT
;
MLTPFX(TMPROOT,PKGSUB,PKGNME,SUBPFX,ERRARYCT,FILERPRT) ; Report multiple use of prefix
NEW PARENT,CMBARCT,NODETXT,CMBHDR
SET (CMBHDR,PKGHDOUT)=0
SET PARENT=""
SET ERRARYCT=ERRARYCT+1
IF ERRARYCT=1 DO
. SET ^TMP("A1VS-ERROR",$J,"PREFIX",1)="The following Prefixes are multiply used by the indicated packages:"
. SET ERRARYCT=2
;
SET CMBARCT=+$O(^TMP("A1VS-ERROR",$J,"COMB-PFX-FLRNG",""),-1)
IF +CMBARCT=0 DO CMBARST(.CMBARCT)
;
SET PKGPFX=$O(^TMP("A1VS-PKGEDIT",$J,PKGSUB,""))
;
; IF not printed package header, print header
IF 'FILERPRT DO
. SET ^TMP("A1VS-ERROR",$J,"PREFIX",ERRARYCT)=" "
. SET CMBARCT=CMBARCT+1
. SET ^TMP("A1VS-ERROR",$J,"A1VS-PKGRPT-CMB-IDX",ERRARYCT)=" "
. SET ERRARYCT=ERRARYCT+1
. IF '$D(^TMP("A1VS-PKGRPT-PFX-IDX",$J,PKGNME)) DO PKGERHDR(TMPROOT,"^TMP(""A1VS-ERROR"","_$J_",""PREFIX"")",PKGNME,.ERRARYCT)
. IF '$D(^TMP("A1VS-PKGRPT-CMB-IDX",$J,PKGNME)) DO
.. SET CMBARCT=CMBARCT+1
.. SET ^TMP("A1VS-ERROR",$J,"COMB-PFX-FLRNG",CMBARCT)=" "
.. SET CMBARCT=CMBARCT+1
.. DO PKGERHDR(TMPROOT,"^TMP(""A1VS-ERROR"","_$J_",""COMB-PFX-FLRNG"")",PKGNME,.CMBARCT)
.. SET CMBHDR=1
. ;
. IF 'CMBHDR DO
.. SET CMBARCT=CMBARCT+1
.. SET ^TMP("A1VS-ERROR",$J,"COMB-PFX-FLRNG",CMBARCT)=" "
. ;
. SET NODETXT=" Prefix: "_PREFIX_" ; intersects the following packages..."
. SET ^TMP("A1VS-ERROR",$J,"PREFIX",ERRARYCT)=NODETXT
. SET ERRARYCT=ERRARYCT+1
. SET CMBARCT=CMBARCT+1
. SET ^TMP("A1VS-ERROR",$J,"COMB-PFX-FLRNG",CMBARCT)=NODETXT
. SET FILERPRT=1
SET PARENT=^TMP("A1VS-PKGEDIT",$J,PKGSUB,PKGPFX,"PARENT")
;
SET NODETXT=" . "_PKGSUB_" ["_SUBPFX_"] "_$S(PARENT]"":" (Parent: "_PARENT_")",1:"")
SET CMBARCT=CMBARCT+1
IF ($L(NODETXT)>79),(NODETXT["(Parent") DO
. NEW NDTXTCMB
. SET NDTXTCMB=NODETXT
. SET NODETXT=$$SPLITNDE(NODETXT,"PREFIX",.ERRARYCT)
. SET NODETXT=$$SPLITNDE(NDTXTCMB,"COMB-PFX-FLRNG",.CMBARCT)
SET ^TMP("A1VS-ERROR",$J,"PREFIX",ERRARYCT)=NODETXT
SET ^TMP("A1VS-ERROR",$J,"COMB-PFX-FLRNG",CMBARCT)=NODETXT
QUIT
;
;
PKGERHDR(TMPROOT,ERRAYRT,PKGNME,ERRARYCT) ; Output Header info for PREFIX and FILE RANGE overlap arrays
NEW PKGPFX
SET:$QSUBSCRIPT(ERRAYRT,3)="PREFIX" ^TMP("A1VS-PKGRPT-PFX-IDX",$J,PKGNME)="" ;Temporary index of Prefix overlap packages reported
SET:$QSUBSCRIPT(ERRAYRT,3)="FILERNG" ^TMP("A1VS-PKGRPT-FRNG-IDX",$J,PKGNME)="" ;Temporary index of File overlap packages reported
SET:$QSUBSCRIPT(ERRAYRT,3)="COMB-PFX-FLRNG" ^TMP("A1VS-PKGRPT-CMB-IDX",$J,PKGNME)="" ;Temporary index of File overlap packages reported
;
SET PKGPFX=$QSUBSCRIPT(TMPROOT,4)
SET @ERRAYRT@(ERRARYCT)=" "
SET ERRARYCT=ERRARYCT+1
SET @ERRAYRT@(ERRARYCT)=" "_PKGNME_" [Primary Prefix: "_PKGPFX_"]"
SET PARENT=@TMPROOT@("PARENT")
SET ERRARYCT=ERRARYCT+1
SET @ERRAYRT@(ERRARYCT)=" Parent: "_$S(PARENT]"":PARENT,1:"None indicated")
SET ERRARYCT=ERRARYCT+1
QUIT
;
CMBARST(CMBARCT) ;Add Header to Combined Prefix and File Range overlap error array
SET ^TMP("A1VS-ERROR",$J,"COMB-PFX-FLRNG",1)="The following Prefixes are multiply used by the indicated packages."
SET CMBARCT=2
DO SETFLHDR("COMB-PFX-FLRNG",.CMBARCT)
QUIT
;
SETFLHDR(NODETYPE,ERRARYCT) ;Set File Header
SET ^TMP("A1VS-ERROR",$J,NODETYPE,ERRARYCT)="The Primary Package file ranges are used by the listed packages."
SET ERRARYCT=ERRARYCT+1
SET ^TMP("A1VS-ERROR",$J,NODETYPE,ERRARYCT)="NOTE: The Primary Package defines Ranges from the Forum LOW-HIGH RANGE'"
SET ERRARYCT=ERRARYCT+1
SET ^TMP("A1VS-ERROR",$J,NODETYPE,ERRARYCT)=" Multiple or included in the FILE multiple. *LOWEST & *HIGHEST FILE NUMBER"
SET ERRARYCT=ERRARYCT+1
SET ^TMP("A1VS-ERROR",$J,NODETYPE,ERRARYCT)=" data is included with LOW-HIGH Range and FILE multiple data in the list"
SET ERRARYCT=ERRARYCT+1
SET ^TMP("A1VS-ERROR",$J,NODETYPE,ERRARYCT)=" of packages overlapping LOW-HIGH Range and FILE multiple data."
SET ERRARYCT=ERRARYCT+1
QUIT
;
SPLITNDE(TEXT,NODESUB,ERRARYCT) ;Split Error Node
NEW PARNTPLC,TXTSLICE,NODETXT
SET PARNTPLC=$FIND(TEXT,"(Parent")-7
SET TXTSLICE=$E(TEXT,1,PARNTPLC-1)
SET ^TMP("A1VS-ERROR",$J,NODESUB,ERRARYCT)=TXTSLICE
SET ERRARYCT=ERRARYCT+1
SET NODETXT=" "_$E(TEXT,PARNTPLC,$L(TEXT))
QUIT NODETXT
;
NOPKGRT(PKGNME,PKGPFX,ERRARYCT,CMBARCT,PKGRPRT) ;Report Package for File section
NEW NODETXT,FLEHDR
SET FLEHDR=0
SET ^TMP("A1VS-ERROR",$J,"FILERNG",ERRARYCT)=" "
SET ERRARYCT=ERRARYCT+1
SET CMBARCT=CMBARCT+1
IF ('$D(^TMP("A1VS-PKGRPT-FRNG-IDX",$J,PKGNME))) DO PKGERHDR(TMPROOT,"^TMP(""A1VS-ERROR"","_$J_",""FILERNG"")",PKGNME,.ERRARYCT)
IF ('$D(^TMP("A1VS-PKGRPT-CMB-IDX",$J,PKGNME))) DO
. SET ^TMP("A1VS-ERROR",$J,"COMB-PFX-FLRNG",CMBARCT)=" "
. SET CMBARCT=CMBARCT+1
. DO PKGERHDR(TMPROOT,"^TMP(""A1VS-ERROR"","_$J_",""COMB-PFX-FLRNG"")",PKGNME,.CMBARCT)
. SET FLEHDR=1
;
IF 'FLEHDR DO
. SET ^TMP("A1VS-ERROR",$J,"COMB-PFX-FLRNG",CMBARCT)=" "
. SET CMBARCT=CMBARCT+1
;
SET NODETXT=" File range, "_FLERNG_", overlaps with the following packages..."
SET ^TMP("A1VS-ERROR",$J,"FILERNG",ERRARYCT)=NODETXT
SET ERRARYCT=ERRARYCT+1
SET ^TMP("A1VS-ERROR",$J,"COMB-PFX-FLRNG",CMBARCT)=NODETXT
SET CMBARCT=CMBARCT+1
SET PKGRPRT=1
QUIT
;
;TO DO: GTS - Code here as follows:
; Create ^TMP("A1VS-ERROR",$J,"COMBINE",<pkgnme>) array in the form:
; <pkgname> <prefix>
; Parent: <pkgname> or "none indicated"
; [If Prefix overlap exists]
; Prefix: <prefix> used by
; . <pkgname> (Parent: <pkgname>)
; . <pkgname> (Parent: <pkgname>)
; [If File Range overlap exists]
; File Range:
; . <pkgname> [has range {begin num - end num}]
; . <pkgname> [has range {begin num - end num}]
;
;
RNGCHK(RNGBEG,RNGEND,STARTSUB,ENDSUB) ;Check Package file ranges against Range index
;Input:
; RNGBEG - Package File begin range to check
; RNGEND - Package File end range to check
; STARTSUB - Range Index - Start file Subscript
; ENDSUB - Range Index - End file Subscript
;
;Output:
; 1: Package file number OVERLAPS range
; 0: Package file number out of range
;
NEW INRNG
SET INRNG=0
IF RNGBEG'<STARTSUB,RNGBEG'>ENDSUB SET INRNG=1
IF RNGEND'<STARTSUB,RNGEND'>ENDSUB SET INRNG=1
IF RNGBEG<STARTSUB,RNGEND>ENDSUB SET INRNG=1
IF RNGBEG=STARTSUB,RNGEND=ENDSUB SET INRNG=1
QUIT INRNG
;
;Action Protocol APIs
DPFXERR ; Display prefix overlap list
; -- Protocol: A1VS PKG MGR PREFIX OVERLAP ACTION
;
NEW LPITEM
SET VALMHDR(1)=" VistA Package Size Analysis Manager - Prefix Overlap"
KILL ^TMP("A1VS PKG MGR PARAM ERROR DISP",$JOB)
SET VALMCNT=0
NEW LPITEM
SET LPITEM=""
FOR SET LPITEM=$O(^TMP("A1VS-ERROR",$J,"PREFIX",LPITEM)) Q:LPITEM="" DO ADD^A1VSLAPI(.VALMCNT,^TMP("A1VS-ERROR",$J,"PREFIX",LPITEM))
SET VALMBG=1
SET VALMBCK="R"
QUIT
;
DRNGERR ; Display File range errors
; -- Protocol: A1VS PKG MGR FILE OVERLAP ACTION
;
NEW LPITEM
SET VALMHDR(1)=" VistA Package Size Analysis Manager - File Overlap"
KILL ^TMP("A1VS PKG MGR PARAM ERROR DISP",$JOB)
SET VALMCNT=0
SET LPITEM=""
FOR SET LPITEM=$O(^TMP("A1VS-ERROR",$J,"FILERNG",LPITEM)) Q:LPITEM="" DO ADD^A1VSLAPI(.VALMCNT,^TMP("A1VS-ERROR",$J,"FILERNG",LPITEM))
SET VALMBG=1
SET VALMBCK="R"
QUIT
;
CMBERR ; Redisplay Prefix/File Range overlaps
; -- Protocol: A1VS PKG MGR PARAM OVRLP REDISP ACTION
;
NEW CMBLP ;NEW CODE
;
SET VALMHDR(1)=" VistA Package Size Analysis Manager - Prefix/File Overlap"
KILL ^TMP("A1VS PKG MGR PARAM ERROR DISP",$JOB)
SET VALMCNT=0
SET CMBLP=0
FOR SET CMBLP=$O(^TMP("A1VS-ERROR",$J,"COMB-PFX-FLRNG",CMBLP)) Q:CMBLP="" DO ADD^A1VSLAPI(.VALMCNT,^TMP("A1VS-ERROR",$J,"COMB-PFX-FLRNG",CMBLP))
SET VALMBG=1
SET VALMBCK="R"
QUIT
;
ERPT ; Email ^TMP("A1VS PKG MGR PARAM ERROR DISP") displayed report
; -- Protocol: A1VS PKG MGR EMAIL OVRLAP RPT ACTION
;
NEW A1INSTMM,A1TOMM,XMERR,XMZ,A1TYPE
DO FULL^VALM1
KILL XMERR
SET A1INSTMM("ADDR FLAGS")="R" ;Do not Restrict addressing
SET A1TYPE="S"
DO TOWHOM^XMXAPIU(DUZ,,A1TYPE,.A1INSTMM)
IF +$G(XMERR)'>0 DO
. NEW XMY,XMTEXT,XMDUZ,XMSUB,A1LPCNT
. SET A1LPCNT=""
. FOR SET A1LPCNT=$O(^TMP("XMY",$J,A1LPCNT)) QUIT:A1LPCNT="" SET XMY(A1LPCNT)=""
. SET XMDUZ=DUZ
. SET XMSUB=$P(VALMHDR(4),":",2)_" ("_$P(VALMHDR(1)," - ",2)_")"
. SET XMTEXT="^TMP(""A1VS PKG MGR PARAM ERROR DISP"","_$JOB_","
. DO ^XMD
. IF +XMZ>0 DO JUSTPAWS^A1VSLAPI($P(VALMHDR(1)," - ",2)_" E-Mailed. [MSG #:"_XMZ_"]")
. IF +XMZ'>0 DO JUSTPAWS^A1VSLAPI("Error: ^TMP(""A1VS PKG MGR PARAM ERROR DISP"","_$JOB_") not E-Mailed! ["_XMZ_"]")
;
SET VALMBCK="R"
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HA1VSLPER 14911 printed Oct 16, 2024@17:39:39 Page 2
A1VSLPER ;Albany FO/GTS - VistA Package Sizing Manager; 7-JUL-2016
+1 ;;1.0;VistA Package Sizing;;Oct 10, 2016;Build 25
EN ; -- main entry point for A1VS PKG MGR PARAM ERROR DISP
+1 DO EN^VALM("A1VS PKG MGR PARAM ERROR DISP")
+2 QUIT
+3 ;
HDR ; -- header code
+1 NEW DEFDIR,SPCPAD,DIRHEAD
+2 SET SPCPAD=""
+3 SET DEFDIR=$$GET^XPAR("SYS","A1VS PACKAGE MGR DEFAULT DIR",1,"I")
+4 SET VALMHDR(1)=" VistA Package Size Analysis Manager - Prefix/File Overlap"
+5 SET VALMHDR(2)=" Version: "_$$VERNUM^A1VSLM()_" Build: "_$$BLDNUM^A1VSLM()
+6 SET DIRHEAD="Default Directory: "_DEFDIR
+7 SET $PIECE(SPCPAD," ",(80-$LENGTH(DIRHEAD))/2)=""
+8 SET VALMHDR(3)=SPCPAD_DIRHEAD
+9 SET SPCPAD=""
+10 SET DIRHEAD="Parameter file: "_A1VPSPRM
+11 SET $PIECE(SPCPAD," ",(80-$LENGTH(DIRHEAD))/2)=""
+12 SET VALMHDR(4)=SPCPAD_DIRHEAD
+13 QUIT
+14 ;
INIT ; -- init variables and list array
+1 DO KILL
+2 ; Check for package Prefix/File Range Overlaps
DO INCONSCK
+3 ;
+4 NEW CMBLP
+5 SET CMBLP=""
+6 SET VALMCNT=0
+7 FOR
SET CMBLP=$ORDER(^TMP("A1VS-ERROR",$JOB,"COMB-PFX-FLRNG",CMBLP))
if CMBLP=""
QUIT
DO ADD^A1VSLAPI(.VALMCNT,^TMP("A1VS-ERROR",$JOB,"COMB-PFX-FLRNG",CMBLP))
+8 QUIT
+9 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 DO KILL
+2 QUIT
+3 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
KILL ; - Clean up local and global display arrays
+1 ;Kill data and video control arrays
DO CLEAN^VALM10
+2 ;Kill Video attributes
DO KILL^VALM10()
+3 KILL ^TMP("A1VS PKG MGR PARAM ERROR DISP",$JOB),^TMP("A1VS-ERROR",$JOB)
+4 QUIT
+5 ;
+6 ;APIs
INCONSCK ;Check for overlaps in Forum Package file data
+1 NEW TMPROOT,PKGNME,PREFIX,ADPFXIND,OLDPKG
+2 SET TMPROOT="^TMP(""A1VS-PKGEDIT"","_$JOB_")"
+3 SET OLDPKG=$QSUBSCRIPT($QUERY(@TMPROOT),3)
+4 SET ADPFXIND=0
+5 FOR
SET TMPROOT=$QUERY(@TMPROOT)
if TMPROOT=""
QUIT
if $QSUBSCRIPT(TMPROOT,1)'="A1VS-PKGEDIT"
QUIT
if $QSUBSCRIPT(TMPROOT,2)'=$JOB
QUIT
Begin DoDot:1
+6 SET PKGNME=$QSUBSCRIPT(TMPROOT,3)
+7 SET PREFIX=$QSUBSCRIPT(TMPROOT,4)
+8 ; Execute "If" code when a new package is encountered
+9 IF (OLDPKG'=PKGNME)
Begin DoDot:2
+10 ;1st loop on pkg, check primary prefix
+11 IF ('ADPFXIND)
DO CHKPFX(PKGNME,PREFIX,"^TMP(""A1VS-PKGEDIT"","_$JOB_","""_PKGNME_""","""_PREFIX_""")",PREFIX)
+12 ;Reset the Add Prefix list found indicator after the first pass on the latest package
SET ADPFXIND=0
End DoDot:2
+13 SET OLDPKG=PKGNME
+14 ; Loop fields and data to check Prefix and File ranges
DO FLDDATLP(TMPROOT,PKGNME,PREFIX,.ADPFXIND)
End DoDot:1
+15 KILL ^TMP("A1VS-PKGRPT-PFX-IDX",$JOB),^TMP("A1VS-PKGRPT-FRNG-IDX",$JOB),^TMP("A1VS-PKGRPT-CMB-IDX",$JOB)
+16 QUIT
+17 ;
FLDDATLP(TMPROOT,PKGNME,PREFIX,ADPFXIND) ;Check Fields and Data for 'ADDPFX' and 'FLERNG'
+1 ; Input: TMPROOT - Package "A1VS-PKGEDIT" array root [^TMP("A1VS-PKGEDIT",$J,PKGNME,PREFIX)]
+2 ; PKGNME - Package Name using Prefix
+3 ; PREFIX - Additional Prefix used by Package
+4 ; ADPFXIND - Indicates that prefix has been checked
+5 ;
+6 NEW FLDSUB,DATASUB
+7 SET FLDSUB=""
+8 FOR
SET FLDSUB=$ORDER(@TMPROOT@(FLDSUB))
if FLDSUB=""
QUIT
Begin DoDot:1
+9 SET DATASUB=""
+10 FOR
SET DATASUB=$ORDER(@TMPROOT@(FLDSUB,DATASUB))
if DATASUB=""
QUIT
Begin DoDot:2
+11 IF FLDSUB="ADDPFX"
DO CHKPFX(PKGNME,DATASUB,TMPROOT,PREFIX)
SET ADPFXIND=1
+12 IF FLDSUB="FLERNG"
DO CHKFILE(PKGNME,DATASUB,TMPROOT,PREFIX)
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
CHKPFX(PKGNME,PREFIX,TMPROOT,PKGPFX) ; Check Prefix for multiple use
+1 ; Input: PKGNME - Package Name using Prefix
+2 ; PREFIX - Additional Prefix used by Package
+3 ; TMPROOT - Package "A1VS-PKGEDIT" array root [^TMP("A1VS-PKGEDIT",J,PKGNME,PREFIX)]
+4 ; PKGPFX - Package Prefix
+5 ;
+6 ; Output: ^TMP("A1VS-ERROR",$J,"PREFIX") array
+7 ;
+8 NEW IDXROOT,PKGSUB,ERRARYCT,FILERPRT,ADDREMPX
+9 SET FILERPRT=0
+10 ;Use "PFXIDX" index
SET IDXROOT="^TMP(""A1VS-PFXIDX"","_$JOB_","""_PREFIX_""")"
+11 SET ADDREMPX=@IDXROOT@(PKGNME)
+12 SET ERRARYCT=+$ORDER(^TMP("A1VS-ERROR",$JOB,"PREFIX",""),-1)
+13 FOR
SET IDXROOT=$QUERY(@IDXROOT)
if IDXROOT=""
QUIT
if $QSUBSCRIPT(IDXROOT,1)'="A1VS-PFXIDX"
QUIT
if $QSUBSCRIPT(IDXROOT,3)'[PREFIX
QUIT
if $QSUBSCRIPT(IDXROOT,2)'=$JOB
QUIT
Begin DoDot:1
+14 SET PKGSUB=$QSUBSCRIPT(IDXROOT,4)
+15 IF PKGSUB'=PKGNME
Begin DoDot:2
+16 NEW IDXRT3
+17 SET IDXRT3=$QSUBSCRIPT(IDXROOT,3)
+18 IF IDXRT3=PREFIX
DO MLTPFX(TMPROOT,PKGSUB,PKGNME,IDXRT3,.ERRARYCT,.FILERPRT)
+19 IF (IDXRT3'=PREFIX)
IF (ADDREMPX'[IDXRT3)
DO MLTPFX(TMPROOT,PKGSUB,PKGNME,IDXRT3,.ERRARYCT,.FILERPRT)
End DoDot:2
End DoDot:1
+20 ;
+21 QUIT
+22 ;
CHKFILE(PKGNME,FLERNG,TMPROOT,PKGPFX) ; Check File range for multiple use
+1 ; Input: PKGNME - Package Name using Prefix
+2 ; FILRNG - File Range used by Package Name
+3 ; TMPROOT - Package "A1VS-PKGEDIT" array root
+4 ; PKGPFX - Package Prefix
+5 ;
+6 ; Output: ^TMP("A1VS-ERROR",$J,"FILERNG") array
+7 ;
+8 NEW IDXROOT,STARTSUB,ENDSUB,PKGSUB,ERRARYCT,RNGBEG,RNGEND,PKGRPRT,RNGIND,PARENT,PREFIX,NODETXT,CMBARCT,NDTXTCMB
+9 SET PKGRPRT=0
+10 SET RNGBEG=$PIECE(FLERNG,"-")
+11 SET RNGEND=$PIECE(FLERNG,"-",2)
+12 SET ERRARYCT=+$ORDER(^TMP("A1VS-ERROR",$JOB,"FILERNG",""),-1)
+13 ;;Use "FRIDX" index
SET IDXROOT="^TMP(""A1VS-FRIDX"","_$JOB_")"
+14 FOR
SET IDXROOT=$QUERY(@IDXROOT)
if IDXROOT=""
QUIT
if $QSUBSCRIPT(IDXROOT,1)'="A1VS-FRIDX"
QUIT
if $QSUBSCRIPT(IDXROOT,2)'=$JOB
QUIT
Begin DoDot:1
+15 SET STARTSUB=$QSUBSCRIPT(IDXROOT,3)
+16 SET ENDSUB=$QSUBSCRIPT(IDXROOT,4)
+17 SET PKGSUB=$QSUBSCRIPT(IDXROOT,5)
+18 IF PKGSUB'=PKGNME
Begin DoDot:2
+19 SET RNGIND=$$RNGCHK(RNGBEG,RNGEND,STARTSUB,ENDSUB)
+20 IF RNGIND
Begin DoDot:3
+21 SET ERRARYCT=ERRARYCT+1
+22 IF ERRARYCT=1
DO SETFLHDR("FILERNG",.ERRARYCT)
+23 ;
+24 SET CMBARCT=+$ORDER(^TMP("A1VS-ERROR",$JOB,"COMB-PFX-FLRNG",""),-1)
+25 IF +CMBARCT=0
DO CMBARST(.CMBARCT)
+26 ;
+27 ;Output Package being reported
IF 'PKGRPRT
DO NOPKGRT(PKGNME,PKGPFX,.ERRARYCT,.CMBARCT,.PKGRPRT)
+28 SET PREFIX=$ORDER(^TMP("A1VS-PKGEDIT",$JOB,PKGSUB,""))
+29 SET PARENT=^TMP("A1VS-PKGEDIT",$JOB,PKGSUB,PREFIX,"PARENT")
+30 SET NODETXT=" . "_PKGSUB_" ["_STARTSUB_"-"_ENDSUB_"]"_$SELECT(PARENT]"":" (Parent: "_PARENT_")",1:"")
+31 SET NDTXTCMB=NODETXT
+32 IF ($LENGTH(NODETXT)>79)
IF (NODETXT["(Parent")
SET NODETXT=$$SPLITNDE(NODETXT,"FILERNG",.ERRARYCT)
+33 SET ^TMP("A1VS-ERROR",$JOB,"FILERNG",ERRARYCT)=NODETXT
+34 SET CMBARCT=CMBARCT+1
+35 IF ($LENGTH(NDTXTCMB)>79)
IF (NDTXTCMB["(Parent")
SET NODETXT=$$SPLITNDE(NDTXTCMB,"COMB-PFX-FLRNG",.CMBARCT)
+36 SET ^TMP("A1VS-ERROR",$JOB,"COMB-PFX-FLRNG",CMBARCT)=NODETXT
End DoDot:3
End DoDot:2
End DoDot:1
+37 QUIT
+38 ;
MLTPFX(TMPROOT,PKGSUB,PKGNME,SUBPFX,ERRARYCT,FILERPRT) ; Report multiple use of prefix
+1 NEW PARENT,CMBARCT,NODETXT,CMBHDR
+2 SET (CMBHDR,PKGHDOUT)=0
+3 SET PARENT=""
+4 SET ERRARYCT=ERRARYCT+1
+5 IF ERRARYCT=1
Begin DoDot:1
+6 SET ^TMP("A1VS-ERROR",$JOB,"PREFIX",1)="The following Prefixes are multiply used by the indicated packages:"
+7 SET ERRARYCT=2
End DoDot:1
+8 ;
+9 SET CMBARCT=+$ORDER(^TMP("A1VS-ERROR",$JOB,"COMB-PFX-FLRNG",""),-1)
+10 IF +CMBARCT=0
DO CMBARST(.CMBARCT)
+11 ;
+12 SET PKGPFX=$ORDER(^TMP("A1VS-PKGEDIT",$JOB,PKGSUB,""))
+13 ;
+14 ; IF not printed package header, print header
+15 IF 'FILERPRT
Begin DoDot:1
+16 SET ^TMP("A1VS-ERROR",$JOB,"PREFIX",ERRARYCT)=" "
+17 SET CMBARCT=CMBARCT+1
+18 SET ^TMP("A1VS-ERROR",$JOB,"A1VS-PKGRPT-CMB-IDX",ERRARYCT)=" "
+19 SET ERRARYCT=ERRARYCT+1
+20 IF '$DATA(^TMP("A1VS-PKGRPT-PFX-IDX",$JOB,PKGNME))
DO PKGERHDR(TMPROOT,"^TMP(""A1VS-ERROR"","_$JOB_",""PREFIX"")",PKGNME,.ERRARYCT)
+21 IF '$DATA(^TMP("A1VS-PKGRPT-CMB-IDX",$JOB,PKGNME))
Begin DoDot:2
+22 SET CMBARCT=CMBARCT+1
+23 SET ^TMP("A1VS-ERROR",$JOB,"COMB-PFX-FLRNG",CMBARCT)=" "
+24 SET CMBARCT=CMBARCT+1
+25 DO PKGERHDR(TMPROOT,"^TMP(""A1VS-ERROR"","_$JOB_",""COMB-PFX-FLRNG"")",PKGNME,.CMBARCT)
+26 SET CMBHDR=1
End DoDot:2
+27 ;
+28 IF 'CMBHDR
Begin DoDot:2
+29 SET CMBARCT=CMBARCT+1
+30 SET ^TMP("A1VS-ERROR",$JOB,"COMB-PFX-FLRNG",CMBARCT)=" "
End DoDot:2
+31 ;
+32 SET NODETXT=" Prefix: "_PREFIX_" ; intersects the following packages..."
+33 SET ^TMP("A1VS-ERROR",$JOB,"PREFIX",ERRARYCT)=NODETXT
+34 SET ERRARYCT=ERRARYCT+1
+35 SET CMBARCT=CMBARCT+1
+36 SET ^TMP("A1VS-ERROR",$JOB,"COMB-PFX-FLRNG",CMBARCT)=NODETXT
+37 SET FILERPRT=1
End DoDot:1
+38 SET PARENT=^TMP("A1VS-PKGEDIT",$JOB,PKGSUB,PKGPFX,"PARENT")
+39 ;
+40 SET NODETXT=" . "_PKGSUB_" ["_SUBPFX_"] "_$SELECT(PARENT]"":" (Parent: "_PARENT_")",1:"")
+41 SET CMBARCT=CMBARCT+1
+42 IF ($LENGTH(NODETXT)>79)
IF (NODETXT["(Parent")
Begin DoDot:1
+43 NEW NDTXTCMB
+44 SET NDTXTCMB=NODETXT
+45 SET NODETXT=$$SPLITNDE(NODETXT,"PREFIX",.ERRARYCT)
+46 SET NODETXT=$$SPLITNDE(NDTXTCMB,"COMB-PFX-FLRNG",.CMBARCT)
End DoDot:1
+47 SET ^TMP("A1VS-ERROR",$JOB,"PREFIX",ERRARYCT)=NODETXT
+48 SET ^TMP("A1VS-ERROR",$JOB,"COMB-PFX-FLRNG",CMBARCT)=NODETXT
+49 QUIT
+50 ;
+51 ;
PKGERHDR(TMPROOT,ERRAYRT,PKGNME,ERRARYCT) ; Output Header info for PREFIX and FILE RANGE overlap arrays
+1 NEW PKGPFX
+2 ;Temporary index of Prefix overlap packages reported
if $QSUBSCRIPT(ERRAYRT,3)="PREFIX"
SET ^TMP("A1VS-PKGRPT-PFX-IDX",$JOB,PKGNME)=""
+3 ;Temporary index of File overlap packages reported
if $QSUBSCRIPT(ERRAYRT,3)="FILERNG"
SET ^TMP("A1VS-PKGRPT-FRNG-IDX",$JOB,PKGNME)=""
+4 ;Temporary index of File overlap packages reported
if $QSUBSCRIPT(ERRAYRT,3)="COMB-PFX-FLRNG"
SET ^TMP("A1VS-PKGRPT-CMB-IDX",$JOB,PKGNME)=""
+5 ;
+6 SET PKGPFX=$QSUBSCRIPT(TMPROOT,4)
+7 SET @ERRAYRT@(ERRARYCT)=" "
+8 SET ERRARYCT=ERRARYCT+1
+9 SET @ERRAYRT@(ERRARYCT)=" "_PKGNME_" [Primary Prefix: "_PKGPFX_"]"
+10 SET PARENT=@TMPROOT@("PARENT")
+11 SET ERRARYCT=ERRARYCT+1
+12 SET @ERRAYRT@(ERRARYCT)=" Parent: "_$SELECT(PARENT]"":PARENT,1:"None indicated")
+13 SET ERRARYCT=ERRARYCT+1
+14 QUIT
+15 ;
CMBARST(CMBARCT) ;Add Header to Combined Prefix and File Range overlap error array
+1 SET ^TMP("A1VS-ERROR",$JOB,"COMB-PFX-FLRNG",1)="The following Prefixes are multiply used by the indicated packages."
+2 SET CMBARCT=2
+3 DO SETFLHDR("COMB-PFX-FLRNG",.CMBARCT)
+4 QUIT
+5 ;
SETFLHDR(NODETYPE,ERRARYCT) ;Set File Header
+1 SET ^TMP("A1VS-ERROR",$JOB,NODETYPE,ERRARYCT)="The Primary Package file ranges are used by the listed packages."
+2 SET ERRARYCT=ERRARYCT+1
+3 SET ^TMP("A1VS-ERROR",$JOB,NODETYPE,ERRARYCT)="NOTE: The Primary Package defines Ranges from the Forum LOW-HIGH RANGE'"
+4 SET ERRARYCT=ERRARYCT+1
+5 SET ^TMP("A1VS-ERROR",$JOB,NODETYPE,ERRARYCT)=" Multiple or included in the FILE multiple. *LOWEST & *HIGHEST FILE NUMBER"
+6 SET ERRARYCT=ERRARYCT+1
+7 SET ^TMP("A1VS-ERROR",$JOB,NODETYPE,ERRARYCT)=" data is included with LOW-HIGH Range and FILE multiple data in the list"
+8 SET ERRARYCT=ERRARYCT+1
+9 SET ^TMP("A1VS-ERROR",$JOB,NODETYPE,ERRARYCT)=" of packages overlapping LOW-HIGH Range and FILE multiple data."
+10 SET ERRARYCT=ERRARYCT+1
+11 QUIT
+12 ;
SPLITNDE(TEXT,NODESUB,ERRARYCT) ;Split Error Node
+1 NEW PARNTPLC,TXTSLICE,NODETXT
+2 SET PARNTPLC=$FIND(TEXT,"(Parent")-7
+3 SET TXTSLICE=$EXTRACT(TEXT,1,PARNTPLC-1)
+4 SET ^TMP("A1VS-ERROR",$JOB,NODESUB,ERRARYCT)=TXTSLICE
+5 SET ERRARYCT=ERRARYCT+1
+6 SET NODETXT=" "_$EXTRACT(TEXT,PARNTPLC,$LENGTH(TEXT))
+7 QUIT NODETXT
+8 ;
NOPKGRT(PKGNME,PKGPFX,ERRARYCT,CMBARCT,PKGRPRT) ;Report Package for File section
+1 NEW NODETXT,FLEHDR
+2 SET FLEHDR=0
+3 SET ^TMP("A1VS-ERROR",$JOB,"FILERNG",ERRARYCT)=" "
+4 SET ERRARYCT=ERRARYCT+1
+5 SET CMBARCT=CMBARCT+1
+6 IF ('$DATA(^TMP("A1VS-PKGRPT-FRNG-IDX",$JOB,PKGNME)))
DO PKGERHDR(TMPROOT,"^TMP(""A1VS-ERROR"","_$JOB_",""FILERNG"")",PKGNME,.ERRARYCT)
+7 IF ('$DATA(^TMP("A1VS-PKGRPT-CMB-IDX",$JOB,PKGNME)))
Begin DoDot:1
+8 SET ^TMP("A1VS-ERROR",$JOB,"COMB-PFX-FLRNG",CMBARCT)=" "
+9 SET CMBARCT=CMBARCT+1
+10 DO PKGERHDR(TMPROOT,"^TMP(""A1VS-ERROR"","_$JOB_",""COMB-PFX-FLRNG"")",PKGNME,.CMBARCT)
+11 SET FLEHDR=1
End DoDot:1
+12 ;
+13 IF 'FLEHDR
Begin DoDot:1
+14 SET ^TMP("A1VS-ERROR",$JOB,"COMB-PFX-FLRNG",CMBARCT)=" "
+15 SET CMBARCT=CMBARCT+1
End DoDot:1
+16 ;
+17 SET NODETXT=" File range, "_FLERNG_", overlaps with the following packages..."
+18 SET ^TMP("A1VS-ERROR",$JOB,"FILERNG",ERRARYCT)=NODETXT
+19 SET ERRARYCT=ERRARYCT+1
+20 SET ^TMP("A1VS-ERROR",$JOB,"COMB-PFX-FLRNG",CMBARCT)=NODETXT
+21 SET CMBARCT=CMBARCT+1
+22 SET PKGRPRT=1
+23 QUIT
+24 ;
+25 ;TO DO: GTS - Code here as follows:
+26 ; Create ^TMP("A1VS-ERROR",$J,"COMBINE",<pkgnme>) array in the form:
+27 ; <pkgname> <prefix>
+28 ; Parent: <pkgname> or "none indicated"
+29 ; [If Prefix overlap exists]
+30 ; Prefix: <prefix> used by
+31 ; . <pkgname> (Parent: <pkgname>)
+32 ; . <pkgname> (Parent: <pkgname>)
+33 ; [If File Range overlap exists]
+34 ; File Range:
+35 ; . <pkgname> [has range {begin num - end num}]
+36 ; . <pkgname> [has range {begin num - end num}]
+37 ;
+38 ;
RNGCHK(RNGBEG,RNGEND,STARTSUB,ENDSUB) ;Check Package file ranges against Range index
+1 ;Input:
+2 ; RNGBEG - Package File begin range to check
+3 ; RNGEND - Package File end range to check
+4 ; STARTSUB - Range Index - Start file Subscript
+5 ; ENDSUB - Range Index - End file Subscript
+6 ;
+7 ;Output:
+8 ; 1: Package file number OVERLAPS range
+9 ; 0: Package file number out of range
+10 ;
+11 NEW INRNG
+12 SET INRNG=0
+13 IF RNGBEG'<STARTSUB
IF RNGBEG'>ENDSUB
SET INRNG=1
+14 IF RNGEND'<STARTSUB
IF RNGEND'>ENDSUB
SET INRNG=1
+15 IF RNGBEG<STARTSUB
IF RNGEND>ENDSUB
SET INRNG=1
+16 IF RNGBEG=STARTSUB
IF RNGEND=ENDSUB
SET INRNG=1
+17 QUIT INRNG
+18 ;
+19 ;Action Protocol APIs
DPFXERR ; Display prefix overlap list
+1 ; -- Protocol: A1VS PKG MGR PREFIX OVERLAP ACTION
+2 ;
+3 NEW LPITEM
+4 SET VALMHDR(1)=" VistA Package Size Analysis Manager - Prefix Overlap"
+5 KILL ^TMP("A1VS PKG MGR PARAM ERROR DISP",$JOB)
+6 SET VALMCNT=0
+7 NEW LPITEM
+8 SET LPITEM=""
+9 FOR
SET LPITEM=$ORDER(^TMP("A1VS-ERROR",$JOB,"PREFIX",LPITEM))
if LPITEM=""
QUIT
DO ADD^A1VSLAPI(.VALMCNT,^TMP("A1VS-ERROR",$JOB,"PREFIX",LPITEM))
+10 SET VALMBG=1
+11 SET VALMBCK="R"
+12 QUIT
+13 ;
DRNGERR ; Display File range errors
+1 ; -- Protocol: A1VS PKG MGR FILE OVERLAP ACTION
+2 ;
+3 NEW LPITEM
+4 SET VALMHDR(1)=" VistA Package Size Analysis Manager - File Overlap"
+5 KILL ^TMP("A1VS PKG MGR PARAM ERROR DISP",$JOB)
+6 SET VALMCNT=0
+7 SET LPITEM=""
+8 FOR
SET LPITEM=$ORDER(^TMP("A1VS-ERROR",$JOB,"FILERNG",LPITEM))
if LPITEM=""
QUIT
DO ADD^A1VSLAPI(.VALMCNT,^TMP("A1VS-ERROR",$JOB,"FILERNG",LPITEM))
+9 SET VALMBG=1
+10 SET VALMBCK="R"
+11 QUIT
+12 ;
CMBERR ; Redisplay Prefix/File Range overlaps
+1 ; -- Protocol: A1VS PKG MGR PARAM OVRLP REDISP ACTION
+2 ;
+3 ;NEW CODE
NEW CMBLP
+4 ;
+5 SET VALMHDR(1)=" VistA Package Size Analysis Manager - Prefix/File Overlap"
+6 KILL ^TMP("A1VS PKG MGR PARAM ERROR DISP",$JOB)
+7 SET VALMCNT=0
+8 SET CMBLP=0
+9 FOR
SET CMBLP=$ORDER(^TMP("A1VS-ERROR",$JOB,"COMB-PFX-FLRNG",CMBLP))
if CMBLP=""
QUIT
DO ADD^A1VSLAPI(.VALMCNT,^TMP("A1VS-ERROR",$JOB,"COMB-PFX-FLRNG",CMBLP))
+10 SET VALMBG=1
+11 SET VALMBCK="R"
+12 QUIT
+13 ;
ERPT ; Email ^TMP("A1VS PKG MGR PARAM ERROR DISP") displayed report
+1 ; -- Protocol: A1VS PKG MGR EMAIL OVRLAP RPT ACTION
+2 ;
+3 NEW A1INSTMM,A1TOMM,XMERR,XMZ,A1TYPE
+4 DO FULL^VALM1
+5 KILL XMERR
+6 ;Do not Restrict addressing
SET A1INSTMM("ADDR FLAGS")="R"
+7 SET A1TYPE="S"
+8 DO TOWHOM^XMXAPIU(DUZ,,A1TYPE,.A1INSTMM)
+9 IF +$GET(XMERR)'>0
Begin DoDot:1
+10 NEW XMY,XMTEXT,XMDUZ,XMSUB,A1LPCNT
+11 SET A1LPCNT=""
+12 FOR
SET A1LPCNT=$ORDER(^TMP("XMY",$JOB,A1LPCNT))
if A1LPCNT=""
QUIT
SET XMY(A1LPCNT)=""
+13 SET XMDUZ=DUZ
+14 SET XMSUB=$PIECE(VALMHDR(4),":",2)_" ("_$PIECE(VALMHDR(1)," - ",2)_")"
+15 SET XMTEXT="^TMP(""A1VS PKG MGR PARAM ERROR DISP"","_$JOB_","
+16 DO ^XMD
+17 IF +XMZ>0
DO JUSTPAWS^A1VSLAPI($PIECE(VALMHDR(1)," - ",2)_" E-Mailed. [MSG #:"_XMZ_"]")
+18 IF +XMZ'>0
DO JUSTPAWS^A1VSLAPI("Error: ^TMP(""A1VS PKG MGR PARAM ERROR DISP"","_$JOB_") not E-Mailed! ["_XMZ_"]")
End DoDot:1
+19 ;
+20 SET VALMBCK="R"
+21 QUIT
