source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRPXAPI1.m@ 1036

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

initial load of WorldVistAEHR
File size: 7.7 KB
Line 
1LRPXAPI1 ;SLC/STAFF Lab Extract API code ;10/28/03 11:29
2 ;;5.2;LAB SERVICE;**295**;Sep 27, 1994
3 ;
4TESTS(TESTS,DFN,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
5 ; returns lab tests on a patient
6 ; returned in array TESTS
7 N CNT,CONDOK,DATA,DATE,ERR,NMSP K DATA
8 S NMSP=$G(TESTS) K TESTS S TESTS=""
9 ; return all tests in ^TMP(NMSP,$J
10 I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S TESTS=NMSP
11 D DATES^LRPXAPIU(.DATE1,.DATE2)
12 S CONDOK=+$P($G(NEXT),U,2)
13 S NEXT=+$G(NEXT)
14 I $L(COND),'CONDOK,'$$CONDOK^LRPXAPIU(COND,"C") Q
15 S CNT=0
16 F S NEXT=$O(^PXRMINDX(63,"PI",DFN,NEXT)) Q:NEXT<1 D Q:CNT'<MAX
17 . S DATE=+$O(^PXRMINDX(63,"PI",DFN,NEXT,DATE1))
18 . I 'DATE Q
19 . I DATE>DATE2 Q
20 . I $L(COND) D VALUE^LRPXAPI2(.DATA,DFN,DATE,NEXT,COND,.ERR) I ERR Q
21 . S CNT=CNT+1
22 . I TESTS?1U1UN1.14UNP D Q
23 .. S ^TMP(TESTS,$J,NEXT)=NEXT_U_$$TESTNM^LRPXAPIU(NEXT)
24 . S TESTS(NEXT)=NEXT_U_$$TESTNM^LRPXAPIU(NEXT)
25 S NEXT=+NEXT_U_1
26 Q
27 ;
28RESULTS(VALUES,DFN,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
29 ; returns all lab results on a patient
30 ; returned in array VALUES
31 ; format: date^test^comment^results
32 ; date is collection date/time
33 ; test is file 60 ien
34 ; comment is 1 (exists) or 0 (no comment)
35 ; results are result node (value^flag^...)
36 N CNT,COMMENT,CONDOK,DATA,DATE,ERR,LRDFN,LRDN,LRIDT,LRIDT1,NMSP,OK,RESULT,TEST
37 S NMSP=$G(VALUES) K VALUES S VALUES=""
38 ; return all results in ^TMP(NMSP,$J
39 I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S VALUES=NMSP
40 S LRDFN=$$LRDFN^LRPXAPIU(DFN)
41 D DATES^LRPXAPIU(.DATE1,.DATE2)
42 S LRIDT=$$LRIDT^LRPXAPIU(DATE2)
43 S LRIDT1=$$LRIDT^LRPXAPIU(DATE1)
44 S CONDOK=+$P($G(NEXT),U,2)
45 S NEXT=+$G(NEXT) I NEXT S LRIDT=NEXT
46 I $L(COND),'CONDOK,'$$CONDOK^LRPXAPIU(COND,"C") Q
47 I $E(COND)="|" S COND=$E(COND,2,245)
48 I $E(COND)="~" S COND=$E(COND,2,245)
49 I $L(COND) S COND=$$REPLACE^LRPXAPI2("I "_COND)
50 S CNT=0
51 S OK=0
52 F S LRIDT=$O(^LR(LRDFN,"CH",LRIDT)) Q:LRIDT<1 D Q:OK
53 . I '$$VERIFIED^LRPXAPI2(LRDFN,LRIDT) Q
54 . I LRIDT<1 S OK=1,LRIDT=0 Q
55 . I LRIDT1,LRIDT>LRIDT1 S OK=1,LRIDT=0 Q
56 . S CNT=CNT+1
57 . S DATE=$$LRIDT^LRPXAPIU(LRIDT)
58 . S COMMENT=$$COMMENT^LRPXAPI2(LRDFN,LRIDT)
59 . S LRDN=1
60 . F S LRDN=$O(^LR(LRDFN,"CH",LRIDT,LRDN)) Q:LRDN<1 S RESULT=^(LRDN) D
61 .. S TEST=$$TEST^LRPXAPIU(LRDN)
62 .. I 'TEST Q
63 .. I $L(COND) D LRVAL^LRPXAPI2(.DATA,LRDFN,LRIDT,LRDN,COND,.ERR) I ERR Q
64 .. E S DATA=RESULT
65 .. I VALUES?1U1UN1.14UNP D Q
66 ... S ^TMP(VALUES,$J,LRIDT_" "_TEST)=DATE_U_TEST_U_COMMENT_U_DATA
67 .. S VALUES(-DATE_" "_TEST)=DATE_U_TEST_U_COMMENT_U_DATA
68 . I CNT'<MAX S OK=1 Q
69 S NEXT=+LRIDT_U_1
70 Q
71 ;
72TRESULTS(VALUES,DFN,TEST,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
73 ; returns a lab test's results on a patient
74 ; returned in array VALUES
75 ; format: date^test^comment^results
76 ; date is collection date/time
77 ; test is file 60 ien
78 ; comment is 1 (exists) or 0 (no comment)
79 ; results are result node (value^flag^...)
80 N CNT,COMMENT,CONDOK,DATA,DATE,ERR,LRDFN,LRDN,LRIDT,NMSP,NODE,OK
81 S NMSP=$G(VALUES) K VALUES S VALUES=""
82 ; return all test results in ^TMP(NMSP,$J
83 I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S VALUES=NMSP
84 S CONDOK=+$P($G(NEXT),U,2)
85 I $L(COND),'CONDOK,'$$CONDOK^LRPXAPIU(COND,"C") Q
86 I $L(COND) D
87 . I $E(COND)="|" S COND=$E(COND,2,245)
88 . I $E(COND)="~" S COND=$E(COND,2,245)
89 . S COND=$$REPLACE^LRPXAPI2("I "_COND)
90 D DATES^LRPXAPIU(.DATE1,.DATE2)
91 S DATE=DATE2
92 S NEXT=+$G(NEXT) I NEXT S DATE=NEXT
93 S CNT=0
94 S OK=0
95 F S DATE=$O(^PXRMINDX(63,"IP",TEST,DFN,DATE),-1) Q:DATE="" D Q:OK
96 . I DATE<DATE1 S OK=1,DATE=0 Q
97 . I DATE>DATE2 S OK=1,DATE=0 Q
98 . S NODE=$O(^PXRMINDX(63,"IP",TEST,DFN,DATE,1))
99 . S LRDFN=+$P(NODE,";")
100 . S LRIDT=+$P(NODE,";",3)
101 . S COMMENT=$$COMMENT^LRPXAPI2(LRDFN,LRIDT)
102 . S NODE=""
103 . F S NODE=$O(^PXRMINDX(63,"IP",TEST,DFN,DATE,NODE)) Q:NODE="" D Q:OK
104 .. S LRDN=+$P(NODE,";",4)
105 .. D LRVAL^LRPXAPI2(.DATA,LRDFN,LRIDT,LRDN,COND,.ERR) I ERR Q
106 .. S CNT=CNT+1
107 .. I VALUES?1U1UN1.14UNP D Q
108 ... S ^TMP(VALUES,$J,-DATE)=DATE_U_TEST_U_COMMENT_U_DATA
109 .. S VALUES(-DATE_" "_TEST)=DATE_U_TEST_U_COMMENT_U_DATA
110 .. I CNT'<MAX S OK=1 Q
111 S NEXT=+DATE_U_1
112 Q
113 ;
114PATIENTS(PATS,TEST,SOURCE,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
115 ; uses PATS within this scope
116 ; returns patients who have a test result
117 ; returned in array PATS
118 ; format: DFN^patient name
119 N CNT,CONDOK,DATA,DATE,DFN,DONE,ERR,LRDFN,LRDN,LRIDT,NMSP,NODE,OK
120 S NMSP=$G(PATS) K PATS S PATS=""
121 ; return patients in ^TMP(NMSP,$J
122 I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S PATS=NMSP
123 D DATES^LRPXAPIU(.DATE1,.DATE2)
124 S CONDOK=+$P($G(NEXT),U,2)
125 S NEXT=+$G(NEXT)
126 S DFN=NEXT
127 I $L(COND),'CONDOK,'$$CONDOK^LRPXAPIU(COND,"C") Q
128 I $E(COND)="|" S COND=$E(COND,2,245)
129 I $E(COND)="~" S COND=$E(COND,2,245)
130 I $L(COND) S COND=$$REPLACE^LRPXAPI2("I "_COND)
131 S CNT=0
132 I '$L(SOURCE) D
133 . F S DFN=$O(^PXRMINDX(63,"IP",TEST,DFN)) Q:DFN<1 D PATS Q:CNT'<MAX
134 E D
135 . F S DFN=$O(@SOURCE@(DFN)) Q:DFN<1 D PATS Q:CNT'<MAX
136 S NEXT=+DFN_U_1
137 Q
138PATS ; within scope of PATIENTS
139 S DONE=0
140 S OK=0
141 S DATE=DATE1
142 F S DATE=$O(^PXRMINDX(63,"IP",TEST,DFN,DATE)) Q:DATE<1 D Q:DONE
143 . I DATE>DATE2 S DONE=1 Q
144 . I '$L(COND) S OK=1,DONE=1 Q
145 . S OK=0
146 . S NODE=""
147 . F S NODE=$O(^PXRMINDX(63,"IP",TEST,DFN,DATE,NODE)) Q:NODE="" D Q:OK
148 .. S LRDFN=+$P(NODE,";")
149 .. S LRIDT=+$P(NODE,";",3)
150 .. S LRDN=+$P(NODE,";",4)
151 .. D LRVAL^LRPXAPI2(.DATA,LRDFN,LRIDT,LRDN,COND,.ERR) I ERR Q
152 .. S OK=1
153 .. S DONE=1
154 I OK D
155 . S CNT=CNT+1
156 . I PATS?1U1UN1.14UNP D Q
157 .. S ^TMP(PATS,$J,DFN)=DFN_U_$$DFNM^LRPXAPIU(DFN)
158 . S PATS(DFN)=DFN_U_$$DFNM^LRPXAPIU(DFN)
159 Q
160 ;
161PTS(PATS,SOURCE,MAX,NEXT,COND,DATE1,DATE2) ; from LRPXAPI
162 ; uses APATS within this scope
163 ; returns all patients that have lab data
164 N CONDOK,CNT,DATE,DFN,ERR,ITEM,NMSP,OK,TYPE
165 ; if item exists in condition, route to other procedure
166 S CONDOK=+$P($G(NEXT),U,2)
167 I $L(COND),'CONDOK,'$$CONDOK^LRPXAPIU(COND,"C") Q
168 I $L(COND) D Q
169 . D ITEM^LRPXAPI6(.ITEM,TYPE,COND,.ERR) I ERR Q
170 . D PATIENTS(.PATS,ITEM,SOURCE,MAX,.NEXT,COND,DATE1,DATE2) Q
171 S NMSP=$G(PATS) K PATS S PATS=""
172 ; return patients in ^TMP(NMSP,$J
173 I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S PATS=NMSP
174 D DATES^LRPXAPIU(.DATE1,.DATE2)
175 S NEXT=+$G(NEXT)
176 S DFN=NEXT
177 S CNT=0
178 I '$L(SOURCE) D
179 . F S DFN=$O(^PXRMINDX(63,"PI",DFN)) Q:DFN<1 D PT Q:CNT'<MAX
180 E D
181 . F S DFN=$O(@SOURCE@(DFN)) Q:DFN<1 D PT Q:CNT'<MAX
182 S NEXT=+DFN_U_1
183 Q
184PT ; within scope of ALLPATS
185 S OK=0
186 S ITEM=0
187 F S ITEM=$O(^PXRMINDX(63,"PI",DFN,ITEM)) Q:ITEM<1 D Q:OK
188 . S DATE=DATE1
189 . F S DATE=+$O(^PXRMINDX(63,"PI",DFN,ITEM,DATE)) Q:DATE<1 D Q:OK
190 .. I DATE>DATE2 Q
191 .. S OK=1 Q
192 I OK D
193 . S CNT=CNT+1
194 . I PATS?1U1UN1.14UNP D Q
195 .. S ^TMP(PATS,$J,DFN)=DFN_U_$$DFNM^LRPXAPIU(DFN)
196 . S PATS(DFN)=DFN_U_$$DFNM^LRPXAPIU(DFN)
197 Q
198 ;
199DATES(DATES,DFN,TYPE,MAX,NEXT,DATE1,DATE2) ; from LRPXAPI
200 ; returns dates of data occurrence
201 ; returned in array DATES
202 N CNT,DATE,ITEM,LRDFN,LRIDT,LRIDT1,NMSP,OK,STOP
203 S NMSP=$G(DATES) K DATES S DATES=""
204 ; return all patients in ^TMP(NMSP,$J
205 I NMSP?1U1UN1.14UNP K ^TMP(NMSP,$J) S DATES=NMSP
206 D DATES^LRPXAPIU(.DATE1,.DATE2)
207 S CNT=0
208 I TYPE="C" D Q
209 . S LRDFN=$$LRDFN^LRPXAPIU(DFN)
210 . S LRIDT=$$LRIDT^LRPXAPIU(DATE2)
211 . S LRIDT1=$$LRIDT^LRPXAPIU(DATE1)
212 . S NEXT=+$G(NEXT) I NEXT S LRIDT=NEXT
213 . S OK=0
214 . F S LRIDT=$O(^LR(LRDFN,"CH",LRIDT)) Q:LRIDT<1 D Q:OK
215 .. I '$$VERIFIED^LRPXAPI2(LRDFN,LRIDT) Q
216 .. I LRIDT<1 S OK=1,LRIDT=0 Q
217 .. I LRIDT1,LRIDT>LRIDT1 S OK=1,LRIDT=0 Q
218 .. S DATE=$$LRIDT^LRPXAPIU(LRIDT)
219 .. S CNT=CNT+1
220 .. I CNT'<MAX S OK=1
221 .. I DATES?1U1UN1.14UNP S ^TMP(DATES,$J,-DATE)=DATE Q
222 .. S DATES(-DATE)=DATE
223 . S NEXT=+LRIDT
224 S DATE=DATE2
225 S NEXT=+$G(NEXT) I NEXT S DATE=NEXT
226 S OK=0
227 F S DATE=$O(^PXRMINDX(63,"PDI",DFN,DATE),-1) Q:DATE="" D Q:OK
228 . I DATE<DATE1 S OK=1,DATE=0 Q
229 . S ITEM=TYPE,STOP=TYPE_"ZZZZ"
230 . F S ITEM=$O(^PXRMINDX(63,"PDI",DFN,DATE,ITEM)) Q:ITEM="" Q:ITEM]STOP D Q
231 .. S CNT=CNT+1
232 .. I DATES?1U1UN1.14UNP D Q
233 ... S ^TMP(DATES,$J,-DATE)=DATE
234 .. S DATES(-DATE)=DATE
235 . I CNT'<MAX S OK=1 Q
236 S NEXT=+DATE
237 Q
238 ;
Note: See TracBrowser for help on using the repository browser.