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

MAGDIR9A.m

Go to the documentation of this file. 
  1. 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
  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.  Q
  1.  ; M2MB server
  1.  ;
  1.  ; This routine creates a ^mag(2005) group entry and links it to the
  1.  ; associated radiology report
  1.  ;
  1.  ;   XXXXXX      XX    XXXXXX
  1.  ;    XX  XX    XXXX    XX  XX
  1.  ;    XX  XX   XX  XX   XX  XX
  1.  ;    XXXXX    XX  XX   XX  XX
  1.  ;    XX XX    XXXXXX   XX  XX
  1.  ;    XX  XX   XX  XX   XX  XX
  1.  ;   XXX  XX   XX  XX  XXXXXX
  1.  ;
  1. GROUP() ; entry point from ^MAGDIR81
  1.  N ACQDEVP ;-- pointer to acquisition device file (#2006.04)
  1.  N DA ;------ fileman variable
  1.  N ERRCODE ;- error trap code
  1.  N GROUP ;--- array to pass group data to ^MAGGTIA
  1.  N GROUPDFN ; DFN value from image group entry for double checking
  1.  N P ;------- scratch variable (pointer to ACQUISITION DEVICE file)
  1.  N RACNE ;--- external "3rd level" subscript in ^RADPT
  1.  N RACNI ;--- internal "3rd level" subscript in ^RADPT
  1.  N RADFN ;--- radiology package's DFN
  1.  N RADTE ;--- external "2nd level" subscript in ^RADPT
  1.  N RADTI ;--- internal "2nd level" subscript in ^RADPT
  1.  N RARPT ;--- 1st level node in ^RARPT for report (ie, the ien)
  1.  N RARPT3 ;-- 3rd level node for 2005 multiple under ^RARPT's report
  1.  N RARPTDFN ; DFN value from ^RARPT for double checking
  1.  N RETURN ;-- variable returned by ^MAGGTIA
  1.  N SOPCLASP ; pointer to SOP Class file (#2006.532)
  1.  N HIT,ISPECIDX,X,Y ; scratch variables
  1.  ;
  1.  S ERRCODE=""
  1.  ;
  1.  S (RADFN,DA(2))=DFN ; patient DFN variables
  1.  S RADTI=RADATA("RADPT2") ; case subscript
  1.  I RADTI="" D  Q ERRCODE
  1.  . K MSG
  1.  . S MSG(1)="No radiology case number specified for patient "_DFN
  1.  . D ERROR^MAGDIRVE($T(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
  1.  . S ERRCODE=-301
  1.  . Q
  1.  ;
  1.  S RADTE=9999999.9999-RADTI ; 9's complement conversion
  1.  S RACNI=RADATA("RADPT3")
  1.  S RACNE=$P(CASENUMB,"-",$L(CASENUMB,"-")) ; short case #
  1.  ;
  1.  ; check for the existence of the entry in ^RADPT (redundant)
  1.  I '$D(^RADPT(RADFN,"DT",RADTI,0)) D  Q ERRCODE ; can't process further
  1.  . K MSG
  1.  . S MSG(1)="Radiology case "_RADTI_" is not in ^RADPT("_RADFN_")"
  1.  . D ERROR^MAGDIRVE($T(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
  1.  . S ERRCODE=-302
  1.  . Q
  1.  ;
  1.  ; check for the existence of the report pointer
  1.  S RARPT=$P($G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0)),"^",17)
  1.  ; if the report does not yet exist, create it
  1.  ; 
  1.  I RARPT="" D  Q:ERRCODE ERRCODE ; can't process further
  1.  . N RACN,RATIMEOUT
  1.  . S RATIMEOUT=1
  1.  . S RACN=RACNE D CREATE^RARIC ; create the report
  1.  . ;
  1.  . I RARPT="-1^radiology exam locked" S ERRCODE="-399^"_$P(RARPT,"^",2) Q
  1.  . ;
  1.  . ; If RARPT is no longer defined at this point, this means
  1.  . ; that we're dealing with an old study, and the report has
  1.  . ; been archived and purged.
  1.  . ;
  1.  . I '$G(RARPT) D  Q
  1.  . . K MSG
  1.  . . S MSG(1)="IMAGE GROUP CREATION ERROR:"
  1.  . . S MSG(2)="Radiology Report has been archived and purged."
  1.  . . S MSG(3)="Patient "_$G(RADFN)_", 9's Complement Date "_$G(RADTI)_", Case "_$G(RACNI)
  1.  . . D ERROR^MAGDIRVE($T(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
  1.  . . S ERRCODE=-303
  1.  . . Q
  1.  . Q
  1.  ;
  1.  ; double check the DFN value from ^RARPT to make sure its right
  1.  S RARPTDFN=$P($G(^RARPT(RARPT,0)),"^",2)
  1.  I RARPTDFN'=DFN D  Q ERRCODE ; fatal error
  1.  . D RADMISS^MAGDIRVE($T(+0),DFN,RARPT,RARPTDFN)
  1.  . S ERRCODE=-304
  1.  . Q
  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 FILEDATA("MODALITY")=MODALITY
  1.  S FILEDATA("PARENT FILE")=74
  1.  S FILEDATA("PARENT IEN")=RARPT
  1.  S FILEDATA("RAD REPORT")=RARPT
  1.  S FILEDATA("RAD PROC PTR")=RADATA("PROCIEN")
  1.  S FILEDATA("PACKAGE")="RAD"
  1.  S X=$S(MODALITY="NM":"NUCLEAR MEDICINE",1:"RADIOLOGY")
  1.  S ISPECIDX=$O(^MAG(2005.84,"B",X,""))
  1.  S X=$$FIELD43^MAGXMA(MODALITY,ISPECIDX,.Y)
  1.  S FILEDATA("PROC/EVENT")=$S(X=0:Y,1:"")
  1.  S FILEDATA("SPEC/SUBSPEC")=ISPECIDX
  1.  ;
  1.  ; find the corresponding image group node under the report
  1.  S (HIT,RARPT3)=0
  1.  F  S RARPT3=$O(^RARPT(RARPT,2005,RARPT3)) Q:'RARPT3  D  Q:HIT  Q:ERRCODE
  1.  . S MAGGP=+$G(^RARPT(RARPT,2005,RARPT3,0)) ; get imaging group pointer
  1.  . S GROUPDFN=$P($G(^MAG(2005,MAGGP,0)),"^",7) ; check image DFN value
  1.  . I GROUPDFN'=DFN D  ; fatal error
  1.  . . D MISMATCH^MAGDIRVE($T(+0),DFN,MAGGP)
  1.  . . S ERRCODE=-305
  1.  . . Q
  1.  . E  I $P($G(^MAG(2005,MAGGP,0)),"^",6)=11 D
  1.  . . ; create a new group if this is for a different Study Instance UID
  1.  . . I STUDYUID'=$P($G(^MAG(2005,MAGGP,"PACS")),"^",1) Q
  1.  . . ; check to see that this group is for the same SOP Class
  1.  . . S P=$P($G(^MAG(2005,MAGGP,"SOP")),"^",1)
  1.  . . S HIT=$$EQUIVGRP^MAGDFCNV(P,SOPCLASP) ; equivalent groups?
  1.  . . Q
  1.  . Q
  1.  ;
  1.  I ERRCODE Q ERRCODE ; fatal image DFN problem
  1.  ;
  1.  I 'HIT D  Q:ERRCODE ERRCODE ; the 2005 node does not yet exist
  1.  . ; create the radiology imaging group
  1.  . N PROCEDUR,RADRPT,RADPTR
  1.  . S PROCEDUR="RAD "_FILEDATA("MODALITY")
  1.  . S RADRPT=FILEDATA("RAD REPORT")
  1.  . S RADPTR=FILEDATA("RAD PROC PTR")
  1.  . ;
  1.  . L +^RARPT(RARPT):$G(DILOCKTM,5)
  1.  . I '$T S ERRCODE="-399^radiology report locked - image processing blocked" Q
  1.  . L -^RARPT(RARPT)
  1.  . ;
  1.  . D NEWGROUP(PROCEDUR,RADRPT,RADPTR) Q:ERRCODE
  1.  . ;
  1.  . ; store the cross-reference for the report
  1.  . D PTR^RARIC Q:Y>0
  1.  . I Y="-1^radiology report locked" S ERRCODE="-399^"_$P(Y,"^",2)
  1.  . E  I Y=0 S ERRCODE=-311
  1.  . E  S ERRCODE=-312
  1.  . Q
  1.  ;
  1.  I 'MAGGP D  Q ERRCODE ; fatal error
  1.  . K MSG
  1.  . S MSG(1)="IMAGE GROUP LOOKUP ERROR:"
  1.  . S MSG(2)="Looking for 2005 cross reference in ^RARPT("_RARPT_")"
  1.  . D ERROR^MAGDIRVE($T(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
  1.  . S ERRCODE=-308
  1.  . Q
  1.  Q 0
  1.  ;
  1. NEWGROUP(PROCEDUR,RADRPT,RADPTR) ; create an imaging group (called by ^MAGDIR9E)
  1.  N I
  1.  K GROUP S I=0
  1.  S I=I+1,GROUP(I)=".01^"_PNAMEVAH_"  "_DCMPID_"  "_PROCDESC
  1.  S I=I+1,GROUP(I)="3^11" ; Object Type -- XRAY Group
  1.  S I=I+1,GROUP(I)="5^"_DFN
  1.  S I=I+1,GROUP(I)="6^"_PROCEDUR
  1.  S I=I+1,GROUP(I)="2005.04^0"
  1.  S I=I+1,GROUP(I)="10^"_PROCDESC
  1.  S I=I+1,GROUP(I)="15^"_DATETIME
  1.  S I=I+1,GROUP(I)="16^"_FILEDATA("PARENT FILE")
  1.  S I=I+1,GROUP(I)="17^"_FILEDATA("PARENT IEN")
  1.  S:$D(FILEDATA("PARENT FILE PTR")) I=I+1,GROUP(I)="18^"_FILEDATA("PARENT FILE PTR")
  1.  S I=I+1,GROUP(I)="60^"_STUDYUID
  1.  ;
  1.  ; the following two fields are only for radiology
  1.  I $D(RADRPT) S I=I+1,GROUP(I)="61^"_RADRPT
  1.  I $D(RADPTR) S I=I+1,GROUP(I)="62^"_RADPTR
  1.  ;
  1.  S I=I+1,GROUP(I)=".05^"_INSTLOC
  1.  S I=I+1,GROUP(I)="40^"_FILEDATA("PACKAGE")
  1.  S I=I+1,GROUP(I)="41^"_$O(^MAG(2005.82,"B","CLIN",""))
  1.  S I=I+1,GROUP(I)="42^"_FILEDATA("TYPE")
  1.  S I=I+1,GROUP(I)="43^"_FILEDATA("PROC/EVENT")
  1.  S I=I+1,GROUP(I)="44^"_FILEDATA("SPEC/SUBSPEC")
  1.  S I=I+1,GROUP(I)="45^"_ORIGINDX
  1.  S I=I+1,GROUP(I)="107^"_FILEDATA("ACQUISITION DEVICE")
  1.  S I=I+1,GROUP(I)="110^"_STAMP
  1.  S I=I+1,GROUP(I)="251^"_FILEDATA("SOP CLASS POINTER")
  1.  D ADD^MAGGTIA(.RETURN,.GROUP)
  1.  S MAGGP=+RETURN
  1.  I 'MAGGP D  Q  ; fatal error
  1.  . K MSG
  1.  . S MSG(1)="IMAGE GROUP CREATION ERROR:"
  1.  . S MSG(2)=$P(RETURN,"^",2,999)
  1.  . D BADERROR^MAGDIRVE($T(+0),"DICOM IMAGE PROCESSING ERROR",.MSG)
  1.  . S ERRCODE=-306
  1.  . Q
  1.  ;
  1.  I MAGGP<LASTIMG D  Q  ; fatal last image pointer error
  1.  . D GROUPPTR^MAGDIRVE($T(+0),MAGGP,LASTIMG)
  1.  . S ERRCODE=-307
  1.  . Q
  1.  Q
  1.  ;