source: FOIAVistA/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSRPT1.m@ 1803

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

initial load of FOIAVistA 6/30/08 version
File size: 8.8 KB
Line 
1BPSRPT1 ;BHAM ISC/BEE - ECME REPORTS ;14-FEB-05
2 ;;1.0;E CLAIMS MGMT ENGINE;**1,5**;JUN 2004;Build 45
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 Q
5 ;
6 ; ECME Report Compile Routine - Looping/Filtering Routine
7 ;
8 ; Input Variables:
9 ; BPRTYPE - Type of Report (1-7)
10 ; BPGLTMP - Temporary storage global
11 ; BPPHARM/BPPHARM(ptr) - Set to 0 for all pharmacies, if set to 1 array
12 ; of internal pointers of selected pharmacies
13 ; BPSUMDET - (1) Summary or (0) Detail format
14 ; BPINSINF - Set to 0 for all insurances or insurance co name
15 ; BPMWC - 1-ALL,2-Mail,3-Window,4-CMOP Prescriptions
16 ; BPRTBCK - 1-ALL,2-RealTime,3-Backbill Claim Submission
17 ; BPRLNRL - 1-ALL,2-RELEASED,3-NOT RELEASED
18 ; BPDRUG - DRUG to report on (ptr to #50)
19 ; BPDRGCL - DRUG CLASS to report on (0 for ALL)
20 ; BPBEGDT - Beginning Date
21 ; BPENDDT - Ending Date
22 ; BPCCRSN - Set to 0 for all closed claim reasons or ptr to #356.8
23 ; BPAUTREV - 0-ALL,1-Auto Reversed
24 ; BPACREJ - 0-ALL,1-REJECTED,2-ACCEPTED
25 ;
26COLLECT(BPGLTMP) N BP02,BP57,BP59,BPENDDT1,BPLDT02,BPLDT57,X,Y,OK,BPIX
27 ;
28 ;Check Variables
29 S OK=1
30 S:'$G(BPBEGDT) BPBEGDT=0
31 S:'$G(BPENDDT) BPENDDT=9999999
32 S BPENDDT=BPENDDT+0.9
33 I $G(BPRTYPE)=""!($G(BPGLTMP)="")!($G(BPPHARM)="")!($G(BPSUMDET)="")!($G(BPINSINF)="")!($G(BPMWC)="")!($G(BPRTBCK)="") S OK=-1 G EXIT
34 ;
35 ;Loop through BPS CLAIMS
36 ;
37 ;First look for fill/refill cross reference
38 ;Loop through Date of Service Index in BPS CLAIMS file and find link to
39 ;claim in BPS TRANSACTION. Process earliest Date of Service entry found in
40 ;BPS TRANSACTION
41 ;
42 ;Choose Index to Loop through (different for Closed Claims)
43 S BPIX="AF" S:BPRTYPE=7 BPIX="AG"
44 ;
45 S BPLDT02=$S(BPIX="AF":$$FM2YMD(BPBEGDT-0.00001),1:BPBEGDT) S:BPLDT02="" BPLDT02=0
46 S BPENDDT1=$S(BPIX="AF":$$FM2YMD(BPENDDT),1:BPENDDT_".9999999999") S:BPENDDT1="" BPENDDT1=99999999
47 F S BPLDT02=+$O(^BPSC(BPIX,BPLDT02)) Q:BPLDT02=0!(BPLDT02>BPENDDT1) D
48 . S BP02=0 F S BP02=$O(^BPSC(BPIX,BPLDT02,BP02)) Q:+BP02=0 D
49 . . S BP59=+$O(^BPST("AE",BP02,0))
50 . . Q:BP59=0
51 . . I $D(@BPGLTMP@("FILE59",BP59)) Q
52 . . S @BPGLTMP@("FILE59",BP59)=BPLDT02_"^02"
53 . . D PROCESS(BP59)
54 ;
55 ;#9002313.59 has only one entry per claim with, which has a date
56 ; of the latest update for the claim
57 ;#9002313.57 has more than one entries per claim and keep all
58 ; changes made the claim
59 ;so we have to go thru #9002313.57 to find the earliest date
60 ;related to the claim to check it against BPBEGDT
61 S BPLDT57=BPBEGDT-0.00001
62 F S BPLDT57=+$O(^BPSTL("AH",BPLDT57)) Q:BPLDT57=0!(BPLDT57>BPENDDT) D
63 . S BP57=0 F S BP57=$O(^BPSTL("AH",BPLDT57,BP57)) Q:+BP57=0 D
64 . . S BP59=+$G(^BPSTL(BP57,0))
65 . . I $D(@BPGLTMP@("FILE59",BP59)) Q
66 . . S @BPGLTMP@("FILE59",BP59)=BPLDT57_"^57"
67 . . D PROCESS(BP59)
68 ;
69 ;Remove Portion of Scratch Global
70EXIT K @BPGLTMP@("FILE59")
71 Q OK
72 ;
73 ;Convert FB date to YYYYMMDD
74FM2YMD(BPFMDT) N Y,Y1
75 S Y=$E(BPFMDT,2,3),Y1=$E(BPFMDT,1,1) S Y=$S(Y1=3:"20"_Y,Y1=2:"19"_Y,1:"")
76 Q:Y Y_$E(BPFMDT,4,7)
77 Q ""
78 ;
79 ;Process each Entry
80 ;
81PROCESS(BP59) N BPBCK,BPDFN,BPREF,BPPAYBL,BPPLAN,BPREJ,BPRLSDT,BPRX,BPRXDRG,BPSTATUS
82 ;
83 ;Get ABSBRXI - ptr to #52
84 S BPRX=+$P($G(^BPST(BP59,1)),U,11)
85 ;
86 ;Get ABSBRXR - Prescription Number IEN
87 S BPREF=+$P($G(^BPST(BP59,1)),U)
88 ;
89 ;Get PATIENT - ptr to #2
90 S BPDFN=+$P($G(^BPST(BP59,0)),U,6)
91 ;
92 ;Check for correct BPS Pharmacy (DIVISION)
93 I $G(BPPHARM)=1,$$CHKPHRM(BP59)=0 G XPROC
94 ;
95 ;Check for Display 1-ALL,2-RELEASED,3-NOT RELEASED
96 S BPRLSDT=$$RELEASED(BPRX,BPREF)
97 I BPRLNRL'=1 I ((BPRLNRL=2)&(BPRLSDT=0))!((BPRLNRL=3)&(BPRLSDT)) G XPROC
98 ;
99 ;Get Status
100 S BPSTATUS=$$STATUS^BPSRPT6(BPRX,BPREF)
101 ;
102 ;if REVERSAL
103 I BPRTYPE=4,BPSTATUS'["REVERSAL" G XPROC ; exclude non-reversed
104 ;
105 ;if PAYABLE
106 S BPPAYBL=BPSTATUS["PAYABLE"
107 I BPRTYPE=1,'BPPAYBL G XPROC ; exclude non-payable
108 I BPRTYPE=1,BPSTATUS["REVERSAL" G XPROC ; reversed
109 ;
110 ;if REJECTED
111 S BPREJ=BPSTATUS["REJECTED"
112 I BPRTYPE=2,BPSTATUS["REVERSAL" G XPROC ; exclude rejected reversals
113 I BPRTYPE=2,'BPREJ G XPROC ; exclude non-rejected
114 I BPRTYPE=2,$$CLSCLM(BP59) G XPROC ;exclude closed claims
115 ;
116 ;if SUBMITTED NOT RELEASED exclude released ones
117 I BPRTYPE=3,BPRLSDT'=0 G XPROC
118 I BPRTYPE=3,'BPPAYBL G XPROC ; exclude non-payable
119 ;
120 ;Auto Reverse Check
121 I BPRTYPE=4,BPAUTREV,'$$AUTOREV(BP59) G XPROC
122 ;
123 ;if CLOSED
124 I BPRTYPE=7,'$$CLSCLM(BP59) G XPROC ;exclude open claims
125 I BPRTYPE=7,BPSTATUS'["REJECTED" G XPROC ;exclude non-rejected closed claims
126 ;
127 ;if Recent Transactions, exclude closed claims
128 I BPRTYPE=5,$$CLSCLM(BP59) G XPROC
129 ;
130 ;If Totals by Date, include only rejects and payables
131 I BPRTYPE=6,BPSTATUS'["REJECTED",BPSTATUS'["PAYABLE" G XPROC ; Reversed
132 ;
133 ;Realtime/Backbill Check
134 S BPBCK=$$RTBCK(BP59)
135 I BPRTBCK'=1 I ((BPRTBCK=2)&(BPBCK=0))!((BPRTBCK=3)&(BPBCK)) G XPROC
136 ;
137 ;Check for MAIL/WINDOW/CMOP/ALL
138 I BPMWC'="A",$$MWC^BPSRPT6(BPRX,BPREF)'=BPMWC G XPROC
139 ;
140 ;Check for selected insurance
141 S BPPLAN=$P($$INSNAM^BPSRPT6(BP59),U,2)
142 I BPINSINF'=0,BPINSINF'=BPPLAN G XPROC
143 ;
144 ;Check for selected drug
145 S BPRXDRG=$$GETDRUG^BPSRPT6(BPRX)
146 I BPRXDRG=0 G XPROC
147 I BPDRUG,BPDRUG'=BPRXDRG G XPROC
148 ;
149 ;Check for selected drug classes
150 I BPDRGCL'=0,BPDRGCL'=$$DRGCLNAM^BPSRPT6($$GETDRGCL^BPSRPT6(BPRXDRG),99) G XPROC
151 ;
152 ;Check for selected Close Reason
153 I BPCCRSN,BPCCRSN'=$P($$CLRSN^BPSRPT7(BP59),U) G XPROC
154 ;
155 ;Check for Accepted/Rejected
156 I BPACREJ=1,BPSTATUS'["REJECTED" G XPROC
157 I BPACREJ=2,BPSTATUS'["ACCEPTED" G XPROC
158 ;
159 ;Check for Specific Reject Code
160 I BPREJCD'=0,'$$CKREJ(BP59,BPREJCD) G XPROC
161 ;
162 ;Save Entry for Report
163 D SETTMP^BPSRPT2(BPGLTMP,BPDFN,BPRX,BPREF,BP59,BPBEGDT,BPENDDT,.BPPHARM,BPSUMDET,BPPLAN,BPRLSDT,BPPAYBL,BPREJ,BPRXDRG,$P(BPSTATUS,U))
164 ;
165XPROC Q
166 ;
167 ;Check if selected BPS PHARMACY
168 ;
169 ; Defined Variable: BPPHARM(ptr) - List of BPS Pharmacies to Report on
170 ; Input Variable: BP59 - Lookup to BPS TRANSACTION (#59)
171 ;
172 ; Returned Value -> 0 = Entry not in list of selected pharmacies
173 ; 1 = Entry is in list of selected pharmacies
174CHKPHRM(BP59) N PHARM
175 S PHARM=+$P($G(^BPST(BP59,1)),"^",7)
176 S PHARM=$S($D(BPPHARM(PHARM)):1,1:0)
177 Q PHARM
178 ;
179 ;Determine whether claim is Released or Not Released
180 ;
181 ; Input Variables: BPRX - ptr to PRESCRIPTION (#52)
182 ; BPREF - refill # (0-No Refills,1-1st Refill, 2-2nd, ...)
183 ;
184 ; Return Value -> 0 = Not Released
185 ; released date = Released
186 ;
187RELEASED(BPRX,BPREF) N RDT
188 ;
189 I BPREF=0 S RDT=$$RXRELDT^BPSRPT6(BPRX)\1
190 I BPREF'=0 S RDT=$$REFRELDT^BPSRPT6(BPRX,BPREF)\1
191 Q RDT
192 ;
193 ;Determine if claim was Auto Reversed
194 ;
195 ; Input Variable: BP59 - Lookup to BPS TRANSACTION (#59)
196 ; Return Value -> 1 = Auto Reversed
197 ; 0 = Not Auto Reversed
198 ;
199AUTOREV(BP59) N AR,BP02
200 S BP02=+$P($G(^BPST(BP59,0)),U,4)
201 S AR=+$P($G(^BPSC(BP02,0)),U,7)
202 Q AR
203 ;
204 ;Determine if claim was closed
205 ;
206 ; Input Variable: BP59 - Lookup to BPS TRANSACTION (#59)
207 ; Return Value -> 1 = Closed
208 ; 0 = Not Closed
209 ;
210CLSCLM(BP59) N BP02,CL
211 S BP02=+$P($G(^BPST(BP59,0)),U,4)
212 S CL=+$G(^BPSC(BP02,900))
213 Q CL
214 ;
215 ;Determine whether claim is Realtime or Backbilled
216 ;
217 ; Input Variable: BP59 - Lookup to BPS TRANSACTION (#59)
218 ; Return Value -> 1 = Backbilled
219 ; 0 = Realtime
220RTBCK(BP59) N BB
221 S BB=$P($G(^BPST(BP59,12)),U)
222 S BB=$S(BB="BB":0,1:1)
223 Q BB
224 ;
225 ;Screen Pause 1
226 ;
227 ; Return variable - BPQ = 0 Continue
228 ; 2 Quit
229PAUSE N X
230 U IO(0) W !!,"Press RETURN to continue, '^' to exit:"
231 R X:$G(DTIME) S:'$T X="^" S:X["^" BPQ=2
232 U IO
233 Q
234 ;
235 ;Screen Pause 2
236 ;
237 ; Return variable - BPQ = 0 Continue
238 ; 2 Quit
239PAUSE2 N X
240 U IO(0) W !!,"Press RETURN to continue:"
241 R X:$G(DTIME) S:'$T X="^" S:X["^" BPQ=2
242 U IO
243 Q
244 ;
245 ;Get ECME#
246 ;
247 ; Input Variable: BP59 - Lookup to BPS TRANSACTION (#59)
248 ; Returned value -> Last 7 digits of ECME#
249 ;
250ECMENUM(BP59) N BPY1,BPY2
251 S BPY1=(BP59\1),BPY2=$E(BPY1,$L(BPY1)-6,99) ;last 7 digits
252 Q BPY2
253 ;
254 ;Convert FM date or date.time to displayable (mm/dd/yy HH:MM) format
255 ;
256DATTIM(X) N DATE,BPT,BPM,BPH,BPAP
257 S DATE=$S(X:$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3),1:"")
258 S BPT=$P(X,".",2) S:$L(BPT)<4 BPT=BPT_$E("0000",1,4-$L(BPT))
259 S BPH=$E(BPT,1,2),BPM=$E(BPT,3,4)
260 S BPAP="AM" I BPH>12 S BPH=BPH-12,BPAP="PM" S:$L(BPH)<2 BPH="0"_BPH
261 I BPT S:'BPH BPH=12 S DATE=DATE_" "_BPH_":"_BPM_BPAP
262 Q $G(DATE)
263 ;
264 ;Display RT-Realtime,BB-Backbill, or " "
265 ;
266RTBCKNAM(BPINDEX) Q $S(BPINDEX=1:"RT",BPINDEX=0:"BB",1:" ")
267 ;
268 ;See for Specific Reject Code
269 ;
270CKREJ(BP59,BPREJCD) N FREJ,I,REJ,X
271 S FREJ=0
272 S X=$$REJTEXT^BPSRPT2(BP59,.REJ)
273 S X="" F S X=$O(REJ(X)) Q:X="" D Q:FREJ=1
274 .S REJ=$P($G(REJ(X)),":") Q:REJ=""
275 .S I="" F S I=$O(^BPSF(9002313.93,"B",REJ,I)) Q:I="" I I=BPREJCD S FREJ=1
276 Q FREJ
Note: See TracBrowser for help on using the repository browser.