source: FOIAVistA/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUOP7.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1PSUOP7 ;BIR/DAM - Outpatient AMIS Summary Data;04 MAR 2004
2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
3 ;
4 ;No DBIA's required
5 ;
6DATA ;Gather AMIS summary data from the detailed "DATA" global
7 ;Called from PSUOP4
8 ;
9 N QTY,PRICE,QUANT
10 ;
11 S QTY=$P(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,1),U,25)
12 ;
13 ;
14 ;Find sum of 30-day fills for each division
15 I QTY'>30 D
16 .S ^TMP($J,"FILL",PSUDV,30)=$G(^TMP($J,"FILL",PSUDV,30))+1
17 I '$G(^TMP($J,"FILL",PSUDV,30)) S ^TMP($J,"FILL",PSUDV,30)=0
18 ;
19 ;
20 ;Find sum of 60-day fills for each division
21 I (QTY>30)&(QTY'>60) D
22 .S ^TMP($J,"FILL",PSUDV,60)=$G(^TMP($J,"FILL",PSUDV,60))+1
23 I '$G(^TMP($J,"FILL",PSUDV,60)) S ^TMP($J,"FILL",PSUDV,60)=0
24 ;
25 ;
26 ;Find sum of 90-day fills for each division
27 I QTY>60 D
28 .S ^TMP($J,"FILL",PSUDV,90)=$G(^TMP($J,"FILL",PSUDV,90))+1
29 I '$G(^TMP($J,"FILL",PSUDV,90)) S ^TMP($J,"FILL",PSUDV,90)=0
30 ;
31 ;
32 N FILL30,FILL60,FILL90
33 S FILL30=^TMP($J,"FILL",PSUDV,30)
34 S FILL60=^TMP($J,"FILL",PSUDV,60)
35 S FILL90=^TMP($J,"FILL",PSUDV,90)
36 ;
37 ;Calculate Unadjusted Total Fills
38 S ^TMP($J,"UNAD",PSUDV)=FILL30+FILL60+FILL90
39 ;
40 ;
41 ;Calculate 30-day Equivalent Fills
42 S ^TMP($J,"EQUIV",PSUDV)=FILL30+(2*FILL60)+(3*FILL90)
43 ;
44 ;
45 ;Calculate total cost for all fills
46 ;S PRICE=$P(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,2),U,5)
47 S PRICE=$P(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,1),U,24)
48 S QUANT=$P(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,1),U,26)
49 S PSUCOST=PRICE*QUANT
50 S ^TMP($J,"COST",PSUDV,PSURXIEN)=$G(^TMP($J,"COST",PSUDV,PSURXIEN))+PSUCOST
51 ;
52 ;
53 ;Find number of "new", "refill", and "partial" prescriptions
54 S PSUTYPE=$P(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,1),U,16)
55 ;
56 I PSUTYPE="N" D
57 .S ^TMP($J,"NEW",PSUDV)=$G(^TMP($J,"NEW",PSUDV))+1 ;New fills
58 I '$G(^TMP($J,"NEW",PSUDV)) S ^TMP($J,"NEW",PSUDV)=0
59 ;
60 ;
61 I PSUTYPE'="N" D
62 .S ^TMP($J,"REF",PSUDV)=$G(^TMP($J,"REF",PSUDV))+1 ;Refills + partial
63 I '$G(^TMP($J,"REF",PSUDV)) S ^TMP($J,"REF",PSUDV)=0
64 ;
65 ;Find total number of "Window CS" and "Mail CS" prescription fills
66 ;
67 S PSUWIN=$P(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,1),U,18)
68 S PSUCMP=$P(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,1),U,17)
69 S PSUCS=$P(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,1),U,15)
70 ;
71 ;
72 I PSUWIN="W" S ^TMP($J,"WIN",PSUDV)=$G(^TMP($J,"WIN",PSUDV))+1 D
73 .I PSUCMP="N" D
74 ..I (PSUCS[2)!(PSUCS[3)!(PSUCS[4)!(PSUCS[5) D
75 ...S ^TMP($J,"WINCS",PSUDV)=$G(^TMP($J,"WINCS",PSUDV))+1 ;WIN CS fills
76 I '$G(^TMP($J,"WIN",PSUDV)) S ^TMP($J,"WIN",PSUDV)=0
77 I '$G(^TMP($J,"WINCS",PSUDV)) S ^TMP($J,"WINCS",PSUDV)=0
78 ;
79 ;
80 I PSUWIN="M" S ^TMP($J,"MAIL",PSUDV)=$G(^TMP($J,"MAIL",PSUDV))+1 D
81 .I PSUCMP="N" D
82 ..I (PSUCS[2)!(PSUCS[3)!(PSUCS[4)!(PSUCS[5) D
83 ...S ^TMP($J,"MAILCS",PSUDV)=$G(^TMP($J,"MAILCS",PSUDV))+1 ;Mail CS
84 I '$G(^TMP($J,"MAIL",PSUDV)) S ^TMP($J,"MAIL",PSUDV)=0
85 I '$G(^TMP($J,"MAILCS",PSUDV)) S ^TMP($J,"MAILCS",PSUDV)=0
86 ;
87 ;
88 I PSUCMP="Y" D
89 .S ^TMP($J,"CMOP",PSUDV)=$G(^TMP($J,"CMOP",PSUDV))+1 ;CMOP fills
90 I '$G(^TMP($J,"CMOP",PSUDV)) S ^TMP($J,"CMOP",PSUDV)=0
91 ;
92 ;
93 I PSUCMP="N" S ^TMP($J,"LOC",PSUDV)=$G(^TMP($J,"LOC",PSUDV))+1 D
94 .I (PSUCS[2)!(PSUCS[3)!(PSUCS[4)!(PSUCS[5) D
95 ..S ^TMP($J,"LOCS",PSUDV)=$G(^TMP($J,"LOCS",PSUDV))+1 ;Local CS fills
96 I '$G(^TMP($J,"LOC",PSUDV)) S ^TMP($J,"LOC",PSUDV)=0
97 I '$G(^TMP($J,"LOCS",PSUDV)) S ^TMP($J,"LOCS",PSUDV)=0
98 ;
99 S PSUSTF=$P(^XTMP(PSUOPSUB,"DATA",PSUDV,PSURXIEN,PSURCT,1),U,20)
100 ;
101 I PSUSTF="S" D
102 .S ^TMP($J,"STAFF",PSUDV)=$G(^TMP($J,"STAFF",PSUDV))+1 ;Staff fills
103 I '$G(^TMP($J,"STAFF",PSUDV)) S ^TMP($J,"STAFF",PSUDV)=0
104 ;
105 ;
106 I PSUSTF="F" D
107 .S ^TMP($J,"FEE",PSUDV)=$G(^TMP($J,"FEE",PSUDV))+1 ;Fee fills
108 I '$G(^TMP($J,"FEE",PSUDV)) S ^TMP($J,"FEE",PSUDV)=0
109 Q
Note: See TracBrowser for help on using the repository browser.