MAGUXDPS ;WOIFO/MLH - Imaging utility - rebuild ADTDUZ indices ; 6 Jun 2011 5:10 PM
;;3.0;IMAGING;**117**;Mar 19, 2002;Build 2238;Jul 15, 2011
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
Q
;
SETUP ; Foreground setup
W !,"Imaging DATE-USER-SITE index rebuild",!!
W "This option builds the ADTDUZ cross reference on Files 2005 and 2005.1",!
W "to optimize the gathering of user capture statistics.",!
L +^MAG("ADT INDEX REBUILD"):0
E W !,"This option is in use by another process. Try again later.",! Q
N HIT,IEN,PARENT,SAVINFO,SAVDAT,SITE,CAPAPP
N DIR,ZTRTN,ZTDESC,ZTDTH,ZTSAVE,ZTIO,ZTSK,Y,DIRUT
; Find whether this has been run to completion previously
S HIT=0,IEN=0
F S IEN=$O(^MAG(2005.1,IEN)) Q:'IEN D Q:HIT
. ; don't count children, just standalones and group parents
. S PARENT=$P($G(^MAG(2005.1,IEN,0)),"^",10)
. S SAVINFO=$G(^MAG(2005.1,IEN,2))
. S SAVDAT=$P(SAVINFO,"^",1)\1,SAVUSER=$P(SAVINFO,"^",2),CAPAPP=$P(SAVINFO,"^",12)
. S SITE=$P($G(^MAG(2005.1,IEN,100)),"^",3)
. I PARENT="",SAVDAT'="",SAVUSER'="",CAPAPP'="",SITE'="" D
. . S HIT=$S($D(^MAG(2005.1,"ADTDUZ",CAPAPP,SAVDAT,SAVUSER,SITE,IEN)):1,1:-1)
. . Q
. Q
I 'HIT D G SETUPX
. W !,"No entries qualify for indexing.",!
. Q
D:HIT=-1
. W !,"This option has not yet been run to completion."
. Q
D:HIT=1
. W !,"This option has previously been run to completion.",!
. W "Enter F or B to re-run, or up-arrow (^) to exit.",!
. Q
S DIR(0)="S^F:Execute in the foreground;B:Execute in the background"
S DIR("A")="Enter F or B"
D ^DIR G:$D(DIRUT) SETUPX
I Y="F" D REBUILD G SETUPX
I Y="B" D G SETUPX
. S ZTRTN="REBUILD^MAGUXDPS"
. S ZTDESC="Rebuild DATE-USER-SITE indices"
. S ZTDTH=$H
. S ZTSAVE("SILENT")=1 ; no I/O for background process
. S ZTIO="" ; no interactive I/O device
. D ^%ZTLOAD,HOME^%ZIS
. W:'$G(ZTSK) !,"TaskMan did not accept request",!
. W:$G(ZTSK) !,"Queued as task number ",ZTSK,!
. Q
SETUPX ;
L -^MAG("ADT INDEX REBUILD")
Q
REBUILD ; Foreground / background rebuild
N FILENO,FILE,INTERVAL,I,IEN,PARENT,SAVINFO,SAVDAT,SAVUSER,CAPAPP,SITE
L +^MAG("ADT INDEX REBUILD"):1E9 ; wait for foreground user exit
F FILENO=2005,2005.1 D
. S FILE=$NA(^MAG(FILENO))
. K @FILE@("ADTDUZ")
. S INTERVAL=$O(@FILE@(" "),-1)\500 ; interval for meter if foreground
. ; work backwards so we can tell whether we're done by testing the
. ; existence of a cross reference for the 1st record on file
. S IEN=" "
. F I=1:1 S IEN=$O(@FILE@(IEN),-1) Q:'IEN D
. . ; don't count children, just standalones and group parents
. . S PARENT=$P($G(@FILE@(IEN,0)),"^",10)
. . S SAVINFO=$G(@FILE@(IEN,2))
. . S SAVDAT=$P(SAVINFO,"^",1)\1,SAVUSER=$P(SAVINFO,"^",2),CAPAPP=$P(SAVINFO,"^",12)
. . S SITE=$P($G(@FILE@(IEN,100)),"^",3)
. . I PARENT="",SAVDAT'="",SAVUSER'="",CAPAPP'="",SITE'="" D
. . . S @FILE@("ADTDUZ",CAPAPP,SAVDAT,SAVUSER,SITE,IEN)=""
. . . I '$D(SILENT),I#INTERVAL=0 W "."
. . . Q
. . Q
. Q
K SILENT
L -^MAG("ADT INDEX REBUILD")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGUXDPS 3999 printed Sep 23, 2025@19:45:29 Page 2
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
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+3 ;; +---------------------------------------------------------------+
+4 ;; | Property of the US Government. |
+5 ;; | No permission to copy or redistribute this software is given. |
+6 ;; | Use of unreleased versions of this software requires the user |
+7 ;; | to execute a written test agreement with the VistA Imaging |
+8 ;; | Development Office of the Department of Veterans Affairs, |
+9 ;; | telephone (301) 734-0100. |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 QUIT
+18 ;
SETUP ; Foreground setup
+1 WRITE !,"Imaging DATE-USER-SITE index rebuild",!!
+2 WRITE "This option builds the ADTDUZ cross reference on Files 2005 and 2005.1",!
+3 WRITE "to optimize the gathering of user capture statistics.",!
+4 LOCK +^MAG("ADT INDEX REBUILD"):0
+5 IF '$TEST
WRITE !,"This option is in use by another process. Try again later.",!
QUIT
+6 NEW HIT,IEN,PARENT,SAVINFO,SAVDAT,SITE,CAPAPP
+7 NEW DIR,ZTRTN,ZTDESC,ZTDTH,ZTSAVE,ZTIO,ZTSK,Y,DIRUT
+8 ; Find whether this has been run to completion previously
+9 SET HIT=0
SET IEN=0
+10 FOR
SET IEN=$ORDER(^MAG(2005.1,IEN))
if 'IEN
QUIT
Begin DoDot:1
+11 ; don't count children, just standalones and group parents
+12 SET PARENT=$PIECE($GET(^MAG(2005.1,IEN,0)),"^",10)
+13 SET SAVINFO=$GET(^MAG(2005.1,IEN,2))
+14 SET SAVDAT=$PIECE(SAVINFO,"^",1)\1
SET SAVUSER=$PIECE(SAVINFO,"^",2)
SET CAPAPP=$PIECE(SAVINFO,"^",12)
+15 SET SITE=$PIECE($GET(^MAG(2005.1,IEN,100)),"^",3)
+16 IF PARENT=""
IF SAVDAT'=""
IF SAVUSER'=""
IF CAPAPP'=""
IF SITE'=""
Begin DoDot:2
+17 SET HIT=$SELECT($DATA(^MAG(2005.1,"ADTDUZ",CAPAPP,SAVDAT,SAVUSER,SITE,IEN)):1,1:-1)
+18 QUIT
End DoDot:2
+19 QUIT
End DoDot:1
if HIT
QUIT
+20 IF 'HIT
Begin DoDot:1
+21 WRITE !,"No entries qualify for indexing.",!
+22 QUIT
End DoDot:1
GOTO SETUPX
+23 if HIT=-1
Begin DoDot:1
+24 WRITE !,"This option has not yet been run to completion."
+25 QUIT
End DoDot:1
+26 if HIT=1
Begin DoDot:1
+27 WRITE !,"This option has previously been run to completion.",!
+28 WRITE "Enter F or B to re-run, or up-arrow (^) to exit.",!
+29 QUIT
End DoDot:1
+30 SET DIR(0)="S^F:Execute in the foreground;B:Execute in the background"
+31 SET DIR("A")="Enter F or B"
+32 DO ^DIR
if $DATA(DIRUT)
GOTO SETUPX
+33 IF Y="F"
DO REBUILD
GOTO SETUPX
+34 IF Y="B"
Begin DoDot:1
+35 SET ZTRTN="REBUILD^MAGUXDPS"
+36 SET ZTDESC="Rebuild DATE-USER-SITE indices"
+37 SET ZTDTH=$HOROLOG
+38 ; no I/O for background process
SET ZTSAVE("SILENT")=1
+39 ; no interactive I/O device
SET ZTIO=""
+40 DO ^%ZTLOAD
DO HOME^%ZIS
+41 if '$GET(ZTSK)
WRITE !,"TaskMan did not accept request",!
+42 if $GET(ZTSK)
WRITE !,"Queued as task number ",ZTSK,!
+43 QUIT
End DoDot:1
GOTO SETUPX
SETUPX ;
+1 LOCK -^MAG("ADT INDEX REBUILD")
+2 QUIT
REBUILD ; Foreground / background rebuild
+1 NEW FILENO,FILE,INTERVAL,I,IEN,PARENT,SAVINFO,SAVDAT,SAVUSER,CAPAPP,SITE
+2 ; wait for foreground user exit
LOCK +^MAG("ADT INDEX REBUILD"):1E9
+3 FOR FILENO=2005,2005.1
Begin DoDot:1
+4 SET FILE=$NAME(^MAG(FILENO))
+5 KILL @FILE@("ADTDUZ")
+6 ; interval for meter if foreground
SET INTERVAL=$ORDER(@FILE@(" "),-1)\500
+7 ; work backwards so we can tell whether we're done by testing the
+8 ; existence of a cross reference for the 1st record on file
+9 SET IEN=" "
+10 FOR I=1:1
SET IEN=$ORDER(@FILE@(IEN),-1)
if 'IEN
QUIT
Begin DoDot:2
+11 ; don't count children, just standalones and group parents
+12 SET PARENT=$PIECE($GET(@FILE@(IEN,0)),"^",10)
+13 SET SAVINFO=$GET(@FILE@(IEN,2))
+14 SET SAVDAT=$PIECE(SAVINFO,"^",1)\1
SET SAVUSER=$PIECE(SAVINFO,"^",2)
SET CAPAPP=$PIECE(SAVINFO,"^",12)
+15 SET SITE=$PIECE($GET(@FILE@(IEN,100)),"^",3)
+16 IF PARENT=""
IF SAVDAT'=""
IF SAVUSER'=""
IF CAPAPP'=""
IF SITE'=""
Begin DoDot:3
+17 SET @FILE@("ADTDUZ",CAPAPP,SAVDAT,SAVUSER,SITE,IEN)=""
+18 IF '$DATA(SILENT)
IF I#INTERVAL=0
WRITE "."
+19 QUIT
End DoDot:3
+20 QUIT
End DoDot:2
+21 QUIT
End DoDot:1
+22 KILL SILENT
+23 LOCK -^MAG("ADT INDEX REBUILD")
+24 QUIT
