| 1 | MAGBRTE3 ;WOIFO/EdM - Find value of variable ; 08/26/2005 07:46
|
|---|
| 2 | ;;3.0;IMAGING;**11,51**;26-August-2005
|
|---|
| 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 | ;; | |
|
|---|
| 11 | ;; | The Food and Drug Administration classifies this software as |
|
|---|
| 12 | ;; | a medical device. As such, it may not be changed in any way. |
|
|---|
| 13 | ;; | Modifications to this software may result in an adulterated |
|
|---|
| 14 | ;; | medical device under 21CFR820, the use of which is considered |
|
|---|
| 15 | ;; | to be a violation of US Federal Statutes. |
|
|---|
| 16 | ;; +---------------------------------------------------------------+
|
|---|
| 17 | ;;
|
|---|
| 18 | Q
|
|---|
| 19 | ;
|
|---|
| 20 | ; The subroutines in this routine calculate the values for
|
|---|
| 21 | ; certain variables that may be needed for the "routing rule processor"
|
|---|
| 22 | ;
|
|---|
| 23 | ; Entry DICOM is the generic value finder that looks for values
|
|---|
| 24 | ; in the data structure that describes an image file.
|
|---|
| 25 | ; The other entries deal with other (computed) values.
|
|---|
| 26 | ;
|
|---|
| 27 | ; The value is always returned in output parameter VAL.
|
|---|
| 28 | ; Note that this variable needs to be an output parameter,
|
|---|
| 29 | ; because in some cases an "undefined value" needs to be returned,
|
|---|
| 30 | ; and in some cases, multiple values may need to be returned.
|
|---|
| 31 | ;
|
|---|
| 32 | DICOM(NAME,TYPE,VAL) N C,I,N,X
|
|---|
| 33 | ;
|
|---|
| 34 | ; Arbitrary decision: the routine stops when the first occurrence
|
|---|
| 35 | ; of a value is found.
|
|---|
| 36 | ; Should we continue until we find all codes that have values?
|
|---|
| 37 | ;
|
|---|
| 38 | S C="" F S C=$O(KEYWORD("CONDITION",NAME,C)) Q:C="" D Q:$D(VAL)
|
|---|
| 39 | . Q:'$D(^TMP("MAG",$J,"DICOM",TYPE,C))
|
|---|
| 40 | . S (I,N)=0 F S N=$O(^TMP("MAG",$J,"DICOM",TYPE,C,N)) Q:N="" D
|
|---|
| 41 | . . S X=$G(^TMP("MAG",$J,"DICOM",TYPE,C,N,1),"<unknown>") Q:X="<unknown>"
|
|---|
| 42 | . . S I=I+1,N(I)=X
|
|---|
| 43 | . . Q
|
|---|
| 44 | . Q:'I
|
|---|
| 45 | . I I=1 S VAL=N(1) Q
|
|---|
| 46 | . F N=1:1:I S VAL(N)=N(N)
|
|---|
| 47 | . Q
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
| 50 | NOW(VAL) N %,DISYS,X
|
|---|
| 51 | D DT^DICRW
|
|---|
| 52 | S VAL=$P("THU FRI SAT SUN MON TUE WED"," ",$H#7+1)_" "_%
|
|---|
| 53 | Q
|
|---|
| 54 | ;
|
|---|
| 55 | SOURCE(IMAGE,VAL) N X
|
|---|
| 56 | S X=$P($G(^MAG(2005,IMAGE,100)),"^",3)
|
|---|
| 57 | S:'X X=$G(DUZ(2))
|
|---|
| 58 | S:'X X=$$KSP^XUPARAM("INST")
|
|---|
| 59 | S VAL=$$GET1^DIQ(4,+X,.01)
|
|---|
| 60 | Q
|
|---|
| 61 | ;
|
|---|
| 62 | MAG(IMAGE,TYPE,NODE,PIECE,VAL) N D0,D1,PARENT,X
|
|---|
| 63 | ; First look in the image itself,
|
|---|
| 64 | ; then in its parent (if any)
|
|---|
| 65 | ; then in any siblings.
|
|---|
| 66 | ; Return the first value found.
|
|---|
| 67 | ;
|
|---|
| 68 | K VAL
|
|---|
| 69 | S X=$P($G(^MAG(2005,IMAGE,NODE)),"^",PIECE) I X'="" S VAL=X D:$D(VAL) MAGX Q
|
|---|
| 70 | ;
|
|---|
| 71 | S PARENT=$P($G(^MAG(2005,IMAGE,0)),"^",10) Q:PARENT=""
|
|---|
| 72 | S X=$P($G(^MAG(2005,PARENT,NODE)),"^",PIECE) I X'="" S VAL=X D:$D(VAL) MAGX Q
|
|---|
| 73 | ;
|
|---|
| 74 | S D1=0 F S D1=$O(^MAG(2005,IMAGE,1,D1)) Q:'D1 D Q:$D(VAL)
|
|---|
| 75 | . S D0=$G(^MAG(2005,IMAGE,1,D1,1)) Q:'D0
|
|---|
| 76 | . S X=$P($G(^MAG(2005,D0,NODE)),"^",PIECE) I X'="" S VAL=X Q
|
|---|
| 77 | . Q
|
|---|
| 78 | D:$D(VAL) MAGX
|
|---|
| 79 | Q
|
|---|
| 80 | ;
|
|---|
| 81 | MAGX I TYPE=0 Q
|
|---|
| 82 | I (TYPE=2005.02)!(TYPE=2005.03)!(TYPE=2005.81)!(TYPE=2005.2) D Q
|
|---|
| 83 | . S X=$P($G(^MAG(TYPE,+VAL,0)),"^",1) K VAL S:X'="" VAL=X
|
|---|
| 84 | . Q
|
|---|
| 85 | I TYPE=2 D Q
|
|---|
| 86 | . S X=$P($G(^DPT(+VAL,0)),"^",1) K VAL S:X'="" VAL=X ; IA 10035
|
|---|
| 87 | . Q
|
|---|
| 88 | I TYPE=200 D Q
|
|---|
| 89 | . S X=$$GET1^DIQ(200,+VAL,.01) K VAL S:X'="" VAL=X ; IA 10060
|
|---|
| 90 | . Q
|
|---|
| 91 | I TYPE=44 D Q
|
|---|
| 92 | . S X=$P($G(^SC(+VAL,0)),"^",1) K VAL S:X'="" VAL=X ; IA 10040
|
|---|
| 93 | . Q
|
|---|
| 94 | I TYPE=71 D Q
|
|---|
| 95 | . S X=$P($G(^RAMIS(71,+VAL,0)),"^",1) K VAL S:X'="" VAL=X ; IA 1174
|
|---|
| 96 | . Q
|
|---|
| 97 | I TYPE=74 D Q
|
|---|
| 98 | . S X=$P($G(^RARPT(+VAL,0)),"^",1) K VAL S:X'="" VAL=X ; IA 1171
|
|---|
| 99 | . Q
|
|---|
| 100 | Q
|
|---|
| 101 | ;
|
|---|
| 102 | DATE(IMAGE,TYPE,NODE,PIECE,WHEN,VAL) N D0,D1,FIRST,LAST,PARENT,X
|
|---|
| 103 | ; First look in the image itself,
|
|---|
| 104 | ; then in its parent (if any)
|
|---|
| 105 | ; then in any siblings.
|
|---|
| 106 | ; Return the first value found.
|
|---|
| 107 | ;
|
|---|
| 108 | K VAL
|
|---|
| 109 | I WHEN=0 D MAG(IMAGE,TYPE,NODE,PIECE,.VAL) Q
|
|---|
| 110 | ;
|
|---|
| 111 | S X=$P($G(^MAG(2005,IMAGE,NODE)),"^",PIECE) I X'="" S X(X)=""
|
|---|
| 112 | ;
|
|---|
| 113 | S PARENT=$P($G(^MAG(2005,IMAGE,0)),"^",10) Q:PARENT=""
|
|---|
| 114 | S X=$P($G(^MAG(2005,PARENT,NODE)),"^",PIECE) I X'="" S X(X)=""
|
|---|
| 115 | ;
|
|---|
| 116 | S D1=0 F S D1=$O(^MAG(2005,IMAGE,1,D1)) Q:'D1 D
|
|---|
| 117 | . S D0=$G(^MAG(2005,IMAGE,1,D1,1)) Q:'D0
|
|---|
| 118 | . S X=$P($G(^MAG(2005,D0,NODE)),"^",PIECE) I X'="" S X(X)=""
|
|---|
| 119 | . Q
|
|---|
| 120 | ;
|
|---|
| 121 | I WHEN=1 S VAL=$O(X(""),+1)
|
|---|
| 122 | I WHEN=2 S VAL=$O(X(""),-1)
|
|---|
| 123 | K:VAL="" VAL
|
|---|
| 124 | Q
|
|---|
| 125 | ;
|
|---|
| 126 | URGENCY(IMAGE,VAL) N P
|
|---|
| 127 | S P=$$PRI^MAGBRTE4("NORMAL",IMAGE)
|
|---|
| 128 | S VAL=$S(P=500:"ROUTINE",P=510:"URGENT",P=520:"STAT",1:P)
|
|---|
| 129 | Q
|
|---|
| 130 | ;
|
|---|
