XTVSLPC ;Albany FO/GTS - VistA Package Sizing Manager; 17-NOV-2016
;;7.3;TOOLKIT;**143**;Apr 25, 1995;Build 116
EN(CMPRFNME) ; -- main entry point for XTVS PKG MGR PARAM COMPARE
; Input: CMPRFNME - File to compare Selected XTMPSIZE.DAT file
;
IF CMPRFNME'["XTMPSIZE" DO QUIT
. DO JUSTPAWS^XTVSLAPI("Comparison XTMPSIZE.DAT file NOT selected!")
;
D EN^VALM("XTVS PKG MGR PARAM COMPARE")
Q
;
HDR ; -- header code
NEW DEFDIR,SPCPAD,DIRHEAD
SET SPCPAD=""
SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
SET VALMHDR(1)=" VistA Package Size Analysis Manager - Parameter Compare"
SET VALMHDR(2)=" Version: "_$$VERNUM^XTVSLM()_" Build: "_$$BLDNUM^XTVSLM()
SET DIRHEAD="Default Directory: "_DEFDIR
SET $P(SPCPAD," ",(80-$L(DIRHEAD))/2)=""
SET VALMHDR(3)=SPCPAD_DIRHEAD
SET SPCPAD=""
SET DIRHEAD="Selected file [SEL]: "_XTVPSPRM
SET $P(SPCPAD," ",(80-$L(DIRHEAD))/2)=""
SET VALMHDR(4)=SPCPAD_DIRHEAD
SET DIRHEAD="Comparison file [CPR]: "_CMPRFNME
SET $P(SPCPAD," ",(80-$L(DIRHEAD))/2)=""
SET VALMHDR(5)=SPCPAD_DIRHEAD
QUIT
;
INIT ; - Build Selected 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","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
;
;Build Selected XTMPSIZE parameter array
DO OPEN^%ZISH("XTMP",DEFDIR,XTVPSPRM,"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("XTVS CUR PARAM",$JOB,NODENUM)=LINEITEM ;Creates ^TMP("XTVS 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("XTVS CPR PARAM",$JOB,NODENUM)=LINEITEM ;Creates ^TMP("XTVS CPR PARAM",$JOB) array
D CLOSE^%ZISH("XTMP2")
;
;Create ^TMP("XTVS PKG MAN PARM COMPARE",$JOB) comparison result array for ListMan display
SET (PKGRPTD,VALMCNT)=0
;
DO ADD^XTVSLAPI(.VALMCNT," ")
DO ADD^XTVSLAPI(.VALMCNT,"CHANGED PACKAGES",1,1,16) ;Output Header for Changed Package list
;Loop through each "Selected" (latest) Package Lineitem
SET CURNDNM=0
FOR SET CURNDNM=$O(^TMP("XTVS CUR PARAM",$JOB,CURNDNM)) QUIT:CURNDNM="" SET NODECUR=^TMP("XTVS CUR PARAM",$JOB,CURNDNM) DO
. SET DELSTATE=0
. IF NODECUR=$G(^TMP("XTVS CPR PARAM",$JOB,CURNDNM)) DO DELPKG(CURNDNM,CURNDNM) SET DELSTATE=1 ;;Remove unedited package from CPR & CUR globals
. IF (NODECUR'=$G(^TMP("XTVS CPR PARAM",$JOB,CURNDNM))),('DELSTATE) DO ;;If Selected Package '= same node on Compare Package lineitem
.. SET (PKGDEL,CPRNDNM)=0
.. FOR SET CPRNDNM=$O(^TMP("XTVS CPR PARAM",$JOB,CPRNDNM)) QUIT:CPRNDNM="" QUIT:PKGDEL DO COMPARE(CPRNDNM,NODECUR,.VALMCNT,.PKGDEL,.PKGRPTD)
IF PKGRPTD=0 DO
. DO ADD^XTVSLAPI(.VALMCNT," No edited packages!")
;
DO ADDDELRP("CUR",.VALMCNT) ;Report packages added new to Selected package extract
DO ADDDELRP("CPR",.VALMCNT) ;Report packages deleted from Selected package extract
SET PKGRPTD=0
D MSG
;
QUIT
;
COMPARE(CPRNDNM,NODECUR,VALMCNT,PKGDEL,PKGRPTD) ; Compare Selected & Comparison parameter files, report diff's and cleanup ^TMP globals
NEW NODECPR,CURPKG,CPRPKG,FNDCHG,CPRPCS,CURPCS
SET CURPKG=$P(NODECUR,"^")
SET NODECPR=^TMP("XTVS CPR PARAM",$JOB,CPRNDNM)
SET CPRPKG=$P(NODECPR,"^")
;
; Set CPRPCS and CURPCS to compare Selected Parameter file to Comparison Parameter file
; (pce 10 = * on CPR 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 selected parameter file (SEL) against a comparison parameter file (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 (Selected) file data
; *PPFX - Primary Prefix
; *HF - *Highest file number
; *LF - *Lowest file number
; *ADPFX - Additional Prefixes
; *EXPFX - Excluded Prefixes
; *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^XTVSLAPI(.VALMCNT,"SEL Prefix: "_$S(CURPPFX]"":CURPPFX,1:"{none}")_" CPR 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^XTVSLAPI(.VALMCNT,"SEL Low File #: "_$S(CURLF]"":CURLF,1:"{none}")_" CPR 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^XTVSLAPI(.VALMCNT,"SEL High File #: "_$S(CURHF]"":CURHF,1:"{none}")_" CPR 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^XTVSLAPI(.VALMCNT,"Parent")
.DO ADD^XTVSLAPI(.VALMCNT," SEL: "_$S(CURPP]"":CURPP,1:"{none}"))
.DO ADD^XTVSLAPI(.VALMCNT," CPR: "_$S(CPRPP]"":CPRPP,1:"{none}"))
;
IF VALMCNT'=STRVLMCT SET FNDCHNG=1
QUIT FNDCHNG
;
ADDDELRP(EXTRCT,VALMCNT) ;Report packages Added/Deleted to/from Selected extract
NEW HDRTXT,NODENM,NODEVAL,DATAELMT,PKGFND
;
SET HDRTXT=$S(EXTRCT="CUR":"ADDED",1:"DELETED")_" PACKAGES:"
DO ADD^XTVSLAPI(.VALMCNT," ")
DO ADD^XTVSLAPI(.VALMCNT," ")
DO ADD^XTVSLAPI(.VALMCNT,HDRTXT,1,1,$L(HDRTXT))
;
SET PKGFND=0
SET NODENM=""
FOR SET NODENM=$O(^TMP("XTVS "_EXTRCT_" PARAM",$JOB,NODENM)) QUIT:NODENM="" SET NODEVAL=^TMP("XTVS "_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^XTVSLAPI(.VALMCNT,"Prefix: "_$S(DATAELMT]"":DATAELMT,1:"{none}"))
. ;
. SET DATAELMT=$P(NODEVAL,"^",3)
. DO ADD^XTVSLAPI(.VALMCNT,"Low File #: "_$S(DATAELMT]"":DATAELMT,1:"{none}"))
. ;
. SET DATAELMT=$P(NODEVAL,"^",4)
. DO ADD^XTVSLAPI(.VALMCNT,"High File #: "_$S(DATAELMT]"":DATAELMT,1:"{none}"))
. ;
. DO ADD^XTVSLAPI(.VALMCNT,"Additional Prefixes: ")
. SET DATAELMT=$P(NODEVAL,"^",5)
. DO EVENSPLT(.VALMCNT,$S(DATAELMT]"":DATAELMT,1:"{none}"))
. ;
. DO ADD^XTVSLAPI(.VALMCNT,"Excepted Prefixes: ")
. SET DATAELMT=$P(NODEVAL,"^",6)
. DO EVENSPLT(.VALMCNT,$S(DATAELMT]"":DATAELMT,1:"{none}"))
. ;
. DO ADD^XTVSLAPI(.VALMCNT,"File List: ")
. SET DATAELMT=$P(NODEVAL,"^",7)
. DO EVENSPLT(.VALMCNT,$S(DATAELMT]"":DATAELMT,1:"{none}"))
. ;
. DO ADD^XTVSLAPI(.VALMCNT,"File Range list: ")
. SET DATAELMT=$P(NODEVAL,"^",8)
. DO EVENSPLT(.VALMCNT,$S(DATAELMT]"":DATAELMT,1:"{none}"))
. ;
. SET DATAELMT=$P(NODEVAL,"^",9)
. DO ADD^XTVSLAPI(.VALMCNT,"Parent: "_$S(DATAELMT]"":DATAELMT,1:"{none}"))
;
DO:'PKGFND ADD^XTVSLAPI(.VALMCNT," No "_$S(EXTRCT="CUR":"added",EXTRCT="CPR":"deleted",1:"")_" packages!")
QUIT
;
HELP ; -- help code
IF $D(X),X'["??" DO
. SET X="?"
. DO DISP^XQORM1 W !
IF $D(X),X["??" DO
. DO CLEAR^VALM1
. DO FULL^VALM1
. SET XTQVAR=Y
. IF XTQVAR DO
.. SET XTQVAR=0
.. FOR TXTCT=1:1 SET XTX=$P($T(LPCTXT+TXTCT^XTVSHLP1),";",3,99) QUIT:XTX="$END" QUIT:XTQVAR DO
... IF XTX="$PAUSE" DO PAUSE^VALM1 D:Y CLEAR^VALM1 IF 'Y SET XTQVAR=1 QUIT
... W !,$S(XTX["$PAUSE":"",1:XTX)
.IF 'XTQVAR DO
.. WRITE !,"List specific actions:",!
.. DO DISP^XQORM1 W !
.. WRITE !,"Email Comparison Report - This action prompts the user for Email addresses,"
.. WRITE !," writes the comparison report to an Email message and sends the message to"
.. WRITE !," the recipients. This option can be used to send a Comparison Report to"
.. WRITE !," Subject Matter Experts.",!!
D MSG
Q
;
EXIT ; -- exit code
DO KILL
Q
;
MSG(TEXT) ; -- set default message
IF $G(TEXT)]"" SET VALMSG=TEXT
IF $G(TEXT)']"" SET VALMSG="Enter ?? for more actions and Help"
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("XTVS PKG MAN PARM COMPARE",$JOB)
KILL DIR,X,Y,DTOUT,DIRUT,DUOUT
QUIT
;
CLNTMPGB ;Kill temporary globals
KILL ^TMP("XTVS CUR PARAM",$JOB),^TMP("XTVS CPR PARAM",$JOB)
QUIT
;
HDROUT(PKGNAME,PKGHDRPT,VALMCNT) ; Output package header
SET PKGHDRPT=1
DO ADD^XTVSLAPI(.VALMCNT," ")
DO ADD^XTVSLAPI(.VALMCNT,"Package: "_PKGNAME,1,10,$L(PKGNAME)) ;ADD^XTVSLAPI parameters: VALMCNT,MSG,LRBOLD,STRTBLD,ENDBLD
QUIT
;
LISTDIF(ELMTNME,CURDAT,CPRDAT,VALMCNT) ; Output differences in parameter lists
NEW PCENUM,DATAELMT,CHKELMT
DO ADD^XTVSLAPI(.VALMCNT," "_ELMTNME)
;
IF (CURDAT]""),(CPRDAT']"") DO
. DO EVENSPLT(.VALMCNT,"Added entire list in SEL file: ",1)
. DO EVENSPLT(.VALMCNT,CURDAT)
IF (CURDAT']""),(CPRDAT]"") DO
. DO EVENSPLT(.VALMCNT,"Deleted entire list in SEL file: ",1)
. DO EVENSPLT(.VALMCNT,CPRDAT)
;
IF (CURDAT]""),(CPRDAT]"") DO ;List changes as lineitems
. DO EVENSPLT(.VALMCNT,"CPR Parameter List: "_$S(CPRDAT]"":CPRDAT,1:"{none}"),1)
. ;
. ;Check for deletions
. FOR PCENUM=1:1 SET DATAELMT=$P(CPRDAT,"|",PCENUM) Q:DATAELMT="" DO
.. SET CHKELMT=DATAELMT_"|"
.. IF CURDAT'[CHKELMT DO EVENSPLT(.VALMCNT,DATAELMT_" ...deleted in SEL file")
. IF PCENUM=1 DO ADD^XTVSLAPI(.VALMCNT," {none} ...deleted in SEL file")
. ;
. ;Check for additions
. FOR PCENUM=1:1 SET DATAELMT=$P(CURDAT,"|",PCENUM) Q:DATAELMT="" DO
.. SET CHKELMT=DATAELMT_"|"
.. IF CPRDAT'[CHKELMT DO EVENSPLT(.VALMCNT,DATAELMT_" ...added in SEL file")
. IF PCENUM=1 DO ADD^XTVSLAPI(.VALMCNT," {none} ...added in SEL file")
. ;
. DO EVENSPLT(.VALMCNT,"SEL Parameter List: "_$S(CURDAT]"":CURDAT,1:"{none}"),1)
;
QUIT
;
EVENSPLT(VALMCNT,MSG,DTANODE) ; Add line to build display split on piece
; VALMCNT - Selected 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^XTVSLAPI(.VALMCNT," "_$S('DTANODE:" ",1:"")_LINEOUT)
.. SET LINEOUT=""
.. SET START=PCENUM+1
DO:LINEOUT]"" ADD^XTVSLAPI(.VALMCNT," "_$S('DTANODE:" ",1:"")_LINEOUT)
;
QUIT
;
DELIMEND(MSGPCE) ; Return ending delimiter for LINEOUT in EVENSPLT^XTVSLPC
NEW RESULT
SET RESULT=$S((MSGPCE'["...")&(MSGPCE'="")&(MSGPCE'["{none}")&(MSGPCE'["file:"):"|",1:"")
QUIT RESULT
;
DELPKG(CURNDNM,CPRNDNM) ; Delete Package from Selected and Compare parameter files
KILL ^TMP("XTVS CUR PARAM",$JOB,CURNDNM),^TMP("XTVS CPR PARAM",$JOB,CPRNDNM)
QUIT
;
;PROTOCOL entry points
;
MAILRPT ; Email ^TMP("XTVS PKG MGR PARAM ERROR DISP") comparison report
; -- Protocol: XTVS PKG MGR PARAM COMPR MAIL ACTION
NEW XTINSTMM,XTTOMM,XMERR,XMZ,XTTYPE,SUBSCPT
DO FULL^VALM1
WRITE !!," The message can take some time to be sent.",!
KILL XMERR
SET XTINSTMM("ADDR FLAGS")="R" ;Do not Restrict addressing
SET XTTYPE="S"
DO TOWHOM^XMXAPIU(DUZ,,XTTYPE,.XTINSTMM)
IF +$G(XMERR)'>0 DO
. NEW XMY,XMTEXT,XMDUZ,XMSUB,XTLPCNT
. SET XTLPCNT=""
. FOR SET XTLPCNT=$O(^TMP("XMY",$J,XTLPCNT)) QUIT:XTLPCNT="" SET XMY(XTLPCNT)=""
. SET XMDUZ=DUZ
. SET XMSUB=$P(VALMHDR(4),":",2)_" ("_$P(VALMHDR(1)," - ",2)_")"
. SET ^TMP("XTVS PKG MAN CMPR MSG",$JOB,1)="Parameter Files comparison: "_$P(VALMHDR(4),":",2)_" [SEL] vs "_$P(VALMHDR(5),":",2)_" [CPR]"
. SET SUBSCPT=0
. FOR SET SUBSCPT=$O(^TMP("XTVS PKG MAN PARM COMPARE",$JOB,SUBSCPT)) QUIT:+SUBSCPT=0 DO
.. SET ^TMP("XTVS PKG MAN CMPR MSG",$JOB,SUBSCPT+1)=^TMP("XTVS PKG MAN PARM COMPARE",$JOB,SUBSCPT,0)
. SET XMTEXT="^TMP(""XTVS PKG MAN CMPR MSG"","_$JOB_","
. DO ^XMD
. IF +XMZ>0 DO JUSTPAWS^XTVSLAPI($P(VALMHDR(1)," - ",2)_" Emailed. [MSG #:"_XMZ_"]")
. IF +XMZ'>0 DO JUSTPAWS^XTVSLAPI("Error: "_$P(VALMHDR(1)," - ",2)_" not Emailed! ["_XMZ_"]")
. KILL ^TMP("XTVS PKG MAN CMPR MSG",$JOB)
;
D MSG
SET VALMBCK="R"
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTVSLPC 14556 printed Apr 09, 2024@21:43:42 Page 2
XTVSLPC ;Albany FO/GTS - VistA Package Sizing Manager; 17-NOV-2016
+1 ;;7.3;TOOLKIT;**143**;Apr 25, 1995;Build 116
EN(CMPRFNME) ; -- main entry point for XTVS PKG MGR PARAM COMPARE
+1 ; Input: CMPRFNME - File to compare Selected XTMPSIZE.DAT file
+2 ;
+3 IF CMPRFNME'["XTMPSIZE"
Begin DoDot:1
+4 DO JUSTPAWS^XTVSLAPI("Comparison XTMPSIZE.DAT file NOT selected!")
End DoDot:1
QUIT
+5 ;
+6 DO EN^VALM("XTVS PKG MGR PARAM COMPARE")
+7 QUIT
+8 ;
HDR ; -- header code
+1 NEW DEFDIR,SPCPAD,DIRHEAD
+2 SET SPCPAD=""
+3 SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
+4 SET VALMHDR(1)=" VistA Package Size Analysis Manager - Parameter Compare"
+5 SET VALMHDR(2)=" Version: "_$$VERNUM^XTVSLM()_" Build: "_$$BLDNUM^XTVSLM()
+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="Selected file [SEL]: "_XTVPSPRM
+11 SET $PIECE(SPCPAD," ",(80-$LENGTH(DIRHEAD))/2)=""
+12 SET VALMHDR(4)=SPCPAD_DIRHEAD
+13 SET DIRHEAD="Comparison file [CPR]: "_CMPRFNME
+14 SET $PIECE(SPCPAD," ",(80-$LENGTH(DIRHEAD))/2)=""
+15 SET VALMHDR(5)=SPCPAD_DIRHEAD
+16 QUIT
+17 ;
INIT ; - Build Selected 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","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
+4 ;
+5 ;Build Selected XTMPSIZE parameter array
+6 DO OPEN^%ZISH("XTMP",DEFDIR,XTVPSPRM,"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("XTVS CUR PARAM",$JOB) array
SET ^TMP("XTVS 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("XTVS CPR PARAM",$JOB) array
SET ^TMP("XTVS CPR PARAM",$JOB,NODENUM)=LINEITEM
End DoDot:2
End DoDot:1
+23 DO CLOSE^%ZISH("XTMP2")
+24 ;
+25 ;Create ^TMP("XTVS PKG MAN PARM COMPARE",$JOB) comparison result array for ListMan display
+26 SET (PKGRPTD,VALMCNT)=0
+27 ;
+28 DO ADD^XTVSLAPI(.VALMCNT," ")
+29 ;Output Header for Changed Package list
DO ADD^XTVSLAPI(.VALMCNT,"CHANGED PACKAGES",1,1,16)
+30 ;Loop through each "Selected" (latest) Package Lineitem
+31 SET CURNDNM=0
+32 FOR
SET CURNDNM=$ORDER(^TMP("XTVS CUR PARAM",$JOB,CURNDNM))
if CURNDNM=""
QUIT
SET NODECUR=^TMP("XTVS CUR PARAM",$JOB,CURNDNM)
Begin DoDot:1
+33 SET DELSTATE=0
+34 ;;Remove unedited package from CPR & CUR globals
IF NODECUR=$GET(^TMP("XTVS CPR PARAM",$JOB,CURNDNM))
DO DELPKG(CURNDNM,CURNDNM)
SET DELSTATE=1
+35 ;;If Selected Package '= same node on Compare Package lineitem
IF (NODECUR'=$GET(^TMP("XTVS CPR PARAM",$JOB,CURNDNM)))
IF ('DELSTATE)
Begin DoDot:2
+36 SET (PKGDEL,CPRNDNM)=0
+37 FOR
SET CPRNDNM=$ORDER(^TMP("XTVS 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^XTVSLAPI(.VALMCNT," No edited packages!")
End DoDot:1
+40 ;
+41 ;Report packages added new to Selected package extract
DO ADDDELRP("CUR",.VALMCNT)
+42 ;Report packages deleted from Selected package extract
DO ADDDELRP("CPR",.VALMCNT)
+43 SET PKGRPTD=0
+44 DO MSG
+45 ;
+46 QUIT
+47 ;
COMPARE(CPRNDNM,NODECUR,VALMCNT,PKGDEL,PKGRPTD) ; Compare Selected & Comparison 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("XTVS CPR PARAM",$JOB,CPRNDNM)
+4 SET CPRPKG=$PIECE(NODECPR,"^")
+5 ;
+6 ; Set CPRPCS and CURPCS to compare Selected Parameter file to Comparison Parameter file
+7 ; (pce 10 = * on CPR 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 selected parameter file (SEL) against a comparison parameter file (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 (Selected) file data
+6 ; *PPFX - Primary Prefix
+7 ; *HF - *Highest file number
+8 ; *LF - *Lowest file number
+9 ; *ADPFX - Additional Prefixes
+10 ; *EXPFX - Excluded Prefixes
+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^XTVSLAPI(.VALMCNT,"SEL Prefix: "_$SELECT(CURPPFX]"":CURPPFX,1:"{none}")_" CPR 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^XTVSLAPI(.VALMCNT,"SEL Low File #: "_$SELECT(CURLF]"":CURLF,1:"{none}")_" CPR 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^XTVSLAPI(.VALMCNT,"SEL High File #: "_$SELECT(CURHF]"":CURHF,1:"{none}")_" CPR 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^XTVSLAPI(.VALMCNT,"Parent")
+74 DO ADD^XTVSLAPI(.VALMCNT," SEL: "_$SELECT(CURPP]"":CURPP,1:"{none}"))
+75 DO ADD^XTVSLAPI(.VALMCNT," CPR: "_$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 Selected extract
+1 NEW HDRTXT,NODENM,NODEVAL,DATAELMT,PKGFND
+2 ;
+3 SET HDRTXT=$SELECT(EXTRCT="CUR":"ADDED",1:"DELETED")_" PACKAGES:"
+4 DO ADD^XTVSLAPI(.VALMCNT," ")
+5 DO ADD^XTVSLAPI(.VALMCNT," ")
+6 DO ADD^XTVSLAPI(.VALMCNT,HDRTXT,1,1,$LENGTH(HDRTXT))
+7 ;
+8 SET PKGFND=0
+9 SET NODENM=""
+10 FOR
SET NODENM=$ORDER(^TMP("XTVS "_EXTRCT_" PARAM",$JOB,NODENM))
if NODENM=""
QUIT
SET NODEVAL=^TMP("XTVS "_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^XTVSLAPI(.VALMCNT,"Prefix: "_$SELECT(DATAELMT]"":DATAELMT,1:"{none}"))
+16 ;
+17 SET DATAELMT=$PIECE(NODEVAL,"^",3)
+18 DO ADD^XTVSLAPI(.VALMCNT,"Low File #: "_$SELECT(DATAELMT]"":DATAELMT,1:"{none}"))
+19 ;
+20 SET DATAELMT=$PIECE(NODEVAL,"^",4)
+21 DO ADD^XTVSLAPI(.VALMCNT,"High File #: "_$SELECT(DATAELMT]"":DATAELMT,1:"{none}"))
+22 ;
+23 DO ADD^XTVSLAPI(.VALMCNT,"Additional Prefixes: ")
+24 SET DATAELMT=$PIECE(NODEVAL,"^",5)
+25 DO EVENSPLT(.VALMCNT,$SELECT(DATAELMT]"":DATAELMT,1:"{none}"))
+26 ;
+27 DO ADD^XTVSLAPI(.VALMCNT,"Excepted Prefixes: ")
+28 SET DATAELMT=$PIECE(NODEVAL,"^",6)
+29 DO EVENSPLT(.VALMCNT,$SELECT(DATAELMT]"":DATAELMT,1:"{none}"))
+30 ;
+31 DO ADD^XTVSLAPI(.VALMCNT,"File List: ")
+32 SET DATAELMT=$PIECE(NODEVAL,"^",7)
+33 DO EVENSPLT(.VALMCNT,$SELECT(DATAELMT]"":DATAELMT,1:"{none}"))
+34 ;
+35 DO ADD^XTVSLAPI(.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^XTVSLAPI(.VALMCNT,"Parent: "_$SELECT(DATAELMT]"":DATAELMT,1:"{none}"))
End DoDot:1
+41 ;
+42 if 'PKGFND
DO ADD^XTVSLAPI(.VALMCNT," No "_$SELECT(EXTRCT="CUR":"added",EXTRCT="CPR":"deleted",1:"")_" packages!")
+43 QUIT
+44 ;
HELP ; -- help code
+1 IF $DATA(X)
IF X'["??"
Begin DoDot:1
+2 SET X="?"
+3 DO DISP^XQORM1
WRITE !
End DoDot:1
+4 IF $DATA(X)
IF X["??"
Begin DoDot:1
+5 DO CLEAR^VALM1
+6 DO FULL^VALM1
+7 SET XTQVAR=Y
+8 IF XTQVAR
Begin DoDot:2
+9 SET XTQVAR=0
+10 FOR TXTCT=1:1
SET XTX=$PIECE($TEXT(LPCTXT+TXTCT^XTVSHLP1),";",3,99)
if XTX="$END"
QUIT
if XTQVAR
QUIT
Begin DoDot:3
+11 IF XTX="$PAUSE"
DO PAUSE^VALM1
if Y
DO CLEAR^VALM1
IF 'Y
SET XTQVAR=1
QUIT
+12 WRITE !,$SELECT(XTX["$PAUSE":"",1:XTX)
End DoDot:3
End DoDot:2
+13 IF 'XTQVAR
Begin DoDot:2
+14 WRITE !,"List specific actions:",!
+15 DO DISP^XQORM1
WRITE !
+16 WRITE !,"Email Comparison Report - This action prompts the user for Email addresses,"
+17 WRITE !," writes the comparison report to an Email message and sends the message to"
+18 WRITE !," the recipients. This option can be used to send a Comparison Report to"
+19 WRITE !," Subject Matter Experts.",!!
End DoDot:2
End DoDot:1
+20 DO MSG
+21 QUIT
+22 ;
EXIT ; -- exit code
+1 DO KILL
+2 QUIT
+3 ;
MSG(TEXT) ; -- set default message
+1 IF $GET(TEXT)]""
SET VALMSG=TEXT
+2 IF $GET(TEXT)']""
SET VALMSG="Enter ?? for more actions and Help"
+3 QUIT
+4 ;
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("XTVS PKG MAN PARM COMPARE",$JOB)
+5 KILL DIR,X,Y,DTOUT,DIRUT,DUOUT
+6 QUIT
+7 ;
CLNTMPGB ;Kill temporary globals
+1 KILL ^TMP("XTVS CUR PARAM",$JOB),^TMP("XTVS CPR PARAM",$JOB)
+2 QUIT
+3 ;
HDROUT(PKGNAME,PKGHDRPT,VALMCNT) ; Output package header
+1 SET PKGHDRPT=1
+2 DO ADD^XTVSLAPI(.VALMCNT," ")
+3 ;ADD^XTVSLAPI parameters: VALMCNT,MSG,LRBOLD,STRTBLD,ENDBLD
DO ADD^XTVSLAPI(.VALMCNT,"Package: "_PKGNAME,1,10,$LENGTH(PKGNAME))
+4 QUIT
+5 ;
LISTDIF(ELMTNME,CURDAT,CPRDAT,VALMCNT) ; Output differences in parameter lists
+1 NEW PCENUM,DATAELMT,CHKELMT
+2 DO ADD^XTVSLAPI(.VALMCNT," "_ELMTNME)
+3 ;
+4 IF (CURDAT]"")
IF (CPRDAT']"")
Begin DoDot:1
+5 DO EVENSPLT(.VALMCNT,"Added entire list in SEL 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 SEL 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,"CPR Parameter 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 SET CHKELMT=DATAELMT_"|"
+17 IF CURDAT'[CHKELMT
DO EVENSPLT(.VALMCNT,DATAELMT_" ...deleted in SEL file")
End DoDot:2
+18 IF PCENUM=1
DO ADD^XTVSLAPI(.VALMCNT," {none} ...deleted in SEL file")
+19 ;
+20 ;Check for additions
+21 FOR PCENUM=1:1
SET DATAELMT=$PIECE(CURDAT,"|",PCENUM)
if DATAELMT=""
QUIT
Begin DoDot:2
+22 SET CHKELMT=DATAELMT_"|"
+23 IF CPRDAT'[CHKELMT
DO EVENSPLT(.VALMCNT,DATAELMT_" ...added in SEL file")
End DoDot:2
+24 IF PCENUM=1
DO ADD^XTVSLAPI(.VALMCNT," {none} ...added in SEL file")
+25 ;
+26 DO EVENSPLT(.VALMCNT,"SEL Parameter List: "_$SELECT(CURDAT]"":CURDAT,1:"{none}"),1)
End DoDot:1
+27 ;
+28 QUIT
+29 ;
EVENSPLT(VALMCNT,MSG,DTANODE) ; Add line to build display split on piece
+1 ; VALMCNT - Selected 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^XTVSLAPI(.VALMCNT," "_$SELECT('DTANODE:" ",1:"")_LINEOUT)
+18 SET LINEOUT=""
+19 SET START=PCENUM+1
End DoDot:2
End DoDot:1
+20 if LINEOUT]""
DO ADD^XTVSLAPI(.VALMCNT," "_$SELECT('DTANODE:" ",1:"")_LINEOUT)
+21 ;
+22 QUIT
+23 ;
DELIMEND(MSGPCE) ; Return ending delimiter for LINEOUT in EVENSPLT^XTVSLPC
+1 NEW RESULT
+2 SET RESULT=$SELECT((MSGPCE'["...")&(MSGPCE'="")&(MSGPCE'["{none}")&(MSGPCE'["file:"):"|",1:"")
+3 QUIT RESULT
+4 ;
DELPKG(CURNDNM,CPRNDNM) ; Delete Package from Selected and Compare parameter files
+1 KILL ^TMP("XTVS CUR PARAM",$JOB,CURNDNM),^TMP("XTVS CPR PARAM",$JOB,CPRNDNM)
+2 QUIT
+3 ;
+4 ;PROTOCOL entry points
+5 ;
MAILRPT ; Email ^TMP("XTVS PKG MGR PARAM ERROR DISP") comparison report
+1 ; -- Protocol: XTVS PKG MGR PARAM COMPR MAIL ACTION
+2 NEW XTINSTMM,XTTOMM,XMERR,XMZ,XTTYPE,SUBSCPT
+3 DO FULL^VALM1
+4 WRITE !!," The message can take some time to be sent.",!
+5 KILL XMERR
+6 ;Do not Restrict addressing
SET XTINSTMM("ADDR FLAGS")="R"
+7 SET XTTYPE="S"
+8 DO TOWHOM^XMXAPIU(DUZ,,XTTYPE,.XTINSTMM)
+9 IF +$GET(XMERR)'>0
Begin DoDot:1
+10 NEW XMY,XMTEXT,XMDUZ,XMSUB,XTLPCNT
+11 SET XTLPCNT=""
+12 FOR
SET XTLPCNT=$ORDER(^TMP("XMY",$JOB,XTLPCNT))
if XTLPCNT=""
QUIT
SET XMY(XTLPCNT)=""
+13 SET XMDUZ=DUZ
+14 SET XMSUB=$PIECE(VALMHDR(4),":",2)_" ("_$PIECE(VALMHDR(1)," - ",2)_")"
+15 SET ^TMP("XTVS PKG MAN CMPR MSG",$JOB,1)="Parameter Files comparison: "_$PIECE(VALMHDR(4),":",2)_" [SEL] vs "_$PIECE(VALMHDR(5),":",2)_" [CPR]"
+16 SET SUBSCPT=0
+17 FOR
SET SUBSCPT=$ORDER(^TMP("XTVS PKG MAN PARM COMPARE",$JOB,SUBSCPT))
if +SUBSCPT=0
QUIT
Begin DoDot:2
+18 SET ^TMP("XTVS PKG MAN CMPR MSG",$JOB,SUBSCPT+1)=^TMP("XTVS PKG MAN PARM COMPARE",$JOB,SUBSCPT,0)
End DoDot:2
+19 SET XMTEXT="^TMP(""XTVS PKG MAN CMPR MSG"","_$JOB_","
+20 DO ^XMD
+21 IF +XMZ>0
DO JUSTPAWS^XTVSLAPI($PIECE(VALMHDR(1)," - ",2)_" Emailed. [MSG #:"_XMZ_"]")
+22 IF +XMZ'>0
DO JUSTPAWS^XTVSLAPI("Error: "_$PIECE(VALMHDR(1)," - ",2)_" not Emailed! ["_XMZ_"]")
+23 KILL ^TMP("XTVS PKG MAN CMPR MSG",$JOB)
End DoDot:1
+24 ;
+25 DO MSG
+26 SET VALMBCK="R"
+27 QUIT
