MAGQE7 ;WOIFO/LB - Imaging Utilities to support Monthly Report ; 18 Jan 2011 5:31 PM
;;3.0;IMAGING;**39**;Mar 19, 2002;Build 2010;Mar 08, 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
ACXREF(IEN,LAST) ;
;This will set the "C" and "AC" cross reference on field #6, "ACCESS DATE/TIME",
;for all the entries in the file. I $D(^MAG(2006.95,"MAGP39")),$P(^MAG(2006.95,"MAGP39"),"^",2)]"" Q
; Don't re-index on further patch 39 rebuilds.
K ^MAG(2006.95,"AC") D INDEX(IEN,LAST)
Q
INDEX(IEN,LAST) ;
N CNT,END,I,IMAGE,J,LAST,NODE,NOTSET,SITE,START,TCNT,USER,PLACE
S START=$$FMTE^XLFDT($$NOW^XLFDT)
D SETXTMP
S:'$D(PLACE) PLACE=$O(^MAG(2006.1,"B",$$KSP^XUPARAM("INST"),"")),U="^"
; PLACE will be used as default
S (CNT,TCNT,NOTSET)=0 ;Counter to count the number of entries set and not set.
;Will only re-index up to the last entry
S LAST=$S('$G(LAST):$O(^MAG(2006.95," "),-1),1:LAST)
S IEN=$S('$G(IEN):0,1:IEN)
S I=IEN
F S I=$O(^MAG(2006.95,I)) Q:'I!(I>LAST) D
. S J=$P($G(^MAG(2006.95,I,0)),U,7) Q:J'?7N1".".N
. S NODE=$G(^MAG(2006.95,I,0)),CNT=CNT+1
. S IMAGE=$P(NODE,"^",4),USER=$P(NODE,"^",3),SITE=""
. ;
. S ^MAG(2006.95,"AC",$E(J,1,30),I)="" ; Regular cross reference on date.
. ;
. I IMAGE D
. . ;Get acquisition site
. . I $D(^MAG(2005,IMAGE,0)),$D(^MAG(2005,IMAGE,100)) S SITE=$P(^(100),"^",3)
. . E I $D(^MAG(2005.1,IMAGE,0)),$D(^MAG(2005.1,IMAGE,100)) S SITE=$P(^(100),"^",3)
. . Q
. I 'SITE D
. . ; no acquisition site - use the user's division.
. . S SITE=$$FINDSITE(USER)
. I 'SITE D BUILD Q:'SITE
. ;This is a new field for p39 - back filing
. S $P(^MAG(2006.95,I,0),"^",11)=SITE
. ;Now MagEnterprise needs the value from PLACE^MAGBAPI.
. S SITE=$S('$D(^MAG(2006.1,"B",SITE)):PLACE,1:$$PLACE^MAGBAPI(SITE))
. S ^MAG(2006.95,"C",SITE,$E(J,1,30),I)="",TCNT=TCNT+1
. S ^XTMP("MAGQE7","LASTXREF")=I_"^"_LAST ; Store the last entry processed.
. Q
S END=$$FMTE^XLFDT($$NOW^XLFDT)
S $P(^MAG(2006.95,"MAGP39"),"^",2)=END ;To prevent re-indexing in future t builds.
;
D DFNIQ^MAGQBPG1("","The starting time for patch 39 post-install XREF process: "_START,0,PLACE,"Consolidate Shares")
D DFNIQ^MAGQBPG1("","# entries processed: "_CNT_" Cross reference set on "_TCNT_" Items unresolved: "_NOTSET,0,PLACE,"Consolidate Shares")
D DFNIQ^MAGQBPG1("","The ending time for patch 39 post-install XREF process: "_END,0,PLACE,"Consolidate Shares")
D DFNIQ^MAGQBPG1("","Installation: Patch 39 - xref post install completed",1,PLACE,"Consolidate Shares")
;
Q
FINDSITE(USER) ;Get the user's site - covered by IA 10060
;File 2006.95 stores the user involved in the event - find out the actual division for this person.
;FSITE - first site found in the DIVISION multiple in file 200.
N I,FSITE,MAGSITE,MAGARR,MSG,SITE
S MAGSITE="" ;FSITE=first entry in the Division field.
Q:'USER
D GETS^DIQ(200,USER_",","16*","I","MAGARR","MSG")
Q:$D(MSG("DIERR"))
S (FSITE,I)="" F S I=$O(MAGARR(200.02,I)) Q:I=""!MAGSITE D
. S SITE=$G(MAGARR(200.02,I,.01,"I")) I 'FSITE S FSITE=SITE
. ;Default division and a match in Imaging
. I $G(MAGARR(200.02,I,1,"I")),$D(^MAG(2006.1,"B",SITE)) S MAGSITE=SITE
. E I $D(^MAG(2006.1,"B",SITE)) S MAGSITE=SITE
. Q
; If not an image site then get the first entry in the Division field or default to site institution.
I 'MAGSITE S MAGSITE=PLACE
Q MAGSITE
;
BUILD ;if sent here there was no acquisition site or user's division is not set
;Purge date should be 30 days
S ^XTMP("MAGQE7","NOTSET",I)=IMAGE_"^"_USER
S NOTSET=NOTSET+1
Q
PRINT ;Utility to print the exceptions in setting the AC cross reference in file 2006.95.
;
N ZTSK
I '$D(^XTMP("MAGQE7","NOTSET")) W !,"Sorry, the XTMP global has been cleared, nothing to display. Quitting" Q
W !,"Exception list for entries in 2006.95 where an AC cross reference could not be set."
N POP,ZTDESC,ZTRTN,ZTSK
S %ZIS="QMP" D ^%ZIS K %ZIS I POP Q
I '$D(IO("Q")) U IO D STARTPRT Q
; task job
S ZTRTN="STARTPRT^MAGQE7",ZTDESC="Exceptions in setting AC cross reference for 2006.95"
D ^%ZTLOAD
W !!,$S($D(ZTSK):">>> Job has been queued. The task number is "_ZTSK_".",1:">>> Unable to queue this job.") K IO("Q")
Q
STARTPRT ;
N ANS,I,IMAGE,NODE,USER,HEADING,HEADING2,HEADING3,PAGE,STOP,ZTREQ
S:'+$G(DTIME) DTIME=600
S ZTREQ="@" ;TaskMan utilities to delete the task.
S PAGE=0,HEADING="Imaging Activity Log (#2006.95) entries without C cross reference."
S HEADING2="Review the Image pointer, the entry should have an Acquisition Site (field #.05)."
S HEADING3="Or possibly the user does not have a DIVISION defined in file #200."
D HDR
S (STOP,I)=0 F S I=$O(^XTMP("MAGQE7","NOTSET",I)) Q:'I S NODE=$G(^XTMP("MAGQE7","NOTSET",I)) D Q:STOP
. S IMAGE=$P(NODE,"^"),USER=$P(NODE,"^",2) D LINE
. Q
D ^%ZISC
Q
HDR ;
W @IOF S PAGE=PAGE+1
W !?2,HEADING," Page: ",PAGE
W !?(IOM-$L(HEADING2)\2),HEADING2 W !?(IOM-$L(HEADING3)\2),HEADING3
W !,?10,"___________________________________",!
Q
LINE ;Display output
N TYPE
D HDR:$Y+4>IOSL S TYPE="" I $D(^MAG(2006.95,I,0)) S TYPE=$P(^MAG(2006.95,I,0),"^",2)
W !,"Entry: ",I,", has image pointer ,",$S('IMAGE:"NULL",1:IMAGE),"; the entry was set by user, ",USER," ",TYPE
I $E(IOST,1,2)="C-",$Y+4>IOSL W !,"Press RETURN to continue or '^' to exit: "
R ANS:DTIME S STOP=$S(ANS="^":1,1:0)
Q
RESTART ;
I '$P($G(^XTMP("MAGQE7","LASTXREF")),"^") W !,"Nothing to process." Q
S IEN=$P(^XMTP("MAGQE7","LASTXREF"),"^"),LAST=$P(^XTMP("MAGQE7","LASTXREF"),"^",2)
I IEN>LAST D Q
. W !,"Last entry processed was IEN: "_IEN_", and indexing did complete."
. Q
D INDEX(IEN,LAST)
Q
SETXTMP ;
;XTMP global structure:
;XTMP("MAGQE7",0)=start date^purge date^AC x-ref for file 2006.95^duz
;zero node to control the purging of this global.
;XTMP("MAGQE7","LASTXREF") =2006.95's IEN last indexed ^ last IEN in the file at time of indexing
;The above global can be used to restart the job incase an error occurs, RESTART^MAGQE7.
;XTMP("MAGQE7","NOTSET",I)=IMAGE_"^"_USER
;The above global is set when an entry can not be indexed. Use PRINT^MAGQE7 to print the entries.
N BEGIN,X,X2 S BEGIN=$$FMTE^XLFDT($$NOW^XLFDT)
S X=$$NOW^XLFDT,X2=$$FMADD^XLFDT(X,30,"","","")
S ^XTMP("MAGQE7",0)=X_"^"_X2_"^"_"AC x-ref for file 2006.95 "_"^"_$G(DUZ) ;Create date^Purge date
;Now time stamp the dd to prevent future t build be executed on test accounts.
S ^MAG(2006.95,"MAGP39")=BEGIN
Q
REINDEX ;
N START,END,DT
S DT=$O(^MAG(2006.95,"AC",""),-1)
I DT'="" S START=$O(^MAG(2006.95,"AC",DT,0))
E S START=1
S END=$P(^MAG(2006.95,0),"^",3)
N MAGDATE,MAGTIME,MAGHR,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK
S ZTRTN="INDEX^MAGQE7("_START_","_END_")",ZTDESC="Re-index file 2006.95",ZTIO=""
S MAGDATE=$$NOW^XLFDT(),MAGTIME=$P(MAGDATE,".",2),MAGHR=$E(MAGTIME,1,2)
I MAGHR>5,MAGHR<17 S MAGTIME=180000
S MAGDATE=$P(MAGDATE,".")_"."_MAGTIME
S ZTDTH=MAGDATE
D ^%ZTLOAD I $D(IO(0)) U IO(0) W !,"Re-indexing scheduled TASK#: "_ZTSK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGQE7 8009 printed Sep 23, 2025@19:44:24 Page 2
MAGQE7 ;WOIFO/LB - Imaging Utilities to support Monthly Report ; 18 Jan 2011 5:31 PM
+1 ;;3.0;IMAGING;**39**;Mar 19, 2002;Build 2010;Mar 08, 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
ACXREF(IEN,LAST) ;
+1 ;This will set the "C" and "AC" cross reference on field #6, "ACCESS DATE/TIME",
+2 ;for all the entries in the file. I $D(^MAG(2006.95,"MAGP39")),$P(^MAG(2006.95,"MAGP39"),"^",2)]"" Q
+3 ; Don't re-index on further patch 39 rebuilds.
+4 KILL ^MAG(2006.95,"AC")
DO INDEX(IEN,LAST)
+5 QUIT
INDEX(IEN,LAST) ;
+1 NEW CNT,END,I,IMAGE,J,LAST,NODE,NOTSET,SITE,START,TCNT,USER,PLACE
+2 SET START=$$FMTE^XLFDT($$NOW^XLFDT)
+3 DO SETXTMP
+4 if '$DATA(PLACE)
SET PLACE=$ORDER(^MAG(2006.1,"B",$$KSP^XUPARAM("INST"),""))
SET U="^"
+5 ; PLACE will be used as default
+6 ;Counter to count the number of entries set and not set.
SET (CNT,TCNT,NOTSET)=0
+7 ;Will only re-index up to the last entry
+8 SET LAST=$SELECT('$GET(LAST):$ORDER(^MAG(2006.95," "),-1),1:LAST)
+9 SET IEN=$SELECT('$GET(IEN):0,1:IEN)
+10 SET I=IEN
+11 FOR
SET I=$ORDER(^MAG(2006.95,I))
if 'I!(I>LAST)
QUIT
Begin DoDot:1
+12 SET J=$PIECE($GET(^MAG(2006.95,I,0)),U,7)
if J'?7N1".".N
QUIT
+13 SET NODE=$GET(^MAG(2006.95,I,0))
SET CNT=CNT+1
+14 SET IMAGE=$PIECE(NODE,"^",4)
SET USER=$PIECE(NODE,"^",3)
SET SITE=""
+15 ;
+16 ; Regular cross reference on date.
SET ^MAG(2006.95,"AC",$EXTRACT(J,1,30),I)=""
+17 ;
+18 IF IMAGE
Begin DoDot:2
+19 ;Get acquisition site
+20 IF $DATA(^MAG(2005,IMAGE,0))
IF $DATA(^MAG(2005,IMAGE,100))
SET SITE=$PIECE(^(100),"^",3)
+21 IF '$TEST
IF $DATA(^MAG(2005.1,IMAGE,0))
IF $DATA(^MAG(2005.1,IMAGE,100))
SET SITE=$PIECE(^(100),"^",3)
+22 QUIT
End DoDot:2
+23 IF 'SITE
Begin DoDot:2
+24 ; no acquisition site - use the user's division.
+25 SET SITE=$$FINDSITE(USER)
End DoDot:2
+26 IF 'SITE
DO BUILD
if 'SITE
QUIT
+27 ;This is a new field for p39 - back filing
+28 SET $PIECE(^MAG(2006.95,I,0),"^",11)=SITE
+29 ;Now MagEnterprise needs the value from PLACE^MAGBAPI.
+30 SET SITE=$SELECT('$DATA(^MAG(2006.1,"B",SITE)):PLACE,1:$$PLACE^MAGBAPI(SITE))
+31 SET ^MAG(2006.95,"C",SITE,$EXTRACT(J,1,30),I)=""
SET TCNT=TCNT+1
+32 ; Store the last entry processed.
SET ^XTMP("MAGQE7","LASTXREF")=I_"^"_LAST
+33 QUIT
End DoDot:1
+34 SET END=$$FMTE^XLFDT($$NOW^XLFDT)
+35 ;To prevent re-indexing in future t builds.
SET $PIECE(^MAG(2006.95,"MAGP39"),"^",2)=END
+36 ;
+37 DO DFNIQ^MAGQBPG1("","The starting time for patch 39 post-install XREF process: "_START,0,PLACE,"Consolidate Shares")
+38 DO DFNIQ^MAGQBPG1("","# entries processed: "_CNT_" Cross reference set on "_TCNT_" Items unresolved: "_NOTSET,0,PLACE,"Consolidate Shares")
+39 DO DFNIQ^MAGQBPG1("","The ending time for patch 39 post-install XREF process: "_END,0,PLACE,"Consolidate Shares")
+40 DO DFNIQ^MAGQBPG1("","Installation: Patch 39 - xref post install completed",1,PLACE,"Consolidate Shares")
+41 ;
+42 QUIT
FINDSITE(USER) ;Get the user's site - covered by IA 10060
+1 ;File 2006.95 stores the user involved in the event - find out the actual division for this person.
+2 ;FSITE - first site found in the DIVISION multiple in file 200.
+3 NEW I,FSITE,MAGSITE,MAGARR,MSG,SITE
+4 ;FSITE=first entry in the Division field.
SET MAGSITE=""
+5 if 'USER
QUIT
+6 DO GETS^DIQ(200,USER_",","16*","I","MAGARR","MSG")
+7 if $DATA(MSG("DIERR"))
QUIT
+8 SET (FSITE,I)=""
FOR
SET I=$ORDER(MAGARR(200.02,I))
if I=""!MAGSITE
QUIT
Begin DoDot:1
+9 SET SITE=$GET(MAGARR(200.02,I,.01,"I"))
IF 'FSITE
SET FSITE=SITE
+10 ;Default division and a match in Imaging
+11 IF $GET(MAGARR(200.02,I,1,"I"))
IF $DATA(^MAG(2006.1,"B",SITE))
SET MAGSITE=SITE
+12 IF '$TEST
IF $DATA(^MAG(2006.1,"B",SITE))
SET MAGSITE=SITE
+13 QUIT
End DoDot:1
+14 ; If not an image site then get the first entry in the Division field or default to site institution.
+15 IF 'MAGSITE
SET MAGSITE=PLACE
+16 QUIT MAGSITE
+17 ;
BUILD ;if sent here there was no acquisition site or user's division is not set
+1 ;Purge date should be 30 days
+2 SET ^XTMP("MAGQE7","NOTSET",I)=IMAGE_"^"_USER
+3 SET NOTSET=NOTSET+1
+4 QUIT
PRINT ;Utility to print the exceptions in setting the AC cross reference in file 2006.95.
+1 ;
+2 NEW ZTSK
+3 IF '$DATA(^XTMP("MAGQE7","NOTSET"))
WRITE !,"Sorry, the XTMP global has been cleared, nothing to display. Quitting"
QUIT
+4 WRITE !,"Exception list for entries in 2006.95 where an AC cross reference could not be set."
+5 NEW POP,ZTDESC,ZTRTN,ZTSK
+6 SET %ZIS="QMP"
DO ^%ZIS
KILL %ZIS
IF POP
QUIT
+7 IF '$DATA(IO("Q"))
USE IO
DO STARTPRT
QUIT
+8 ; task job
+9 SET ZTRTN="STARTPRT^MAGQE7"
SET ZTDESC="Exceptions in setting AC cross reference for 2006.95"
+10 DO ^%ZTLOAD
+11 WRITE !!,$SELECT($DATA(ZTSK):">>> Job has been queued. The task number is "_ZTSK_".",1:">>> Unable to queue this job.")
KILL IO("Q")
+12 QUIT
STARTPRT ;
+1 NEW ANS,I,IMAGE,NODE,USER,HEADING,HEADING2,HEADING3,PAGE,STOP,ZTREQ
+2 if '+$GET(DTIME)
SET DTIME=600
+3 ;TaskMan utilities to delete the task.
SET ZTREQ="@"
+4 SET PAGE=0
SET HEADING="Imaging Activity Log (#2006.95) entries without C cross reference."
+5 SET HEADING2="Review the Image pointer, the entry should have an Acquisition Site (field #.05)."
+6 SET HEADING3="Or possibly the user does not have a DIVISION defined in file #200."
+7 DO HDR
+8 SET (STOP,I)=0
FOR
SET I=$ORDER(^XTMP("MAGQE7","NOTSET",I))
if 'I
QUIT
SET NODE=$GET(^XTMP("MAGQE7","NOTSET",I))
Begin DoDot:1
+9 SET IMAGE=$PIECE(NODE,"^")
SET USER=$PIECE(NODE,"^",2)
DO LINE
+10 QUIT
End DoDot:1
if STOP
QUIT
+11 DO ^%ZISC
+12 QUIT
HDR ;
+1 WRITE @IOF
SET PAGE=PAGE+1
+2 WRITE !?2,HEADING," Page: ",PAGE
+3 WRITE !?(IOM-$LENGTH(HEADING2)\2),HEADING2
WRITE !?(IOM-$LENGTH(HEADING3)\2),HEADING3
+4 WRITE !,?10,"___________________________________",!
+5 QUIT
LINE ;Display output
+1 NEW TYPE
+2 if $Y+4>IOSL
DO HDR
SET TYPE=""
IF $DATA(^MAG(2006.95,I,0))
SET TYPE=$PIECE(^MAG(2006.95,I,0),"^",2)
+3 WRITE !,"Entry: ",I,", has image pointer ,",$SELECT('IMAGE:"NULL",1:IMAGE),"; the entry was set by user, ",USER," ",TYPE
+4 IF $EXTRACT(IOST,1,2)="C-"
IF $Y+4>IOSL
WRITE !,"Press RETURN to continue or '^' to exit: "
+5 READ ANS:DTIME
SET STOP=$SELECT(ANS="^":1,1:0)
+6 QUIT
RESTART ;
+1 IF '$PIECE($GET(^XTMP("MAGQE7","LASTXREF")),"^")
WRITE !,"Nothing to process."
QUIT
+2 SET IEN=$PIECE(^XMTP("MAGQE7","LASTXREF"),"^")
SET LAST=$PIECE(^XTMP("MAGQE7","LASTXREF"),"^",2)
+3 IF IEN>LAST
Begin DoDot:1
+4 WRITE !,"Last entry processed was IEN: "_IEN_", and indexing did complete."
+5 QUIT
End DoDot:1
QUIT
+6 DO INDEX(IEN,LAST)
+7 QUIT
SETXTMP ;
+1 ;XTMP global structure:
+2 ;XTMP("MAGQE7",0)=start date^purge date^AC x-ref for file 2006.95^duz
+3 ;zero node to control the purging of this global.
+4 ;XTMP("MAGQE7","LASTXREF") =2006.95's IEN last indexed ^ last IEN in the file at time of indexing
+5 ;The above global can be used to restart the job incase an error occurs, RESTART^MAGQE7.
+6 ;XTMP("MAGQE7","NOTSET",I)=IMAGE_"^"_USER
+7 ;The above global is set when an entry can not be indexed. Use PRINT^MAGQE7 to print the entries.
+8 NEW BEGIN,X,X2
SET BEGIN=$$FMTE^XLFDT($$NOW^XLFDT)
+9 SET X=$$NOW^XLFDT
SET X2=$$FMADD^XLFDT(X,30,"","","")
+10 ;Create date^Purge date
SET ^XTMP("MAGQE7",0)=X_"^"_X2_"^"_"AC x-ref for file 2006.95 "_"^"_$GET(DUZ)
+11 ;Now time stamp the dd to prevent future t build be executed on test accounts.
+12 SET ^MAG(2006.95,"MAGP39")=BEGIN
+13 QUIT
REINDEX ;
+1 NEW START,END,DT
+2 SET DT=$ORDER(^MAG(2006.95,"AC",""),-1)
+3 IF DT'=""
SET START=$ORDER(^MAG(2006.95,"AC",DT,0))
+4 IF '$TEST
SET START=1
+5 SET END=$PIECE(^MAG(2006.95,0),"^",3)
+6 NEW MAGDATE,MAGTIME,MAGHR,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK
+7 SET ZTRTN="INDEX^MAGQE7("_START_","_END_")"
SET ZTDESC="Re-index file 2006.95"
SET ZTIO=""
+8 SET MAGDATE=$$NOW^XLFDT()
SET MAGTIME=$PIECE(MAGDATE,".",2)
SET MAGHR=$EXTRACT(MAGTIME,1,2)
+9 IF MAGHR>5
IF MAGHR<17
SET MAGTIME=180000
+10 SET MAGDATE=$PIECE(MAGDATE,".")_"."_MAGTIME
+11 SET ZTDTH=MAGDATE
+12 DO ^%ZTLOAD
IF $DATA(IO(0))
USE IO(0)
WRITE !,"Re-indexing scheduled TASK#: "_ZTSK
+13 QUIT
