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. 
MAGIPS93 ;WOIFO/SG - INSTALL CODE FOR MAG*3*93 ; 5/13/09 10:01am

 ;;3.0;IMAGING;**93**;Dec 02, 2009;Build 163

 ;; 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.                     |

 ;; +---------------------------------------------------------------+

 ;

 ; There are no environment checks here but the MAGIPS93 has to be

 ; referenced by the "Environment Check Routine" field of the KIDS

 ; build so that entry points of the routine are available to the

 ; KIDS during all installation phases.

 Q

 ;

 ;+++++ INSTALLATION ERROR HANDLING

ERROR ;

 S:$D(XPDNM) XPDABORT=1

 ;--- Display the messages and store them to the INSTALL file

 D DUMP^MAGUERR1(),ABTMSG^MAGKIDS()

 Q

 ;

 ;+++++ UPDATES/FIXES THE DELETED IMAGE ENTRY

 ;

 ; MAGIEN        IEN of an entry of the IMAGE AUDIT file (#2005.1)

 ;

 ; Input Variables

 ; ===============

 ;   MAGSTAT

 ;

 ; Return Values

 ; =============

 ;           <0  Error descriptor (see the $$ERROR^MAGUERR)

 ;            0  Ok

 ;

MAGAUDIT(MAGIEN) ;

 N MAGNODE,MAGRC,STC,SUB,TMP

 S MAGNODE=$NA(^MAG(2005.1,MAGIEN))

 Q:$D(@MAGNODE)<10 $$ERROR^MAGUERR(-22,,2005.1,MAGIEN_",")

 S STC=$P($G(@MAGNODE@(100)),U,8)  Q:STC=12 0  ; STATUS (113)

 S MAGRC=0

 ;

 ;=== Fix the subfile headers

 F SUB="1^2005.14P","4^2005.1106DA","5^2005.11PA","6^2005.1111A","99^2005.199D"  D

 . S TMP=$P(SUB,U)  Q:'($D(^MAG(2005.1,MAGIEN,TMP,0))#2)

 . S $P(^MAG(2005.1,MAGIEN,TMP,0),U,2)=$P(SUB,U,2)

 . Q

 ;

 ;=== Update STATUS field and create the corresponding audit record

 S TMP=+$P($G(@MAGNODE@(30)),U,2)   ; DELETED DATE (30.1)

 I TMP>0  D  Q:MAGRC<0 MAGRC

 . N IENS,MAGFDA,MAGMSG

 . S IENS="+1,"_MAGIEN_","

 . S MAGFDA(2005.199,IENS,.01)=TMP  ; DATE/TIME RECORDED

 . S MAGFDA(2005.199,IENS,.02)=113  ; FIELD NUMBER

 . ;--- USER = DELETED BY (30)

 . S MAGFDA(2005.199,IENS,.03)=$P($G(@MAGNODE@(30)),U)

 . ;--- OLD INTERNAL VALUE and OLD EXTERNAL VALUE

 . D:STC>0

 . . S MAGFDA(2005.199,IENS,1)=STC

 . . S:$G(MAGSTAT(STC))'="" MAGFDA(2005.199,IENS,2)=MAGSTAT(STC)

 . . Q

 . ;--- Create audit record for the status update

 . D UPDATE^DIE(,"MAGFDA",,"MAGMSG")

 . S:$G(DIERR) MAGRC=$$DBS^MAGUERR("MAGMSG",2005.1,MAGIEN_",")

 . Q

 S $P(@MAGNODE@(100),U,8)=12  ; STATUS = 'Deleted'

 ;

 ;===

 Q MAGRC

 ;

 ;+++++ BUILDS NEW INDEXES IN FILES #2005 AND #2005.1

 ;

 ; MAGSUSPEND    Task suspension parameters

 ;                 ^01: Suspend the task (0|1)

 ;                 ^02: Suspension start time (e.g. 7am: .07)

 ;                 ^03: Suspension end time (e.g. 8pm: .2)

 ;

 ; Input Variables

 ; ===============

 ;   XPDNM, ZTQUEUED

 ;

 ; Return Values

 ; =============

 ;           <0  Error descriptor (see the $$ERROR^MAGUERR)

 ;            0  Ok

 ;

 ; Notes

 ; =====

 ;

 ; This function also populates the STATUS field (113) and fixes

 ; headers of all multiples of the IMAGE AUDIT file (#2005.1).

 ;

NDXBLD(MAGSUSPEND) ;

 N MAGFILE       ; Number of the file that is being processed

 N MAGNOFMAUDIT  ; Controls image audit indexes (see AUDIT^MAGUXRF)

 N MAGROOT       ; Closed root of the file that is being processed

 N MAGSTAT       ; List of status codes and their descriptions

 ;

 N DTNEXT,MAGCNT,MAGIEN,MAGRC,SILENT,TH,TMP

 S SILENT=$S($G(XPDNM)'="":0,1:$D(ZTQUEUED)),MAGRC=0

 D:'SILENT BMES^MAGKIDS("Building new image indexes...")

 ;

 ;=== Get the image status codes

 D

 . N BUF,I

 . S BUF=$$GET1^DID(2005,113,,"POINTER")

 . F I=1:1  S TMP=$P(BUF,";",I)  Q:TMP=""  D

 . . S MAGSTAT(+TMP)=$P(TMP,":",2)

 . . Q

 . Q

 ;

 ;=== Do not update the AUDIT multiple (99)

 S MAGNOFMAUDIT=1

 ;

 ;=== Build the indexes

 F MAGFILE=2005,2005.1  D  Q:MAGRC<0

 . I 'SILENT  D  D MES^MAGKIDS(TMP_" file (#"_MAGFILE_")")

 . . S TMP=$$GET1^DID(MAGFILE,,,"NAME")

 . . Q

 . ;--- Check if the file has been processed already

 . I $$PRD^MAGKIDS(MAGFILE,93)  D:'SILENT  Q

 . . D MES^MAGKIDS("This file is already processed.")

 . . Q

 . ;--- Initialize

 . S XPDIDTOT=$$GET1^DID(MAGFILE,,,"ENTRIES")

 . I XPDIDTOT'>0  D:'SILENT MES^MAGKIDS("This file is empty.")  Q

 . S MAGROOT=$$ROOT^DILFD(MAGFILE,,1),DIK=$$OREF^DILF(MAGROOT)

 . ;--- Delete the indexes (in case of restart)

 . K @MAGROOT@("APDT")

 . K:MAGFILE=2005.1 @MAGROOT@("AGP"),^("APDTPX")

 . ;--- Process the file

 . S (MAGCNT,MAGIEN)=0

 . F  S MAGIEN=$O(@MAGROOT@(MAGIEN))  Q:'MAGIEN  D  Q:MAGRC<0

 . . I '(MAGCNT#1000)  D  Q:MAGRC<0

 . . . I '$D(ZTQUEUED)  D PROGRESS(MAGCNT)  Q

 . . . ;--- Check if task stop has been requested

 . . . I $$S^%ZTLOAD  S MAGRC=$$ERROR^MAGUERR(-1)  Q

 . . . ;--- Check if the task should be suspended

 . . . Q:'$G(MAGSUSPEND)

 . . . Q:$$NOW^XLFDT<$G(DTNEXT)

 . . . Q:'$$SUSPEND(.DTNEXT)

 . . . ;--- Suspend the task during the peak hours

 . . . F  D  Q:'TH!MAGRC<0

 . . . . S TH=$$FMDIFF^XLFDT(DTNEXT,$$NOW^XLFDT,2)

 . . . . I TH<60  S TH=0  Q       ; Do not HANG for less than a

 . . . . H $S(TH>3600:3600,1:TH)  ; minute and more than an hour

 . . . . ;--- Check if task stop has been requested

 . . . . S:$$S^%ZTLOAD MAGRC=$$ERROR^MAGUERR(-1)

 . . . . Q

 . . . Q

 . . S MAGCNT=MAGCNT+1

 . . ;--- Additional processing for IMAGE AUDIT record

 . . I MAGFILE=2005.1  S MAGRC=$$MAGAUDIT(MAGIEN)  Q:MAGRC<0

 . . ;--- Re-index the record

 . . D XREF(MAGFILE,MAGIEN)

 . . Q

 . ;--- Indicate the final state of the process

 . D:'$D(ZTQUEUED) PROGRESS(MAGCNT)

 . D PRD^MAGKIDS(MAGFILE,93,"A")

 . Q

 Q:MAGRC<0 MAGRC

 ;

 ;=== Success

 D:'SILENT MES^MAGKIDS("The indexes have been successfully built.")

 Q 0

 ;

 ;+++++ CALLBACK FUNCTION FOR THE IMGAGE INDEX CHECKPOINT

 ;

 ; Input Variables

 ; ===============

 ;   DUZ, XPDQUES, ZTQUEUED

 ;

NDXCP() ;

 N MAGRC

 S MAGRC=0

 ;

 ;=== Schedule a separate task that will build image indexes

 I $G(XPDQUES("POS02-MODE"))  D  Q MAGRC

 . N MSG,ZTCPU,ZTDESC,ZTDTH,ZTIO,ZTKIL,ZTPRI

 . N ZTRTN,ZTSAVE,ZTSK,ZTSYNC,ZTUCI

 . S ZTSAVE("MAGDUZ")=$G(DUZ)

 . S:$G(XPDQUES("POS10-SUSPEND")) ZTSAVE("MAGSUSPEND")="1^.07^.2"

 . S ZTRTN="NDXTASK^"_$T(+0),ZTIO=""

 . S ZTDESC="Image index builder (MAG*3*93)"

 . S ZTDTH=$G(XPDQUES("POS05-SCHEDULEAT"))

 . S:ZTDTH'>0 ZTDTH=$$NOW^XLFDT

 . D ^%ZTLOAD

 . I $G(ZTSK)=""  S MAGRC=$$ERROR^MAGUERR(-39)  Q

 . ;--- Display the confirmation message

 . S MSG(1)="It will rebuild indexes in the IMAGE (#2005) and IMAGE AUDIT (#2005.1)"

 . S MSG(2)="files and perform other post-processing actions."

 . D BMES^MAGKIDS("Task #"_ZTSK_" has been scheduled.",.MSG)

 . Q

 ;

 ;=== Build the indexes as part of the patch post-install

 Q $$NDXBLD()

 ;

 ;***** FORMATS AND PRINTS THE HELP TEXT FOR THE INDEX TASK MODE

NDXHLP(DIR,KIDS) ;

 ;;Patch MAG*3*93 defines new indexes for the IMAGE (#2005) and IMAGE 

 ;;AUDIT (#2005.1) files. These indexes can be built as a part of the

 ;;patch KIDS build installation or the post-install code can schedule

 ;;a separate task that will build the indexes.

 ;;

 ;;However, it appears that the Taskman is not running on this system.

 ;;As the result, you will not be given a choice and the indexes will

 ;;be built as part of the post-install. If you want to schedule a

 ;;separate indexing task, abort the installation, start the Taskman,

 ;;and restart the patch installation.

NDXHLP1 ;

 ;;Patch MAG*3*93 defines new indexes for the IMAGE (#2005) and IMAGE 

 ;;AUDIT (#2005.1) files. These indexes can be built in the current

 ;;session (this will block it for quite a long time) or a separate

 ;;task can be scheduled.

 ;;

 ;;However, it appears that the Taskman is not running on this system.

 ;;If you want to schedule a separate indexing task, exit this option,

 ;;start the Taskman, and run the option again.

 ;

 N DIWF,DIWL,DIWR,MAGI,MAGTAG,X

 S MAGTAG=$S($G(KIDS):"NDXHLP",1:"NDXHLP1")

 S DIWF="",DIWL=4,DIWR=$G(IOM,80)-DIWL+1

 K ^UTILITY($J,"W"),DIR("?")

 ;--- Format the main help text

 F MAGI=1:1  S X=$P($T(@MAGTAG+MAGI),";;",2)  Q:X=""  D ^DIWP

 S X=" "  D ^DIWP

 ;--- Add the warning if the Taskman is not running

 I '$$TM^%ZTLOAD  D

 . F MAGI=MAGI+1:1  S X=$P($T(@MAGTAG+MAGI),";;",2)  Q:X=""  D ^DIWP

 . Q

 E  D

 . S X="Enter 'Y' or 'N'; enter '^' to cancel. "  D ^DIWP

 . Q

 ;--- Load the help text into the ^DIR parameter and print it

 S MAGI=0

 F  S MAGI=$O(^UTILITY($J,"W",DIWL,MAGI))  Q:MAGI'>0  D

 . S DIR("?",MAGI)=$J("",DIWL-1)_^UTILITY($J,"W",DIWL,MAGI,0)

 . W !,DIR("?",MAGI)

 . Q

 W !

 ;--- Special processing for the last line of the help text

 S MAGI=+$O(DIR("?",""),-1)

 I MAGI>0  S DIR("?")=DIR("?",MAGI)  K DIR("?",MAGI)

 ;--- Cleanup

 K ^UTILITY($J,"W")

 Q

 ;

 ;+++++ RETURNS THE MESSAGE DESCRIBING RESULTS OF THE INDEX BUILD

 ;

 ; RC            Error descriptor (see the $$ERROR^MAGUERR)

 ;

NDXMSG(RC) ;

 N PREFIX

 S PREFIX="MAG*3*93: "

 ;--- Error

 Q:RC<-1 PREFIX_RC

 ;--- Stopped by user

 Q:+RC=-1 PREFIX_"Image indexing task was stopped by the user."

 ;--- Success

 Q PREFIX_"New indexes of the image files have been built."

 ;

 ;***** BACKGROUND TASK THAT BUILDS THE IMAGE INDEXES

 ;

 ; Input Variables

 ; ===============

 ;

 ; MAGDUZ        Identifier of the user who started the task and who

 ;               will receive the alert when the task finishes (IEN

 ;               in the NEW PERSON file (#200)).

 ;

 ; MAGSUSPEND    Controls suspension of the task on working days

 ;                 ^01: Suspend the task (0|1)

 ;                 ^02: Start time (FileMan)

 ;                 ^03: End time (FileMan)

 ;

NDXTASK ;

 N MAGRC

 ;--- Build the indexes

 S MAGRC=$$NDXBLD($G(MAGSUSPEND))

 ;--- Send the alert

 D:$G(MAGDUZ)>0

 . N TMP,XQA,XQAARCH,XQACNDEL,XQADATA,XQAFLG,XQAGUID,XQAID

 . N XQAMSG,XQAOPT,XQAREVUE,XQAROU,XQASUPV,XQASURO,XQATEXT

 . S XQAMSG=$$NDXMSG(MAGRC)

 . S XQATEXT(1)=""

 . S XQATEXT(2)="Date/Time of completion: "_$$FMTE^XLFDT($$NOW^XLFDT)

 . S XQA(+MAGDUZ)="",XQAFLG="D"

 . S TMP=$$SETUP1^XQALERT

 . Q

 ;--- Keep the task descriptor only in case of error(s)

 S:MAGRC'<0 ZTREQ="@"

 K MAGDUZ,MAGSUSPEND

 Q

 ;

 ;***** POST-INSTALL CODE

POS ;

 N CALLBACK

 D CLEAR^MAGUERR(1)

 ;

 ;--- Link new remote procedures to the Broker context option

 S CALLBACK="$$ADDRPCS^"_$NA(MAGKIDS1("RPCLST^"_$T(+0),"MAG WINDOWS"))

 I $$CP^MAGKIDS("MAG ATTACH RPCS",CALLBACK)<0  D ERROR  Q

 ;

 ;--- Enable version checking for all sites

 S CALLBACK="$$VERCHKON^MAGKIDS1"

 I $$CP^MAGKIDS("MAG VERSION CHECK",CALLBACK)<0  D ERROR  Q

 ;

 ;--- Restart the Imaging Utilization Report task

 I $$CP^MAGKIDS("MAG REPORT TASK","$$RPTSKCP^"_$T(+0))<0  D ERROR  Q

 ;

 ;--- Build new indexes in the files #2005 and #2005.1

 I $$CP^MAGKIDS("MAG IMAGE INDEXES","$$NDXCP^"_$T(+0))<0  D ERROR  Q

 ;

 ;--- Send the notification e-mail

 I $$CP^MAGKIDS("MAG NOTIFICATION","$$NOTIFY^MAGKIDS1")<0  D ERROR  Q

 Q

 ;

 ;***** PRE-INSTALL CODE

PRE ;

 ;--- Delete the field #4; it will be replaced by the field #5.5

 D DELFLDS^MAGKIDS(2006.81,"4")

 Q

 ;

 ;+++++ UPDATES THE PROGRESS INDICATOR

PROGRESS(CNT) ;

 ;--- Reset the progress indicator

 I $G(CNT)'>0  D  Q

 . I '$D(XPDNM)  W !,"   0.00%"  Q

 . N XPDIDTOT

 . S XPDIDTOT=0  D UPDATE^XPDID(0)

 . Q

 ;--- Make sure that we never see more than 100%

 I $G(XPDIDTOT)>0  S:CNT>XPDIDTOT CNT=XPDIDTOT

 ;--- Update the indicator

 I $D(XPDNM)  D UPDATE^XPDID(CNT)  Q

 I $G(XPDIDTOT)>0  S $X=0  W *13,?3,$J(CNT/XPDIDTOT*100,0,2)_"%"

 Q

 ;

 ;***** MANUAL STARTER OF THE INDEX BUILDER TASK

REINDEX ;

 N DA,DIR,DIROUT,DIRUT,DTOUT,DUOUT,EXIT,SCHEDULE,X,Y,ZTSAVE

 D CLEAR^MAGUERR(1)

 S SCHEDULE=0

 ;

 ;=== Request parameter values from the user

 S EXIT=0  D  Q:EXIT

 . ;--- Select the index building mode

 . K DIR  S DIR(0)="Y"

 . S DIR("A")="Schedule the task that builds the indexes"

 . D NDXHLP(.DIR)

 . D ^DIR  I $D(DIRUT)  S EXIT=1  Q

 . Q:'Y

 . ;--- The task will be scheduled

 . S SCHEDULE=1,ZTSAVE("MAGDUZ")=$G(DUZ)

 . ;--- Prompt for the task suspension mode

 . K DIR  S DIR(0)="Y",DIR("B")="YES"

 . S DIR("A")="Suspend the task during business hours (7am - 8pm)"

 . D ^DIR  I $D(DIRUT)  S EXIT=1  Q

 . S:Y ZTSAVE("MAGSUSPEND")="1^.07^.2"

 . Q

 ;

 ;=== Schedule the task that will build the indexes

 I SCHEDULE  D  Q

 . N ZTCPU,ZTDESC,ZTDTH,ZTIO,ZTKIL,ZTPRI,ZTRTN,ZTSK,ZTSYNC,ZTUCI

 . S ZTRTN="NDXTASK^"_$T(+0),ZTIO=""

 . S ZTDESC="Image index builder (MAG*3*93)"

 . D ^%ZTLOAD  W !

 . I $G(ZTSK)=""  D ERROR^MAGUERR(-39),DUMP^MAGUERR1()  Q

 . W !,"Task #"_ZTSK_" has been scheduled."

 . Q

 ;

 ;=== Build the indexes in the current session

 K DIR  S DIR(0)="Y"

 S DIR("A")="Build the image indexes now"

 D ^DIR  Q:$D(DIRUT)

 I Y,$$NDXBLD()<0  W !  D DUMP^MAGUERR1()

 Q

 ;

 ;+++++ LIST OF NEW REMOTE PROCEDURES

RPCLST ;

 ;;MAG4 IMAGE LIST

 ;;MAGG IMAGE LOCK

 ;;MAGG IMAGE GET PROPERTIES

 ;;MAGG IMAGE SET PROPERTIES

 ;;MAGG IMAGE STATISTICS

 ;;MAGG IMAGE UNLOCK

 ;;MAGG REASON GET PROPERTIES

 ;;MAGG REASON LIST

 ;;MAGG CAPTURE USERS

 Q

 ;

 ;+++++ RESTARTS THE IMAGING UTILIZATION REPORT TASK

RPTSKCP() ;

 D REMTASK^MAGQE4,STTASK^MAGQE4

 Q 0

 ;

 ;+++++ CHECKS IF THE TASK SHOULD BE SUSPENDED

 ;

 ; .DTNEXT       Date/Time of the next event (suspend/resume)

 ;               is returned via this parameter

 ;

 ; Input Variables

 ; ===============

 ;   MAGSUSPEND

 ;

 ; Return Values

 ; =============

 ;            0  Continue/Resume

 ;            1  Suspend

 ;

SUSPEND(DTNEXT) ;

 N DATE,NOW,SUSPEND,TIME,TR,TS

 S TS=$P(MAGSUSPEND,U,2),TR=$P(MAGSUSPEND,U,3)

 S NOW=$$NOW^XLFDT,DATE=NOW\1

 ;--- A work day

 I $$WDCHK^MAGUTL03(DATE)  D  Q SUSPEND

 . S TIME=NOW-DATE,SUSPEND=0

 . I TIME<TS   S DTNEXT=DATE+TS  Q

 . I TIME'<TR  S DTNEXT=$$WDNEXT^MAGUTL03(DATE)+TS  Q

 . S DTNEXT=DATE+TR,SUSPEND=1

 . Q

 ;--- Saturday, Sunday or Holiday

 S DTNEXT=$$WDNEXT^MAGUTL03(DATE)+TS

 Q 0

 ;

 ;+++++ RE-INDEXES THE IMAGE RECORD

XREF(MAGFILE,MAGIEN) ;

 N GRPIEN,TMP,X0,X2

 S X0=$G(^MAG(MAGFILE,MAGIEN,0)),X2=$G(^(2))

 S GRPIEN=+$P(X0,U,10)  ; GROUP PARENT (14)

 ;---

 I GRPIEN  D:MAGFILE=2005.1

 . ;--- AGP

 . S ^MAG(MAGFILE,"AGP",GRPIEN,MAGIEN)=""

 . Q

 E  D

 . N DFN,PDT

 . S PDT=$P(X2,U,5)  Q:'PDT    ; PROCEDURE/EXAM DATE/TIME (15)

 . ;--- APDT

 . S ^MAG(MAGFILE,"APDT",PDT,MAGIEN)=""

 . ;--- IMAGE file (#2005) already has the APDTPX index

 . Q:MAGFILE=2005

 . ;--- APDTPX

 . S DFN=$P(X0,U,7)  Q:'DFN    ; PATIENT (5)

 . S TMP=$P(X0,U,8)  Q:TMP=""  ; PROCEDURE (6)

 . S ^MAG(MAGFILE,"APDTPX",DFN,9999999.9999-PDT,TMP,MAGIEN)=""

 . Q

 ;--- ACA

 D:'$P(X2,U,12)  ; CAPTURE APPLICATION (8.1)

 . N X100,PACS

 . S X100=$G(^MAG(MAGFILE,MAGIEN,100)),PACS=$G(^("PACS"))

 . S TMP=$TR($P(PACS,U,1,3),"^ ")  ; Fields 60, 61, and 62

 . S $P(^MAG(MAGFILE,MAGIEN,2),U,12)=$S($P(X100,U,5)'="":"I",TMP'="":"D",1:"C")

 . Q

 ;--- Done

 Q