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

XTVSLM.m

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