XTVSLM ;ALBANY FO/GTS - VistA Package Sizing Manager; 23-JUN-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 PACKAGE MANAGER
NEW FIRSTITM,LASTITM
;Definitions:
; FIRSTITM - Line # of first XTMPSIZE.DAT file in list
; LASTITM - Line # of last XTMPSIZE.DAT file in list
;NOTE: These variables are used by XTVSLP & XTVSLR (XTVS PKG MGR PARAM DISPLAY ListMan & XTVS PKG MGR VISTA SIZE RPT Templates)
;
D EN^VALM("XTVS PACKAGE MANAGER")
QUIT
;
HDR ; -- header code
SET VALMHDR(1)=" VistA Package Size Analysis Manager"
SET VALMHDR(2)=" Version: "_$$VERNUM^XTVSLM()_" Build: "_$$BLDNUM^XTVSLM()
QUIT
;
INIT ; -- init variables and list array
; DISPBAK - List "BAK" files indicator [NOTE: Used by this List Template to turn on/off display of *.BAK files
; [KILLed in EXIT]
; XTVPSPRM - Last selected XTMPFILE parameter file selected. [KILLed in EXIT]
;
SET DISPBAK=$P($$YNCHK^XTVSLAPI("Do you want to Display XTMPSIZE*.BAK (backup files)"),"^",2)
;
IF DISPBAK'=-1 DO BUILD
IF DISPBAK=-1 SET VALMQUIT=""
DO MSG
QUIT
;
BUILD ; - Build local and global display arrays
NEW DEFDIR,FILENME,HDLINE,RESULT,FILELIST,UNDRLINE,FILELP,LISTNUM
DO KILL ;Kill all processing & data arrays and video attributes & control arrays
;
SET (FIRSTITM,LASTITM,VALMCNT)=0
SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
DO ADD^XTVSLAPI(.VALMCNT," ")
DO ADD^XTVSLAPI(.VALMCNT," XTMPSIZE.DAT default directory: "_$S($G(DEFDIR)]"":DEFDIR,1:"<no default defined>"),1,36,$S($L(DEFDIR)>0:$L(DEFDIR),1:20))
IF DEFDIR]"" DO
. SET FILENME("XTMPSIZE*")=""
. SET RESULT=$$LIST^%ZISH(DEFDIR,"FILENME","FILELIST")
. DO ADD^XTVSLAPI(.VALMCNT," ")
. SET HDLINE=" XTMPSIZE.DAT Package Parameter file list in "_DEFDIR_":"
. SET $P(UNDRLINE,"-",$L(HDLINE)-3)=""
. DO ADD^XTVSLAPI(.VALMCNT,HDLINE)
. DO ADD^XTVSLAPI(.VALMCNT," "_UNDRLINE)
. IF 'RESULT DO ADD^XTVSLAPI(.VALMCNT," No XTMPSIZE* files found in "_DEFDIR_".")
. IF RESULT DO
.. SET FILELP=""
.. FOR SET FILELP=$O(FILELIST(FILELP)) Q:FILELP="" DO
... IF ($P(FILELP,".",2)'["LCK")&((+$G(DISPBAK)=1)!($P(FILELP,".",2)["DAT")) DO
.... SET LISTNUM=VALMCNT-4
.... DO ADD^XTVSLAPI(.VALMCNT," "_LISTNUM_") "_FILELP)
.... SET:FIRSTITM=0 FIRSTITM=VALMCNT
.... SET LASTITM=VALMCNT
;
QUIT
;
HELP ; -- help code
IF $D(X),X'["??" DO
. SET X="?"
. DO DISP^XQORM1 W !
IF $D(X),X["??",X'["???" DO
. DO CLEAR^VALM1
. DO FULL^VALM1
. WRITE !,"VistA Package Size Analysis Manager help..."
. WRITE !,"List specific actions:",!
. DO DISP^XQORM1 W !!
. SET XTQVAR=Y
. IF XTQVAR DO
.. SET XTQVAR=0
.. FOR TXTCT=1:1 SET XTX=$P($T(LMTXT2+TXTCT^XTVSHLP2),";",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)
. W !
IF $D(X),X["???" DO
. DO CLEAR^VALM1
. DO FULL^VALM1
. WRITE !,"List specific actions:"
. DO DISP^XQORM1 W !
. WRITE !,"These actions provide a set of tools that support the process described here."
. WRITE !,"VistA Package Size Reporting Process help...",!
. SET XTQVAR=Y
. IF XTQVAR DO
.. SET XTQVAR=0
.. FOR TXTCT=1:1 SET XTX=$P($T(LMTXT3+TXTCT^XTVSHLP2),";",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)
. W !
S VALMBCK="R"
D MSG
K XTX,Y,TXTCT,XTQVAR
Q
;
EXIT ; -- exit code
DO KILL
KILL DISPBAK,XTVPSPRM
Q
;
KILL ; - Kill local and global display arrays
DO CLEAN^VALM10 ;Kill data and video control arrays
DO KILL^VALM10() ;Kill Video attributes
KILL ^TMP("XTVS PACKAGE MGR",$JOB)
QUIT
;
REFRESH ; -- refresh display
DO BUILD
SET VALMBCK="R"
QUIT
;
; APIs
MSG(TEXT) ; -- set default message
IF $G(TEXT)]"" SET VALMSG=TEXT
IF $G(TEXT)']"" SET VALMSG="Enter ?? : more actions & Help, ??? : Process Help"
QUIT
;
BLDNUM() ; -- returns the build number
QUIT +$PIECE($PIECE($TEXT(XTVSLM+1),";",7),"Build ",2)
;
VERNUM() ; -- returns the version number for this build
QUIT +$PIECE($TEXT(XTVSLM+1),";",3)
;
;PROTOCOL entry points
;
SP ; -- XTVS site parameters
; -- Protocol: XTVS SITE PARAMETERS
DO FULL^VALM1
DO TED^XPAREDIT("XTVS PKG MGT PARAMETERS","B")
KILL VALMHDR
DO REFRESH
DO MSG
QUIT
;
;
PRMD ; -- Report Parameter file Display
; -- Protocol: XTVS PKG MGR PARAM DISP/EDIT ACTION
NEW DEFDIR
SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
IF (+$G(FIRSTITM)'>0)!($G(LASTITM)'>0) DO JUSTPAWS^XTVSLAPI(" No Package Parameter Files in "_DEFDIR_" to display.")
IF (+$G(FIRSTITM)>0),($G(LASTITM)>0) DO EN^XTVSLP
DO REFRESH
DO MSG
QUIT
;
VSR ; -- Generate a VistA Size Report
; -- Protocol: XTVS PKG MGR VISTA SIZE RPT
NEW DEFDIR
SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
IF (+$G(FIRSTITM)'>0)!($G(LASTITM)'>0) DO JUSTPAWS^XTVSLAPI(" No Package Parameter Files in "_DEFDIR_" to select.")
IF (+$G(FIRSTITM)>0),($G(LASTITM)>0) DO EN^XTVSLR
DO REFRESH
DO MSG
QUIT
;
EA ; -- Extract Manager
; -- Protocol: XTVS PKG MGR EXT MNGR ACTION
DO EN^XTVSLN
DO REFRESH
DO MSG
QUIT
;
DELPRM ; -- Delete a selected Parameter file
; -- Protocol: XTVS PKG MGR PARAM FILE DELETE ACTION
;
NEW DEFDIR
DO FULL^VALM1
SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
IF (+$G(FIRSTITM)'>0)!($G(LASTITM)'>0) DO JUSTPAWS^XTVSLAPI(" No Package Parameter Files to delete in "_DEFDIR_".")
IF (+$G(FIRSTITM)>0),($G(LASTITM)>0) DO
. NEW DELFILE,FILENME,CHKLKER,UNLKRSLT,DELRSLT
. SET DELFILE=0
. SET FILENME=$$SELXTMP^XTVSLAPI(FIRSTITM,LASTITM)
. IF FILENME]"" DO
.. SET CHKLKER=$$REQLOCK^XTVSLAPI(FILENME)
.. IF 'CHKLKER DO ;LOCKED
... SET DELFILE=+$$YNCHK^XTVSLAPI("Do you want to PERMANENTLY DELETE "_FILENME)
... IF DELFILE DO
.... NEW DELFLE
.... SET DELFLE(FILENME)="" SET DELRSLT=$$DEL^%ZISH(DEFDIR,$NA(DELFLE)) K DELFLE(FILENME) ;Delete selected Parameter file
.... IF 'DELRSLT DO JUSTPAWS^XTVSLAPI(FILENME_" parameter file deletion failed. Check your privileges.")
.... IF DELRSLT DO REFRESH
... SET UNLKRSLT=$$UNLCKPFL^XTVSLAPI(FILENME)
... IF ($P(UNLKRSLT,"^")'=1) W !!," <* UNLOCK ERROR. Check LOCK file Integrity. *>" DO JUSTPAWS^XTVSLAPI($P(UNLKRSLT,"^",2))
.. IF CHKLKER W !!," <* LOCK request denied! Try again later. *>" DO JUSTPAWS^XTVSLAPI($P(CHKLKER,"^",2))
;
D MSG
IF VALMCNT#13=0 SET VALMBG=VALMCNT-12 ; When last file on screen deleted, display previous screen
SET VALMBCK="R"
QUIT
;
RMVLCK ; -- Package Parameter lock cleanup
; -- Protocol: XTVS PKG MGR PARAM UNLOCK ACTION
;
NEW UNLKFNME,DELLOCK,DEFDIR,OPTUNLCK
SET OPTUNLCK=1
DO FULL^VALM1
SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
SET UNLKFNME=$$PRMFLIST^XTVSLP("XTMPSIZE*.LCK"," There are no XTMPSIZE files LOCKED!") ;Select a File to unlock
IF UNLKFNME[".LCK" DO
. SET DELLOCK=+$$YNCHK^XTVSLAPI("Do you want to UNLOCK "_$P(UNLKFNME,".")_".DAT")
. IF DELLOCK DO
.. NEW UNLKRSLT
.. SET UNLKRSLT=$$UNLCKPFL^XTVSLAPI($P(UNLKFNME,".")_".DAT") ;Delete selected Parameter Lock file
.. IF 'UNLKRSLT DO JUSTPAWS^XTVSLAPI($P(UNLKFNME,".")_".DAT"_" parameter file UNLOCK failed. Check your privileges.")
DO REFRESH
DO MSG
QUIT
;
REMREQ ; Remote Report Protocol entry point - Called from "VistA Package Size Analysis Manager"
; -- Protocol: XTVS PKG QUERY REMOTE VISTA SIZE ACTION
;
NEW DEFDIR,XTVSXFNM,LASTSPKG
DO FULL^VALM1
SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
IF (+$G(FIRSTITM)'>0)!($G(LASTITM)'>0) DO JUSTPAWS^XTVSLAPI(" No Package Parameter Files in "_DEFDIR_" to select.")
IF (+$G(FIRSTITM)>0),($G(LASTITM)>0) DO
. NEW CHKLKER,LCKCHK
. SET XTVSXFNM=$$SELXTMP^XTVSLAPI(FIRSTITM,LASTITM)
. IF XTVSXFNM]"" DO
.. SET XTVPSPRM=XTVSXFNM
.. SET LASTSPKG=""
.. SET LCKCHK=$$CHKPID^XTVSLAPI(DEFDIR,XTVPSPRM) ;Returns 1 when current process has lock
.. SET CHKLKER=$$REQLOCK^XTVSLAPI(XTVPSPRM) ;Returns 1 when any process has lock
.. IF (+CHKLKER=0)!(+LCKCHK=1) DO
... WRITE:(+CHKLKER=0) !!,$P(CHKLKER,"^",2)
... WRITE:(+LCKCHK=1) !!,XTVPSPRM_" LOCK already held."
... DO REMRPTRQ^XTVSLR(XTVPSPRM)
.. IF (+CHKLKER=1),(+LCKCHK'=1) DO
... W !!," <* LOCK request denied! Try again later. *>"
... DO JUSTPAWS^XTVSLAPI($P(CHKLKER,"^",2))
DO REFRESH
DO MSG
;
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTVSLM 8653 printed Dec 13, 2024@02:42:09 Page 2
XTVSLM ;ALBANY FO/GTS - VistA Package Sizing Manager; 23-JUN-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 PACKAGE MANAGER
+1 NEW FIRSTITM,LASTITM
+2 ;Definitions:
+3 ; FIRSTITM - Line # of first XTMPSIZE.DAT file in list
+4 ; LASTITM - Line # of last XTMPSIZE.DAT file in list
+5 ;NOTE: These variables are used by XTVSLP & XTVSLR (XTVS PKG MGR PARAM DISPLAY ListMan & XTVS PKG MGR VISTA SIZE RPT Templates)
+6 ;
+7 DO EN^VALM("XTVS PACKAGE MANAGER")
+8 QUIT
+9 ;
HDR ; -- header code
+1 SET VALMHDR(1)=" VistA Package Size Analysis Manager"
+2 SET VALMHDR(2)=" Version: "_$$VERNUM^XTVSLM()_" Build: "_$$BLDNUM^XTVSLM()
+3 QUIT
+4 ;
INIT ; -- init variables and list array
+1 ; DISPBAK - List "BAK" files indicator [NOTE: Used by this List Template to turn on/off display of *.BAK files
+2 ; [KILLed in EXIT]
+3 ; XTVPSPRM - Last selected XTMPFILE parameter file selected. [KILLed in EXIT]
+4 ;
+5 SET DISPBAK=$PIECE($$YNCHK^XTVSLAPI("Do you want to Display XTMPSIZE*.BAK (backup files)"),"^",2)
+6 ;
+7 IF DISPBAK'=-1
DO BUILD
+8 IF DISPBAK=-1
SET VALMQUIT=""
+9 DO MSG
+10 QUIT
+11 ;
BUILD ; - Build local and global display arrays
+1 NEW DEFDIR,FILENME,HDLINE,RESULT,FILELIST,UNDRLINE,FILELP,LISTNUM
+2 ;Kill all processing & data arrays and video attributes & control arrays
DO KILL
+3 ;
+4 SET (FIRSTITM,LASTITM,VALMCNT)=0
+5 SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
+6 DO ADD^XTVSLAPI(.VALMCNT," ")
+7 DO ADD^XTVSLAPI(.VALMCNT," XTMPSIZE.DAT default directory: "_$SELECT($GET(DEFDIR)]"":DEFDIR,1:"<no default defined>"),1,36,$SELECT($LENGTH(DEFDIR)>0:$LENGTH(DEFDIR),1:20))
+8 IF DEFDIR]""
Begin DoDot:1
+9 SET FILENME("XTMPSIZE*")=""
+10 SET RESULT=$$LIST^%ZISH(DEFDIR,"FILENME","FILELIST")
+11 DO ADD^XTVSLAPI(.VALMCNT," ")
+12 SET HDLINE=" XTMPSIZE.DAT Package Parameter file list in "_DEFDIR_":"
+13 SET $PIECE(UNDRLINE,"-",$LENGTH(HDLINE)-3)=""
+14 DO ADD^XTVSLAPI(.VALMCNT,HDLINE)
+15 DO ADD^XTVSLAPI(.VALMCNT," "_UNDRLINE)
+16 IF 'RESULT
DO ADD^XTVSLAPI(.VALMCNT," No XTMPSIZE* files found in "_DEFDIR_".")
+17 IF RESULT
Begin DoDot:2
+18 SET FILELP=""
+19 FOR
SET FILELP=$ORDER(FILELIST(FILELP))
if FILELP=""
QUIT
Begin DoDot:3
+20 IF ($PIECE(FILELP,".",2)'["LCK")&((+$GET(DISPBAK)=1)!($PIECE(FILELP,".",2)["DAT"))
Begin DoDot:4
+21 SET LISTNUM=VALMCNT-4
+22 DO ADD^XTVSLAPI(.VALMCNT," "_LISTNUM_") "_FILELP)
+23 if FIRSTITM=0
SET FIRSTITM=VALMCNT
+24 SET LASTITM=VALMCNT
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+25 ;
+26 QUIT
+27 ;
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 DO CLEAR^VALM1
+6 DO FULL^VALM1
+7 WRITE !,"VistA Package Size Analysis Manager help..."
+8 WRITE !,"List specific actions:",!
+9 DO DISP^XQORM1
WRITE !!
+10 SET XTQVAR=Y
+11 IF XTQVAR
Begin DoDot:2
+12 SET XTQVAR=0
+13 FOR TXTCT=1:1
SET XTX=$PIECE($TEXT(LMTXT2+TXTCT^XTVSHLP2),";",3,99)
if XTX="$END"
QUIT
if XTQVAR
QUIT
Begin DoDot:3
+14 IF XTX="$PAUSE"
DO PAUSE^VALM1
if Y
DO CLEAR^VALM1
IF 'Y
SET XTQVAR=1
QUIT
+15 WRITE !,$SELECT(XTX["$PAUSE":"",1:XTX)
End DoDot:3
End DoDot:2
+16 WRITE !
End DoDot:1
+17 IF $DATA(X)
IF X["???"
Begin DoDot:1
+18 DO CLEAR^VALM1
+19 DO FULL^VALM1
+20 WRITE !,"List specific actions:"
+21 DO DISP^XQORM1
WRITE !
+22 WRITE !,"These actions provide a set of tools that support the process described here."
+23 WRITE !,"VistA Package Size Reporting Process help...",!
+24 SET XTQVAR=Y
+25 IF XTQVAR
Begin DoDot:2
+26 SET XTQVAR=0
+27 FOR TXTCT=1:1
SET XTX=$PIECE($TEXT(LMTXT3+TXTCT^XTVSHLP2),";",3,99)
if XTX="$END"
QUIT
if XTQVAR
QUIT
Begin DoDot:3
+28 IF XTX="$PAUSE"
DO PAUSE^VALM1
if Y
DO CLEAR^VALM1
IF 'Y
SET XTQVAR=1
QUIT
+29 WRITE !,$SELECT(XTX["$PAUSE":"",1:XTX)
End DoDot:3
End DoDot:2
+30 WRITE !
End DoDot:1
+31 SET VALMBCK="R"
+32 DO MSG
+33 KILL XTX,Y,TXTCT,XTQVAR
+34 QUIT
+35 ;
EXIT ; -- exit code
+1 DO KILL
+2 KILL DISPBAK,XTVPSPRM
+3 QUIT
+4 ;
KILL ; - Kill 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 PACKAGE MGR",$JOB)
+4 QUIT
+5 ;
REFRESH ; -- refresh display
+1 DO BUILD
+2 SET VALMBCK="R"
+3 QUIT
+4 ;
+5 ; APIs
MSG(TEXT) ; -- set default message
+1 IF $GET(TEXT)]""
SET VALMSG=TEXT
+2 IF $GET(TEXT)']""
SET VALMSG="Enter ?? : more actions & Help, ??? : Process Help"
+3 QUIT
+4 ;
BLDNUM() ; -- returns the build number
+1 QUIT +$PIECE($PIECE($TEXT(XTVSLM+1),";",7),"Build ",2)
+2 ;
VERNUM() ; -- returns the version number for this build
+1 QUIT +$PIECE($TEXT(XTVSLM+1),";",3)
+2 ;
+3 ;PROTOCOL entry points
+4 ;
SP ; -- XTVS site parameters
+1 ; -- Protocol: XTVS SITE PARAMETERS
+2 DO FULL^VALM1
+3 DO TED^XPAREDIT("XTVS PKG MGT PARAMETERS","B")
+4 KILL VALMHDR
+5 DO REFRESH
+6 DO MSG
+7 QUIT
+8 ;
+9 ;
PRMD ; -- Report Parameter file Display
+1 ; -- Protocol: XTVS PKG MGR PARAM DISP/EDIT ACTION
+2 NEW DEFDIR
+3 SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
+4 IF (+$GET(FIRSTITM)'>0)!($GET(LASTITM)'>0)
DO JUSTPAWS^XTVSLAPI(" No Package Parameter Files in "_DEFDIR_" to display.")
+5 IF (+$GET(FIRSTITM)>0)
IF ($GET(LASTITM)>0)
DO EN^XTVSLP
+6 DO REFRESH
+7 DO MSG
+8 QUIT
+9 ;
VSR ; -- Generate a VistA Size Report
+1 ; -- Protocol: XTVS PKG MGR VISTA SIZE RPT
+2 NEW DEFDIR
+3 SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
+4 IF (+$GET(FIRSTITM)'>0)!($GET(LASTITM)'>0)
DO JUSTPAWS^XTVSLAPI(" No Package Parameter Files in "_DEFDIR_" to select.")
+5 IF (+$GET(FIRSTITM)>0)
IF ($GET(LASTITM)>0)
DO EN^XTVSLR
+6 DO REFRESH
+7 DO MSG
+8 QUIT
+9 ;
EA ; -- Extract Manager
+1 ; -- Protocol: XTVS PKG MGR EXT MNGR ACTION
+2 DO EN^XTVSLN
+3 DO REFRESH
+4 DO MSG
+5 QUIT
+6 ;
DELPRM ; -- Delete a selected Parameter file
+1 ; -- Protocol: XTVS PKG MGR PARAM FILE DELETE ACTION
+2 ;
+3 NEW DEFDIR
+4 DO FULL^VALM1
+5 SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
+6 IF (+$GET(FIRSTITM)'>0)!($GET(LASTITM)'>0)
DO JUSTPAWS^XTVSLAPI(" No Package Parameter Files to delete in "_DEFDIR_".")
+7 IF (+$GET(FIRSTITM)>0)
IF ($GET(LASTITM)>0)
Begin DoDot:1
+8 NEW DELFILE,FILENME,CHKLKER,UNLKRSLT,DELRSLT
+9 SET DELFILE=0
+10 SET FILENME=$$SELXTMP^XTVSLAPI(FIRSTITM,LASTITM)
+11 IF FILENME]""
Begin DoDot:2
+12 SET CHKLKER=$$REQLOCK^XTVSLAPI(FILENME)
+13 ;LOCKED
IF 'CHKLKER
Begin DoDot:3
+14 SET DELFILE=+$$YNCHK^XTVSLAPI("Do you want to PERMANENTLY DELETE "_FILENME)
+15 IF DELFILE
Begin DoDot:4
+16 NEW DELFLE
+17 ;Delete selected Parameter file
SET DELFLE(FILENME)=""
SET DELRSLT=$$DEL^%ZISH(DEFDIR,$NAME(DELFLE))
KILL DELFLE(FILENME)
+18 IF 'DELRSLT
DO JUSTPAWS^XTVSLAPI(FILENME_" parameter file deletion failed. Check your privileges.")
+19 IF DELRSLT
DO REFRESH
End DoDot:4
+20 SET UNLKRSLT=$$UNLCKPFL^XTVSLAPI(FILENME)
+21 IF ($PIECE(UNLKRSLT,"^")'=1)
WRITE !!," <* UNLOCK ERROR. Check LOCK file Integrity. *>"
DO JUSTPAWS^XTVSLAPI($PIECE(UNLKRSLT,"^",2))
End DoDot:3
+22 IF CHKLKER
WRITE !!," <* LOCK request denied! Try again later. *>"
DO JUSTPAWS^XTVSLAPI($PIECE(CHKLKER,"^",2))
End DoDot:2
End DoDot:1
+23 ;
+24 DO MSG
+25 ; When last file on screen deleted, display previous screen
IF VALMCNT#13=0
SET VALMBG=VALMCNT-12
+26 SET VALMBCK="R"
+27 QUIT
+28 ;
RMVLCK ; -- Package Parameter lock cleanup
+1 ; -- Protocol: XTVS PKG MGR PARAM UNLOCK ACTION
+2 ;
+3 NEW UNLKFNME,DELLOCK,DEFDIR,OPTUNLCK
+4 SET OPTUNLCK=1
+5 DO FULL^VALM1
+6 SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
+7 ;Select a File to unlock
SET UNLKFNME=$$PRMFLIST^XTVSLP("XTMPSIZE*.LCK"," There are no XTMPSIZE files LOCKED!")
+8 IF UNLKFNME[".LCK"
Begin DoDot:1
+9 SET DELLOCK=+$$YNCHK^XTVSLAPI("Do you want to UNLOCK "_$PIECE(UNLKFNME,".")_".DAT")
+10 IF DELLOCK
Begin DoDot:2
+11 NEW UNLKRSLT
+12 ;Delete selected Parameter Lock file
SET UNLKRSLT=$$UNLCKPFL^XTVSLAPI($PIECE(UNLKFNME,".")_".DAT")
+13 IF 'UNLKRSLT
DO JUSTPAWS^XTVSLAPI($PIECE(UNLKFNME,".")_".DAT"_" parameter file UNLOCK failed. Check your privileges.")
End DoDot:2
End DoDot:1
+14 DO REFRESH
+15 DO MSG
+16 QUIT
+17 ;
REMREQ ; Remote Report Protocol entry point - Called from "VistA Package Size Analysis Manager"
+1 ; -- Protocol: XTVS PKG QUERY REMOTE VISTA SIZE ACTION
+2 ;
+3 NEW DEFDIR,XTVSXFNM,LASTSPKG
+4 DO FULL^VALM1
+5 SET DEFDIR=$$GET^XPAR("SYS","XTVS PACKAGE MGR DEFAULT DIR",1,"I")
+6 IF (+$GET(FIRSTITM)'>0)!($GET(LASTITM)'>0)
DO JUSTPAWS^XTVSLAPI(" No Package Parameter Files in "_DEFDIR_" to select.")
+7 IF (+$GET(FIRSTITM)>0)
IF ($GET(LASTITM)>0)
Begin DoDot:1
+8 NEW CHKLKER,LCKCHK
+9 SET XTVSXFNM=$$SELXTMP^XTVSLAPI(FIRSTITM,LASTITM)
+10 IF XTVSXFNM]""
Begin DoDot:2
+11 SET XTVPSPRM=XTVSXFNM
+12 SET LASTSPKG=""
+13 ;Returns 1 when current process has lock
SET LCKCHK=$$CHKPID^XTVSLAPI(DEFDIR,XTVPSPRM)
+14 ;Returns 1 when any process has lock
SET CHKLKER=$$REQLOCK^XTVSLAPI(XTVPSPRM)
+15 IF (+CHKLKER=0)!(+LCKCHK=1)
Begin DoDot:3
+16 if (+CHKLKER=0)
WRITE !!,$PIECE(CHKLKER,"^",2)
+17 if (+LCKCHK=1)
WRITE !!,XTVPSPRM_" LOCK already held."
+18 DO REMRPTRQ^XTVSLR(XTVPSPRM)
End DoDot:3
+19 IF (+CHKLKER=1)
IF (+LCKCHK'=1)
Begin DoDot:3
+20 WRITE !!," <* LOCK request denied! Try again later. *>"
+21 DO JUSTPAWS^XTVSLAPI($PIECE(CHKLKER,"^",2))
End DoDot:3
End DoDot:2
End DoDot:1
+22 DO REFRESH
+23 DO MSG
+24 ;
+25 QUIT
