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

MAGUXDPS.m

Go to the documentation of this file. 
  1. MAGUXDPS ;WOIFO/MLH - Imaging utility - rebuild ADTDUZ indices ; 6 Jun 2011 5:10 PM
  1.  ;;3.0;IMAGING;**117**;Mar 19, 2002;Build 2238;Jul 15, 2011
  1.  ;; Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;; +---------------------------------------------------------------+
  1.  ;; | Property of the US Government.                                |
  1.  ;; | No permission to copy or redistribute this software is given. |
  1.  ;; | Use of unreleased versions of this software requires the user |
  1.  ;; | to execute a written test agreement with the VistA Imaging    |
  1.  ;; | Development Office of the Department of Veterans Affairs,     |
  1.  ;; | telephone (301) 734-0100.                                     |
  1.  ;; | The Food and Drug Administration classifies this software as  |
  1.  ;; | a medical device.  As such, it may not be changed in any way. |
  1.  ;; | Modifications to this software may result in an adulterated   |
  1.  ;; | medical device under 21CFR820, the use of which is considered |
  1.  ;; | to be a violation of US Federal Statutes.                     |
  1.  ;; +---------------------------------------------------------------+
  1.  ;;
  1.  Q
  1.  ;
  1. SETUP ; Foreground setup
  1.  W !,"Imaging DATE-USER-SITE index rebuild",!!
  1.  W "This option builds the ADTDUZ cross reference on Files 2005 and 2005.1",!
  1.  W "to optimize the gathering of user capture statistics.",!
  1.  L +^MAG("ADT INDEX REBUILD"):0
  1.  E  W !,"This option is in use by another process. Try again later.",! Q
  1.  N HIT,IEN,PARENT,SAVINFO,SAVDAT,SITE,CAPAPP
  1.  N DIR,ZTRTN,ZTDESC,ZTDTH,ZTSAVE,ZTIO,ZTSK,Y,DIRUT
  1.  ; Find whether this has been run to completion previously
  1.  S HIT=0,IEN=0
  1.  F  S IEN=$O(^MAG(2005.1,IEN)) Q:'IEN  D  Q:HIT
  1.  . ; don't count children, just standalones and group parents
  1.  . S PARENT=$P($G(^MAG(2005.1,IEN,0)),"^",10)
  1.  . S SAVINFO=$G(^MAG(2005.1,IEN,2))
  1.  . S SAVDAT=$P(SAVINFO,"^",1)\1,SAVUSER=$P(SAVINFO,"^",2),CAPAPP=$P(SAVINFO,"^",12)
  1.  . S SITE=$P($G(^MAG(2005.1,IEN,100)),"^",3)
  1.  . I PARENT="",SAVDAT'="",SAVUSER'="",CAPAPP'="",SITE'="" D
  1.  . . S HIT=$S($D(^MAG(2005.1,"ADTDUZ",CAPAPP,SAVDAT,SAVUSER,SITE,IEN)):1,1:-1)
  1.  . . Q
  1.  . Q
  1.  I 'HIT D  G SETUPX
  1.  . W !,"No entries qualify for indexing.",!
  1.  . Q
  1.  D:HIT=-1
  1.  . W !,"This option has not yet been run to completion."
  1.  . Q
  1.  D:HIT=1
  1.  . W !,"This option has previously been run to completion.",!
  1.  . W "Enter F or B to re-run, or up-arrow (^) to exit.",!
  1.  . Q
  1.  S DIR(0)="S^F:Execute in the foreground;B:Execute in the background"
  1.  S DIR("A")="Enter F or B"
  1.  D ^DIR G:$D(DIRUT) SETUPX
  1.  I Y="F" D REBUILD G SETUPX
  1.  I Y="B" D  G SETUPX
  1.  . S ZTRTN="REBUILD^MAGUXDPS"
  1.  . S ZTDESC="Rebuild DATE-USER-SITE indices"
  1.  . S ZTDTH=$H
  1.  . S ZTSAVE("SILENT")=1 ; no I/O for background process
  1.  . S ZTIO="" ; no interactive I/O device
  1.  . D ^%ZTLOAD,HOME^%ZIS
  1.  . W:'$G(ZTSK) !,"TaskMan did not accept request",!
  1.  . W:$G(ZTSK) !,"Queued as task number ",ZTSK,!
  1.  . Q
  1. SETUPX ;
  1.  L -^MAG("ADT INDEX REBUILD")
  1.  Q
  1. REBUILD ; Foreground / background rebuild
  1.  N FILENO,FILE,INTERVAL,I,IEN,PARENT,SAVINFO,SAVDAT,SAVUSER,CAPAPP,SITE
  1.  L +^MAG("ADT INDEX REBUILD"):1E9 ; wait for foreground user exit
  1.  F FILENO=2005,2005.1 D
  1.  . S FILE=$NA(^MAG(FILENO))
  1.  . K @FILE@("ADTDUZ")
  1.  . S INTERVAL=$O(@FILE@(" "),-1)\500 ; interval for meter if foreground
  1.  . ; work backwards so we can tell whether we're done by testing the
  1.  . ;  existence of a cross reference for the 1st record on file
  1.  . S IEN=" "
  1.  . F I=1:1 S IEN=$O(@FILE@(IEN),-1) Q:'IEN  D
  1.  . . ; don't count children, just standalones and group parents
  1.  . . S PARENT=$P($G(@FILE@(IEN,0)),"^",10)
  1.  . . S SAVINFO=$G(@FILE@(IEN,2))
  1.  . . S SAVDAT=$P(SAVINFO,"^",1)\1,SAVUSER=$P(SAVINFO,"^",2),CAPAPP=$P(SAVINFO,"^",12)
  1.  . . S SITE=$P($G(@FILE@(IEN,100)),"^",3)
  1.  . . I PARENT="",SAVDAT'="",SAVUSER'="",CAPAPP'="",SITE'="" D
  1.  . . . S @FILE@("ADTDUZ",CAPAPP,SAVDAT,SAVUSER,SITE,IEN)=""
  1.  . . . I '$D(SILENT),I#INTERVAL=0 W "."
  1.  . . . Q
  1.  . . Q
  1.  . Q
  1.  K SILENT
  1.  L -^MAG("ADT INDEX REBUILD")
  1.  Q