MAGDIR9F ;WOIFO/PMK - Read a DICOM image file ; 17 Jul 2013 11:42 AM
;;3.0;IMAGING;**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. |
;; +---------------------------------------------------------------+
;;
; M2MB server
;
; This routine creates the group entry in ^MAG(2005) and links it
; to the request in Anatomic Pathology.
;
GROUP() ; entry point from ^MAGDIR8 for Anatomic Pathology 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 IENS ;----- lookup string for Fileman
N MAGGPP ;--- pointer to group in DICOM LAB TEMP LIST ^MAG(20006.5838)
N P ;-------- scratch variable (pointer to ACQUISITION DEVICE file)
N PARENTFILE ; one of four anatomic pathology files
N RESULT ;--- scratch variable
N SOPCLASP ;- pointer to SOP Class file (#2006.532)
N TIUIEN ;--- TIU file 8925 IEN value
N TIUREF ;--- Anatomic Pathology reference file
N ERROR ;---- error return for GETS^DIQ Filename API call
;
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
;
D SUBFILES(LRSS) ; get LAB DATA (#63)subfile
S FILEDATA("SPEC/SUBSPEC")=$O(^MAG(2005.84,"B","PATHOLOGY",""))
;
S MAGGP="" ; initialize pointer to the image group
;
; check if there already is a TIU note attached to this request
;
S TIUIEN=0
;
; look up TIU note
S IENS="1,"_LRI_","_LRDFN_","
S TIUIEN=$$GET1^DIQ(TIUREF,IENS,1,"I")
;
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 anatomic pathology study
;
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.5838,"C",PARENTFILE,LRDFN,LRI,MAGGPP)) Q:'MAGGPP D Q:ERRCODE
. . N GROUPDFN ; DFN value from image group entry for double checking
. . S MAGGP=$P(^MAG(2006.5838,MAGGPP,0),"^",4)
. . ; 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)
. . . I FILEDATA("PARENT FILE")'=2006.5838 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.5838 ; Anatomic Pathology temporary file
. . S FILEDATA("PARENT IEN")=LRDFN
. . S FILEDATA("PARENT FILE PTR")=LRI
. . Q
. Q
;
S FILEDATA("MODALITY")=MODALITY
S FILEDATA("PACKAGE")="LAB"
;
; add an image to the MAG PATH CASELIST file (#2005.42)
D IMAGECNT^MAGTP005(ACNUMB,1)
;
; if the 2005 group node does not yet exist, create it
;
I 'MAGGP D Q:ERRCODE ERRCODE ; create the imaging group
. ;
. D NEWGROUP^MAGDIR9A("PATHOLOGY") Q:ERRCODE
. ;
. I FILEDATA("PARENT FILE")=8925 D Q:ERRCODE ; fix for ^TIU
. . S ERRCODE=$$TIUXLINK^MAGDIR9E()
. . Q
. E I FILEDATA("PARENT FILE")=2006.5838 D ; fix for Anatomic Pathology
. . L +^MAG(2006.5838):1E9 ; Background job MUST wait
. . I '$D(^MAG(2006.5838,0)) D
. . . S ^MAG(2006.5838,0)="DICOM LAB TEMP LIST^2006.5838S^0^0"
. . . Q
. . S D0=$P(^MAG(2006.5838,0),"^",3)+1
. . S $P(^MAG(2006.5838,0),"^",3)=D0,$P(^(0),"^",4)=$P(^(0),"^",4)+1
. . L -^MAG(2006.5838)
. . S ^MAG(2006.5838,D0,0)=PARENTFILE_"^"_LRDFN_"^"_LRI_"^"_MAGGP
. . S ^MAG(2006.5838,"C",PARENTFILE,LRDFN,LRI,D0)=""
. . Q
. Q
;
Q 0
;
SUBFILES(LRSS) ; get LAB DATA (#63)subfiles - called by MAGDRPC4
N FILE ; ---- LAB DATA subfile numbers and other info
N ERRSTAT S ERRSTAT=0 ; error status - assume nothing to repor
S ERRSTAT=$$GETFILE^MAGT7MA(LRSS)
I ERRSTAT S (FILEDATA("PROC/EVENT"),PARENTFILE,TIUREF)="" Q
S PARENTFILE=FILE("PARENT FILE")
S TIUREF=FILE("TIU REFERENCE")
S FILEDATA("PROC/EVENT")=FILE("PROC/EVENT")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDIR9F 8089 printed Apr 09, 2024@21:10:02 Page 2
MAGDIR9F ;WOIFO/PMK - Read a DICOM image file ; 17 Jul 2013 11:42 AM
+1 ;;3.0;IMAGING;**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 ; M2MB server
+18 ;
+19 ; This routine creates the group entry in ^MAG(2005) and links it
+20 ; to the request in Anatomic Pathology.
+21 ;
GROUP() ; entry point from ^MAGDIR8 for Anatomic Pathology 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 ;----- lookup string for Fileman
NEW IENS
+6 ;--- pointer to group in DICOM LAB TEMP LIST ^MAG(20006.5838)
NEW MAGGPP
+7 ;-------- scratch variable (pointer to ACQUISITION DEVICE file)
NEW P
+8 ; one of four anatomic pathology files
NEW PARENTFILE
+9 ;--- scratch variable
NEW RESULT
+10 ;- pointer to SOP Class file (#2006.532)
NEW SOPCLASP
+11 ;--- TIU file 8925 IEN value
NEW TIUIEN
+12 ;--- Anatomic Pathology reference file
NEW TIUREF
+13 ;---- error return for GETS^DIQ Filename API call
NEW ERROR
+14 ;
+15 SET ERRCODE=""
+16 ;
+17 ; get study date/time from image header
IF STUDYDAT
IF STUDYTIM
Begin DoDot:1
+18 ; FileMan date.time fmt
SET DATETIME=(STUDYDAT_"."_STUDYTIM)-17000000
+19 QUIT
End DoDot:1
+20 ; use current date/time
IF '$TEST
SET DATETIME=$$NOW^XLFDT()
+21 ;
+22 ; initialize FILEDATA for GROUP and IMAGE
+23 ; get the acquisition device pointer (file 2005, field 107)
+24 SET ACQDEVP=$$ACQDEV^MAGDFCNV(MFGR,MODEL,INSTLOC)
+25 SET FILEDATA("ACQUISITION DEVICE")=ACQDEVP
+26 ; get the SOP Class pointer (file 2005, field 251)
+27 SET SOPCLASP=$ORDER(^MAG(2006.532,"B",SOPCLASS,""))
+28 SET FILEDATA("SOP CLASS POINTER")=SOPCLASP
+29 ;
+30 ; get LAB DATA (#63)subfile
DO SUBFILES(LRSS)
+31 SET FILEDATA("SPEC/SUBSPEC")=$ORDER(^MAG(2005.84,"B","PATHOLOGY",""))
+32 ;
+33 ; initialize pointer to the image group
SET MAGGP=""
+34 ;
+35 ; check if there already is a TIU note attached to this request
+36 ;
+37 SET TIUIEN=0
+38 ;
+39 ; look up TIU note
+40 SET IENS="1,"_LRI_","_LRDFN_","
+41 SET TIUIEN=$$GET1^DIQ(TIUREF,IENS,1,"I")
+42 ;
+43 ; there is TIU note already
IF TIUIEN
Begin DoDot:1
+44 ; double check TIU note DFN to make sure that it matches
+45 ; scratch variable used in finding corresponding image group
NEW HIT
+46 ; DFN value from ^TIU for double checking
NEW TIUDFN
+47 ; TIU External Data File IEN
NEW TIUXDIEN
+48 SET TIUDFN=$PIECE($GET(^TIU(8925,TIUIEN,0)),"^",2)
+49 ; fatal error
IF TIUDFN'=DFN
Begin DoDot:2
+50 DO TIUMISS^MAGDIRVE($TEXT(+0),DFN,TIUIEN,TIUDFN)
+51 SET ERRCODE=-501
+52 QUIT
End DoDot:2
QUIT
+53 ;
+54 ; TIU file
SET FILEDATA("PARENT FILE")=8925
+55 SET FILEDATA("PARENT IEN")=TIUIEN
+56 ;
+57 ; is there an entry in TIU External Data File for this note
+58 SET (HIT,TIUXDIEN)=0
+59 FOR
SET TIUXDIEN=$ORDER(^TIU(8925.91,"B",TIUIEN,TIUXDIEN))
if 'TIUXDIEN
QUIT
Begin DoDot:2
+60 ;----- data value for getting parent file attributes
NEW MAG2
+61 ;- DFN value from image group entry for double checking
NEW GROUPDFN
+62 ; there is a TIU External Data File
+63 ; does the TIU External Data File entry point to an image group?
+64 SET MAGGP=$$GET1^DIQ(8925.91,TIUXDIEN,.02,"I")
if 'MAGGP
QUIT
+65 ; double check image group entry DFN
+66 SET GROUPDFN=$PIECE($GET(^MAG(2005,MAGGP,0)),"^",7)
+67 ; fatal error
IF GROUPDFN'=DFN
Begin DoDot:3
+68 DO MISMATCH^MAGDIRVE($TEXT(+0),DFN,MAGGP)
+69 SET ERRCODE=-502
+70 QUIT
End DoDot:3
QUIT
+71 ; 11=XRAY GROUP
IF $PIECE($GET(^MAG(2005,MAGGP,0)),"^",6)'=11
Begin DoDot:3
+72 ; wrong object type - skip this image group
SET MAGGP=""
+73 QUIT
End DoDot:3
QUIT
+74 ; create a new group if this is for a different Study Instance UID
+75 IF STUDYUID'=$PIECE($GET(^MAG(2005,MAGGP,"PACS")),"^",1)
SET MAGGP=""
QUIT
+76 SET P=$PIECE($GET(^MAG(2005,MAGGP,"SOP")),"^",1)
+77 ; skip this image group if wrong SOP Class
+78 IF '$$EQUIVGRP^MAGDFCNV(P,SOPCLASP)
SET MAGGP=""
QUIT
+79 ; add the new image to this existing image group
+80 SET HIT=1
SET MAG2=$GET(^MAG(2005,MAGGP,2))
+81 SET FILEDATA("PARENT FILE")=$PIECE(MAG2,"^",6)
+82 SET FILEDATA("PARENT IEN")=$PIECE(MAG2,"^",7)
+83 SET FILEDATA("PARENT FILE PTR")=$PIECE(MAG2,"^",8)
+84 ; fatal error
IF FILEDATA("PARENT IEN")'=TIUIEN
Begin DoDot:3
+85 DO TIUMISS2^MAGDIRVE($TEXT(+0),TIUIEN,FILEDATA("PARENT IEN"),TIUXDIEN,MAGGP)
+86 SET ERRCODE=-503
+87 QUIT
End DoDot:3
+88 QUIT
End DoDot:2
if HIT
QUIT
if ERRCODE
QUIT
+89 QUIT
End DoDot:1
if ERRCODE
QUIT ERRCODE
+90 ;
+91 ; need a temporary association for the anatomic pathology study
+92 ;
+93 ; check if there is a temporary association
IF '$TEST
Begin DoDot:1
+94 ;
+95 ; Note: this algorithm creates multiple groups for a study,
+96 ; for instance a GI fluoroscopy + color images
+97 ;
+98 SET MAGGPP=""
+99 FOR
SET MAGGPP=$ORDER(^MAG(2006.5838,"C",PARENTFILE,LRDFN,LRI,MAGGPP))
if 'MAGGPP
QUIT
Begin DoDot:2
+100 ; DFN value from image group entry for double checking
NEW GROUPDFN
+101 SET MAGGP=$PIECE(^MAG(2006.5838,MAGGPP,0),"^",4)
+102 ; double check image group entry DFN in existing 2005 group node
+103 SET GROUPDFN=$PIECE($GET(^MAG(2005,MAGGP,0)),"^",7)
+104 ; fatal error
IF GROUPDFN'=DFN
Begin DoDot:3
+105 DO MISMATCH^MAGDIRVE($TEXT(+0),DFN,MAGGP)
+106 ; bad group
SET MAGGP=""
+107 SET ERRCODE=-504
+108 QUIT
End DoDot:3
+109 ; wrong device
IF '$TEST
SET P=$PIECE($GET(^MAG(2005,MAGGP,100)),"^",4)
IF P
IF P'=ACQDEVP
Begin DoDot:3
+110 ; wrong acquisition device - skip this image group
SET MAGGP=""
+111 QUIT
End DoDot:3
+112 ; add the new image to this existing image group
IF '$TEST
Begin DoDot:3
+113 ; data value for getting parent file attributes
NEW MAG2
+114 SET MAG2=$GET(^MAG(2005,MAGGP,2))
+115 SET FILEDATA("PARENT FILE")=$PIECE(MAG2,"^",6)
+116 SET FILEDATA("PARENT IEN")=$PIECE(MAG2,"^",7)
+117 SET FILEDATA("PARENT FILE PTR")=$PIECE(MAG2,"^",8)
+118 ; fatal error
IF FILEDATA("PARENT FILE")'=2006.5838
Begin DoDot:4
+119 DO TMPMISS^MAGDIRVE($TEXT(+0),FILEDATA("PARENT FILE"),MAGGP)
+120 SET ERRCODE=-505
+121 QUIT
End DoDot:4
+122 QUIT
End DoDot:3
+123 QUIT
End DoDot:2
if ERRCODE
QUIT
+124 ;
+125 ; no group exists yet create a temporary association
IF 'MAGGP
Begin DoDot:2
+126 ; Anatomic Pathology temporary file
SET FILEDATA("PARENT FILE")=2006.5838
+127 SET FILEDATA("PARENT IEN")=LRDFN
+128 SET FILEDATA("PARENT FILE PTR")=LRI
+129 QUIT
End DoDot:2
+130 QUIT
End DoDot:1
if ERRCODE
QUIT ERRCODE
+131 ;
+132 SET FILEDATA("MODALITY")=MODALITY
+133 SET FILEDATA("PACKAGE")="LAB"
+134 ;
+135 ; add an image to the MAG PATH CASELIST file (#2005.42)
+136 DO IMAGECNT^MAGTP005(ACNUMB,1)
+137 ;
+138 ; if the 2005 group node does not yet exist, create it
+139 ;
+140 ; create the imaging group
IF 'MAGGP
Begin DoDot:1
+141 ;
+142 DO NEWGROUP^MAGDIR9A("PATHOLOGY")
if ERRCODE
QUIT
+143 ;
+144 ; fix for ^TIU
IF FILEDATA("PARENT FILE")=8925
Begin DoDot:2
+145 SET ERRCODE=$$TIUXLINK^MAGDIR9E()
+146 QUIT
End DoDot:2
if ERRCODE
QUIT
+147 ; fix for Anatomic Pathology
IF '$TEST
IF FILEDATA("PARENT FILE")=2006.5838
Begin DoDot:2
+148 ; Background job MUST wait
LOCK +^MAG(2006.5838):1E9
+149 IF '$DATA(^MAG(2006.5838,0))
Begin DoDot:3
+150 SET ^MAG(2006.5838,0)="DICOM LAB TEMP LIST^2006.5838S^0^0"
+151 QUIT
End DoDot:3
+152 SET D0=$PIECE(^MAG(2006.5838,0),"^",3)+1
+153 SET $PIECE(^MAG(2006.5838,0),"^",3)=D0
SET $PIECE(^(0),"^",4)=$PIECE(^(0),"^",4)+1
+154 LOCK -^MAG(2006.5838)
+155 SET ^MAG(2006.5838,D0,0)=PARENTFILE_"^"_LRDFN_"^"_LRI_"^"_MAGGP
+156 SET ^MAG(2006.5838,"C",PARENTFILE,LRDFN,LRI,D0)=""
+157 QUIT
End DoDot:2
+158 QUIT
End DoDot:1
if ERRCODE
QUIT ERRCODE
+159 ;
+160 QUIT 0
+161 ;
SUBFILES(LRSS) ; get LAB DATA (#63)subfiles - called by MAGDRPC4
+1 ; ---- LAB DATA subfile numbers and other info
NEW FILE
+2 ; error status - assume nothing to repor
NEW ERRSTAT
SET ERRSTAT=0
+3 SET ERRSTAT=$$GETFILE^MAGT7MA(LRSS)
+4 IF ERRSTAT
SET (FILEDATA("PROC/EVENT"),PARENTFILE,TIUREF)=""
QUIT
+5 SET PARENTFILE=FILE("PARENT FILE")
+6 SET TIUREF=FILE("TIU REFERENCE")
+7 SET FILEDATA("PROC/EVENT")=FILE("PROC/EVENT")
+8 QUIT
