XTVSLDE ;Albany FO/GTS - VistA Package Sizing Manager; 30-JUN-2016
;;7.3;TOOLKIT;**143**;Apr 25, 1995;Build 116
;
EN ; -- main entry point for XTVS PKG MGR EXT DISP ACTION
D EN^VALM("XTVS PKG MGR EXT DISP")
Q
;
HDR ; -- header code
;NOTE: XPID must be set by invoking action
;
NEW XSYSTEM,XDATE,DIRHEAD,SPCPAD
;
SET XDATE=$P($P(^XTMP("XTSIZE",XPID,0),"^",3),"-")
SET XSYSTEM=$P(^XTMP("XTSIZE",XPID,0),"^",4)
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^XTVSLM()_" Build: "_$$BLDNUM^XTVSLM()
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^XTVSLAPI(.VALMCNT," ")
DO ADD^XTVSLAPI(.VALMCNT," Package data in ^XTMP extract")
DO ADD^XTVSLAPI(.VALMCNT," ")
SET PKGSUB=0
FOR SET PKGSUB=$O(^XTMP("XTSIZE",XPID,PKGSUB)) Q:PKGSUB="" DO
. SET (PPFX,BFNM,EFNM,ADDPFX,EXCPFX,FRNG,PARENT)=0
. SET PPFX=$P(^XTMP("XTSIZE",XPID,PKGSUB),"^")
. SET BFNM=$P(^XTMP("XTSIZE",XPID,PKGSUB),"^",2)
. SET EFNM=$P(^XTMP("XTSIZE",XPID,PKGSUB),"^",3)
. SET FILEMULT=$$FEXT^XTVSLAPI("^XTMP(""XTSIZE"","_XPID_","""_PKGSUB_""")")
. SET ADDPFX=$P(^XTMP("XTSIZE",XPID,PKGSUB),"^",4)
. SET EXCPFX=$P(^XTMP("XTSIZE",XPID,PKGSUB),"^",5)
. SET FILRNG=$P(^XTMP("XTSIZE",XPID,PKGSUB),"^",6)
. SET PARENT=$P(^XTMP("XTSIZE",XPID,PKGSUB),"^",7)
. DO ADD^XTVSLAPI(.VALMCNT," ")
. DO ADD^XTVSLAPI(.VALMCNT,PKGSUB,1,1,$L(PKGSUB))
. DO ADD^XTVSLAPI(.VALMCNT,"Prefix: "_PPFX)
. DO ADD^XTVSLAPI(.VALMCNT,"*Low File#: "_BFNM_" *High File#: "_EFNM)
. DO SPLITADD^XTVSLAPI(.VALMCNT,"File List: "_FILEMULT)
. DO SPLITADD^XTVSLAPI(.VALMCNT,"Added Prefixes: "_ADDPFX)
. DO SPLITADD^XTVSLAPI(.VALMCNT,"Excluded Prefixes: "_EXCPFX)
. DO SPLITADD^XTVSLAPI(.VALMCNT,"File Ranges: "_FILRNG)
. DO ADD^XTVSLAPI(.VALMCNT,"Parent Package: "_PARENT)
DO MSG
QUIT
;
HELP ; -- help code
IF $D(X),X'["??" DO
. SET X="?"
. DO DISP^XQORM1 W !
IF $D(X),X["??" DO
. DO CLEAR^VALM1
. DO FULL^VALM1
. WRITE !,"Display Extract help..."
. WRITE !,"List specific actions:",!
. DO DISP^XQORM1 W !
. WRITE !,"Delete Displayed Extract - This action prompts the user to confirm deletion"
. WRITE !," of the ^XTMP global displayed in the list. 'No' displays a message and"
. WRITE !," redisplays the extract global. 'Yes' deletes the global and returns to"
. WRITE !," the Extract Manager screen.",!!
D MSG
Q
;
EXIT ; -- exit code
DO KILL
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("XTVS PKG MGR EXT DISP",$JOB)
KILL DIR,X,Y,DTOUT,DIRUT,DUOUT
QUIT
;
MSG(TEXT) ; -- set default message
IF $G(TEXT)]"" SET VALMSG=TEXT
IF $G(TEXT)']"" SET VALMSG="Enter ?? for more actions and Help"
QUIT
;
;PROTOCOL entry points
DEL ; -- Delete Extract
; -- Protocol: XTVS PKG EXT DISP DEL ACTION
NEW X,Y,DIR
SET DIR("A",1)=""
SET DIR("A")="Do you want to delete ^XTMP(""XTSIZE"","_XPID_")"
SET DIR("B")="NO"
SET DIR(0)="Y::"
DO ^DIR
IF ('$D(DTOUT)),('$D(DUOUT)),(($G(Y)=1)) DO QUIT
. KILL ^XTMP("XTSIZE",XPID),X,Y,DTOUT,DIRUT,DUOUT
. DO EXIT
. DO REFRESH^XTVSLN
. SET VALMBCK="Q"
IF ($D(DTOUT))!($D(DUOUT))!(($G(Y)=0)) DO
. DO JUSTPAWS^XTVSLAPI("^XTMP(""XTSIZE"","_XPID_") NOT DELETED!")
;
KILL X,Y,DTOUT,DIRUT,DUOUT
DO MSG
SET VALMBCK="R"
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTVSLDE 3904 printed Oct 16, 2024@18:42:44 Page 2
XTVSLDE ;Albany FO/GTS - VistA Package Sizing Manager; 30-JUN-2016
+1 ;;7.3;TOOLKIT;**143**;Apr 25, 1995;Build 116
+2 ;
EN ; -- main entry point for XTVS PKG MGR EXT DISP ACTION
+1 DO EN^VALM("XTVS 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($PIECE(^XTMP("XTSIZE",XPID,0),"^",3),"-")
+6 SET XSYSTEM=$PIECE(^XTMP("XTSIZE",XPID,0),"^",4)
+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^XTVSLM()_" Build: "_$$BLDNUM^XTVSLM()
+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^XTVSLAPI(.VALMCNT," ")
+5 DO ADD^XTVSLAPI(.VALMCNT," Package data in ^XTMP extract")
+6 DO ADD^XTVSLAPI(.VALMCNT," ")
+7 SET PKGSUB=0
+8 FOR
SET PKGSUB=$ORDER(^XTMP("XTSIZE",XPID,PKGSUB))
if PKGSUB=""
QUIT
Begin DoDot:1
+9 SET (PPFX,BFNM,EFNM,ADDPFX,EXCPFX,FRNG,PARENT)=0
+10 SET PPFX=$PIECE(^XTMP("XTSIZE",XPID,PKGSUB),"^")
+11 SET BFNM=$PIECE(^XTMP("XTSIZE",XPID,PKGSUB),"^",2)
+12 SET EFNM=$PIECE(^XTMP("XTSIZE",XPID,PKGSUB),"^",3)
+13 SET FILEMULT=$$FEXT^XTVSLAPI("^XTMP(""XTSIZE"","_XPID_","""_PKGSUB_""")")
+14 SET ADDPFX=$PIECE(^XTMP("XTSIZE",XPID,PKGSUB),"^",4)
+15 SET EXCPFX=$PIECE(^XTMP("XTSIZE",XPID,PKGSUB),"^",5)
+16 SET FILRNG=$PIECE(^XTMP("XTSIZE",XPID,PKGSUB),"^",6)
+17 SET PARENT=$PIECE(^XTMP("XTSIZE",XPID,PKGSUB),"^",7)
+18 DO ADD^XTVSLAPI(.VALMCNT," ")
+19 DO ADD^XTVSLAPI(.VALMCNT,PKGSUB,1,1,$LENGTH(PKGSUB))
+20 DO ADD^XTVSLAPI(.VALMCNT,"Prefix: "_PPFX)
+21 DO ADD^XTVSLAPI(.VALMCNT,"*Low File#: "_BFNM_" *High File#: "_EFNM)
+22 DO SPLITADD^XTVSLAPI(.VALMCNT,"File List: "_FILEMULT)
+23 DO SPLITADD^XTVSLAPI(.VALMCNT,"Added Prefixes: "_ADDPFX)
+24 DO SPLITADD^XTVSLAPI(.VALMCNT,"Excluded Prefixes: "_EXCPFX)
+25 DO SPLITADD^XTVSLAPI(.VALMCNT,"File Ranges: "_FILRNG)
+26 DO ADD^XTVSLAPI(.VALMCNT,"Parent Package: "_PARENT)
End DoDot:1
+27 DO MSG
+28 QUIT
+29 ;
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["??"
Begin DoDot:1
+5 DO CLEAR^VALM1
+6 DO FULL^VALM1
+7 WRITE !,"Display Extract help..."
+8 WRITE !,"List specific actions:",!
+9 DO DISP^XQORM1
WRITE !
+10 WRITE !,"Delete Displayed Extract - This action prompts the user to confirm deletion"
+11 WRITE !," of the ^XTMP global displayed in the list. 'No' displays a message and"
+12 WRITE !," redisplays the extract global. 'Yes' deletes the global and returns to"
+13 WRITE !," the Extract Manager screen.",!!
End DoDot:1
+14 DO MSG
+15 QUIT
+16 ;
EXIT ; -- exit code
+1 DO KILL
+2 QUIT
+3 ;
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("XTVS PKG MGR EXT DISP",$JOB)
+4 KILL DIR,X,Y,DTOUT,DIRUT,DUOUT
+5 QUIT
+6 ;
MSG(TEXT) ; -- set default message
+1 IF $GET(TEXT)]""
SET VALMSG=TEXT
+2 IF $GET(TEXT)']""
SET VALMSG="Enter ?? for more actions and Help"
+3 QUIT
+4 ;
+5 ;PROTOCOL entry points
DEL ; -- Delete Extract
+1 ; -- Protocol: XTVS 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(""XTSIZE"","_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("XTSIZE",XPID),X,Y,DTOUT,DIRUT,DUOUT
+10 DO EXIT
+11 DO REFRESH^XTVSLN
+12 SET VALMBCK="Q"
End DoDot:1
QUIT
+13 IF ($DATA(DTOUT))!($DATA(DUOUT))!(($GET(Y)=0))
Begin DoDot:1
+14 DO JUSTPAWS^XTVSLAPI("^XTMP(""XTSIZE"","_XPID_") NOT DELETED!")
End DoDot:1
+15 ;
+16 KILL X,Y,DTOUT,DIRUT,DUOUT
+17 DO MSG
+18 SET VALMBCK="R"
+19 QUIT
