source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRPXAPIU.m@ 1006

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

initial load of WorldVistAEHR

File size: 5.6 KB
Line 
1LRPXAPIU ; SLC/STAFF Lab Extract API Utilities ;1/29/04 14:32
2 ;;5.2;LAB SERVICE;**295**;Sep 27, 1994
3 ;
4 ; lab APIs
5 ; dbia 4246
6 ;
7 ; ------------ internal number conversions -----------
8 ;
9LRDFN(DFN) ; API $$(dfn) -> lrdfn
10 Q +$G(^DPT(+$G(DFN),"LR"))
11 ;
12DFN(LRDFN) ; API $$(lrdfn) -> dfn
13 S LRDFN=+$G(LRDFN)
14 I $P($G(^LR(LRDFN,0)),U,2)'=2 Q 0
15 Q +$P(^LR(LRDFN,0),U,3)
16 ;
17LRIDT(DATETIME) ; API $$(datetime) -> lridt (or lridt to datetime)
18 I +$G(DATETIME)'>0 Q 0
19 Q 9999999-DATETIME
20 ;
21LRDN(TEST) ; API $$(test) -> data number (subscript for test in ^LR)
22 Q +$P($P($G(^LAB(60,+$G(TEST),0)),U,5),";",2)
23 ;
24TEST(LRDN) ; API $$(lrdn) -> test
25 Q +$O(^LAB(60,"C","CH;"_$G(LRDN)_";1",0))
26 ;
27AB(ABDN) ; API $$(antimicrobial data number) -> antimicrobial ien
28 Q +$G(^LAB(62.06,"AI",+$G(ABDN)))
29 ;
30ABDN(AB) ; API $$(62.06 ien) -> antimicrobial data number
31 N ABDN
32 S ABDN=+$P($G(^LAB(62.06,+$G(AB),0)),U,2)
33 I ABDN'["2." Q 0
34 Q ABDN
35 ;
36TB(TBDN) ; API $$(mycobacteria data number) -> mycobacteria field number
37 Q +$O(^DD(63.39,"GL",+$G(TBDN),1,0)) ; dbia 999
38 ;
39TBDN(TB) ; API $$(mycobacteria field number) -> mycobacteria data number
40 N TBDN
41 S TBDN=+$P($G(^DD(63.39,+$G(TB),0)),U,4) ; dbia 999
42 I TBDN'["2." Q 0
43 Q TBDN
44 ;
45CATEGORY(SUB,TYPE) ; API $$(subscript, type) -> Micro category [B P F M V], AP category [A C E M S]
46 N CAT
47 S SUB=+$G(SUB)
48 I TYPE="M" D Q CAT
49 . I SUB=3 S CAT="B" Q
50 . I SUB=6 S CAT="P" Q
51 . I SUB=9 S CAT="F" Q
52 . I SUB=12 S CAT="M" Q
53 . I SUB=17 S CAT="V" Q
54 . S CAT=-1
55 I SUB="SP" Q "S"
56 I SUB="CY" Q "C"
57 I SUB="EM" Q "E"
58 I SUB="AU" Q "A"
59 I SUB="AY" Q "A"
60 I SUB=33 Q "A"
61 I SUB=80 Q "A"
62 Q -1
63 ;
64CATSUB(CAT,TYPE) ; API $$(category letter, type) -> subscript
65 N SUB
66 S CAT=$G(CAT)
67 I TYPE="M" D Q SUB
68 . I CAT="B" S SUB=3 Q
69 . I CAT="P" S SUB=6 Q
70 . I CAT="F" S SUB=9 Q
71 . I CAT="M" S SUB=12 Q
72 . I CAT="V" S SUB=17 Q
73 . S SUB=-1
74 I CAT="S" Q "SP"
75 I CAT="C" Q "CY"
76 I CAT="E" Q "EM"
77 I CAT="A" Q "AU" ; must check - could be AY, 33, 80
78 Q -1
79 ;
80 ; ----------- external names ---------------
81 ;
82DFNM(DFN) ; API $$(dfn) -> patient name
83 Q $P($G(^DPT(+$G(DFN),0)),U)
84 ;
85LRDFNM(LRDFN) ; API $$(lrdfn) -> patient name
86 Q $$DFNM($$DFN(+$G(LRDFN)))
87 ;
88TESTNM(TEST) ; API $$(test ien) -> test name
89 Q $P($G(^LAB(60,+$G(TEST),0)),U)
90 ;
91LRDNM(LRDN) ; API $$(data number) -> test name
92 Q $$TESTNM($$TEST($G(LRDN)))
93 ;
94SPECNM(SPEC) ; API $$(spec ien) -> specimen name
95 Q $P($G(^LAB(61,+$G(SPEC),0)),U)
96 ;
97BUGNM(BUG) ; API $$(organism ien) -> organism name
98 Q $P($G(^LAB(61.2,+$G(BUG),0)),U)
99 ;
100ABNM(AB) ; API $$(antimicrobial ien) -> antimicrobial name
101 Q $P($G(^LAB(62.06,+$G(AB),0)),U)
102 ;
103TBNM(TB) ; API $$(mycobacteria field number) -> mycobacteria drug name
104 Q $P($G(^DD(63.39,+$G(TB),0)),U) ; dbia 999
105 ;
106ORGNM(ORGAN) ; API $$(organ/tissue ien) -> organ/tissue name
107 Q $P($G(^LAB(61,+$G(ORGAN),0)),U)
108 ;
109DISNM(DISEASE) ; API $$(disease ien) -> disease name
110 Q $P($G(^LAB(61.4,+$G(DISEASE),0)),U)
111 ;
112ETINM(ETIOLOGY) ; API $$(etiology ien) -> etiology name
113 Q $P($G(^LAB(61.2,+$G(ETIOLOGY),0)),U)
114 ;
115MORPHNM(MORPH) ; API $$(morphology ien) -> morphology name
116 Q $P($G(^LAB(61.1,+$G(MORPH),0)),U)
117 ;
118FUNNM(FUNCTION) ; API $$(function ien) -> function name
119 Q $P($G(^LAB(61.3,+$G(FUNCTION),0)),U)
120 ;
121PROCNM(PROC) ; API $$(procedure ien) -> procedure name
122 Q $P($G(^LAB(61.5,+$G(PROC),0)),U)
123 ;
124ICD9(ICD9) ; API $$(icd9 ien) -> icd code^name
125 Q $P($G(^ICD9(+$G(ICD9),0)),U)_U_$G(^ICD9(+$G(ICD9),1))
126 ;
127DOD(DFN) ; API $$(dfn) -> date of death else 0
128 Q +$G(^DPT(+$G(DFN),.35)) ; dbia 13
129 ;
130EXTVALUE(Y,REF) ; API $$(internal value,index ref) -> external value
131 N C,FIELD
132 I $P(REF,";",2)'="CH" Q Y
133 S FIELD=+$P(REF,";",4)
134 S C=$P(^DD(63.04,FIELD,0),U,2) ; dbia 999
135 D Y^DIQ
136 Q Y
137 ;
138ITEMNM(INFO) ; API $$(ap or micro item) -> item name
139 N FILE,NAME,NUM,TYPE
140 I INFO=+INFO Q $$TESTNM(INFO)
141 S NAME=""
142 S TYPE=$P(INFO,";") I '$L(TYPE) Q NAME
143 S FILE=$P(INFO,";",2) I '$L(FILE) Q NAME
144 S NUM=+$P(INFO,";",3) I 'NUM Q NAME
145 I TYPE="M" D Q NAME
146 . I FILE="S" S NAME=$$SPECNM(NUM) Q
147 . I FILE="T" S NAME=$$TESTNM(NUM) Q
148 . I FILE="O" S NAME=$$BUGNM(NUM) Q
149 . I FILE="A" S NAME=$$ABNM(NUM) Q
150 . I FILE="M" S NAME=$$TBNM(NUM) Q
151 I TYPE="A" D Q NAME
152 . I FILE="S" S NAME=$P(INFO,".",2) Q
153 . I FILE="T" S NAME=$$TESTNM(NUM) Q
154 . I FILE="O" S NAME=$$ORGNM(NUM) Q
155 . I FILE="D" S NAME=$$DISNM(NUM) Q
156 . I FILE="M" S NAME=$$MORPHNM(NUM) Q
157 . I FILE="E" S NAME=$$ETINM(NUM) Q
158 . I FILE="F" S NAME=$$FUNNM(NUM) Q
159 . I FILE="P" S NAME=$$PROCNM(NUM) Q
160 . I FILE="I" S NAME=$$ICD9^LRPXAPIU(NUM) Q
161 Q NAME
162 ;
163 ; -------------- other utilities -------------
164 ;
165CONDOK(COND,TYPE) ; API $$(condition,type) -> 1 for valid condition, else 0
166 Q $$CONDOK^LRPXAPI2($G(COND),$G(TYPE,"C"))
167 ;
168NORMALS(LOW,HIGH,TEST,SPEC) ; API return low and high ref range on test
169 D NORMALS^LRPXAPI2(.LOW,.HIGH,TEST,SPEC)
170 Q
171 ;
172DATES(DATE1,DATE2) ; API return proper date range
173 ; DATE1 always returns oldest value
174 N TEMP
175 S DATE1=$$EXTTOFM($G(DATE1))
176 S DATE2=$$EXTTOFM($G(DATE2))
177 I 'DATE2 S DATE2=9999999
178 I DATE1>DATE2 S TEMP=DATE1,DATE1=DATE2,DATE2=TEMP
179 I DATE2=+DATE2,DATE2'=9999999,DATE2'["." S DATE2=DATE2+.25
180 Q
181 ;
182EXTTOFM(X) ; $$(external date/time) -> FM date/time
183 N %DT,Y
184 S %DT="TS"
185 D ^%DT
186 I Y=-1 Q 0
187 Q +Y
188 ;
189VRESULT(TEST,RESULT) ; $$(test,result) -> valid result
190 Q $$STRIP($$RESULT(TEST,RESULT))
191 ;
192RESULT(TEST,RESULT) ; $$(test,result) -> result Convert CH result to external format
193 ;TEST=Test ptr to file 60
194 ;RESULT=Test result
195 N X,X1,LRCW
196 S LRCW="",X1=$P($G(^LAB(60,TEST,.1)),U,3),X1=$S($L(X1):X1,1:"$J(X,8)"),X=RESULT,@("X="_X1)
197 Q X
198 ;
199STRIP(TEXT) ; $$(text) -> stripped text Strips white space from text
200 N I,X
201 S X="" F I=1:1:$L(TEXT," ") S:$A($P(TEXT," ",I))>0 X=X_$P(TEXT," ",I)
202 Q X
203 ;
Note: See TracBrowser for help on using the repository browser.