MAGDIR9E ;WOIFO/PMK - Read a DICOM image file ; Feb 15, 2022@09:34:42
;;3.0;IMAGING;**11,51,46,54,99,138,305**;Mar 19, 2002;Build 3
;; 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. |
;; +---------------------------------------------------------------+
;;
; M2MB server
;
; This routine creates the group entry in ^MAG(2005) and links it
; to the consult/procedure request in GMRC.
;
; XXXX XXX X
; XX XX XX XX
; XX XXXX XX XXX XXXXXXX XX XXX XX XXXXX
; XX XX XX XXX XX XX XX XX XX XX
; XX X XX XX XX XX XXXXXXX XX XX XX XX
; XX XX XX XX XX XX XX XX XX XX XX XX
; XXXX XXXX XX XX XXXXXXX XXX XX XXXX XXX
;
GROUP() ; entry point from ^MAGDIR8 for consult/procedure groups
N ACQDEVP ;-- pointer to acquisition device file (#2006.04)
N D0 ;------- fileman variable
N ERRCODE ;-- error trap code
N GROUP ;---- array to pass group data to ^MAGGTIA
N MAGGPP ;--- pointer to group in DICOM GMRC TEMP LIST ^MAG(20006.5839)
N P ;-------- scratch variable (pointer to ACQUISITION DEVICE file)
N RESULT ;--- scratch variable
N SERVICE ;-- service performing the consult/procedure - ^GMR(123.5)
N SOPCLASP ;- pointer to SOP Class file (#2006.532)
N TIUIEN ;--- TIU file 8925 IEN value
;
S ERRCODE=""
;
I STUDYDAT,STUDYTIM D ; get study date/time from image header
. S DATETIME=(STUDYDAT_"."_STUDYTIM)-17000000 ; FileMan date.time fmt
. Q
E S DATETIME=$$NOW^XLFDT() ; use current date/time
;
; 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 MAGGP="" ; initialize pointer to the image group
;
; check if there already is a TIU note attached to this request
;
S TIUIEN=$$TIULAST^MAGDGMRC(GMRCIEN)
I TIUIEN D Q:ERRCODE ERRCODE ; there is TIU note already
. ; double check TIU note DFN to make sure that it matches
. N HIT ; scratch variable used in finding corresponding image group
. N TIUDFN ; DFN value from ^TIU for double checking
. N TIUXDIEN ; TIU External Data File IEN
. S TIUDFN=$P($G(^TIU(8925,TIUIEN,0)),"^",2)
. I TIUDFN'=DFN D Q ; fatal error
. . D TIUMISS^MAGDIRVE($T(+0),DFN,TIUIEN,TIUDFN)
. . S ERRCODE=-501
. . Q
. ;
. S FILEDATA("PARENT FILE")=8925 ; TIU file
. S FILEDATA("PARENT IEN")=TIUIEN
. ;
. ; is there an entry in TIU External Data File for this note
. S (HIT,TIUXDIEN)=0
. F S TIUXDIEN=$O(^TIU(8925.91,"B",TIUIEN,TIUXDIEN)) Q:'TIUXDIEN D Q:HIT Q:ERRCODE
. . N MAG2 ;----- data value for getting parent file attributes
. . N GROUPDFN ;- DFN value from image group entry for double checking
. . ; there is a TIU External Data File
. . ; does the TIU External Data File entry point to an image group?
. . S MAGGP=$$GET1^DIQ(8925.91,TIUXDIEN,.02,"I") Q:'MAGGP
. . ; double check image group entry DFN
. . S GROUPDFN=$P($G(^MAG(2005,MAGGP,0)),"^",7)
. . I GROUPDFN'=DFN D Q ; fatal error
. . . D MISMATCH^MAGDIRVE($T(+0),DFN,MAGGP)
. . . S ERRCODE=-502
. . . Q
. . I $P($G(^MAG(2005,MAGGP,0)),"^",6)'=11 D Q ; 11=XRAY GROUP
. . . S MAGGP="" ; wrong object type - skip this image group
. . . Q
. . ; create a new group if this is for a different Study Instance UID
. . I STUDYUID'=$P($G(^MAG(2005,MAGGP,"PACS")),"^",1) S MAGGP="" Q
. . S P=$P($G(^MAG(2005,MAGGP,"SOP")),"^",1)
. . ; skip this image group if wrong SOP Class
. . I '$$EQUIVGRP^MAGDFCNV(P,SOPCLASP) S MAGGP="" Q
. . ; add the new image to this existing image group
. . S HIT=1,MAG2=$G(^MAG(2005,MAGGP,2))
. . S FILEDATA("PARENT FILE")=$P(MAG2,"^",6)
. . S FILEDATA("PARENT IEN")=$P(MAG2,"^",7)
. . S FILEDATA("PARENT FILE PTR")=$P(MAG2,"^",8)
. . I FILEDATA("PARENT IEN")'=TIUIEN D ; fatal error
. . . D TIUMISS2^MAGDIRVE($T(+0),TIUIEN,FILEDATA("PARENT IEN"),TIUXDIEN,MAGGP)
. . . S ERRCODE=-503
. . . Q
. . Q
. Q
;
; need a temporary association for the consult/procedure request
;
E D Q:ERRCODE ERRCODE ; check if there is a temporary association
. ;
. ; Note: this algorithm creates multiple groups for a study,
. ; for instance a GI fluoroscopy + color images
. ;
. S MAGGPP=""
. F S MAGGPP=$O(^MAG(2006.5839,"C",123,GMRCIEN,MAGGPP)) Q:'MAGGPP D Q:ERRCODE
. . N GROUPDFN ; DFN value from image group entry for double checking
. . S MAGGP=$P(^MAG(2006.5839,MAGGPP,0),"^",3)
. . ; double check image group entry DFN in existing 2005 group node
. . S GROUPDFN=$P($G(^MAG(2005,MAGGP,0)),"^",7)
. . I GROUPDFN'=DFN D ; fatal error
. . . D MISMATCH^MAGDIRVE($T(+0),DFN,MAGGP)
. . . S MAGGP="" ; bad group
. . . S ERRCODE=-504
. . . Q
. . E S P=$P($G(^MAG(2005,MAGGP,100)),"^",4) I P,P'=ACQDEVP D ; wrong device
. . . S MAGGP="" ; wrong acquisition device - skip this image group
. . . Q
. . E D ; add the new image to this existing image group
. . . N MAG2 ; data value for getting parent file attributes
. . . S MAG2=$G(^MAG(2005,MAGGP,2))
. . . S FILEDATA("PARENT FILE")=$P(MAG2,"^",6)
. . . S FILEDATA("PARENT IEN")=$P(MAG2,"^",7)
. . . S FILEDATA("PARENT FILE PTR")=$P(MAG2,"^",8) ; should be null
. . . I FILEDATA("PARENT FILE")'=2006.5839 D ; fatal error
. . . . D TMPMISS^MAGDIRVE($T(+0),FILEDATA("PARENT FILE"),MAGGP)
. . . . S ERRCODE=-505
. . . . Q
. . . Q
. . Q
. ;
. I 'MAGGP D ; no group exists yet create a temporary association
. . S FILEDATA("PARENT FILE")=2006.5839 ; GMRC file
. . S FILEDATA("PARENT IEN")=GMRCIEN
. . Q
. Q
;
S FILEDATA("MODALITY")=MODALITY
S FILEDATA("PACKAGE")="CONS"
;
; add the study to the Consult Unread List, if necessary
D ADD^MAGDTR03(.RESULT,GMRCIEN,"I",1) ; add if "on image" is set
;
S (FILEDATA("SPEC/SUBSPEC"),FILEDATA("PROC/EVENT"))=""
;
; lookup study in ^GMR(123) and get FILEDATA variables
;
S SERVICE=$$GET1^DIQ(123,GMRCIEN,1,"I")
I SERVICE D ; look for ISPECIDX and IPROCIDX
. N DONE,ISPECIDX1,ISPECIDX2,IPROCIDX1,IPROCIDX2,MWLCONFIG,UNREAD,X,Y
. ;
. S (ISPECIDX1,ISPECIDX2,IPROCIDX1,IPROCIDX2)=""
. ;
. ; look in CLINICAL SPECIALTY DICOM & HL7 file #2006.5831 first
. S MWLCONFIG=$$MWLFIND^MAGDHOW1(SERVICE,GMRCIEN)
. I MWLCONFIG D Q:DONE
. . S X=^MAG(2006.5831,MWLCONFIG,0)
. . S ISPECIDX1=$P(X,"^",3),IPROCIDX1=$P(X,"^",4)
. . S DONE=$$IMAGEIDX(ISPECIDX1,IPROCIDX1,.FILEDATA)
. . Q
. ;
. ; look in TeleReader READ/UNREAD LIST file #2006.5849 next
. S UNREAD=$O(^MAG(2006.5849,"B",GMRCIEN,""))
. I UNREAD D Q:DONE
. . S X=^MAG(2006.5849,UNREAD,0)
. . S ISPECIDX2=$P(X,"^",3),IPROCIDX2=$P(X,"^",4)
. . S DONE=$$IMAGEIDX(ISPECIDX2,IPROCIDX2,.FILEDATA)
. . Q
. ;
. ; inactive index to procedure
. S X=$$FIELD43^MAGXMA(FILEDATA("MODALITY"),ISPECIDX1,.Y)
. S FILEDATA("PROC/EVENT")=$S(X=0:Y,1:"")
. Q
;
; if the 2005 group node does not yet exist, create it
;
I 'MAGGP D Q:ERRCODE ERRCODE ; create the imaging group
. D NEWGROUP^MAGDIR9A("CON/PROC") Q:ERRCODE
. ;
. I FILEDATA("PARENT FILE")=8925 D Q:ERRCODE ; fix for ^TIU
. . S ERRCODE=$$TIUXLINK^MAGDIR9E()
. . Q
. E I FILEDATA("PARENT FILE")=2006.5839 D ; fix for ^GMR
. . L +^MAG(2006.5839):1E9 ; Background job MUST wait
. . I '$D(^MAG(2006.5839,0)) D
. . . S ^MAG(2006.5839,0)="DICOM GMRC TEMP LIST^^0^0"
. . . Q
. . S D0=$P(^MAG(2006.5839,0),"^",3)+1
. . S $P(^MAG(2006.5839,0),"^",3)=D0,$P(^(0),"^",4)=$P(^(0),"^",4)+1
. . L -^MAG(2006.5839)
. . S ^MAG(2006.5839,D0,0)="123^"_GMRCIEN_"^"_MAGGP
. . S ^MAG(2006.5839,"C",123,GMRCIEN,D0)=""
. . Q
. Q
;
; check for intra-oral x-ray images & get tooth number(s)
I IMAGNAME'="" S FILEDATA("SHORT DESCRIPTION")=IMAGNAME
;
Q 0
;
IMAGEIDX(ISPECIDX,IPROCIDX,FILEDATA) ; set image index for specialty and procedure
N NFIELDS
;
S NFIELDS=0
;
I FILEDATA("SPEC/SUBSPEC") S NFIELDS=NFIELDS+1
E I ISPECIDX,"A"[$P(^MAG(2005.84,ISPECIDX,0),"^",4) D
. S FILEDATA("SPEC/SUBSPEC")=ISPECIDX
. S NFIELDS=NFIELDS+1
. Q
;
I FILEDATA("PROC/EVENT") S NFIELDS=NFIELDS+1
E I IPROCIDX,"A"[$P(^MAG(2005.85,IPROCIDX,0),"^",3) D
. S FILEDATA("PROC/EVENT")=IPROCIDX
. S NFIELDS=NFIELDS+1
. Q
. I
;
Q NFIELDS=2
;
TIUXLINK() ; create the cross-linkages to TIU EXTERNAL DATA LINK file
N TIUXDIEN
D PUTIMAGE^TIUSRVPL(.TIUXDIEN,TIUIEN,MAGGP)
I TIUXDIEN D
. S FILEDATA("PARENT FILE PTR")=TIUXDIEN
. S $P(^MAG(2005,MAGGP,2),"^",8)=TIUXDIEN
. Q
E D Q ERRCODE ; fatal error
. K MSG
. S MSG(1)="ERROR ASSOCIATING WITH TIU EXTERNAL DATA LINK (file 8925.91):"
. S MSG(2)=$P(TIUXDIEN,"^",2,999)
. D BADERROR^MAGDIRVE($T(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
. S ERRCODE=-508
. Q
Q 0
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDIR9E 9968 printed Apr 09, 2024@21:00:25 Page 2
MAGDIR9E ;WOIFO/PMK - Read a DICOM image file ; Feb 15, 2022@09:34:42
+1 ;;3.0;IMAGING;**11,51,46,54,99,138,305**;Mar 19, 2002;Build 3
+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 ; M2MB server
+18 ;
+19 ; This routine creates the group entry in ^MAG(2005) and links it
+20 ; to the consult/procedure request in GMRC.
+21 ;
+22 ; XXXX XXX X
+23 ; XX XX XX XX
+24 ; XX XXXX XX XXX XXXXXXX XX XXX XX XXXXX
+25 ; XX XX XX XXX XX XX XX XX XX XX
+26 ; XX X XX XX XX XX XXXXXXX XX XX XX XX
+27 ; XX XX XX XX XX XX XX XX XX XX XX XX
+28 ; XXXX XXXX XX XX XXXXXXX XXX XX XXXX XXX
+29 ;
GROUP() ; entry point from ^MAGDIR8 for consult/procedure groups
+1 ;-- pointer to acquisition device file (#2006.04)
NEW ACQDEVP
+2 ;------- fileman variable
NEW D0
+3 ;-- error trap code
NEW ERRCODE
+4 ;---- array to pass group data to ^MAGGTIA
NEW GROUP
+5 ;--- pointer to group in DICOM GMRC TEMP LIST ^MAG(20006.5839)
NEW MAGGPP
+6 ;-------- scratch variable (pointer to ACQUISITION DEVICE file)
NEW P
+7 ;--- scratch variable
NEW RESULT
+8 ;-- service performing the consult/procedure - ^GMR(123.5)
NEW SERVICE
+9 ;- pointer to SOP Class file (#2006.532)
NEW SOPCLASP
+10 ;--- TIU file 8925 IEN value
NEW TIUIEN
+11 ;
+12 SET ERRCODE=""
+13 ;
+14 ; get study date/time from image header
IF STUDYDAT
IF STUDYTIM
Begin DoDot:1
+15 ; FileMan date.time fmt
SET DATETIME=(STUDYDAT_"."_STUDYTIM)-17000000
+16 QUIT
End DoDot:1
+17 ; use current date/time
IF '$TEST
SET DATETIME=$$NOW^XLFDT()
+18 ;
+19 ; initialize FILEDATA for GROUP and IMAGE
+20 ; get the acquisition device pointer (file 2005, field 107)
+21 SET ACQDEVP=$$ACQDEV^MAGDFCNV(MFGR,MODEL,INSTLOC)
+22 SET FILEDATA("ACQUISITION DEVICE")=ACQDEVP
+23 ; get the SOP Class pointer (file 2005, field 251)
+24 SET SOPCLASP=$ORDER(^MAG(2006.532,"B",SOPCLASS,""))
+25 SET FILEDATA("SOP CLASS POINTER")=SOPCLASP
+26 ;
+27 ; initialize pointer to the image group
SET MAGGP=""
+28 ;
+29 ; check if there already is a TIU note attached to this request
+30 ;
+31 SET TIUIEN=$$TIULAST^MAGDGMRC(GMRCIEN)
+32 ; there is TIU note already
IF TIUIEN
Begin DoDot:1
+33 ; double check TIU note DFN to make sure that it matches
+34 ; scratch variable used in finding corresponding image group
NEW HIT
+35 ; DFN value from ^TIU for double checking
NEW TIUDFN
+36 ; TIU External Data File IEN
NEW TIUXDIEN
+37 SET TIUDFN=$PIECE($GET(^TIU(8925,TIUIEN,0)),"^",2)
+38 ; fatal error
IF TIUDFN'=DFN
Begin DoDot:2
+39 DO TIUMISS^MAGDIRVE($TEXT(+0),DFN,TIUIEN,TIUDFN)
+40 SET ERRCODE=-501
+41 QUIT
End DoDot:2
QUIT
+42 ;
+43 ; TIU file
SET FILEDATA("PARENT FILE")=8925
+44 SET FILEDATA("PARENT IEN")=TIUIEN
+45 ;
+46 ; is there an entry in TIU External Data File for this note
+47 SET (HIT,TIUXDIEN)=0
+48 FOR
SET TIUXDIEN=$ORDER(^TIU(8925.91,"B",TIUIEN,TIUXDIEN))
if 'TIUXDIEN
QUIT
Begin DoDot:2
+49 ;----- data value for getting parent file attributes
NEW MAG2
+50 ;- DFN value from image group entry for double checking
NEW GROUPDFN
+51 ; there is a TIU External Data File
+52 ; does the TIU External Data File entry point to an image group?
+53 SET MAGGP=$$GET1^DIQ(8925.91,TIUXDIEN,.02,"I")
if 'MAGGP
QUIT
+54 ; double check image group entry DFN
+55 SET GROUPDFN=$PIECE($GET(^MAG(2005,MAGGP,0)),"^",7)
+56 ; fatal error
IF GROUPDFN'=DFN
Begin DoDot:3
+57 DO MISMATCH^MAGDIRVE($TEXT(+0),DFN,MAGGP)
+58 SET ERRCODE=-502
+59 QUIT
End DoDot:3
QUIT
+60 ; 11=XRAY GROUP
IF $PIECE($GET(^MAG(2005,MAGGP,0)),"^",6)'=11
Begin DoDot:3
+61 ; wrong object type - skip this image group
SET MAGGP=""
+62 QUIT
End DoDot:3
QUIT
+63 ; create a new group if this is for a different Study Instance UID
+64 IF STUDYUID'=$PIECE($GET(^MAG(2005,MAGGP,"PACS")),"^",1)
SET MAGGP=""
QUIT
+65 SET P=$PIECE($GET(^MAG(2005,MAGGP,"SOP")),"^",1)
+66 ; skip this image group if wrong SOP Class
+67 IF '$$EQUIVGRP^MAGDFCNV(P,SOPCLASP)
SET MAGGP=""
QUIT
+68 ; add the new image to this existing image group
+69 SET HIT=1
SET MAG2=$GET(^MAG(2005,MAGGP,2))
+70 SET FILEDATA("PARENT FILE")=$PIECE(MAG2,"^",6)
+71 SET FILEDATA("PARENT IEN")=$PIECE(MAG2,"^",7)
+72 SET FILEDATA("PARENT FILE PTR")=$PIECE(MAG2,"^",8)
+73 ; fatal error
IF FILEDATA("PARENT IEN")'=TIUIEN
Begin DoDot:3
+74 DO TIUMISS2^MAGDIRVE($TEXT(+0),TIUIEN,FILEDATA("PARENT IEN"),TIUXDIEN,MAGGP)
+75 SET ERRCODE=-503
+76 QUIT
End DoDot:3
+77 QUIT
End DoDot:2
if HIT
QUIT
if ERRCODE
QUIT
+78 QUIT
End DoDot:1
if ERRCODE
QUIT ERRCODE
+79 ;
+80 ; need a temporary association for the consult/procedure request
+81 ;
+82 ; check if there is a temporary association
IF '$TEST
Begin DoDot:1
+83 ;
+84 ; Note: this algorithm creates multiple groups for a study,
+85 ; for instance a GI fluoroscopy + color images
+86 ;
+87 SET MAGGPP=""
+88 FOR
SET MAGGPP=$ORDER(^MAG(2006.5839,"C",123,GMRCIEN,MAGGPP))
if 'MAGGPP
QUIT
Begin DoDot:2
+89 ; DFN value from image group entry for double checking
NEW GROUPDFN
+90 SET MAGGP=$PIECE(^MAG(2006.5839,MAGGPP,0),"^",3)
+91 ; double check image group entry DFN in existing 2005 group node
+92 SET GROUPDFN=$PIECE($GET(^MAG(2005,MAGGP,0)),"^",7)
+93 ; fatal error
IF GROUPDFN'=DFN
Begin DoDot:3
+94 DO MISMATCH^MAGDIRVE($TEXT(+0),DFN,MAGGP)
+95 ; bad group
SET MAGGP=""
+96 SET ERRCODE=-504
+97 QUIT
End DoDot:3
+98 ; wrong device
IF '$TEST
SET P=$PIECE($GET(^MAG(2005,MAGGP,100)),"^",4)
IF P
IF P'=ACQDEVP
Begin DoDot:3
+99 ; wrong acquisition device - skip this image group
SET MAGGP=""
+100 QUIT
End DoDot:3
+101 ; add the new image to this existing image group
IF '$TEST
Begin DoDot:3
+102 ; data value for getting parent file attributes
NEW MAG2
+103 SET MAG2=$GET(^MAG(2005,MAGGP,2))
+104 SET FILEDATA("PARENT FILE")=$PIECE(MAG2,"^",6)
+105 SET FILEDATA("PARENT IEN")=$PIECE(MAG2,"^",7)
+106 ; should be null
SET FILEDATA("PARENT FILE PTR")=$PIECE(MAG2,"^",8)
+107 ; fatal error
IF FILEDATA("PARENT FILE")'=2006.5839
Begin DoDot:4
+108 DO TMPMISS^MAGDIRVE($TEXT(+0),FILEDATA("PARENT FILE"),MAGGP)
+109 SET ERRCODE=-505
+110 QUIT
End DoDot:4
+111 QUIT
End DoDot:3
+112 QUIT
End DoDot:2
if ERRCODE
QUIT
+113 ;
+114 ; no group exists yet create a temporary association
IF 'MAGGP
Begin DoDot:2
+115 ; GMRC file
SET FILEDATA("PARENT FILE")=2006.5839
+116 SET FILEDATA("PARENT IEN")=GMRCIEN
+117 QUIT
End DoDot:2
+118 QUIT
End DoDot:1
if ERRCODE
QUIT ERRCODE
+119 ;
+120 SET FILEDATA("MODALITY")=MODALITY
+121 SET FILEDATA("PACKAGE")="CONS"
+122 ;
+123 ; add the study to the Consult Unread List, if necessary
+124 ; add if "on image" is set
DO ADD^MAGDTR03(.RESULT,GMRCIEN,"I",1)
+125 ;
+126 SET (FILEDATA("SPEC/SUBSPEC"),FILEDATA("PROC/EVENT"))=""
+127 ;
+128 ; lookup study in ^GMR(123) and get FILEDATA variables
+129 ;
+130 SET SERVICE=$$GET1^DIQ(123,GMRCIEN,1,"I")
+131 ; look for ISPECIDX and IPROCIDX
IF SERVICE
Begin DoDot:1
+132 NEW DONE,ISPECIDX1,ISPECIDX2,IPROCIDX1,IPROCIDX2,MWLCONFIG,UNREAD,X,Y
+133 ;
+134 SET (ISPECIDX1,ISPECIDX2,IPROCIDX1,IPROCIDX2)=""
+135 ;
+136 ; look in CLINICAL SPECIALTY DICOM & HL7 file #2006.5831 first
+137 SET MWLCONFIG=$$MWLFIND^MAGDHOW1(SERVICE,GMRCIEN)
+138 IF MWLCONFIG
Begin DoDot:2
+139 SET X=^MAG(2006.5831,MWLCONFIG,0)
+140 SET ISPECIDX1=$PIECE(X,"^",3)
SET IPROCIDX1=$PIECE(X,"^",4)
+141 SET DONE=$$IMAGEIDX(ISPECIDX1,IPROCIDX1,.FILEDATA)
+142 QUIT
End DoDot:2
if DONE
QUIT
+143 ;
+144 ; look in TeleReader READ/UNREAD LIST file #2006.5849 next
+145 SET UNREAD=$ORDER(^MAG(2006.5849,"B",GMRCIEN,""))
+146 IF UNREAD
Begin DoDot:2
+147 SET X=^MAG(2006.5849,UNREAD,0)
+148 SET ISPECIDX2=$PIECE(X,"^",3)
SET IPROCIDX2=$PIECE(X,"^",4)
+149 SET DONE=$$IMAGEIDX(ISPECIDX2,IPROCIDX2,.FILEDATA)
+150 QUIT
End DoDot:2
if DONE
QUIT
+151 ;
+152 ; inactive index to procedure
+153 SET X=$$FIELD43^MAGXMA(FILEDATA("MODALITY"),ISPECIDX1,.Y)
+154 SET FILEDATA("PROC/EVENT")=$SELECT(X=0:Y,1:"")
+155 QUIT
End DoDot:1
+156 ;
+157 ; if the 2005 group node does not yet exist, create it
+158 ;
+159 ; create the imaging group
IF 'MAGGP
Begin DoDot:1
+160 DO NEWGROUP^MAGDIR9A("CON/PROC")
if ERRCODE
QUIT
+161 ;
+162 ; fix for ^TIU
IF FILEDATA("PARENT FILE")=8925
Begin DoDot:2
+163 SET ERRCODE=$$TIUXLINK^MAGDIR9E()
+164 QUIT
End DoDot:2
if ERRCODE
QUIT
+165 ; fix for ^GMR
IF '$TEST
IF FILEDATA("PARENT FILE")=2006.5839
Begin DoDot:2
+166 ; Background job MUST wait
LOCK +^MAG(2006.5839):1E9
+167 IF '$DATA(^MAG(2006.5839,0))
Begin DoDot:3
+168 SET ^MAG(2006.5839,0)="DICOM GMRC TEMP LIST^^0^0"
+169 QUIT
End DoDot:3
+170 SET D0=$PIECE(^MAG(2006.5839,0),"^",3)+1
+171 SET $PIECE(^MAG(2006.5839,0),"^",3)=D0
SET $PIECE(^(0),"^",4)=$PIECE(^(0),"^",4)+1
+172 LOCK -^MAG(2006.5839)
+173 SET ^MAG(2006.5839,D0,0)="123^"_GMRCIEN_"^"_MAGGP
+174 SET ^MAG(2006.5839,"C",123,GMRCIEN,D0)=""
+175 QUIT
End DoDot:2
+176 QUIT
End DoDot:1
if ERRCODE
QUIT ERRCODE
+177 ;
+178 ; check for intra-oral x-ray images & get tooth number(s)
+179 IF IMAGNAME'=""
SET FILEDATA("SHORT DESCRIPTION")=IMAGNAME
+180 ;
+181 QUIT 0
+182 ;
IMAGEIDX(ISPECIDX,IPROCIDX,FILEDATA) ; set image index for specialty and procedure
+1 NEW NFIELDS
+2 ;
+3 SET NFIELDS=0
+4 ;
+5 IF FILEDATA("SPEC/SUBSPEC")
SET NFIELDS=NFIELDS+1
+6 IF '$TEST
IF ISPECIDX
IF "A"[$PIECE(^MAG(2005.84,ISPECIDX,0),"^",4)
Begin DoDot:1
+7 SET FILEDATA("SPEC/SUBSPEC")=ISPECIDX
+8 SET NFIELDS=NFIELDS+1
+9 QUIT
End DoDot:1
+10 ;
+11 IF FILEDATA("PROC/EVENT")
SET NFIELDS=NFIELDS+1
+12 IF '$TEST
IF IPROCIDX
IF "A"[$PIECE(^MAG(2005.85,IPROCIDX,0),"^",3)
Begin DoDot:1
+13 SET FILEDATA("PROC/EVENT")=IPROCIDX
+14 SET NFIELDS=NFIELDS+1
+15 QUIT
+16 IF $TEST
End DoDot:1
+17 ;
+18 QUIT NFIELDS=2
+19 ;
TIUXLINK() ; create the cross-linkages to TIU EXTERNAL DATA LINK file
+1 NEW TIUXDIEN
+2 DO PUTIMAGE^TIUSRVPL(.TIUXDIEN,TIUIEN,MAGGP)
+3 IF TIUXDIEN
Begin DoDot:1
+4 SET FILEDATA("PARENT FILE PTR")=TIUXDIEN
+5 SET $PIECE(^MAG(2005,MAGGP,2),"^",8)=TIUXDIEN
+6 QUIT
End DoDot:1
+7 ; fatal error
IF '$TEST
Begin DoDot:1
+8 KILL MSG
+9 SET MSG(1)="ERROR ASSOCIATING WITH TIU EXTERNAL DATA LINK (file 8925.91):"
+10 SET MSG(2)=$PIECE(TIUXDIEN,"^",2,999)
+11 DO BADERROR^MAGDIRVE($TEXT(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
+12 SET ERRCODE=-508
+13 QUIT
End DoDot:1
QUIT ERRCODE
+14 QUIT 0
+15 ;
