A1VSLPC ;Albany FO/GTS - VistA Package Sizing Manager; 17-NOV-2016
;;1.0;VistA Package Sizing;;Oct 10, 2016;Build 25
EN(CMPRFNME) ; -- main entry point for A1VS PKG MGR PARAM COMPARE
; Input: CMPRFNME - File to compare current XTMPSIZE.DAT file
;
IF CMPRFNME'["XTMPSIZE" DO QUIT
. DO JUSTPAWS^A1VSLAPI("Comparison XTMPSIZE.DAT file NOT selected!")
;
D EN^VALM("A1VS PKG MGR PARAM COMPARE")
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 - Parameter Compare"
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="Current [New] file: "_A1VPSPRM
SET $P(SPCPAD," ",(80-$L(DIRHEAD))/2)=""
SET VALMHDR(4)=SPCPAD_DIRHEAD
SET DIRHEAD="Comparison [Old] file: "_CMPRFNME
SET $P(SPCPAD," ",(80-$L(DIRHEAD))/2)=""
SET VALMHDR(5)=SPCPAD_DIRHEAD
QUIT
;
INIT ; - Build Current and Comparison XTMPSIZE parameter arrays
NEW DEFDIR,NODENUM,NODECUR,CURNDNM,CPRNDNM,PKGRPTD,PKGDEL,DELSTATE
DO KILL ;Kill all processing & data arrays and video attributes & control arrays
SET DEFDIR=$$GET^XPAR("SYS","A1VS PACKAGE MGR DEFAULT DIR",1,"I")
;
;Build current XTMPSIZE parameter array
DO OPEN^%ZISH("XTMP",DEFDIR,A1VPSPRM,"R")
U IO
SET NODENUM=0
FOR S LINEITEM="" READ LINEITEM:5 Q:$$STATUS^%ZISH DO
. IF LINEITEM]"" DO
.. SET NODENUM=NODENUM+1
.. SET ^TMP("A1VS CUR PARAM",$JOB,NODENUM)=LINEITEM ;Creates ^TMP("A1VS CUR PARAM",$JOB) array
D CLOSE^%ZISH("XTMP")
;
;Build comparison XTMPSIZE parameter array
DO OPEN^%ZISH("XTMP2",DEFDIR,CMPRFNME,"R")
U IO
SET NODENUM=0
FOR S LINEITEM="" READ LINEITEM:5 Q:$$STATUS^%ZISH DO
. IF LINEITEM]"" DO
.. SET NODENUM=NODENUM+1
.. SET ^TMP("A1VS CPR PARAM",$JOB,NODENUM)=LINEITEM ;Creates ^TMP("A1VS CPR PARAM",$JOB) array
D CLOSE^%ZISH("XTMP2")
;
;Create ^TMP("A1VS PKG MAN PARM COMPARE",$JOB) comparison result array for ListMan display
SET (PKGRPTD,VALMCNT)=0
;
DO ADD^A1VSLAPI(.VALMCNT," ")
DO ADD^A1VSLAPI(.VALMCNT,"CHANGED PACKAGES",1,1,16) ;Output Header for Changed Package list
;Loop through each "Current" (latest) Package Lineitem
SET CURNDNM=0
FOR SET CURNDNM=$O(^TMP("A1VS CUR PARAM",$JOB,CURNDNM)) QUIT:CURNDNM="" SET NODECUR=^TMP("A1VS CUR PARAM",$JOB,CURNDNM) DO
. SET DELSTATE=0
. IF NODECUR=$G(^TMP("A1VS CPR PARAM",$JOB,CURNDNM)) DO DELPKG(CURNDNM,CURNDNM) SET DELSTATE=1 ;;Remove unedited package from CPR & CUR globals
. IF (NODECUR'=$G(^TMP("A1VS CPR PARAM",$JOB,CURNDNM))),('DELSTATE) DO ;;If Current Package '= same node on Compare Package lineitem
.. SET (PKGDEL,CPRNDNM)=0
.. FOR SET CPRNDNM=$O(^TMP("A1VS CPR PARAM",$JOB,CPRNDNM)) QUIT:CPRNDNM="" QUIT:PKGDEL DO COMPARE(CPRNDNM,NODECUR,.VALMCNT,.PKGDEL,.PKGRPTD)
IF PKGRPTD=0 DO
. DO ADD^A1VSLAPI(.VALMCNT," No edited packages!")
;
DO ADDDELRP("CUR",.VALMCNT) ;Report packages added new to Current package extract
DO ADDDELRP("CPR",.VALMCNT) ;Report packages deleted from Current package extract
SET PKGRPTD=0
;
QUIT
;
COMPARE(CPRNDNM,NODECUR,VALMCNT,PKGDEL,PKGRPTD) ; Compare current & selected parameter files, report diff's and cleanup ^TMP globals
NEW NODECPR,CURPKG,CPRPKG,FNDCHG,CPRPCS,CURPCS
SET CURPKG=$P(NODECUR,"^")
SET NODECPR=^TMP("A1VS CPR PARAM",$JOB,CPRNDNM)
SET CPRPKG=$P(NODECPR,"^")
;
; Set CPRPCS and CURPCS to compare new Parameter file to Old Parameter file
; (pce 10 = * on old parameter files indicated circular Parent/Child relationship)
SET CPRPCS=$L(NODECPR,"^")
SET CURPCS=$L(NODECUR,"^")
IF $P(NODECPR,"^",CPRPCS)="*" SET CPRPCS=CPRPCS-1
IF $P(NODECUR,"^",CURPCS)="*" SET CURPCS=CURPCS-1
;
IF ($P(NODECUR,"^",1,CURPCS)=$P(NODECPR,"^",1,CPRPCS)) DO DELPKG(CURNDNM,CPRNDNM) SET PKGDEL=1 ;Remove unedited Pkg from TMP globals, set PKGDEL to QUIT CPR loop
IF ($P(NODECUR,"^",1,CURPCS)'=$P(NODECPR,"^",1,CPRPCS)),(CPRPKG=CURPKG) DO
. SET FNDCHG=$$CHNGCHK(NODECUR,NODECPR,.VALMCNT) ;NOTE: FNDCHG not used
. DO DELPKG(CURNDNM,CPRNDNM) ;Remove edited Pkg from globals
. SET PKGRPTD=1 ;PKGRPTD prevents 'No edited packages' msg
. SET PKGDEL=1 ; Quit CPR Node loop
QUIT
;
CHNGCHK(NODECUR,NODECPR,VALMCNT) ; Check latest extract (CUR) against a comparison extract (CPR)
NEW FNDCHNG,PKGHDRPT,PKGNAME
NEW CURPPFX,CPRPPFX,CURHF,CPRHF,CURLF,CPRLF,CURADPFX,CPRADPFX,CUREXPFX,CPREXPFX,CURFL,CPRFL,CURFRL,CPRFRL,CURPP,CPRPP
;Variable doc key:
; CPR* is compare file data
; CUR* is current file data
; *PPFX - Primary Prefix
; *HF - *Highest file number
; *LF - *Lowest file number
; *ADPFX - Additional Prefices
; *EXPFX - Excluded Prefices
; *FL - File List
; *FRL - File Range List
; *PP - Parent Package
;
SET (FNDCHNG,PKGHDRPT)=0
SET PKGNAME=$P(NODECUR,"^")
SET STRVLMCT=VALMCNT
;
;Prefix
SET CURPPFX=$P(NODECUR,"^",2)
SET CPRPPFX=$P(NODECPR,"^",2)
IF CURPPFX'=CPRPPFX DO
.DO:'PKGHDRPT HDROUT(PKGNAME,.PKGHDRPT,.VALMCNT)
.DO ADD^A1VSLAPI(.VALMCNT,"New Prefix: "_$S(CURPPFX]"":CURPPFX,1:"{none}")_" Old Prefix: "_$S(CPRPPFX]"":CPRPPFX,1:"{none}"))
;
;Low File
SET CURLF=$P(NODECUR,"^",3)
SET CPRLF=$P(NODECPR,"^",3)
IF CURLF'=CPRLF DO
.DO:'PKGHDRPT HDROUT(PKGNAME,.PKGHDRPT,.VALMCNT)
.DO ADD^A1VSLAPI(.VALMCNT,"New Low File #: "_$S(CURLF]"":CURLF,1:"{none}")_" Old Low File #: "_$S(CPRLF]"":CPRLF,1:"{none}"))
;
;High File
SET CURHF=$P(NODECUR,"^",4)
SET CPRHF=$P(NODECPR,"^",4)
IF CURHF'=CPRHF DO
.DO:'PKGHDRPT HDROUT(PKGNAME,.PKGHDRPT,.VALMCNT)
.DO ADD^A1VSLAPI(.VALMCNT,"New High File #: "_$S(CURHF]"":CURHF,1:"{none}")_" Old High File #: "_$S(CPRHF]"":CPRHF,1:"{none}"))
;
;Additional Prefixes
SET CURADPFX=$P(NODECUR,"^",5)
SET CPRADPFX=$P(NODECPR,"^",5)
IF CURADPFX'=CPRADPFX DO
.DO:'PKGHDRPT HDROUT(PKGNAME,.PKGHDRPT,.VALMCNT)
.DO LISTDIF("Additional Prefixes",CURADPFX,CPRADPFX,.VALMCNT)
;
;Excluded Prefixes
SET CUREXPFX=$P(NODECUR,"^",6)
SET CPREXPFX=$P(NODECPR,"^",6)
IF CUREXPFX'=CPREXPFX DO
.DO:'PKGHDRPT HDROUT(PKGNAME,.PKGHDRPT,.VALMCNT)
.DO LISTDIF("Excepted Prefixes",CUREXPFX,CPREXPFX,.VALMCNT)
;
;File List
SET CURFL=$P(NODECUR,"^",7)
SET CPRFL=$P(NODECPR,"^",7)
IF CURFL'=CPRFL DO
.DO:'PKGHDRPT HDROUT(PKGNAME,.PKGHDRPT,.VALMCNT)
.DO LISTDIF("Files",CURFL,CPRFL,.VALMCNT)
;
;File Range List
SET CURFRL=$P(NODECUR,"^",8)
SET CPRFRL=$P(NODECPR,"^",8)
IF CURFRL'=CPRFRL DO
.DO:'PKGHDRPT HDROUT(PKGNAME,.PKGHDRPT,.VALMCNT)
.DO LISTDIF("File Ranges",CURFRL,CPRFRL,.VALMCNT)
;
;Parent
SET CURPP=$P(NODECUR,"^",9)
SET CPRPP=$P(NODECPR,"^",9)
IF CURPP'=CPRPP DO
.DO:'PKGHDRPT HDROUT(PKGNAME,.PKGHDRPT,.VALMCNT)
.DO ADD^A1VSLAPI(.VALMCNT,"Parent")
.DO ADD^A1VSLAPI(.VALMCNT," New: "_$S(CURPP]"":CURPP,1:"{none}"))
.DO ADD^A1VSLAPI(.VALMCNT," Old: "_$S(CPRPP]"":CPRPP,1:"{none}"))
;
IF VALMCNT'=STRVLMCT SET FNDCHNG=1
QUIT FNDCHNG
;
ADDDELRP(EXTRCT,VALMCNT) ;Report packages Added/Deleted to/from current extract
NEW HDRTXT,NODENM,NODEVAL,DATAELMT,PKGFND
;
SET HDRTXT=$S(EXTRCT="CUR":"ADDED",1:"DELETED")_" PACKAGES:"
DO ADD^A1VSLAPI(.VALMCNT," ")
DO ADD^A1VSLAPI(.VALMCNT," ")
DO ADD^A1VSLAPI(.VALMCNT,HDRTXT,1,1,$L(HDRTXT))
;
SET PKGFND=0
SET NODENM=""
FOR SET NODENM=$O(^TMP("A1VS "_EXTRCT_" PARAM",$JOB,NODENM)) QUIT:NODENM="" SET NODEVAL=^TMP("A1VS "_EXTRCT_" PARAM",$JOB,NODENM) DO
. SET PKGFND=1
. DO HDROUT($P(NODEVAL,"^",1),.PKGHDRPT,.VALMCNT) ;Output package name
. ;
. SET DATAELMT=$P(NODEVAL,"^",2)
. DO ADD^A1VSLAPI(.VALMCNT,"Prefix: "_$S(DATAELMT]"":DATAELMT,1:"{none}"))
. ;
. SET DATAELMT=$P(NODEVAL,"^",3)
. DO ADD^A1VSLAPI(.VALMCNT,"Low File #: "_$S(DATAELMT]"":DATAELMT,1:"{none}"))
. ;
. SET DATAELMT=$P(NODEVAL,"^",4)
. DO ADD^A1VSLAPI(.VALMCNT,"High File #: "_$S(DATAELMT]"":DATAELMT,1:"{none}"))
. ;
. DO ADD^A1VSLAPI(.VALMCNT,"Additional Prefixes: ")
. SET DATAELMT=$P(NODEVAL,"^",5)
. DO EVENSPLT(.VALMCNT,$S(DATAELMT]"":DATAELMT,1:"{none}"))
. ;
. DO ADD^A1VSLAPI(.VALMCNT,"Excepted Prefixes: ")
. SET DATAELMT=$P(NODEVAL,"^",6)
. DO EVENSPLT(.VALMCNT,$S(DATAELMT]"":DATAELMT,1:"{none}"))
. ;
. DO ADD^A1VSLAPI(.VALMCNT,"File List: ")
. SET DATAELMT=$P(NODEVAL,"^",7)
. DO EVENSPLT(.VALMCNT,$S(DATAELMT]"":DATAELMT,1:"{none}"))
. ;
. DO ADD^A1VSLAPI(.VALMCNT,"File Range list: ")
. SET DATAELMT=$P(NODEVAL,"^",8)
. DO EVENSPLT(.VALMCNT,$S(DATAELMT]"":DATAELMT,1:"{none}"))
. ;
. SET DATAELMT=$P(NODEVAL,"^",9)
. DO ADD^A1VSLAPI(.VALMCNT,"Parent: "_$S(DATAELMT]"":DATAELMT,1:"{none}"))
;
DO:'PKGFND ADD^A1VSLAPI(.VALMCNT," No "_$S(EXTRCT="CUR":"added",EXTRCT="CPR":"deleted",1:"")_" packages!")
QUIT
;
HELP ; -- help code
SET X="?" D DISP^XQORM1
;SET VALMBCK="R"
Q
;
EXIT ; -- exit code
DO KILL
Q
;
EXPND ; -- expand code
Q
;
REFRESH ; -- refresh display
DO INIT
SET VALMBCK="R"
QUIT
;
MSG(TEXT) ; -- set default message
;SET VALMSG=TEXT
QUIT
;
KILL ; - Cleanup local and global display arrays
DO CLEAN^VALM10 ;Kill data and video control arrays
DO KILL^VALM10() ;Kill Video attributes
DO CLNTMPGB
KILL ^TMP("A1VS PKG MAN PARM COMPARE",$JOB)
KILL DIR,X,Y,DTOUT,DIRUT,DUOUT
QUIT
;
CLNTMPGB ;Kill temporary globals
KILL ^TMP("A1VS CUR PARAM",$JOB),^TMP("A1VS CPR PARAM",$JOB)
QUIT
;
HDROUT(PKGNAME,PKGHDRPT,VALMCNT) ; Output package header
SET PKGHDRPT=1
DO ADD^A1VSLAPI(.VALMCNT," ")
DO ADD^A1VSLAPI(.VALMCNT,"Package: "_PKGNAME,1,10,$L(PKGNAME)) ;ADD^A1VSLAPI parameters: VALMCNT,MSG,LRBOLD,STRTBLD,ENDBLD
QUIT
;
LISTDIF(ELMTNME,CURDAT,CPRDAT,VALMCNT) ; Output differences in parameter lists
NEW PCENUM,DATAELMT
DO ADD^A1VSLAPI(.VALMCNT," "_ELMTNME)
;
IF (CURDAT]""),(CPRDAT']"") DO
. DO EVENSPLT(.VALMCNT,"Added entire list in New file: ",1)
. DO EVENSPLT(.VALMCNT,CURDAT)
IF (CURDAT']""),(CPRDAT]"") DO
. DO EVENSPLT(.VALMCNT,"Deleted entire list in New file: ",1)
. DO EVENSPLT(.VALMCNT,CPRDAT)
;
IF (CURDAT]""),(CPRDAT]"") DO ;List changes as lineitems
. DO EVENSPLT(.VALMCNT,"Old List: "_$S(CPRDAT]"":CPRDAT,1:"{none}"),1)
. ;
. ;Check for deletions
. FOR PCENUM=1:1 SET DATAELMT=$P(CPRDAT,"|",PCENUM) Q:DATAELMT="" DO
.. IF CURDAT'[DATAELMT_"|" DO EVENSPLT(.VALMCNT,DATAELMT_" ...deleted in New file")
. IF PCENUM=1 DO ADD^A1VSLAPI(.VALMCNT," {none} ...deleted in New file")
. ;
. ;Check for additions
. FOR PCENUM=1:1 SET DATAELMT=$P(CURDAT,"|",PCENUM) Q:DATAELMT="" DO
.. IF CPRDAT'[DATAELMT_"|" DO EVENSPLT(.VALMCNT,DATAELMT_" ...added in New file")
. IF PCENUM=1 DO ADD^A1VSLAPI(.VALMCNT," {none} ...added in New file")
. ;
. DO EVENSPLT(.VALMCNT,"New List: "_$s(CURDAT]"":CURDAT,1:"{none}"),1)
;
QUIT
;
EVENSPLT(VALMCNT,MSG,DTANODE) ; Add line to build display split on piece
; VALMCNT - Current array node number
; MSG - Message to add to ListMan Display
; DTANODE - Indicates raw data node or data element changed
; 1 : Raw data node
; 0 : data element changed
;
NEW PCENUM,MSGPCE,LINEOUT,START
SET DTANODE=+$G(DTANODE)
SET LINEOUT=""
SET START=1
;
FOR PCENUM=1:1 SET MSGPCE=$P(MSG,"|",PCENUM) SET LINEOUT=LINEOUT_MSGPCE_$$DELIMEND(MSGPCE) QUIT:MSGPCE="" DO
. IF ($L(LINEOUT)>$S(DTANODE:75,1:73))!(LINEOUT["...") DO ;$Select DTANODE determines if leading spaces are added to LINEOUT
.. IF $L(LINEOUT)>$S(DTANODE:75,1:73) DO
... SET PCENUM=PCENUM-1
... SET LINEOUT=$P(MSG,"|",START,PCENUM)
.. DO ADD^A1VSLAPI(.VALMCNT," "_$S('DTANODE:" ",1:"")_LINEOUT)
.. SET LINEOUT=""
.. SET START=PCENUM+1
DO:LINEOUT]"" ADD^A1VSLAPI(.VALMCNT," "_$S('DTANODE:" ",1:"")_LINEOUT)
;
QUIT
;
DELIMEND(MSGPCE) ; Return ending delimiter for LINEOUT in EVENSPLT^A1VSLPC
NEW RESULT
SET RESULT=$S((MSGPCE'["...")&(MSGPCE'="")&(MSGPCE'["{none}")&(MSGPCE'["file:"):"|",1:"")
QUIT RESULT
;
DELPKG(CURNDNM,CPRNDNM) ; Delete Package from Current and Compare parameter files
KILL ^TMP("A1VS CUR PARAM",$JOB,CURNDNM),^TMP("A1VS CPR PARAM",$JOB,CPRNDNM)
QUIT
;
;PROTOCOL entry points
;
MAILRPT ; Email ^TMP("A1VS PKG MGR PARAM ERROR DISP") comparison report
; -- Protocol: A1VS PKG MGR PARAM COMPR MAIL ACTION
NEW A1INSTMM,A1TOMM,XMERR,XMZ,A1TYPE,SUBSCPT
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 MAN PARM COMPARE"","_$JOB_","
. SET ^TMP("A1VS PKG MAN CMPR MSG",$JOB,1)="Parameter Files comparison: "_$P(VALMHDR(4),":",2)_" [New] vs "_$P(VALMHDR(5),":",2)_" [Old]"
. SET SUBSCPT=0
. FOR SET SUBSCPT=$O(^TMP("A1VS PKG MAN PARM COMPARE",$JOB,SUBSCPT)) QUIT:+SUBSCPT=0 DO
.. SET ^TMP("A1VS PKG MAN CMPR MSG",$JOB,SUBSCPT+1)=^TMP("A1VS PKG MAN PARM COMPARE",$JOB,SUBSCPT,0)
. SET XMTEXT="^TMP(""A1VS PKG MAN CMPR MSG"","_$JOB_","
. DO ^XMD
. IF +XMZ>0 DO JUSTPAWS^A1VSLAPI($P(VALMHDR(1)," - ",2)_" E-Mailed. [MSG #:"_XMZ_"]")
. IF +XMZ'>0 DO JUSTPAWS^A1VSLAPI("Error: "_$P(VALMHDR(1)," - ",2)_" not E-Mailed! ["_XMZ_"]")
. KILL ^TMP("A1VS PKG MAN CMPR MSG",$JOB)
;
SET VALMBCK="R"
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HA1VSLPC 13701 printed Sep 23, 2025@19:14:43 Page 2
A1VSLPC ;Albany FO/GTS - VistA Package Sizing Manager; 17-NOV-2016
+1 ;;1.0;VistA Package Sizing;;Oct 10, 2016;Build 25
EN(CMPRFNME) ; -- main entry point for A1VS PKG MGR PARAM COMPARE
+1 ; Input: CMPRFNME - File to compare current XTMPSIZE.DAT file
+2 ;
+3 IF CMPRFNME'["XTMPSIZE"
Begin DoDot:1
+4 DO JUSTPAWS^A1VSLAPI("Comparison XTMPSIZE.DAT file NOT selected!")
End DoDot:1
QUIT
+5 ;
+6 DO EN^VALM("A1VS PKG MGR PARAM COMPARE")
+7 QUIT
+8 ;
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 - Parameter Compare"
+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="Current [New] file: "_A1VPSPRM
+11 SET $PIECE(SPCPAD," ",(80-$LENGTH(DIRHEAD))/2)=""
+12 SET VALMHDR(4)=SPCPAD_DIRHEAD
+13 SET DIRHEAD="Comparison [Old] file: "_CMPRFNME
+14 SET $PIECE(SPCPAD," ",(80-$LENGTH(DIRHEAD))/2)=""
+15 SET VALMHDR(5)=SPCPAD_DIRHEAD
+16 QUIT
+17 ;
INIT ; - Build Current and Comparison XTMPSIZE parameter arrays
+1 NEW DEFDIR,NODENUM,NODECUR,CURNDNM,CPRNDNM,PKGRPTD,PKGDEL,DELSTATE
+2 ;Kill all processing & data arrays and video attributes & control arrays
DO KILL
+3 SET DEFDIR=$$GET^XPAR("SYS","A1VS PACKAGE MGR DEFAULT DIR",1,"I")
+4 ;
+5 ;Build current XTMPSIZE parameter array
+6 DO OPEN^%ZISH("XTMP",DEFDIR,A1VPSPRM,"R")
+7 USE IO
+8 SET NODENUM=0
+9 FOR
SET LINEITEM=""
READ LINEITEM:5
if $$STATUS^%ZISH
QUIT
Begin DoDot:1
+10 IF LINEITEM]""
Begin DoDot:2
+11 SET NODENUM=NODENUM+1
+12 ;Creates ^TMP("A1VS CUR PARAM",$JOB) array
SET ^TMP("A1VS CUR PARAM",$JOB,NODENUM)=LINEITEM
End DoDot:2
End DoDot:1
+13 DO CLOSE^%ZISH("XTMP")
+14 ;
+15 ;Build comparison XTMPSIZE parameter array
+16 DO OPEN^%ZISH("XTMP2",DEFDIR,CMPRFNME,"R")
+17 USE IO
+18 SET NODENUM=0
+19 FOR
SET LINEITEM=""
READ LINEITEM:5
if $$STATUS^%ZISH
QUIT
Begin DoDot:1
+20 IF LINEITEM]""
Begin DoDot:2
+21 SET NODENUM=NODENUM+1
+22 ;Creates ^TMP("A1VS CPR PARAM",$JOB) array
SET ^TMP("A1VS CPR PARAM",$JOB,NODENUM)=LINEITEM
End DoDot:2
End DoDot:1
+23 DO CLOSE^%ZISH("XTMP2")
+24 ;
+25 ;Create ^TMP("A1VS PKG MAN PARM COMPARE",$JOB) comparison result array for ListMan display
+26 SET (PKGRPTD,VALMCNT)=0
+27 ;
+28 DO ADD^A1VSLAPI(.VALMCNT," ")
+29 ;Output Header for Changed Package list
DO ADD^A1VSLAPI(.VALMCNT,"CHANGED PACKAGES",1,1,16)
+30 ;Loop through each "Current" (latest) Package Lineitem
+31 SET CURNDNM=0
+32 FOR
SET CURNDNM=$ORDER(^TMP("A1VS CUR PARAM",$JOB,CURNDNM))
if CURNDNM=""
QUIT
SET NODECUR=^TMP("A1VS CUR PARAM",$JOB,CURNDNM)
Begin DoDot:1
+33 SET DELSTATE=0
+34 ;;Remove unedited package from CPR & CUR globals
IF NODECUR=$GET(^TMP("A1VS CPR PARAM",$JOB,CURNDNM))
DO DELPKG(CURNDNM,CURNDNM)
SET DELSTATE=1
+35 ;;If Current Package '= same node on Compare Package lineitem
IF (NODECUR'=$GET(^TMP("A1VS CPR PARAM",$JOB,CURNDNM)))
IF ('DELSTATE)
Begin DoDot:2
+36 SET (PKGDEL,CPRNDNM)=0
+37 FOR
SET CPRNDNM=$ORDER(^TMP("A1VS CPR PARAM",$JOB,CPRNDNM))
if CPRNDNM=""
QUIT
if PKGDEL
QUIT
DO COMPARE(CPRNDNM,NODECUR,.VALMCNT,.PKGDEL,.PKGRPTD)
End DoDot:2
End DoDot:1
+38 IF PKGRPTD=0
Begin DoDot:1
+39 DO ADD^A1VSLAPI(.VALMCNT," No edited packages!")
End DoDot:1
+40 ;
+41 ;Report packages added new to Current package extract
DO ADDDELRP("CUR",.VALMCNT)
+42 ;Report packages deleted from Current package extract
DO ADDDELRP("CPR",.VALMCNT)
+43 SET PKGRPTD=0
+44 ;
+45 QUIT
+46 ;
COMPARE(CPRNDNM,NODECUR,VALMCNT,PKGDEL,PKGRPTD) ; Compare current & selected parameter files, report diff's and cleanup ^TMP globals
+1 NEW NODECPR,CURPKG,CPRPKG,FNDCHG,CPRPCS,CURPCS
+2 SET CURPKG=$PIECE(NODECUR,"^")
+3 SET NODECPR=^TMP("A1VS CPR PARAM",$JOB,CPRNDNM)
+4 SET CPRPKG=$PIECE(NODECPR,"^")
+5 ;
+6 ; Set CPRPCS and CURPCS to compare new Parameter file to Old Parameter file
+7 ; (pce 10 = * on old parameter files indicated circular Parent/Child relationship)
+8 SET CPRPCS=$LENGTH(NODECPR,"^")
+9 SET CURPCS=$LENGTH(NODECUR,"^")
+10 IF $PIECE(NODECPR,"^",CPRPCS)="*"
SET CPRPCS=CPRPCS-1
+11 IF $PIECE(NODECUR,"^",CURPCS)="*"
SET CURPCS=CURPCS-1
+12 ;
+13 ;Remove unedited Pkg from TMP globals, set PKGDEL to QUIT CPR loop
IF ($PIECE(NODECUR,"^",1,CURPCS)=$PIECE(NODECPR,"^",1,CPRPCS))
DO DELPKG(CURNDNM,CPRNDNM)
SET PKGDEL=1
+14 IF ($PIECE(NODECUR,"^",1,CURPCS)'=$PIECE(NODECPR,"^",1,CPRPCS))
IF (CPRPKG=CURPKG)
Begin DoDot:1
+15 ;NOTE: FNDCHG not used
SET FNDCHG=$$CHNGCHK(NODECUR,NODECPR,.VALMCNT)
+16 ;Remove edited Pkg from globals
DO DELPKG(CURNDNM,CPRNDNM)
+17 ;PKGRPTD prevents 'No edited packages' msg
SET PKGRPTD=1
+18 ; Quit CPR Node loop
SET PKGDEL=1
End DoDot:1
+19 QUIT
+20 ;
CHNGCHK(NODECUR,NODECPR,VALMCNT) ; Check latest extract (CUR) against a comparison extract (CPR)
+1 NEW FNDCHNG,PKGHDRPT,PKGNAME
+2 NEW CURPPFX,CPRPPFX,CURHF,CPRHF,CURLF,CPRLF,CURADPFX,CPRADPFX,CUREXPFX,CPREXPFX,CURFL,CPRFL,CURFRL,CPRFRL,CURPP,CPRPP
+3 ;Variable doc key:
+4 ; CPR* is compare file data
+5 ; CUR* is current file data
+6 ; *PPFX - Primary Prefix
+7 ; *HF - *Highest file number
+8 ; *LF - *Lowest file number
+9 ; *ADPFX - Additional Prefices
+10 ; *EXPFX - Excluded Prefices
+11 ; *FL - File List
+12 ; *FRL - File Range List
+13 ; *PP - Parent Package
+14 ;
+15 SET (FNDCHNG,PKGHDRPT)=0
+16 SET PKGNAME=$PIECE(NODECUR,"^")
+17 SET STRVLMCT=VALMCNT
+18 ;
+19 ;Prefix
+20 SET CURPPFX=$PIECE(NODECUR,"^",2)
+21 SET CPRPPFX=$PIECE(NODECPR,"^",2)
+22 IF CURPPFX'=CPRPPFX
Begin DoDot:1
+23 if 'PKGHDRPT
DO HDROUT(PKGNAME,.PKGHDRPT,.VALMCNT)
+24 DO ADD^A1VSLAPI(.VALMCNT,"New Prefix: "_$SELECT(CURPPFX]"":CURPPFX,1:"{none}")_" Old Prefix: "_$SELECT(CPRPPFX]"":CPRPPFX,1:"{none}"))
End DoDot:1
+25 ;
+26 ;Low File
+27 SET CURLF=$PIECE(NODECUR,"^",3)
+28 SET CPRLF=$PIECE(NODECPR,"^",3)
+29 IF CURLF'=CPRLF
Begin DoDot:1
+30 if 'PKGHDRPT
DO HDROUT(PKGNAME,.PKGHDRPT,.VALMCNT)
+31 DO ADD^A1VSLAPI(.VALMCNT,"New Low File #: "_$SELECT(CURLF]"":CURLF,1:"{none}")_" Old Low File #: "_$SELECT(CPRLF]"":CPRLF,1:"{none}"))
End DoDot:1
+32 ;
+33 ;High File
+34 SET CURHF=$PIECE(NODECUR,"^",4)
+35 SET CPRHF=$PIECE(NODECPR,"^",4)
+36 IF CURHF'=CPRHF
Begin DoDot:1
+37 if 'PKGHDRPT
DO HDROUT(PKGNAME,.PKGHDRPT,.VALMCNT)
+38 DO ADD^A1VSLAPI(.VALMCNT,"New High File #: "_$SELECT(CURHF]"":CURHF,1:"{none}")_" Old High File #: "_$SELECT(CPRHF]"":CPRHF,1:"{none}"))
End DoDot:1
+39 ;
+40 ;Additional Prefixes
+41 SET CURADPFX=$PIECE(NODECUR,"^",5)
+42 SET CPRADPFX=$PIECE(NODECPR,"^",5)
+43 IF CURADPFX'=CPRADPFX
Begin DoDot:1
+44 if 'PKGHDRPT
DO HDROUT(PKGNAME,.PKGHDRPT,.VALMCNT)
+45 DO LISTDIF("Additional Prefixes",CURADPFX,CPRADPFX,.VALMCNT)
End DoDot:1
+46 ;
+47 ;Excluded Prefixes
+48 SET CUREXPFX=$PIECE(NODECUR,"^",6)
+49 SET CPREXPFX=$PIECE(NODECPR,"^",6)
+50 IF CUREXPFX'=CPREXPFX
Begin DoDot:1
+51 if 'PKGHDRPT
DO HDROUT(PKGNAME,.PKGHDRPT,.VALMCNT)
+52 DO LISTDIF("Excepted Prefixes",CUREXPFX,CPREXPFX,.VALMCNT)
End DoDot:1
+53 ;
+54 ;File List
+55 SET CURFL=$PIECE(NODECUR,"^",7)
+56 SET CPRFL=$PIECE(NODECPR,"^",7)
+57 IF CURFL'=CPRFL
Begin DoDot:1
+58 if 'PKGHDRPT
DO HDROUT(PKGNAME,.PKGHDRPT,.VALMCNT)
+59 DO LISTDIF("Files",CURFL,CPRFL,.VALMCNT)
End DoDot:1
+60 ;
+61 ;File Range List
+62 SET CURFRL=$PIECE(NODECUR,"^",8)
+63 SET CPRFRL=$PIECE(NODECPR,"^",8)
+64 IF CURFRL'=CPRFRL
Begin DoDot:1
+65 if 'PKGHDRPT
DO HDROUT(PKGNAME,.PKGHDRPT,.VALMCNT)
+66 DO LISTDIF("File Ranges",CURFRL,CPRFRL,.VALMCNT)
End DoDot:1
+67 ;
+68 ;Parent
+69 SET CURPP=$PIECE(NODECUR,"^",9)
+70 SET CPRPP=$PIECE(NODECPR,"^",9)
+71 IF CURPP'=CPRPP
Begin DoDot:1
+72 if 'PKGHDRPT
DO HDROUT(PKGNAME,.PKGHDRPT,.VALMCNT)
+73 DO ADD^A1VSLAPI(.VALMCNT,"Parent")
+74 DO ADD^A1VSLAPI(.VALMCNT," New: "_$SELECT(CURPP]"":CURPP,1:"{none}"))
+75 DO ADD^A1VSLAPI(.VALMCNT," Old: "_$SELECT(CPRPP]"":CPRPP,1:"{none}"))
End DoDot:1
+76 ;
+77 IF VALMCNT'=STRVLMCT
SET FNDCHNG=1
+78 QUIT FNDCHNG
+79 ;
ADDDELRP(EXTRCT,VALMCNT) ;Report packages Added/Deleted to/from current extract
+1 NEW HDRTXT,NODENM,NODEVAL,DATAELMT,PKGFND
+2 ;
+3 SET HDRTXT=$SELECT(EXTRCT="CUR":"ADDED",1:"DELETED")_" PACKAGES:"
+4 DO ADD^A1VSLAPI(.VALMCNT," ")
+5 DO ADD^A1VSLAPI(.VALMCNT," ")
+6 DO ADD^A1VSLAPI(.VALMCNT,HDRTXT,1,1,$LENGTH(HDRTXT))
+7 ;
+8 SET PKGFND=0
+9 SET NODENM=""
+10 FOR
SET NODENM=$ORDER(^TMP("A1VS "_EXTRCT_" PARAM",$JOB,NODENM))
if NODENM=""
QUIT
SET NODEVAL=^TMP("A1VS "_EXTRCT_" PARAM",$JOB,NODENM)
Begin DoDot:1
+11 SET PKGFND=1
+12 ;Output package name
DO HDROUT($PIECE(NODEVAL,"^",1),.PKGHDRPT,.VALMCNT)
+13 ;
+14 SET DATAELMT=$PIECE(NODEVAL,"^",2)
+15 DO ADD^A1VSLAPI(.VALMCNT,"Prefix: "_$SELECT(DATAELMT]"":DATAELMT,1:"{none}"))
+16 ;
+17 SET DATAELMT=$PIECE(NODEVAL,"^",3)
+18 DO ADD^A1VSLAPI(.VALMCNT,"Low File #: "_$SELECT(DATAELMT]"":DATAELMT,1:"{none}"))
+19 ;
+20 SET DATAELMT=$PIECE(NODEVAL,"^",4)
+21 DO ADD^A1VSLAPI(.VALMCNT,"High File #: "_$SELECT(DATAELMT]"":DATAELMT,1:"{none}"))
+22 ;
+23 DO ADD^A1VSLAPI(.VALMCNT,"Additional Prefixes: ")
+24 SET DATAELMT=$PIECE(NODEVAL,"^",5)
+25 DO EVENSPLT(.VALMCNT,$SELECT(DATAELMT]"":DATAELMT,1:"{none}"))
+26 ;
+27 DO ADD^A1VSLAPI(.VALMCNT,"Excepted Prefixes: ")
+28 SET DATAELMT=$PIECE(NODEVAL,"^",6)
+29 DO EVENSPLT(.VALMCNT,$SELECT(DATAELMT]"":DATAELMT,1:"{none}"))
+30 ;
+31 DO ADD^A1VSLAPI(.VALMCNT,"File List: ")
+32 SET DATAELMT=$PIECE(NODEVAL,"^",7)
+33 DO EVENSPLT(.VALMCNT,$SELECT(DATAELMT]"":DATAELMT,1:"{none}"))
+34 ;
+35 DO ADD^A1VSLAPI(.VALMCNT,"File Range list: ")
+36 SET DATAELMT=$PIECE(NODEVAL,"^",8)
+37 DO EVENSPLT(.VALMCNT,$SELECT(DATAELMT]"":DATAELMT,1:"{none}"))
+38 ;
+39 SET DATAELMT=$PIECE(NODEVAL,"^",9)
+40 DO ADD^A1VSLAPI(.VALMCNT,"Parent: "_$SELECT(DATAELMT]"":DATAELMT,1:"{none}"))
End DoDot:1
+41 ;
+42 if 'PKGFND
DO ADD^A1VSLAPI(.VALMCNT," No "_$SELECT(EXTRCT="CUR":"added",EXTRCT="CPR":"deleted",1:"")_" packages!")
+43 QUIT
+44 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
+2 ;SET VALMBCK="R"
+3 QUIT
+4 ;
EXIT ; -- exit code
+1 DO KILL
+2 QUIT
+3 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
REFRESH ; -- refresh display
+1 DO INIT
+2 SET VALMBCK="R"
+3 QUIT
+4 ;
MSG(TEXT) ; -- set default message
+1 ;SET VALMSG=TEXT
+2 QUIT
+3 ;
KILL ; - Cleanup local and global display arrays
+1 ;Kill data and video control arrays
DO CLEAN^VALM10
+2 ;Kill Video attributes
DO KILL^VALM10()
+3 DO CLNTMPGB
+4 KILL ^TMP("A1VS PKG MAN PARM COMPARE",$JOB)
+5 KILL DIR,X,Y,DTOUT,DIRUT,DUOUT
+6 QUIT
+7 ;
CLNTMPGB ;Kill temporary globals
+1 KILL ^TMP("A1VS CUR PARAM",$JOB),^TMP("A1VS CPR PARAM",$JOB)
+2 QUIT
+3 ;
HDROUT(PKGNAME,PKGHDRPT,VALMCNT) ; Output package header
+1 SET PKGHDRPT=1
+2 DO ADD^A1VSLAPI(.VALMCNT," ")
+3 ;ADD^A1VSLAPI parameters: VALMCNT,MSG,LRBOLD,STRTBLD,ENDBLD
DO ADD^A1VSLAPI(.VALMCNT,"Package: "_PKGNAME,1,10,$LENGTH(PKGNAME))
+4 QUIT
+5 ;
LISTDIF(ELMTNME,CURDAT,CPRDAT,VALMCNT) ; Output differences in parameter lists
+1 NEW PCENUM,DATAELMT
+2 DO ADD^A1VSLAPI(.VALMCNT," "_ELMTNME)
+3 ;
+4 IF (CURDAT]"")
IF (CPRDAT']"")
Begin DoDot:1
+5 DO EVENSPLT(.VALMCNT,"Added entire list in New file: ",1)
+6 DO EVENSPLT(.VALMCNT,CURDAT)
End DoDot:1
+7 IF (CURDAT']"")
IF (CPRDAT]"")
Begin DoDot:1
+8 DO EVENSPLT(.VALMCNT,"Deleted entire list in New file: ",1)
+9 DO EVENSPLT(.VALMCNT,CPRDAT)
End DoDot:1
+10 ;
+11 ;List changes as lineitems
IF (CURDAT]"")
IF (CPRDAT]"")
Begin DoDot:1
+12 DO EVENSPLT(.VALMCNT,"Old List: "_$SELECT(CPRDAT]"":CPRDAT,1:"{none}"),1)
+13 ;
+14 ;Check for deletions
+15 FOR PCENUM=1:1
SET DATAELMT=$PIECE(CPRDAT,"|",PCENUM)
if DATAELMT=""
QUIT
Begin DoDot:2
+16 IF CURDAT'[DATAELMT_"|"
DO EVENSPLT(.VALMCNT,DATAELMT_" ...deleted in New file")
End DoDot:2
+17 IF PCENUM=1
DO ADD^A1VSLAPI(.VALMCNT," {none} ...deleted in New file")
+18 ;
+19 ;Check for additions
+20 FOR PCENUM=1:1
SET DATAELMT=$PIECE(CURDAT,"|",PCENUM)
if DATAELMT=""
QUIT
Begin DoDot:2
+21 IF CPRDAT'[DATAELMT_"|"
DO EVENSPLT(.VALMCNT,DATAELMT_" ...added in New file")
End DoDot:2
+22 IF PCENUM=1
DO ADD^A1VSLAPI(.VALMCNT," {none} ...added in New file")
+23 ;
+24
*** ERROR ***
DO EVENSPLT(.VALMCNT,"New List: "_$s(CURDAT]"":CURDAT,1:"{none}"),1)
End DoDot:1
+25 ;
+26 QUIT
+27 ;
EVENSPLT(VALMCNT,MSG,DTANODE) ; Add line to build display split on piece
+1 ; VALMCNT - Current array node number
+2 ; MSG - Message to add to ListMan Display
+3 ; DTANODE - Indicates raw data node or data element changed
+4 ; 1 : Raw data node
+5 ; 0 : data element changed
+6 ;
+7 NEW PCENUM,MSGPCE,LINEOUT,START
+8 SET DTANODE=+$GET(DTANODE)
+9 SET LINEOUT=""
+10 SET START=1
+11 ;
+12 FOR PCENUM=1:1
SET MSGPCE=$PIECE(MSG,"|",PCENUM)
SET LINEOUT=LINEOUT_MSGPCE_$$DELIMEND(MSGPCE)
if MSGPCE=""
QUIT
Begin DoDot:1
+13 ;$Select DTANODE determines if leading spaces are added to LINEOUT
IF ($LENGTH(LINEOUT)>$SELECT(DTANODE:75,1:73))!(LINEOUT["...")
Begin DoDot:2
+14 IF $LENGTH(LINEOUT)>$SELECT(DTANODE:75,1:73)
Begin DoDot:3
+15 SET PCENUM=PCENUM-1
+16 SET LINEOUT=$PIECE(MSG,"|",START,PCENUM)
End DoDot:3
+17 DO ADD^A1VSLAPI(.VALMCNT," "_$SELECT('DTANODE:" ",1:"")_LINEOUT)
+18 SET LINEOUT=""
+19 SET START=PCENUM+1
End DoDot:2
End DoDot:1
+20 if LINEOUT]""
DO ADD^A1VSLAPI(.VALMCNT," "_$SELECT('DTANODE:" ",1:"")_LINEOUT)
+21 ;
+22 QUIT
+23 ;
DELIMEND(MSGPCE) ; Return ending delimiter for LINEOUT in EVENSPLT^A1VSLPC
+1 NEW RESULT
+2 SET RESULT=$SELECT((MSGPCE'["...")&(MSGPCE'="")&(MSGPCE'["{none}")&(MSGPCE'["file:"):"|",1:"")
+3 QUIT RESULT
+4 ;
DELPKG(CURNDNM,CPRNDNM) ; Delete Package from Current and Compare parameter files
+1 KILL ^TMP("A1VS CUR PARAM",$JOB,CURNDNM),^TMP("A1VS CPR PARAM",$JOB,CPRNDNM)
+2 QUIT
+3 ;
+4 ;PROTOCOL entry points
+5 ;
MAILRPT ; Email ^TMP("A1VS PKG MGR PARAM ERROR DISP") comparison report
+1 ; -- Protocol: A1VS PKG MGR PARAM COMPR MAIL ACTION
+2 NEW A1INSTMM,A1TOMM,XMERR,XMZ,A1TYPE,SUBSCPT
+3 DO FULL^VALM1
+4 KILL XMERR
+5 ;Do not Restrict addressing
SET A1INSTMM("ADDR FLAGS")="R"
+6 SET A1TYPE="S"
+7 DO TOWHOM^XMXAPIU(DUZ,,A1TYPE,.A1INSTMM)
+8 IF +$GET(XMERR)'>0
Begin DoDot:1
+9 NEW XMY,XMTEXT,XMDUZ,XMSUB,A1LPCNT
+10 SET A1LPCNT=""
+11 FOR
SET A1LPCNT=$ORDER(^TMP("XMY",$JOB,A1LPCNT))
if A1LPCNT=""
QUIT
SET XMY(A1LPCNT)=""
+12 SET XMDUZ=DUZ
+13 SET XMSUB=$PIECE(VALMHDR(4),":",2)_" ("_$PIECE(VALMHDR(1)," - ",2)_")"
+14 ;SET XMTEXT="^TMP(""A1VS PKG MAN PARM COMPARE"","_$JOB_","
+15 SET ^TMP("A1VS PKG MAN CMPR MSG",$JOB,1)="Parameter Files comparison: "_$PIECE(VALMHDR(4),":",2)_" [New] vs "_$PIECE(VALMHDR(5),":",2)_" [Old]"
+16 SET SUBSCPT=0
+17 FOR
SET SUBSCPT=$ORDER(^TMP("A1VS PKG MAN PARM COMPARE",$JOB,SUBSCPT))
if +SUBSCPT=0
QUIT
Begin DoDot:2
+18 SET ^TMP("A1VS PKG MAN CMPR MSG",$JOB,SUBSCPT+1)=^TMP("A1VS PKG MAN PARM COMPARE",$JOB,SUBSCPT,0)
End DoDot:2
+19 SET XMTEXT="^TMP(""A1VS PKG MAN CMPR MSG"","_$JOB_","
+20 DO ^XMD
+21 IF +XMZ>0
DO JUSTPAWS^A1VSLAPI($PIECE(VALMHDR(1)," - ",2)_" E-Mailed. [MSG #:"_XMZ_"]")
+22 IF +XMZ'>0
DO JUSTPAWS^A1VSLAPI("Error: "_$PIECE(VALMHDR(1)," - ",2)_" not E-Mailed! ["_XMZ_"]")
+23 KILL ^TMP("A1VS PKG MAN CMPR MSG",$JOB)
End DoDot:1
+24 ;
+25 SET VALMBCK="R"
+26 QUIT
