| 1 | MAGDIR81 ;WOIFO/PMK - Read a DICOM image file ; 24 Jan 2006  13:30 PM
 | 
|---|
| 2 |  ;;3.0;IMAGING;**11,30,51,50,46**;16-February-2007;;Build 1023
 | 
|---|
| 3 |  ;; Per VHA Directive 2004-038, this routine should not be modified.
 | 
|---|
| 4 |  ;; +---------------------------------------------------------------+
 | 
|---|
| 5 |  ;; | Property of the US Government.                                |
 | 
|---|
| 6 |  ;; | No permission to copy or redistribute this software is given. |
 | 
|---|
| 7 |  ;; | Use of unreleased versions of this software requires the user |
 | 
|---|
| 8 |  ;; | to execute a written test agreement with the VistA Imaging    |
 | 
|---|
| 9 |  ;; | Development Office of the Department of Veterans Affairs,     |
 | 
|---|
| 10 |  ;; | telephone (301) 734-0100.                                     |
 | 
|---|
| 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 is invoked by the ^MAGDIR8 for the "STORE1/STORE2"
 | 
|---|
| 22 |  ; REQUEST items when there is an image to be stored into the database.
 | 
|---|
| 23 |  ; It adds it to the ^MAG global with appropriate pointers to the
 | 
|---|
| 24 |  ; "parent data files".
 | 
|---|
| 25 |  ;
 | 
|---|
| 26 | ENTRY ; process one image
 | 
|---|
| 27 |  N MEDATA ;--- medicine pkg patient & study data (set in ^MAGDIR8A)
 | 
|---|
| 28 |  N FILEDATA ;- array of data to be passed between routines
 | 
|---|
| 29 |  N FIRSTDCM ;- patient first name from the image header (ie, PNAMEDCM)
 | 
|---|
| 30 |  N GMRCIEN ;-- internal entry number of consult/procedure request
 | 
|---|
| 31 |  N LASTDCM ;-- patient last name from the image header (ie, PNAMEDCM)
 | 
|---|
| 32 |  N MAGGP ;---- image's group pointer in ^MAG(2005)
 | 
|---|
| 33 |  N MAGIEN ;--- pointer to the entry for the image in ^MAG(2005)
 | 
|---|
| 34 |  N MIDCM ;---- patient middle initial from the image header (PNAMEDCM)
 | 
|---|
| 35 |  N PNAMEVAH ;- patient name from VADM(1)
 | 
