source: WorldVistAEHR/trunk/r/E_CLAIMS_MGMT_ENGINE-BPS/BPSSCRLG.m@ 1407

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

initial load of WorldVistAEHR
File size: 9.2 KB
RevLine 
[613]1BPSSCRLG ;BHAM ISC/SS - ECME LOGINFO ;05-APR-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 ;
5 Q
6 ;
7EN ; -- main entry point for BPS LSTMN LOG
8 D EN^VALM("BPS LSTMN LOG")
9 Q
10 ;
11HDR ; -- header code
12 S VALMHDR(1)="Claim Log information"
13 S VALMHDR(2)=""
14 Q
15 ;
16INIT ; -- init variables and list array
17 N BPSELCLM,LINE
18 S BPSELCLM=$G(@VALMAR@("SELLN"))
19 ; piece 2: patient ien #2
20 ; piece 3: insurance ien #36
21 ; piece 4: ptr to #9002313.59
22 S LINE=1
23 S VALMCNT=$$PREPINFO(.LINE,$P(BPSELCLM,U,2),$P(BPSELCLM,U,3),$P(BPSELCLM,U,4))
24 S:VALMCNT>1 VALMCNT=VALMCNT-1
25 Q
26 ;
27HELP ; -- help code
28 S X="?" D DISP^XQORM1 W !!
29 K X
30 Q
31 ;
32EXIT ; -- exit code
33 Q
34 ;
35EXPND ; -- expand code
36 Q
37 ;
38 ;
39LOG ;entry point for LOG menu option of the main User Screen
40 N BPRET,BPSEL
41 I '$D(@(VALMAR)) Q
42 D FULL^VALM1
43 W !,"Enter the line number for which you wish to print claim logs."
44 S BPSEL=$$ASKLINE^BPSSCRU4("Select item","C","Please select SINGLE Rx Line.")
45 I BPSEL<1 S VALMBCK="R" Q
46 D SAVESEL(BPSEL,VALMAR)
47 D EN
48 S VALMBCK="R"
49 Q
50 ;
51 ;save selection in order to use inside enclosed ListManager copy
52 ;BPSEL - selected line
53 ;BPVALMR - parent VALMAR
54SAVESEL(BPSEL,BPVALMR) ;
55 D CLEANIT
56 S ^TMP("BPSLOG",$J,"VALM","SELLN")=BPSEL
57 S ^TMP("BPSLOG",$J,"VALM","PARENT")=BPVALMR
58 M ^TMP("BPSLOG",$J,"VALM","VIEWPARAMS")=@BPVALMR@("VIEWPARAMS")
59 Q
60 ;
61CLEANIT ;
62 K ^TMP("BPSLOG",$J,"VALM")
63 Q
64 ;input:
65 ; BPDFN: patient ien #2
66 ; BP36: insurance ien #36
67 ; BP59: ptr to #9002313.59
68 ; returns number of lines
69PREPINFO(BPLN,BPDFN,BP36,BP59) ;
70 I '$G(BP59) Q 0
71 I '$G(BP36) Q 0
72 I '$G(BPDFN) Q 0
73 N BPSCRLNS S BPSCRLNS=17 ;(see "BPS LSTMN LOG" LM template: Bottom=21, Top = 4, 21-4=17)
74 N BPX,BPRXIEN,BPREF,BP1,BPLSTCLM,BPLSTRSP,BPDAT59,BPUSR,BPSTRT,BPHIST,BPQ
75 N BPDT,BPLN0,BPCNT
76 S BP1=$$RXREF^BPSSCRU2(BP59)
77 S BPRXIEN=$P(BP1,U,1)
78 S BPREF=$P(BP1,U,2)
79 S BPDAT59(0)=$G(^BPST(BP59,0))
80 ;create a history
81 D MKHIST^BPSSCRU5(BP59,.BPHIST)
82 ;
83 S BPLN0=BPLN
84 D SETLINE(.BPLN,"Pharmacy ECME Log")
85 D SETLINE(.BPLN,"")
86 S BPX=$$RJ^BPSSCR02("VA Rx #: ",19)_$$LJ^BPSSCR02($$RXNUM^BPSSCRU2(+BPRXIEN),13)
87 S BPX=BPX_$$RJ^BPSSCR02("Fill #: ",10)_$$LJ^BPSSCR02(BPREF,4)
88 S BPX=BPX_$$RJ^BPSSCR02("ECME Claim Rx #: ",18)_$$LJ^BPSSCR02(BP59,20)
89 D SETLINE(.BPLN,BPX)
90 S BPX=$$RJ^BPSSCR02("Patient Name: ",19)
91 S BPX=BPX_$$LJ^BPSSCR02($$PATNAME^BPSSCRU2(BPDFN)_" "_$$SSN4^BPSSCRU2(BPDFN),30)
92 D SETLINE(.BPLN,BPX)
93 S BPX=$$RJ^BPSSCR02("Last Submitted: ",19)
94 S BPSTRT=$P(BPDAT59(0),U,11) ;@# need to check with analyst if this is a START DATE
95 I BPSTRT]"" S BPX=BPX_$$DATETIME^BPSSCRU5(BPSTRT)
96 D SETLINE(.BPLN,BPX)
97 S BPX=$$RJ^BPSSCR02("Last Submitted By: ",19)
98 S BPUSR=$P(BPDAT59(0),U,10)
99 I BPUSR]"" S BPX=BPX_$$GETUSRNM^BPSSCRU1(BPUSR)
100 D SETLINE(.BPLN,BPX)
101 ;
102 ;find the latest claim
103 S BP1=+$O(BPHIST("C",99999999),-1)
104 I BP1=0 D SETLINE(.BPLN,""),SETLINE(.BPLN,"------ No electronic claims ------") Q BPLN
105 S BP1=+$O(BPHIST("C",BP1,0))
106 S BPX=$$RJ^BPSSCR02("Last VA Claim #: ",19)_$P($G(^BPSC(+BP1,0)),U,1)
107 D SETLINE(.BPLN,BPX)
108 F BPCNT=BPLN:1:BPLN0+BPSCRLNS D SETLINE(.BPLN,"")
109 ;process history
110 N BPTYPE,BPIEN,BPIENRS
111 S BPDT=99999999
112 F S BPDT=$O(BPHIST("C",BPDT),-1) Q:+BPDT=0 D
113 . S BPIEN=+$O(BPHIST("C",BPDT,0)) Q:BPIEN=""
114 . D DISPCLM(.BPLN,BP59,BPIEN,+BPHIST("C",BPDT,BPIEN),$P(BPHIST("C",BPDT,BPIEN),U,2),BPDT)
115 . S BPIENRS=0
116 . F S BPIENRS=$O(BPHIST("C",BPDT,BPIEN,"R",BPIENRS)) Q:+BPIENRS=0 D
117 . . D DISPRSP(.BPLN,BP59,BPIENRS,+BPHIST("C",BPDT,BPIEN,"R",BPIENRS),$P(BPHIST("C",BPDT,BPIEN,"R",BPIENRS),U,2),BPDT)
118 Q BPLN
119 ;calls SET^VALM10,
120 ;increments BPLINE
121SETLINE(BPLINE,BPSTR) ;
122 D SET^VALM10(BPLINE,BPSTR)
123 S BPLINE=BPLINE+1
124 Q
125 ;display claim record
126DISPCLM(BPLN,BP59,BPIEN02,BP57,BPSTYPE,BPSDTALT) ;
127 N BPSCRLNS S BPSCRLNS=17 ;(see "BPS LSTMN LOG" LM template: Bottom=21, Top = 4, 21-4=17)
128 N BPX,BPLN0,BPCNT,BPSTR1,BPSTYP2
129 S BPLN0=BPLN
130 S BPSTYP2=$S(BPSTYPE="C":"CLAIM REQUEST",BPSTYPE="R":"REVERSAL",1:"")
131 S BPSTR1="Transmission Information ("_BPSTYP2_")(#"_BPIEN02_")"
132 D SETLINE(.BPLN,BPSTR1_$$LINE^BPSSCRU3(79-$L(BPSTR1),"-"))
133 D SETLINE(.BPLN,"")
134 D SETLINE(.BPLN,"Created on: "_$$CREATEDT(BPIEN02,BPSDTALT))
135 D SETLINE(.BPLN,"VA Claim ID: "_$P($G(^BPSC(+BPIEN02,0)),U,1))
136 D SETLINE(.BPLN,"Transaction Type: "_$$TRTYPE^BPSSCRU5($$TRCODE(BPIEN02)))
137 D SETLINE(.BPLN,"Date of Service: "_$$DOSCLM(BPIEN02))
138 D SETLINE(.BPLN,"NDC: "_$$LNDC^BPSSCRU5(BPIEN02))
139 D SETLINE(.BPLN,"ECME Pharmacy: "_$$DIVNAME^BPSSCRDS($$LDIV(BP57)))
140 D SETLINE(.BPLN,"Days Supply: "_$$DAYSSUPL(BPIEN02))
141 S BPX="Qty: "_$$QTY(BP57)
142 S BPX=BPX_" Unit Price: "_$$UNTPRICE(BP57)
143 S BPX=BPX_" Total Price: "_$$TOTPRICE(BP57)
144 D SETLINE(.BPLN,BPX)
145 D SETLINE(.BPLN,"")
146 D SETLINE(.BPLN,"Insurance Name: "_$$INSUR57(BP57))
147 D SETLINE(.BPLN,"BIN: "_$$BIN(BPIEN02))
148 D SETLINE(.BPLN,"PCN: "_$$PCN(BPIEN02))
149 D SETLINE(.BPLN,"Group ID: "_$$GRPID(BPIEN02))
150 D SETLINE(.BPLN,"Cardholder ID: "_$$CRDHLDID(BPIEN02))
151 D SETLINE(.BPLN,"Patient Relationship Code: "_$$PATRELSH(BPIEN02,BP57))
152 D SETLINE(.BPLN,"Cardholder First Name: "_$$CRDHLDFN(BPIEN02,BP57))
153 D SETLINE(.BPLN,"Cardholder Last Name: "_$$CRDHLDLN(BPIEN02,BP57))
154 F BPCNT=BPLN:1:BPLN0+BPSCRLNS D SETLINE(.BPLN,"")
155 S BPLN0=BPLN
156 D SETLINE(.BPLN,"Plan ID: "_$$PLANID(BP57))
157 D SETLINE(.BPLN,"Payer Sheet IEN: "_$$PYRIEN^BPSSCRU5(BPIEN02))
158 D SETLINE(.BPLN,"B2 Payer Sheet IEN: "_$$B2PYRIEN^BPSSCRU5(BPIEN02,BP57))
159 D SETLINE(.BPLN,"B3 Rebill Payer Sheet: "_$$B3PYRIEN^BPSSCRU5(BPIEN02,BP59,BP57))
160 D SETLINE(.BPLN,"Certify Mode: "_$$CERTMOD(BP57))
161 D SETLINE(.BPLN,"Cert IEN: "_$$CERTIEN(BP57))
162 F BPCNT=BPLN:1:BPLN0+BPSCRLNS D SETLINE(.BPLN,"")
163 Q
164 ;Date os service date in BPS CLAIM file
165DOSCLM(BPIEN02) ;
166 N BPDT
167 S BPDT=$P($G(^BPSC(BPIEN02,400,1,400)),U,1)\1
168 Q $E(BPDT,5,6)_"/"_$E(BPDT,7,8)_"/"_$E(BPDT,1,4)
169 ;record created on
170CREATEDT(BPIEN02,BPSDTALT) ;
171 N BPSDT
172 S BPSDT=+$P($G(^BPSC(BPIEN02,0)),U,6)
173 Q $$DATETIME^BPSSCRU5($S(BPSDT>0:BPSDT,1:BPSDTALT))
174 Q
175 ;Plan ID from #9002313.57
176PLANID(BP57) ;
177 Q $P($G(^BPSTL(BP57,10,+$G(^BPSTL(BP57,9)),0)),U,1)
178 ;
179CERTMOD(BP57) ;
180 Q $P($G(^BPSTL(BP57,10,+$G(^BPSTL(BP57,9)),0)),U,5)
181 ;Software Vendor/Cert ID
182CERTIEN(BP57) ;
183 Q $P($G(^BPSTL(BP57,10,+$G(^BPSTL(BP57,9)),0)),U,6)
184 ;group ID
185GRPID(BPIEN02) ;
186 Q $E($P($G(^BPSC(BPIEN02,300)),U,1),3,99)
187 ;
188 ;Cardholder ID
189CRDHLDID(BPIEN02) ;
190 Q $E($P($G(^BPSC(BPIEN02,300)),U,2),3,99)
191 ;Cardholder First name
192CRDHLDFN(BPIEN02,BP57) ;
193 N Y
194 S Y=$P($G(^BPSC(BPIEN02,300)),U,12)
195 I $L(Y)=0 S Y=$P($G(^BPSTL(BP57,10,+$G(^BPSTL(BP57,9)),1)),U,6)
196 Q Y
197 ;Cardholder Last Name
198CRDHLDLN(BPIEN02,BP57) ;
199 N Y
200 S Y=$P($G(^BPSC(BPIEN02,300)),U,13)
201 I $L(Y)=0 S Y=$P($G(^BPSTL(BP57,10,+$G(^BPSTL(BP57,9)),1)),U,7)
202 Q Y
203 ;Patient Relationship Code
204PATRELSH(BPIEN02,BP57) ;
205 N Y
206 S Y=$P($G(^BPSC(BPIEN02,300)),U,6)
207 I $L(Y)=0 S Y=$P($G(^BPSTL(BP57,10,+$G(^BPSTL(BP57,9)),1)),U,5)
208 Q $S(Y=1:"CARDHOLDER",Y=2:"SPOUSE",Y=3:"CHILD",1:Y)
209 ;
210PCN(BPIEN02) ;
211 Q $P($G(^BPSC(BPIEN02,100)),U,4)
212 ;
213BIN(BPIEN02) ;
214 Q $P($G(^BPSC(BPIEN02,100)),U,1)
215 ;insurance name by 9002313.57 pointer
216INSUR57(BPIEN57) ;
217 N BPINSN
218 S BPINSN=+$G(^BPSTL(BPIEN57,9))
219 Q $P($G(^BPSTL(BPIEN57,10,BPINSN,0)),U,7)
220 ;
221QTY(BPIEN57) ;
222 Q +$P($G(^BPSTL(BPIEN57,5)),U,1)
223UNTPRICE(BPIEN57) ;
224 Q +$P($G(^BPSTL(BPIEN57,5)),U,2)
225TOTPRICE(BPIEN57) ;
226 Q +$P($G(^BPSTL(BPIEN57,5)),U,5)
227 ;get ECME pharmacy division ptr for LOG
228LDIV(BPIEN57) ;
229 Q +$P($G(^BPSTL(BPIEN57,1)),U,7)
230 ;transaction code
231TRCODE(BPIEN02) ;
232 Q $P($G(^BPSC(BPIEN02,100)),U,3)
233 ;days supply
234DAYSSUPL(BPIEN02) ;
235 ;format D5NNN -> NNN
236 Q +$E($P($G(^BPSC(BPIEN02,400,1,400)),U,5),3,99)
237 ;
238 ;display response record
239DISPRSP(BPLN,BP59,BPIEN03,BP57,BPSTYPE,BPSDTALT) ;
240 N BPSCRLNS S BPSCRLNS=17 ;(see "BPS LSTMN LOG" LM template: Bottom=21, Top = 4, 21-4=17)
241 N BPX,BPLN0,BPCNT,BPRJCDS,BPRJ,BPSTR1,BPSTYP2
242 S BPLN0=BPLN
243 S BPSTYP2=$S(BPSTYPE="C":"CLAIM REQUEST",BPSTYPE="R":"REVERSAL",1:"")
244 S BPSTR1="Response Information ("_BPSTYP2_")(#"_BPIEN03_")"
245 D SETLINE(.BPLN,BPSTR1_$$LINE^BPSSCRU3(79-$L(BPSTR1),"-"))
246 D SETLINE(.BPLN,"")
247 D SETLINE(.BPLN,"Response Received: "_$$RESPREC(BPIEN03,BPSDTALT))
248 D SETLINE(.BPLN,"Date of Service: "_$$DOSRSP(BPIEN03))
249 D SETLINE(.BPLN,"Transaction Response Status: "_$$RESPSTAT^BPSSCRU5(BPIEN03))
250 D SETLINE(.BPLN,"Total Amount Paid: $"_+$$TOTAMNT(BPIEN03,BP59,BP57))
251 D SETLINE(.BPLN,"Reject code(s): ")
252 D REJCODES^BPSSCRU5(BPIEN03,.BPRJCDS)
253 S BPRJ=""
254 F S BPRJ=$O(BPRJCDS(BPRJ)) Q:BPRJ="" D
255 . D SETLINE(.BPLN," "_$$GETRJNAM^BPSSCRU3(BPRJ))
256 D WRAPLN^BPSSCRU5(.BPLN,$$MESSAGE(BPIEN03),76,"Message: ",5)
257 D WRAPLN^BPSSCRU5(.BPLN,$$ADDMESS(BPIEN03),76,"Additional Message: ",5)
258 ;D WRAPLN^BPSSCRU5(.BPLN,$$DUR(BPIEN03),60,"DUR Information: ",5)
259 D WRAPLN^BPSSCRU5(.BPLN,$$DURRESP(BPIEN03),76,"DUR Response Info: ",5)
260 F BPCNT=BPLN:1:BPLN0+BPSCRLNS D SETLINE(.BPLN,"")
261 Q
262 ;
263RESPREC(BPIEN03,BPSDTALT) ;
264 N BPSDT
265 S BPSDT=+$P($G(^BPSR(BPIEN03,0)),U,2)
266 Q $$DATETIME^BPSSCRU5($S(BPSDT>0:BPSDT,1:BPSDTALT))
267 ;
268DOSRSP(BPIEN03) ;
269 N BPDT
270 S BPDT=$P($G(^BPSR(BPIEN03,400)),U,1)\1
271 Q $E(BPDT,5,6)_"/"_$E(BPDT,7,8)_"/"_$E(BPDT,1,4)
272 ;
273TOTAMNT(BPIEN03,BP59,BP57) ;
274 Q $$DFF2EXT^BPSECFM($P($G(^BPSR(BPIEN03,1000,1,500)),U,9))
275 ;
276MESSAGE(BPIEN03) ;
277 Q $P($G(^BPSR(BPIEN03,504)),U)
278 ;
279ADDMESS(BPIEN03) ;
280 Q $P($G(^BPSR(BPIEN03,1000,1,526)),U)
281 ;
282DUR(BPIEN03) ;
283 Q "???"
284 ;
285DURRESP(BPIEN03) ;
286 Q $P($G(^BPSR(BPIEN03,1000,1,525)),U)
Note: See TracBrowser for help on using the repository browser.