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

A1VSLDE.m

Go to the documentation of this file. 
  1. A1VSLDE ;Albany FO/GTS - VistA Package Sizing Manager; 30-JUN-2016
  1.  ;;1.0;VistA Package Sizing;;Oct 10, 2016;Build 25
  1.  ;
  1. EN ; -- main entry point for A1VS PKG MGR EXT DISP ACTION
  1.  D EN^VALM("A1VS PKG MGR EXT DISP")
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  ;NOTE: XPID must be set by invoking action
  1.  ;
  1.  NEW XSYSTEM,XDATE,DIRHEAD,SPCPAD
  1.  ;
  1.  SET XDATE=$P(^XTMP("A1SIZE",XPID,0),"^")
  1.  SET XSYSTEM=$P(^XTMP("A1SIZE",XPID,0),"^",2)
  1.  SET XDATE=$$FMTE^XLFDT(XDATE,"1P")
  1.  SET:XDATE']"" XDATE="undefined"
  1.  SET:XSYSTEM']"" XSYSTEM="undefined"
  1.  ;
  1.  SET VALMHDR(1)="           VistA Package Size Analysis Manager - Display Extract"
  1.  SET VALMHDR(2)="                         Version: "_$$VERNUM^A1VSLM()_"     Build: "_$$BLDNUM^A1VSLM()
  1.  SET DIRHEAD="System: "_XSYSTEM_"    PID:"_XPID_"     Date: "_XDATE
  1.  SET $P(SPCPAD," ",(80-$L(DIRHEAD))/2)=""
  1.  SET VALMHDR(3)=SPCPAD_DIRHEAD
  1.  QUIT
  1.  ;
  1. INIT ; -- init variables and list array
  1.  DO KILL ;Kill all processing & data arrays and video attributes & control arrays
  1.  NEW PKGSUB,FNSUB,PPFX,BFNM,EFNM,FILEMULT,ADDPFX,EXCPFX,FILRNG,PARENT
  1.  SET VALMCNT=0
  1.  DO ADD^A1VSLAPI(.VALMCNT," ")
  1.  DO ADD^A1VSLAPI(.VALMCNT,"  Package data in ^XTMP extract")
  1.  DO ADD^A1VSLAPI(.VALMCNT," ")
  1.  SET PKGSUB=0
  1.  FOR  SET PKGSUB=$O(^XTMP("A1SIZE",XPID,PKGSUB))  Q:PKGSUB=""  DO
  1.  . SET (PPFX,BFNM,EFNM,ADDPFX,EXCPFX,FRNG,PARENT)=0
  1.  . SET PPFX=$P(^XTMP("A1SIZE",XPID,PKGSUB),"^")
  1.  . SET BFNM=$P(^XTMP("A1SIZE",XPID,PKGSUB),"^",2)
  1.  . SET EFNM=$P(^XTMP("A1SIZE",XPID,PKGSUB),"^",3)
  1.  . SET FILEMULT=$$FEXT^A1VSLAPI("^XTMP(""A1SIZE"","_XPID_","""_PKGSUB_""")")
  1.  . SET ADDPFX=$P(^XTMP("A1SIZE",XPID,PKGSUB),"^",4)
  1.  . SET EXCPFX=$P(^XTMP("A1SIZE",XPID,PKGSUB),"^",5)
  1.  . SET FILRNG=$P(^XTMP("A1SIZE",XPID,PKGSUB),"^",6)
  1.  . SET PARENT=$P(^XTMP("A1SIZE",XPID,PKGSUB),"^",7)
  1.  . DO ADD^A1VSLAPI(.VALMCNT," ")
  1.  . DO ADD^A1VSLAPI(.VALMCNT,PKGSUB,1,1,$L(PKGSUB))
  1.  . DO ADD^A1VSLAPI(.VALMCNT,"Prefix: "_PPFX)
  1.  . DO ADD^A1VSLAPI(.VALMCNT,"*Low File#: "_BFNM_"     *High File#: "_EFNM)
  1.  . DO SPLITADD^A1VSLAPI(.VALMCNT,"File List: "_FILEMULT)
  1.  . DO SPLITADD^A1VSLAPI(.VALMCNT,"Added Prefixes: "_ADDPFX)
  1.  . DO SPLITADD^A1VSLAPI(.VALMCNT,"Excluded Prefixes: "_EXCPFX)
  1.  . DO SPLITADD^A1VSLAPI(.VALMCNT,"File Ranges: "_FILRNG)
  1.  . DO ADD^A1VSLAPI(.VALMCNT,"Parent Package: "_PARENT)
  1.  QUIT
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  DO KILL
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  1.  Q
  1.  ;
  1. KILL ;Clean up global arrays/variables and local variables
  1.  DO CLEAN^VALM10 ;Kill data and video control arrays
  1.  DO KILL^VALM10() ;Kill Video attributes
  1.  KILL ^TMP("A1VS PKG MGR EXT DISP",$JOB)
  1.  KILL DIR,X,Y,DTOUT,DIRUT,DUOUT
  1.  QUIT
  1.  ;
  1.  ;PROTOCOL entry points
  1. DEL ; -- Delete Extract
  1.  ; -- Protocol: A1VS PKG EXT DISP DEL ACTION
  1.  NEW X,Y,DIR
  1.  SET DIR("A",1)=""
  1.  SET DIR("A")="Do you want to delete ^XTMP(""A1SIZE"","_XPID_")"
  1.  SET DIR("B")="NO"
  1.  SET DIR(0)="Y::"
  1.  DO ^DIR
  1.  IF ('$D(DTOUT)),('$D(DUOUT)),(($G(Y)=1)) DO  QUIT
  1.  . KILL ^XTMP("A1SIZE",XPID),X,Y,DTOUT,DIRUT,DUOUT
  1.  . DO EXIT
  1.  . DO REFRESH^A1VSLN
  1.  . SET VALMBCK="Q"
  1.  IF ($D(DTOUT))!($D(DUOUT))!(($G(Y)=0)) DO
  1.  . DO JUSTPAWS^A1VSLAPI("^XTMP(""A1SIZE"","_XPID_") NOT DELETED!")
  1.  ;
  1.  KILL X,Y,DTOUT,DIRUT,DUOUT
  1.  SET VALMBCK="R"
  1.  QUIT