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