source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGDIR81.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 9.4 KB
Line 
1MAGDIR81 ;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 ;
26ENTRY ; 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 ;
107NEWIMAGE() ; 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 ;
167SAVEUID(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 ;
184GETUID(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 ;
189MULTFRAM ; 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 ;
224LOOKUP() ; 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
Note: See TracBrowser for help on using the repository browser.