source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORX009A.m@ 1729

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

initial load of FOIAVistA 6/30/08 version
File size: 7.5 KB
Line 
1RORX009A ;HCIOFO/SG - PRESCRIPTION UTILIZ. (QUERY & SORT) ; 10/12/05 11:49am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6 ;***** QUERIES THE REGISTRY
7 ;
8 ; FLAGS Flags for the $$SKIP^RORXU005
9 ;
10 ; Return Values:
11 ; <0 Error code
12 ; 0 Ok
13 ; >0 Number of non-fatal errors
14 ;
15QUERY(FLAGS) ;
16 N ROREDT1 ; Day after the end date
17 N RORPTN ; Number of patients in the registry
18 ;
19 N CNT,ECNT,IEN,IENS,PATIEN,RC,RORXDST,RXFLAGS,TMP,XREFNODE
20 S XREFNODE=$NA(^RORDATA(798,"AC",+RORREG))
21 S RORPTN=$$REGSIZE^RORUTL02(+RORREG) S:RORPTN<0 RORPTN=0
22 S ROREDT1=$$FMADD^XLFDT(ROREDT,1)
23 S (CNT,ECNT,RC)=0
24 ;
25 ;--- Prepare parameters for the pharmacy search API
26 S RORXDST=$NA(^TMP("RORX009",$J))
27 S RORXDST("RORCB")="$$RXSCB^RORX009A"
28 S RORXDST("GENERIC")=$$PARAM^RORTSK01("DRUGS","AGGR_GENERIC")
29 S RXFLAGS="E"
30 S:$$PARAM^RORTSK01("PATIENTS","INPATIENT") RXFLAGS=RXFLAGS_"IV"
31 S:$$PARAM^RORTSK01("PATIENTS","OUTPATIENT") RXFLAGS=RXFLAGS_"O"
32 Q:RXFLAGS="E" 0
33 ;
34 ;--- Browse through the registry records
35 S IEN=0
36 F S IEN=$O(@XREFNODE@(IEN)) Q:IEN'>0 D Q:RC<0
37 . S TMP=$S(RORPTN>0:CNT/RORPTN,1:"")
38 . S RC=$$LOOP^RORTSK01(TMP) Q:RC<0
39 . S IENS=IEN_",",CNT=CNT+1
40 . ;--- Check if the patient should be skipped
41 . Q:$$SKIP^RORXU005(IEN,FLAGS,RORSDT,ROREDT)
42 . ;
43 . ;--- Get the patient IEN (DFN)
44 . S PATIEN=$$PTIEN^RORUTL01(IEN) Q:PATIEN'>0
45 . ;
46 . ;--- Search the pharmacy data
47 . M RORXDST("RORXGRP")=RORXGRP("C")
48 . S TMP=$$RXSEARCH^RORUTL14(PATIEN,RORXL,.RORXDST,RXFLAGS,RORSDT,ROREDT1)
49 . I TMP<0 S ECNT=ECNT+1 Q
50 . ;--- No medications from some groups
51 . Q:$D(RORXDST("RORXGRP"))>1
52 . ;--- Skip the patient if no data has been found
53 . I '$D(@RORXDST@("IP",PATIEN)),'$D(@RORXDST@("OP",PATIEN)) Q
54 . ;
55 . ;--- Calculate intermediate totals
56 . S RC=$$TOTALS(PATIEN)
57 . I RC S ECNT=ECNT+1 Q:RC<0
58 ;---
59 Q $S(RC<0:RC,1:ECNT)
60 ;
61 ;***** CALLBACK FUNCTION FOR THE PHARMACY SEARCH API
62RXSCB(ROR8DST,ORDER,ORDFLG,DRUG,DATE) ;
63 N DRUGIEN,DRUGNAME,IRP,RPS,RXCNT,SUBS,TMP
64 I ROR8DST("GENERIC") D
65 . S DRUGIEN=+ROR8DST("RORXGEN"),DRUGNAME=$P(ROR8DST("RORXGEN"),U,2)
66 E S DRUGIEN=+DRUG,DRUGNAME=$P(DRUG,U,2)
67 Q:(DRUGIEN'>0)!(DRUGNAME="") 1
68 ;=== Check the drug groups
69 S TMP=$$RXGRPCHK^RORXU007(.ROR8DST,+DRUG,RORXL)
70 Q:TMP TMP
71 ;=== Process the order
72 S SUBS=$S(ORDFLG["I":"IP",ORDFLG["O":"OP",1:"") Q:SUBS="" 1
73 S RXCNT=0
74 ;--- Count the original order, refills and partials
75 I ORDFLG["I" S RXCNT=RXCNT+1 ; Inpatient
76 E D ; Outpatient
77 . S TMP=+$P($G(^TMP("PS",$J,"RXN",0)),U,6) ; Original Fill Date
78 . S:(TMP'<ROR8DST("RORSDT"))&(TMP<ROR8DST("ROREDT")) RXCNT=RXCNT+1
79 F RPS="PAR","REF" S IRP=0 D
80 . F S IRP=$O(^TMP("PS",$J,RPS,IRP)) Q:IRP'>0 S RXCNT=RXCNT+1
81 ;--- Update the counters
82 D:RXCNT>0
83 . S TMP=$G(@ROR8DST@(SUBS,+ROR8DST("RORDFN"),"D",DRUGIEN))
84 . S @ROR8DST@(SUBS,+ROR8DST("RORDFN"),"D",DRUGIEN)=TMP+RXCNT
85 . S TMP=SUBS_"D"
86 . S:'$D(@ROR8DST@(TMP,DRUGIEN)) @ROR8DST@(TMP,DRUGIEN)=DRUGNAME
87 Q 0
88 ;
89 ;***** SORTS THE RESULTS AND COMPILES THE TOTALS
90 ;
91 ; Return Values:
92 ; <0 Error code
93 ; 0 Ok
94 ; >0 Number of non-fatal errors
95 ;
96SORT() ;
97 N ECNT,NODE,RC
98 S (ECNT,RC)=0
99 S NODE=$NA(^TMP("RORX009",$J))
100 Q:$D(@NODE)<10 0
101 ;---
102 S RC=$$LOOP^RORTSK01(0) Q:RC<0 RC
103 D SORTRX(NODE,"IPD")
104 ;---
105 S RC=$$LOOP^RORTSK01(.33) Q:RC<0 RC
106 D SORTRX(NODE,"OPD")
107 ;---
108 S RC=$$LOOP^RORTSK01(.66) Q:RC<0 RC
109 S RC=$$SUMRX(NODE)
110 ;---
111 Q $S(RC<0:RC,1:ECNT)
112 ;
113 ;***** SORTS THE DRUG LIST
114 ;
115 ; NODE Closed root of the category section
116 ; in the temporary global
117 ;
118 ; SUBS Drug list subscript ("IPD" or "OPD")
119 ;
120SORTRX(NODE,SUBS) ;
121 N IEN,NAME,NDRUGS,SUM,TMP
122 S IEN=0,NDRUGS=0
123 F S IEN=$O(@NODE@(SUBS,IEN)) Q:IEN'>0 D
124 . S NAME=@NODE@(SUBS,IEN),NDRUGS=NDRUGS+1
125 . S TMP=+$G(@NODE@(SUBS,IEN,"D"))
126 . S @NODE@(SUBS,"B",TMP,NAME,IEN)=""
127 ;--- Numbers of different drugs
128 S @NODE@(SUBS)=NDRUGS
129 Q
130 ;
131 ;***** COMBINES THE INPATIENT AND OUTPATIENT DATA
132 ;
133 ; NODE Closed root of the category section
134 ; in the temporary global
135 ;
136SUMRX(NODE) ;
137 N COUNT,I,MAXUTNUM,NDRX,NRX,RC,RXIEN,SUMNRX,TMP
138 Q:($D(@NODE@("IPRX"))<10)!($D(@NODE@("OPRX"))<10) 0
139 S MAXUTNUM=$$PARAM^RORTSK01("MAXUTNUM")
140 Q:MAXUTNUM'>0 0
141 ;
142 ;=== Outpatient data
143 S NRX="",(COUNT,RC)=0
144 F S NRX=$O(@NODE@("OPRX",NRX),-1) Q:NRX="" D Q:RC
145 . S RC=$$LOOP^RORTSK01() Q:RC<0
146 . S @NODE@("SUMRX",NRX)=$G(@NODE@("OPRX",NRX))
147 . S NAME=""
148 . F S NAME=$O(@NODE@("OPRX",NRX,NAME)) Q:NAME="" D Q:RC
149 . . S DFN=""
150 . . F S DFN=$O(@NODE@("OPRX",NRX,NAME,DFN)) Q:DFN="" D Q:RC
151 . . . ;--- Include only the patients with highest utilization
152 . . . S COUNT=COUNT+1 I COUNT>MAXUTNUM S RC=1 Q
153 . . . ;--- Calculate the totals
154 . . . S (NDRX,SUMNRX)=0
155 . . . F I="IP","OP" S TMP=$G(@NODE@(I,DFN)) D
156 . . . . S NDRX=NDRX+$P(TMP,U,5),SUMNRX=SUMNRX+$P(TMP,U,4)
157 . . . S @NODE@("SUMRX",SUMNRX,NAME,DFN,"OP")=""
158 . . . S @NODE@("SUMRX",SUMNRX)=$G(@NODE@("SUMRX",SUMNRX))+1
159 . . . ;--- Adjust the total number of different drugs
160 . . . ;--- (some drugs could be both inpatient and outpatient)
161 . . . S RXIEN=0
162 . . . F S RXIEN=$O(@NODE@("OP",DFN,"D",RXIEN)) Q:RXIEN'>0 D
163 . . . . S:$D(@NODE@("IP",DFN,"D",RXIEN)) NDRX=NDRX-1
164 . . . ;--- Store the number of different drugs
165 . . . S @NODE@("SUMRX",SUMNRX,NAME,DFN)=NDRX
166 ;
167 ;=== Inpatient data
168 S NRX="",(COUNT,RC)=0
169 F S NRX=$O(@NODE@("IPRX",NRX),-1) Q:NRX="" D Q:RC
170 . S RC=$$LOOP^RORTSK01() Q:RC<0
171 . S NAME=""
172 . F S NAME=$O(@NODE@("IPRX",NRX,NAME)) Q:NAME="" D Q:RC
173 . . S DFN=""
174 . . F S DFN=$O(@NODE@("IPRX",NRX,NAME,DFN)) Q:DFN="" D Q:RC
175 . . . ;--- Include only the patients with highest utilization
176 . . . S COUNT=COUNT+1 I COUNT>MAXUTNUM S RC=1 Q
177 . . . ;--- Calculate the totals
178 . . . S (NDRX,SUMNRX)=0
179 . . . F I="IP","OP" S TMP=$G(@NODE@(I,DFN)) D
180 . . . . S NDRX=NDRX+$P(TMP,U,5),SUMNRX=SUMNRX+$P(TMP,U,4)
181 . . . S @NODE@("SUMRX",SUMNRX,NAME,DFN,"IP")=""
182 . . . ;--- Quit if the patient has been processed already
183 . . . Q:$D(@NODE@("SUMRX",SUMNRX,NAME,DFN,"OP"))
184 . . . S @NODE@("SUMRX",SUMNRX)=$G(@NODE@("SUMRX",SUMNRX))+1
185 . . . ;--- Adjust the total number of different drugs
186 . . . ;--- (some drugs could be both inpatient and outpatient)
187 . . . S RXIEN=0
188 . . . F S RXIEN=$O(@NODE@("IP",DFN,"D",RXIEN)) Q:RXIEN'>0 D
189 . . . . S:$D(@NODE@("OP",DFN,"D",RXIEN)) NDRX=NDRX-1
190 . . . ;--- Store the number of different drugs
191 . . . S @NODE@("SUMRX",SUMNRX,NAME,DFN)=NDRX
192 ;===
193 Q $S(RC<0:RC,1:0)
194 ;
195 ;***** CALCULATES THE INTERMEDIATE TOTALS
196 ;
197 ; PATIEN Patient IEN (DFN)
198 ;
199 ; Return Values:
200 ; <0 Error code
201 ; 0 Ok
202 ; >0 Number of non-fatal errors
203 ;
204TOTALS(PATIEN) ;
205 N DOD,IEN,LAST4,NDRUGS,NODE,NRX,PTNAME,PTNRX,RXS,SUBS,TMP,VA,VADM,VAERR
206 S NODE=$NA(^TMP("RORX009",$J))
207 ;--- Get the patient's data
208 D VADEM^RORUTL05(PATIEN,1)
209 S PTNAME=VADM(1),LAST4=VA("BID"),DOD=$$DATE^RORXU002(VADM(6)\1)
210 ;---
211 F SUBS="IP","OP" D:$D(@NODE@(SUBS,PATIEN))>1
212 . S RXS=SUBS_"D"
213 . S IEN=0,(NDRUGS,PTNRX)=0
214 . F S IEN=$O(@NODE@(SUBS,PATIEN,"D",IEN)) Q:IEN'>0 D
215 . . S NRX=@NODE@(SUBS,PATIEN,"D",IEN)
216 . . S NDRUGS=NDRUGS+1,PTNRX=PTNRX+NRX
217 . . ;---
218 . . S @NODE@(RXS,IEN,"D")=$G(@NODE@(RXS,IEN,"D"))+NRX
219 . . S @NODE@(RXS,IEN,"P")=$G(@NODE@(RXS,IEN,"P"))+1
220 . . ;---
221 . . S TMP=$G(@NODE@(RXS,IEN,"M"))
222 . . D:NRX'<TMP
223 . . . I NRX>TMP S @NODE@(RXS,IEN,"M")=NRX_U_1 Q
224 . . . S $P(@NODE@(RXS,IEN,"M"),U,2)=$P(TMP,U,2)+1
225 . ;---
226 . S @NODE@(SUBS)=$G(@NODE@(SUBS))+1
227 . S @NODE@(SUBS,PATIEN)=LAST4_U_PTNAME_U_DOD_U_PTNRX_U_NDRUGS
228 . ;---
229 . S RXS=SUBS_"RX"
230 . S @NODE@(RXS)=$G(@NODE@(RXS))+PTNRX
231 . S @NODE@(RXS,PTNRX)=$G(@NODE@(RXS,PTNRX))+1
232 . S @NODE@(RXS,PTNRX,PTNAME,PATIEN)=""
233 ;---
234 Q 0
Note: See TracBrowser for help on using the repository browser.