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

MAGQE7.m

Go to the documentation of this file. 
  1. 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
  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. ACXREF(IEN,LAST) ;
  1.  ;This will set the "C" and "AC" cross reference on field #6, "ACCESS DATE/TIME",
  1.  ;for all the entries in the file. I $D(^MAG(2006.95,"MAGP39")),$P(^MAG(2006.95,"MAGP39"),"^",2)]"" Q
  1.  ; Don't re-index on further patch 39 rebuilds.
  1.  K ^MAG(2006.95,"AC") D INDEX(IEN,LAST)
  1.  Q
  1. INDEX(IEN,LAST) ;
  1.  N CNT,END,I,IMAGE,J,LAST,NODE,NOTSET,SITE,START,TCNT,USER,PLACE
  1.  S START=$$FMTE^XLFDT($$NOW^XLFDT)
  1.  D SETXTMP
  1.  S:'$D(PLACE) PLACE=$O(^MAG(2006.1,"B",$$KSP^XUPARAM("INST"),"")),U="^"
  1.  ; PLACE will be used as default
  1.  S (CNT,TCNT,NOTSET)=0  ;Counter to count the number of entries set and not set.
  1.  ;Will only re-index up to the last entry
  1.  S LAST=$S('$G(LAST):$O(^MAG(2006.95," "),-1),1:LAST)
  1.  S IEN=$S('$G(IEN):0,1:IEN)
  1.  S I=IEN
  1.  F  S I=$O(^MAG(2006.95,I)) Q:'I!(I>LAST)  D
  1.  . S J=$P($G(^MAG(2006.95,I,0)),U,7) Q:J'?7N1".".N
  1.  . S NODE=$G(^MAG(2006.95,I,0)),CNT=CNT+1
  1.  . S IMAGE=$P(NODE,"^",4),USER=$P(NODE,"^",3),SITE=""
  1.  . ;
  1.  . S ^MAG(2006.95,"AC",$E(J,1,30),I)=""  ; Regular cross reference on date.
  1.  . ;
  1.  . I IMAGE D
  1.  . . ;Get acquisition site
  1.  . . I $D(^MAG(2005,IMAGE,0)),$D(^MAG(2005,IMAGE,100)) S SITE=$P(^(100),"^",3)
  1.  . . E  I $D(^MAG(2005.1,IMAGE,0)),$D(^MAG(2005.1,IMAGE,100)) S SITE=$P(^(100),"^",3)
  1.  . . Q 
  1.  . I 'SITE D
  1.  . . ; no acquisition site - use the user's division.
  1.  . . S SITE=$$FINDSITE(USER)
  1.  . I 'SITE D BUILD Q:'SITE
  1.  . ;This is a new field for p39 - back filing
  1.  . S $P(^MAG(2006.95,I,0),"^",11)=SITE
  1.  . ;Now MagEnterprise needs the value from PLACE^MAGBAPI. 
  1.  . S SITE=$S('$D(^MAG(2006.1,"B",SITE)):PLACE,1:$$PLACE^MAGBAPI(SITE))
  1.  . S ^MAG(2006.95,"C",SITE,$E(J,1,30),I)="",TCNT=TCNT+1
  1.  . S ^XTMP("MAGQE7","LASTXREF")=I_"^"_LAST  ; Store the last entry processed.
  1.  . Q 
  1.  S END=$$FMTE^XLFDT($$NOW^XLFDT)
  1.  S $P(^MAG(2006.95,"MAGP39"),"^",2)=END ;To prevent re-indexing in future t builds.
  1.  ;
  1.  D DFNIQ^MAGQBPG1("","The starting time for patch 39 post-install XREF process: "_START,0,PLACE,"Consolidate Shares")
  1.  D DFNIQ^MAGQBPG1("","# entries processed: "_CNT_" Cross reference set on "_TCNT_" Items unresolved: "_NOTSET,0,PLACE,"Consolidate Shares")
  1.  D DFNIQ^MAGQBPG1("","The ending time for patch 39 post-install XREF process: "_END,0,PLACE,"Consolidate Shares")
  1.  D DFNIQ^MAGQBPG1("","Installation: Patch 39 - xref post install completed",1,PLACE,"Consolidate Shares")
  1.  ;
  1.  Q
  1. 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.
  1.  ;FSITE - first site found in the DIVISION multiple in file 200.
  1.  N I,FSITE,MAGSITE,MAGARR,MSG,SITE
  1.  S MAGSITE=""    ;FSITE=first entry in the Division field.
  1.  Q:'USER
  1.  D GETS^DIQ(200,USER_",","16*","I","MAGARR","MSG")
  1.  Q:$D(MSG("DIERR"))
  1.  S (FSITE,I)="" F  S I=$O(MAGARR(200.02,I)) Q:I=""!MAGSITE  D
  1.  . S SITE=$G(MAGARR(200.02,I,.01,"I")) I 'FSITE S FSITE=SITE
  1.  . ;Default division and a match in Imaging
  1.  . I $G(MAGARR(200.02,I,1,"I")),$D(^MAG(2006.1,"B",SITE)) S MAGSITE=SITE
  1.  . E  I $D(^MAG(2006.1,"B",SITE)) S MAGSITE=SITE
  1.  . Q
  1.  ; If not an image site then get the first entry in the Division field or default to site institution.
  1.  I 'MAGSITE S MAGSITE=PLACE
  1.  Q MAGSITE
  1.  ;
  1. BUILD ;if sent here there was no acquisition site or user's division is not set
  1.  ;Purge date should be 30 days
  1.  S ^XTMP("MAGQE7","NOTSET",I)=IMAGE_"^"_USER
  1.  S NOTSET=NOTSET+1
  1.  Q
  1. PRINT ;Utility to print the exceptions in setting the AC cross reference in file 2006.95.
  1.  ;
  1.  N ZTSK
  1.  I '$D(^XTMP("MAGQE7","NOTSET")) W !,"Sorry, the XTMP global has been cleared, nothing to display. Quitting" Q
  1.  W !,"Exception list for entries in 2006.95 where an AC cross reference could not be set."
  1.  N POP,ZTDESC,ZTRTN,ZTSK
  1.  S %ZIS="QMP" D ^%ZIS K %ZIS I POP Q
  1.  I '$D(IO("Q")) U IO D STARTPRT Q
  1.  ; task job
  1.  S ZTRTN="STARTPRT^MAGQE7",ZTDESC="Exceptions in setting AC cross reference for 2006.95"
  1.  D ^%ZTLOAD
  1.  W !!,$S($D(ZTSK):">>> Job has been queued. The task number is "_ZTSK_".",1:">>> Unable to queue this job.") K IO("Q")
  1.  Q
  1. STARTPRT ;
  1.  N ANS,I,IMAGE,NODE,USER,HEADING,HEADING2,HEADING3,PAGE,STOP,ZTREQ
  1.  S:'+$G(DTIME) DTIME=600
  1.  S ZTREQ="@"  ;TaskMan utilities to delete the task.
  1.  S PAGE=0,HEADING="Imaging Activity Log (#2006.95) entries without C cross reference."
  1.  S HEADING2="Review the Image pointer, the entry should have an Acquisition Site (field #.05)."
  1.  S HEADING3="Or possibly the user does not have a DIVISION defined in file #200."
  1.  D HDR
  1.  S (STOP,I)=0 F  S I=$O(^XTMP("MAGQE7","NOTSET",I)) Q:'I  S NODE=$G(^XTMP("MAGQE7","NOTSET",I)) D  Q:STOP
  1.  . S IMAGE=$P(NODE,"^"),USER=$P(NODE,"^",2) D LINE
  1.  . Q
  1.  D ^%ZISC
  1.  Q
  1. HDR ;
  1.  W @IOF S PAGE=PAGE+1
  1.  W !?2,HEADING,"  Page: ",PAGE
  1.  W !?(IOM-$L(HEADING2)\2),HEADING2 W !?(IOM-$L(HEADING3)\2),HEADING3
  1.  W !,?10,"___________________________________",!
  1.  Q
  1. LINE ;Display output
  1.  N TYPE
  1.  D HDR:$Y+4>IOSL S TYPE="" I $D(^MAG(2006.95,I,0)) S TYPE=$P(^MAG(2006.95,I,0),"^",2)
  1.  W !,"Entry: ",I,", has image pointer ,",$S('IMAGE:"NULL",1:IMAGE),"; the entry was set by user, ",USER," ",TYPE
  1.  I $E(IOST,1,2)="C-",$Y+4>IOSL W !,"Press RETURN to continue or '^' to exit: "
  1.  R ANS:DTIME S STOP=$S(ANS="^":1,1:0)
  1.  Q
  1. RESTART ;
  1.  I '$P($G(^XTMP("MAGQE7","LASTXREF")),"^") W !,"Nothing to process." Q
  1.  S IEN=$P(^XMTP("MAGQE7","LASTXREF"),"^"),LAST=$P(^XTMP("MAGQE7","LASTXREF"),"^",2)
  1.  I IEN>LAST D  Q
  1.  . W !,"Last entry processed was IEN: "_IEN_", and indexing did complete."
  1.  . Q
  1.  D INDEX(IEN,LAST)
  1.  Q
  1. SETXTMP ;
  1.  ;XTMP global structure:
  1.  ;XTMP("MAGQE7",0)=start date^purge date^AC x-ref for file 2006.95^duz 
  1.  ;zero node to control the purging of this global.
  1.  ;XTMP("MAGQE7","LASTXREF") =2006.95's IEN last indexed ^ last IEN in the file at time of indexing
  1.  ;The above global can be used to restart the job incase an error occurs, RESTART^MAGQE7.
  1.  ;XTMP("MAGQE7","NOTSET",I)=IMAGE_"^"_USER
  1.  ;The above global is set when an entry can not be indexed.  Use PRINT^MAGQE7 to print the entries.
  1.  N BEGIN,X,X2 S BEGIN=$$FMTE^XLFDT($$NOW^XLFDT)
  1.  S X=$$NOW^XLFDT,X2=$$FMADD^XLFDT(X,30,"","","")
  1.  S ^XTMP("MAGQE7",0)=X_"^"_X2_"^"_"AC x-ref for file 2006.95 "_"^"_$G(DUZ)   ;Create date^Purge date
  1.  ;Now time stamp the dd to prevent future t build be executed on test accounts.
  1.  S ^MAG(2006.95,"MAGP39")=BEGIN
  1.  Q
  1. REINDEX ;
  1.  N START,END,DT
  1.  S DT=$O(^MAG(2006.95,"AC",""),-1)
  1.  I DT'="" S START=$O(^MAG(2006.95,"AC",DT,0))
  1.  E  S START=1
  1.  S END=$P(^MAG(2006.95,0),"^",3)
  1.  N MAGDATE,MAGTIME,MAGHR,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK
  1.  S ZTRTN="INDEX^MAGQE7("_START_","_END_")",ZTDESC="Re-index file 2006.95",ZTIO=""
  1.  S MAGDATE=$$NOW^XLFDT(),MAGTIME=$P(MAGDATE,".",2),MAGHR=$E(MAGTIME,1,2)
  1.  I MAGHR>5,MAGHR<17 S MAGTIME=180000
  1.  S MAGDATE=$P(MAGDATE,".")_"."_MAGTIME
  1.  S ZTDTH=MAGDATE
  1.  D ^%ZTLOAD I $D(IO(0)) U IO(0) W !,"Re-indexing scheduled TASK#: "_ZTSK
  1.  Q