source: FOIAVistA/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUCSR2.m@ 1488

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

initial load of FOIAVistA 6/30/08 version
File size: 4.3 KB
Line 
1PSUCSR2 ;BIR/DAM - PBM CS AMIS SUMMARY;6 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 ^PSUCSR1
8 ;
9 N TYP
10 K CSAM
11 ;
12 S PSUDV=0
13 F S PSUDV=$O(^XTMP(PSUCSJB,"RECORDS",PSUDV)) Q:PSUDV="" D
14 .S PSUA=0
15 .F S PSUA=$O(^XTMP(PSUCSJB,"RECORDS",PSUDV,PSUA)) Q:PSUA="" D
16 ..S PSUB=0
17 ..F S PSUB=$O(^XTMP(PSUCSJB,"RECORDS",PSUDV,PSUA,PSUB)) Q:PSUB="" D
18 ...S TYP=^XTMP(PSUCSJB,"RECORDS",PSUDV,PSUA,PSUB,0)
19 ...I TYP=2 D
20 ....D DISP
21 ....D TCOST
22 .Q:'$D(CSAM(PSUDV))
23 .D AVE
24 .D TRUNC
25 ;
26 D TOTAL
27 D MSG
28 D MAIL
29 ;
30 Q
31 ;
32DISP ;Calculate orders dispensed
33 ;
34 S $P(CSAM(PSUDV),U,1)=$P($G(CSAM(PSUDV)),U,1)+1
35 ;
36 Q
37 ;
38TCOST ;Calculate total cost of orders dispensed
39 ;
40 N QTY,PRC
41 ;
42 S QTY=^XTMP(PSUCSJB,"RECORDS",PSUDV,PSUA,PSUB,17)
43 S PRC=^XTMP(PSUCSJB,"RECORDS",PSUDV,PSUA,PSUB,16)
44 ;
45 S $P(CSAM(PSUDV),U,2)=$P($G(CSAM(PSUDV)),U,2)+(QTY*PRC)
46 ;
47 Q
48 ;
49AVE ;Calculate average cost per order
50 ;
51 N TCST,DSP
52 ;
53 S DSP=$P(CSAM(PSUDV),U,1)
54 S TCST=$P(CSAM(PSUDV),U,2)
55 ;
56 S $P(CSAM(PSUDV),U,3)=$P($G(CSAM(PSUDV)),U,3)+(TCST/DSP)
57 ;
58 Q
59 ;
60TRUNC ;Truncate pieces with dollar values to 2 decimal places
61 ;
62 F I=2:1:3 D
63 .N A,B,C
64 .;
65 .I $P(CSAM(PSUDV),U,I)'["." D Q
66 ..S $P(CSAM(PSUDV),U,I)=$P(CSAM(PSUDV),U,I)_".00"
67 .;
68 .S A=$F($P(CSAM(PSUDV),U,I),".") ;Find first position after decimal
69 .;
70 .S B=$E($P(CSAM(PSUDV),U,I),1,(A-1)) ;Extract dollars and decimal
71 .;
72 .S C=$E($P(CSAM(PSUDV),U,I),A,(A+1)) ;Extract cents after decimal
73 .;
74 .I $L(C)'=2 S C=$E(C,1)_0
75 .;
76 .S $P(CSAM(PSUDV),U,I)=B_C
77 ;
78 Q
79TOTAL ;Add column totals
80 ;
81 N TDSP,TCST,TAVE
82 ;
83 S PSUDIV=0
84 F S PSUDIV=$O(CSAM(PSUDIV)) Q:PSUDIV="" D
85 .S TDSP=$G(TDSP)+$P(CSAM(PSUDIV),U,1) ;Total orders dispensed
86 .S TCST=$G(TCST)+$P(CSAM(PSUDIV),U,2) ;Total of total costs
87 .I $G(TDSP) S TAVE=$G(TCST)/TDSP D
88 ..I TAVE'["." S TAVE=TAVE_".00" Q
89 ..N A,B,C
90 ..S A=$F(TAVE,".") ;Find 1st position after decimal
91 ..S B=$E(TAVE,1,(A-1)) ;Extract dollars and decimal
92 ..S C=$E(TAVE,A,(A+1)) ;Extract cents after decimal
93 ..I $L(C)'=2 S C=$E(C,1)_0
94 ..S TAVE=B_C
95 ;
96 S TOTAL("TOT")=$G(TDSP)_U_$G(TCST)_U_$G(TAVE)
97 ;
98 Q
99 ;
100MSG ;Construct lines for the MailMan message
101 ;
102 S Y=PSUSDT\1 X ^DD("DD") S PSUDTS=Y ; start date
103 S Y=PSUEDT\1 X ^DD("DD") S PSUDTE=Y ; end date
104 ;
105 K AMISC ;Array to hold message lines
106 ;
107 S AMISC(1)="Controlled AMIS Summary for "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
108 ;
109 S AMISC(2)="" ;Blank line
110 ;
111 I '$D(CSAM) D Q
112 .S AMISC(3)=" "
113 .S AMISC(4)="No data to report"
114 .S AMISC(5)=" "
115 ;
116 S ^XTMP(PSUCSJB,"MAIL",PSUMC)=PSUDIV
117 ;
118 S AMISC(3)="INPATIENT CONTROLLED SUBSTANCE ORDERS:"
119 ;
120 S AMISC(4)="" ;Blank line
121 ;
122 S AMISC(5)=" ORDERS TOTAL AVE COST"
123 S AMISC(6)="DIVISION DISPENSED COST PER ORDER"
124 ;
125 S $P(AMISC(7),"-",78)="" ;Separator bar
126 ;
127 S PSULN=8
128 ;
129 S PSUDIV=0
130 F S PSUDIV=$O(CSAM(PSUDIV)) Q:PSUDIV="" D
131 .S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC
132 .S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
133 .S PSULINE=""
134 .S $E(PSULINE,1,17)=PSUDIVNM
135 .S $E(PSULINE,18,35)=$J($P(CSAM(PSUDIV),U,1),18)
136 .S $E(PSULINE,41,42)="$"
137 .S $E(PSULINE,43,53)=$J($P(CSAM(PSUDIV),U,2),11)
138 .S $E(PSULINE,60,61)="$"
139 .S $E(PSULINE,62,67)=$J($P(CSAM(PSUDIV),U,3),6)
140 .S AMISC(PSULN)=PSULINE S PSULN=PSULN+1
141 ;
142 S $P(AMISC(PSULN),"-",78)="" ;Separator bar
143 S PSULN=PSULN+1
144 ;
145 S PSULINE=""
146 S $E(PSULINE,1,17)="Total"
147 S $E(PSULINE,18,35)=$J($P(TOTAL("TOT"),U,1),18)
148 S $E(PSULINE,41,42)="$"
149 S $E(PSULINE,43,53)=$J($P(TOTAL("TOT"),U,2),11)
150 S $E(PSULINE,60,61)="$"
151 S $E(PSULINE,62,67)=$J($P(TOTAL("TOT"),U,3),6)
152 S AMISC(PSULN)=PSULINE S PSULN=PSULN+1
153 ;
154 F PSULN=PSULN:1:(PSULN+2) S AMISC(PSULN)="" ;Blank lines
155 Q
156 ;
157MAIL ;Mail CS AMIS summary report
158 ;
159 ;Do not send report if option selection includes 1,2,3,4,6
160 ;Instead send the combined AMIS summary report
161 I $D(^XTMP("PSU_"_PSUJOB,"CBAMIS")) D Q
162 .M ^XTMP("PSU_"_PSUJOB,"CSCOMBO")=AMISC
163 .S ^XTMP("PSU_"_PSUJOB,"CSCOMBO",1)=""
164 .D EN^PSUAMC
165 ;
166 M XMY=PSUXMYS2
167 ;
168 S X=PSUSNDR,DIC=40.8,DIC(0)="X",D="C" D IX^DIC
169 S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
170 ;
171 S XMSUB="V. 4.0 PBMCS "_PSUMON_" "_PSUSNDR_" "_PSUDIVNM
172 S XMTEXT="AMISC("
173 M ^XTMP("PSU_"_PSUJOB,"CSAMIS")=AMISC
174 S XMCHAN=1
175 D ^XMD
176 ;
177 Q
Note: See TracBrowser for help on using the repository browser.