source: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LRPXAPI3.m@ 636

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

initial load of FOIAVistA 6/30/08 version
File size: 8.5 KB
Line 
1LRPXAPI3 ;SLC/STAFF Lab Extract API code - Micro and AP ;10/28/03 11:29
2 ;;5.2;LAB SERVICE;**295**;Sep 27, 1994
3 ;
4TESTS(INFO,DFN,TYPE,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
5 ; returns AP or Micro items on a patient in array INFO
6 N CNT,CONDOK,CONDS,DATE,NMSP,OK,STOP K CONDS
7 S NMSP=$G(INFO) K INFO S INFO=""
8 ; return all info in ^TMP(NMSP,$J
9 I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S INFO=NMSP
10 D DATES^LRPXAPIU(.DATE1,.DATE2)
11 S CONDOK=+$P($G(NEXT),U,2)
12 S NEXT=$G(NEXT,TYPE)
13 I NEXT'=TYPE S NEXT=$P(NEXT,U,3)
14 I $L(COND),'CONDOK,'$$CONDOK^LRPXAPIU(COND,TYPE) Q
15 I $L(COND) D CONDS^LRPXAPI6(.CONDS,COND,TYPE)
16 S STOP=TYPE_"Z"
17 S CNT=0
18 F S NEXT=$O(^PXRMINDX(63,"PI",DFN,NEXT)) Q:NEXT="" Q:NEXT]STOP D Q:CNT'<MAX
19 . I $E(NEXT)'=TYPE Q
20 . S OK=0
21 . I '$L(COND) D Q:'OK
22 .. S DATE=+$O(^PXRMINDX(63,"PI",DFN,NEXT,DATE1))
23 .. I 'DATE Q
24 .. I DATE>DATE2 Q
25 .. S OK=1
26 . E D Q:'OK
27 .. S DATE=DATE1
28 .. F S DATE=$O(^PXRMINDX(63,"PI",DFN,NEXT,DATE)) Q:DATE<1 Q:DATE>DATE2 D Q:OK
29 ... I $$MATCH^LRPXAPI5(DFN,DATE,.CONDS,TYPE) S OK=1
30 . S CNT=CNT+1
31 . I INFO?1U1UN1.14UNP D Q
32 .. S ^TMP(INFO,$J,NEXT)=NEXT_U_$$ITEMNM^LRPXAPIU(NEXT)
33 . S INFO(NEXT)=NEXT_U_$$ITEMNM^LRPXAPIU(NEXT)
34 I NEXT]STOP!'$L(NEXT) S NEXT=0
35 E S NEXT="1^1^"_NEXT ; #^item is used for consistency with other APIs
36 Q
37 ;
38RESULTS(VALUES,DFN,PITEM,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
39 ; returns all AP or Micro results on a patient in array VALUES
40 ; format: date^item^node^data
41 ; where data is item file ien^item name^values on node
42 N CAT,CATONLY,CATSUB,CONDOK,CNT,DATA,DATE,DONE,ERR,ITEM,ISTOP,NODE,NMSP,OK,TYPE
43 S NMSP=$G(VALUES) K VALUES S VALUES=""
44 ; return all results in ^TMP(NMSP,$J
45 I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S VALUES=NMSP
46 D DATES^LRPXAPIU(.DATE1,.DATE2)
47 S CONDOK=+$P($G(NEXT),U,2)
48 S TYPE=$E(PITEM)
49 S NEXT=+$G(NEXT) I NEXT S DATE2=NEXT
50 I $L(COND),'CONDOK,'$$CONDOK^LRPXAPIU(COND,TYPE) Q
51 S CAT="",CATSUB=""
52 S CATONLY=$$CATONLY(COND)
53 I CATONLY S CAT=$E(COND,$L(COND)-1)
54 I $L(CAT) D
55 . S CATSUB=$$CATSUB^LRPXAPIU(CAT,TYPE)
56 . I CATSUB=-1 S CATSUB="" Q
57 I $L(COND),'CATONLY D Q
58 . D ITEM^LRPXAPI6(.ITEM,TYPE,COND,.ERR) I ERR Q
59 . D TRESULTS(.VALUES,DFN,TYPE,ITEM,MAX,.NEXT,COND,DATE1,DATE2) Q
60 I $L($P(PITEM,";",2)) S ISTOP=$P(PITEM,";",1,2)_"Z"
61 E S PITEM=$E(TYPE),ISTOP=PITEM_"Z"
62 S CNT=0
63 S DONE=0
64 S DATE=DATE2
65 F S DATE=$O(^PXRMINDX(63,"PDI",DFN,DATE),-1) Q:DATE="" D Q:DONE
66 . I DATE1,DATE<DATE1 S DATE="",DONE=1 Q
67 . S OK=0
68 . S ITEM=PITEM
69 . F S ITEM=$O(^PXRMINDX(63,"PDI",DFN,DATE,ITEM)) Q:ITEM="" Q:ITEM]ISTOP D
70 .. I $E(ITEM)'=TYPE Q
71 .. I $L(CATSUB),'$$CATOK(DFN,ITEM,DATE,CATSUB) Q
72 .. S OK=1
73 .. S NODE=""
74 .. F S NODE=$O(^PXRMINDX(63,"PDI",DFN,DATE,ITEM,NODE)) Q:NODE="" Q:$E(NODE)[TYPE D
75 ... D LRPXRM^LRPXAPI(.DATA,NODE,ITEM)
76 ... I VALUES?1U1UN1.14UNP D Q
77 .... S ^TMP(VALUES,$J,NODE_" "_ITEM)=ITEM_U_NODE_U_DATA
78 ... S VALUES(-DATE_" "_NODE_" "_ITEM)=DATE_U_ITEM_U_NODE_U_DATA
79 . I OK S CNT=CNT+1
80 . I CNT'<MAX S DONE=1 Q
81 S NEXT=+DATE_U_1
82 Q
83 ;
84TRESULTS(VALUES,DFN,TYPE,ITEM,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
85 ; returns AP or Micro single item results on a patient in array VALUES
86 N CNT,CONDOK,CONDS,DATA,DATE,NMSP,NODE,OK K CONDS
87 S NMSP=$G(VALUES) K VALUES S VALUES=""
88 ; return all test results in ^TMP(NMSP,$J
89 I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S VALUES=NMSP
90 S CONDOK=+$P($G(NEXT),U,2)
91 I $L(COND),'$$CONDOK^LRPXAPIU(COND,TYPE) Q
92 I $L(COND) D CONDS^LRPXAPI6(.CONDS,COND,TYPE,ITEM)
93 D DATES^LRPXAPIU(.DATE1,.DATE2)
94 S DATE=DATE2
95 S NEXT=+$G(NEXT) I NEXT S DATE=NEXT
96 S CNT=0
97 S OK=0
98 F S DATE=$O(^PXRMINDX(63,"IP",ITEM,DFN,DATE),-1) Q:DATE="" D Q:OK
99 . I DATE<DATE1 S OK=1,DATE=0 Q
100 . I DATE>DATE2 S OK=1,DATE=0 Q
101 . I $L(COND),'$$MATCH^LRPXAPI5(DFN,DATE,.CONDS,TYPE) Q
102 . S CNT=CNT+1
103 . S NODE=""
104 . F S NODE=$O(^PXRMINDX(63,"IP",ITEM,DFN,DATE,NODE)) Q:NODE="" D Q:OK
105 .. S OK=0
106 .. D LRPXRM^LRPXAPI(.DATA,NODE,ITEM)
107 .. I VALUES?1U1UN1.14UNP D Q
108 ... S ^TMP(VALUES,$J,-DATE)=DATE_U_ITEM_U_NODE_U_DATA
109 .. S VALUES(-DATE_" "_NODE_" "_ITEM)=DATE_U_ITEM_U_NODE_U_DATA
110 . I CNT'<MAX S OK=1 Q
111 S NEXT=+DATE_U_1
112 Q
113 ;
114PATIENTS(PATS,TYPE,ITEM,SOURCE,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
115 ; uses PCHK within this scope
116 ; returns patients who have AP or Micro item results in array PATS
117 N CNT,CONDOK,CONDS,DATE,DFN,DONE,NMSP,OK K CONDS
118 S NMSP=$G(PATS) K PATS S PATS=""
119 ; return all patients in ^TMP(NMSP,$J
120 I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S PATS=NMSP
121 D DATES^LRPXAPIU(.DATE1,.DATE2)
122 S CONDOK=+$P($G(NEXT),U,2)
123 S NEXT=+$G(NEXT)
124 S DFN=NEXT
125 I $L(COND),'CONDOK,'$$CONDOK^LRPXAPIU(COND,TYPE) Q
126 I $L(COND) D CONDS^LRPXAPI6(.CONDS,COND,TYPE,ITEM)
127 S CNT=0
128 I '$L(SOURCE) D
129 . F S DFN=$O(^PXRMINDX(63,"IP",ITEM,DFN)) Q:DFN<1 D PCHK Q:CNT'<MAX
130 E D
131 . F S DFN=$O(@SOURCE@(DFN)) Q:DFN<1 D PCHK Q:CNT'<MAX
132 S NEXT=+DFN_U_1
133 Q
134PCHK ; within scope of PATIENTS
135 S DONE=0
136 S OK=0
137 S DATE=DATE1
138 F S DATE=$O(^PXRMINDX(63,"IP",ITEM,DFN,DATE)) Q:DATE<1 D Q:DONE
139 . I DATE>DATE2 S DONE=1 Q
140 . I '$L(COND) S OK=1,DONE=1 Q
141 . I '$$MATCH^LRPXAPI5(DFN,DATE,.CONDS,TYPE) Q
142 . S OK=0
143 . I $L($O(^PXRMINDX(63,"IP",ITEM,DFN,DATE,""))) S OK=1,DONE=1 Q
144 I OK D
145 . S CNT=CNT+1
146 . I PATS?1U1UN1.14UNP D Q
147 .. S ^TMP(PATS,$J,DFN)=DFN_U_$$DFNM^LRPXAPIU(DFN)
148 . S PATS(DFN)=DFN_U_$$DFNM^LRPXAPIU(DFN)
149 Q
150 ;
151ALLPATS(PATS,SOURCE,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
152 ; uses APATS within this scope
153 ; returns all patients that have lab data
154 N CNT,DATE,DFN,ERR,ITEM,NMSP,OK,TYPE
155 ; if item exists in condition, route to other procedure
156 I $L(COND) D Q
157 . S OK=0 F TYPE="C","M","A" D Q:OK ; use first valid type
158 .. I $$CONDOK^LRPXAPIU(COND,TYPE) S OK=1 Q
159 . I 'OK Q
160 . D ITEM^LRPXAPI6(.ITEM,TYPE,COND,.ERR) I ERR Q
161 . I TYPE="C" D PATIENTS(.PATS,ITEM,SOURCE,MAX,.NEXT,COND,DATE1,DATE2) Q
162 . D PATIENTS^LRPXAPI3(.PATS,TYPE,ITEM,SOURCE,MAX,.NEXT,COND,DATE1,DATE2) Q
163 S NMSP=$G(PATS) K PATS S PATS=""
164 ; return patients in ^TMP(NMSP,$J
165 I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S PATS=NMSP
166 D DATES^LRPXAPIU(.DATE1,.DATE2)
167 S NEXT=+$G(NEXT)
168 S DFN=NEXT
169 S CNT=0
170 I '$L(SOURCE) D
171 . F S DFN=$O(^PXRMINDX(63,"PI",DFN)) Q:DFN<1 D APATS Q:CNT'<MAX
172 E D
173 . F S DFN=$O(@SOURCE@(DFN)) Q:DFN<1 D APATS Q:CNT'<MAX
174 S NEXT=+DFN
175 Q
176APATS ; within scope of ALLPATS
177 S OK=0
178 S ITEM=""
179 F S ITEM=$O(^PXRMINDX(63,"PI",DFN,ITEM)) Q:ITEM="" D Q:OK
180 . S DATE=DATE1
181 . F S DATE=+$O(^PXRMINDX(63,"PI",DFN,ITEM,DATE)) Q:DATE<1 D Q:OK
182 .. I DATE>DATE2 Q
183 .. S OK=1 Q
184 I OK D
185 . S CNT=CNT+1
186 . I PATS?1U1UN1.14UNP D Q
187 .. S ^TMP(PATS,$J,DFN)=DFN_U_$$DFNM^LRPXAPIU(DFN)
188 . S PATS(DFN)=DFN_U_$$DFNM^LRPXAPIU(DFN)
189 Q
190 ;
191PTS(PATS,TYPE,PITEM,SOURCE,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
192 ; uses PCHK within this scope
193 ; returns patients who have AP or Micro (all or partial type) results in array PATS
194 N CAT,CATONLY,CATSUB,CNT,CONDOK,CONDS,DATE,DFN,DONE,ERR,ITEM
195 N ISTOP,NMSP,OK K CONDS
196 S NMSP=$G(PATS) K PATS S PATS=""
197 ; return all patients in ^TMP(NMSP,$J
198 I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S PATS=NMSP
199 D DATES^LRPXAPIU(.DATE1,.DATE2)
200 S CONDOK=+$P($G(NEXT),U,2)
201 S NEXT=+$G(NEXT)
202 S DFN=NEXT
203 I $L(COND),'CONDOK,'$$CONDOK^LRPXAPIU(COND,TYPE) Q
204 S CAT="",CATSUB=""
205 S CATONLY=$$CATONLY(COND)
206 I CATONLY S CAT=$E(COND,$L(COND)-1)
207 I $L(CAT) D
208 . S CATSUB=$$CATSUB^LRPXAPIU(CAT,TYPE)
209 . I CATSUB=-1 S CATSUB="" Q
210 I $L(COND),'CATONLY D Q
211 . D ITEM^LRPXAPI6(.ITEM,TYPE,COND,.ERR) I ERR Q
212 . D PATIENTS(.PATS,TYPE,ITEM,SOURCE,MAX,.NEXT,COND,DATE1,DATE2) Q
213 I $L($P(PITEM,";",2)) S ISTOP=$P(PITEM,";",1,2)_"Z"
214 E S PITEM=$E(TYPE),ISTOP=PITEM_"Z"
215 S CNT=0
216 S DONE=0
217 S ITEM=PITEM
218 F S ITEM=$O(^PXRMINDX(63,"IP",ITEM)) Q:ITEM="" Q:ITEM]ISTOP D Q:DONE
219 . I TYPE'=$E(ITEM) S DONE=1 Q
220 . I '$L(SOURCE) D
221 .. F S DFN=$O(^PXRMINDX(63,"IP",ITEM,DFN)) Q:DFN<1 D PT Q:DONE
222 . E D
223 .. F S DFN=$O(@SOURCE@(DFN)) Q:DFN<1 D Q:DONE
224 ... I $D(^PXRMINDX(63,"IP",ITEM,DFN)) D PT
225 S NEXT=+DFN_U_1
226 Q
227PT ; within scope of PATIENTS
228 S OK=0
229 S DATE=DATE1
230 F S DATE=$O(^PXRMINDX(63,"IP",ITEM,DFN,DATE)) Q:DATE<1 D Q:OK
231 . I DATE>DATE2 Q
232 . I $L(CATSUB),'$$CATOK(DFN,ITEM,DATE,CATSUB) Q
233 . S OK=1
234 I OK D
235 . S CNT=CNT+1
236 . I CNT'<MAX S DONE=1
237 . I PATS?1U1UN1.14UNP D Q
238 .. S ^TMP(PATS,$J,DFN)=DFN_U_$$DFNM^LRPXAPIU(DFN)
239 . S PATS(DFN)=DFN_U_$$DFNM^LRPXAPIU(DFN)
240 Q
241 ;
242CATONLY(COND) ; $$(condition) -> 1 if condition is only a category, else 0
243 I '$L(COND) Q 0
244 I $L(COND)>6 Q 0
245 I $E(COND,$L(COND))'="""" Q 0
246 I $E(COND,1,3)["C=" Q 1
247 Q 0
248 ;
249CATOK(DFN,ITEM,DATE,CATSUB) ; $$(dfn,item,date,cat) -> 1 if any nodes match category, else 0
250 N NODE,SUB
251 S NODE=$O(^PXRMINDX(63,"PI",DFN,ITEM,DATE,""))
252 I NODE="" Q 0
253 S SUB=$P(NODE,";",2)
254 I SUB=CATSUB Q 1
255 I SUB="MI",$P(NODE,";",4)=CATSUB Q 1
256 I SUB="AY",CATSUB="AU" Q 1
257 I SUB=80,CATSUB="AU" Q 1
258 I SUB=33,CATSUB="AU" Q 1
259 Q 0
Note: See TracBrowser for help on using the repository browser.