source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORX012A.m@ 1783

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

initial load of FOIAVistA 6/30/08 version
File size: 8.1 KB
Line 
1RORX012A ;HCIOFO/SG - COMBINED MEDS AND LABS (QUERY & STORE) ; 12/8/05 10:39am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6 ;***** LAB SEARCH CALLBACK
7 ;
8 ; .ROR8DST Reference to the ROR8DST parameter.
9 ;
10 ; INVDT IEN of the Lab test (inverted date)
11 ;
12 ; .RESULT Reference to a local variable, which contains
13 ; the result (see the $$LTSEARCH^RORUTL10).
14 ;
15 ; Return Values:
16 ; <0 Error code (the search will be aborted)
17 ; 0 Ok
18 ; 1 Skip this result
19 ; 2 Skip this and all remaining results
20 ;
21LTSCB(ROR8DST,INVDT,RESULT) ;
22 N DATE,IEN,NAME,RC,TMP,VAL
23 S IEN=+RESULT(2) Q:IEN'>0 1 ; IEN of the Lab test
24 S NAME=$P(RESULT(2),U,2) Q:NAME="" 1 ; Name of the test
25 S DATE=+$P(RESULT(1),U,2) Q:DATE'>0 1 ; Date of the test
26 S ROR8DST("RORUTIL")=1
27 ;--- Check the result range if necessary
28 I $D(RORLTRV(IEN))>1 S RC=1 D Q:RC RC
29 . S VAL=$$CLRNMVAL^RORUTL18($P(RESULT(1),U,3))
30 . ;--- Skip a non-numeric result
31 . Q:'$$NUMERIC^RORUTL05(VAL)
32 . ;--- Check the range
33 . I $G(RORLTRV(IEN,"L"))'="" Q:VAL<RORLTRV(IEN,"L")
34 . I $G(RORLTRV(IEN,"H"))'="" Q:VAL>RORLTRV(IEN,"H")
35 . S RC=0
36 ;--- Store the result
37 S @ROR8DST@(DATE,NAME,IEN)=$P(RESULT(1),U,3)
38 Q 0
39 ;
40 ;***** QUERIES THE REGISTRY
41 ;
42 ; FLAGS Flags for the $$SKIP^RORXU005
43 ; .NSPT Number of selected patients is returned here
44 ;
45 ; Return Values:
46 ; <0 Error code
47 ; 0 Ok
48 ; >0 Number of non-fatal errors
49 ;
50QUERY(FLAGS,NSPT) ;
51 N RORLDST ; Descriptor for Lab search API
52 N RORPTN ; Number of patients in the registry
53 N RORXDST ; Descriptor for pharmacy search API
54 ;
55 N CNT,ECNT,IEN,IENS,LTEDT,LTSDT,PATIEN,RC,RXEDT,SKIP,SKIPEDT,SKIPSDT,TMP,UTEDT,UTIL,UTSDT,VA,VADM,XREFNODE
56 S XREFNODE=$NA(^RORDATA(798,"AC",+RORREG))
57 S (CNT,ECNT,NSPT,RC)=0,(SKIPEDT,SKIPSDT)=0
58 ;--- Utilization date range
59 D:$$PARAM^RORTSK01("PATIENTS","CAREONLY")
60 . S UTSDT=$$PARAM^RORTSK01("DATE_RANGE_3","START")\1
61 . S UTEDT=$$PARAM^RORTSK01("DATE_RANGE_3","END")\1
62 . ;--- Combined date range
63 . S SKIPSDT=$$DTMIN^RORUTL18(SKIPSDT,UTSDT)
64 . S SKIPEDT=$$DTMAX^RORUTL18(SKIPEDT,UTEDT)
65 ;--- Number of patients in the registry
66 S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
67 ;
68 ;--- Setup the descriptors for callback API's
69 I RORLAB D
70 . I RORLTST'="*",$D(@RORLTST)<10 S RORLAB=0 Q
71 . S RORLDST("RORCB")="$$LTSCB^RORX012A"
72 . ;--- Labs date range
73 . S LTSDT=$$PARAM^RORTSK01("DATE_RANGE_2","START")\1
74 . S LTEDT=$$PARAM^RORTSK01("DATE_RANGE_2","END")\1
75 . ;--- Combined date range
76 . S SKIPSDT=$$DTMIN^RORUTL18(SKIPSDT,LTSDT)
77 . S SKIPEDT=$$DTMAX^RORUTL18(SKIPEDT,LTEDT)
78 . ;--- Shift the Labs end date
79 . S LTEDT=$$FMADD^XLFDT(LTEDT,1)
80 I RORPHARM D
81 . I RORXL'="*",$D(@RORXL)<10 S RORPHARM=0 Q
82 . S RORXDST("RORCB")="$$RXSCB^RORX012A"
83 . S RORXDST("GENERIC")=$$PARAM^RORTSK01("DRUGS","AGGR_GENERIC")
84 . ;--- Combined date range
85 . S SKIPSDT=$$DTMIN^RORUTL18(SKIPSDT,RORXSDT)
86 . S SKIPEDT=$$DTMAX^RORUTL18(SKIPEDT,RORXEDT)
87 . ;--- Shift the Meds end date
88 . S RXEDT=$$FMADD^XLFDT(RORXEDT\1,1)
89 Q:'(RORLAB!RORPHARM) 0
90 ;
91 ;--- Browse through the registry records
92 S IEN=0
93 F S IEN=$O(@XREFNODE@(IEN)) Q:IEN'>0 D Q:RC<0
94 . S TMP=$S(RORPTN>0:CNT/RORPTN,1:"")
95 . S RC=$$LOOP^RORTSK01(TMP) Q:RC<0
96 . S IENS=IEN_",",CNT=CNT+1
97 . ;--- Check if the patient should be skipped
98 . Q:$$SKIP^RORXU005(IEN,FLAGS,SKIPSDT,SKIPEDT)
99 . S SKIP=1,UTIL=0
100 . ;
101 . ;--- Get the patient IEN (DFN)
102 . S PATIEN=$$PTIEN^RORUTL01(IEN) Q:PATIEN'>0
103 . ;
104 . D I RC<0 S ECNT=ECNT+1,RC=0 Q
105 . . ;--- Search for pharmacy data
106 . . I RORPHARM D Q:RC'>0
107 . . . M RORXDST("RORXGRP")=RORXGRP("C")
108 . . . S RORXDST=$NA(^TMP("RORX012",$J,"PAT",PATIEN,"RX"))
109 . . . K RORXDST("RORUTIL")
110 . . . S RC=$$RXSEARCH^RORUTL14(PATIEN,RORXL,.RORXDST,"EIOV",RORXSDT,RXEDT)
111 . . . Q:RC<0
112 . . . ;S:$G(RORXDST("RORUTIL")) UTIL=1
113 . . . I RC>0 S:$D(RORXDST("RORXGRP"))>1 RC=0
114 . . . ;--- Invert the result if the "Did Not" logic was selected
115 . . . I RORPHARM<0 S RC='RC K @RORXDST
116 . . ;--- Search for Lab data
117 . . I RORLAB D Q:RC'>0
118 . . . S RORLDST=$NA(^TMP("RORX012",$J,"PAT",PATIEN,"LR"))
119 . . . K RORLDST("RORUTIL")
120 . . . S RC=$$LTSEARCH^RORUTL10(PATIEN,RORLTST,.RORLDST,,LTSDT,LTEDT)
121 . . . Q:RC<0
122 . . . ;S:$G(RORLDST("RORUTIL")) UTIL=1
123 . . . ;--- Invert the result if the "Did Not" logic was selected
124 . . . S:RORLAB<0 RC='RC
125 . . ;---
126 . . S SKIP=0
127 . ;
128 . ;--- Check for any utilization in the corresponding date range
129 . I 'SKIP D:$$PARAM^RORTSK01("PATIENTS","CAREONLY")
130 . . K TMP S TMP("ALL")=1
131 . . S UTIL=+$$UTIL^RORXU003(UTSDT,UTEDT,PATIEN,.TMP)
132 . . S:'UTIL SKIP=1
133 . ;
134 . ;--- Skip the patient if not all search criteria have been met
135 . I SKIP K ^TMP("RORX012",$J,"PAT",PATIEN) Q
136 . ;
137 . ;--- Get and store the patient's data
138 . D VADEM^RORUTL05(PATIEN,1)
139 . S TMP=$$DATE^RORXU002(VADM(6)\1)
140 . S ^TMP("RORX012",$J,"PAT",PATIEN)=VA("BID")_U_VADM(1)_U_TMP
141 . S NSPT=NSPT+1
142 ;
143 ;---
144 Q $S(RC<0:RC,1:ECNT)
145 ;
146 ;***** CALLBACK FUNCTION FOR THE PHARMACY SEARCH API
147RXSCB(ROR8DST,ORDER,ORDFLG,DRUG,DATE) ;
148 N GRP,IEN,NAME,TMP
149 S ROR8DST("RORUTIL")=1
150 ;=== Check the drug groups
151 S TMP=$$RXGRPCHK^RORXU007(.ROR8DST,+DRUG,RORXL)
152 Q:TMP TMP
153 ;--- Get the drug data
154 I ROR8DST("GENERIC") D
155 . S IEN=+ROR8DST("RORXGEN"),NAME=$P(ROR8DST("RORXGEN"),U,2)
156 E S IEN=+DRUG,NAME=$P(DRUG,U,2)
157 Q:(IEN'>0)!(NAME="") 1
158 ;--- Output the data
159 S @ROR8DST@(NAME,IEN)=""
160 Q 0
161 ;
162 ;***** STORES THE REPORT DATA
163 ;
164 ; REPORT IEN of the REPORT element
165 ; NSPT Number of selected patients
166 ;
167 ; Return Values:
168 ; <0 Error code
169 ; 0 Ok
170 ; >0 Number of non-fatal errors
171 ;
172STORE(REPORT,NSPT) ;
173 N CNT,DATE,DFN,DOD,ECNT,IEN,ITEM,LAST4,LTLST,NAME,NODE,PTCNT,PTLST,PTNAME,RC,RXLST,TMP,VAL
174 S (ECNT,RC)=0,(LTLST,PTLST,RXLST)=-1
175 ;--- Force the "patient data" note in the output
176 D ADDVAL^RORTSK11(RORTSK,"PATIENT",,REPORT)
177 ;--- Create lab test list
178 I RORLAB D Q:LTLST<0 LTLST
179 . S LTLST=$$ADDVAL^RORTSK11(RORTSK,"LABTESTS",,REPORT)
180 . D ADDATTR^RORTSK11(RORTSK,LTLST,"TABLE","LABTESTS")
181 ;--- Create pharmacy list
182 I RORPHARM>0 D Q:RXLST<0 RXLST
183 . S RXLST=$$ADDVAL^RORTSK11(RORTSK,"DRUGS",,REPORT)
184 . D ADDATTR^RORTSK11(RORTSK,RXLST,"TABLE","DRUGS")
185 ;--- Create patient list
186 I (RORLAB<0)!(RORPHARM<0) D Q:PTLST<0 PTLST
187 . S PTLST=$$ADDVAL^RORTSK11(RORTSK,"PATIENTS",,REPORT)
188 . D ADDATTR^RORTSK11(RORTSK,PTLST,"TABLE","PATIENTS")
189 ;---
190 S (CNT,DFN,PTCNT)=0
191 F S DFN=$O(^TMP("RORX012",$J,"PAT",DFN)) Q:DFN'>0 D Q:RC<0
192 . S TMP=$S(NSPT>0:CNT/NSPT,1:"")
193 . S RC=$$LOOP^RORTSK01(TMP) Q:RC<0
194 . S CNT=CNT+1,NODE=$NA(^TMP("RORX012",$J,"PAT",DFN))
195 . ;--- Patient's data
196 . S TMP=$G(@NODE)
197 . S LAST4=$P(TMP,U),PTNAME=$P(TMP,U,2),DOD=$P(TMP,U,3)
198 . ;--- Patient list
199 . S TMP=$S(LTLST<0:1,1:$D(@NODE@("LR"))<10)
200 . I TMP,$S(RXLST<0:1,1:$D(@NODE@("RX"))<10) D Q
201 . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,PTLST,,DFN)
202 . . D ADDVAL^RORTSK11(RORTSK,"NAME",PTNAME,ITEM,1)
203 . . D ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,ITEM,2)
204 . . D ADDVAL^RORTSK11(RORTSK,"DOD",DOD,ITEM,1)
205 . . S PTCNT=PTCNT+1
206 . ;--- List of Lab tests
207 . S DATE=""
208 . F S DATE=$O(@NODE@("LR",DATE)) Q:DATE="" D
209 . . S NAME=""
210 . . F S NAME=$O(@NODE@("LR",DATE,NAME)) Q:NAME="" D
211 . . . S IEN=""
212 . . . F S IEN=$O(@NODE@("LR",DATE,NAME,IEN)) Q:IEN="" D
213 . . . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"LT",,LTLST,,DFN)
214 . . . . D ADDVAL^RORTSK11(RORTSK,"NAME",PTNAME,ITEM,1)
215 . . . . D ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,ITEM,2)
216 . . . . D ADDVAL^RORTSK11(RORTSK,"DOD",DOD,ITEM,1)
217 . . . . D ADDVAL^RORTSK11(RORTSK,"DATE",DATE\1,ITEM,1)
218 . . . . D ADDVAL^RORTSK11(RORTSK,"LTNAME",NAME,ITEM,1)
219 . . . . S VAL=$G(@NODE@("LR",DATE,NAME,IEN))
220 . . . . S TMP=$S($$NUMERIC^RORUTL05(VAL):3,1:1)
221 . . . . D ADDVAL^RORTSK11(RORTSK,"RESULT",VAL,ITEM,TMP)
222 . ;--- List of drugs
223 . S NAME=""
224 . F S NAME=$O(@NODE@("RX",NAME)) Q:NAME="" D
225 . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"DRUG",,RXLST,,DFN)
226 . . D ADDVAL^RORTSK11(RORTSK,"NAME",PTNAME,ITEM,1)
227 . . D ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,ITEM,2)
228 . . D ADDVAL^RORTSK11(RORTSK,"DOD",DOD,ITEM,1)
229 . . D ADDVAL^RORTSK11(RORTSK,"RXNAME",NAME,ITEM,1)
230 ;--- Inactivate the patient list tag if the list is empty
231 D:PTCNT'>0 UPDVAL^RORTSK11(RORTSK,PTLST,,,1)
232 ;---
233 Q ECNT
Note: See TracBrowser for help on using the repository browser.