source: FOIAVistA/trunk/r/PHARMACY_BENEFITS_MANAGEMENT-PSU/PSUV1.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: 8.7 KB
Line 
1PSUV1 ;BIR/CFL - Extract Data of PBM IV Module ;25 AUG 1998
2 ;;4.0;PHARMACY BENEFITS MANAGEMENT;;MARCH, 2005
3 ;DBIAs
4 ; Reference to file #55 supported by DBIA 2497
5 ; Reference to file #59.5 supported by DBIA 2499
6 ; Reference to file #40.8 supported by DBIA 2438
7 ; Reference to file #7 supported by DBIA 2495
8 ; Reference to file #49 supported by DBIA 10093
9 ; Reference to file #52.6 supported by DBIA 436
10 ; Reference to file #50 supported by DBIA 221
11 ; Reference to file #52.7 supported by DBIA 437
12 ; Reference to file #2 supported by DBIA 10035 and 2701
13 ; Reference to file #200 supported by DBIA 10060
14 ;
15IVDATA ;Loop through IV data
16 N PSUDOC1
17 K PSUSSNA,PSUORDA
18 ; *34 |==>
19 S PSUIVDT=PSUSDT\1-.0001 ;use 1st day of extract for 'stop date' scan
20 S PSUTEDT=PSUEDT\1+.2359
21 F S PSUIVDT=$O(^PS(55,"AIV",PSUIVDT)) Q:'PSUIVDT D
22 .S PSUPDA=""
23 .F S PSUPDA=$O(^PS(55,"AIV",PSUIVDT,PSUPDA)) Q:'PSUPDA D
24 ..S PSUODA=""
25 ..F S PSUODA=$O(^PS(55,"AIV",PSUIVDT,PSUPDA,PSUODA)) Q:'PSUODA D
26 ...S ^XTMP("PSU_"_PSUJOB,"PSUHLD",PSUODA)="" ;should be the D0's for file 55.01 ; <==| *34
27 ...S COUNT=0
28 ...S PSUDIV=""
29 ...K PSUIV
30 ...; screen test patients
31 ...Q:$$TESTPAT^PSUTL1(PSUPDA)
32 ...S XX=$$VALI^PSUTL(55.01,"PSUPDA,PSUODA",.02) Q:XX>PSUTEDT ;*34
33 ...K PSUIV ;*34
34 ...D GETS^PSUTL(55.01,"PSUPDA,PSUODA",".01;.02;.03;.04;.06;.08;.09;.22;104;106;108","PSUIV","I")
35 ...;.01-Order num;.02-Start Dt;.03-Stop Dt;.04-Type;.06-Provider
36 ...;104-Ward;106-Chemotherapy Type;108-Intermittent Syringe
37 ...Q:'$D(PSUIV)
38 ...;VMP OIFO BAY PINES;ELR;PSU*3*35 ADDED NEXT LINE
39 ...Q:$G(PSUIV(.06,"I"))'>0
40 ...S ^XTMP("PSU_"_PSUJOB,"PSUPIEN",PSUPDA)="" ;Patient IEN's ;*34
41 ...D MOVEI^PSUTL("PSUIV")
42 ...S PSUIV(.02)=PSUIV(.02)\1
43 ...S PSUIV(.03)=PSUIV(.03)\1
44 ...I PSUIV(.22)'="" S PSUDIV=$$VALI^PSUTL(59.5,PSUIV(.22),.02)
45 ...S PSUFAC=$$VALI^PSUTL(40.8,PSUDIV,1) S:PSUFAC="" PSUFAC=PSUSNDR
46 ...S PSUFAC(PSUFAC)=""
47 ...S PSUOUTP=$S(PSUIV(104)=.5:"Y",1:"N")
48 ...S DFN=PSUPDA D PID^VADPT
49 ...S PSUSSN=$TR(VA("PID"),"^-","")
50 ...D ICN
51 ...K PSUDOC
52 ...D GETS^PSUTL(200,"PSUIV(.06)","9;29;53.5","PSUDOC","I")
53 ...D MOVEI^PSUTL("PSUDOC")
54 ...I $G(PSUDOC(9))="" S PSUVSSN1=999999999
55 ...I $G(PSUDOC(9))'="" S PSUVSSN1=PSUDOC(9)
56 ...S ^XTMP("PSU_"_PSUJOB,"PSUPDR",PSUVSSN1,PSUIV(.06))=""
57 ...S (PSUPCLS,PSUSP1,PSUSP2)=""
58 ...I $D(PSUDOC(53.5)),PSUDOC(53.5)'="" D
59 ....S PSUPCLS=$$VALI^PSUTL(7,PSUDOC(53.5),1)
60 ....I PSUPCLS="" S PSUPCLS=$$VALI^PSUTL(7,PSUDOC(53.5),.01)
61 ...S PSUPSV=$S($L($G(PSUDOC(29))):$$VAL^PSUTL(49,PSUDOC(29),.01),1:"")
62 ...S PSUPSV=$$UPPER^PSUTL(PSUPSV),PSUSERV=""
63 ...I $L(PSUPSV),$D(PSECT(PSUPSV)) S PSUSERV=PSECT(PSUPSV)
64 ...S SPECPTR=$$GET^XUA4A72(PSUIV(.06),PSUIVDT)
65 ...S PSUSP1=$P($G(SPECPTR),U,3),PSUSP2=$P($G(SPECPTR),U,4)
66 ...D OCCAMT
67 ...I PSUFND D
68 ....D GETRATE^PSUV2(PSUIV(.04))
69 ....D SETTOT
70 ....S RECTYP=""
71 ....D ADDTIV
72 ....D SOLUTN
73 I $D(^XTMP(PSUIVSUB,"RECORDS")) D SETSUM^PSUV2
74 Q
75 ;
76ICN ;Find patient ICN
77 ;
78 N PSUPICN,PSUPICN1,PSUICN
79 S PSUPTN=0
80 I $G(PSUSSN),PSUSSN'="" D
81 .F S PSUPTN=$O(^DPT("SSN",PSUSSN,PSUPTN)) Q:PSUPTN="" D
82 ..S PSUPICN1=$$GETICN^MPIF001(PSUPTN) D
83 ...I PSUPICN1'[-1 D
84 ....S ^XTMP("PSU_"_PSUJOB,"PSUPICN")=PSUPICN1
85 ...I PSUPICN1[-1 S ^XTMP("PSU_"_PSUJOB,"PSUPICN")=""
86 Q
87 ;
88 ;
89OCCAMT ;Calculate the number of dispensing occurrences
90 S (PSUFND,PSUDISP,PSUPULL,OCC,PSUDISPT,PSURECT,PSUDEST,PSUCAN)=0
91 F S OCC=$O(^PS(55,PSUPDA,"IV",PSUODA,"LAB",OCC)) Q:'OCC D
92 .K PSUOCC
93 .D GETS^PSUTL(55.1111,"PSUPDA,PSUODA,OCC","1;2;4;6","PSUOCC","I")
94 .D MOVEI^PSUTL("PSUOCC")
95 .S PSUOCC(1)=PSUOCC(1)\1
96 .I PSUOCC(1)<PSUSDT!(PSUOCC(1)>PSUTEDT) Q ;*34
97 .S PSUFND=1
98 .I $G(PSUOCC(6))=1,$G(PSUOCC(2))=1 D
99 ..S PSUDISP=PSUDISP+$G(PSUOCC(4))
100 ..S PSUDISPT=PSUDISP ;Total IV dispensed
101 ..S PSUPULL=PSUPULL+$G(PSUOCC(4))
102 ..S ^XTMP(PSUIVSUB,"TYPE_"_PSUIV(.04),PSUFAC)=PSUOCC(4)+$G(^XTMP(PSUIVSUB,"TYPE_"_PSUIV(.04),PSUFAC))
103 ..I PSUOUTP="Y" D ; Total outpatient IV's dispensed
104 ...S ^XTMP(PSUIVSUB,"ODISP",PSUFAC)=$G(^XTMP(PSUIVSUB,"ODISP",PSUFAC))+PSUOCC(4)
105 .;I PSUOCC(2)=2!(PSUOCC(2)=4) S PSUDISP=PSUDISP-PSUOCC(4)
106 .I PSUOCC(6)=1,PSUOCC(2)=2 D
107 ..S PSURECT=$G(PSURECT)+PSUOCC(4) ;Total IV Recycled
108 .I PSUOCC(6)=1,PSUOCC(2)=3 D
109 ..S PSUDEST=$G(PSUDEST)+PSUOCC(4) ;Total IV Destroyed
110 .I PSUOCC(6)=1,PSUOCC(2)=4 D
111 ..S PSUCAN=$G(PSUCAN)+PSUOCC(4) ;Total IV Cancelled
112 .I PSUOCC(6)=1 D
113 ..I (PSUOCC(2)=2)!(PSUOCC(2)=4) S PSUDISP=PSUDISP-PSUOCC(4) ;Net disp
114 Q
115SETTOT ;Set totals
116 ; Total number of IV's ordered
117 S ^XTMP(PSUIVSUB,"ORD",PSUFAC)=$G(^XTMP(PSUIVSUB,"ORD",PSUFAC))+1
118 ; Total number of IV patients
119 I '$D(^XTMP(PSUIVSUB,"PAT",PSUSSN,PSUFAC)) D
120 .S ^XTMP(PSUIVSUB,"SSN",PSUFAC)=$G(^XTMP(PSUIVSUB,"SSN",PSUFAC))+1
121 .S ^XTMP(PSUIVSUB,"PAT",PSUSSN,PSUFAC)=""
122 .S PSUDIV=PSUFAC D GETDIV^PSUV3 I PSUDIVNM'="" D
123 ..S ^XTMP("PSU_"_PSUJOB,"PSUDIV",PSUDIVNM,PSUSSN)="" ;Pt demo summary
124 .I PSUDIVNM="" S ^XTMP("PSU_"_PSUJOB,"PSUDIV",PSUDIV,PSUSSN)=""
125 I PSUOUTP="Y" D
126 .; Total outpatient IV's ordered
127 .S ^XTMP(PSUIVSUB,"OORD",PSUFAC)=$G(^XTMP(PSUIVSUB,"OORD",PSUFAC))+1
128 Q
129ADDTIV ;Loop through each additive
130 S (PSUNITS,ADTIV)=0
131 F S ADTIV=$O(^PS(55,PSUPDA,"IV",PSUODA,"AD",ADTIV)) Q:'ADTIV D
132 .K PSUADDTV,PSUGNRIC,PSUADD
133 .D GETS^PSUTL(55.02,"PSUPDA,PSUODA,ADTIV",".01;.02","PSUADDTV","I")
134 .D MOVEI^PSUTL("PSUADDTV")
135 .D GETS^PSUTL(52.6,"PSUADDTV(.01)",".01;1;7","PSUGNRIC","I")
136 .D MOVEI^PSUTL("PSUGNRIC")
137 .S PSUPNAM=PSUGNRIC(.01)
138 .S PSUDGU=$$VAL^PSUTL(52.6,PSUADDTV(.01),2)
139 .S PSUDGDA=PSUGNRIC(1)
140 .D GETS^PSUTL(50,"PSUDGDA",".01;2;20;21;22;25;31;51;52;3","PSUADD","I")
141 .D MOVEI^PSUTL("PSUADD")
142 .S PSUGNM=PSUADD(.01)
143 .S PSUDCLS=PSUADD(2)
144 .S PSUPRNM=PSUADD(21)
145 .S PSUNDC=PSUADD(31)
146 .S PSUNFI=PSUADD(51)
147 .S PSUNADR=PSUADD(20)
148 .S PSUNDCL=PSUADD(22)
149 .S PSUDEA=PSUADD(3)
150 .S PSUNAF=$S(PSUADD(52):"N/F",1:"")
151 .D SETVAR
152 .S PSUSTRN=+PSUADDTV(.02)
153 .;
154 .;DAM Add AMIS Additive data
155 .N PSUTDSP1
156 .S PSUTDSP1=$G(PSUDISPT)*PSUSTRN ;Total Additive units dispens
157 .;
158 .N PSURCY1
159 .S PSURCY1=$G(PSURECT)*PSUSTRN ;Total Additive units recycled
160 .;
161 .N PSUDES1
162 .S PSUDES1=$G(PSUDEST)*PSUSTRN ;Total Additive units destroyed
163 .;
164 .N PSUCAN1
165 .S PSUCAN1=$G(PSUCAN)*PSUSTRN ;Total Additive units cancelled
166 .;END DAM
167 .S PSUNITS=PSUDISP*PSUSTRN
168 .S PSUBAGS=PSUPULL*PSUSTRN
169 .S PSUDCST=PSUGNRIC(7)
170 .S RECIND="A"
171 .D CALC
172 .D SETREC^PSUV2
173 .D SETDRUG^PSUV2
174 Q
175SOLUTN ;Loop through each solution
176 S (PSUNITS,SOLDA)=0 F S SOLDA=$O(^PS(55,PSUPDA,"IV",PSUODA,"SOL",SOLDA)) Q:'SOLDA D
177 .K PSUSOL,GENRIC,SOLDRUG
178 .D GETS^PSUTL(55.11,"PSUPDA,PSUODA,SOLDA",".01;1","PSUSOL","I")
179 .D MOVEI^PSUTL("PSUSOL")
180 .D GETS^PSUTL(52.7,"PSUSOL(.01)",".01;1;7","GENRIC","I")
181 .D MOVEI^PSUTL("GENRIC")
182 .S PSUPNAM=GENRIC(.01)
183 .S PSUDGU="ML"
184 .S PSUDGDA=GENRIC(1)
185 .D GETS^PSUTL(50,"PSUDGDA",".01;2;20;21;22;25;31;51;52;3","SOLDRUG","I")
186 .D MOVEI^PSUTL("SOLDRUG")
187 .S PSUGNM=SOLDRUG(.01)
188 .S PSUDCLS=SOLDRUG(2)
189 .S PSUPRNM=SOLDRUG(21)
190 .S PSUNDC=SOLDRUG(31)
191 .S PSUNFI=SOLDRUG(51)
192 .S PSUNADR=SOLDRUG(20)
193 .S PSUNDCL=SOLDRUG(22)
194 .S PSUDEA=SOLDRUG(3)
195 .S PSUNAF=$S(SOLDRUG(52):"N/F",1:"")
196 .D SETVAR
197 .S VOLUME=+PSUSOL(1)
198 .;
199 .;DAM ADD AMIS SOLUTION DATA
200 .N PSUTSOL1
201 .S PSUTSOL1=$G(PSUDISPT)*VOLUME ;Total Solution units dispense
202 .;
203 .N PSUTRS1
204 .S PSUTRS1=$G(PSURECT)*VOLUME ;Total Solution units recycl
205 .;
206 .N PSUTDS1
207 .S PSUTDS1=$G(PSUDEST)*VOLUME ;Total Solution units destroyed
208 .;
209 .N PSUTCS1
210 .S PSUTCS1=$G(PSUCAN)*VOLUME ;Total Solution units cancelled
211 .;END DAM
212 .S PSUNITS=PSUDISP*VOLUME
213 .S PSUBAGS=PSUPULL*VOLUME
214 .S PSUDCST=GENRIC(7)
215 .S RECIND="S"
216 .D CALC
217 .D SETREC^PSUV2
218 .D SETDRUG^PSUV2
219 Q
220SETVAR ;Setup common variables for IV Additives and Solutions
221 I PSUGNM="" S PSUGNM="UNKNOWN GENERIC NAME"
222 I PSUPRNM="" S PSUPRNM="UNKNOWN VA PRODUCT NAME"
223 I PSUNDC="" S PSUNDC="No NDC"
224 I PSUNFI=1 S PSUNFI="N/F"
225 S (PSIVNFI,PSIVNFR)=""
226 I $$VERSION^XPDUTL("PSN")'<4 D
227 .S PSIVNFI=$$FORMI^PSNAPIS(PSUNADR,PSUNDCL)
228 .S PSIVNFR=$$FORMR^PSNAPIS(PSUNADR,PSUNDCL)>0
229 Q
230CALC ;Do calculations for additives and solutions
231 S ^XTMP(PSUIVSUB,"CST",PSUFAC)=(PSUNITS*PSUDCST)+$G(^XTMP(PSUIVSUB,"CST",PSUFAC))
232 S RECTYP=""
233 S COUNT=COUNT+1
234 S:COUNT=1 RECTYP="P"
235 I PSUOUTP="Y" D
236 .S ^XTMP(PSUIVSUB,"OCST",PSUFAC)=(PSUDCST*PSUBAGS)+$G(^XTMP(PSUIVSUB,"OCST",PSUFAC))
237 I PSUIV(.04)="P" D
238 .S ^XTMP(PSUIVSUB,"SPIG",PSUFAC)=(PSUDCST*PSUBAGS)+$G(^XTMP(PSUIVSUB,"SPIG",PSUFAC))
239 I PSUIV(.04)="A" D
240 .S ^XTMP(PSUIVSUB,"SADM",PSUFAC)=(PSUDCST*PSUBAGS)+$G(^XTMP(PSUIVSUB,"SADM",PSUFAC))
241 I PSUIV(.04)="H" D
242 .S ^XTMP(PSUIVSUB,"SHYP",PSUFAC)=(PSUDCST*PSUBAGS)+$G(^XTMP(PSUIVSUB,"SHYP",PSUFAC))
243 I PSUIV(.04)="S" D
244 .S ^XTMP(PSUIVSUB,"SSYR",PSUFAC)=(PSUDCST*PSUBAGS)+$G(^XTMP(PSUIVSUB,"SSYR",PSUFAC))
245 I PSUIV(.04)="C" D
246 .S ^XTMP(PSUIVSUB,"SCHEM",PSUFAC)=(PSUDCST*PSUBAGS)+$G(^XTMP(PSUIVSUB,"SCHEM",PSUFAC))
247 Q
Note: See TracBrowser for help on using the repository browser.