MAGDIR9A ;WOIFO/PMK/RRB - Read a DICOM image file ; 03 Jul 2013 9:15 AM
;;3.0;IMAGING;**11,30,51,46,54,53,49,99,138**;Mar 19, 2002;Build 5380;Sep 03, 2013
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
Q
; M2MB server
;
; This routine creates a ^mag(2005) group entry and links it to the
; associated radiology report
;
; XXXXXX XX XXXXXX
; XX XX XXXX XX XX
; XX XX XX XX XX XX
; XXXXX XX XX XX XX
; XX XX XXXXXX XX XX
; XX XX XX XX XX XX
; XXX XX XX XX XXXXXX
;
GROUP() ; entry point from ^MAGDIR81
N ACQDEVP ;-- pointer to acquisition device file (#2006.04)
N DA ;------ fileman variable
N ERRCODE ;- error trap code
N GROUP ;--- array to pass group data to ^MAGGTIA
N GROUPDFN ; DFN value from image group entry for double checking
N P ;------- scratch variable (pointer to ACQUISITION DEVICE file)
N RACNE ;--- external "3rd level" subscript in ^RADPT
N RACNI ;--- internal "3rd level" subscript in ^RADPT
N RADFN ;--- radiology package's DFN
N RADTE ;--- external "2nd level" subscript in ^RADPT
N RADTI ;--- internal "2nd level" subscript in ^RADPT
N RARPT ;--- 1st level node in ^RARPT for report (ie, the ien)
N RARPT3 ;-- 3rd level node for 2005 multiple under ^RARPT's report
N RARPTDFN ; DFN value from ^RARPT for double checking
N RETURN ;-- variable returned by ^MAGGTIA
N SOPCLASP ; pointer to SOP Class file (#2006.532)
N HIT,ISPECIDX,X,Y ; scratch variables
;
S ERRCODE=""
;
S (RADFN,DA(2))=DFN ; patient DFN variables
S RADTI=RADATA("RADPT2") ; case subscript
I RADTI="" D Q ERRCODE
. K MSG
. S MSG(1)="No radiology case number specified for patient "_DFN
. D ERROR^MAGDIRVE($T(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
. S ERRCODE=-301
. Q
;
S RADTE=9999999.9999-RADTI ; 9's complement conversion
S RACNI=RADATA("RADPT3")
S RACNE=$P(CASENUMB,"-",$L(CASENUMB,"-")) ; short case #
;
; check for the existence of the entry in ^RADPT (redundant)
I '$D(^RADPT(RADFN,"DT",RADTI,0)) D Q ERRCODE ; can't process further
. K MSG
. S MSG(1)="Radiology case "_RADTI_" is not in ^RADPT("_RADFN_")"
. D ERROR^MAGDIRVE($T(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
. S ERRCODE=-302
. Q
;
; check for the existence of the report pointer
S RARPT=$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),"^",17)
; if the report does not yet exist, create it
;
I RARPT="" D Q:ERRCODE ERRCODE ; can't process further
. N RACN,RATIMEOUT
. S RATIMEOUT=1
. S RACN=RACNE D CREATE^RARIC ; create the report
. ;
. I RARPT="-1^radiology exam locked" S ERRCODE="-399^"_$P(RARPT,"^",2) Q
. ;
. ; If RARPT is no longer defined at this point, this means
. ; that we're dealing with an old study, and the report has
. ; been archived and purged.
. ;
. I '$G(RARPT) D Q
. . K MSG
. . S MSG(1)="IMAGE GROUP CREATION ERROR:"
. . S MSG(2)="Radiology Report has been archived and purged."
. . S MSG(3)="Patient "_$G(RADFN)_", 9's Complement Date "_$G(RADTI)_", Case "_$G(RACNI)
. . D ERROR^MAGDIRVE($T(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
. . S ERRCODE=-303
. . Q
. Q
;
; double check the DFN value from ^RARPT to make sure its right
S RARPTDFN=$P($G(^RARPT(RARPT,0)),"^",2)
I RARPTDFN'=DFN D Q ERRCODE ; fatal error
. D RADMISS^MAGDIRVE($T(+0),DFN,RARPT,RARPTDFN)
. S ERRCODE=-304
. Q
;
; initialize FILEDATA for GROUP and IMAGE
; get the acquisition device pointer (file 2005, field 107)
S ACQDEVP=$$ACQDEV^MAGDFCNV(MFGR,MODEL,INSTLOC)
S FILEDATA("ACQUISITION DEVICE")=ACQDEVP
; get the SOP Class pointer (file 2005, field 251)
S SOPCLASP=$O(^MAG(2006.532,"B",SOPCLASS,""))
S FILEDATA("SOP CLASS POINTER")=SOPCLASP
;
S FILEDATA("MODALITY")=MODALITY
S FILEDATA("PARENT FILE")=74
S FILEDATA("PARENT IEN")=RARPT
S FILEDATA("RAD REPORT")=RARPT
S FILEDATA("RAD PROC PTR")=RADATA("PROCIEN")
S FILEDATA("PACKAGE")="RAD"
S X=$S(MODALITY="NM":"NUCLEAR MEDICINE",1:"RADIOLOGY")
S ISPECIDX=$O(^MAG(2005.84,"B",X,""))
S X=$$FIELD43^MAGXMA(MODALITY,ISPECIDX,.Y)
S FILEDATA("PROC/EVENT")=$S(X=0:Y,1:"")
S FILEDATA("SPEC/SUBSPEC")=ISPECIDX
;
; find the corresponding image group node under the report
S (HIT,RARPT3)=0
F S RARPT3=$O(^RARPT(RARPT,2005,RARPT3)) Q:'RARPT3 D Q:HIT Q:ERRCODE
. S MAGGP=+$G(^RARPT(RARPT,2005,RARPT3,0)) ; get imaging group pointer
. S GROUPDFN=$P($G(^MAG(2005,MAGGP,0)),"^",7) ; check image DFN value
. I GROUPDFN'=DFN D ; fatal error
. . D MISMATCH^MAGDIRVE($T(+0),DFN,MAGGP)
. . S ERRCODE=-305
. . Q
. E I $P($G(^MAG(2005,MAGGP,0)),"^",6)=11 D
. . ; create a new group if this is for a different Study Instance UID
. . I STUDYUID'=$P($G(^MAG(2005,MAGGP,"PACS")),"^",1) Q
. . ; check to see that this group is for the same SOP Class
. . S P=$P($G(^MAG(2005,MAGGP,"SOP")),"^",1)
. . S HIT=$$EQUIVGRP^MAGDFCNV(P,SOPCLASP) ; equivalent groups?
. . Q
. Q
;
I ERRCODE Q ERRCODE ; fatal image DFN problem
;
I 'HIT D Q:ERRCODE ERRCODE ; the 2005 node does not yet exist
. ; create the radiology imaging group
. N PROCEDUR,RADRPT,RADPTR
. S PROCEDUR="RAD "_FILEDATA("MODALITY")
. S RADRPT=FILEDATA("RAD REPORT")
. S RADPTR=FILEDATA("RAD PROC PTR")
. ;
. L +^RARPT(RARPT):$G(DILOCKTM,5)
. I '$T S ERRCODE="-399^radiology report locked - image processing blocked" Q
. L -^RARPT(RARPT)
. ;
. D NEWGROUP(PROCEDUR,RADRPT,RADPTR) Q:ERRCODE
. ;
. ; store the cross-reference for the report
. D PTR^RARIC Q:Y>0
. I Y="-1^radiology report locked" S ERRCODE="-399^"_$P(Y,"^",2)
. E I Y=0 S ERRCODE=-311
. E S ERRCODE=-312
. Q
;
I 'MAGGP D Q ERRCODE ; fatal error
. K MSG
. S MSG(1)="IMAGE GROUP LOOKUP ERROR:"
. S MSG(2)="Looking for 2005 cross reference in ^RARPT("_RARPT_")"
. D ERROR^MAGDIRVE($T(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
. S ERRCODE=-308
. Q
Q 0
;
NEWGROUP(PROCEDUR,RADRPT,RADPTR) ; create an imaging group (called by ^MAGDIR9E)
N I
K GROUP S I=0
S I=I+1,GROUP(I)=".01^"_PNAMEVAH_" "_DCMPID_" "_PROCDESC
S I=I+1,GROUP(I)="3^11" ; Object Type -- XRAY Group
S I=I+1,GROUP(I)="5^"_DFN
S I=I+1,GROUP(I)="6^"_PROCEDUR
S I=I+1,GROUP(I)="2005.04^0"
S I=I+1,GROUP(I)="10^"_PROCDESC
S I=I+1,GROUP(I)="15^"_DATETIME
S I=I+1,GROUP(I)="16^"_FILEDATA("PARENT FILE")
S I=I+1,GROUP(I)="17^"_FILEDATA("PARENT IEN")
S:$D(FILEDATA("PARENT FILE PTR")) I=I+1,GROUP(I)="18^"_FILEDATA("PARENT FILE PTR")
S I=I+1,GROUP(I)="60^"_STUDYUID
;
; the following two fields are only for radiology
I $D(RADRPT) S I=I+1,GROUP(I)="61^"_RADRPT
I $D(RADPTR) S I=I+1,GROUP(I)="62^"_RADPTR
;
S I=I+1,GROUP(I)=".05^"_INSTLOC
S I=I+1,GROUP(I)="40^"_FILEDATA("PACKAGE")
S I=I+1,GROUP(I)="41^"_$O(^MAG(2005.82,"B","CLIN",""))
S I=I+1,GROUP(I)="42^"_FILEDATA("TYPE")
S I=I+1,GROUP(I)="43^"_FILEDATA("PROC/EVENT")
S I=I+1,GROUP(I)="44^"_FILEDATA("SPEC/SUBSPEC")
S I=I+1,GROUP(I)="45^"_ORIGINDX
S I=I+1,GROUP(I)="107^"_FILEDATA("ACQUISITION DEVICE")
S I=I+1,GROUP(I)="110^"_STAMP
S I=I+1,GROUP(I)="251^"_FILEDATA("SOP CLASS POINTER")
D ADD^MAGGTIA(.RETURN,.GROUP)
S MAGGP=+RETURN
I 'MAGGP D Q ; fatal error
. K MSG
. S MSG(1)="IMAGE GROUP CREATION ERROR:"
. S MSG(2)=$P(RETURN,"^",2,999)
. D BADERROR^MAGDIRVE($T(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
. S ERRCODE=-306
. Q
;
I MAGGP<LASTIMG D Q ; fatal last image pointer error
. D GROUPPTR^MAGDIRVE($T(+0),MAGGP,LASTIMG)
. S ERRCODE=-307
. Q
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDIR9A 8485 printed Sep 23, 2025@19:36:39 Page 2
MAGDIR9A ;WOIFO/PMK/RRB - Read a DICOM image file ; 03 Jul 2013 9:15 AM
+1 ;;3.0;IMAGING;**11,30,51,46,54,53,49,99,138**;Mar 19, 2002;Build 5380;Sep 03, 2013
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+3 ;; +---------------------------------------------------------------+
+4 ;; | Property of the US Government. |
+5 ;; | No permission to copy or redistribute this software is given. |
+6 ;; | Use of unreleased versions of this software requires the user |
+7 ;; | to execute a written test agreement with the VistA Imaging |
+8 ;; | Development Office of the Department of Veterans Affairs, |
+9 ;; | telephone (301) 734-0100. |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 QUIT
+18 ; M2MB server
+19 ;
+20 ; This routine creates a ^mag(2005) group entry and links it to the
+21 ; associated radiology report
+22 ;
+23 ; XXXXXX XX XXXXXX
+24 ; XX XX XXXX XX XX
+25 ; XX XX XX XX XX XX
+26 ; XXXXX XX XX XX XX
+27 ; XX XX XXXXXX XX XX
+28 ; XX XX XX XX XX XX
+29 ; XXX XX XX XX XXXXXX
+30 ;
GROUP() ; entry point from ^MAGDIR81
+1 ;-- pointer to acquisition device file (#2006.04)
NEW ACQDEVP
+2 ;------ fileman variable
NEW DA
+3 ;- error trap code
NEW ERRCODE
+4 ;--- array to pass group data to ^MAGGTIA
NEW GROUP
+5 ; DFN value from image group entry for double checking
NEW GROUPDFN
+6 ;------- scratch variable (pointer to ACQUISITION DEVICE file)
NEW P
+7 ;--- external "3rd level" subscript in ^RADPT
NEW RACNE
+8 ;--- internal "3rd level" subscript in ^RADPT
NEW RACNI
+9 ;--- radiology package's DFN
NEW RADFN
+10 ;--- external "2nd level" subscript in ^RADPT
NEW RADTE
+11 ;--- internal "2nd level" subscript in ^RADPT
NEW RADTI
+12 ;--- 1st level node in ^RARPT for report (ie, the ien)
NEW RARPT
+13 ;-- 3rd level node for 2005 multiple under ^RARPT's report
NEW RARPT3
+14 ; DFN value from ^RARPT for double checking
NEW RARPTDFN
+15 ;-- variable returned by ^MAGGTIA
NEW RETURN
+16 ; pointer to SOP Class file (#2006.532)
NEW SOPCLASP
+17 ; scratch variables
NEW HIT,ISPECIDX,X,Y
+18 ;
+19 SET ERRCODE=""
+20 ;
+21 ; patient DFN variables
SET (RADFN,DA(2))=DFN
+22 ; case subscript
SET RADTI=RADATA("RADPT2")
+23 IF RADTI=""
Begin DoDot:1
+24 KILL MSG
+25 SET MSG(1)="No radiology case number specified for patient "_DFN
+26 DO ERROR^MAGDIRVE($TEXT(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
+27 SET ERRCODE=-301
+28 QUIT
End DoDot:1
QUIT ERRCODE
+29 ;
+30 ; 9's complement conversion
SET RADTE=9999999.9999-RADTI
+31 SET RACNI=RADATA("RADPT3")
+32 ; short case #
SET RACNE=$PIECE(CASENUMB,"-",$LENGTH(CASENUMB,"-"))
+33 ;
+34 ; check for the existence of the entry in ^RADPT (redundant)
+35 ; can't process further
IF '$DATA(^RADPT(RADFN,"DT",RADTI,0))
Begin DoDot:1
+36 KILL MSG
+37 SET MSG(1)="Radiology case "_RADTI_" is not in ^RADPT("_RADFN_")"
+38 DO ERROR^MAGDIRVE($TEXT(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
+39 SET ERRCODE=-302
+40 QUIT
End DoDot:1
QUIT ERRCODE
+41 ;
+42 ; check for the existence of the report pointer
+43 SET RARPT=$PIECE($GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),"^",17)
+44 ; if the report does not yet exist, create it
+45 ;
+46 ; can't process further
IF RARPT=""
Begin DoDot:1
+47 NEW RACN,RATIMEOUT
+48 SET RATIMEOUT=1
+49 ; create the report
SET RACN=RACNE
DO CREATE^RARIC
+50 ;
+51 IF RARPT="-1^radiology exam locked"
SET ERRCODE="-399^"_$PIECE(RARPT,"^",2)
QUIT
+52 ;
+53 ; If RARPT is no longer defined at this point, this means
+54 ; that we're dealing with an old study, and the report has
+55 ; been archived and purged.
+56 ;
+57 IF '$GET(RARPT)
Begin DoDot:2
+58 KILL MSG
+59 SET MSG(1)="IMAGE GROUP CREATION ERROR:"
+60 SET MSG(2)="Radiology Report has been archived and purged."
+61 SET MSG(3)="Patient "_$GET(RADFN)_", 9's Complement Date "_$GET(RADTI)_", Case "_$GET(RACNI)
+62 DO ERROR^MAGDIRVE($TEXT(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
+63 SET ERRCODE=-303
+64 QUIT
End DoDot:2
QUIT
+65 QUIT
End DoDot:1
if ERRCODE
QUIT ERRCODE
+66 ;
+67 ; double check the DFN value from ^RARPT to make sure its right
+68 SET RARPTDFN=$PIECE($GET(^RARPT(RARPT,0)),"^",2)
+69 ; fatal error
IF RARPTDFN'=DFN
Begin DoDot:1
+70 DO RADMISS^MAGDIRVE($TEXT(+0),DFN,RARPT,RARPTDFN)
+71 SET ERRCODE=-304
+72 QUIT
End DoDot:1
QUIT ERRCODE
+73 ;
+74 ; initialize FILEDATA for GROUP and IMAGE
+75 ; get the acquisition device pointer (file 2005, field 107)
+76 SET ACQDEVP=$$ACQDEV^MAGDFCNV(MFGR,MODEL,INSTLOC)
+77 SET FILEDATA("ACQUISITION DEVICE")=ACQDEVP
+78 ; get the SOP Class pointer (file 2005, field 251)
+79 SET SOPCLASP=$ORDER(^MAG(2006.532,"B",SOPCLASS,""))
+80 SET FILEDATA("SOP CLASS POINTER")=SOPCLASP
+81 ;
+82 SET FILEDATA("MODALITY")=MODALITY
+83 SET FILEDATA("PARENT FILE")=74
+84 SET FILEDATA("PARENT IEN")=RARPT
+85 SET FILEDATA("RAD REPORT")=RARPT
+86 SET FILEDATA("RAD PROC PTR")=RADATA("PROCIEN")
+87 SET FILEDATA("PACKAGE")="RAD"
+88 SET X=$SELECT(MODALITY="NM":"NUCLEAR MEDICINE",1:"RADIOLOGY")
+89 SET ISPECIDX=$ORDER(^MAG(2005.84,"B",X,""))
+90 SET X=$$FIELD43^MAGXMA(MODALITY,ISPECIDX,.Y)
+91 SET FILEDATA("PROC/EVENT")=$SELECT(X=0:Y,1:"")
+92 SET FILEDATA("SPEC/SUBSPEC")=ISPECIDX
+93 ;
+94 ; find the corresponding image group node under the report
+95 SET (HIT,RARPT3)=0
+96 FOR
SET RARPT3=$ORDER(^RARPT(RARPT,2005,RARPT3))
if 'RARPT3
QUIT
Begin DoDot:1
+97 ; get imaging group pointer
SET MAGGP=+$GET(^RARPT(RARPT,2005,RARPT3,0))
+98 ; check image DFN value
SET GROUPDFN=$PIECE($GET(^MAG(2005,MAGGP,0)),"^",7)
+99 ; fatal error
IF GROUPDFN'=DFN
Begin DoDot:2
+100 DO MISMATCH^MAGDIRVE($TEXT(+0),DFN,MAGGP)
+101 SET ERRCODE=-305
+102 QUIT
End DoDot:2
+103 IF '$TEST
IF $PIECE($GET(^MAG(2005,MAGGP,0)),"^",6)=11
Begin DoDot:2
+104 ; create a new group if this is for a different Study Instance UID
+105 IF STUDYUID'=$PIECE($GET(^MAG(2005,MAGGP,"PACS")),"^",1)
QUIT
+106 ; check to see that this group is for the same SOP Class
+107 SET P=$PIECE($GET(^MAG(2005,MAGGP,"SOP")),"^",1)
+108 ; equivalent groups?
SET HIT=$$EQUIVGRP^MAGDFCNV(P,SOPCLASP)
+109 QUIT
End DoDot:2
+110 QUIT
End DoDot:1
if HIT
QUIT
if ERRCODE
QUIT
+111 ;
+112 ; fatal image DFN problem
IF ERRCODE
QUIT ERRCODE
+113 ;
+114 ; the 2005 node does not yet exist
IF 'HIT
Begin DoDot:1
+115 ; create the radiology imaging group
+116 NEW PROCEDUR,RADRPT,RADPTR
+117 SET PROCEDUR="RAD "_FILEDATA("MODALITY")
+118 SET RADRPT=FILEDATA("RAD REPORT")
+119 SET RADPTR=FILEDATA("RAD PROC PTR")
+120 ;
+121 LOCK +^RARPT(RARPT):$GET(DILOCKTM,5)
+122 IF '$TEST
SET ERRCODE="-399^radiology report locked - image processing blocked"
QUIT
+123 LOCK -^RARPT(RARPT)
+124 ;
+125 DO NEWGROUP(PROCEDUR,RADRPT,RADPTR)
if ERRCODE
QUIT
+126 ;
+127 ; store the cross-reference for the report
+128 DO PTR^RARIC
if Y>0
QUIT
+129 IF Y="-1^radiology report locked"
SET ERRCODE="-399^"_$PIECE(Y,"^",2)
+130 IF '$TEST
IF Y=0
SET ERRCODE=-311
+131 IF '$TEST
SET ERRCODE=-312
+132 QUIT
End DoDot:1
if ERRCODE
QUIT ERRCODE
+133 ;
+134 ; fatal error
IF 'MAGGP
Begin DoDot:1
+135 KILL MSG
+136 SET MSG(1)="IMAGE GROUP LOOKUP ERROR:"
+137 SET MSG(2)="Looking for 2005 cross reference in ^RARPT("_RARPT_")"
+138 DO ERROR^MAGDIRVE($TEXT(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
+139 SET ERRCODE=-308
+140 QUIT
End DoDot:1
QUIT ERRCODE
+141 QUIT 0
+142 ;
NEWGROUP(PROCEDUR,RADRPT,RADPTR) ; create an imaging group (called by ^MAGDIR9E)
+1 NEW I
+2 KILL GROUP
SET I=0
+3 SET I=I+1
SET GROUP(I)=".01^"_PNAMEVAH_" "_DCMPID_" "_PROCDESC
+4 ; Object Type -- XRAY Group
SET I=I+1
SET GROUP(I)="3^11"
+5 SET I=I+1
SET GROUP(I)="5^"_DFN
+6 SET I=I+1
SET GROUP(I)="6^"_PROCEDUR
+7 SET I=I+1
SET GROUP(I)="2005.04^0"
+8 SET I=I+1
SET GROUP(I)="10^"_PROCDESC
+9 SET I=I+1
SET GROUP(I)="15^"_DATETIME
+10 SET I=I+1
SET GROUP(I)="16^"_FILEDATA("PARENT FILE")
+11 SET I=I+1
SET GROUP(I)="17^"_FILEDATA("PARENT IEN")
+12 if $DATA(FILEDATA("PARENT FILE PTR"))
SET I=I+1
SET GROUP(I)="18^"_FILEDATA("PARENT FILE PTR")
+13 SET I=I+1
SET GROUP(I)="60^"_STUDYUID
+14 ;
+15 ; the following two fields are only for radiology
+16 IF $DATA(RADRPT)
SET I=I+1
SET GROUP(I)="61^"_RADRPT
+17 IF $DATA(RADPTR)
SET I=I+1
SET GROUP(I)="62^"_RADPTR
+18 ;
+19 SET I=I+1
SET GROUP(I)=".05^"_INSTLOC
+20 SET I=I+1
SET GROUP(I)="40^"_FILEDATA("PACKAGE")
+21 SET I=I+1
SET GROUP(I)="41^"_$ORDER(^MAG(2005.82,"B","CLIN",""))
+22 SET I=I+1
SET GROUP(I)="42^"_FILEDATA("TYPE")
+23 SET I=I+1
SET GROUP(I)="43^"_FILEDATA("PROC/EVENT")
+24 SET I=I+1
SET GROUP(I)="44^"_FILEDATA("SPEC/SUBSPEC")
+25 SET I=I+1
SET GROUP(I)="45^"_ORIGINDX
+26 SET I=I+1
SET GROUP(I)="107^"_FILEDATA("ACQUISITION DEVICE")
+27 SET I=I+1
SET GROUP(I)="110^"_STAMP
+28 SET I=I+1
SET GROUP(I)="251^"_FILEDATA("SOP CLASS POINTER")
+29 DO ADD^MAGGTIA(.RETURN,.GROUP)
+30 SET MAGGP=+RETURN
+31 ; fatal error
IF 'MAGGP
Begin DoDot:1
+32 KILL MSG
+33 SET MSG(1)="IMAGE GROUP CREATION ERROR:"
+34 SET MSG(2)=$PIECE(RETURN,"^",2,999)
+35 DO BADERROR^MAGDIRVE($TEXT(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
+36 SET ERRCODE=-306
+37 QUIT
End DoDot:1
QUIT
+38 ;
+39 ; fatal last image pointer error
IF MAGGP<LASTIMG
Begin DoDot:1
+40 DO GROUPPTR^MAGDIRVE($TEXT(+0),MAGGP,LASTIMG)
+41 SET ERRCODE=-307
+42 QUIT
End DoDot:1
QUIT
+43 QUIT
+44 ;
