MAGDIR9B ;WOIFO/PMK/RRB - Read a DICOM image file ; 04 May 2010 8:25 AM
;;3.0;IMAGING;**11,51,50,54,53,99**;Mar 19, 2002;Build 2057;Apr 19, 2011
;; 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. |
;; +---------------------------------------------------------------+
;;
Q
; Create an image entry in ^MAG(2005)
;
IMAGE() ; entry point from ^MAGDIR81 to create an image entry in ^MAG(2005)
N I ;-------- scratch counter
N IMAGE ;---- image array for ^MAGGTIA
N IMAGECNT ;- counter of image in the group
N IMAGEPTR ;- value returned by ^MAGGTIA
;
; check that the group has right object type and is for the same person
I $P($G(^MAG(2005,MAGGP,0)),"^",6)'=11 D Q -101 ; fatal error
. D OBJECT^MAGDIRVE($T(+0),MAGGP)
. Q
;
; check that the group patient DFN matches the image patient DFN
I $P(^MAG(2005,MAGGP,0),"^",7)'=DFN D Q -102 ; fatal error
. D MISMATCH^MAGDIRVE($T(+0),DFN,MAGGP)
. Q
;
; get the next file number and create the entry for this image
;
S IMAGECNT=$P($G(^MAG(2005,MAGGP,1,0)),"^",4)+1 ; next image # in group
;
K IMAGE S I=0
S I=I+1,IMAGE(I)=".01^"_PNAMEVAH_" "_DCMPID_" "_PROCDESC ; used in ^MAGDIR8
S I=I+1,IMAGE(I)="5^"_DFN
I $D(FILEDATA("SHORT DESCRIPTION")) D ; set in ^MAGDIR7F
. S I=I+1,IMAGE(I)="10^"_FILEDATA("SHORT DESCRIPTION")
. Q
E S I=I+1,IMAGE(I)="10^"_PROCDESC_" (#"_IMAGECNT_")" ; used in ^MAGDIR81
S I=I+1,IMAGE(I)="14^"_MAGGP
S I=I+1,IMAGE(I)="15^"_DATETIME
S I=I+1,IMAGE(I)="60^"_IMAGEUID
S I=I+1,IMAGE(I)=FILEDATA("EXTENSION") ; specify the image file extension
S:$D(FILEDATA("ABSTRACT")) I=I+1,IMAGE(I)=FILEDATA("ABSTRACT")
S I=I+1,IMAGE(I)="WRITE^PACS" ; select the PACS Image write location
S I=I+1,IMAGE(I)="3^"_FILEDATA("OBJECT TYPE")
S I=I+1,IMAGE(I)="6^"_FILEDATA("MODALITY")
S I=I+1,IMAGE(I)="16^"_FILEDATA("PARENT FILE")
S I=I+1,IMAGE(I)="17^"_FILEDATA("PARENT IEN")
S:$D(FILEDATA("PARENT FILE PTR")) I=I+1,IMAGE(I)="18^"_FILEDATA("PARENT FILE PTR")
S:$D(FILEDATA("RAD REPORT")) I=I+1,IMAGE(I)="61^"_FILEDATA("RAD REPORT")
S:$D(FILEDATA("RAD PROC PTR")) I=I+1,IMAGE(I)="62^"_FILEDATA("RAD PROC PTR")
I MODPARMS["/" D
. N EXTENSION
. S I=I+1
. S EXTENSION=$S($P(MODPARMS,"/",2)="<DICOM>":"DCM",1:"BIG")
. S IMAGE(I)="BIG^1^"_EXTENSION ; big file will be output
. Q
S I=I+1,IMAGE(I)="DICOMSN^"_SERINUMB ; series number
S I=I+1,IMAGE(I)="DICOMIN^"_IMAGNUMB ; image number
S I=I+1,IMAGE(I)=".05^"_INSTLOC
S I=I+1,IMAGE(I)="40^"_FILEDATA("PACKAGE")
S I=I+1,IMAGE(I)="41^"_$O(^MAG(2005.82,"B","CLIN",""))
S I=I+1,IMAGE(I)="42^"_FILEDATA("TYPE")
S I=I+1,IMAGE(I)="43^"_FILEDATA("PROC/EVENT")
S I=I+1,IMAGE(I)="44^"_FILEDATA("SPEC/SUBSPEC")
S I=I+1,IMAGE(I)="45^"_ORIGINDX
S I=I+1,IMAGE(I)="107^"_FILEDATA("ACQUISITION DEVICE")
S I=I+1,IMAGE(I)="110^"_STAMP
S I=I+1,IMAGE(I)="251^"_FILEDATA("SOP CLASS POINTER")
S I=I+1,IMAGE(I)="253^"_SERIEUID
D ADD^MAGGTIA(.RETURN,.IMAGE)
;
S IMAGEPTR=+RETURN
I 'IMAGEPTR D Q -103 ; fatal error
. K MSG
. S MSG(1)="IMAGE FILE CREATION ERROR:"
. S MSG(2)=$P(RETURN,"^",2,999)
. D BADERROR^MAGDIRVE($T(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
. Q
;
I IMAGEPTR<LASTIMG D Q -104 ; fatal last image pointer error
. D IMAGEPTR^MAGDIRVE($T(+0),IMAGEPTR,LASTIMG)
. Q
;
S $P(RETURN,"^",4)=$$CHKPATH() ; hierarchal file patch check
;
Q 0
;
CHKPATH() ; determine if the path is hierarchal (true) or not (false)
N D0,PATH
S D0="",PATH=$P(RETURN,"^",2)
I $D(^MAG(2005.2,"AC")) S D0=$O(^MAG(2005.2,"AC",PATH,""))
E D
. N PLACE
. S PLACE=""
. F S PLACE=$O(^MAG(2005.2,"E",PLACE)) Q:PLACE="" D Q:D0
. . S D0=$O(^MAG(2005.2,"E",PLACE,PATH,""))
. . Q
. Q
Q 'D0 ; network location file
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDIR9B 4615 printed Sep 23, 2025@19:36:40 Page 2
MAGDIR9B ;WOIFO/PMK/RRB - Read a DICOM image file ; 04 May 2010 8:25 AM
+1 ;;3.0;IMAGING;**11,51,50,54,53,99**;Mar 19, 2002;Build 2057;Apr 19, 2011
+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 QUIT
+18 ; Create an image entry in ^MAG(2005)
+19 ;
IMAGE() ; entry point from ^MAGDIR81 to create an image entry in ^MAG(2005)
+1 ;-------- scratch counter
NEW I
+2 ;---- image array for ^MAGGTIA
NEW IMAGE
+3 ;- counter of image in the group
NEW IMAGECNT
+4 ;- value returned by ^MAGGTIA
NEW IMAGEPTR
+5 ;
+6 ; check that the group has right object type and is for the same person
+7 ; fatal error
IF $PIECE($GET(^MAG(2005,MAGGP,0)),"^",6)'=11
Begin DoDot:1
+8 DO OBJECT^MAGDIRVE($TEXT(+0),MAGGP)
+9 QUIT
End DoDot:1
QUIT -101
+10 ;
+11 ; check that the group patient DFN matches the image patient DFN
+12 ; fatal error
IF $PIECE(^MAG(2005,MAGGP,0),"^",7)'=DFN
Begin DoDot:1
+13 DO MISMATCH^MAGDIRVE($TEXT(+0),DFN,MAGGP)
+14 QUIT
End DoDot:1
QUIT -102
+15 ;
+16 ; get the next file number and create the entry for this image
+17 ;
+18 ; next image # in group
SET IMAGECNT=$PIECE($GET(^MAG(2005,MAGGP,1,0)),"^",4)+1
+19 ;
+20 KILL IMAGE
SET I=0
+21 ; used in ^MAGDIR8
SET I=I+1
SET IMAGE(I)=".01^"_PNAMEVAH_" "_DCMPID_" "_PROCDESC
+22 SET I=I+1
SET IMAGE(I)="5^"_DFN
+23 ; set in ^MAGDIR7F
IF $DATA(FILEDATA("SHORT DESCRIPTION"))
Begin DoDot:1
+24 SET I=I+1
SET IMAGE(I)="10^"_FILEDATA("SHORT DESCRIPTION")
+25 QUIT
End DoDot:1
+26 ; used in ^MAGDIR81
IF '$TEST
SET I=I+1
SET IMAGE(I)="10^"_PROCDESC_" (#"_IMAGECNT_")"
+27 SET I=I+1
SET IMAGE(I)="14^"_MAGGP
+28 SET I=I+1
SET IMAGE(I)="15^"_DATETIME
+29 SET I=I+1
SET IMAGE(I)="60^"_IMAGEUID
+30 ; specify the image file extension
SET I=I+1
SET IMAGE(I)=FILEDATA("EXTENSION")
+31 if $DATA(FILEDATA("ABSTRACT"))
SET I=I+1
SET IMAGE(I)=FILEDATA("ABSTRACT")
+32 ; select the PACS Image write location
SET I=I+1
SET IMAGE(I)="WRITE^PACS"
+33 SET I=I+1
SET IMAGE(I)="3^"_FILEDATA("OBJECT TYPE")
+34 SET I=I+1
SET IMAGE(I)="6^"_FILEDATA("MODALITY")
+35 SET I=I+1
SET IMAGE(I)="16^"_FILEDATA("PARENT FILE")
+36 SET I=I+1
SET IMAGE(I)="17^"_FILEDATA("PARENT IEN")
+37 if $DATA(FILEDATA("PARENT FILE PTR"))
SET I=I+1
SET IMAGE(I)="18^"_FILEDATA("PARENT FILE PTR")
+38 if $DATA(FILEDATA("RAD REPORT"))
SET I=I+1
SET IMAGE(I)="61^"_FILEDATA("RAD REPORT")
+39 if $DATA(FILEDATA("RAD PROC PTR"))
SET I=I+1
SET IMAGE(I)="62^"_FILEDATA("RAD PROC PTR")
+40 IF MODPARMS["/"
Begin DoDot:1
+41 NEW EXTENSION
+42 SET I=I+1
+43 SET EXTENSION=$SELECT($PIECE(MODPARMS,"/",2)="<DICOM>":"DCM",1:"BIG")
+44 ; big file will be output
SET IMAGE(I)="BIG^1^"_EXTENSION
+45 QUIT
End DoDot:1
+46 ; series number
SET I=I+1
SET IMAGE(I)="DICOMSN^"_SERINUMB
+47 ; image number
SET I=I+1
SET IMAGE(I)="DICOMIN^"_IMAGNUMB
+48 SET I=I+1
SET IMAGE(I)=".05^"_INSTLOC
+49 SET I=I+1
SET IMAGE(I)="40^"_FILEDATA("PACKAGE")
+50 SET I=I+1
SET IMAGE(I)="41^"_$ORDER(^MAG(2005.82,"B","CLIN",""))
+51 SET I=I+1
SET IMAGE(I)="42^"_FILEDATA("TYPE")
+52 SET I=I+1
SET IMAGE(I)="43^"_FILEDATA("PROC/EVENT")
+53 SET I=I+1
SET IMAGE(I)="44^"_FILEDATA("SPEC/SUBSPEC")
+54 SET I=I+1
SET IMAGE(I)="45^"_ORIGINDX
+55 SET I=I+1
SET IMAGE(I)="107^"_FILEDATA("ACQUISITION DEVICE")
+56 SET I=I+1
SET IMAGE(I)="110^"_STAMP
+57 SET I=I+1
SET IMAGE(I)="251^"_FILEDATA("SOP CLASS POINTER")
+58 SET I=I+1
SET IMAGE(I)="253^"_SERIEUID
+59 DO ADD^MAGGTIA(.RETURN,.IMAGE)
+60 ;
+61 SET IMAGEPTR=+RETURN
+62 ; fatal error
IF 'IMAGEPTR
Begin DoDot:1
+63 KILL MSG
+64 SET MSG(1)="IMAGE FILE CREATION ERROR:"
+65 SET MSG(2)=$PIECE(RETURN,"^",2,999)
+66 DO BADERROR^MAGDIRVE($TEXT(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
+67 QUIT
End DoDot:1
QUIT -103
+68 ;
+69 ; fatal last image pointer error
IF IMAGEPTR<LASTIMG
Begin DoDot:1
+70 DO IMAGEPTR^MAGDIRVE($TEXT(+0),IMAGEPTR,LASTIMG)
+71 QUIT
End DoDot:1
QUIT -104
+72 ;
+73 ; hierarchal file patch check
SET $PIECE(RETURN,"^",4)=$$CHKPATH()
+74 ;
+75 QUIT 0
+76 ;
CHKPATH() ; determine if the path is hierarchal (true) or not (false)
+1 NEW D0,PATH
+2 SET D0=""
SET PATH=$PIECE(RETURN,"^",2)
+3 IF $DATA(^MAG(2005.2,"AC"))
SET D0=$ORDER(^MAG(2005.2,"AC",PATH,""))
+4 IF '$TEST
Begin DoDot:1
+5 NEW PLACE
+6 SET PLACE=""
+7 FOR
SET PLACE=$ORDER(^MAG(2005.2,"E",PLACE))
if PLACE=""
QUIT
Begin DoDot:2
+8 SET D0=$ORDER(^MAG(2005.2,"E",PLACE,PATH,""))
+9 QUIT
End DoDot:2
if D0
QUIT
+10 QUIT
End DoDot:1
+11 ; network location file
QUIT 'D0
+12 ;
