| 1 | MAGDIR9A ;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 | ; | 
|---|
| 32 | GROUP() ; 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 | ; | 
|---|
| 160 | NEWGROUP(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 | ; | 
|---|