source: FOIAVistA/trunk/r/IMAGING-MAG-ZMAG/MAGDIR9A.m@ 1203

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

initial load of FOIAVistA 6/30/08 version
File size: 7.2 KB
Line 
1MAGDIR9A ;WOIFO/PMK - Read a DICOM image file ; 09 Feb 2006 7:38 AM
2 ;;3.0;IMAGING;**11,30,51,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 creates a ^mag(2005) group entry and links it to the
22 ; associated radiology report
23 ;
24 ; XXXXXX XX XXXXXX
25 ; XX XX XXXX XX XX
26 ; XX XX XX XX XX XX
27 ; XXXXX XX XX XX XX
28 ; XX XX XXXXXX XX XX
29 ; XX XX XX XX XX XX
30 ; XXX XX XX XX XXXXXX
31 ;
32GROUP() ; entry point from ^MAGDIR81
33 N ACQDEVP ;-- pointer to acquisition device file (#2006.04)
34 N DA ;------ fileman variable
35 N ERRCODE ;- error trap code
36 N GROUP ;--- array to pass group data to ^MAGGTIA
37 N GROUPDFN ; DFN value from image group entry for double checking
38 N P ;-------- scratch variable (pointer to ACQUISITION DEVICE file)
39 N RACNE ;--- external "3rd level" subscript in ^RADPT
40 N RACNI ;--- internal "3rd level" subscript in ^RADPT
41 N RADFN ;--- radiology package's DFN
42 N RADTE ;--- external "2nd level" subscript in ^RADPT
43 N RADTI ;--- internal "2nd level" subscript in ^RADPT
44 N RARPT ;--- 1st level node in ^RARPT for report (ie, the ien)
45 N RARPT3 ;-- 3rd level node for 2005 multiple under ^RARPT's report
46 N RARPTDFN ; DFN value from ^RARPT for double checking
47 N SOPCLASP ; pointer to SOP Class file (#2006.532)
48 N HIT,ISPECIDX,X,Y ; scratch variables
49 ;
50 S ERRCODE=""
51 ;
52 S (RADFN,DA(2))=DFN ; patient DFN variables
53 S RADTI=RADATA("RADPT2") ; case subscript
54 I RADTI="" D Q ERRCODE
55 . K MSG
56 . S MSG(1)="No radiology case number specified for patient "_DFN
57 . D ERROR^MAGDIRVE($T(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
58 . S ERRCODE=-301
59 . Q
60 ;
61 S RADTE=$TR(RADATA("RADPT2"),"0123456789","9876543210")
62 S RACNI=RADATA("RADPT3")
63 S RACNE=$S(CASENUMB["-":$P(CASENUMB,"-",2),1:CASENUMB) ; short case #
64 ;
65 ; check for the existence of the entry in ^RADPT (redundant)
66 I '$D(^RADPT(RADFN,"DT",RADTI,0)) D Q ERRCODE ; can't process further
67 . K MSG
68 . S MSG(1)="Radiology case "_RADTI_" is not in ^RADPT("_RADFN_")"
69 . D ERROR^MAGDIRVE($T(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
70 . S ERRCODE=-302
71 . Q
72 ;
73 ; check for the existence of the report pointer
74 S RARPT=$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),"^",17)
75 ; if the report does not yet exist, create it
76 D:RARPT=""
77 . N RACN
78 . S RACN=RACNE D CREATE^RARIC ; create the report
79 . Q
80 ;
81 ; If RARPT is no longer defined at this point, this means
82 ; that we're dealing with an old study, and the report has
83 ; been archived and purged.
84 ;
85 I '$G(RARPT) D Q ERRCODE
86 . K MSG
87 . S MSG(1)="IMAGE GROUP CREATION ERROR:"
88 . S MSG(2)="Radiology Report has been archived and purged."
89 . S MSG(3)="Patient "_$G(RADFN)_", Date "_$G(RADTI)_", Case "_$G(RACNI)
90 . D ERROR^MAGDIRVE($T(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
91 . S ERRCODE=-303
92 . Q
93 ;
94 ; double check the DFN value from ^RARPT to make sure its right
95 S RARPTDFN=$P($G(^RARPT(RARPT,0)),"^",2)
96 I RARPTDFN'=DFN D Q ERRCODE ; fatal error
97 . D RADMISS^MAGDIRVE($T(+0),DFN,RARPT,RARPTDFN)
98 . S ERRCODE=-304
99 . Q
100 ;
101 ; initialize FILEDATA for GROUP and IMAGE
102 ; get the acquisition device pointer (file 2005, field 107)
103 S ACQDEVP=$$ACQDEV^MAGDFCNV(MFGR,MODEL,INSTLOC)
104 S FILEDATA("ACQUISITION DEVICE")=ACQDEVP
105 ; get the SOP Class pointer (file 2005, field 251)
106 S SOPCLASP=$O(^MAG(2006.532,"B",SOPCLASS,""))
107 S FILEDATA("SOP CLASS POINTER")=SOPCLASP
108 ;
109 S FILEDATA("MODALITY")=MODALITY
110 S FILEDATA("PARENT FILE")=74
111 S FILEDATA("PARENT IEN")=RARPT
112 S FILEDATA("RAD REPORT")=RARPT
113 S FILEDATA("RAD PROC PTR")=RADATA("PROCIEN")
114 S FILEDATA("PACKAGE")="RAD"
115 S X=$S(MODALITY="NM":"NUCLEAR MEDICINE",1:"RADIOLOGY")
116 S ISPECIDX=$O(^MAG(2005.84,"B",X,""))
117 S X=$$FIELD43^MAGXMA(MODALITY,ISPECIDX,.Y)
118 S FILEDATA("PROC/EVENT")=$S(X=0:Y,1:"")
119 S FILEDATA("SPEC/SUBSPEC")=ISPECIDX
120 ;
121 ; find the corresponding image group node under the report
122 S (HIT,RARPT3)=0
123 F S RARPT3=$O(^RARPT(RARPT,2005,RARPT3)) Q:'RARPT3 D Q:HIT Q:ERRCODE
124 . S MAGGP=+$G(^RARPT(RARPT,2005,RARPT3,0)) ; get imaging group pointer
125 . S GROUPDFN=$P($G(^MAG(2005,MAGGP,0)),"^",7) ; check image DFN value
126 . I GROUPDFN'=DFN D ; fatal error
127 . . D MISMATCH^MAGDIRVE($T(+0),DFN,MAGGP)
128 . . S ERRCODE=-305
129 . . Q
130 . E I $P($G(^MAG(2005,MAGGP,0)),"^",6)=11 D
131 . . ; check to see that this group is for the same SOP Class
132 . . S P=$P($G(^MAG(2005,MAGGP,"SOP")),"^",1)
133 . . S HIT=$$EQUIVGRP^MAGDFCNV(P,SOPCLASP) ; equivalent groups?
134 . . Q
135 . Q
136 ;
137 I ERRCODE Q ERRCODE ; fatal image DFN problem
138 ;
139 I 'HIT D Q:ERRCODE ERRCODE ; the 2005 node does not yet exist
140 . ; create the radiology imaging group
141 . N PROCEDUR,RADRPT,RADPTR
142 . S PROCEDUR="RAD "_FILEDATA("MODALITY")
143 . S RADRPT=FILEDATA("RAD REPORT")
144 . S RADPTR=FILEDATA("RAD PROC PTR")
145 . D NEWGROUP(PROCEDUR,RADRPT,RADPTR) Q:ERRCODE
146 . ;
147 . ; store the cross-reference for the report
148 . D PTR^RARIC
149 . Q
150 ;
151 I 'MAGGP D Q ERRCODE ; fatal error
152 . K MSG
153 . S MSG(1)="IMAGE GROUP LOOKUP ERROR:"
154 . S MSG(2)="Looking for 2005 cross reference in ^RARPT("_RARPT_")"
155 . D ERROR^MAGDIRVE($T(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
156 . S ERRCODE=-308
157 . Q
158 Q 0
159 ;
160NEWGROUP(PROCEDUR,RADRPT,RADPTR) ; create an imaging group (called by ^MAGDIR9E)
161 K GROUP
162 S GROUP(1)=".01^"_PNAMEVAH_" "_DCMPID_" "_PROCDESC
163 S GROUP(2)="3^11" ; Object Type -- XRAY Group
164 S GROUP(3)="5^"_DFN
165 S GROUP(4)="6^"_PROCEDUR
166 S GROUP(5)="2005.04^0"
167 S GROUP(6)="10^"_PROCDESC
168 S GROUP(7)="15^"_DATETIME
169 S GROUP(8)="16^"_FILEDATA("PARENT FILE")
170 S GROUP(9)="17^"_FILEDATA("PARENT IEN")
171 S GROUP(10)="60^"_STUDYUID
172 ;
173 ; the following two fields are only for radiology
174 I $D(RADRPT) S GROUP(11)="61^"_RADRPT
175 I $D(RADPTR) S GROUP(12)="62^"_RADPTR
176 ;
177 S GROUP(13)=".05^"_INSTLOC
178 S GROUP(14)="40^"_FILEDATA("PACKAGE")
179 S GROUP(15)="41^"_$O(^MAG(2005.82,"B","CLIN",""))
180 S GROUP(16)="42^"_FILEDATA("TYPE")
181 S GROUP(17)="43^"_FILEDATA("PROC/EVENT")
182 S GROUP(18)="44^"_FILEDATA("SPEC/SUBSPEC")
183 S GROUP(19)="107^"_FILEDATA("ACQUISITION DEVICE")
184 S GROUP(20)="251^"_FILEDATA("SOP CLASS POINTER")
185 D ADD^MAGGTIA(.RETURN,.GROUP)
186 S MAGGP=+RETURN
187 I 'MAGGP D Q ; fatal error
188 . K MSG
189 . S MSG(1)="IMAGE GROUP CREATION ERROR:"
190 . S MSG(2)=$P(RETURN,"^",2,999)
191 . D BADERROR^MAGDIRVE($T(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
192 . S ERRCODE=-306
193 . Q
194 ;
195 I MAGGP<LASTIMG D Q ; fatal last image pointer error
196 . D GROUPPTR^MAGDIRVE($T(+0),MAGGP,LASTIMG)
197 . S ERRCODE=-307
198 . Q
199 Q
200 ;
Note: See TracBrowser for help on using the repository browser.