|---|
| 36 |  N PROCDESC ;- procedure description (VA's name)
 | 
|---|
| 37 |  N RADATA ;--- radiology pkg patient & study data (set in ^MAGDIR8A)
 | 
|---|
| 38 |  N VADM ;----- array of demographic variables filled in by DEM^VADPT
 | 
|---|
| 39 |  N I,MAG0,MAG1,MAG2,QUIT,X
 | 
|---|
| 40 |  ;
 | 
|---|
| 41 |  N ACNUMB,CASENUMB,EMAIL,FROMPATH,IMAGEUID,IMAGNAME,IMAGNUMB,IMGSVC
 | 
|---|
| 42 |  N INSTLOC,INSTNAME,LASTIMG,LOCATION,MACHID,MFGR,MODALITY,MODEL,MODPARMS
 | 
|---|
| 43 |  N MULTFRAM,PID,PNAMEDCM,ROUTRULE,SERINUMB,SERIEUID,SOPCLASS,STATUS
 | 
|---|
| 44 |  N STUDYDAT,STUDYTIM,STUDYDAT,STUDYTIM,STUDYUID,SYSTITLE
 | 
|---|
| 45 |  ;
 | 
|---|
| 46 |  S STATUS=$P(ARGS,"|",1),LOCATION=$P(ARGS,"|",2)
 | 
|---|
| 47 |  S MACHID=$P(ARGS,"|",3),IMGSVC=$P(ARGS,"|",4)
 | 
|---|
| 48 |  S INSTNAME=$P(ARGS,"|",5),FROMPATH=$P(ARGS,"|",6)
 | 
|---|
| 49 |  S PID=$P(ARGS,"|",7),PNAMEDCM=$P(ARGS,"|",8)
 | 
|---|
| 50 |  S CASENUMB=$P(ARGS,"|",9),ACNUMB=$P(ARGS,"|",10)
 | 
|---|
| 51 |  S STUDYDAT=$P(ARGS,"|",11),STUDYTIM=$P(ARGS,"|",12)
 | 
|---|
| 52 |  S MODALITY=$P(ARGS,"|",14)
 | 
|---|
| 53 |  S IMAGNAME=$P(ARGS,"|",15),MODPARMS=$P(ARGS,"|",16)
 | 
|---|
| 54 |  S SERINUMB=$P(ARGS,"|",17),IMAGNUMB=$P(ARGS,"|",18)
 | 
|---|
| 55 |  S INSTLOC=$P(ARGS,"|",19),MULTFRAM=$P(ARGS,"|",20)
 | 
|---|
| 56 |  S SYSTITLE=$P(ARGS,"|",21),EMAIL=$P(ARGS,"|",22)
 | 
|---|
| 57 |  S IREQUEST=IREQUEST+1,OPCODE=$P(REQUEST(IREQUEST),"|")
 | 
|---|
| 58 |  I OPCODE'="STORE2" D  Q
 | 
|---|
| 59 |  . D RESULT^MAGDIR8("STORE","-101 Expecting STORE2, got """_OPCODE_"""")
 | 
|---|
| 60 |  . Q
 | 
|---|
| 61 |  S ARGS=$P(REQUEST(IREQUEST),"|",2,999)
 | 
|---|
| 62 |  S STUDYUID=$P(ARGS,"|",1),SERIEUID=$P(ARGS,"|",2)
 | 
|---|
| 63 |  S IMAGEUID=$P(ARGS,"|",3),SOPCLASS=$P(ARGS,"|",4)
 | 
|---|
| 64 |  S LASTIMG=$P(ARGS,"|",5),ROUTRULE=$P(ARGS,"|",6)
 | 
|---|
| 65 |  S MFGR=$P(ARGS,"|",7),MODEL=$P(ARGS,"|",8)
 | 
|---|
| 66 |  ;
 | 
|---|
| 67 |  ; get a pointer to the image, if it is already on file
 | 
|---|
| 68 |  S MAGIEN=$O(^MAG(2005,"P",IMAGEUID,0))
 | 
|---|
| 69 |  ;
 | 
|---|
| 70 |  ; the following line will have to be adjusted for DICOM SR
 | 
|---|
| 71 |  S FILEDATA("TYPE")=$O(^MAG(2005.83,"B","IMAGE",""))
 | 
|---|
| 72 |  ;
 | 
|---|
| 73 |  I MULTFRAM,MAGIEN D  ; subsequent image of a multiframe object
 | 
|---|
| 74 |  . D MULTFRAM ; require both MULTFRAM and MAGIEN to be non-zero
 | 
|---|
| 75 |  . Q
 | 
|---|
| 76 |  E  D  Q:ERRCODE  ; new image
 | 
|---|
| 77 |  . S ERRCODE=$$NEWIMAGE()
 | 
|---|
| 78 |  . I ERRCODE D  ; error - abort image processing
 | 
|---|
| 79 |  . . D ERROR^MAGDIR8("STORE",ERRCODE,.MSG,$T(+0))
 | 
|---|
| 80 |  . . Q
 | 
|---|
| 81 |  . Q
 | 
|---|
| 82 |  ;
 | 
|---|
| 83 |  ;create the image pointer
 | 
|---|
| 84 |  I MODPARMS="<DICOM>" D  ; store DICOM image type in VistA
 | 
|---|
| 85 |  . S FILEDATA("OBJECT TYPE")=100 ; DICOM image type
 | 
|---|
| 86 |  . S FILEDATA("EXTENSION")="EXT^DCM" ; specify the DICOM file extension
 | 
|---|
| 87 |  . Q
 | 
|---|
| 88 |  E  D  ; convert DICOM image type to TGA and store it in VistA
 | 
|---|
| 89 |  . S FILEDATA("OBJECT TYPE")=3 ; XRAY image type
 | 
|---|
| 90 |  . S FILEDATA("EXTENSION")="EXT^TGA" ; specify the TGA file extension
 | 
|---|
| 91 |  . Q
 | 
|---|
| 92 |  S FILEDATA("ABSTRACT")="ABS^STUFFONLY" ; specify the abstract net loc
 | 
|---|
| 93 |  ;
 | 
|---|
| 94 |  S ERRCODE=$$IMAGE^MAGDIR9B ; create the ^MAG(2005) entry for the image
 | 
|---|
| 95 |  I ERRCODE D  ; error - abort image processing
 | 
|---|
| 96 |  . D ERROR^MAGDIR8("STORE",ERRCODE,.MSG,$T(+0))
 | 
|---|
| 97 |  . Q
 | 
|---|
| 98 |  E  D  ; no error
 | 
|---|
| 99 |  . S X="0|"_RETURN
 | 
|---|
| 100 |  . ; save pname, pid, dob, age, and sex from DEM^VADPT for gateway
 | 
|---|
| 101 |  . F I=1:1:5 S X=X_"|"_VADM(I)
 | 
|---|
| 102 |  . S X=X_"|"_$$GETICN^MPIF001(DFN) ; save ICN value
 | 
|---|
| 103 |  . D RESULT^MAGDIR8("STORE",X)
 | 
|---|
| 104 |  . Q
 | 
|---|
| 105 |  Q
 | 
|---|
| 106 |  ;
 | 
|---|
| 107 | NEWIMAGE() ; processing for a new image
 | 
|---|
| 108 |  N ERRORMSG ;- error message causing processing to stop
 | 
|---|
| 109 |  N PIDCHECK ;- return value of from $$PIDCHECK^MAGDIR8A()
 | 
|---|
| 110 |  ;
 | 
|---|
| 111 |  I MAGIEN D  I $L(ERRORMSG) Q ERRORMSG
 | 
|---|
| 112 |  . K MSG
 | 
|---|
| 113 |  . N Y
 | 
|---|
| 114 |  . I IMAGEUID=$$GETUID(MACHID) D  ; same image as last one
 | 
|---|
| 115 |  . . ; process the image again, after software crash
 | 
|---|
| 116 |  . . ; If the software crashed processing the first image, it might
 | 
|---|
| 117 |  . . ; delete the image without ever writing it to the file server.
 | 
|---|
| 118 |  . . ; Now, the image processing software has a second chance.
 | 
|---|
| 119 |  . . S Y=$P($G(^MAG(2005,MAGIEN,2)),"^") I Y D DD^%DT
 | 
|---|
| 120 |  . . S MSG(1)="Reprocessing image """_FROMPATH_""""
 | 
|---|
| 121 |  . . S MSG(2)="which is partially in the database (#"_MAGIEN_") for"
 | 
|---|
| 122 |  . . S MSG(3)=""""_$P($G(^MAG(2005,MAGIEN,0)),"^")_""""
 | 
|---|
| 123 |  . . S MSG(4)="Acquired on "_Y
 | 
|---|
| 124 |  . . S MSG(5)="UID = "_IMAGEUID
 | 
|---|
| 125 |  . . D ERROR^MAGDIR8("STORE","1 Image partially in the database",.MSG,$T(+0))
 | 
|---|
| 126 |  . . S ERRORMSG="" ; this is not an error!
 | 
|---|
| 127 |  . . Q
 | 
|---|
| 128 |  . E  D  ; don't accept images with duplicate UIDs
 | 
|---|
| 129 |  . . S Y=$P($G(^MAG(2005,MAGIEN,2)),"^") I Y D DD^%DT
 | 
|---|
| 130 |  . . S MSG(1)="Image """_FROMPATH_""""
 | 
|---|
| 131 |  . . S MSG(2)="is already in the database (#"_MAGIEN_") for"
 | 
|---|
| 132 |  . . S MSG(3)=""""_$P($G(^MAG(2005,MAGIEN,0)),"^")_""""
 | 
|---|
| 133 |  . . S MSG(4)="Acquired on "_Y
 | 
|---|
| 134 |  . . S MSG(5)="UID = "_IMAGEUID
 | 
|---|
| 135 |  . . S ERRORMSG="-1 Image already in database"
 | 
|---|
| 136 |  . . Q
 | 
|---|
| 137 |  . Q
 | 
|---|
| 138 |  ;
 | 
|---|
| 139 |  D SAVEUID(MACHID,IMAGEUID) ; record the UID of the image being processed
 | 
|---|
| 140 |  ;
 | 
|---|
| 141 |  ; lookup the study by ACNUMB/CASENUMB, get DFN, and double-check PID
 | 
|---|
| 142 |  S ERRCODE=$$LOOKUP Q:ERRCODE ERRCODE
 | 
|---|
| 143 |  ;
 | 
|---|
| 144 |  S PIDCHECK=$$PIDCHECK^MAGDIR8A()
 | 
|---|
| 145 |  I PIDCHECK D  Q "-2 Image Association Problem" ; didn't find the study
 | 
|---|
| 146 |  . N CASETEXT,COLUMNS,MFGR,MODEL,MODIEN,OFFSET,ROWS
 | 
|---|
| 147 |  . ; formulate error message
 | 
|---|
| 148 |  . K MSG
 | 
|---|
| 149 |  . S MSG(1)=PIDCHECK
 | 
|---|
| 150 |  . S (ROWS,COLUMNS,OFFSET,MODIEN,MFGR,MODEL,CASETEXT)=""
 | 
|---|
| 151 |  . D MOVE^MAGDLBAA
 | 
|---|
| 152 |  . Q
 | 
|---|
| 153 |  ; create the group pointer
 | 
|---|
| 154 |  I IMGSVC="RAD" D  Q:ERRCODE ERRCODE
 | 
|---|
| 155 |  . S ERRCODE=$$GROUP^MAGDIR9A
 | 
|---|
| 156 |  . Q
 | 
|---|
| 157 |  E  I IMGSVC="CON" D  Q:ERRCODE ERRCODE
 | 
|---|
| 158 |  . S ERRCODE=$$GROUP^MAGDIR9E
 | 
|---|
| 159 |  . Q
 | 
|---|
| 160 |  E  D  Q 3  ; undefined imaging service - same as error #4 in LOOKUP
 | 
|---|
| 161 |  . K MSG
 | 
|---|
| 162 |  . S MSG(1)="Undefined Imaging Service: "_IMGSVC
 | 
|---|
| 163 |  . D ERROR^MAGDIRVE($T(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
 | 
|---|
| 164 |  . Q
 | 
|---|
| 165 |  Q 0
 | 
|---|
| 166 |  ;
 | 
|---|
| 167 | SAVEUID(MACHID,UID) ; record the UID of the image being processed
 | 
|---|
| 168 |  N D0,X
 | 
|---|
| 169 |  S D0=$O(^MAGD(2006.5715,"B",MACHID,"")) D:'D0
 | 
|---|
| 170 |  . L +^MAGD(2006.5715):1E9 ; Background process MUST wait
 | 
|---|
| 171 |  . S D0=$O(^MAGD(2006.5715," "),-1)+1
 | 
|---|
| 172 |  . S X=$G(^MAGD(2006.5715,0))
 | 
|---|
| 173 |  . S $P(X,"^",1,2)="CURRENT IMAGE^2006.5715"
 | 
|---|
| 174 |  . S $P(X,"^",3)=D0
 | 
|---|
| 175 |  . S $P(X,"^",4)=$P(X,"^",4)+1
 | 
|---|
| 176 |  . S ^MAGD(2006.5715,0)=X
 | 
|---|
| 177 |  . S ^MAGD(2006.5715,D0,0)=MACHID
 | 
|---|
| 178 |  . S ^MAGD(2006.5715,"B",MACHID,D0)=""
 | 
|---|
| 179 |  . L -^MAGD(2006.5715)
 | 
|---|
| 180 |  . Q
 | 
|---|
| 181 |  S $P(^MAGD(2006.5715,D0,0),"^",2)=UID
 | 
|---|
| 182 |  Q
 | 
|---|
| 183 |  ;
 | 
|---|
| 184 | GETUID(MACHID) ; lookup the UID of the last image processed
 | 
|---|
| 185 |  N D0
 | 
|---|
| 186 |  S D0=+$O(^MAGD(2006.5715,"B",MACHID,""))
 | 
|---|
| 187 |  Q $P($G(^MAGD(2006.5715,D0,0)),"^",2)
 | 
|---|
| 188 |  ;
 | 
|---|
| 189 | MULTFRAM ; Handle additional images in a multiframe object
 | 
|---|
| 190 |  ; Get the information from the first image for the additional ones
 | 
|---|
| 191 |  ;
 | 
|---|
| 192 |  N DIQUIET,INAME,MAG0,MAG40,MAG100,MAGPACS
 | 
|---|
| 193 |  N SOPCLASP ; pointer to SOP Class file (#2006.532)
 | 
|---|
| 194 |  S MAG0=^MAG(2005,MAGIEN,0),MAG1=$G(^(1)),MAG2=$G(^(2))
 | 
|---|
| 195 |  S MAG40=$G(^MAG(2005,MAGIEN,40)),MAG100=$G(^(100))
 | 
|---|
| 196 |  S MAGPACS=$G(^MAG(2005,MAGIEN,"PACS"))
 | 
|---|
| 197 |  S INAME=$P(MAG0,"^",1) ; field .01
 | 
|---|
| 198 |  S PNAMEVAH=$P(INAME,"  ",1),DCMPID=$P(INAME,"  ",2)
 | 
|---|
| 199 |  S DFN=$P(MAG0,"^",7) ; field 5
 | 
|---|
| 200 |  S MAGGP=$P(MAG0,"^",10) ; field 14
 | 
|---|
| 201 |  S DATETIME=$P(MAG2,"^",5) ; field 15
 | 
|---|
| 202 |  S FILEDATA("MODALITY")=MODALITY
 | 
|---|
| 203 |  S FILEDATA("PARENT FILE")=$P(MAG2,"^",6) ; field 16
 | 
|---|
| 204 |  S FILEDATA("PARENT IEN")=$P(MAG2,"^",7) ; field 17
 | 
|---|
| 205 |  S FILEDATA("PARENT FILE PTR")=$P(MAG2,"^",8) ; field 18
 | 
|---|
| 206 |  S FILEDATA("RAD REPORT")=$P(MAGPACS,"^",2) ; field 61
 | 
|---|
| 207 |  S FILEDATA("RAD PROC PTR")=$P(MAGPACS,"^",3) ; field 62
 | 
|---|
| 208 |  S FILEDATA("PACKAGE")=$P(MAG40,"^",1) ; field 40
 | 
|---|
| 209 |  ; field 41 is not needed
 | 
|---|
| 210 |  S FILEDATA("TYPE")=$P(MAG40,"^",3) ; field 42
 | 
|---|
| 211 |  S FILEDATA("PROC/EVENT")=$P(MAG40,"^",4) ; field 43
 | 
|---|
| 212 |  S FILEDATA("SPEC/SUBSPEC")=$P(MAG40,"^",5) ; field 44
 | 
|---|
| 213 |  S FILEDATA("ACQUISITION DEVICE")=$P(MAG100,"^",4) ; field 107
 | 
|---|
| 214 |  ; get the SOP Class pointer (file 2005, field 251)
 | 
|---|
| 215 |  S SOPCLASP=$O(^MAG(2006.532,"B",SOPCLASS,""))
 | 
|---|
| 216 |  S FILEDATA("SOP CLASS POINTER")=SOPCLASP
 | 
|---|
| 217 |  S PROCDESC=$P(MAG2,"^",4) ; field 10
 | 
|---|
| 218 |  ; S X="" F  S X=$O(FILEDATA(X)) Q:X=""  I FILEDATA(X)="" K FILEDATA(X)
 | 
|---|
| 219 |  I PROCDESC?.E1" (#".N1")" S PROCDESC=$P(PROCDESC," (#")
 | 
|---|
| 220 |  ; lookup patient in VistA database - needed to build VADM array
 | 
|---|
| 221 |  S DIQUIET=1 D DEM^VADPT
 | 
|---|
| 222 |  Q
 | 
|---|
| 223 |  ;
 | 
|---|
| 224 | LOOKUP() ; lookup the patient/study using cross-reference
 | 
|---|
| 225 |  I IMGSVC="RAD" D
 | 
|---|
| 226 |  . D RADLKUP^MAGDIR8A
 | 
|---|
| 227 |  . Q
 | 
|---|
| 228 |  E  I IMGSVC="CON" D
 | 
|---|
| 229 |  . S ACNUMB=CASENUMB
 | 
|---|
| 230 |  . D CONLKUP^MAGDIR8A
 | 
|---|
| 231 |  . Q
 | 
|---|
| 232 |  E  D  Q 4 ; undefined imaging service - same as error #3 in NEWIMAGE
 | 
|---|
| 233 |  . K MSG
 | 
|---|
| 234 |  . S MSG(1)="Undefined Imaging Service: "_IMGSVC
 | 
|---|
| 235 |  . D ERROR^MAGDIRVE($T(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
 | 
|---|
| 236 |  . Q
 | 
|---|
| 237 |  Q 0
 | 
|---|