XTVSLPER ;ALBANY FO/GTS - VistA Package Sizing Manager; 7-JUL-2016
;;7.3;TOOLKIT;**143,152**;Apr 25, 1995;Build 3
;Per VA Directive 6402, this routine should not be modified.
;
EN ; -- main entry point for XTVS PKG MGR PARAM ERROR DISP
D EN^VALM("XTVS PKG MGR PARAM ERROR DISP")
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 - Prefix/File Overlap"
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="Parameter file: "_XTVPSPRM
SET $P(SPCPAD," ",(80-$L(DIRHEAD))/2)=""
SET VALMHDR(4)=SPCPAD_DIRHEAD
QUIT
;
INIT ; -- init variables and list array
DO KILL
DO INCONSCK^XTVSLPR1 ; Check for package Prefix/File Range Overlaps
DO MSG
;
NEW CMBLP
SET CMBLP=""
SET VALMCNT=0
FOR SET CMBLP=$O(^TMP("XTVS-ERROR",$J,"COMB-PFX-FLRNG",CMBLP)) Q:CMBLP="" DO ADD^XTVSLAPI(.VALMCNT,^TMP("XTVS-ERROR",$J,"COMB-PFX-FLRNG",CMBLP))
QUIT
;
HELP ; -- help code
IF $D(X),X'["??" DO
. SET X="?"
. DO DISP^XQORM1 W !
IF $D(X),X["??",X'["???" DO
. SET XTQVAR=0
. DO CLEAR^VALM1
. DO FULL^VALM1
. FOR TXTCT=1:1 SET XTX=$P($T(LPERTXT2+TXTCT^XTVSHELP),";",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
.. D CLEAR^VALM1
.. WRITE !,"Possible actions on the Prefix/File Overlap list are the following:"
.. SET X="?"
.. DO DISP^XQORM1 W !!
IF $D(X),X["???" DO
. DO CLEAR^VALM1
. DO FULL^VALM1
. SET XTQVAR=0
. FOR TXTCT=1:1 SET XTX=$P($T(LPERTXT3+TXTCT^XTVSHELP),";",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
.. D CLEAR^VALM1
.. WRITE !,"Possible actions on the Prefix/File Overlap list are the following:"
.. SET X="?"
.. DO DISP^XQORM1 W !!
D MSG
S VALMBCK="R"
K XTX,Y,TXTCT,XTQVAR
QUIT
;
MSG(TEXT) ; -- set default message
IF $G(TEXT)]"" SET VALMSG=TEXT
IF $G(TEXT)']"" SET VALMSG="Enter ?? : more actions & Help, ??? : Prefix Help"
QUIT
;
EXIT ; -- exit code
DO KILL
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("XTVS PKG MGR PARAM ERROR DISP",$JOB),^TMP("XTVS-ERROR",$J)
QUIT
;
;Action Protocol APIs
DPFXERR ; Display prefix overlap list
; -- Protocol: XTVS PKG MGR PREFIX OVERLAP ACTION
;
NEW LPITEM
SET VALMHDR(1)=" VistA Package Size Analysis Manager - Prefix Overlap"
KILL ^TMP("XTVS PKG MGR PARAM ERROR DISP",$JOB)
SET VALMCNT=0
NEW LPITEM
SET LPITEM=""
FOR SET LPITEM=$O(^TMP("XTVS-ERROR",$J,"PREFIX",LPITEM)) Q:LPITEM="" DO ADD^XTVSLAPI(.VALMCNT,^TMP("XTVS-ERROR",$J,"PREFIX",LPITEM))
SET VALMBG=1
DO MSG
SET VALMBCK="R"
QUIT
;
DRNGERR ; Display File range errors
; -- Protocol: XTVS PKG MGR FILE OVERLAP ACTION
;
NEW LPITEM
SET VALMHDR(1)=" VistA Package Size Analysis Manager - File Overlap"
KILL ^TMP("XTVS PKG MGR PARAM ERROR DISP",$JOB)
SET VALMCNT=0
SET LPITEM=""
FOR SET LPITEM=$O(^TMP("XTVS-ERROR",$J,"FILERNG",LPITEM)) Q:LPITEM="" DO ADD^XTVSLAPI(.VALMCNT,^TMP("XTVS-ERROR",$J,"FILERNG",LPITEM))
SET VALMBG=1
DO MSG
SET VALMBCK="R"
QUIT
;
CMBERR ; Redisplay Prefix/File Range overlaps
; -- Protocol: XTVS PKG MGR PARAM OVRLP REDISP ACTION
;
NEW CMBLP
;
SET VALMHDR(1)=" VistA Package Size Analysis Manager - Prefix/File Overlap"
KILL ^TMP("XTVS PKG MGR PARAM ERROR DISP",$JOB)
SET VALMCNT=0
SET CMBLP=0
FOR SET CMBLP=$O(^TMP("XTVS-ERROR",$J,"COMB-PFX-FLRNG",CMBLP)) Q:CMBLP="" DO ADD^XTVSLAPI(.VALMCNT,^TMP("XTVS-ERROR",$J,"COMB-PFX-FLRNG",CMBLP))
SET VALMBG=1
DO MSG
SET VALMBCK="R"
QUIT
;
ERPT ; Email ^TMP("XTVS PKG MGR PARAM ERROR DISP") displayed report
; -- Protocol: XTVS PKG MGR EMAIL OVRLAP RPT ACTION
;
NEW XTINSTMM,XTTOMM,XMERR,XMZ,XTTYPE
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 XMTEXT="^TMP(""XTVS PKG MGR PARAM ERROR DISP"","_$JOB_","
. DO ^XMD
. IF +XMZ>0 DO JUSTPAWS^XTVSLAPI($P(VALMHDR(1)," - ",2)_" Emailed. [MSG #:"_XMZ_"]")
. IF +XMZ'>0 DO JUSTPAWS^XTVSLAPI("Error: ^TMP(""XTVS PKG MGR PARAM ERROR DISP"","_$JOB_") not Emailed! ["_XMZ_"]")
;
DO MSG
SET VALMBCK="R"
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTVSLPER 5094 printed Dec 13, 2024@02:42:16 Page 2
XTVSLPER ;ALBANY FO/GTS - VistA Package Sizing Manager; 7-JUL-2016
+1 ;;7.3;TOOLKIT;**143,152**;Apr 25, 1995;Build 3
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN ; -- main entry point for XTVS PKG MGR PARAM ERROR DISP
+1 DO EN^VALM("XTVS 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","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
+4 SET VALMHDR(1)=" VistA Package Size Analysis Manager - Prefix/File Overlap"
+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="Parameter file: "_XTVPSPRM
+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^XTVSLPR1
+3 DO MSG
+4 ;
+5 NEW CMBLP
+6 SET CMBLP=""
+7 SET VALMCNT=0
+8 FOR
SET CMBLP=$ORDER(^TMP("XTVS-ERROR",$JOB,"COMB-PFX-FLRNG",CMBLP))
if CMBLP=""
QUIT
DO ADD^XTVSLAPI(.VALMCNT,^TMP("XTVS-ERROR",$JOB,"COMB-PFX-FLRNG",CMBLP))
+9 QUIT
+10 ;
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["??"
IF X'["???"
Begin DoDot:1
+5 SET XTQVAR=0
+6 DO CLEAR^VALM1
+7 DO FULL^VALM1
+8 FOR TXTCT=1:1
SET XTX=$PIECE($TEXT(LPERTXT2+TXTCT^XTVSHELP),";",3,99)
if XTX="$END"
QUIT
if XTQVAR
QUIT
Begin DoDot:2
+9 IF XTX="$PAUSE"
DO PAUSE^VALM1
if Y
DO CLEAR^VALM1
IF 'Y
SET XTQVAR=1
QUIT
+10 WRITE !,$SELECT(XTX["$PAUSE":"",1:XTX)
End DoDot:2
+11 IF 'XTQVAR
Begin DoDot:2
+12 DO CLEAR^VALM1
+13 WRITE !,"Possible actions on the Prefix/File Overlap list are the following:"
+14 SET X="?"
+15 DO DISP^XQORM1
WRITE !!
End DoDot:2
End DoDot:1
+16 IF $DATA(X)
IF X["???"
Begin DoDot:1
+17 DO CLEAR^VALM1
+18 DO FULL^VALM1
+19 SET XTQVAR=0
+20 FOR TXTCT=1:1
SET XTX=$PIECE($TEXT(LPERTXT3+TXTCT^XTVSHELP),";",3,99)
if XTX="$END"
QUIT
if XTQVAR
QUIT
Begin DoDot:2
+21 IF XTX="$PAUSE"
DO PAUSE^VALM1
if Y
DO CLEAR^VALM1
IF 'Y
SET XTQVAR=1
QUIT
+22 WRITE !,$SELECT(XTX["$PAUSE":"",1:XTX)
End DoDot:2
+23 IF 'XTQVAR
Begin DoDot:2
+24 DO CLEAR^VALM1
+25 WRITE !,"Possible actions on the Prefix/File Overlap list are the following:"
+26 SET X="?"
+27 DO DISP^XQORM1
WRITE !!
End DoDot:2
End DoDot:1
+28 DO MSG
+29 SET VALMBCK="R"
+30 KILL XTX,Y,TXTCT,XTQVAR
+31 QUIT
+32 ;
MSG(TEXT) ; -- set default message
+1 IF $GET(TEXT)]""
SET VALMSG=TEXT
+2 IF $GET(TEXT)']""
SET VALMSG="Enter ?? : more actions & Help, ??? : Prefix Help"
+3 QUIT
+4 ;
EXIT ; -- exit code
+1 DO KILL
+2 QUIT
+3 ;
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("XTVS PKG MGR PARAM ERROR DISP",$JOB),^TMP("XTVS-ERROR",$JOB)
+4 QUIT
+5 ;
+6 ;Action Protocol APIs
DPFXERR ; Display prefix overlap list
+1 ; -- Protocol: XTVS PKG MGR PREFIX OVERLAP ACTION
+2 ;
+3 NEW LPITEM
+4 SET VALMHDR(1)=" VistA Package Size Analysis Manager - Prefix Overlap"
+5 KILL ^TMP("XTVS PKG MGR PARAM ERROR DISP",$JOB)
+6 SET VALMCNT=0
+7 NEW LPITEM
+8 SET LPITEM=""
+9 FOR
SET LPITEM=$ORDER(^TMP("XTVS-ERROR",$JOB,"PREFIX",LPITEM))
if LPITEM=""
QUIT
DO ADD^XTVSLAPI(.VALMCNT,^TMP("XTVS-ERROR",$JOB,"PREFIX",LPITEM))
+10 SET VALMBG=1
+11 DO MSG
+12 SET VALMBCK="R"
+13 QUIT
+14 ;
DRNGERR ; Display File range errors
+1 ; -- Protocol: XTVS PKG MGR FILE OVERLAP ACTION
+2 ;
+3 NEW LPITEM
+4 SET VALMHDR(1)=" VistA Package Size Analysis Manager - File Overlap"
+5 KILL ^TMP("XTVS PKG MGR PARAM ERROR DISP",$JOB)
+6 SET VALMCNT=0
+7 SET LPITEM=""
+8 FOR
SET LPITEM=$ORDER(^TMP("XTVS-ERROR",$JOB,"FILERNG",LPITEM))
if LPITEM=""
QUIT
DO ADD^XTVSLAPI(.VALMCNT,^TMP("XTVS-ERROR",$JOB,"FILERNG",LPITEM))
+9 SET VALMBG=1
+10 DO MSG
+11 SET VALMBCK="R"
+12 QUIT
+13 ;
CMBERR ; Redisplay Prefix/File Range overlaps
+1 ; -- Protocol: XTVS PKG MGR PARAM OVRLP REDISP ACTION
+2 ;
+3 NEW CMBLP
+4 ;
+5 SET VALMHDR(1)=" VistA Package Size Analysis Manager - Prefix/File Overlap"
+6 KILL ^TMP("XTVS PKG MGR PARAM ERROR DISP",$JOB)
+7 SET VALMCNT=0
+8 SET CMBLP=0
+9 FOR
SET CMBLP=$ORDER(^TMP("XTVS-ERROR",$JOB,"COMB-PFX-FLRNG",CMBLP))
if CMBLP=""
QUIT
DO ADD^XTVSLAPI(.VALMCNT,^TMP("XTVS-ERROR",$JOB,"COMB-PFX-FLRNG",CMBLP))
+10 SET VALMBG=1
+11 DO MSG
+12 SET VALMBCK="R"
+13 QUIT
+14 ;
ERPT ; Email ^TMP("XTVS PKG MGR PARAM ERROR DISP") displayed report
+1 ; -- Protocol: XTVS PKG MGR EMAIL OVRLAP RPT ACTION
+2 ;
+3 NEW XTINSTMM,XTTOMM,XMERR,XMZ,XTTYPE
+4 DO FULL^VALM1
+5 WRITE !!," The message can take some time to be sent.",!
+6 KILL XMERR
+7 ;Do not Restrict addressing
SET XTINSTMM("ADDR FLAGS")="R"
+8 SET XTTYPE="S"
+9 DO TOWHOM^XMXAPIU(DUZ,,XTTYPE,.XTINSTMM)
+10 IF +$GET(XMERR)'>0
Begin DoDot:1
+11 NEW XMY,XMTEXT,XMDUZ,XMSUB,XTLPCNT
+12 SET XTLPCNT=""
+13 FOR
SET XTLPCNT=$ORDER(^TMP("XMY",$JOB,XTLPCNT))
if XTLPCNT=""
QUIT
SET XMY(XTLPCNT)=""
+14 SET XMDUZ=DUZ
+15 SET XMSUB=$PIECE(VALMHDR(4),":",2)_" ("_$PIECE(VALMHDR(1)," - ",2)_")"
+16 SET XMTEXT="^TMP(""XTVS PKG MGR PARAM ERROR DISP"","_$JOB_","
+17 DO ^XMD
+18 IF +XMZ>0
DO JUSTPAWS^XTVSLAPI($PIECE(VALMHDR(1)," - ",2)_" Emailed. [MSG #:"_XMZ_"]")
+19 IF +XMZ'>0
DO JUSTPAWS^XTVSLAPI("Error: ^TMP(""XTVS PKG MGR PARAM ERROR DISP"","_$JOB_") not Emailed! ["_XMZ_"]")
End DoDot:1
+20 ;
+21 DO MSG
+22 SET VALMBCK="R"
+23 QUIT
