source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LR7OR4.m@ 677

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

initial load of FOIAVistA 6/30/08 version
File size: 7.6 KB
Line 
1LR7OR4 ;slc/dcm - Get Lab TEST Info ;8/11/97
2 ;;5.2;LAB SERVICE;**256,356**;Sep 27, 1994;Build 8
3 ;Entry points: EN
4GET(TEST) ;Get TEST ifn
5 I '$D(TEST) Q ""
6 I TEST'?1N.N S TEST=$O(^LAB(60,"B",TEST,0)) Q:'TEST ""
7 I TEST?1N.N Q:'$D(^LAB(60,TEST)) ""
8 Q TEST
9ONE(Y,TEST) ;Gets parameters for one test
10 N CNT
11 Q:'$L($G(TEST))
12 S CNT=0,TEST=+TEST
13 D EN
14 Q
15ALL(Y,TESTS) ;Gets Lab Test ordering parameters from file 60
16 ;TEST=Lab TEST (can be either name or internal #)
17 N I,CNT
18 Q:'$O(TESTS(0))
19 S (I,CNT)=0
20 F S I=$O(TESTS(I)) Q:'I S TEST=+TESTS(I) D EN S CNT=CNT+1,Y(CNT)="---------------------"
21 Q
22EN Q:'$D(TEST)
23 N X0
24 S TEST=$$GET(TEST) Q:'TEST
25 S X0=^LAB(60,TEST,0),CNT=CNT+1,Y(CNT)=$P(X0,"^",1)
26 I $L($P(X0,"^",11)) S Y(CNT)=Y(CNT)_" $"_$J($P(X0,"^",11),4,2)
27 D URG
28 D GCOM
29 I $P(X0,"^",8),$O(^LAB(60,TEST,3,0)) S X=$G(^($O(^(0)),0)),CNT=CNT+1,Y(CNT)="Unique collection sample: "_$$SAMP(+X) ;$P($G(^LAB(62,+X,0)),"^")
30 I $P(X0,"^",9) S I=0 F S I=$O(^LAB(60,TEST,3,I)) Q:I<1 S X=+^(I,0) I X=$P(X0,"^",9) S CNT=CNT+1,Y(CNT)="Lab collect sample: "_$$SAMP(X) Q ;$P($G(^LAB(62,X,0)),"^") Q
31 ;I $O(^LAB(60,TEST,3,0)) S X=$G(^($O(^(0)),0)),CNT=CNT+1,Y(CNT)="Default collection sample: "_$P($G(^LAB(62,+X,0)),"^")
32 D COLL,SUB
33 Q
34COLL ;Get Collection Sample-Specimen data
35 N I,J,X,SAMP,SPEC,CHK
36 S I=0
37 F S I=$O(^LAB(60,TEST,3,I)) Q:I<1 S X=^(I,0) D
38 . S CNT=CNT+1,Y(CNT)="Collection sample: "_$$SAMP(X,$P(X0,"^",19))
39 . I $L($P(X,"^",2)) S CNT=CNT+1,Y(CNT)=" Form name/number: "_$P(X,"^",2)
40 . I $L($P(X,"^",4)) S CNT=CNT+1,Y(CNT)=" Minimum volume (in mls): "_$P(X,"^",4)
41 . I $L($P(X,"^",5)) S CNT=CNT+1,Y(CNT)=" Maximum order frequency: "_$P(X,"^",5)
42 . I $L($P(X,"^",7)) S CNT=CNT+1,Y(CNT)=" Maximum daily order frequency: "_$P(X,"^",7)
43 . I $O(^LAB(60,TEST,3,I,1,0)) S CNT=CNT+1,Y(CNT)=" Collection sample instructions: " D
44 .. S J=0 F S J=$O(^LAB(60,TEST,3,I,1,J)) Q:J<1 S CNT=CNT+1,Y(CNT)=" "_^(J,0)
45 ;. I $O(^LAB(60,TEST,3,I,2,0)) S CNT=CNT+1,Y(CNT)=" Collection sample LAB processing instructions: " D
46 ;.. S J=0 F S J=$O(^LAB(60,TEST,3,I,2,J)) Q:J<1 S CNT=CNT+1,Y(CNT)=" "_^(J,0)
47 S I=0
48 F S I=$O(^LAB(60,TEST,1,I)) Q:I<1 S X=^(I,0) D
49 . S CNT=CNT+1,Y(CNT)="Site/Specimen: "_$P($G(^LAB(61,+X,0)),"^")
50 . I $L($P(X,"^",2,3))>1 D CRRV("Reference range",$P(X,"^",2,3))
51 . I $L($P(X,"^",11,12))>1 D CRRV("Therapeutic range",$P(X,"^",11,12))
52 . I $L($P(X,"^",4,5))>1 D CRRV("Critical",$P(X,"^",4,5))
53 . I $L($P(X,"^",7)) S CNT=CNT+1,Y(CNT)=" Units: "_$P(X,"^",7)
54 . I $O(^LAB(60,TEST,1,I,1,0)) S CNT=CNT+1,Y(CNT)=" Interpretation: "
55 . S J=0 F S J=$O(^LAB(60,TEST,1,I,1,J)) Q:'J S X=^(J,0),CNT=CNT+1,Y(CNT)=" "_X
56 Q
57URG ;Get Urgency params for TEST
58 N I,X,URG
59 I $P(X0,"^",18) S CNT=CNT+1,Y(CNT)="Default urgency: "_$P($G(^LAB(62.05,+$P(X0,"^",18),0)),"^")
60 I $P(X0,"^",16) S CNT=CNT+1,Y(CNT)="Highest urgency allowed: "_$P($G(^LAB(62.05,+$P(X0,"^",16),0)),"^")
61 Q
62SAMP(X,REQ) ;Build Collection Sample data
63 ;X=zero node from ^LAB(60,TEST,3,ifn,0) or ptr to 62
64 ;REQ=Required comment from $P(^LAB(60,TEST,0),"^",19)
65 N X0,Y1
66 Q:'$D(^LAB(62,+X,0)) "" S X0=^(0)
67 ;S REQ=$S($P(X,"^",6):$P(X,"^",6),$G(REQ):REQ,1:""),REQ=$S(REQ:$P($G(^LAB(62.07,REQ,0)),"^"),1:"")
68 ;S Y1=+X_"^"_$P(X0,"^")_"^"_$P(X0,"^",2)_"^"_$P(X0,"^",3)_"^"_$P(X,"^",5)_"^"_$P(X,"^",7)_"^"_$P(X0,"^",7)_"^"_REQ
69 S Y1=$P(X0,"^")_" "_$P(X0,"^",3)
70 Q Y1
71GCOM ;Get General Ward & Lab Instructions
72 ;TEST=ptr to TEST in file 60
73 N I
74 S I=0
75 I $O(^LAB(60,+$G(TEST),6,0)) S CNT=CNT+1,Y(CNT)="General instructions: "
76 F S I=$O(^LAB(60,TEST,6,I)) Q:'I S CNT=CNT+1,Y(CNT)=" "_^(I,0)
77 S I=0
78 ;I $O(^LAB(60,+$G(TEST),7,0)) S CNT=CNT+1,Y(CNT)="General LAB processing instructions: "
79 ;F S I=$O(^LAB(60,TEST,7,I)) Q:'I S CNT=CNT+1,Y(CNT)=" "_^(I,0)
80 Q
81SUB ;Tests in panel
82 N I
83 S I=0
84 I $O(^LAB(60,+$G(TEST),2,0)) S I=0,CNT=CNT+1,Y(CNT)="Tests included in panel: "
85 F S I=$O(^LAB(60,TEST,2,I)) Q:'I S X=^(I,0),CNT=CNT+1,Y(CNT)=" "_$P($G(^LAB(60,+X,0)),"^")
86 Q
87 ;Added to support LR*5.2*356, PSI-06-025
88CRRV(RT,RV) ;Convert Referance Range Values - convert embedded M code into a more readable format
89 ;Variables passed in:
90 ;RT - Refereance range Text
91 ;RV - Refereance range Value
92 ; 1st piece holds low value
93 ; 2nd piece holds high value
94 ;Routine variables
95 ;Y() - The return array with the lab test information
96 ;CNT - The counter variable used to create nodes in the Y array variable
97 ;Local variables
98 ;SP5 - 5 embedded spaces for output alinement
99 ;SP10 - 10 embedded spaces for output alinement
100 ;X - Work variable
101 N SP5,SP10,X
102 S SP5=" ",SP10=SP5_SP5,X=""
103 I RV'["$S(" D Q
104 . I $L($P(RV,"^")),'$L($P(RV,"^",2)),$P(RV,"^")?.ANP S CNT=CNT+1,Y(CNT)=SP5_RT_$S($P(RV,"^")?.N:" low : "_$TR($P(RV,"^"),""""),1:" : "_$TR($P(RV,"^"),"""")) Q
105 . I '$L($P(RV,"^")),$L($P(RV,"^",2)),$P(RV,"^",2)?.ANP S CNT=CNT+1,Y(CNT)=SP5_RT_$S($P(RV,"^",2)?.N:" high : "_$TR($P(RV,"^",2),""""),1:" : "_$TR($P(RV,"^",2),"""")) Q
106 . I $L($P(RV,"^")) S CNT=CNT+1,Y(CNT)=SP5_RT_" low : "_$TR($P(RV,"^"),"""")
107 . I $L($P(RV,"^",2)) S CNT=CNT+1,Y(CNT)=SP5_RT_" high : "_$TR($P(RV,"^",2),"""")
108 . ;I $L($P(RV,"^")) S CNT=CNT+1,Y(CNT)=SP5_RT_$S($P(RV,"^")?.AP:" : "_$TR($P(RV,"^"),""""),1:" low : "_$TR($P(RV,"^"),""""))
109 . ;I $L($P(RV,"^",2)) S CNT=CNT+1,Y(CNT)=SP5_RT_$S($P(RV,"^",2)?.AP:" : "_$TR($P(RV,"^",2),""""),1:" high : "_$TR($P(RV,"^",2),""""))
110 I RV["SEX" D Q
111 . I RV["AGE" S CNT=CNT+1,Y(CNT)=SP5_RT_" - Age and sex dependent range values, please contact lab for specifics." Q
112 . S CNT=CNT+1,Y(CNT)=SP5_RT
113 . I $L($$GSV($P(RV,"^"),"M")) S CNT=CNT+1,Y(CNT)=SP10_"Male "_$S($$GSV($P(RV,"^"),"M")?.AP:": "_$TR($$GSV($P(RV,"^"),"M"),""""),1:"low : "_$TR($$GSV($P(RV,"^"),"M"),""""))
114 . I $L($$GSV($P(RV,"^",2),"M")) S CNT=CNT+1,Y(CNT)=SP10_"Male "_$S($$GSV($P(RV,"^",2),"M")?.AP:$TR($$GSV($P(RV,"^",2),"M"),""""),1:"high : "_$TR($$GSV($P(RV,"^",2),"M"),""""))
115 . I $L($$GSV($P(RV,"^"),"F")) S CNT=CNT+1,Y(CNT)=SP10_"Female "_$S($$GSV($P(RV,"^"),"F")?.AP:": "_$TR($$GSV($P(RV,"^"),"F"),""""),1:"low : "_$TR($$GSV($P(RV,"^"),"F"),""""))
116 . I $L($$GSV($P(RV,"^",2),"F")) S CNT=CNT+1,Y(CNT)=SP10_"Female "_$S($$GSV($P(RV,"^",2),"F")?.AP:$TR($$GSV($P(RV,"^",2),"F"),""""),1:"high : "_$TR($$GSV($P(RV,"^",2),"F"),""""))
117 I RV["AGE" D Q
118 . S CNT=CNT+1,Y(CNT)=SP5_RT
119 . I $L($P(RV,"^")) D FAVO($P(RV,"^"),"low")
120 . I $L($P(RV,"^",2)) D FAVO($P(RV,"^",2),"high")
121GSV(X,SEX) ;Get Sex Value
122 ;Variables passed in:
123 ;X - Work variable low/high range value
124 ;SEX - Patient's sex
125 ;Subroutine variables:
126 ;X1 - Return value variable with the resolved low/high value
127 N X1
128 S @("X1="_$S($L(X):X,1:""""""))
129 Q X1
130FAVO(X,HL) ;Format Age Value Output
131 ;Variables passed in:
132 ;X - Work variable with low/high range value
133 ;HL - This will be for either a low or high reference range
134 ;Subroutine variables:
135 ;AT0 - Common text for output
136 ;AT1 - Embedded M code tested for
137 ;AT2 - Text description for embedded M code for output
138 ;IO - Counter to piece the low/high range value
139 ;I1 - Counter to reformat the embedded M code
140 ;SP10 - 10 embedded spaces for output alinement
141 ;X0,X1,X2 - Work variables used in converting the low/high range value
142 N AT0,AT1,AT2,I0,I1,SP10,X0,X1,X2
143 S AT0="If Age is "
144 S AT1="",AT1(1)="AGE<",AT1(2)="AGE>",AT1(3)="AGE'<",AT1(4)="AGE'>",AT1(5)="AGE="
145 S AT2="",AT2(1)="less than ",AT2(2)="greater than "
146 S AT2(3)="not less than ",AT2(4)="not greater than ",AT2(5)="equal to "
147 S SP10=" "
148 S X0=$E(X,4,$L(X)-1),(X1,X2)=""
149 F I0=1:1 S X1=$P(X0,",",I0) Q:X1="" D
150 . I $P(X1,":")=1 S X2=SP10_"Default "_HL_": "_$P(X1,":",2),CNT=CNT+1,Y(CNT)=$TR(X2,"""")
151 . E D
152 . . F I1=1:1:5 I $P(X1,":")[AT1(I1) S X2=SP10_AT0_AT2(I1)_$E($P(X1,":"),$L(AT1(I1))+1,$L($P(X1,":")))_" the "_HL_" is "_$P(X1,":",2),CNT=CNT+1,Y(CNT)=$TR(X2,"""")
153 Q
Note: See TracBrowser for help on using the repository browser.