MAGDIR84 ;WOIFO/PMK - Read a DICOM image file ; 19 Sep 2007 9:43 AM
;;3.0;IMAGING;**11,54**;03-July-2009;;Build 1424
;; 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. |
;; +---------------------------------------------------------------+
;;
; M2MB server
;
; This routine handles the "PATIENT SAFETY" REQUEST item.
;
; It checks the 0-node of ^MAG(2005) and other files to verify that
; they have not been unintentionally decremented. This is a safety
; precaution to prevent an earlier copy of the global from being used.
;
; This problem can be caused either by using the VA AXP DSM
; Global/Volume Set Repacking Utility or by restoring an old
; copy of the global.
;
ENTRY ; entry point from ^MAGDIR8
N LASTIEN ;-- internal entry number of last image in ^MAG(2005)
N LASTPTR ;-- value of "LAST IMAGE POINTER"
N FILE ;----- name of MUMPS file containing 0-node for testing
N FILENAME ;- human-readable name of file begin tested
N NEWVALUE ;- updated value for the last pointer
N RESULTS ;-- result string (working variable)
;
N EMAIL,LASTIMG,LASTRAD,SYSTITLE
;
S LASTIMG=$P(ARGS,"|",2),LASTRAD=$P(ARGS,"|",3)
S SYSTITLE=$P(ARGS,"|",4),EMAIL=$P(ARGS,"|",5)
;
I $$MAG D ; imaging file (2005)
. ; error with imaging file
. D ERROR^MAGDIR8("PATIENT SAFETY","-1 IMAGE FILE CORRUPTION",.MSG,$T(+0))
. Q
E D ; no error with imaging file
. S RESULTS="0|"_NEWVALUE ; new IMAGEPTR
. ;
. I $$RARPT D ; radiology report file
. . ; error with radiology report file
. . D ERROR^MAGDIR8("PATIENT SAFETY","-2 RAD REPORT FILE CORRUPTION",.MSG,$T(+0))
. . Q
. E D ; no errors
. . S RESULTS=RESULTS_"|"_NEWVALUE ; new RADPT
. . I RESULTS'=$P(ARGS,"|",1,3) D ; do this only if there are changes
. . . D RESULT^MAGDIR8("PATIENT SAFETY",RESULTS)
. . . Q
. . Q
. Q
Q
;
MAG() ; check that the last image pointer is monotonically increasing
S FILE="^MAG(2005)",FILENAME="IMAGE",LASTPTR=LASTIMG
I $$CHECK1'<0 Q 0 ; normal exit, everything is consistent
;
; Something fishy may be up ... look for multiple deleted entries
N LAST,LASTDEL,LASTMAG
H 5 ; wait for other image gateways to complete file update
S LASTMAG=$O(^MAG(2005," "),-1) ; last image file ien
S LASTDEL=$O(^MAG(2005.1," "),-1) ; last delete file ien
S LAST=$S(LASTDEL>LASTMAG:LASTDEL,1:LASTMAG) ; greater of these
I LAST<LASTPTR D Q 1 ; issue an error message, as data is missing
. D MAGZERO^MAGDIRVE($T(+0),LASTIEN,LASTIMG)
. Q
Q 0
;
RARPT() ; check ^RARPT to make sure that it isn't decremented abnormally
S FILE="^RARPT",FILENAME="RAD REPORT",LASTPTR=LASTRAD
Q $$CHECK
;
CHECK() ; check the last internal entry with that previously saved
I $$CHECK1'<0 Q 0 ; normal exit, everything is consistent
;
; Something fishy may be up ... flag the error
D ZERONODE^MAGDIRVE($T(+0),LASTIEN,LASTPTR,FILE,FILENAME)
Q 1
;
CHECK1() ; check the last internal entry number against the largest know value
S LASTIEN=$O(@FILE@(" "),-1) ; changed from piece 3 of zero node - PMK 6/4/02
S NEWVALUE=LASTPTR,LASTPTR=+LASTPTR
I LASTIEN=LASTPTR Q 0 ; no change
I LASTIEN>LASTPTR D UPDATE Q 1 ; record last ien in ^MAGDICOM
;
; if last entry was deleted, LASTIEN should be one less than LASTPTR
I LASTIEN=(LASTPTR-1) D UPDATE Q 1 ; a delete must have happened
Q -1 ; the last entry number is less that it should be
;
UPDATE ; record the largest known internal entry number in ^MAGDICOM
N Y
S Y=$$HTE^XLFDT($H,1)
S NEWVALUE=LASTIEN_" "_$P(Y,",")_" at "_$P(Y,"@",2)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDIR84 4445 printed Sep 23, 2025@19:36:35 Page 2
MAGDIR84 ;WOIFO/PMK - Read a DICOM image file ; 19 Sep 2007 9:43 AM
+1 ;;3.0;IMAGING;**11,54**;03-July-2009;;Build 1424
+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 ; M2MB server
+18 ;
+19 ; This routine handles the "PATIENT SAFETY" REQUEST item.
+20 ;
+21 ; It checks the 0-node of ^MAG(2005) and other files to verify that
+22 ; they have not been unintentionally decremented. This is a safety
+23 ; precaution to prevent an earlier copy of the global from being used.
+24 ;
+25 ; This problem can be caused either by using the VA AXP DSM
+26 ; Global/Volume Set Repacking Utility or by restoring an old
+27 ; copy of the global.
+28 ;
ENTRY ; entry point from ^MAGDIR8
+1 ;-- internal entry number of last image in ^MAG(2005)
NEW LASTIEN
+2 ;-- value of "LAST IMAGE POINTER"
NEW LASTPTR
+3 ;----- name of MUMPS file containing 0-node for testing
NEW FILE
+4 ;- human-readable name of file begin tested
NEW FILENAME
+5 ;- updated value for the last pointer
NEW NEWVALUE
+6 ;-- result string (working variable)
NEW RESULTS
+7 ;
+8 NEW EMAIL,LASTIMG,LASTRAD,SYSTITLE
+9 ;
+10 SET LASTIMG=$PIECE(ARGS,"|",2)
SET LASTRAD=$PIECE(ARGS,"|",3)
+11 SET SYSTITLE=$PIECE(ARGS,"|",4)
SET EMAIL=$PIECE(ARGS,"|",5)
+12 ;
+13 ; imaging file (2005)
IF $$MAG
Begin DoDot:1
+14 ; error with imaging file
+15 DO ERROR^MAGDIR8("PATIENT SAFETY","-1 IMAGE FILE CORRUPTION",.MSG,$TEXT(+0))
+16 QUIT
End DoDot:1
+17 ; no error with imaging file
IF '$TEST
Begin DoDot:1
+18 ; new IMAGEPTR
SET RESULTS="0|"_NEWVALUE
+19 ;
+20 ; radiology report file
IF $$RARPT
Begin DoDot:2
+21 ; error with radiology report file
+22 DO ERROR^MAGDIR8("PATIENT SAFETY","-2 RAD REPORT FILE CORRUPTION",.MSG,$TEXT(+0))
+23 QUIT
End DoDot:2
+24 ; no errors
IF '$TEST
Begin DoDot:2
+25 ; new RADPT
SET RESULTS=RESULTS_"|"_NEWVALUE
+26 ; do this only if there are changes
IF RESULTS'=$PIECE(ARGS,"|",1,3)
Begin DoDot:3
+27 DO RESULT^MAGDIR8("PATIENT SAFETY",RESULTS)
+28 QUIT
End DoDot:3
+29 QUIT
End DoDot:2
+30 QUIT
End DoDot:1
+31 QUIT
+32 ;
MAG() ; check that the last image pointer is monotonically increasing
+1 SET FILE="^MAG(2005)"
SET FILENAME="IMAGE"
SET LASTPTR=LASTIMG
+2 ; normal exit, everything is consistent
IF $$CHECK1'<0
QUIT 0
+3 ;
+4 ; Something fishy may be up ... look for multiple deleted entries
+5 NEW LAST,LASTDEL,LASTMAG
+6 ; wait for other image gateways to complete file update
HANG 5
+7 ; last image file ien
SET LASTMAG=$ORDER(^MAG(2005," "),-1)
+8 ; last delete file ien
SET LASTDEL=$ORDER(^MAG(2005.1," "),-1)
+9 ; greater of these
SET LAST=$SELECT(LASTDEL>LASTMAG:LASTDEL,1:LASTMAG)
+10 ; issue an error message, as data is missing
IF LAST<LASTPTR
Begin DoDot:1
+11 DO MAGZERO^MAGDIRVE($TEXT(+0),LASTIEN,LASTIMG)
+12 QUIT
End DoDot:1
QUIT 1
+13 QUIT 0
+14 ;
RARPT() ; check ^RARPT to make sure that it isn't decremented abnormally
+1 SET FILE="^RARPT"
SET FILENAME="RAD REPORT"
SET LASTPTR=LASTRAD
+2 QUIT $$CHECK
+3 ;
CHECK() ; check the last internal entry with that previously saved
+1 ; normal exit, everything is consistent
IF $$CHECK1'<0
QUIT 0
+2 ;
+3 ; Something fishy may be up ... flag the error
+4 DO ZERONODE^MAGDIRVE($TEXT(+0),LASTIEN,LASTPTR,FILE,FILENAME)
+5 QUIT 1
+6 ;
CHECK1() ; check the last internal entry number against the largest know value
+1 ; changed from piece 3 of zero node - PMK 6/4/02
SET LASTIEN=$ORDER(@FILE@(" "),-1)
+2 SET NEWVALUE=LASTPTR
SET LASTPTR=+LASTPTR
+3 ; no change
IF LASTIEN=LASTPTR
QUIT 0
+4 ; record last ien in ^MAGDICOM
IF LASTIEN>LASTPTR
DO UPDATE
QUIT 1
+5 ;
+6 ; if last entry was deleted, LASTIEN should be one less than LASTPTR
+7 ; a delete must have happened
IF LASTIEN=(LASTPTR-1)
DO UPDATE
QUIT 1
+8 ; the last entry number is less that it should be
QUIT -1
+9 ;
UPDATE ; record the largest known internal entry number in ^MAGDICOM
+1 NEW Y
+2 SET Y=$$HTE^XLFDT($HOROLOG,1)
+3 SET NEWVALUE=LASTIEN_" "_$PIECE(Y,",")_" at "_$PIECE(Y,"@",2)
+4 QUIT
+5 ;
