- 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 Jan 18, 2025@03:43:23 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