Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XTVSLPER

XTVSLPER.m

Go to the documentation of this file.
  1. XTVSLPER ;ALBANY FO/GTS - VistA Package Sizing Manager; 7-JUL-2016
  1. ;;7.3;TOOLKIT;**143,152**;Apr 25, 1995;Build 3
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. EN ; -- main entry point for XTVS PKG MGR PARAM ERROR DISP
  1. D EN^VALM("XTVS PKG MGR PARAM ERROR DISP")
  1. Q
  1. ;
  1. HDR ; -- header code
  1. NEW DEFDIR,SPCPAD,DIRHEAD
  1. SET SPCPAD=""
  1. SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
  1. SET VALMHDR(1)=" VistA Package Size Analysis Manager - Prefix/File Overlap"
  1. SET VALMHDR(2)=" Version: "_$$VERNUM^XTVSLM()_" Build: "_$$BLDNUM^XTVSLM()
  1. SET DIRHEAD="Default Directory: "_DEFDIR
  1. SET $P(SPCPAD," ",(80-$L(DIRHEAD))/2)=""
  1. SET VALMHDR(3)=SPCPAD_DIRHEAD
  1. SET SPCPAD=""
  1. SET DIRHEAD="Parameter file: "_XTVPSPRM
  1. SET $P(SPCPAD," ",(80-$L(DIRHEAD))/2)=""
  1. SET VALMHDR(4)=SPCPAD_DIRHEAD
  1. QUIT
  1. ;
  1. INIT ; -- init variables and list array
  1. DO KILL
  1. DO INCONSCK^XTVSLPR1 ; Check for package Prefix/File Range Overlaps
  1. DO MSG
  1. ;
  1. NEW CMBLP
  1. SET CMBLP=""
  1. SET VALMCNT=0
  1. 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))
  1. QUIT
  1. ;
  1. HELP ; -- help code
  1. IF $D(X),X'["??" DO
  1. . SET X="?"
  1. . DO DISP^XQORM1 W !
  1. IF $D(X),X["??",X'["???" DO
  1. . SET XTQVAR=0
  1. . DO CLEAR^VALM1
  1. . DO FULL^VALM1
  1. . FOR TXTCT=1:1 SET XTX=$P($T(LPERTXT2+TXTCT^XTVSHELP),";",3,99) QUIT:XTX="$END" QUIT:XTQVAR DO
  1. .. IF XTX="$PAUSE" DO PAUSE^VALM1 D:Y CLEAR^VALM1 IF 'Y SET XTQVAR=1 QUIT
  1. .. W !,$S(XTX["$PAUSE":"",1:XTX)
  1. . IF 'XTQVAR DO
  1. .. D CLEAR^VALM1
  1. .. WRITE !,"Possible actions on the Prefix/File Overlap list are the following:"
  1. .. SET X="?"
  1. .. DO DISP^XQORM1 W !!
  1. IF $D(X),X["???" DO
  1. . DO CLEAR^VALM1
  1. . DO FULL^VALM1
  1. . SET XTQVAR=0
  1. . FOR TXTCT=1:1 SET XTX=$P($T(LPERTXT3+TXTCT^XTVSHELP),";",3,99) QUIT:XTX="$END" QUIT:XTQVAR DO
  1. .. IF XTX="$PAUSE" DO PAUSE^VALM1 D:Y CLEAR^VALM1 IF 'Y SET XTQVAR=1 QUIT
  1. .. W !,$S(XTX["$PAUSE":"",1:XTX)
  1. . IF 'XTQVAR DO
  1. .. D CLEAR^VALM1
  1. .. WRITE !,"Possible actions on the Prefix/File Overlap list are the following:"
  1. .. SET X="?"
  1. .. DO DISP^XQORM1 W !!
  1. D MSG
  1. S VALMBCK="R"
  1. K XTX,Y,TXTCT,XTQVAR
  1. QUIT
  1. ;
  1. MSG(TEXT) ; -- set default message
  1. IF $G(TEXT)]"" SET VALMSG=TEXT
  1. IF $G(TEXT)']"" SET VALMSG="Enter ?? : more actions & Help, ??? : Prefix Help"
  1. QUIT
  1. ;
  1. EXIT ; -- exit code
  1. DO KILL
  1. Q
  1. ;
  1. KILL ; - Clean up local and global display arrays
  1. DO CLEAN^VALM10 ;Kill data and video control arrays
  1. DO KILL^VALM10() ;Kill Video attributes
  1. KILL ^TMP("XTVS PKG MGR PARAM ERROR DISP",$JOB),^TMP("XTVS-ERROR",$J)
  1. QUIT
  1. ;
  1. ;Action Protocol APIs
  1. DPFXERR ; Display prefix overlap list
  1. ; -- Protocol: XTVS PKG MGR PREFIX OVERLAP ACTION
  1. ;
  1. NEW LPITEM
  1. SET VALMHDR(1)=" VistA Package Size Analysis Manager - Prefix Overlap"
  1. KILL ^TMP("XTVS PKG MGR PARAM ERROR DISP",$JOB)
  1. SET VALMCNT=0
  1. NEW LPITEM
  1. SET LPITEM=""
  1. FOR SET LPITEM=$O(^TMP("XTVS-ERROR",$J,"PREFIX",LPITEM)) Q:LPITEM="" DO ADD^XTVSLAPI(.VALMCNT,^TMP("XTVS-ERROR",$J,"PREFIX",LPITEM))
  1. SET VALMBG=1
  1. DO MSG
  1. SET VALMBCK="R"
  1. QUIT
  1. ;
  1. DRNGERR ; Display File range errors
  1. ; -- Protocol: XTVS PKG MGR FILE OVERLAP ACTION
  1. ;
  1. NEW LPITEM
  1. SET VALMHDR(1)=" VistA Package Size Analysis Manager - File Overlap"
  1. KILL ^TMP("XTVS PKG MGR PARAM ERROR DISP",$JOB)
  1. SET VALMCNT=0
  1. SET LPITEM=""
  1. FOR SET LPITEM=$O(^TMP("XTVS-ERROR",$J,"FILERNG",LPITEM)) Q:LPITEM="" DO ADD^XTVSLAPI(.VALMCNT,^TMP("XTVS-ERROR",$J,"FILERNG",LPITEM))
  1. SET VALMBG=1
  1. DO MSG
  1. SET VALMBCK="R"
  1. QUIT
  1. ;
  1. CMBERR ; Redisplay Prefix/File Range overlaps
  1. ; -- Protocol: XTVS PKG MGR PARAM OVRLP REDISP ACTION
  1. ;
  1. NEW CMBLP
  1. ;
  1. SET VALMHDR(1)=" VistA Package Size Analysis Manager - Prefix/File Overlap"
  1. KILL ^TMP("XTVS PKG MGR PARAM ERROR DISP",$JOB)
  1. SET VALMCNT=0
  1. SET CMBLP=0
  1. 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))
  1. SET VALMBG=1
  1. DO MSG
  1. SET VALMBCK="R"
  1. QUIT
  1. ;
  1. ERPT ; Email ^TMP("XTVS PKG MGR PARAM ERROR DISP") displayed report
  1. ; -- Protocol: XTVS PKG MGR EMAIL OVRLAP RPT ACTION
  1. ;
  1. NEW XTINSTMM,XTTOMM,XMERR,XMZ,XTTYPE
  1. DO FULL^VALM1
  1. WRITE !!," The message can take some time to be sent.",!
  1. KILL XMERR
  1. SET XTINSTMM("ADDR FLAGS")="R" ;Do not Restrict addressing
  1. SET XTTYPE="S"
  1. DO TOWHOM^XMXAPIU(DUZ,,XTTYPE,.XTINSTMM)
  1. IF +$G(XMERR)'>0 DO
  1. . NEW XMY,XMTEXT,XMDUZ,XMSUB,XTLPCNT
  1. . SET XTLPCNT=""
  1. . FOR SET XTLPCNT=$O(^TMP("XMY",$J,XTLPCNT)) QUIT:XTLPCNT="" SET XMY(XTLPCNT)=""
  1. . SET XMDUZ=DUZ
  1. . SET XMSUB=$P(VALMHDR(4),":",2)_" ("_$P(VALMHDR(1)," - ",2)_")"
  1. . SET XMTEXT="^TMP(""XTVS PKG MGR PARAM ERROR DISP"","_$JOB_","
  1. . DO ^XMD
  1. . IF +XMZ>0 DO JUSTPAWS^XTVSLAPI($P(VALMHDR(1)," - ",2)_" Emailed. [MSG #:"_XMZ_"]")
  1. . IF +XMZ'>0 DO JUSTPAWS^XTVSLAPI("Error: ^TMP(""XTVS PKG MGR PARAM ERROR DISP"","_$JOB_") not Emailed! ["_XMZ_"]")
  1. ;
  1. DO MSG
  1. SET VALMBCK="R"
  1. QUIT