source: FOIAVistA/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUSUM7.m@ 990

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

initial load of FOIAVistA 6/30/08 version
File size: 7.4 KB
Line 
1PSUSUM7 ;BIR/DAM - Pt. Demographics Summary for IV/RX or UD/RX ; 20 DEC 2001
2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
3 ;
4EN ;EN CALLED FROM PSUOP0
5 ;Q:$D(^XTMP("PSU_"_PSUJOB,"PSU_"_PSUJOB,"PSUMFLAG")) ;Do not run if auto extract
6 ;
7 D PULL^PSUCP
8 F I=1:1:$L(PSUOPTS,",") S PSUMOD($P(PSUOPTS,",",I))=""
9 ;
10 K ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
11 I $G(^XTMP("PSU_"_PSUJOB,"PSUFLAG2"))!$G(^XTMP("PSU_"_PSUJOB,"PSUFLAG3")) K ^XTMP("PSU_"_PSUJOB,"PSUSUMA")
12 I $D(^XTMP("PSU_"_PSUJOB,"PSUNONE","RX")) D Q
13 .I $D(^XTMP("PSU_"_PSUJOB,"PSUNONE","IV"))!$D(^XTMP("PSU_"_PSUJOB,"PSUNONE","UD")) D
14 ..D NODATA
15 ..I $G(^XTMP("PSU_"_PSUJOB,"PSUFLAG1"))!$G(^XTMP("PSU_"_PSUJOB,"PSUFLAG2")) K ^XTMP("PSU_"_PSUJOB,"PSUNONE")
16 ;
17 D EN1
18 Q
19 ;
20EN1 ;Gather summary data
21 D DATE^PSUSUM6
22 S I=7
23 I $D(PSUMOD(1)) D UNIQUE1
24 I '$D(PSUMOD(1)) D UNIQUE
25 D TOP^PSUSUM6
26 D OPDIV^PSUSUM6
27 D DIVTOT^PSUSUM6
28 D TUDIV
29 I $D(PSUMOD(1)) D
30 .D IPDIV2
31 I $D(PSUMOD(2)) D
32 .D IPDIV^PSUSUM6
33 .D IPDIV1
34 .D TAB4
35 D PDSUM^PSUDEM5
36 K ^XTMP("PSU_"_PSUJOB,"PSUTMP"),^XTMP("PSU_"_PSUJOB,"PSUTOTAL"),^XTMP("PSU_"_PSUJOB,"PSURXUNIQUE")
37 K ^XTMP("PSU_"_PSUJOB,"PSURXTOTAL")
38 K ^XTMP("PSU_"_PSUJOB,"PSURXCTA"),^XTMP("PSU_"_PSUJOB,"PSUIVINDIV")
39 K ^XTMP("PSU_"_PSUJOB,"PSURXSSN"),^XTMP("PSU_"_PSUJOB,"PSUIVDIV"),^XTMP("PSU_"_PSUJOB,"PSUFLAG2")
40 K ^XTMP("PSU_"_PSUJOB,"PSUFLAG3")
41 K ^XTMP("PSU_"_PSUJOB,"PSUIVOUT"),^XTMP("PSU_"_PSUJOB,"PSUIVSSN"),^XTMP("PSU_"_PSUJOB,"PSUUDDIV")
42 Q
43 ;
44UNIQUE ;Find total unique pharmacy patients across all divisions when
45 ;UD and RX extracts are run together
46 ;
47 S PSURXN=0,PSUUDN1=0,PSUUDN2=0
48 ;
49 S N=1
50 F S PSURXN=$O(^XTMP("PSU_"_PSUJOB,"PSURXSSN",PSURXN)) Q:PSURXN="" D
51 .S ^XTMP("PSU_"_PSUJOB,"PSUTMP",PSURXN)=N S N=N+1
52 .F S PSUUDN1=$O(^XTMP("PSU_"_PSUJOB,"PSUUDSSN",PSUUDN1)) Q:PSUUDN1="" D
53 ..I '$D(^XTMP("PSU_"_PSUJOB,"PSUTMP",PSUUDN1)) S ^XTMP("PSU_"_PSUJOB,"PSUTMP",PSUUDN1)=N S N=N+1
54 ;
55 S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=N-1
56 D TAB2
57 S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)="" S I=I+1
58 Q
59 ;
60TAB2 ;Tab spacing for line 7. Set line into global
61 ;
62 S PSUTB3=" "
63 S PSUTB4="TOTAL Pharmacy patients across all divisions:"
64 S PSUTB5=(64-$L(PSUTB4))-$L($P($G(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")),U,1))
65 F S3=1:1:(PSUTB5-1) S PSUTB(S3)=" " D
66 .S PSUTB3=PSUTB3_PSUTB(S3)
67 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$P($G(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")),U,1)
68 S I=I+1
69 Q
70 ;
71UNIQUE1 ;Find total unique pharmacy patients across all divisions when
72 ;IV and RX extracts are run together
73 ;
74 S PSURXN=0,PSUIVN=0
75 ;
76 S N=1
77 ;
78 F S PSURXN=$O(^XTMP("PSU_"_PSUJOB,"PSURXSSN",PSURXN)) Q:PSURXN="" D
79 .S ^XTMP("PSU_"_PSUJOB,"PSUTMP",PSURXN)=N S N=N+1
80 .F S PSUIVN=$O(^XTMP("PSU_"_PSUJOB,"PSUIVSSN",PSUIVN)) Q:PSUIVN="" D
81 ..I '$D(^XTMP("PSU_"_PSUJOB,"PSUTMP",PSUIVN)) S ^XTMP("PSU_"_PSUJOB,"PSUTMP",PSUIVN)=N S N=N+1
82 ;
83 S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL")=N-1
84 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="TOTAL Pharmacy patients across all divisions: "_$P($G(^XTMP("PSU_"_PSUJOB,"PSUTOTAL")),U,1) S I=I+1
85 S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)="" S I=I+1
86 Q
87 ;
88TUDIV ;Calculate total inpatient count and tab spacing for 'Total
89 ;INPATIENT (UD or IV)' line and set into message global
90 ;
91 N PSUTB3,PSUTB4,PSUTB5,PSUDT
92 ;
93 I '$D(PSUMOD(1)) D
94 .S PSUDT=$P($G(^XTMP("PSU_"_PSUJOB,"PSUUDSSN")),U) D
95 ..S ^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")=PSUDT ;Total UD inpatient count
96 ;
97 I '$D(PSUMOD(2)) D
98 .S ^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")=$P($G(^XTMP("PSU_"_PSUJOB,"PSUIVIN")),U,1)-1 ;Total IV inpatient count
99 ;
100 I '$G(^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")) S ^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")=0
101 S PSUTB3=" "
102 S PSUTB4=" Total INPATIENT (UD or IV):"
103 S PSUTB5=(64-$L(PSUTB4))-$L($P($G(^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")),U,1))
104 F S3=1:1:(PSUTB5-1) S PSUTB(S3)=" " D
105 .S PSUTB3=PSUTB3_PSUTB(S3) ;Tab position
106 ;
107 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$P($G(^XTMP("PSU_"_PSUJOB,"PSUUDIVTOT")),U,1) S I=I+1
108 S $P(^XTMP("PSU_"_PSUJOB,"PSUSUMA",I),"-",70)="" S I=I+1
109 Q
110 ;
111IPDIV1 ;Find UD inpatient division totals
112 ;
113 S PSULBL=0
114 N PSUTTL
115 ;
116 I $D(PSUMOD(2)) D ;UD inpatients
117 .F S PSULBL=$O(^XTMP("PSU_"_PSUJOB,"PSUUDDIV",PSULBL)) Q:PSULBL="" D
118 ..S PSUTTL=$P($G(^XTMP("PSU_"_PSUJOB,"PSUUDDIV",PSULBL)),U,1)
119 ..D TAB1^PSUSUM6
120 ..D IPMSG
121 Q
122 ;
123IPMSG ;Set UD inpatient division totals into message global
124 ;
125 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSULBL_" Division:"_PSUTB1_PSUTTL
126 S I=I+1
127 Q
128 ;
129IPDIV2 ;Calculate inpatient totals for IV divisions
130 ;
131 ;
132 ;Construct a storage global containing unique IV inpatients
133 ;per division
134 S PSUDV=0
135 F S PSUDV=$O(^XTMP("PSU_"_PSUJOB,"PSUDIV1",PSUDV)) Q:PSUDV="" D
136 .S PSUPT=0
137 .F S PSUPT=$O(^XTMP("PSU_"_PSUJOB,"PSUDIV1",PSUDV,PSUPT)) Q:PSUPT="" D
138 ..S PSUPT1=0
139 ..F S PSUPT1=$O(^XTMP("PSU_"_PSUJOB,"PSUIN1",PSUPT1)) Q:PSUPT1="" D
140 ...I PSUPT1=PSUPT S ^XTMP("PSU_"_PSUJOB,"PSUDIV",PSUDV,PSUPT1)=""
141 D IPDIV3
142 Q
143 ;
144IPDIV3 ;Find unique inpatient count for each division
145 S PSUCT1=0,PSUCT2=0,T=1
146 ;
147 F S PSUCT1=$O(^XTMP("PSU_"_PSUJOB,"PSUDIV",PSUCT1)) Q:PSUCT1="" D
148 .F S PSUCT2=$O(^XTMP("PSU_"_PSUJOB,"PSUDIV",PSUCT1,PSUCT2)) Q:PSUCT2="" D
149 ..S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL1")=T S T=T+1 ;Total count
150 ..I $D(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUCT1)) D
151 ...S C=C+1
152 ...S ^XTMP("PSU_"_PSUJOB,"PSUCT",PSUCT1)=C
153 ..I '$D(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUCT1)) D
154 ...S C=1
155 ...S ^XTMP("PSU_"_PSUJOB,"PSUCT",PSUCT1)=C
156 D DIVNUM
157 D MSG
158 Q
159 ;
160DIVNUM ;Set number of inpatients per division into summary message
161 ;
162 N PSUTB1,PSUTB2
163 S N=1
164 ;
165 N PSUCT2
166 S PSUDIVA1=0
167 F S PSUDIVA1=$O(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVA1)) Q:PSUDIVA1="" D
168 .S PSUCT2=$P($G(^XTMP("PSU_"_PSUJOB,"PSUCT",PSUDIVA1)),U,1)
169 .D TAB5
170 .S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" "_PSUDIVA1_" Division:"_PSUTB1_PSUCT2
171 .S I=I+1
172 Q
173 ;
174TAB5 ;Calculate tab spacing
175 ;
176 S PSUTB1=" "
177 S PSUTB2=(59-$L(PSUCT2))-$L(PSUDIVA1)-10
178 F S2=1:1:(PSUTB2-1) S PSUTB(S2)=" " D
179 .S PSUTB1=PSUTB1_PSUTB(S2) ;Tab position
180 Q
181 ;
182TAB4 ;Calculate UD totals of all divisions and place in summary
183 ;message
184 ;
185 S N=0,PSUMKER=0,R=1
186 ;
187 I $D(PSUMOD(2)) D
188 .F S PSUMKER=$O(^XTMP("PSU_"_PSUJOB,"PSUUDDIV",PSUMKER)) Q:PSUMKER="" D
189 ..S N=$P(^XTMP("PSU_"_PSUJOB,"PSUUDDIV",PSUMKER),U)+N
190 ..S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL1")=N ;Sum of all UD inpatients
191 ;
192 D MSG
193 Q
194 ;
195MSG ;Final lines of message
196 ;
197 I '$D(^XTMP("PSU_"_PSUJOB,"PSUTOTAL1")) S ^XTMP("PSU_"_PSUJOB,"PSUTOTAL1")=0
198 ;
199 N PSUTB3,PSUTB4,PSUTB5
200 ;
201 S PSUTB3=" "
202 S PSUTB4=" Inpatient Total of all Divisions:"
203 S PSUTB5=(64-$L(PSUTB4))-$L($P($G(^XTMP("PSU_"_PSUJOB,"PSUTOTAL1")),U,1))
204 F S3=1:1:(PSUTB5-1) S PSUTB(S3)=" " D
205 .S PSUTB3=PSUTB3_PSUTB(S3) ;Tab position
206 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=" ----------" S I=I+1
207 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)=PSUTB4_PSUTB3_$P($G(^XTMP("PSU_"_PSUJOB,"PSUTOTAL1")),U,1) S I=I+1
208 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="" S I=I+1
209 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="**PLEASE NOTE: Final TOTAL may not match sum of all SUBTOTALS. A patient may" S I=I+1
210 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="have been provided pharmacy services at more than one outpatient and/or" S I=I+1
211 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",I)="inpatient division."
212 Q
213 ;
214NODATA ;Summary report line to be sent if there is no data
215 ;
216 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",1)="PHARMACY UNIQUE PATIENTS REPORT"
217 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",2)=" "
218 S ^XTMP("PSU_"_PSUJOB,"PSUSUMA",3)="No data to report"
219 D PDSUM^PSUDEM5
220 Q
Note: See TracBrowser for help on using the repository browser.