A1VSLDE ;Albany FO/GTS - VistA Package Sizing Manager; 30-JUN-2016
;;1.0;VistA Package Sizing;;Oct 10, 2016;Build 25
;
EN ; -- main entry point for A1VS PKG MGR EXT DISP ACTION
D EN^VALM("A1VS PKG MGR EXT DISP")
Q
;
HDR ; -- header code
;NOTE: XPID must be set by invoking action
;
NEW XSYSTEM,XDATE,DIRHEAD,SPCPAD
;
SET XDATE=$P(^XTMP("A1SIZE",XPID,0),"^")
SET XSYSTEM=$P(^XTMP("A1SIZE",XPID,0),"^",2)
SET XDATE=$$FMTE^XLFDT(XDATE,"1P")
SET:XDATE']"" XDATE="undefined"
SET:XSYSTEM']"" XSYSTEM="undefined"
;
SET VALMHDR(1)=" VistA Package Size Analysis Manager - Display Extract"
SET VALMHDR(2)=" Version: "_$$VERNUM^A1VSLM()_" Build: "_$$BLDNUM^A1VSLM()
SET DIRHEAD="System: "_XSYSTEM_" PID:"_XPID_" Date: "_XDATE
SET $P(SPCPAD," ",(80-$L(DIRHEAD))/2)=""
SET VALMHDR(3)=SPCPAD_DIRHEAD
QUIT
;
INIT ; -- init variables and list array
DO KILL ;Kill all processing & data arrays and video attributes & control arrays
NEW PKGSUB,FNSUB,PPFX,BFNM,EFNM,FILEMULT,ADDPFX,EXCPFX,FILRNG,PARENT
SET VALMCNT=0
DO ADD^A1VSLAPI(.VALMCNT," ")
DO ADD^A1VSLAPI(.VALMCNT," Package data in ^XTMP extract")
DO ADD^A1VSLAPI(.VALMCNT," ")
SET PKGSUB=0
FOR SET PKGSUB=$O(^XTMP("A1SIZE",XPID,PKGSUB)) Q:PKGSUB="" DO
. SET (PPFX,BFNM,EFNM,ADDPFX,EXCPFX,FRNG,PARENT)=0
. SET PPFX=$P(^XTMP("A1SIZE",XPID,PKGSUB),"^")
. SET BFNM=$P(^XTMP("A1SIZE",XPID,PKGSUB),"^",2)
. SET EFNM=$P(^XTMP("A1SIZE",XPID,PKGSUB),"^",3)
. SET FILEMULT=$$FEXT^A1VSLAPI("^XTMP(""A1SIZE"","_XPID_","""_PKGSUB_""")")
. SET ADDPFX=$P(^XTMP("A1SIZE",XPID,PKGSUB),"^",4)
. SET EXCPFX=$P(^XTMP("A1SIZE",XPID,PKGSUB),"^",5)
. SET FILRNG=$P(^XTMP("A1SIZE",XPID,PKGSUB),"^",6)
. SET PARENT=$P(^XTMP("A1SIZE",XPID,PKGSUB),"^",7)
. DO ADD^A1VSLAPI(.VALMCNT," ")
. DO ADD^A1VSLAPI(.VALMCNT,PKGSUB,1,1,$L(PKGSUB))
. DO ADD^A1VSLAPI(.VALMCNT,"Prefix: "_PPFX)
. DO ADD^A1VSLAPI(.VALMCNT,"*Low File#: "_BFNM_" *High File#: "_EFNM)
. DO SPLITADD^A1VSLAPI(.VALMCNT,"File List: "_FILEMULT)
. DO SPLITADD^A1VSLAPI(.VALMCNT,"Added Prefixes: "_ADDPFX)
. DO SPLITADD^A1VSLAPI(.VALMCNT,"Excluded Prefixes: "_EXCPFX)
. DO SPLITADD^A1VSLAPI(.VALMCNT,"File Ranges: "_FILRNG)
. DO ADD^A1VSLAPI(.VALMCNT,"Parent Package: "_PARENT)
QUIT
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
DO KILL
Q
;
EXPND ; -- expand code
Q
;
KILL ;Clean up global arrays/variables and local variables
DO CLEAN^VALM10 ;Kill data and video control arrays
DO KILL^VALM10() ;Kill Video attributes
KILL ^TMP("A1VS PKG MGR EXT DISP",$JOB)
KILL DIR,X,Y,DTOUT,DIRUT,DUOUT
QUIT
;
;PROTOCOL entry points
DEL ; -- Delete Extract
; -- Protocol: A1VS PKG EXT DISP DEL ACTION
NEW X,Y,DIR
SET DIR("A",1)=""
SET DIR("A")="Do you want to delete ^XTMP(""A1SIZE"","_XPID_")"
SET DIR("B")="NO"
SET DIR(0)="Y::"
DO ^DIR
IF ('$D(DTOUT)),('$D(DUOUT)),(($G(Y)=1)) DO QUIT
. KILL ^XTMP("A1SIZE",XPID),X,Y,DTOUT,DIRUT,DUOUT
. DO EXIT
. DO REFRESH^A1VSLN
. SET VALMBCK="Q"
IF ($D(DTOUT))!($D(DUOUT))!(($G(Y)=0)) DO
. DO JUSTPAWS^A1VSLAPI("^XTMP(""A1SIZE"","_XPID_") NOT DELETED!")
;
KILL X,Y,DTOUT,DIRUT,DUOUT
SET VALMBCK="R"
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HA1VSLDE 3258 printed Apr 09, 2024@20:43:51 Page 2
A1VSLDE ;Albany FO/GTS - VistA Package Sizing Manager; 30-JUN-2016
+1 ;;1.0;VistA Package Sizing;;Oct 10, 2016;Build 25
+2 ;
EN ; -- main entry point for A1VS PKG MGR EXT DISP ACTION
+1 DO EN^VALM("A1VS PKG MGR EXT DISP")
+2 QUIT
+3 ;
HDR ; -- header code
+1 ;NOTE: XPID must be set by invoking action
+2 ;
+3 NEW XSYSTEM,XDATE,DIRHEAD,SPCPAD
+4 ;
+5 SET XDATE=$PIECE(^XTMP("A1SIZE",XPID,0),"^")
+6 SET XSYSTEM=$PIECE(^XTMP("A1SIZE",XPID,0),"^",2)
+7 SET XDATE=$$FMTE^XLFDT(XDATE,"1P")
+8 if XDATE']""
SET XDATE="undefined"
+9 if XSYSTEM']""
SET XSYSTEM="undefined"
+10 ;
+11 SET VALMHDR(1)=" VistA Package Size Analysis Manager - Display Extract"
+12 SET VALMHDR(2)=" Version: "_$$VERNUM^A1VSLM()_" Build: "_$$BLDNUM^A1VSLM()
+13 SET DIRHEAD="System: "_XSYSTEM_" PID:"_XPID_" Date: "_XDATE
+14 SET $PIECE(SPCPAD," ",(80-$LENGTH(DIRHEAD))/2)=""
+15 SET VALMHDR(3)=SPCPAD_DIRHEAD
+16 QUIT
+17 ;
INIT ; -- init variables and list array
+1 ;Kill all processing & data arrays and video attributes & control arrays
DO KILL
+2 NEW PKGSUB,FNSUB,PPFX,BFNM,EFNM,FILEMULT,ADDPFX,EXCPFX,FILRNG,PARENT
+3 SET VALMCNT=0
+4 DO ADD^A1VSLAPI(.VALMCNT," ")
+5 DO ADD^A1VSLAPI(.VALMCNT," Package data in ^XTMP extract")
+6 DO ADD^A1VSLAPI(.VALMCNT," ")
+7 SET PKGSUB=0
+8 FOR
SET PKGSUB=$ORDER(^XTMP("A1SIZE",XPID,PKGSUB))
if PKGSUB=""
QUIT
Begin DoDot:1
+9 SET (PPFX,BFNM,EFNM,ADDPFX,EXCPFX,FRNG,PARENT)=0
+10 SET PPFX=$PIECE(^XTMP("A1SIZE",XPID,PKGSUB),"^")
+11 SET BFNM=$PIECE(^XTMP("A1SIZE",XPID,PKGSUB),"^",2)
+12 SET EFNM=$PIECE(^XTMP("A1SIZE",XPID,PKGSUB),"^",3)
+13 SET FILEMULT=$$FEXT^A1VSLAPI("^XTMP(""A1SIZE"","_XPID_","""_PKGSUB_""")")
+14 SET ADDPFX=$PIECE(^XTMP("A1SIZE",XPID,PKGSUB),"^",4)
+15 SET EXCPFX=$PIECE(^XTMP("A1SIZE",XPID,PKGSUB),"^",5)
+16 SET FILRNG=$PIECE(^XTMP("A1SIZE",XPID,PKGSUB),"^",6)
+17 SET PARENT=$PIECE(^XTMP("A1SIZE",XPID,PKGSUB),"^",7)
+18 DO ADD^A1VSLAPI(.VALMCNT," ")
+19 DO ADD^A1VSLAPI(.VALMCNT,PKGSUB,1,1,$LENGTH(PKGSUB))
+20 DO ADD^A1VSLAPI(.VALMCNT,"Prefix: "_PPFX)
+21 DO ADD^A1VSLAPI(.VALMCNT,"*Low File#: "_BFNM_" *High File#: "_EFNM)
+22 DO SPLITADD^A1VSLAPI(.VALMCNT,"File List: "_FILEMULT)
+23 DO SPLITADD^A1VSLAPI(.VALMCNT,"Added Prefixes: "_ADDPFX)
+24 DO SPLITADD^A1VSLAPI(.VALMCNT,"Excluded Prefixes: "_EXCPFX)
+25 DO SPLITADD^A1VSLAPI(.VALMCNT,"File Ranges: "_FILRNG)
+26 DO ADD^A1VSLAPI(.VALMCNT,"Parent Package: "_PARENT)
End DoDot:1
+27 QUIT
+28 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 DO KILL
+2 QUIT
+3 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
KILL ;Clean up global arrays/variables and local variables
+1 ;Kill data and video control arrays
DO CLEAN^VALM10
+2 ;Kill Video attributes
DO KILL^VALM10()
+3 KILL ^TMP("A1VS PKG MGR EXT DISP",$JOB)
+4 KILL DIR,X,Y,DTOUT,DIRUT,DUOUT
+5 QUIT
+6 ;
+7 ;PROTOCOL entry points
DEL ; -- Delete Extract
+1 ; -- Protocol: A1VS PKG EXT DISP DEL ACTION
+2 NEW X,Y,DIR
+3 SET DIR("A",1)=""
+4 SET DIR("A")="Do you want to delete ^XTMP(""A1SIZE"","_XPID_")"
+5 SET DIR("B")="NO"
+6 SET DIR(0)="Y::"
+7 DO ^DIR
+8 IF ('$DATA(DTOUT))
IF ('$DATA(DUOUT))
IF (($GET(Y)=1))
Begin DoDot:1
+9 KILL ^XTMP("A1SIZE",XPID),X,Y,DTOUT,DIRUT,DUOUT
+10 DO EXIT
+11 DO REFRESH^A1VSLN
+12 SET VALMBCK="Q"
End DoDot:1
QUIT
+13 IF ($DATA(DTOUT))!($DATA(DUOUT))!(($GET(Y)=0))
Begin DoDot:1
+14 DO JUSTPAWS^A1VSLAPI("^XTMP(""A1SIZE"","_XPID_") NOT DELETED!")
End DoDot:1
+15 ;
+16 KILL X,Y,DTOUT,DIRUT,DUOUT
+17 SET VALMBCK="R"
+18 QUIT
