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

MAGBRTE3.m

Go to the documentation of this file. 
  1. MAGBRTE3 ;WOIFO/EdM/DAC - Find value of variable ; 02/08/2017  1:05PM
  1.  ;;3.0;IMAGING;**11,51,166**;Mar 19, 2002;Build 45
  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.  ;; |                                                               |
  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.  ;
  1.  ; The subroutines in this routine calculate the values for
  1.  ; certain variables that may be needed for the "routing rule processor"
  1.  ;
  1.  ; Entry DICOM is the generic value finder that looks for values
  1.  ; in the data structure that describes an image file.
  1.  ; The other entries deal with other (computed) values.
  1.  ;
  1.  ; The value is always returned in output parameter VAL.
  1.  ; Note that this variable needs to be an output parameter,
  1.  ; because in some cases an "undefined value" needs to be returned,
  1.  ; and in some cases, multiple values may need to be returned.
  1.  ;
  1. DICOM(NAME,TYPE,VAL) N C,I,N,X
  1.  ;
  1.  ; Arbitrary decision: the routine stops when the first occurrence
  1.  ; of a value is found.
  1.  ; Should we continue until we find all codes that have values?
  1.  ;
  1.  S C="" F  S C=$O(KEYWORD("CONDITION",NAME,C)) Q:C=""  D  Q:$D(VAL)
  1.  . Q:'$D(^TMP("MAG",$J,"DICOM",TYPE,C))
  1.  . S (I,N)=0 F  S N=$O(^TMP("MAG",$J,"DICOM",TYPE,C,N)) Q:N=""  D
  1.  . . S X=$G(^TMP("MAG",$J,"DICOM",TYPE,C,N,1),"<unknown>") Q:X="<unknown>"
  1.  . . S I=I+1,N(I)=X
  1.  . . Q
  1.  . Q:'I
  1.  . I I=1 S VAL=N(1) Q
  1.  . F N=1:1:I S VAL(N)=N(N)
  1.  . Q
  1.  Q
  1.  ;
  1. NOW(VAL) N %,DISYS,X
  1.  ; P166 DAC - 'NOW^%DTC' required after update to FileMan v22.2
  1.  D DT^DICRW,NOW^%DTC
  1.  S VAL=$P("THU FRI SAT SUN MON TUE WED"," ",$H#7+1)_" "_%
  1.  Q
  1.  ;
  1. SOURCE(IMAGE,VAL) N X
  1.  S X=$P($G(^MAG(2005,IMAGE,100)),"^",3)
  1.  S:'X X=$G(DUZ(2))
  1.  S:'X X=$$KSP^XUPARAM("INST")
  1.  S VAL=$$GET1^DIQ(4,+X,.01)
  1.  Q
  1.  ;
  1. MAG(IMAGE,TYPE,NODE,PIECE,VAL) N D0,D1,PARENT,X
  1.  ; First look in the image itself,
  1.  ; then in its parent (if any)
  1.  ; then in any siblings.
  1.  ; Return the first value found.
  1.  ;
  1.  K VAL
  1.  S X=$P($G(^MAG(2005,IMAGE,NODE)),"^",PIECE) I X'="" S VAL=X D:$D(VAL) MAGX Q
  1.  ;
  1.  S PARENT=$P($G(^MAG(2005,IMAGE,0)),"^",10) Q:PARENT=""
  1.  S X=$P($G(^MAG(2005,PARENT,NODE)),"^",PIECE) I X'="" S VAL=X D:$D(VAL) MAGX Q
  1.  ;
  1.  S D1=0 F  S D1=$O(^MAG(2005,IMAGE,1,D1)) Q:'D1  D  Q:$D(VAL)
  1.  . S D0=$G(^MAG(2005,IMAGE,1,D1,1)) Q:'D0
  1.  . S X=$P($G(^MAG(2005,D0,NODE)),"^",PIECE) I X'="" S VAL=X Q
  1.  . Q
  1.  D:$D(VAL) MAGX
  1.  Q
  1.  ;
  1. MAGX I TYPE=0 Q
  1.  I (TYPE=2005.02)!(TYPE=2005.03)!(TYPE=2005.81)!(TYPE=2005.2) D  Q
  1.  . S X=$P($G(^MAG(TYPE,+VAL,0)),"^",1) K VAL S:X'="" VAL=X
  1.  . Q
  1.  I TYPE=2 D  Q
  1.  . S X=$P($G(^DPT(+VAL,0)),"^",1) K VAL S:X'="" VAL=X ; IA 10035
  1.  . Q
  1.  I TYPE=200 D  Q
  1.  . S X=$$GET1^DIQ(200,+VAL,.01) K VAL S:X'="" VAL=X ; IA 10060
  1.  . Q
  1.  I TYPE=44 D  Q
  1.  . S X=$P($G(^SC(+VAL,0)),"^",1) K VAL S:X'="" VAL=X ; IA 10040
  1.  . Q
  1.  I TYPE=71 D  Q
  1.  . S X=$P($G(^RAMIS(71,+VAL,0)),"^",1) K VAL S:X'="" VAL=X ; IA 1174
  1.  . Q
  1.  I TYPE=74 D  Q
  1.  . S X=$P($G(^RARPT(+VAL,0)),"^",1) K VAL S:X'="" VAL=X ; IA 1171
  1.  . Q
  1.  Q
  1.  ;
  1. DATE(IMAGE,TYPE,NODE,PIECE,WHEN,VAL) N D0,D1,FIRST,LAST,PARENT,X
  1.  ; First look in the image itself,
  1.  ; then in its parent (if any)
  1.  ; then in any siblings.
  1.  ; Return the first value found.
  1.  ;
  1.  K VAL
  1.  I WHEN=0 D MAG(IMAGE,TYPE,NODE,PIECE,.VAL) Q
  1.  ;
  1.  S X=$P($G(^MAG(2005,IMAGE,NODE)),"^",PIECE) I X'="" S X(X)=""
  1.  ;
  1.  S PARENT=$P($G(^MAG(2005,IMAGE,0)),"^",10) Q:PARENT=""
  1.  S X=$P($G(^MAG(2005,PARENT,NODE)),"^",PIECE) I X'="" S X(X)=""
  1.  ;
  1.  S D1=0 F  S D1=$O(^MAG(2005,IMAGE,1,D1)) Q:'D1  D
  1.  . S D0=$G(^MAG(2005,IMAGE,1,D1,1)) Q:'D0
  1.  . S X=$P($G(^MAG(2005,D0,NODE)),"^",PIECE) I X'="" S X(X)=""
  1.  . Q
  1.  ;
  1.  I WHEN=1 S VAL=$O(X(""),+1)
  1.  I WHEN=2 S VAL=$O(X(""),-1)
  1.  K:VAL="" VAL
  1.  Q
  1.  ;
  1. URGENCY(IMAGE,VAL) N P
  1.  S P=$$PRI^MAGBRTE4("NORMAL",IMAGE)
  1.  S VAL=$S(P=500:"ROUTINE",P=510:"URGENT",P=520:"STAT",1:P)
  1.  Q
  1.  ;