Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGDIR9E

MAGDIR9E.m

Go to the documentation of this file.
  1. 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
  1. ;; Per VHA Directive 2004-038, this routine should not be modified.
  1. ;; +---------------------------------------------------------------+
  1. ;; | Property of the US Government. |
  1. ;; | No permission to copy or redistribute this software is given. |
  1. ;; | Use of unreleased versions of this software requires the user |
  1. ;; | to execute a written test agreement with the VistA Imaging |
  1. ;; | Development Office of the Department of Veterans Affairs, |
  1. ;; | telephone (301) 734-0100. |
  1. ;; | The Food and Drug Administration classifies this software as |
  1. ;; | a medical device. As such, it may not be changed in any way. |
  1. ;; | Modifications to this software may result in an adulterated |
  1. ;; | medical device under 21CFR820, the use of which is considered |
  1. ;; | to be a violation of US Federal Statutes. |
  1. ;; +---------------------------------------------------------------+
  1. ;;
  1. ; M2MB server
  1. ;
  1. ; This routine creates the group entry in ^MAG(2005) and links it
  1. ; to the consult/procedure request in GMRC.
  1. ;
  1. ; XXXX XXX X
  1. ; XX XX XX XX
  1. ; XX XXXX XX XXX XXXXXXX XX XXX XX XXXXX
  1. ; XX XX XX XXX XX XX XX XX XX XX
  1. ; XX X XX XX XX XX XXXXXXX XX XX XX XX
  1. ; XX XX XX XX XX XX XX XX XX XX XX XX
  1. ; XXXX XXXX XX XX XXXXXXX XXX XX XXXX XXX
  1. ;
  1. GROUP() ; entry point from ^MAGDIR8 for consult/procedure groups
  1. N ACQDEVP ;-- pointer to acquisition device file (#2006.04)
  1. N D0 ;------- fileman variable
  1. N ERRCODE ;-- error trap code
  1. N GROUP ;---- array to pass group data to ^MAGGTIA
  1. N MAGGPP ;--- pointer to group in DICOM GMRC TEMP LIST ^MAG(20006.5839)
  1. N P ;-------- scratch variable (pointer to ACQUISITION DEVICE file)
  1. N RESULT ;--- scratch variable
  1. N SERVICE ;-- service performing the consult/procedure - ^GMR(123.5)
  1. N SOPCLASP ;- pointer to SOP Class file (#2006.532)
  1. N TIUIEN ;--- TIU file 8925 IEN value
  1. ;
  1. S ERRCODE=""
  1. ;
  1. I STUDYDAT,STUDYTIM D ; get study date/time from image header
  1. . S DATETIME=(STUDYDAT_"."_STUDYTIM)-17000000 ; FileMan date.time fmt
  1. . Q
  1. E S DATETIME=$$NOW^XLFDT() ; use current date/time
  1. ;
  1. ; initialize FILEDATA for GROUP and IMAGE
  1. ; get the acquisition device pointer (file 2005, field 107)
  1. S ACQDEVP=$$ACQDEV^MAGDFCNV(MFGR,MODEL,INSTLOC)
  1. S FILEDATA("ACQUISITION DEVICE")=ACQDEVP
  1. ; get the SOP Class pointer (file 2005, field 251)
  1. S SOPCLASP=$O(^MAG(2006.532,"B",SOPCLASS,""))
  1. S FILEDATA("SOP CLASS POINTER")=SOPCLASP
  1. ;
  1. S MAGGP="" ; initialize pointer to the image group
  1. ;
  1. ; check if there already is a TIU note attached to this request
  1. ;
  1. S TIUIEN=$$TIULAST^MAGDGMRC(GMRCIEN)
  1. I TIUIEN D Q:ERRCODE ERRCODE ; there is TIU note already
  1. . ; double check TIU note DFN to make sure that it matches
  1. . N HIT ; scratch variable used in finding corresponding image group
  1. . N TIUDFN ; DFN value from ^TIU for double checking
  1. . N TIUXDIEN ; TIU External Data File IEN
  1. . S TIUDFN=$P($G(^TIU(8925,TIUIEN,0)),"^",2)
  1. . I TIUDFN'=DFN D Q ; fatal error
  1. . . D TIUMISS^MAGDIRVE($T(+0),DFN,TIUIEN,TIUDFN)
  1. . . S ERRCODE=-501
  1. . . Q
  1. . ;
  1. . S FILEDATA("PARENT FILE")=8925 ; TIU file
  1. . S FILEDATA("PARENT IEN")=TIUIEN
  1. . ;
  1. . ; is there an entry in TIU External Data File for this note
  1. . S (HIT,TIUXDIEN)=0
  1. . F S TIUXDIEN=$O(^TIU(8925.91,"B",TIUIEN,TIUXDIEN)) Q:'TIUXDIEN D Q:HIT Q:ERRCODE
  1. . . N MAG2 ;----- data value for getting parent file attributes
  1. . . N GROUPDFN ;- DFN value from image group entry for double checking
  1. . . ; there is a TIU External Data File
  1. . . ; does the TIU External Data File entry point to an image group?
  1. . . S MAGGP=$$GET1^DIQ(8925.91,TIUXDIEN,.02,"I") Q:'MAGGP
  1. . . ; double check image group entry DFN
  1. . . S GROUPDFN=$P($G(^MAG(2005,MAGGP,0)),"^",7)
  1. . . I GROUPDFN'=DFN D Q ; fatal error
  1. . . . D MISMATCH^MAGDIRVE($T(+0),DFN,MAGGP)
  1. . . . S ERRCODE=-502
  1. . . . Q
  1. . . I $P($G(^MAG(2005,MAGGP,0)),"^",6)'=11 D Q ; 11=XRAY GROUP
  1. . . . S MAGGP="" ; wrong object type - skip this image group
  1. . . . Q
  1. . . ; create a new group if this is for a different Study Instance UID
  1. . . I STUDYUID'=$P($G(^MAG(2005,MAGGP,"PACS")),"^",1) S MAGGP="" Q
  1. . . S P=$P($G(^MAG(2005,MAGGP,"SOP")),"^",1)
  1. . . ; skip this image group if wrong SOP Class
  1. . . I '$$EQUIVGRP^MAGDFCNV(P,SOPCLASP) S MAGGP="" Q
  1. . . ; add the new image to this existing image group
  1. . . S HIT=1,MAG2=$G(^MAG(2005,MAGGP,2))
  1. . . S FILEDATA("PARENT FILE")=$P(MAG2,"^",6)
  1. . . S FILEDATA("PARENT IEN")=$P(MAG2,"^",7)
  1. . . S FILEDATA("PARENT FILE PTR")=$P(MAG2,"^",8)
  1. . . I FILEDATA("PARENT IEN")'=TIUIEN D ; fatal error
  1. . . . D TIUMISS2^MAGDIRVE($T(+0),TIUIEN,FILEDATA("PARENT IEN"),TIUXDIEN,MAGGP)
  1. . . . S ERRCODE=-503
  1. . . . Q
  1. . . Q
  1. . Q
  1. ;
  1. ; need a temporary association for the consult/procedure request
  1. ;
  1. E D Q:ERRCODE ERRCODE ; check if there is a temporary association
  1. . ;
  1. . ; Note: this algorithm creates multiple groups for a study,
  1. . ; for instance a GI fluoroscopy + color images
  1. . ;
  1. . S MAGGPP=""
  1. . F S MAGGPP=$O(^MAG(2006.5839,"C",123,GMRCIEN,MAGGPP)) Q:'MAGGPP D Q:ERRCODE
  1. . . N GROUPDFN ; DFN value from image group entry for double checking
  1. . . S MAGGP=$P(^MAG(2006.5839,MAGGPP,0),"^",3)
  1. . . ; double check image group entry DFN in existing 2005 group node
  1. . . S GROUPDFN=$P($G(^MAG(2005,MAGGP,0)),"^",7)
  1. . . I GROUPDFN'=DFN D ; fatal error
  1. . . . D MISMATCH^MAGDIRVE($T(+0),DFN,MAGGP)
  1. . . . S MAGGP="" ; bad group
  1. . . . S ERRCODE=-504
  1. . . . Q
  1. . . E S P=$P($G(^MAG(2005,MAGGP,100)),"^",4) I P,P'=ACQDEVP D ; wrong device
  1. . . . S MAGGP="" ; wrong acquisition device - skip this image group
  1. . . . Q
  1. . . E D ; add the new image to this existing image group
  1. . . . N MAG2 ; data value for getting parent file attributes
  1. . . . S MAG2=$G(^MAG(2005,MAGGP,2))
  1. . . . S FILEDATA("PARENT FILE")=$P(MAG2,"^",6)
  1. . . . S FILEDATA("PARENT IEN")=$P(MAG2,"^",7)
  1. . . . S FILEDATA("PARENT FILE PTR")=$P(MAG2,"^",8) ; should be null
  1. . . . I FILEDATA("PARENT FILE")'=2006.5839 D ; fatal error
  1. . . . . D TMPMISS^MAGDIRVE($T(+0),FILEDATA("PARENT FILE"),MAGGP)
  1. . . . . S ERRCODE=-505
  1. . . . . Q
  1. . . . Q
  1. . . Q
  1. . ;
  1. . I 'MAGGP D ; no group exists yet create a temporary association
  1. . . S FILEDATA("PARENT FILE")=2006.5839 ; GMRC file
  1. . . S FILEDATA("PARENT IEN")=GMRCIEN
  1. . . Q
  1. . Q
  1. ;
  1. S FILEDATA("MODALITY")=MODALITY
  1. S FILEDATA("PACKAGE")="CONS"
  1. ;
  1. ; add the study to the Consult Unread List, if necessary
  1. D ADD^MAGDTR03(.RESULT,GMRCIEN,"I",1) ; add if "on image" is set
  1. ;
  1. S (FILEDATA("SPEC/SUBSPEC"),FILEDATA("PROC/EVENT"))=""
  1. ;
  1. ; lookup study in ^GMR(123) and get FILEDATA variables
  1. ;
  1. S SERVICE=$$GET1^DIQ(123,GMRCIEN,1,"I")
  1. I SERVICE D ; look for ISPECIDX and IPROCIDX
  1. . N DONE,ISPECIDX1,ISPECIDX2,IPROCIDX1,IPROCIDX2,MWLCONFIG,UNREAD,X,Y
  1. . ;
  1. . S (ISPECIDX1,ISPECIDX2,IPROCIDX1,IPROCIDX2)=""
  1. . ;
  1. . ; look in CLINICAL SPECIALTY DICOM & HL7 file #2006.5831 first
  1. . S MWLCONFIG=$$MWLFIND^MAGDHOW1(SERVICE,GMRCIEN)
  1. . I MWLCONFIG D Q:DONE
  1. . . S X=^MAG(2006.5831,MWLCONFIG,0)
  1. . . S ISPECIDX1=$P(X,"^",3),IPROCIDX1=$P(X,"^",4)
  1. . . S DONE=$$IMAGEIDX(ISPECIDX1,IPROCIDX1,.FILEDATA)
  1. . . Q
  1. . ;
  1. . ; look in TeleReader READ/UNREAD LIST file #2006.5849 next
  1. . S UNREAD=$O(^MAG(2006.5849,"B",GMRCIEN,""))
  1. . I UNREAD D Q:DONE
  1. . . S X=^MAG(2006.5849,UNREAD,0)
  1. . . S ISPECIDX2=$P(X,"^",3),IPROCIDX2=$P(X,"^",4)
  1. . . S DONE=$$IMAGEIDX(ISPECIDX2,IPROCIDX2,.FILEDATA)
  1. . . Q
  1. . ;
  1. . ; inactive index to procedure
  1. . S X=$$FIELD43^MAGXMA(FILEDATA("MODALITY"),ISPECIDX1,.Y)
  1. . S FILEDATA("PROC/EVENT")=$S(X=0:Y,1:"")
  1. . Q
  1. ;
  1. ; if the 2005 group node does not yet exist, create it
  1. ;
  1. I 'MAGGP D Q:ERRCODE ERRCODE ; create the imaging group
  1. . D NEWGROUP^MAGDIR9A("CON/PROC") Q:ERRCODE
  1. . ;
  1. . I FILEDATA("PARENT FILE")=8925 D Q:ERRCODE ; fix for ^TIU
  1. . . S ERRCODE=$$TIUXLINK^MAGDIR9E()
  1. . . Q
  1. . E I FILEDATA("PARENT FILE")=2006.5839 D ; fix for ^GMR
  1. . . L +^MAG(2006.5839):1E9 ; Background job MUST wait
  1. . . I '$D(^MAG(2006.5839,0)) D
  1. . . . S ^MAG(2006.5839,0)="DICOM GMRC TEMP LIST^^0^0"
  1. . . . Q
  1. . . S D0=$P(^MAG(2006.5839,0),"^",3)+1
  1. . . S $P(^MAG(2006.5839,0),"^",3)=D0,$P(^(0),"^",4)=$P(^(0),"^",4)+1
  1. . . L -^MAG(2006.5839)
  1. . . S ^MAG(2006.5839,D0,0)="123^"_GMRCIEN_"^"_MAGGP
  1. . . S ^MAG(2006.5839,"C",123,GMRCIEN,D0)=""
  1. . . Q
  1. . Q
  1. ;
  1. ; check for intra-oral x-ray images & get tooth number(s)
  1. I IMAGNAME'="" S FILEDATA("SHORT DESCRIPTION")=IMAGNAME
  1. ;
  1. Q 0
  1. ;
  1. IMAGEIDX(ISPECIDX,IPROCIDX,FILEDATA) ; set image index for specialty and procedure
  1. N NFIELDS
  1. ;
  1. S NFIELDS=0
  1. ;
  1. I FILEDATA("SPEC/SUBSPEC") S NFIELDS=NFIELDS+1
  1. E I ISPECIDX,"A"[$P(^MAG(2005.84,ISPECIDX,0),"^",4) D
  1. . S FILEDATA("SPEC/SUBSPEC")=ISPECIDX
  1. . S NFIELDS=NFIELDS+1
  1. . Q
  1. ;
  1. I FILEDATA("PROC/EVENT") S NFIELDS=NFIELDS+1
  1. E I IPROCIDX,"A"[$P(^MAG(2005.85,IPROCIDX,0),"^",3) D
  1. . S FILEDATA("PROC/EVENT")=IPROCIDX
  1. . S NFIELDS=NFIELDS+1
  1. . Q
  1. . I
  1. ;
  1. Q NFIELDS=2
  1. ;
  1. N TIUXDIEN
  1. D PUTIMAGE^TIUSRVPL(.TIUXDIEN,TIUIEN,MAGGP)
  1. I TIUXDIEN D
  1. . S FILEDATA("PARENT FILE PTR")=TIUXDIEN
  1. . S $P(^MAG(2005,MAGGP,2),"^",8)=TIUXDIEN
  1. . Q
  1. E D Q ERRCODE ; fatal error
  1. . K MSG
  1. . S MSG(1)="ERROR ASSOCIATING WITH TIU EXTERNAL DATA LINK (file 8925.91):"
  1. . S MSG(2)=$P(TIUXDIEN,"^",2,999)
  1. . D BADERROR^MAGDIRVE($T(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
  1. . S ERRCODE=-508
  1. . Q
  1. Q 0
  1. ;