source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORX009C.m@ 1383

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

initial load of FOIAVistA 6/30/08 version
File size: 7.5 KB
Line 
1RORX009C ;HCIOFO/SG - PRESCRIPTION UTILIZ. (STORE) ; 12/16/05 9:19am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6 ;***** DRUGS
7 ;
8 ; SECTION IEN of the parent element
9 ;
10 ; SUBS
11 ;
12 ; NODE Closed root of the category section
13 ; in the temporary global
14 ;
15 ; TBLNAME
16 ;
17 ; Return Values:
18 ; <0 Error code
19 ; 0 Ok
20 ;
21DRUGS(SECTION,SUBS,NODE,TBLNAME) ;
22 Q:$D(@NODE@(SUBS))<10 0
23 N IEN,ITEM,NAME,NRXNAME,NUM,RC,TMP
24 S TABLE=$$ADDVAL^RORTSK11(RORTSK,TBLNAME,,SECTION)
25 Q:TABLE<0 TABLE
26 D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE",TBLNAME)
27 S NRXNAME=$E(SUBS,1,2)_"NRX"
28 ;---
29 S NUM="",RC=0
30 F S NUM=$O(@NODE@(SUBS,"B",NUM),-1) Q:NUM="" D Q:RC
31 . S NAME=""
32 . F S NAME=$O(@NODE@(SUBS,"B",NUM,NAME)) Q:NAME="" D Q:RC
33 . . S IEN=""
34 . . F S IEN=$O(@NODE@(SUBS,"B",NUM,NAME,IEN)) Q:IEN="" D Q:RC
35 . . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"DRUG",,TABLE)
36 . . . D ADDVAL^RORTSK11(RORTSK,"NAME",NAME,ITEM,1)
37 . . . S TMP=+$G(@NODE@(SUBS,IEN,"P"))
38 . . . D ADDVAL^RORTSK11(RORTSK,"NP",TMP,ITEM,3)
39 . . . D ADDVAL^RORTSK11(RORTSK,NRXNAME,NUM,ITEM,3)
40 . . . S TMP=$G(@NODE@(SUBS,IEN,"M"))
41 . . . D ADDVAL^RORTSK11(RORTSK,"MAXNRPP",+$P(TMP,U),ITEM,3)
42 . . . D ADDVAL^RORTSK11(RORTSK,"MAXNP",+$P(TMP,U,2),ITEM,3)
43 Q $S(RC<0:RC,1:0)
44 ;
45 ;***** STORES THE REPORT DATA
46 ;
47 ; REPORT IEN of the REPORT element
48 ;
49 ; Return Values:
50 ; <0 Error code
51 ; 0 Ok
52 ; >0 Number of non-fatal errors
53 ;
54STORE(REPORT) ;
55 N RORSONLY ; Output summary only
56 ;
57 N ECNT,NODE,RC,TMP
58 S RORSONLY=$$SMRYONLY^RORXU006(),(ECNT,RC)=0
59 S NODE=$NA(^TMP("RORX009",$J))
60 Q:$D(@NODE)<10 0
61 ;--- Outpatient data
62 S RC=$$LOOP^RORTSK01(0) Q:RC<0 RC
63 S RC=$$STOREOP(REPORT,NODE)
64 I RC Q:RC<0 S ECNT=ECNT+1
65 ;--- Inpatient data
66 S RC=$$LOOP^RORTSK01(.33) Q:RC<0 RC
67 S RC=$$STOREIP(REPORT,NODE)
68 I RC Q:RC<0 S ECNT=ECNT+1
69 ;--- Highest utilization summary
70 S RC=$$LOOP^RORTSK01(.66) Q:RC<0 RC
71 S RC=$$STORESUM(REPORT,NODE)
72 I RC Q:RC<0 S ECNT=ECNT+1
73 ;---
74 Q $S(RC<0:RC,1:ECNT)
75 ;
76 ;***** INPATIENT DATA
77 ;
78 ; PRNTELMT IEN of the parent element
79 ;
80 ; NODE Closed root of the category section
81 ; in the temporary global
82 ;
83 ; Return Values:
84 ; <0 Error code
85 ; 0 Ok
86 ;
87STOREIP(PRNTELMT,NODE) ;
88 Q:$D(@NODE@("IP"))<10 0
89 N COUNT,DFN,ITEM,MAXUTNUM,NAME,NRX,RC,SECTION,TABLE,TMP
90 S MAXUTNUM=$$PARAM^RORTSK01("MAXUTNUM")
91 S SECTION=$$ADDVAL^RORTSK11(RORTSK,"INPATIENTS",,PRNTELMT)
92 Q:SECTION<0 SECTION
93 S RC=0
94 ;--- Number of doses
95 S TABLE=$$ADDVAL^RORTSK11(RORTSK,"DOSES",,SECTION)
96 Q:TABLE<0 TABLE
97 D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","DOSES")
98 S NRX=""
99 F S NRX=$O(@NODE@("IPRX",NRX),-1) Q:NRX="" D
100 . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"ITEM",,TABLE)
101 . D ADDVAL^RORTSK11(RORTSK,"NP",$P(@NODE@("IPRX",NRX),U),ITEM,3)
102 . D ADDVAL^RORTSK11(RORTSK,"IPNRX",NRX,ITEM,3)
103 ;--- Drugs
104 S RC=$$DRUGS(SECTION,"IPD",NODE,"DRUGS_DOSES") Q:RC<0 RC
105 ;--- Patients with highest utlization
106 I MAXUTNUM>0 D Q:RC<0 RC
107 . S TABLE=$$ADDVAL^RORTSK11(RORTSK,"HU_DOSES",,SECTION)
108 . I TABLE<0 S RC=TABLE Q
109 . D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","HU_DOSES")
110 . S NRX="",(COUNT,RC)=0
111 . F S NRX=$O(@NODE@("IPRX",NRX),-1) Q:NRX="" D Q:RC
112 . . S RC=$$LOOP^RORTSK01() Q:RC<0
113 . . S NAME=""
114 . . F S NAME=$O(@NODE@("IPRX",NRX,NAME)) Q:NAME="" D Q:RC
115 . . . S DFN=""
116 . . . F S DFN=$O(@NODE@("IPRX",NRX,NAME,DFN)) Q:DFN="" D Q:RC
117 . . . . S COUNT=COUNT+1 I COUNT>MAXUTNUM S RC=1 Q
118 . . . . S BUF=$G(@NODE@("IP",DFN))
119 . . . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE)
120 . . . . D ADDVAL^RORTSK11(RORTSK,"NAME",NAME,ITEM,1)
121 . . . . D ADDVAL^RORTSK11(RORTSK,"LAST4",$P(BUF,U),ITEM,2)
122 . . . . D ADDVAL^RORTSK11(RORTSK,"DOD",$P(BUF,U,3),ITEM,1)
123 . . . . D ADDVAL^RORTSK11(RORTSK,"IPNRX",NRX,ITEM,3)
124 . . . . D ADDVAL^RORTSK11(RORTSK,"ND",$P(BUF,U,5),ITEM,3)
125 ;--- Summary
126 D ADDVAL^RORTSK11(RORTSK,"NP",+$G(@NODE@("IP")),SECTION)
127 D ADDVAL^RORTSK11(RORTSK,"IPNRX",+$G(@NODE@("IPRX")),SECTION)
128 D ADDVAL^RORTSK11(RORTSK,"ND",+$G(@NODE@("IPD")),SECTION)
129 Q 0
130 ;
131 ;***** OUTPATIENT DATA
132 ;
133 ; PRNTELMT IEN of the parent element
134 ;
135 ; NODE Closed root of the category section
136 ; in the temporary global
137 ;
138 ; Return Values:
139 ; <0 Error code
140 ; 0 Ok
141 ;
142STOREOP(PRNTELMT,NODE) ;
143 Q:$D(@NODE@("OP"))<10 0
144 N COUNT,DFN,ITEM,MAXUTNUM,NAME,NRX,RC,SECTION,TABLE,TMP
145 S MAXUTNUM=$$PARAM^RORTSK01("MAXUTNUM")
146 S SECTION=$$ADDVAL^RORTSK11(RORTSK,"OUTPATIENTS",,PRNTELMT)
147 Q:SECTION<0 SECTION
148 S RC=0
149 ;--- Number of fills
150 S TABLE=$$ADDVAL^RORTSK11(RORTSK,"FILLS",,SECTION)
151 Q:TABLE<0 TABLE
152 D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","FILLS")
153 S NRX=""
154 F S NRX=$O(@NODE@("OPRX",NRX),-1) Q:NRX="" D
155 . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"ITEM",,TABLE)
156 . D ADDVAL^RORTSK11(RORTSK,"NP",$P(@NODE@("OPRX",NRX),U),ITEM,3)
157 . D ADDVAL^RORTSK11(RORTSK,"OPNRX",NRX,ITEM,3)
158 ;--- Drugs
159 S RC=$$DRUGS(SECTION,"OPD",NODE,"DRUGS_FILLS") Q:RC<0 RC
160 ;--- Patients with highest utlization
161 I MAXUTNUM>0 D Q:RC<0 RC
162 . S TABLE=$$ADDVAL^RORTSK11(RORTSK,"HU_FILLS",,SECTION)
163 . I TABLE<0 S RC=TABLE Q
164 . D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","HU_FILLS")
165 . S NRX="",(COUNT,RC)=0
166 . F S NRX=$O(@NODE@("OPRX",NRX),-1) Q:NRX="" D Q:RC
167 . . S RC=$$LOOP^RORTSK01() Q:RC<0
168 . . S NAME=""
169 . . F S NAME=$O(@NODE@("OPRX",NRX,NAME)) Q:NAME="" D Q:RC
170 . . . S DFN=""
171 . . . F S DFN=$O(@NODE@("OPRX",NRX,NAME,DFN)) Q:DFN="" D Q:RC
172 . . . . S COUNT=COUNT+1 I COUNT>MAXUTNUM S RC=1 Q
173 . . . . S BUF=$G(@NODE@("OP",DFN))
174 . . . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE)
175 . . . . D ADDVAL^RORTSK11(RORTSK,"NAME",NAME,ITEM,1)
176 . . . . D ADDVAL^RORTSK11(RORTSK,"LAST4",$P(BUF,U),ITEM,2)
177 . . . . D ADDVAL^RORTSK11(RORTSK,"DOD",$P(BUF,U,3),ITEM,1)
178 . . . . D ADDVAL^RORTSK11(RORTSK,"OPNRX",NRX,ITEM,3)
179 . . . . D ADDVAL^RORTSK11(RORTSK,"ND",$P(BUF,U,5),ITEM,3)
180 ;--- Summary
181 D ADDVAL^RORTSK11(RORTSK,"NP",+$G(@NODE@("OP")),SECTION)
182 D ADDVAL^RORTSK11(RORTSK,"OPNRX",+$G(@NODE@("OPRX")),SECTION)
183 D ADDVAL^RORTSK11(RORTSK,"ND",+$G(@NODE@("OPD")),SECTION)
184 Q 0
185 ;
186 ;***** SUMMARY DATA
187 ;
188 ; PRNTELMT IEN of the parent element
189 ;
190 ; NODE Closed root of the category section
191 ; in the temporary global
192 ;
193 ; Return Values:
194 ; <0 Error code
195 ; 0 Ok
196 ;
197STORESUM(PRNTELMT,NODE) ;
198 N DFN,DOD,IPNRX,ITEM,LAST4,MAXUTNUM,NAME,NRX,OPNRX,RC,SECTION,TABLE,TMP
199 S MAXUTNUM=$$PARAM^RORTSK01("MAXUTNUM")
200 Q:($D(@NODE@("SUMRX"))<10)!(MAXUTNUM'>0) 0
201 ;---
202 S SECTION=$$ADDVAL^RORTSK11(RORTSK,"SUMMARY",,PRNTELMT)
203 Q:SECTION<0 SECTION
204 S RC=0
205 ;--- Patients with highest utlization
206 S TABLE=$$ADDVAL^RORTSK11(RORTSK,"HU_NRX",,SECTION)
207 I TABLE<0 S RC=TABLE Q
208 D ADDATTR^RORTSK11(RORTSK,TABLE,"TABLE","HU_NRX")
209 ;---
210 S NRX="",RC=0
211 F S NRX=$O(@NODE@("SUMRX",NRX),-1) Q:NRX="" D Q:RC
212 . S RC=$$LOOP^RORTSK01() Q:RC<0
213 . S NAME=""
214 . F S NAME=$O(@NODE@("SUMRX",NRX,NAME)) Q:NAME="" D Q:RC
215 . . S DFN=""
216 . . F S DFN=$O(@NODE@("SUMRX",NRX,NAME,DFN)) Q:DFN="" D Q:RC
217 . . . S ITEM=$$ADDVAL^RORTSK11(RORTSK,"PATIENT",,TABLE)
218 . . . S (IPNRX,OPNRX)=0
219 . . . S BUF=$G(@NODE@("OP",DFN))
220 . . . S:BUF'="" LAST4=$P(BUF,U),DOD=$P(BUF,U,3),OPNRX=$P(BUF,U,4)
221 . . . S BUF=$G(@NODE@("IP",DFN))
222 . . . S:BUF'="" LAST4=$P(BUF,U),DOD=$P(BUF,U,3),IPNRX=$P(BUF,U,4)
223 . . . D ADDVAL^RORTSK11(RORTSK,"NAME",NAME,ITEM,1)
224 . . . D ADDVAL^RORTSK11(RORTSK,"LAST4",LAST4,ITEM,2)
225 . . . D ADDVAL^RORTSK11(RORTSK,"DOD",DOD,ITEM,1)
226 . . . D ADDVAL^RORTSK11(RORTSK,"OPNRX",OPNRX,ITEM,3)
227 . . . D ADDVAL^RORTSK11(RORTSK,"IPNRX",IPNRX,ITEM,3)
228 . . . S TMP=+$G(@NODE@("SUMRX",NRX,NAME,DFN))
229 . . . D ADDVAL^RORTSK11(RORTSK,"ND",TMP,ITEM,3)
230 ;---
231 Q 0
Note: See TracBrowser for help on using the repository browser.