source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGBRTE3.m@ 1147

Last change on this file since 1147 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.3 KB
Line 
1MAGBRTE3 ;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 ;
32DICOM(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 ;
50NOW(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 ;
55SOURCE(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 ;
62MAG(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 ;
81MAGX 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 ;
102DATE(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 ;
126URGENCY(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 ;
Note: See TracBrowser for help on using the repository browser.