source: FOIAVistA/tag/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUCSR1.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 5.0 KB
Line 
1PSUCSR1 ;BIR/DJM - Drug breakdown ;25 AUG 1998
2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
3 ; DBIA(s)
4 ; Reference to file #40.8 supported by DBIA 2438
5 ;
6EN ;EP -- DRUG BREAKDOWN REPORT
7 ;
8 S RC="^XTMP(PSUCSJB,""RECORDS"",PSUDIV,PSUTIEN,PSURC)"
9 I $G(@RC@(0))'=2 Q
10 S PSUGNM=$G(@RC@(9))
11 S PSUBU=$G(@RC@(14))
12 S PSUBU=$S(PSUBU="":"N/A",1:PSUBU)
13 S PSUPSZ=$G(@RC@(15))
14 S PSUPSZ=$S(PSUPSZ="":"N/A",1:PSUPSZ)
15 S PSUNFI=$G(@RC@(10))
16 S PSUVFI=$G(@RC@(11))
17 S PSUCST=$G(@RC@(16))
18 S PSUQTY=$G(@RC@(17))
19 S PSUCST=PSUCST*PSUQTY
20 S PSUTCST=$G(PSUTCST)+PSUCST
21 ; pull previous counters
22 ; PSUGNM-drug name; PSUBU-break down unit/dispense unit
23 ; PSUPSZ-package size
24 S PSUX=$G(^XTMP(PSUCSJB,"CSFR-37",PSUDIV,PSUGNM,PSUBU,PSUPSZ))
25 S PSUOQTY=$P(PSUX,U,3)
26 S PSUOCST=$P(PSUX,U,4)
27 S PSUOCNT=$P(PSUX,U,5)
28 ; update/store counters
29 S PSUTCST=PSUOCST+PSUCST
30 S PSUTQTY=PSUOQTY+PSUQTY
31 S PSUTCNT=PSUOCNT+1
32 S PSUX=PSUNFI_U_PSUVFI_U_PSUTQTY_U_PSUTCST_U_PSUTCNT
33 S ^XTMP(PSUCSJB,"CSFR-37",PSUDIV,PSUGNM,PSUBU,PSUPSZ)=PSUX
34 Q
35 ;
36 ;
37GENREP(PSUMSG) ;EP - Generate the report based on the collected information
38 ;
39 S PSUPGS("PG")=1
40 D PGHDR1
41 S PSUL=3
42 F S PSUL=$O(^XTMP("PSU_"_PSUJOB,"CSAMIS",PSUL)) Q:PSUL="" D
43 .I LNCNT+4>IOSL D PGHDR1
44 .W !,^XTMP("PSU_"_PSUJOB,"CSAMIS",PSUL)
45 .S LNCNT=LNCNT+1
46 Q
47COMBO(PSUMSG) ;EP - Generate the report based on the collected information
48 ;
49 S PSUPGS("PG")=1
50 D PGHDR2
51 S PSUL=3
52 F S PSUL=$O(^XTMP("PSU_"_PSUJOB,"COMBOAMIS",PSUL)) Q:PSUL="" D
53 .I LNCNT+4>IOSL D PGHDR2
54 .W !,^XTMP("PSU_"_PSUJOB,"COMBOAMIS",PSUL)
55 .S LNCNT=LNCNT+1
56 Q
57 ;
58PGHDR1 ;AMIS PAGE HEADER
59 U IO
60 W @IOF
61 W !,^XTMP("PSU_"_PSUJOB,"CSAMIS",1)
62 W !!,?68,"Page: ",PSUPGS("PG")
63 W !,$G(^XTMP("PSU_"_PSUJOB,"IVAMIS",2))
64 S LNCNT=3
65 Q
66 ;
67PGHDR2 ;COMBO AMIS PAGE HEADER
68 U IO
69 W @IOF
70 W !,^XTMP("PSU_"_PSUJOB,"COMBOAMIS",1)
71 W !!,?68,"Page: ",PSUPGS("PG")
72 W !,$G(^XTMP("PSU_"_PSUJOB,"COMBOAMIS",2))
73 S LNCNT=3
74 Q
75 ;
76PG ;EP Page controller
77 S PSUQUIT=0
78 I $Y<(IOSL-4) Q
79 S:'$D(PSUPG("PG")) PSUPG("PG")=0
80 S PSUPG("PG")=PSUPG("PG")+1
81 I $E(IOST)="C" K DIR S DIR(0)="E" D ^DIR
82 I $G(DIROUT)!$G(DUOUT)!$G(DTOUT)!$G(DIRUT) S PSUQUIT=1
83 U IO W @IOF
84 Q:$G(PSUQUIT)
85 ;
86PGHDR ;EP write header & page number
87 F I=1,2 W !,^XTMP(PSUCSJB,"MAIL",PSUMC,I)
88 W !,?60,"PAGE: ",PSUPG("PG")
89 F I=4,5,6 I $D(^XTMP(PSUCSJB,"MAIL",PSUMC,I)) W !,^(I)
90 Q
91 ;
92SUMMRY(PSUMSG,PSUMFL) ; Mail the drug summary report (by division)
93 K PSUTCSO,PSUTCST
94 S X=PSUDIV,DIC=40.8,DIC(0)="X",D="C" D IX^DIC ;**1
95 S X=+Y S PSUDIVNM=$$VAL^PSUTL(40.8,X,.01)
96 S PSUMFL=$G(PSUMFL,1)
97 S PSUOMC=PSUMC,PSUMLC=0
98 S PSUMC=PSUMC+1,PSULC=0,PSUTLC=0
99 S PSUDRG="",PSUQDTL=0,PSUTCSO=0,PSUTCST=0
100 S PSUDSHL=$$PAD("","-",76)
101 S PSULC=PSULC+1
102 S ML="^XTMP(PSUCSJB,""MAIL"",PSUMC)"
103 S @ML@(1)=$$CTR("Controlled Substance Statistical Data"," ",75)
104 S @ML@(2)=" "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
105 S @ML@(3)=" "
106 S X=$$PAD(" "," ",45)_$$CTR("Breakdown"," ",10)_$$CTR("Package"," ",10)_"Quantity"
107 S @ML@(4)=X
108 S X=$$PAD("Drug Name"," ",45)_$$PAD("Unit"," ",10)_$$CTR("Size"," ",10)_"Dispensed"
109 S @ML@(5)=X
110 S @ML@(6)=PSUDSHL,PSULC=6
111 ;
112 F S PSUDRG=$O(^XTMP(PSUCSJB,"CSFR-37",PSUDIV,PSUDRG)) Q:PSUDRG="" D
113 . S PSUBU=""
114 . F S PSUBU=$O(^XTMP(PSUCSJB,"CSFR-37",PSUDIV,PSUDRG,PSUBU)) Q:PSUBU="" D
115 .. S PSUSZ=""
116 .. F S PSUSZ=$O(^XTMP(PSUCSJB,"CSFR-37",PSUDIV,PSUDRG,PSUBU,PSUSZ)) Q:PSUSZ="" D
117 ... S X=$G(^XTMP(PSUCSJB,"CSFR-37",PSUDIV,PSUDRG,PSUBU,PSUSZ),"^^0")
118 ... S PSUNFI=$P(X,U,1)
119 ... S PSUVFI=$P(X,U,2)
120 ... S PSUQTY=$P(X,U,3)
121 ... S PSUCST=$P(X,U,4)
122 ... S PSUTCST=PSUTCST+PSUCST
123 ... S PSUCNT=$P(X,U,5),PSUTCSO=PSUTCSO+PSUCNT
124 ... S X=PSUDRG_" "_$S(PSUVFI=0:"#",1:"")_$S(PSUNFI'="":"*",1:"")
125 ... S X=$$PAD(X," ",45)
126 ... S X=X_$$PAD(PSUBU," ",10)
127 ... S X=X_$$PAD($J(PSUSZ,7)," ",12)
128 ... S X=X_$$PAD($J(PSUQTY,7)," ",10)
129 ... S PSUQDTL=PSUQDTL+PSUQTY ; Sum up the total quantity dispensed
130 ... S PSULC=PSULC+1,PSUTLC=PSUTLC+1
131 ... S @ML@(PSULC)=X
132 S ^XTMP(PSUCSJB,"REPORT",PSUMC)="" ; trigger print report
133 S ^XTMP(PSUCSJB,"SUMMARY 2",PSUMC)="" ;trigger mail & XMY group
134 I $G(PSUTCSO)=0 D ; No mail summary to send
135 . K ^XTMP(PSUCSJB,"MAIL",PSUMC)
136 . S ^XTMP(PSUCSJB,"MAIL",PSUMC)=PSUDIV
137 . S ^XTMP(PSUCSJB,"REPORT",PSUMC)=""
138 . S @ML@(1)=$$CTR("Controlled Substance Statistical Data"," ",75)
139 . S @ML@(2)=" "_PSUDTS_" through "_PSUDTE_" for "_PSUDIVNM
140 . S @ML@(3)=" "
141 . S @ML@(4)="No data to report"
142 . S @ML@(5)=" "
143 I $G(PSUSMRY,0) D
144 . K ^XTMP(PSUCSJB,"MAIL",PSUMC),^XTMP(PSUCSJB,"REPORT",PSUMC)
145 I '$G(PSUSMRY,0),PSUTLC D
146 . S PSUTLC=PSUTLC+6 ; Adjust for the header
147 . ; Set total line
148 . S ^XTMP(PSUCSJB,"MAIL",PSUMC)=PSUDIV
149 . S PSULC=PSULC+1,PSUTLC=PSUTLC+1
150 . S @ML@(PSULC)=PSUDSHL ; dashes line
151 . S PSULC=PSULC+1,PSUTLC=PSUTLC+1
152 . S @ML@(PSULC)=$$PAD("Totals:"," ",64)_$J(PSUQDTL,10)
153 . S PSULC=PSULC+1
154 . S @ML@(PSULC)=" "
155 . S PSULC=PSULC+1
156 . S @ML@(PSULC)=" * Non-Formulary"
157 . S PSULC=PSULC+1
158 . S @ML@(PSULC)=" # Not on National Formulary"
159 ;
160 Q
161 ;
162EXIT1 S PSUMLC=0
163 Q
164PAD(S,P,L) ; Pad string S with P to length L
165 S $P(P,P,L)=""
166 Q $E(S_P,1,L)
167CTR(S,P,L) ; Center string S left and right P in size L
168 Q $$PAD($$PAD(P,P,L-$L(S)\2)_S,P,L)
Note: See TracBrowser for help on using the repository browser.