| 1 | MAGDIR84 ;WOIFO/PMK - Read a DICOM image file ; 09/30/2003  09:19
 | 
|---|
| 2 |  ;;3.0;IMAGING;**11**;14-April-2004
 | 
|---|
| 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 |  ;; |                                                               |
 | 
|---|
| 11 |  ;; | The Food and Drug Administration classifies this software as  |
 | 
|---|
| 12 |  ;; | a medical device.  As such, it may not be changed in any way. |
 | 
|---|
| 13 |  ;; | Modifications to this software may result in an adulterated   |
 | 
|---|
| 14 |  ;; | medical device under 21CFR820, the use of which is considered |
 | 
|---|
| 15 |  ;; | to be a violation of US Federal Statutes.                     |
 | 
|---|
| 16 |  ;; +---------------------------------------------------------------+
 | 
|---|
| 17 |  ;;
 | 
|---|
| 18 |  ;
 | 
|---|
| 19 |  ; M2MB server
 | 
|---|
| 20 |  ;
 | 
|---|
| 21 |  ; This routine handles the "PATIENT SAFETY" REQUEST item.
 | 
|---|
| 22 |  ;
 | 
|---|
| 23 |  ; It checks the 0-node of ^MAG(2005) and other files to verify that
 | 
|---|
| 24 |  ; they have not been unintentionally decremented.  This is a safety
 | 
|---|
| 25 |  ; precaution to prevent an earlier copy of the global from being used.
 | 
|---|
| 26 |  ; 
 | 
|---|
| 27 |  ; This problem can be caused either by using the VA AXP DSM 
 | 
|---|
| 28 |  ; Global/Volume Set Repacking Utility or by restoring an old
 | 
|---|
| 29 |  ; copy of the global.
 | 
|---|
| 30 |  ; 
 | 
|---|
| 31 | ENTRY ; entry point from ^MAGDIR8
 | 
|---|
| 32 |  N LASTIEN ;-- internal entry number of last image in ^MAG(2005)
 | 
|---|
| 33 |  N LASTPTR ;-- value of "LAST IMAGE POINTER"
 | 
|---|
| 34 |  N FILE ;----- name of MUMPS file containing 0-node for testing
 | 
|---|
| 35 |  N FILENAME ;- human-readable name of file begin tested
 | 
|---|
| 36 |  N NEWVALUE ;- updated value for the last pointer
 | 
|---|
| 37 |  N NODENAME ;- subscript of "LAST <filename> POINTER" in ^MAGDICOM
 | 
|---|
| 38 |  N RESULTS ;-- result string (working variable)
 | 
|---|
| 39 |  ;
 | 
|---|
| 40 |  N EMAIL,LASTIMG,LASTRAD,SYSTITLE
 | 
|---|
| 41 |  ;
 | 
|---|
| 42 |  S LASTIMG=$P(ARGS,"|",2),LASTRAD=$P(ARGS,"|",3)
 | 
|---|
| 43 |  S SYSTITLE=$P(ARGS,"|",4),EMAIL=$P(ARGS,"|",5)
 | 
|---|
| 44 |  ;
 | 
|---|
| 45 |  I $$MAG D  ; imaging file (2005)
 | 
|---|
| 46 |  . ; error with imaging file
 | 
|---|
| 47 |  . D ERROR^MAGDIR8("PATIENT SAFETY","-1 IMAGE FILE CORRUPTION",.MSG,$T(+0))
 | 
|---|
| 48 |  . Q
 | 
|---|
| 49 |  E  D  ; no error with imaging file
 | 
|---|
| 50 |  . S RESULTS="0|"_NEWVALUE ; new IMAGEPTR
 | 
|---|
| 51 |  . ;
 | 
|---|
| 52 |  . I $$RARPT D  ; radiology report file
 | 
|---|
| 53 |  . . ; error with radiology report file
 | 
|---|
| 54 |  . . D ERROR^MAGDIR8("PATIENT SAFETY","-2 RAD REPORT FILE CORRUPTION",.MSG,$T(+0))
 | 
|---|
| 55 |  . . Q
 | 
|---|
| 56 |  . E  D  ; no errors
 | 
|---|
| 57 |  . . S RESULTS=RESULTS_"|"_NEWVALUE ; new RADPT
 | 
