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