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