source: FOIAVistA/tag/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUV12.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 8.8 KB
Line 
1PSUV12 ;BIR/DAM - IV AMIS Summary Message II ;04 MAR 2004
2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;**4**;MARCH, 2005
3 ;
4 ;No DBIA's required
5 ;
6EN ;Entry point for MailMan message
7 ;Called from PSUV11
8 ;
9 ;Construct IV AMIS summary message
10 ;
11 S Y=PSUSDT X ^DD("DD") S PSUDTS=Y
12 S Y=PSUEDT X ^DD("DD") S PSUDTE=Y
13 S PSUDIV=PSUSNDR D GETDIV^PSUV3
14 S AMIS(1)="IV AMIS Summary for "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
15 ;
16 S AMIS(2)="" ;Blank line
17 ;
18 I PSUAIS=1 S AMIS(3)="NO IV AMIS Summary data to report" Q
19 ;
20 S AMIS(3)=" NET Cost/"
21 ;
22 S AMIS(4)=" LVPs LVPs LVPs LVPs LVPs Total NET LVPs"
23 ;
24 S AMIS(5)="Division DISP RET DES CAN DISP Cost DISP"
25 ;
26 S $P(AMIS(6),"-",78)="" ;Separator bar
27 ;
28 S PSULN=7
29 ;
30 ;Construct LVP DATA lines with spacing
31 S PSUDIV=0
32 F S PSUDIV=$O(LVP(PSUDIV)) Q:PSUDIV="" D
33 .D GETDIV^PSUV3
34 .S PSULINE=""
35 .S $E(PSULINE,1,17)=PSUDIVNM
36 .S $E(PSULINE,18,24)=$J($P(LVP(PSUDIV),U,1),7)
37 .S $E(PSULINE,25,31)=$J($P(LVP(PSUDIV),U,2),7)
38 .S $E(PSULINE,32,38)=$J($P(LVP(PSUDIV),U,3),7)
39 .S $E(PSULINE,39,45)=$J($P(LVP(PSUDIV),U,4),7)
40 .S $E(PSULINE,46,52)=$J($P(LVP(PSUDIV),U,5),7)
41 .S $E(PSULINE,54,55)="$"
42 .S $E(PSULINE,56,64)=$J($P(LVP(PSUDIV),U,6),9)
43 .S $E(PSULINE,66,67)="$"
44 .S $E(PSULINE,68,75)=$J($P(LVP(PSUDIV),U,7),8)
45 .;End line
46 .S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
47 ;
48 S $P(AMIS(PSULN),"-",78)="" S PSULN=PSULN+1 ;Separator bar
49 ;
50 M LVP("TOT")=^XTMP(PSUIVSUB,"LVPTOT") ;LVP Totals array
51 ;Construct LVP Totals line
52 S PSULINE=""
53 S $E(PSULINE,1,17)="Total"
54 S $E(PSULINE,18,24)=$J($P(LVP("TOT"),U,1),7)
55 S $E(PSULINE,25,31)=$J($P(LVP("TOT"),U,2),7)
56 S $E(PSULINE,32,38)=$J($P(LVP("TOT"),U,3),7)
57 S $E(PSULINE,39,45)=$J($P(LVP("TOT"),U,4),7)
58 S $E(PSULINE,46,52)=$J($P(LVP("TOT"),U,5),7)
59 S $E(PSULINE,54,55)="$"
60 S $E(PSULINE,56,64)=$J($P(LVP("TOT"),U,6),9)
61 S $E(PSULINE,66,67)="$"
62 S $E(PSULINE,68,75)=$J($P(LVP("TOT"),U,7),8)
63 ;End line
64 S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
65 ;
66 F PSULN=PSULN:1:(PSULN+4) S AMIS(PSULN)="" ;Blank lines
67 S PSULN=PSULN+1
68 ;
69 ;
70 S AMIS(PSULN)=" NET Cost/"
71 S PSULN=PSULN+1
72 ;
73 S AMIS(PSULN)=" IVPBs IVPBs IVPBs IVPBs IVPBs Total NET IVPBs"
74 ;
75 S PSULN=PSULN+1
76 S AMIS(PSULN)="Division DISP RET DES CAN DISP Cost DISP"
77 ;
78 S PSULN=PSULN+1
79 ;
80 S $P(AMIS(PSULN),"-",78)="" S PSULN=PSULN+1 ;Separator bar
81 ;
82 ;Construct IVPB DATA lines with spacing
83 S PSUDIV=0
84 F S PSUDIV=$O(PB(PSUDIV)) Q:PSUDIV="" D
85 .D GETDIV^PSUV3
86 .S PSULINE=""
87 .S $E(PSULINE,1,17)=PSUDIVNM
88 .S $E(PSULINE,18,24)=$J($P(PB(PSUDIV),U,1),7)
89 .S $E(PSULINE,25,31)=$J($P(PB(PSUDIV),U,2),7)
90 .S $E(PSULINE,32,38)=$J($P(PB(PSUDIV),U,3),7)
91 .S $E(PSULINE,39,45)=$J($P(PB(PSUDIV),U,4),7)
92 .S $E(PSULINE,46,52)=$J($P(PB(PSUDIV),U,5),7)
93 .S $E(PSULINE,54,55)="$"
94 .S $E(PSULINE,56,64)=$J($P(PB(PSUDIV),U,6),9)
95 .S $E(PSULINE,66,67)="$"
96 .S $E(PSULINE,68,75)=$J($P(PB(PSUDIV),U,7),8)
97 .;End line
98 .S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
99 ;
100 S $P(AMIS(PSULN),"-",78)="" S PSULN=PSULN+1 ;Separator bar
101 ;
102 M PB("TOT")=^XTMP(PSUIVSUB,"PBTOT") ;IVPB Totals array
103 ;Construct PB Totals line
104 S PSULINE=""
105 S $E(PSULINE,1,17)="Total"
106 S $E(PSULINE,18,24)=$J($P(PB("TOT"),U,1),7)
107 S $E(PSULINE,25,31)=$J($P(PB("TOT"),U,2),7)
108 S $E(PSULINE,32,38)=$J($P(PB("TOT"),U,3),7)
109 S $E(PSULINE,39,45)=$J($P(PB("TOT"),U,4),7)
110 S $E(PSULINE,46,52)=$J($P(PB("TOT"),U,5),7)
111 S $E(PSULINE,54,55)="$"
112 S $E(PSULINE,56,64)=$J($P(PB("TOT"),U,6),9)
113 S $E(PSULINE,66,67)="$"
114 S $E(PSULINE,68,75)=$J($P(PB("TOT"),U,7),8)
115 ;End line
116 S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
117 ;
118 F PSULN=PSULN:1:(PSULN+4) S AMIS(PSULN)="" ;Blank lines
119 S PSULN=PSULN+1
120 ;
121 S AMIS(PSULN)=" NET Cost/"
122 S PSULN=PSULN+1
123 ;
124 S AMIS(PSULN)=" TPNs TPNs TPNs TPNs TPNs Total NET TPNs"
125 ;
126 S PSULN=PSULN+1
127 S AMIS(PSULN)="Division DISP RET DES CAN DISP Cost DISP"
128 ;
129 S PSULN=PSULN+1
130 ;
131 S $P(AMIS(PSULN),"-",78)="" S PSULN=PSULN+1 ;Separator bar
132 ;
133 ;Construct TPN DATA lines with spacing
134 S PSUDIV=0
135 F S PSUDIV=$O(TPN(PSUDIV)) Q:PSUDIV="" D
136 .D GETDIV^PSUV3
137 .S PSULINE=""
138 .S $E(PSULINE,1,17)=PSUDIVNM
139 .S $E(PSULINE,18,24)=$J($P(TPN(PSUDIV),U,1),7)
140 .S $E(PSULINE,25,31)=$J($P(TPN(PSUDIV),U,2),7)
141 .S $E(PSULINE,32,38)=$J($P(TPN(PSUDIV),U,3),7)
142 .S $E(PSULINE,39,45)=$J($P(TPN(PSUDIV),U,4),7)
143 .S $E(PSULINE,46,52)=$J($P(TPN(PSUDIV),U,5),7)
144 .S $E(PSULINE,54,55)="$"
145 .S $E(PSULINE,56,64)=$J($P(TPN(PSUDIV),U,6),9)
146 .S $E(PSULINE,66,67)="$"
147 .S $E(PSULINE,68,75)=$J($P(TPN(PSUDIV),U,7),8)
148 .;End line
149 .S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
150 ;
151 S $P(AMIS(PSULN),"-",78)="" S PSULN=PSULN+1 ;Separator bar
152 ;
153 M TPN("TOT")=^XTMP(PSUIVSUB,"TPNTOT") ;TPN Totals array
154 ;Construct TPN Totals line
155 S PSULINE=""
156 S $E(PSULINE,1,17)="Total"
157 S $E(PSULINE,18,24)=$J($P(TPN("TOT"),U,1),7)
158 S $E(PSULINE,25,31)=$J($P(TPN("TOT"),U,2),7)
159 S $E(PSULINE,32,38)=$J($P(TPN("TOT"),U,3),7)
160 S $E(PSULINE,39,45)=$J($P(TPN("TOT"),U,4),7)
161 S $E(PSULINE,46,52)=$J($P(TPN("TOT"),U,5),7)
162 S $E(PSULINE,54,55)="$"
163 S $E(PSULINE,56,64)=$J($P(TPN("TOT"),U,6),9)
164 S $E(PSULINE,66,67)="$"
165 S $E(PSULINE,68,75)=$J($P(TPN("TOT"),U,7),8)
166 ;End line
167 S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
168 ;
169 F PSULN=PSULN:1:(PSULN+4) S AMIS(PSULN)="" ;Blank lines
170 S PSULN=PSULN+1
171 ;
172 S AMIS(PSULN)=" NET Cost/"
173 S PSULN=PSULN+1
174 ;
175 S AMIS(PSULN)=" CHEMO CHEMO CHEMO CHEMO CHEMO Total NET CHEMOs"
176 ;
177 S PSULN=PSULN+1
178 S AMIS(PSULN)="Division DISP RET DES CAN DISP Cost DISP"
179 ;
180 S PSULN=PSULN+1
181 ;
182 S $P(AMIS(PSULN),"-",78)="" S PSULN=PSULN+1 ;Separator bar
183 ;
184 ;Construct CHEMO DATA lines with spacing
185 S PSUDIV=0
186 F S PSUDIV=$O(CH(PSUDIV)) Q:PSUDIV="" D
187 .D GETDIV^PSUV3
188 .S PSULINE=""
189 .S $E(PSULINE,1,17)=PSUDIVNM
190 .S $E(PSULINE,18,24)=$J($P(CH(PSUDIV),U,1),7)
191 .S $E(PSULINE,25,31)=$J($P(CH(PSUDIV),U,2),7)
192 .S $E(PSULINE,32,38)=$J($P(CH(PSUDIV),U,3),7)
193 .S $E(PSULINE,39,45)=$J($P(CH(PSUDIV),U,4),7)
194 .S $E(PSULINE,46,52)=$J($P(CH(PSUDIV),U,5),7)
195 .S $E(PSULINE,54,55)="$"
196 .S $E(PSULINE,56,64)=$J($P(CH(PSUDIV),U,6),9)
197 .S $E(PSULINE,66,67)="$"
198 .S $E(PSULINE,68,75)=$J($P(CH(PSUDIV),U,7),8)
199 .;End line
200 .S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
201 ;
202 S $P(AMIS(PSULN),"-",78)="" S PSULN=PSULN+1 ;Separator bar
203 ;
204 M CH("TOT")=^XTMP(PSUIVSUB,"CHTOT") ;CHEMO Totals array
205 ;Construct CHEMO Totals line
206 S PSULINE=""
207 S $E(PSULINE,1,17)="Total"
208 S $E(PSULINE,18,24)=$J($P(CH("TOT"),U,1),7)
209 S $E(PSULINE,25,31)=$J($P(CH("TOT"),U,2),7)
210 S $E(PSULINE,32,38)=$J($P(CH("TOT"),U,3),7)
211 S $E(PSULINE,39,45)=$J($P(CH("TOT"),U,4),7)
212 S $E(PSULINE,46,52)=$J($P(CH("TOT"),U,5),7)
213 S $E(PSULINE,54,55)="$"
214 S $E(PSULINE,56,64)=$J($P(CH("TOT"),U,6),9)
215 S $E(PSULINE,66,67)="$"
216 S $E(PSULINE,68,75)=$J($P(CH("TOT"),U,7),8)
217 ;End line
218 S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
219 ;
220 F PSULN=PSULN:1:(PSULN+4) S AMIS(PSULN)="" ;Blank lines
221 S PSULN=PSULN+1
222 ;
223 ;
224 S AMIS(PSULN)=" NET Cost/"
225 S PSULN=PSULN+1
226 ;
227 S AMIS(PSULN)=" SYRs SYRs SYRs SYRs SYRs Total NET SYRs"
228 ;
229 S PSULN=PSULN+1
230 S AMIS(PSULN)="Division DISP RET DES CAN DISP Cost DISP"
231 ;
232 S PSULN=PSULN+1
233 ;
234 S $P(AMIS(PSULN),"-",78)="" S PSULN=PSULN+1 ;Separator bar
235 ;
236 ;Construct SYRINGE DATA lines with spacing
237 S PSUDIV=0
238 F S PSUDIV=$O(SYR(PSUDIV)) Q:PSUDIV="" D
239 .D GETDIV^PSUV3
240 .S PSULINE=""
241 .S $E(PSULINE,1,17)=PSUDIVNM
242 .S $E(PSULINE,18,24)=$J($P(SYR(PSUDIV),U,1),7)
243 .S $E(PSULINE,25,31)=$J($P(SYR(PSUDIV),U,2),7)
244 .S $E(PSULINE,32,38)=$J($P(SYR(PSUDIV),U,3),7)
245 .S $E(PSULINE,39,45)=$J($P(SYR(PSUDIV),U,4),7)
246 .S $E(PSULINE,46,52)=$J($P(SYR(PSUDIV),U,5),7)
247 .S $E(PSULINE,54,55)="$"
248 .S $E(PSULINE,56,64)=$J($P(SYR(PSUDIV),U,6),9)
249 .S $E(PSULINE,66,67)="$"
250 .S $E(PSULINE,68,75)=$J($P(SYR(PSUDIV),U,7),8)
251 .;End line
252 .S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
253 ;
254 S $P(AMIS(PSULN),"-",78)="" S PSULN=PSULN+1 ;Separator bar
255 ;
256 M SYR("TOT")=^XTMP(PSUIVSUB,"SYRTOT") ;SYRINGE Totals array
257 ;Construct SYRINGE Totals line
258 S PSULINE=""
259 S $E(PSULINE,1,17)="Total"
260 S $E(PSULINE,18,24)=$J($P(SYR("TOT"),U,1),7)
261 S $E(PSULINE,25,31)=$J($P(SYR("TOT"),U,2),7)
262 S $E(PSULINE,32,38)=$J($P(SYR("TOT"),U,3),7)
263 S $E(PSULINE,39,45)=$J($P(SYR("TOT"),U,4),7)
264 S $E(PSULINE,46,52)=$J($P(SYR("TOT"),U,5),7)
265 S $E(PSULINE,54,55)="$"
266 S $E(PSULINE,56,64)=$J($P(SYR("TOT"),U,6),9)
267 S $E(PSULINE,66,67)="$"
268 S $E(PSULINE,68,75)=$J($P(SYR("TOT"),U,7),8)
269 ;End line
270 S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
271 ;
272 F PSULN=PSULN:1:(PSULN+4) S AMIS(PSULN)="" ;Blank lines
273 S PSULN=PSULN+1
274 Q
Note: See TracBrowser for help on using the repository browser.