source: FOIAVistA/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUAR7.m@ 1801

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

initial load of FOIAVistA 6/30/08 version
File size: 7.8 KB
Line 
1PSUAR7 ;BIR/DAM - PBM AR/WS AMIS SUMMARY MESSAGE;15 APR 2004
2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
3 ;
4 ;Reference to file #40.8 supported by DBIA 2438
5 ;
6EN ;Entry point to create AMIS summary report
7 ;Called from ^PSUAR6
8 ;
9 D DOSES
10 Q:'$D(^XTMP(PSUARSUB,"DIV_CAT")) ;QUIT IF NO DATA
11 D UNITS
12 D FLDS
13 D BLD
14 F PSULN=PSULN:1:(PSULN+3) S AMISAR(PSULN)="" ;Blank lines
15 D MAIL
16 ;
17 Q
18 ;
19 ;
20DOSES ;Construct DOSES lines for the MailMan message
21 ;
22 S Y=PSUSDT\1 X ^DD("DD") S PSUDTS=Y ; start date
23 S Y=PSUEDT\1 X ^DD("DD") S PSUDTE=Y ; end date
24 ;
25 K AMISAR ;Array to hold message lines
26 ;
27 S AMISAR(1)="Automatic Replenishment/Ward Stock AMIS Summary"
28 ;
29 S AMISAR(2)=PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
30 ;
31 S AMISAR(3)="" ;Blank line
32 ;
33 I '$D(^XTMP(PSUARSUB,"DIV_CAT")) D G MAIL ;NO DATA REPORT
34 .S AMISAR(3)=" "
35 .S AMISAR(4)="No data to report"
36 .S AMISAR(5)=" "
37 ;
38 S AMISAR(4)="AR/WS DOSES:"
39 ;
40 S AMISAR(5)=" DOSES DOSES NET DOSES TOTAL AVE COST"
41 S AMISAR(6)="DIVISION DISPENSED RETURNED DISPENSED COST PER DOSE"
42 ;
43 S $P(AMISAR(7),"-",78)="" ;Separator bar
44 ;
45 S PSULN=8
46 ;
47 S PSUDIV=0
48 F S PSUDIV=$O(PSUAR("DSP",PSUDIV)) Q:PSUDIV="" D
49 .S PSULINE=""
50 .S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC
51 .S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
52 .S $E(PSULINE,1,17)=$G(PSUDIVNM)
53 .I PSUDIVNM="" S $E(PSULINE,1,17)=$G(PSUDIV)
54 .S $E(PSULINE,19,29)=$J($P(PSUAR("DSP",PSUDIV),U,1),11)
55 .S $E(PSULINE,30,39)=$J($P(PSUAR("DSP",PSUDIV),U,2),10)
56 .S $E(PSULINE,40,50)=$J($P(PSUAR("DSP",PSUDIV),U,3),11)
57 .S $E(PSULINE,53,54)="$"
58 .S $E(PSULINE,55,65)=$J($P(PSUAR("DSP",PSUDIV),U,4),11)
59 .S $E(PSULINE,70,71)="$"
60 .S $E(PSULINE,72,78)=$J($P(PSUAR("DSP",PSUDIV),U,5),7)
61 .S AMISAR(PSULN)=PSULINE S PSULN=PSULN+1
62 ;
63 S $P(AMISAR(PSULN),"-",78)="" ;Separator bar
64 S PSULN=PSULN+1
65 ;
66 S PSULINE=""
67 S $E(PSULINE,1,17)="Total"
68 S $E(PSULINE,19,29)=$J($P(TOTAL("DSP"),U,1),11)
69 S $E(PSULINE,30,39)=$J($P(TOTAL("DSP"),U,2),10)
70 S $E(PSULINE,40,50)=$J($P(TOTAL("DSP"),U,3),11)
71 S $E(PSULINE,53,54)="$"
72 S $E(PSULINE,55,65)=$J($P(TOTAL("DSP"),U,4),11)
73 S $E(PSULINE,70,71)="$"
74 S $E(PSULINE,72,78)=$J($P(TOTAL("DSP"),U,5),7)
75 S AMISAR(PSULN)=PSULINE S PSULN=PSULN+1
76 ;
77 Q
78 ;
79UNITS ;Construct DOSES lines for the MailMan message
80 ;
81 F PSULN=PSULN:1:(PSULN+1) S AMISAR(PSULN)=""
82 S PSULN=PSULN+1
83 ;
84 S AMISAR(PSULN)="AR/WS UNITS:"
85 S PSULN=PSULN+1
86 ;
87 S AMISAR(PSULN)=" UNITS UNITS NET UNITS TOTAL AVE COST"
88 S PSULN=PSULN+1
89 ;
90 S AMISAR(PSULN)="DIVISION DISPENSED RETURNED DISPENSED COST PER UNIT"
91 S PSULN=PSULN+1
92 ;
93 S $P(AMISAR(PSULN),"-",78)="" ;Separator bar
94 ;
95 S PSULN=PSULN+1
96 ;
97 S PSUDIV=0
98 F S PSUDIV=$O(PSUAR("UNIT",PSUDIV)) Q:PSUDIV="" D
99 .S PSULINE=""
100 .S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC
101 .S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
102 .S $E(PSULINE,1,17)=$G(PSUDIVNM)
103 .I PSUDIVNM="" S $E(PSULINE,1,17)=$G(PSUDIV)
104 .S $E(PSULINE,19,29)=$J($P(PSUAR("UNIT",PSUDIV),U,1),11)
105 .S $E(PSULINE,30,39)=$J($P(PSUAR("UNIT",PSUDIV),U,2),10)
106 .S $E(PSULINE,40,50)=$J($P(PSUAR("UNIT",PSUDIV),U,3),11)
107 .S $E(PSULINE,53,54)="$"
108 .S $E(PSULINE,55,65)=$J($P(PSUAR("UNIT",PSUDIV),U,4),11)
109 .S $E(PSULINE,70,71)="$"
110 .S $E(PSULINE,72,78)=$J($P(PSUAR("UNIT",PSUDIV),U,5),7)
111 .S AMISAR(PSULN)=PSULINE S PSULN=PSULN+1
112 ;
113 S $P(AMISAR(PSULN),"-",78)="" ;Separator bar
114 S PSULN=PSULN+1
115 ;
116 S PSULINE=""
117 S $E(PSULINE,1,17)="Total"
118 S $E(PSULINE,19,29)=$J($P(TOTAL("UNIT"),U,1),11)
119 S $E(PSULINE,30,39)=$J($P(TOTAL("UNIT"),U,2),10)
120 S $E(PSULINE,40,50)=$J($P(TOTAL("UNIT"),U,3),11)
121 S $E(PSULINE,53,54)="$"
122 S $E(PSULINE,55,65)=$J($P(TOTAL("UNIT"),U,4),11)
123 S $E(PSULINE,70,71)="$"
124 S $E(PSULINE,72,78)=$J($P(TOTAL("UNIT"),U,5),7)
125 S AMISAR(PSULN)=PSULINE S PSULN=PSULN+1
126 ;
127 Q
128 ;
129FLDS ;Compose lines for FLUIDS/SETS portion of message
130 ;
131 F PSULN=PSULN:1:(PSULN+1) S AMISAR(PSULN)=""
132 S PSULN=PSULN+1
133 ;
134 S AMISAR(PSULN)="FLUIDS/SETS:"
135 S PSULN=PSULN+1
136 ;
137 S AMISAR(PSULN)=" NET"
138 S PSULN=PSULN+1
139 ;
140 S AMISAR(PSULN)=" FLUIDS/SETS FLUIDS/SETS FLUIDS/SETS TOTAL AVE COST"
141 S PSULN=PSULN+1
142 ;
143 S AMISAR(PSULN)="DIVISION DISPENSED RETURNED DISPENSED COST PER"
144 S PSULN=PSULN+1
145 ;
146 S AMISAR(PSULN)=" FLUIDS/SETS"
147 S PSULN=PSULN+1
148 ;
149 S $P(AMISAR(PSULN),"-",78)="" ;Separator bar
150 ;
151 S PSULN=PSULN+1
152 ;
153 S PSUDIV=0
154 F S PSUDIV=$O(PSUAR("FLD",PSUDIV)) Q:PSUDIV="" D
155 .S PSULINE=""
156 .S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC
157 .S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
158 .S $E(PSULINE,1,17)=$G(PSUDIVNM)
159 .I PSUDIVNM="" S $E(PSULINE,1,17)=$G(PSUDIV)
160 .S $E(PSULINE,19,29)=$J($P(PSUAR("FLD",PSUDIV),U,1),11)
161 .S $E(PSULINE,30,39)=$J($P(PSUAR("FLD",PSUDIV),U,2),10)
162 .S $E(PSULINE,40,50)=$J($P(PSUAR("FLD",PSUDIV),U,3),11)
163 .S $E(PSULINE,53,54)="$"
164 .S $E(PSULINE,55,65)=$J($P(PSUAR("FLD",PSUDIV),U,4),11)
165 .S $E(PSULINE,70,71)="$"
166 .S $E(PSULINE,72,78)=$J($P(PSUAR("FLD",PSUDIV),U,5),7)
167 .S AMISAR(PSULN)=PSULINE S PSULN=PSULN+1
168 ;
169 S $P(AMISAR(PSULN),"-",78)="" ;Separator bar
170 S PSULN=PSULN+1
171 ;
172 S PSULINE=""
173 S $E(PSULINE,1,17)="Total"
174 S $E(PSULINE,19,29)=$J($P(TOTAL("FLD"),U,1),11)
175 S $E(PSULINE,30,39)=$J($P(TOTAL("FLD"),U,2),10)
176 S $E(PSULINE,40,50)=$J($P(TOTAL("FLD"),U,3),11)
177 S $E(PSULINE,53,54)="$"
178 S $E(PSULINE,55,65)=$J($P(TOTAL("FLD"),U,4),11)
179 S $E(PSULINE,70,71)="$"
180 S $E(PSULINE,72,78)=$J($P(TOTAL("FLD"),U,5),7)
181 S AMISAR(PSULN)=PSULINE S PSULN=PSULN+1
182 ;
183 Q
184 ;
185BLD ;Compose lines for BLOOD PRODUCTS portion of message
186 ;
187 F PSULN=PSULN:1:(PSULN+1) S AMISAR(PSULN)=""
188 S PSULN=PSULN+1
189 ;
190 S AMISAR(PSULN)="BLOOD PRODUCTS"
191 S PSULN=PSULN+1
192 ;
193 S AMISAR(PSULN)=" NET"
194 S PSULN=PSULN+1
195 ;
196 S AMISAR(PSULN)=" BLOOD PROD BLOOD PROD BLOOD PROD TOTAL AVE COST"
197 S PSULN=PSULN+1
198 ;
199 S AMISAR(PSULN)="DIVISION DISPENSED RETURNED DISPENSED COST PER"
200 S PSULN=PSULN+1
201 ;
202 S AMISAR(PSULN)=" BLOOD PROD"
203 S PSULN=PSULN+1
204 ;
205 S $P(AMISAR(PSULN),"-",78)="" ;Separator bar
206 ;
207 S PSULN=PSULN+1
208 ;
209 S PSUDIV=0
210 F S PSUDIV=$O(PSUAR("BLD",PSUDIV)) Q:PSUDIV="" D
211 .S PSULINE=""
212 .S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC
213 .S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
214 .S $E(PSULINE,1,17)=$G(PSUDIVNM)
215 .I PSUDIVNM="" S $E(PSULINE,1,17)=$G(PSUDIV)
216 .S $E(PSULINE,19,29)=$J($P(PSUAR("BLD",PSUDIV),U,1),11)
217 .S $E(PSULINE,30,39)=$J($P(PSUAR("BLD",PSUDIV),U,2),10)
218 .S $E(PSULINE,40,50)=$J($P(PSUAR("BLD",PSUDIV),U,3),11)
219 .S $E(PSULINE,53,54)="$"
220 .S $E(PSULINE,55,65)=$J($P(PSUAR("BLD",PSUDIV),U,4),11)
221 .S $E(PSULINE,70,71)="$"
222 .S $E(PSULINE,72,78)=$J($P(PSUAR("BLD",PSUDIV),U,5),7)
223 .S AMISAR(PSULN)=PSULINE S PSULN=PSULN+1
224 ;
225 S $P(AMISAR(PSULN),"-",78)="" ;Separator bar
226 S PSULN=PSULN+1
227 ;
228 S PSULINE=""
229 S $E(PSULINE,1,17)="Total"
230 S $E(PSULINE,19,29)=$J($P(TOTAL("BLD"),U,1),11)
231 S $E(PSULINE,30,39)=$J($P(TOTAL("BLD"),U,2),10)
232 S $E(PSULINE,40,50)=$J($P(TOTAL("BLD"),U,3),11)
233 S $E(PSULINE,53,54)="$"
234 S $E(PSULINE,55,65)=$J($P(TOTAL("BLD"),U,4),11)
235 S $E(PSULINE,70,71)="$"
236 S $E(PSULINE,72,78)=$J($P(TOTAL("BLD"),U,5),7)
237 S AMISAR(PSULN)=PSULINE S PSULN=PSULN+1
238 ;
239 Q
240 ;
241 ;
242 ;
243MAIL ;Mail CS AMIS summary report
244 ;
245 ;Do not send report if option selection includes 1,2,3,4,6
246 I $D(^XTMP("PSU_"_PSUJOB,"CBAMIS")) D Q
247 .M ^XTMP("PSU_"_PSUJOB,"ARCOMBO")=AMISAR
248 .S ^XTMP("PSU_"_PSUJOB,"ARCOMBO",1)=""
249 .S ^XTMP("PSU_"_PSUJOB,"ARCOMBO",2)=""
250 ;
251 M XMY=PSUXMYS2
252 ;
253 S X=PSUSNDR,DIC=40.8,DIC(0)="X",D="C" D IX^DIC
254 S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
255 ;
256 S XMSUB="V. 4.0 PBMAR "_PSUMON_" "_PSUSNDR_" "_PSUDIVNM
257 S XMTEXT="AMISAR("
258 M ^XTMP("PSU_"_PSUJOB,"ARAMIS")=AMISAR
259 S XMCHAN=1
260 D ^XMD
261 ;
262 Q
Note: See TracBrowser for help on using the repository browser.