- 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 Feb 18, 2025@23:26:57 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 ;