source: FOIAVistA/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUOP5.m@ 1401

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

initial load of FOIAVistA 6/30/08 version
File size: 5.0 KB
Line 
1PSUOP5 ;BIR/CFL,TJH;PSU PBM Outpatient Pharmacy summary statistical data; 08/25/1998
2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
3 ;
4RECLOOP ; loop through 'by-drug' totals to get grand totals
5 ;
6 ;
7 S PSUSITE=""
8 F S PSUSITE=$O(^XTMP(PSUOPSUB,"DRUG",PSUSITE)) Q:PSUSITE="" D
9 .F I=1:1:9 S PSUSUMT(I)=0
10 .S PSUDNM=""
11 .F S PSUDNM=$O(^XTMP(PSUOPSUB,"DRUG",PSUSITE,PSUDNM)) Q:PSUDNM="" D
12 ..S PSUNR=$G(^XTMP(PSUOPSUB,"DRUG",PSUSITE,PSUDNM,"N"))
13 ..S PSUYR=$G(^XTMP(PSUOPSUB,"DRUG",PSUSITE,PSUDNM,"Y"))
14 ..F I=1:1:4 S PSUSUMT(I)=PSUSUMT(I)+$P(PSUNR,U,I)
15 ..F I=5:1:7 S PSUSUMT(I)=PSUSUMT(I)+$P(PSUYR,U,I-3)
16 .S PSUDVD=(PSUSUMT(1)+PSUSUMT(2)+PSUSUMT(3))
17 .I PSUDVD S PSUSUMT(8)=PSUSUMT(4)/PSUDVD
18 .S PSUDVD=(PSUSUMT(5)+PSUSUMT(6))
19 .I PSUDVD S PSUSUMT(9)=PSUSUMT(7)/PSUDVD
20 .F I=1:1:9 S $P(PSUREC,U,I)=PSUSUMT(I)
21 .S ^XTMP(PSUOPSUB,"SUMMARY",PSUSITE)=PSUREC
22 Q
23 ;
24RECSUM ;Set up statistical summary data to be printed
25 I PSUNOREC Q
26 K PSULINE,J
27 S Y=PSUSDT X ^DD("DD") S PSUDTS=Y
28 S Y=PSUEDT X ^DD("DD") S PSUDTE=Y
29 F I=1:1:9 S J(I)=$P(^XTMP(PSUOPSUB,"SUMMARY",PSUDIV),"^",I)
30 S PSULINE(1)="Outpatient Statistical Data Summary for "_PSUDTS_" through "_PSUDTE
31 S PSULINE(2)=" "
32 S X="",X=$$SETSTR^VALM1("Consolidated Mail Out Pharmacy (CMOP)",X,43,37)
33 S PSULINE(3)=X
34 S PSULINE(4)=" "
35 S X="",X=$$SETSTR^VALM1("Total",X,34,5),X=$$SETSTR^VALM1("Total",X,69,5)
36 S PSULINE(5)=X
37 S X="",X="Partials",X=$$SETSTR^VALM1("Fills",X,13,5)
38 S X=$$SETSTR^VALM1("Refills",X,22,7),X=$$SETSTR^VALM1("Cost",X,35,4)
39 S X=$$SETSTR^VALM1("Fills",X,48,5),X=$$SETSTR^VALM1("Refills",X,57,7)
40 S X=$$SETSTR^VALM1("Cost",X,70,4)
41 S PSULINE(6)=X
42 S PSULINE(7)=$E(PSUDASH,1,79)
43 S X=$J(J(1),6)_$J(J(2),10)_$J(J(3),11)_$J(J(4),12,2)_$J(J(5),12)_$J(J(6),11)_$J(J(7),12,2)
44 S PSULINE(8)=X
45 S PSULINE(9)=" "
46 S X=$E("Avg. Cost/Fill = $"_$J(J(8),0,2)_PSUFILL,1,47)_"Avg. Cost/Fill = $"_$J(J(9),0,2)
47 S PSULINE(10)=X
48 S XMCHAN=1
49 S XMSUB="V. 4.0 PBMOP "_$G(PSUMON)_" "_PSUDIV_" "_PSUDIVNM
50 S XMTEXT="PSULINE("
51 M XMY=PSUXMYS1
52 D ^XMD
53 M ^XTMP(PSUOPSUB,"STATSUM",PSUDIV)=PSULINE
54 Q
55 ;
56DRUGSUM ; create the Drug Summary
57 ;VMP OIFO BAY PINES;ELR;PSU*3.0*32
58 K ^XTMP(PSUOPSUB,"DRUGSUM",PSUDIV)
59 S PSUHDR0="Outpatient Statistical Data for "_PSUDTS_" through "_PSUDTE
60 S PSUHDR1=$J("Total Total Qty",96)
61 S PSUHDR2="Drug Name"_$J("Partials Fills Refills Cost Dispensed",87)
62 S PSUHDR3="Drug Name"_$J("Fills Refills Cost Dispensed",87)
63 S ^XTMP(PSUOPSUB,"DRUGSUM",PSUDIV,1)=PSUHDR0
64 S ^XTMP(PSUOPSUB,"DRUGSUM",PSUDIV,2)=$J("Page: 1",89)
65 S ^XTMP(PSUOPSUB,"DRUGSUM",PSUDIV,3)=" "
66 S ^XTMP(PSUOPSUB,"DRUGSUM",PSUDIV,4)=PSUHDR1
67 S ^XTMP(PSUOPSUB,"DRUGSUM",PSUDIV,5)=PSUHDR2
68 S ^XTMP(PSUOPSUB,"DRUGSUM",PSUDIV,6)=$E(PSUDASH,1,96)
69 S PSUDN="",PSULN=6
70 F I=1:1:4 S PSUTOT(I)=0
71 F S PSUDN=$O(^XTMP(PSUOPSUB,"DRUG",PSUDIV,PSUDN)) Q:PSUDN="" D
72 .S PSUR=$G(^XTMP(PSUOPSUB,"DRUG",PSUDIV,PSUDN,"N"))
73 .Q:PSUR=""
74 .F I=1:1:7 S PSUF(I)=$P(PSUR,U,I) S:I<5 PSUTOT(I)=PSUTOT(I)+PSUF(I)
75 .S PSULINE=$E(PSUDN_" "_PSUF(6)_PSUF(7)_PSUFILL,1,43)_$J(PSUF(1),9)
76 .S PSULINE=PSULINE_$J(PSUF(2),9)_$J(PSUF(3),9)_$J(PSUF(4),13,2)_$J(PSUF(5),13,2)
77 .S PSULN=PSULN+1
78 .S ^XTMP(PSUOPSUB,"DRUGSUM",PSUDIV,PSULN)=PSULINE
79 S PSULN=PSULN+1
80 S ^XTMP(PSUOPSUB,"DRUGSUM",PSUDIV,PSULN)=$E(PSUDASH,1,96)
81 S PSULN=PSULN+1
82 S PSULINE=$E("Totals:"_PSUFILL,1,43)_$J(PSUTOT(1),9)_$J(PSUTOT(2),9)_$J(PSUTOT(3),9)_$J(PSUTOT(4),13,2)
83 S ^XTMP(PSUOPSUB,"DRUGSUM",PSUDIV,PSULN)=PSULINE
84 S PSULN=PSULN+1
85 S ^XTMP(PSUOPSUB,"DRUGSUM",PSUDIV,PSULN)=" "
86 S PSULN=PSULN+1
87 S ^XTMP(PSUOPSUB,"DRUGSUM",PSUDIV,PSULN)="* Non-Formulary"
88 S PSULN=PSULN+1
89 S ^XTMP(PSUOPSUB,"DRUGSUM",PSUDIV,PSULN)="# Not on National Formulary"
90 S PSULN=PSULN+1
91 S ^XTMP(PSUOPSUB,"DRUGSUM",PSUDIV,PSULN)=" "
92 S PSULN=PSULN+1
93 S ^XTMP(PSUOPSUB,"DRUGSUM",PSUDIV,PSULN)=$J("Consolidated Mail Out Pharmacy (CMOP)",66)
94 S PSULN=PSULN+1
95 S ^XTMP(PSUOPSUB,"DRUGSUM",PSUDIV,PSULN)=" "
96 S PSULN=PSULN+1
97 S ^XTMP(PSUOPSUB,"DRUGSUM",PSUDIV,PSULN)=PSUHDR1
98 S PSULN=PSULN+1
99 S ^XTMP(PSUOPSUB,"DRUGSUM",PSUDIV,PSULN)=PSUHDR3
100 S PSULN=PSULN+1
101 S ^XTMP(PSUOPSUB,"DRUGSUM",PSUDIV,PSULN)=$E(PSUDASH,1,96)
102 S PSUDN=""
103 F I=1:1:4 S PSUTOT(I)=0
104 F S PSUDN=$O(^XTMP(PSUOPSUB,"DRUG",PSUDIV,PSUDN)) Q:PSUDN="" D
105 .S PSUR=$G(^XTMP(PSUOPSUB,"DRUG",PSUDIV,PSUDN,"Y"))
106 .Q:PSUR=""
107 .F I=1:1:7 S PSUF(I)=$P(PSUR,U,I) S:I<5 PSUTOT(I)=PSUTOT(I)+PSUF(I)
108 .S PSULINE=$E(PSUDN_" "_PSUF(6)_PSUF(7)_PSUFILL,1,43)_$J("",9)
109 .S PSULINE=PSULINE_$J(PSUF(2),9)_$J(PSUF(3),9)_$J(PSUF(4),13,2)_$J(PSUF(5),13,2)
110 .S PSULN=PSULN+1
111 .S ^XTMP(PSUOPSUB,"DRUGSUM",PSUDIV,PSULN)=PSULINE
112 S PSULN=PSULN+1
113 S ^XTMP(PSUOPSUB,"DRUGSUM",PSUDIV,PSULN)=$E(PSUDASH,1,96)
114 S PSULN=PSULN+1
115 S PSULINE=$E("Totals:"_PSUFILL,1,43)_$J("",9)_$J(PSUTOT(2),9)_$J(PSUTOT(3),9)_$J(PSUTOT(4),13,2)
116 S ^XTMP(PSUOPSUB,"DRUGSUM",PSUDIV,PSULN)=PSULINE
117 S PSULN=PSULN+1
118 S ^XTMP(PSUOPSUB,"DRUGSUM",PSUDIV,PSULN)=" "
119 S PSULN=PSULN+1
120 S ^XTMP(PSUOPSUB,"DRUGSUM",PSUDIV,PSULN)="* Non-Formulary"
121 S PSULN=PSULN+1
122 S ^XTMP(PSUOPSUB,"DRUGSUM",PSUDIV,PSULN)="# Not on National Formulary"
123 S XMSUB="V. 4.0 PBMOP "_PSUMON_" "_PSUDIV_" "_PSUDIVNM
124 S XMTEXT="^XTMP(PSUOPSUB,""DRUGSUM"",PSUDIV,"
125 S XMCHAN=1
126 M XMY=PSUXMYS2
127 D ^XMD
128 Q
Note: See TracBrowser for help on using the repository browser.