A1VSLM ;Albany FO/GTS - VistA Package Sizing Manager; 23-JUN-2016
;;1.0;VistA Package Sizing;;Oct 10, 2016;Build 25
;
EN ; -- main entry point for A1VS PACKAGE MANAGER
NEW FIRSTITM,LASTITM
;Definitions:
; FIRSTITM - Line Item of first XTMPSIZE.DAT file in list
; LASTITM - Line Item of last XTMPSIZE.DAT file in list
;NOTE: These variables are used by A1VSLP & A1VSLR (A1VS PKG MGR PARAM DISPLAY ListMan & A1VS PKG MGR VISTA SIZE RPT Templates)
;
D EN^VALM("A1VS PACKAGE MANAGER")
QUIT
;
HDR ; -- header code
SET VALMHDR(1)=" VistA Package Size Analysis Manager"
SET VALMHDR(2)=" Version: "_$$VERNUM^A1VSLM()_" Build: "_$$BLDNUM^A1VSLM()
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]
;
SET DISPBAK=+$$YNCHK^A1VSLAPI("Do you want to Display XTMPSIZE*.BAK (backup files)")
;
DO BUILD
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","A1VS PACKAGE MGR DEFAULT DIR",1,"I")
DO ADD^A1VSLAPI(.VALMCNT," ")
DO ADD^A1VSLAPI(.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^A1VSLAPI(.VALMCNT," ")
. SET HDLINE=" XTMPSIZE.DAT Package Parameter file list in "_DEFDIR_":"
. SET $P(UNDRLINE,"-",$L(HDLINE)-3)=""
. DO ADD^A1VSLAPI(.VALMCNT,HDLINE)
. DO ADD^A1VSLAPI(.VALMCNT," "_UNDRLINE)
. IF 'RESULT DO ADD^A1VSLAPI(.VALMCNT," No XTMPSIZE* files found in "_DEFDIR_".")
. IF RESULT DO
.. SET FILELP=""
.. FOR SET FILELP=$O(FILELIST(FILELP)) Q:FILELP="" DO
... IF (+$G(DISPBAK)=1)!($P(FILELP,".",2)["DAT") DO
.... SET LISTNUM=VALMCNT-4
.... DO ADD^A1VSLAPI(.VALMCNT," "_LISTNUM_") "_FILELP)
.... SET:FIRSTITM=0 FIRSTITM=VALMCNT
.... SET LASTITM=VALMCNT
;
QUIT
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
DO KILL
KILL DISPBAK
Q
;
EXPND ; -- expand code
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("A1VS PACKAGE MGR",$JOB)
QUIT
;
REFRESH ; -- refresh display
DO BUILD
SET VALMBCK="R"
QUIT
;
; APIs
MSG(TEXT) ; -- set default message
;SET VALMSG=TEXT
QUIT
;
BLDNUM() ; -- returns the build number
QUIT +$PIECE($PIECE($TEXT(A1VSLM+1),";",7),"Build ",2)
;
VERNUM() ; -- returns the version number for this build
QUIT +$PIECE($TEXT(A1VSLM+1),";",3)
;
;PROTOCOL entry points
;
SP ; -- A1VS site parameters
; -- Protocol: A1VS SITE PARAMETERS
DO FULL^VALM1
DO TED^XPAREDIT("A1VS PKG MGT PARAMETERS","B")
KILL VALMHDR
DO REFRESH
DO MSG
QUIT
;
;
PE ; -- Package Manager Editor
; -- Protocol: A1VS PKG MGR MENU EDIT ACTION
DO EN^A1VSLE
DO REFRESH
DO MSG
QUIT
;
PRMD ; -- Report Parameter file Display
; -- Protocol: A1VS PKG MGR PARAM DISPLAY ACTION
DO EN^A1VSLP
DO REFRESH
DO MSG
QUIT
;
VSR ; -- Generate a VistA Size Report
; -- Protocol: A1VS PKG MGR VISTA SIZE RPT
DO EN^A1VSLR
DO REFRESH
DO MSG
QUIT
;
EA ; -- Extract Manager
; -- Protocol: A1VS PKG MGR EXT MNGR ACTION
DO EN^A1VSLN
DO REFRESH
DO MSG
QUIT
;
DELPRM ; -- Delete a selected Parameter file
; -- Protocol: A1VS PKG MGR PARAM FILE DELETE ACTION
;
NEW DEFDIR
DO FULL^VALM1
SET DEFDIR=$$GET^XPAR("SYS","A1VS PACKAGE MGR DEFAULT DIR",1,"I")
IF (+$G(FIRSTITM)'>0)!($G(LASTITM)'>0) DO JUSTPAWS^A1VSLAPI(" No Package Parameter Files to delete in "_DEFDIR_".")
IF (+$G(FIRSTITM)>0),($G(LASTITM)>0) DO
. NEW DELFILE,FILESEL,FILENME
. SET DELFILE=0
. SET FILESEL=$$SELXTMP^A1VSLAPI(FIRSTITM,LASTITM,5)
. IF +FILESEL>0 DO
.. SET FILENME=$P($G(^TMP("A1VS PACKAGE MGR",$J,FILESEL,0)),FILESEL-5_") ",2)
.. SET DELFILE=+$$YNCHK^A1VSLAPI("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^A1VSLAPI(FILENME_" parameter file deletion failed. Check your privileges.")
... IF DELRSLT DO REFRESH
;
SET VALMBCK="R"
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HA1VSLM 4659 printed Sep 23, 2025@19:14:40 Page 2
A1VSLM ;Albany FO/GTS - VistA Package Sizing Manager; 23-JUN-2016
+1 ;;1.0;VistA Package Sizing;;Oct 10, 2016;Build 25
+2 ;
EN ; -- main entry point for A1VS PACKAGE MANAGER
+1 NEW FIRSTITM,LASTITM
+2 ;Definitions:
+3 ; FIRSTITM - Line Item of first XTMPSIZE.DAT file in list
+4 ; LASTITM - Line Item of last XTMPSIZE.DAT file in list
+5 ;NOTE: These variables are used by A1VSLP & A1VSLR (A1VS PKG MGR PARAM DISPLAY ListMan & A1VS PKG MGR VISTA SIZE RPT Templates)
+6 ;
+7 DO EN^VALM("A1VS PACKAGE MANAGER")
+8 QUIT
+9 ;
HDR ; -- header code
+1 SET VALMHDR(1)=" VistA Package Size Analysis Manager"
+2 SET VALMHDR(2)=" Version: "_$$VERNUM^A1VSLM()_" Build: "_$$BLDNUM^A1VSLM()
+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 ;
+4 SET DISPBAK=+$$YNCHK^A1VSLAPI("Do you want to Display XTMPSIZE*.BAK (backup files)")
+5 ;
+6 DO BUILD
+7 QUIT
+8 ;
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","A1VS PACKAGE MGR DEFAULT DIR",1,"I")
+6 DO ADD^A1VSLAPI(.VALMCNT," ")
+7 DO ADD^A1VSLAPI(.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^A1VSLAPI(.VALMCNT," ")
+12 SET HDLINE=" XTMPSIZE.DAT Package Parameter file list in "_DEFDIR_":"
+13 SET $PIECE(UNDRLINE,"-",$LENGTH(HDLINE)-3)=""
+14 DO ADD^A1VSLAPI(.VALMCNT,HDLINE)
+15 DO ADD^A1VSLAPI(.VALMCNT," "_UNDRLINE)
+16 IF 'RESULT
DO ADD^A1VSLAPI(.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 (+$GET(DISPBAK)=1)!($PIECE(FILELP,".",2)["DAT")
Begin DoDot:4
+21 SET LISTNUM=VALMCNT-4
+22 DO ADD^A1VSLAPI(.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 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 DO KILL
+2 KILL DISPBAK
+3 QUIT
+4 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
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("A1VS 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 ;SET VALMSG=TEXT
+2 QUIT
+3 ;
BLDNUM() ; -- returns the build number
+1 QUIT +$PIECE($PIECE($TEXT(A1VSLM+1),";",7),"Build ",2)
+2 ;
VERNUM() ; -- returns the version number for this build
+1 QUIT +$PIECE($TEXT(A1VSLM+1),";",3)
+2 ;
+3 ;PROTOCOL entry points
+4 ;
SP ; -- A1VS site parameters
+1 ; -- Protocol: A1VS SITE PARAMETERS
+2 DO FULL^VALM1
+3 DO TED^XPAREDIT("A1VS PKG MGT PARAMETERS","B")
+4 KILL VALMHDR
+5 DO REFRESH
+6 DO MSG
+7 QUIT
+8 ;
+9 ;
PE ; -- Package Manager Editor
+1 ; -- Protocol: A1VS PKG MGR MENU EDIT ACTION
+2 DO EN^A1VSLE
+3 DO REFRESH
+4 DO MSG
+5 QUIT
+6 ;
PRMD ; -- Report Parameter file Display
+1 ; -- Protocol: A1VS PKG MGR PARAM DISPLAY ACTION
+2 DO EN^A1VSLP
+3 DO REFRESH
+4 DO MSG
+5 QUIT
+6 ;
VSR ; -- Generate a VistA Size Report
+1 ; -- Protocol: A1VS PKG MGR VISTA SIZE RPT
+2 DO EN^A1VSLR
+3 DO REFRESH
+4 DO MSG
+5 QUIT
+6 ;
EA ; -- Extract Manager
+1 ; -- Protocol: A1VS PKG MGR EXT MNGR ACTION
+2 DO EN^A1VSLN
+3 DO REFRESH
+4 DO MSG
+5 QUIT
+6 ;
DELPRM ; -- Delete a selected Parameter file
+1 ; -- Protocol: A1VS PKG MGR PARAM FILE DELETE ACTION
+2 ;
+3 NEW DEFDIR
+4 DO FULL^VALM1
+5 SET DEFDIR=$$GET^XPAR("SYS","A1VS PACKAGE MGR DEFAULT DIR",1,"I")
+6 IF (+$GET(FIRSTITM)'>0)!($GET(LASTITM)'>0)
DO JUSTPAWS^A1VSLAPI(" No Package Parameter Files to delete in "_DEFDIR_".")
+7 IF (+$GET(FIRSTITM)>0)
IF ($GET(LASTITM)>0)
Begin DoDot:1
+8 NEW DELFILE,FILESEL,FILENME
+9 SET DELFILE=0
+10 SET FILESEL=$$SELXTMP^A1VSLAPI(FIRSTITM,LASTITM,5)
+11 IF +FILESEL>0
Begin DoDot:2
+12 SET FILENME=$PIECE($GET(^TMP("A1VS PACKAGE MGR",$JOB,FILESEL,0)),FILESEL-5_") ",2)
+13 SET DELFILE=+$$YNCHK^A1VSLAPI("Do you want to PERMANENTLY DELETE "_FILENME)
+14 IF DELFILE
Begin DoDot:3
+15 NEW DELFLE
+16 ;Delete selected Parameter file
SET DELFLE(FILENME)=""
SET DELRSLT=$$DEL^%ZISH(DEFDIR,$NAME(DELFLE))
KILL DELFLE(FILENME)
+17 IF 'DELRSLT
DO JUSTPAWS^A1VSLAPI(FILENME_" parameter file deletion failed. Check your privileges.")
+18 IF DELRSLT
DO REFRESH
End DoDot:3
End DoDot:2
End DoDot:1
+19 ;
+20 SET VALMBCK="R"
+21 QUIT
