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

MAGIPS93.m

Go to the documentation of this file. 
  1. MAGIPS93 ;WOIFO/SG - INSTALL CODE FOR MAG*3*93 ; 5/13/09 10:01am
  1.  ;;3.0;IMAGING;**93**;Dec 02, 2009;Build 163
  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.  ;; |                                                               |
  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.  ; There are no environment checks here but the MAGIPS93 has to be
  1.  ; referenced by the "Environment Check Routine" field of the KIDS
  1.  ; build so that entry points of the routine are available to the
  1.  ; KIDS during all installation phases.
  1.  Q
  1.  ;
  1.  ;+++++ INSTALLATION ERROR HANDLING
  1. ERROR ;
  1.  S:$D(XPDNM) XPDABORT=1
  1.  ;--- Display the messages and store them to the INSTALL file
  1.  D DUMP^MAGUERR1(),ABTMSG^MAGKIDS()
  1.  Q
  1.  ;
  1.  ;+++++ UPDATES/FIXES THE DELETED IMAGE ENTRY
  1.  ;
  1.  ; MAGIEN        IEN of an entry of the IMAGE AUDIT file (#2005.1)
  1.  ;
  1.  ; Input Variables
  1.  ; ===============
  1.  ;   MAGSTAT
  1.  ;
  1.  ; Return Values
  1.  ; =============
  1.  ;           <0  Error descriptor (see the $$ERROR^MAGUERR)
  1.  ;            0  Ok
  1.  ;
  1. MAGAUDIT(MAGIEN) ;
  1.  N MAGNODE,MAGRC,STC,SUB,TMP
  1.  S MAGNODE=$NA(^MAG(2005.1,MAGIEN))
  1.  Q:$D(@MAGNODE)<10 $$ERROR^MAGUERR(-22,,2005.1,MAGIEN_",")
  1.  S STC=$P($G(@MAGNODE@(100)),U,8)  Q:STC=12 0  ; STATUS (113)
  1.  S MAGRC=0
  1.  ;
  1.  ;=== Fix the subfile headers
  1.  F SUB="1^2005.14P","4^2005.1106DA","5^2005.11PA","6^2005.1111A","99^2005.199D"  D
  1.  . S TMP=$P(SUB,U)  Q:'($D(^MAG(2005.1,MAGIEN,TMP,0))#2)
  1.  . S $P(^MAG(2005.1,MAGIEN,TMP,0),U,2)=$P(SUB,U,2)
  1.  . Q
  1.  ;
  1.  ;=== Update STATUS field and create the corresponding audit record
  1.  S TMP=+$P($G(@MAGNODE@(30)),U,2)   ; DELETED DATE (30.1)
  1.  I TMP>0  D  Q:MAGRC<0 MAGRC
  1.  . N IENS,MAGFDA,MAGMSG
  1.  . S IENS="+1,"_MAGIEN_","
  1.  . S MAGFDA(2005.199,IENS,.01)=TMP  ; DATE/TIME RECORDED
  1.  . S MAGFDA(2005.199,IENS,.02)=113  ; FIELD NUMBER
  1.  . ;--- USER = DELETED BY (30)
  1.  . S MAGFDA(2005.199,IENS,.03)=$P($G(@MAGNODE@(30)),U)
  1.  . ;--- OLD INTERNAL VALUE and OLD EXTERNAL VALUE
  1.  . D:STC>0
  1.  . . S MAGFDA(2005.199,IENS,1)=STC
  1.  . . S:$G(MAGSTAT(STC))'="" MAGFDA(2005.199,IENS,2)=MAGSTAT(STC)
  1.  . . Q
  1.  . ;--- Create audit record for the status update
  1.  . D UPDATE^DIE(,"MAGFDA",,"MAGMSG")
  1.  . S:$G(DIERR) MAGRC=$$DBS^MAGUERR("MAGMSG",2005.1,MAGIEN_",")
  1.  . Q
  1.  S $P(@MAGNODE@(100),U,8)=12  ; STATUS = 'Deleted'
  1.  ;
  1.  ;===
  1.  Q MAGRC
  1.  ;
  1.  ;+++++ BUILDS NEW INDEXES IN FILES #2005 AND #2005.1
  1.  ;
  1.  ; MAGSUSPEND    Task suspension parameters
  1.  ;                 ^01: Suspend the task (0|1)
  1.  ;                 ^02: Suspension start time (e.g. 7am: .07)
  1.  ;                 ^03: Suspension end time (e.g. 8pm: .2)
  1.  ;
  1.  ; Input Variables
  1.  ; ===============
  1.  ;   XPDNM, ZTQUEUED
  1.  ;
  1.  ; Return Values
  1.  ; =============
  1.  ;           <0  Error descriptor (see the $$ERROR^MAGUERR)
  1.  ;            0  Ok
  1.  ;
  1.  ; Notes
  1.  ; =====
  1.  ;
  1.  ; This function also populates the STATUS field (113) and fixes
  1.  ; headers of all multiples of the IMAGE AUDIT file (#2005.1).
  1.  ;
  1. NDXBLD(MAGSUSPEND) ;
  1.  N MAGFILE       ; Number of the file that is being processed
  1.  N MAGNOFMAUDIT  ; Controls image audit indexes (see AUDIT^MAGUXRF)
  1.  N MAGROOT       ; Closed root of the file that is being processed
  1.  N MAGSTAT       ; List of status codes and their descriptions
  1.  ;
  1.  N DTNEXT,MAGCNT,MAGIEN,MAGRC,SILENT,TH,TMP
  1.  S SILENT=$S($G(XPDNM)'="":0,1:$D(ZTQUEUED)),MAGRC=0
  1.  D:'SILENT BMES^MAGKIDS("Building new image indexes...")
  1.  ;
  1.  ;=== Get the image status codes
  1.  D
  1.  . N BUF,I
  1.  . S BUF=$$GET1^DID(2005,113,,"POINTER")
  1.  . F I=1:1  S TMP=$P(BUF,";",I)  Q:TMP=""  D
  1.  . . S MAGSTAT(+TMP)=$P(TMP,":",2)
  1.  . . Q
  1.  . Q
  1.  ;
  1.  ;=== Do not update the AUDIT multiple (99)
  1.  S MAGNOFMAUDIT=1
  1.  ;
  1.  ;=== Build the indexes
  1.  F MAGFILE=2005,2005.1  D  Q:MAGRC<0
  1.  . I 'SILENT  D  D MES^MAGKIDS(TMP_" file (#"_MAGFILE_")")
  1.  . . S TMP=$$GET1^DID(MAGFILE,,,"NAME")
  1.  . . Q
  1.  . ;--- Check if the file has been processed already
  1.  . I $$PRD^MAGKIDS(MAGFILE,93)  D:'SILENT  Q
  1.  . . D MES^MAGKIDS("This file is already processed.")
  1.  . . Q
  1.  . ;--- Initialize
  1.  . S XPDIDTOT=$$GET1^DID(MAGFILE,,,"ENTRIES")
  1.  . I XPDIDTOT'>0  D:'SILENT MES^MAGKIDS("This file is empty.")  Q
  1.  . S MAGROOT=$$ROOT^DILFD(MAGFILE,,1),DIK=$$OREF^DILF(MAGROOT)
  1.  . ;--- Delete the indexes (in case of restart)
  1.  . K @MAGROOT@("APDT")
  1.  . K:MAGFILE=2005.1 @MAGROOT@("AGP"),^("APDTPX")
  1.  . ;--- Process the file
  1.  . S (MAGCNT,MAGIEN)=0
  1.  . F  S MAGIEN=$O(@MAGROOT@(MAGIEN))  Q:'MAGIEN  D  Q:MAGRC<0
  1.  . . I '(MAGCNT#1000)  D  Q:MAGRC<0
  1.  . . . I '$D(ZTQUEUED)  D PROGRESS(MAGCNT)  Q
  1.  . . . ;--- Check if task stop has been requested
  1.  . . . I $$S^%ZTLOAD  S MAGRC=$$ERROR^MAGUERR(-1)  Q
  1.  . . . ;--- Check if the task should be suspended
  1.  . . . Q:'$G(MAGSUSPEND)
  1.  . . . Q:$$NOW^XLFDT<$G(DTNEXT)
  1.  . . . Q:'$$SUSPEND(.DTNEXT)
  1.  . . . ;--- Suspend the task during the peak hours
  1.  . . . F  D  Q:'TH!MAGRC<0
  1.  . . . . S TH=$$FMDIFF^XLFDT(DTNEXT,$$NOW^XLFDT,2)
  1.  . . . . I TH<60  S TH=0  Q       ; Do not HANG for less than a
  1.  . . . . H $S(TH>3600:3600,1:TH)  ; minute and more than an hour
  1.  . . . . ;--- Check if task stop has been requested
  1.  . . . . S:$$S^%ZTLOAD MAGRC=$$ERROR^MAGUERR(-1)
  1.  . . . . Q
  1.  . . . Q
  1.  . . S MAGCNT=MAGCNT+1
  1.  . . ;--- Additional processing for IMAGE AUDIT record
  1.  . . I MAGFILE=2005.1  S MAGRC=$$MAGAUDIT(MAGIEN)  Q:MAGRC<0
  1.  . . ;--- Re-index the record
  1.  . . D XREF(MAGFILE,MAGIEN)
  1.  . . Q
  1.  . ;--- Indicate the final state of the process
  1.  . D:'$D(ZTQUEUED) PROGRESS(MAGCNT)
  1.  . D PRD^MAGKIDS(MAGFILE,93,"A")
  1.  . Q
  1.  Q:MAGRC<0 MAGRC
  1.  ;
  1.  ;=== Success
  1.  D:'SILENT MES^MAGKIDS("The indexes have been successfully built.")
  1.  Q 0
  1.  ;
  1.  ;+++++ CALLBACK FUNCTION FOR THE IMGAGE INDEX CHECKPOINT
  1.  ;
  1.  ; Input Variables
  1.  ; ===============
  1.  ;   DUZ, XPDQUES, ZTQUEUED
  1.  ;
  1. NDXCP() ;
  1.  N MAGRC
  1.  S MAGRC=0
  1.  ;
  1.  ;=== Schedule a separate task that will build image indexes
  1.  I $G(XPDQUES("POS02-MODE"))  D  Q MAGRC
  1.  . N MSG,ZTCPU,ZTDESC,ZTDTH,ZTIO,ZTKIL,ZTPRI
  1.  . N ZTRTN,ZTSAVE,ZTSK,ZTSYNC,ZTUCI
  1.  . S ZTSAVE("MAGDUZ")=$G(DUZ)
  1.  . S:$G(XPDQUES("POS10-SUSPEND")) ZTSAVE("MAGSUSPEND")="1^.07^.2"
  1.  . S ZTRTN="NDXTASK^"_$T(+0),ZTIO=""
  1.  . S ZTDESC="Image index builder (MAG*3*93)"
  1.  . S ZTDTH=$G(XPDQUES("POS05-SCHEDULEAT"))
  1.  . S:ZTDTH'>0 ZTDTH=$$NOW^XLFDT
  1.  . D ^%ZTLOAD
  1.  . I $G(ZTSK)=""  S MAGRC=$$ERROR^MAGUERR(-39)  Q
  1.  . ;--- Display the confirmation message
  1.  . S MSG(1)="It will rebuild indexes in the IMAGE (#2005) and IMAGE AUDIT (#2005.1)"
  1.  . S MSG(2)="files and perform other post-processing actions."
  1.  . D BMES^MAGKIDS("Task #"_ZTSK_" has been scheduled.",.MSG)
  1.  . Q
  1.  ;
  1.  ;=== Build the indexes as part of the patch post-install
  1.  Q $$NDXBLD()
  1.  ;
  1.  ;***** FORMATS AND PRINTS THE HELP TEXT FOR THE INDEX TASK MODE
  1. NDXHLP(DIR,KIDS) ;
  1.  ;;Patch MAG*3*93 defines new indexes for the IMAGE (#2005) and IMAGE 
  1.  ;;AUDIT (#2005.1) files. These indexes can be built as a part of the
  1.  ;;patch KIDS build installation or the post-install code can schedule
  1.  ;;a separate task that will build the indexes.
  1.  ;;
  1.  ;;However, it appears that the Taskman is not running on this system.
  1.  ;;As the result, you will not be given a choice and the indexes will
  1.  ;;be built as part of the post-install. If you want to schedule a
  1.  ;;separate indexing task, abort the installation, start the Taskman,
  1.  ;;and restart the patch installation.
  1. NDXHLP1 ;
  1.  ;;Patch MAG*3*93 defines new indexes for the IMAGE (#2005) and IMAGE 
  1.  ;;AUDIT (#2005.1) files. These indexes can be built in the current
  1.  ;;session (this will block it for quite a long time) or a separate
  1.  ;;task can be scheduled.
  1.  ;;
  1.  ;;However, it appears that the Taskman is not running on this system.
  1.  ;;If you want to schedule a separate indexing task, exit this option,
  1.  ;;start the Taskman, and run the option again.
  1.  ;
  1.  N DIWF,DIWL,DIWR,MAGI,MAGTAG,X
  1.  S MAGTAG=$S($G(KIDS):"NDXHLP",1:"NDXHLP1")
  1.  S DIWF="",DIWL=4,DIWR=$G(IOM,80)-DIWL+1
  1.  K ^UTILITY($J,"W"),DIR("?")
  1.  ;--- Format the main help text
  1.  F MAGI=1:1  S X=$P($T(@MAGTAG+MAGI),";;",2)  Q:X=""  D ^DIWP
  1.  S X=" "  D ^DIWP
  1.  ;--- Add the warning if the Taskman is not running
  1.  I '$$TM^%ZTLOAD  D
  1.  . F MAGI=MAGI+1:1  S X=$P($T(@MAGTAG+MAGI),";;",2)  Q:X=""  D ^DIWP
  1.  . Q
  1.  E  D
  1.  . S X="Enter 'Y' or 'N'; enter '^' to cancel. "  D ^DIWP
  1.  . Q
  1.  ;--- Load the help text into the ^DIR parameter and print it
  1.  S MAGI=0
  1.  F  S MAGI=$O(^UTILITY($J,"W",DIWL,MAGI))  Q:MAGI'>0  D
  1.  . S DIR("?",MAGI)=$J("",DIWL-1)_^UTILITY($J,"W",DIWL,MAGI,0)
  1.  . W !,DIR("?",MAGI)
  1.  . Q
  1.  W !
  1.  ;--- Special processing for the last line of the help text
  1.  S MAGI=+$O(DIR("?",""),-1)
  1.  I MAGI>0  S DIR("?")=DIR("?",MAGI)  K DIR("?",MAGI)
  1.  ;--- Cleanup
  1.  K ^UTILITY($J,"W")
  1.  Q
  1.  ;
  1.  ;+++++ RETURNS THE MESSAGE DESCRIBING RESULTS OF THE INDEX BUILD
  1.  ;
  1.  ; RC            Error descriptor (see the $$ERROR^MAGUERR)
  1.  ;
  1. NDXMSG(RC) ;
  1.  N PREFIX
  1.  S PREFIX="MAG*3*93: "
  1.  ;--- Error
  1.  Q:RC<-1 PREFIX_RC
  1.  ;--- Stopped by user
  1.  Q:+RC=-1 PREFIX_"Image indexing task was stopped by the user."
  1.  ;--- Success
  1.  Q PREFIX_"New indexes of the image files have been built."
  1.  ;
  1.  ;***** BACKGROUND TASK THAT BUILDS THE IMAGE INDEXES
  1.  ;
  1.  ; Input Variables
  1.  ; ===============
  1.  ;
  1.  ; MAGDUZ        Identifier of the user who started the task and who
  1.  ;               will receive the alert when the task finishes (IEN
  1.  ;               in the NEW PERSON file (#200)).
  1.  ;
  1.  ; MAGSUSPEND    Controls suspension of the task on working days
  1.  ;                 ^01: Suspend the task (0|1)
  1.  ;                 ^02: Start time (FileMan)
  1.  ;                 ^03: End time (FileMan)
  1.  ;
  1. NDXTASK ;
  1.  N MAGRC
  1.  ;--- Build the indexes
  1.  S MAGRC=$$NDXBLD($G(MAGSUSPEND))
  1.  ;--- Send the alert
  1.  D:$G(MAGDUZ)>0
  1.  . N TMP,XQA,XQAARCH,XQACNDEL,XQADATA,XQAFLG,XQAGUID,XQAID
  1.  . N XQAMSG,XQAOPT,XQAREVUE,XQAROU,XQASUPV,XQASURO,XQATEXT
  1.  . S XQAMSG=$$NDXMSG(MAGRC)
  1.  . S XQATEXT(1)=""
  1.  . S XQATEXT(2)="Date/Time of completion: "_$$FMTE^XLFDT($$NOW^XLFDT)
  1.  . S XQA(+MAGDUZ)="",XQAFLG="D"
  1.  . S TMP=$$SETUP1^XQALERT
  1.  . Q
  1.  ;--- Keep the task descriptor only in case of error(s)
  1.  S:MAGRC'<0 ZTREQ="@"
  1.  K MAGDUZ,MAGSUSPEND
  1.  Q
  1.  ;
  1.  ;***** POST-INSTALL CODE
  1. POS ;
  1.  N CALLBACK
  1.  D CLEAR^MAGUERR(1)
  1.  ;
  1.  ;--- Link new remote procedures to the Broker context option
  1.  S CALLBACK="$$ADDRPCS^"_$NA(MAGKIDS1("RPCLST^"_$T(+0),"MAG WINDOWS"))
  1.  I $$CP^MAGKIDS("MAG ATTACH RPCS",CALLBACK)<0  D ERROR  Q
  1.  ;
  1.  ;--- Enable version checking for all sites
  1.  S CALLBACK="$$VERCHKON^MAGKIDS1"
  1.  I $$CP^MAGKIDS("MAG VERSION CHECK",CALLBACK)<0  D ERROR  Q
  1.  ;
  1.  ;--- Restart the Imaging Utilization Report task
  1.  I $$CP^MAGKIDS("MAG REPORT TASK","$$RPTSKCP^"_$T(+0))<0  D ERROR  Q
  1.  ;
  1.  ;--- Build new indexes in the files #2005 and #2005.1
  1.  I $$CP^MAGKIDS("MAG IMAGE INDEXES","$$NDXCP^"_$T(+0))<0  D ERROR  Q
  1.  ;
  1.  ;--- Send the notification e-mail
  1.  I $$CP^MAGKIDS("MAG NOTIFICATION","$$NOTIFY^MAGKIDS1")<0  D ERROR  Q
  1.  Q
  1.  ;
  1.  ;***** PRE-INSTALL CODE
  1. PRE ;
  1.  ;--- Delete the field #4; it will be replaced by the field #5.5
  1.  D DELFLDS^MAGKIDS(2006.81,"4")
  1.  Q
  1.  ;
  1.  ;+++++ UPDATES THE PROGRESS INDICATOR
  1. PROGRESS(CNT) ;
  1.  ;--- Reset the progress indicator
  1.  I $G(CNT)'>0  D  Q
  1.  . I '$D(XPDNM)  W !,"   0.00%"  Q
  1.  . N XPDIDTOT
  1.  . S XPDIDTOT=0  D UPDATE^XPDID(0)
  1.  . Q
  1.  ;--- Make sure that we never see more than 100%
  1.  I $G(XPDIDTOT)>0  S:CNT>XPDIDTOT CNT=XPDIDTOT
  1.  ;--- Update the indicator
  1.  I $D(XPDNM)  D UPDATE^XPDID(CNT)  Q
  1.  I $G(XPDIDTOT)>0  S $X=0  W *13,?3,$J(CNT/XPDIDTOT*100,0,2)_"%"
  1.  Q
  1.  ;
  1.  ;***** MANUAL STARTER OF THE INDEX BUILDER TASK
  1. REINDEX ;
  1.  N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,EXIT,SCHEDULE,X,Y,ZTSAVE
  1.  D CLEAR^MAGUERR(1)
  1.  S SCHEDULE=0
  1.  ;
  1.  ;=== Request parameter values from the user
  1.  S EXIT=0  D  Q:EXIT
  1.  . ;--- Select the index building mode
  1.  . K DIR  S DIR(0)="Y"
  1.  . S DIR("A")="Schedule the task that builds the indexes"
  1.  . D NDXHLP(.DIR)
  1.  . D ^DIR  I $D(DIRUT)  S EXIT=1  Q
  1.  . Q:'Y
  1.  . ;--- The task will be scheduled
  1.  . S SCHEDULE=1,ZTSAVE("MAGDUZ")=$G(DUZ)
  1.  . ;--- Prompt for the task suspension mode
  1.  . K DIR  S DIR(0)="Y",DIR("B")="YES"
  1.  . S DIR("A")="Suspend the task during business hours (7am - 8pm)"
  1.  . D ^DIR  I $D(DIRUT)  S EXIT=1  Q
  1.  . S:Y ZTSAVE("MAGSUSPEND")="1^.07^.2"
  1.  . Q
  1.  ;
  1.  ;=== Schedule the task that will build the indexes
  1.  I SCHEDULE  D  Q
  1.  . N ZTCPU,ZTDESC,ZTDTH,ZTIO,ZTKIL,ZTPRI,ZTRTN,ZTSK,ZTSYNC,ZTUCI
  1.  . S ZTRTN="NDXTASK^"_$T(+0),ZTIO=""
  1.  . S ZTDESC="Image index builder (MAG*3*93)"
  1.  . D ^%ZTLOAD  W !
  1.  . I $G(ZTSK)=""  D ERROR^MAGUERR(-39),DUMP^MAGUERR1()  Q
  1.  . W !,"Task #"_ZTSK_" has been scheduled."
  1.  . Q
  1.  ;
  1.  ;=== Build the indexes in the current session
  1.  K DIR  S DIR(0)="Y"
  1.  S DIR("A")="Build the image indexes now"
  1.  D ^DIR  Q:$D(DIRUT)
  1.  I Y,$$NDXBLD()<0  W !  D DUMP^MAGUERR1()
  1.  Q
  1.  ;
  1.  ;+++++ LIST OF NEW REMOTE PROCEDURES
  1. RPCLST ;
  1.  ;;MAG4 IMAGE LIST
  1.  ;;MAGG IMAGE LOCK
  1.  ;;MAGG IMAGE GET PROPERTIES
  1.  ;;MAGG IMAGE SET PROPERTIES
  1.  ;;MAGG IMAGE STATISTICS
  1.  ;;MAGG IMAGE UNLOCK
  1.  ;;MAGG REASON GET PROPERTIES
  1.  ;;MAGG REASON LIST
  1.  ;;MAGG CAPTURE USERS
  1.  Q
  1.  ;
  1.  ;+++++ RESTARTS THE IMAGING UTILIZATION REPORT TASK
  1. RPTSKCP() ;
  1.  D REMTASK^MAGQE4,STTASK^MAGQE4
  1.  Q 0
  1.  ;
  1.  ;+++++ CHECKS IF THE TASK SHOULD BE SUSPENDED
  1.  ;
  1.  ; .DTNEXT       Date/Time of the next event (suspend/resume)
  1.  ;               is returned via this parameter
  1.  ;
  1.  ; Input Variables
  1.  ; ===============
  1.  ;   MAGSUSPEND
  1.  ;
  1.  ; Return Values
  1.  ; =============
  1.  ;            0  Continue/Resume
  1.  ;            1  Suspend
  1.  ;
  1. SUSPEND(DTNEXT) ;
  1.  N DATE,NOW,SUSPEND,TIME,TR,TS
  1.  S TS=$P(MAGSUSPEND,U,2),TR=$P(MAGSUSPEND,U,3)
  1.  S NOW=$$NOW^XLFDT,DATE=NOW\1
  1.  ;--- A work day
  1.  I $$WDCHK^MAGUTL03(DATE)  D  Q SUSPEND
  1.  . S TIME=NOW-DATE,SUSPEND=0
  1.  . I TIME<TS   S DTNEXT=DATE+TS  Q
  1.  . I TIME'<TR  S DTNEXT=$$WDNEXT^MAGUTL03(DATE)+TS  Q
  1.  . S DTNEXT=DATE+TR,SUSPEND=1
  1.  . Q
  1.  ;--- Saturday, Sunday or Holiday
  1.  S DTNEXT=$$WDNEXT^MAGUTL03(DATE)+TS
  1.  Q 0
  1.  ;
  1.  ;+++++ RE-INDEXES THE IMAGE RECORD
  1. XREF(MAGFILE,MAGIEN) ;
  1.  N GRPIEN,TMP,X0,X2
  1.  S X0=$G(^MAG(MAGFILE,MAGIEN,0)),X2=$G(^(2))
  1.  S GRPIEN=+$P(X0,U,10)  ; GROUP PARENT (14)
  1.  ;---
  1.  I GRPIEN  D:MAGFILE=2005.1
  1.  . ;--- AGP
  1.  . S ^MAG(MAGFILE,"AGP",GRPIEN,MAGIEN)=""
  1.  . Q
  1.  E  D
  1.  . N DFN,PDT
  1.  . S PDT=$P(X2,U,5)  Q:'PDT    ; PROCEDURE/EXAM DATE/TIME (15)
  1.  . ;--- APDT
  1.  . S ^MAG(MAGFILE,"APDT",PDT,MAGIEN)=""
  1.  . ;--- IMAGE file (#2005) already has the APDTPX index
  1.  . Q:MAGFILE=2005
  1.  . ;--- APDTPX
  1.  . S DFN=$P(X0,U,7)  Q:'DFN    ; PATIENT (5)
  1.  . S TMP=$P(X0,U,8)  Q:TMP=""  ; PROCEDURE (6)
  1.  . S ^MAG(MAGFILE,"APDTPX",DFN,9999999.9999-PDT,TMP,MAGIEN)=""
  1.  . Q
  1.  ;--- ACA
  1.  D:'$P(X2,U,12)  ; CAPTURE APPLICATION (8.1)
  1.  . N X100,PACS
  1.  . S X100=$G(^MAG(MAGFILE,MAGIEN,100)),PACS=$G(^("PACS"))
  1.  . S TMP=$TR($P(PACS,U,1,3),"^ ")  ; Fields 60, 61, and 62
  1.  . S $P(^MAG(MAGFILE,MAGIEN,2),U,12)=$S($P(X100,U,5)'="":"I",TMP'="":"D",1:"C")
  1.  . Q
  1.  ;--- Done
  1.  Q