source: WorldVistAEHR/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUUD7.m@ 1739

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

initial load of WorldVistAEHR
File size: 4.1 KB
Line 
1PSUUD7 ;BIR/DAM - UD AMIS Summary Message II;23 MAR 2004
2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
3 ;
4 ;Reference to file #40.8 supported by DBIA 2438
5 ;
6EN ;Entry point for MailMan message
7 ;Called from PSUUD0
8 ;
9 K AMIS,DOSE,DOSTOT,SPEC,DIVTOT,GTOT ;Kill arrays to hold data
10 ;
11 D MSG
12 F PSULN=PSULN:1:(PSULN+3) S AMIS(PSULN)="" ;Blank lines
13 M ^XTMP("PSU_"_PSUJOB,"UDAMIS")=AMIS
14 D MAIL
15 ;
16 Q
17 ;
18MSG ;Set up lines in message
19 ;
20 S Y=PSUSDT\1 X ^DD("DD") S PSUDTS=Y ; start date
21 S Y=PSUEDT\1 X ^DD("DD") S PSUDTE=Y ; end date
22 ;
23 S X=PSUSNDR,DIC=40.8,DIC(0)="X",D="C" D IX^DIC
24 S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
25 S AMIS(1)="UD AMIS Summary for "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
26 ;
27 S AMIS(2)="" ;Blank line
28 ;
29 S AMIS(3)=" NET"
30 ;
31 S AMIS(4)=" DOSES DOSES DOSES TOTAL AVG COST"
32 ;
33 S AMIS(5)="DIVISION DISP RET DISP COST PER DOSE"
34 ;
35 S $P(AMIS(6),"-",78)="" ;Separator bar
36 ;
37 S PSULN=7
38 ;
39 D DOSE
40 ;
41 S $P(AMIS(PSULN),"-",78)="" S PSULN=PSULN+1 ;Separator bar
42 ;
43 D DOST
44 ;
45 F PSULN=PSULN:1:(PSULN+2) S AMIS(PSULN)="" ;Blank lines
46 S PULN=PSULN+1
47 ;
48 S AMIS(PSULN)="Division Specialty Total Patient Days of Care"
49 ;
50 S PSULN=PSULN+1
51 ;
52 S $P(AMIS(PSULN),"-",78)="" S PSULN=PSULN+1 ;Separator bar
53 ;
54 D DIV ;Calculate division data
55 D GTOT ;Calculate grand totals
56 Q
57 ;
58DOSE ;Set doses into array and set data into message
59 ;
60 M DOSE=^XTMP(PSUUDSUB,"DOSES")
61 ;
62 S PSUDIV=0
63 F S PSUDIV=$O(DOSE(PSUDIV)) Q:PSUDIV="" D
64 .S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC
65 .S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
66 .S PSULINE=""
67 .S $E(PSULINE,1,17)=PSUDIVNM
68 .S $E(PSULINE,18,24)=$J($P(DOSE(PSUDIV),U,1),7)
69 .S $E(PSULINE,25,32)=$J($P(DOSE(PSUDIV),U,2),8)
70 .S $E(PSULINE,33,42)=$J($P(DOSE(PSUDIV),U,3),10)
71 .S $E(PSULINE,44,45)="$"
72 .S $E(PSULINE,46,53)=$J($P(DOSE(PSUDIV),U,4),8)
73 .S $E(PSULINE,57,58)="$"
74 .S $E(PSULINE,59,64)=$J($P(DOSE(PSUDIV),U,5),6)
75 .S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
76 Q
77 ;
78DOST ;Set dose totals into array and set into message
79 ;
80 M DOSTOT=^XTMP(PSUUDSUB,"DOSTOT")
81 I '$G(DOSTOT) S DOSTOT="0^0^0^0^0"
82 ;
83 S PSULINE=""
84 S $E(PSULINE,1,17)="Total"
85 S $E(PSULINE,18,24)=$J($P(DOSTOT,U,1),7)
86 S $E(PSULINE,25,32)=$J($P(DOSTOT,U,2),8)
87 S $E(PSULINE,33,42)=$J($P(DOSTOT,U,3),10)
88 S $E(PSULINE,44,45)="$"
89 S $E(PSULINE,46,53)=$J($P(DOSTOT,U,4),8)
90 S $E(PSULINE,57,58)="$"
91 S $E(PSULINE,59,64)=$J($P(DOSTOT,U,5),6)
92 S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
93 Q
94 ;
95DIV ;Set division data into array and create message
96 ;
97 M SPEC=^XTMP(PSUUDSUB,"SPEC")
98 ;
99 ;
100 S PSUDV=0
101 F S PSUDV=$O(SPEC(PSUDV)) Q:PSUDV="" D
102 .S X=PSUDV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC
103 .S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
104 .S PSUSPC=0
105 .N C
106 .F S PSUSPC=$O(SPEC(PSUDV,PSUSPC)) Q:PSUSPC="" D
107 ..S PSULINE=""
108 ..I '$D(C) S $E(PSULINE,1,17)=PSUDIVNM S C=""
109 ..S $E(PSULINE,25,49)=$P(SPEC(PSUDV,PSUSPC),U,1)
110 ..S $E(PSULINE,50,59)=$J($P(SPEC(PSUDV,PSUSPC),U,2),10)
111 ..S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
112 .D DIVTOT
113 Q
114 ;
115DIVTOT ;Create message lines for division totals
116 ;
117 S $P(AMIS(PSULN),"-",78)="" S PSULN=PSULN+1 ;Separator bar
118 ;
119 S PSULINE=""
120 S $E(PSULINE,1,40)=PSUDIVNM_" Total"
121 S $E(PSULINE,50,59)=$J(^XTMP(PSUUDSUB,"DIVTOT",PSUDV),10)
122 S AMIS(PSULN)=PSULINE
123 ;
124 S PSULN=PSULN+1
125 ;
126 F PSULN=PSULN:1:(PSULN+2) S AMIS(PSULN)="" ;Blank lines
127 S PSULN=PSULN+1
128 Q
129 ;
130GTOT ;Calculate grand total patient days of care for all divisions
131 ;
132 S $P(AMIS(PSULN),"-",78)="" S PSULN=PSULN+1 ;Separator bar
133 ;
134 S PSULINE=""
135 S $E(PSULINE,1,40)="Grand Total"
136 S $E(PSULINE,50,59)=$J($G(^XTMP(PSUUDSUB,"GTOT")),10)
137 S AMIS(PSULN)=PSULINE S PSULN=PSULN+1
138 ;
139 ;
140 Q
141 ;
142MAIL ;Send mailman message
143 ;
144 ;Do not send report if option selection includes 1,2,3,4,6
145 I $D(^XTMP("PSU_"_PSUJOB,"CBAMIS")) D Q
146 .M ^XTMP("PSU_"_PSUJOB,"UDCOMBO")=AMIS
147 .S ^XTMP("PSU_"_PSUJOB,"UDCOMBO",1)="INPATIENT:"
148 ;
149 S X=PSUSNDR,DIC=40.8,DIC(0)="X",D="C" D IX^DIC
150 S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
151 ;
152 S XMSUB="V. 4.0 PBMUD "_PSUMON_" "_PSUSNDR_" "_PSUDIVNM
153 S XMTEXT="AMIS("
154 S XMDUZ=DUZ
155 M XMY=PSUXMY
156 S XMCHAN=1
157 I PSUMASF!PSUDUZ!PSUPBMG D ^XMD
158 ;
159 Q
Note: See TracBrowser for help on using the repository browser.