|---|
| 58 |  . . I RESULTS'=$P(ARGS,"|",1,3) D  ; do this only if there are changes
 | 
|---|
| 59 |  . . . D RESULT^MAGDIR8("PATIENT SAFETY",RESULTS)
 | 
|---|
| 60 |  . . . Q
 | 
|---|
| 61 |  . . Q
 | 
|---|
| 62 |  . Q
 | 
|---|
| 63 |  Q
 | 
|---|
| 64 |  ;
 | 
|---|
| 65 | MAG() ; check that the last image pointer is monotonically increasing
 | 
|---|
| 66 |  S FILE="^MAG(2005)",FILENAME="IMAGE",LASTPTR=LASTIMG
 | 
|---|
| 67 |  I $$CHECK1'<0 Q 0 ; normal exit, everything is consistent
 | 
|---|
| 68 |  ;
 | 
|---|
| 69 |  ; Something fishy may be up ... look for multiple deleted entries
 | 
|---|
| 70 |  N LAST,LASTDEL,LASTMAG
 | 
|---|
| 71 |  H 5 ; wait for other image gateways to complete file update
 | 
|---|
| 72 |  S LASTMAG=$O(^MAG(2005," "),-1) ; last image file ien
 | 
|---|
| 73 |  S LASTDEL=$O(^MAG(2005.1," "),-1) ; last delete file ien
 | 
|---|
| 74 |  S LAST=$S(LASTDEL>LASTMAG:LASTDEL,1:LASTMAG) ; greater of these
 | 
|---|
| 75 |  I LAST<LASTPTR D  Q 1  ; issue an error message, as data is missing
 | 
|---|
| 76 |  . D MAGZERO^MAGDIRVE($T(+0),LASTIEN,LASTIMG)
 | 
|---|
| 77 |  . Q
 | 
|---|
| 78 |  Q 0
 | 
|---|
| 79 |  ;
 | 
|---|
| 80 | RARPT() ; check ^RARPT to make sure that it isn't decremented abnormally
 | 
|---|
| 81 |  S FILE="^RARPT",FILENAME="RAD REPORT",LASTPTR=LASTRAD
 | 
|---|
| 82 |  Q $$CHECK
 | 
|---|
| 83 |  ;
 | 
|---|
| 84 | CHECK() ; check the last internal entry with that previously saved
 | 
|---|
| 85 |  I $$CHECK1'<0 Q 0 ; normal exit, everything is consistent
 | 
|---|
| 86 |  ;
 | 
|---|
| 87 |  ; Something fishy may be up ... flag the error
 | 
|---|
| 88 |  D ZERONODE^MAGDIRVE($T(+0),LASTIEN,LASTPTR,FILE,FILENAME)
 | 
|---|
| 89 |  Q 1
 | 
|---|
| 90 |  ;
 | 
|---|
| 91 | CHECK1() ; check the last internal entry number against the largest know value
 | 
|---|
| 92 |  S LASTIEN=$O(@FILE@(" "),-1) ; changed from piece 3 of zero node - PMK 6/4/02
 | 
|---|
| 93 |  S NODENAME="LAST "_FILENAME_" POINTER"
 | 
|---|
| 94 |  S NEWVALUE=LASTPTR,LASTPTR=+LASTPTR
 | 
|---|
| 95 |  I LASTIEN=LASTPTR Q 0 ; no change
 | 
|---|
| 96 |  I LASTIEN>LASTPTR D UPDATE Q 1 ; record last ien in ^MAGDICOM
 | 
|---|
| 97 |  ;
 | 
|---|
| 98 |  ; if last entry was deleted, LASTIEN should be one less than LASTPTR 
 | 
|---|
| 99 |  I LASTIEN=(LASTPTR-1) D UPDATE Q 1 ; a delete must have happened
 | 
|---|
| 100 |  Q -1 ; the last entry number is less that it should be
 | 
|---|
| 101 |  ;
 | 
|---|
| 102 | UPDATE ; record the largest known internal entry number in ^MAGDICOM
 | 
|---|
| 103 |  N %,%H,%I,X,Y
 | 
|---|
| 104 |  D NOW^%DTC,YX^%DTC S Y=$P(Y,",")_" at "_$P(Y,"@",2)
 | 
|---|
| 105 |  S NEWVALUE=LASTIEN_" "_Y
 | 
|---|
| 106 |  Q
 | 
|---|