BPSRPT8 ;BHAM ISC/BEE - ECME REPORTS ;14-FEB-05
;;1.0;E CLAIMS MGMT ENGINE;**1,3,5,7,8,10,11,19,20,23,24,28**;JUN 2004;Build 22
;;Per VA Directive 6402, this routine should not be modified.
;
;Reference to IB NCPCP NON-BILLABLE STATUS REASONS (#366.17) supported by ICR 6136
;
Q
;
;Routine to Display the Reports in Excel
;
;Print Report Line 1
;
; Input Variable -> BPRTYPE,BPDIV,BPGRPLAN,BPDFN,BPRX,BPREF,BPX,BPSRTDT
; BPBIL,BPINS,BPCOLL
;
WRLINE1(BPRTYPE,BPREC,BPDIV,BPGRPLAN,BPDFN,BPRX,BPREF,BPX,BPSRTDT,BPBIL,BPINS,BPCOLL,BPPSEQ) ;
;
N BP59,BP02,BP03,BPREC2
S BP59=$P(BPX,U,3)
S BP02=+$P($G(^BPST(BP59,0)),U,4)
S BP03=+$P($G(^BPST(BP59,0)),U,5)
;Division
I (",5,6,8,")[BPRTYPE S BPREC=$S(BPDIV=0:"BLANK",$$DIVNAME^BPSSCRDS(BPDIV)]"":$$DIVNAME^BPSSCRDS(BPDIV),1:BPDIV)_U
I (",1,2,3,4,7,9,10,")[(","_BPRTYPE_",") S BPREC=$S(BPDIV=0:"BLANK",$$DIVNAME^BPSSCRDS(BPDIV)]"":$E($$DIVNAME^BPSSCRDS(BPDIV),1,12),1:$E(BPDIV,1,12))_U
;
;Insurance
I BPRTYPE=8 S BPREC=BPREC_$E(BPGRPLAN,1,90)_U
;
I (",1,2,3,4,7,9,")[BPRTYPE D
. S BPREC=BPREC_$E(BPGRPLAN,1,21)_U ;Insurance
. I BPRTYPE=2 S BPREC=BPREC_$$INSBIN^BPSRPT6(BP59)_U ;BIN
. S BPREC=BPREC_$E($$PATNAME^BPSRPT6(BPDFN),1,13)_U ;Patient Name
. S BPREC=BPREC_$$SSN4^BPSRPT6(BPDFN)_U ;L4SSN
;
I (",5,6,8,")[BPRTYPE D
. S BPREC=BPREC_$$PATNAME^BPSRPT6(BPDFN)_U ;Patient Name
. S BPREC=BPREC_"("_$$SSN4^BPSRPT6(BPDFN)_")"_U ;L4SSN
;
I (BPRTYPE=1)!(BPRTYPE=4) D Q
. N PTRESP
. S BPREC=BPREC_$$ELIGCODE^BPSSCR05($P(BPX,U,3))_U ;Eligibility
. S BPREC=BPREC_$$RXNUM^BPSRPT6(BPRX)_$$COPAY^BPSRPT6(BPRX)_U ;RX Number
. S BPREC=BPREC_BPREF_"/"_$$ECMENUM^BPSRPT1($P(BPX,U,3))_U ;Refill/ECME Number
. S BPREC=BPREC_$$DATTIM^BPSRPT1(BPSRTDT)_U ;Date
. S BPREC=BPREC_$$INGRCST^BPSSCRLG(BP02)_U ;Ingredient Cost
. S BPREC=BPREC_$$DISPFEE^BPSSCRLG(BP02)_U ;Dispensing Fee
. S BPREC=BPREC_$TR($J(BPBIL,10,2)," ")_U ;$Billed
. S BPREC=BPREC_$$ICPAID^BPSSCRLG(BP03)_U ;Ingredient Cost Paid
. S BPREC=BPREC_$$DFPAID^BPSSCRLG(BP03)_U ;Dispensing Fee Paid
. S PTRESP=$$PTRESP^BPSSCRLG(BP03) S BPREC=BPREC_$S('PTRESP:PTRESP,1:"-"_PTRESP)_U ;Patient Pay Amount
. S BPREC=BPREC_$TR($J(BPINS,10,2)," ")_U ;$Ins. Paid
. S BPREC=BPREC_$S(BPCOLL]"":$TR($J(BPCOLL,10,2)," "),1:"")_U ;$Collected
;
I BPRTYPE=2 D Q
. S BPREC=BPREC_$$ELIGCODE^BPSSCR05($P(BPX,U,3))_U ;Eligibility
. S BPREC=BPREC_$$RXNUM^BPSRPT6(BPRX)_$$COPAY^BPSRPT6(BPRX)_U ;RX Number
. S BPREC=BPREC_BPREF_"/"_$$ECMENUM^BPSRPT1($P(BPX,U,3))_U ;Refill/ECME Number
. S BPREC=BPREC_$$DATTIM^BPSRPT1(BPSRTDT)_U ;Date
. S BPREC=BPREC_$$DATTIM^BPSRPT1(+BPX)_U ;Released On
. ;RX INFO
. S BPREC=BPREC_$$MWC^BPSRPT6(BPRX,BPREF)_U ;Fill Location
. S BPREC=BPREC_$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($P(BPX,U,3)))_U ;Fill Type
. S BPREC=BPREC_$$RXSTATUS^BPSRPT6($P(BPX,U,3)) ;Status
. S BPREC=BPREC_$S($P(BPX,U):"/R",1:"/N")_U ;RL/NR
. S BPREC=BPREC_$$RXCOB($G(BPPSEQ))_U
. S BPREC=BPREC_$S($$CLOSED02^BPSSCR03($P(^BPST($P(BPX,U,3),0),U,4))=1:"C",1:"O")_U ;Open/Closed
;
I BPRTYPE=3 D Q
. N PTRESP
. S BPREC=BPREC_$$RXNUM^BPSRPT6(BPRX)_$$COPAY^BPSRPT6(BPRX)_U ;RX Number
. S BPREC=BPREC_BPREF_"/"_$$ECMENUM^BPSRPT1($P(BPX,U,3))_U ;Refill/ECME Number
. S BPREC=BPREC_$$DATTIM^BPSRPT1(BPSRTDT)_U ;Date
. S BPREC=BPREC_$$INGRCST^BPSSCRLG(BP02)_U ;Ingredient Cost
. S BPREC=BPREC_$$DISPFEE^BPSSCRLG(BP02)_U ;Dispensing Fee
. S BPREC=BPREC_$TR($J(BPBIL,10,2)," ")_U ;$Billed
. S BPREC=BPREC_$$ICPAID^BPSSCRLG(BP03)_U ;Ingredient Cost Paid
. S BPREC=BPREC_$$DFPAID^BPSSCRLG(BP03)_U ;Dispensing Fee Paid
. S PTRESP=$$PTRESP^BPSSCRLG(BP03) S BPREC=BPREC_$S('PTRESP:PTRESP,1:"-"_PTRESP)_U ;Patient Pay Amount
. S BPREC=BPREC_$TR($J(BPINS,10,2)," ")_U ;Insurance Response
;
I BPRTYPE=5 D Q
. S BPREC=BPREC_$$RXNUM^BPSRPT6(BPRX)_$$COPAY^BPSRPT6(BPRX)_U ;RX Number
. S BPREC=BPREC_BPREF_"/"_$$ECMENUM^BPSRPT1($P(BPX,U,3))_U ;Refill/ECME Number
. S BPREC=BPREC_$$DATTIM^BPSRPT1($$TRANDT^BPSRPT2($P(BPX,U,3),1))_U ;Completed
. S BPREC=BPREC_$$TTYPE^BPSRPT7($P(BPX,U,4),$P(BPX,U,5),BPPSEQ)_U ;Trans Type
. S BPREC=BPREC_$$RESPONSE^BPSRPT7($P(BPX,U,4),$P(BPX,U,5),BPPSEQ)_U ;Payer Response
. S BPREC=BPREC_$$RXCOB($G(BPPSEQ))_U ;RX COB
;
I BPRTYPE=7 D Q
. ;RX INFO
. S BPREC=BPREC_$$ELIGCODE^BPSSCR05($P(BPX,U,3))_U ;Eligibility
. S BPREC=BPREC_$$RXNUM^BPSRPT6(BPRX)_$$COPAY^BPSRPT6(BPRX)_U ;RX Number
. S BPREC=BPREC_BPREF_"/"_$$ECMENUM^BPSRPT1($P(BPX,U,3))_U ;Refill/ECME Number
. S BPREC=BPREC_$$MWC^BPSRPT6(BPRX,BPREF)_U ;Fill Location
. S BPREC=BPREC_$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($P(BPX,U,3)))_U ;Fill Type
. S BPREC=BPREC_$$RXSTATUS^BPSRPT6($P(BPX,U,3)) ;Status
. S BPREC=BPREC_$S($P(BPX,U):"/R",1:"/N")_U ;RL/NR
. S BPREC=BPREC_$S($P(BPX,U,13):"REJ",1:"")_U
. S BPREC=BPREC_$$DRGNAM^BPSRPT6($P(BPX,U,14),15)_U ;Drug
. S BPREC=BPREC_$TR($$GETNDC^BPSRPT6(BPRX,BPREF),"-")_U
;
I (BPRTYPE=8) D Q
. S BPREC=BPREC_$$RXNUM^BPSRPT6(BPRX)_$$COPAY^BPSRPT6(BPRX)_U ;RX Number
. S BPREC=BPREC_BPREF_"/"_$$ECMENUM^BPSRPT1($P(BPX,U,3))_U ;Refill/ECME Number
. S BPREC=BPREC_$$DATTIM^BPSRPT1(BPSRTDT)_U ;Date
. S BPREC=BPREC_$TR($J(BPBIL,10,2)," ")_U ;$Billed
. S BPREC=BPREC_$TR($J(BPINS,10,2)," ")_U ;$Ins. Paid
. S BPREC=BPREC_$S(BPCOLL]"":$TR($J(BPCOLL,10,2)," "),1:"")_U ;$Collected
;
I BPRTYPE=9 D Q
. N ELGCD S ELGCD=$P(BPX,U,1)
. S BPREC=BPREC_$S(ELGCD="V":"VET",ELGCD="T":"TRI",ELGCD="C":"CVA",1:"UNK")_U
. S BPREC=BPREC_$$RXNUM^BPSRPT6(BPRX)_$$COPAY^BPSRPT6(BPRX)_U ;RX Number
. S BPREC=BPREC_BPREF_U ;Refill
. S BPREC=BPREC_$$DATTIM^BPSRPT1(BPSRTDT)_U ;Date
. S BPREC=BPREC_$S($P(BPX,U,2)]"":$TR($J($P(BPX,U,2),10,2)," "),1:"")_U ;$Drug Cost
;
I BPRTYPE=10 D Q
. N BPDPAY
. S BPDPAY=$P(BPX,U,17)
. S BPREC=BPREC_$E(BPGRPLAN,1,21)_U ;Insurance
. S BPREC=BPREC_$E($$PATNAME^BPSRPT6(BPDFN),1,13)_U ;Patient Name
. S BPREC=BPREC_$$SSN4^BPSRPT6(BPDFN)_U ;L4SSN
. S BPREC=BPREC_$$ELIGCODE^BPSSCR05($P(BPX,U,3))_U ;Eligibility
. S BPREC=BPREC_$$RXNUM^BPSRPT6(BPRX)_$$COPAY^BPSRPT6(BPRX)_U ;RX Number
. S BPREC=BPREC_BPREF_"/"_$$ECMENUM^BPSRPT1($P(BPX,U,3))_U ;Refill/ECME Number
. S BPREC=BPREC_$$DATTIM^BPSRPT1(BPSRTDT)_U ;Date
. S BPREC=BPREC_$$INGRCST^BPSSCRLG(BP02)_U ;Ingredient Cost
. S BPREC=BPREC_$$DISPFEE^BPSSCRLG(BP02)_U ;Dispensing Fee
. S BPREC=BPREC_$TR($J(BPBIL,10,2)," ")_U ;$Billed
. S BPREC=BPREC_$$ICPAID^BPSSCRLG(BP03)_U ;Ingredient Cost Paid
. S BPREC=BPREC_$$DFPAID^BPSSCRLG(BP03)_U ;Dispensing Fee Paid
. S BPREC=BPREC_$TR($J(BPDPAY,10,2)," ")_U ;Pt. Resp (Ins)
. S BPREC=BPREC_$TR($J(BPINS,10,2)," ")_U ;$Ins. Paid
. S BPREC=BPREC_$S(BPCOLL]"":$TR($J(BPCOLL,10,2)," "),1:"")_U ;$Collected
Q
;
;Print Report Line 2
;
; Input Variable -> BPRTYPE,BPX,BPRX,BPREF,BPBIL,BPGRPLAN
;
WRLINE2(BPRTYPE,BPREC,BPX,BPRX,BPREF,BPBIL,BPGRPLAN,BPPSEQ) ;
N BP59,BP02
S BP59=$P(BPX,U,3)
S BP02=+$P($G(^BPST(BP59,0)),U,4)
;
I (BPRTYPE=1)!(BPRTYPE=4) D Q
. ;Drug
. S BPREC=BPREC_$$DRGNAM^BPSRPT6($P(BPX,U,14),15)_U
. S BPREC=BPREC_$TR($$GETNDC^BPSRPT6(BPRX,BPREF),"-")_U ;Released On
. S BPREC=BPREC_$$DATTIM^BPSRPT1(+BPX)_U
. ;RX INFO
. S BPREC=BPREC_$$MWC^BPSRPT6(BPRX,BPREF)_U ;Fill Location
. S BPREC=BPREC_$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($P(BPX,U,3)))_U ;Fill Type
. S BPREC=BPREC_$$RXSTATUS^BPSRPT6($P(BPX,U,3)) ;Status
. S BPREC=BPREC_$S($P(BPX,U):"/R",1:"/N")_U ;RL/NR
. I BPRTYPE=4 S BPREC=BPREC_$$RXCOB($G(BPPSEQ))_U
. S BPREC=BPREC_$S($P(BPX,U,13):"REJ",1:"")
. I BPRTYPE=1 S BPREC=BPREC_U_$$BILL^BPSRPT6(BPRX,BPREF,BPPSEQ)_U_$$RXCOB($G(BPPSEQ)) ;Bill # and RX COB
;
I BPRTYPE=2 D Q
. S BPREC=BPREC_$E($$GRPID^BPSRPT2(+$P(BPX,U,3)),3,10)_U ;Group ID
. S BPREC=BPREC_$$INGRCST^BPSSCRLG(BP02)_U ;Ingredient Cost
. S BPREC=BPREC_$$DISPFEE^BPSSCRLG(BP02)_U ;Dispensing Fee
. S BPREC=BPREC_$TR($J(BPBIL,10,2)," ")_U ;$Billed
. S BPREC=BPREC_$$QTY^BPSRPT6($P(BPX,U,3))_U ;Qty
. S BPREC=BPREC_$$GETNDC^BPSRPT6(BPRX,BPREF)_U ;NDC#
. S BPREC=BPREC_$$DRGNAM^BPSRPT6($P(BPX,U,14),15)_U ;Drug
;
I BPRTYPE=3 D Q
. S BPREC=BPREC_$$DRGNAM^BPSRPT6($P(BPX,U,14),15)_U ;Drug
. S BPREC=BPREC_$TR($$GETNDC^BPSRPT6(BPRX,BPREF),"-")_U
. ;RX INFO
. S BPREC=BPREC_$$MWC^BPSRPT6(BPRX,BPREF)_U ;Fill Location
. S BPREC=BPREC_$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($P(BPX,U,3)))_U ;Fill Type
. S BPREC=BPREC_$$RXSTATUS^BPSRPT6($P(BPX,U,3)) ;Status
. S BPREC=BPREC_$S($P(BPX,U):"/R",1:"/N")_U ;RL/NR
. S BPREC=BPREC_$$RXCOB($G(BPPSEQ))_U
. S BPREC=BPREC_$$ELIGCODE^BPSSCR05($P(BPX,U,3))_U ;Eligibility
. S BPREC=BPREC_$S($P(BPX,U,13):"REJ",1:"")
;
I BPRTYPE=5 D Q
. S BPREC=BPREC_$$DRGNAM^BPSRPT6($P(BPX,U,14),32)_U ;Drug
. S BPREC=BPREC_$TR($$GETNDC^BPSRPT6(BPRX,BPREF),"-")_U
. ;RX INFO
. S BPREC=BPREC_$$MWC^BPSRPT6(BPRX,BPREF)_U ;Fill Location
. S BPREC=BPREC_$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($P(BPX,U,3)))_U ;Fill Type
. S BPREC=BPREC_$$RXSTATUS^BPSRPT6($P(BPX,U,3)) ;Status
. S BPREC=BPREC_$S($P(BPX,U):"/R",1:"/N")_U ;RL/NR
. S BPREC=BPREC_$S($P(BPX,U,13):"REJ",1:"")_U
. I $P(BPGRPLAN,U,2)]"" S BPREC=BPREC_$E($P(BPGRPLAN,U,2),1,30) ;Insurance
. S BPREC=BPREC_U_$$ELAPSE^BPSRPT6($P(BPX,U,3)) ;Elapsed Time
;
I BPRTYPE=7 D Q
. S BPREC=BPREC_$E($$GRPID^BPSRPT2(+$P(BPX,U,3)),3,10)_U ;Group ID
. S BPREC=BPREC_$TR($J(BPBIL,10,2)," ")_U ;$Billed
. S BPREC=BPREC_$$DATTIM^BPSRPT1(+$$CLOSEDT^BPSRPT2(+$P(BPX,U,3)))_U ;Close Dt/Time
. S BPREC=BPREC_$E($$CLSBY^BPSRPT6(+$P(BPX,U,3)),1,25)_U ;Close By
. S BPREC=BPREC_$E($P($$CLRSN^BPSRPT7(+$P(BPX,U,3)),U,2),1,30)_U ;Close Reason
;
I BPRTYPE=8 D Q
. S BPREC=BPREC_$$DRGNAM^BPSRPT6($P(BPX,U,14),27)_U ;Drug
. S BPREC=BPREC_$$MWC^BPSRPT6(BPRX,BPREF)_" " ;Fill Location
. S BPREC=BPREC_$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($P(BPX,U,3)))_" " ;Fill Type
. S BPREC=BPREC_$$RXSTATUS^BPSRPT6($P(BPX,U,3)) ;Status
. S BPREC=BPREC_$S($P(BPX,U):"/R",1:"/N")_U ;RL/NR
. S BPREC=BPREC_$TR($E($$GRPID^BPSRPT2(+$P(BPX,U,3)),3,10)," ","")_U ;Group ID
. S BPREC=BPREC_$E(BPGRPLAN,1,30)_U ;Insurance
. S BPREC=BPREC_$$BILL^BPSRPT6(BPRX,BPREF,BPPSEQ)_U ;Bill#
;
I BPRTYPE=9 D Q
. S BPREC=BPREC_$$DRGNAM^BPSRPT6($P(BPX,U,4),15)_U ;Drug
. S BPREC=BPREC_$TR($$GETNDC^BPSRPT6(BPRX,BPREF),"-")_U ;NDC
. S BPREC=BPREC_$$DATTIM^BPSRPT1($P(BPX,U,5))_U ;Release Date
. S BPREC=BPREC_$$MWC^BPSRPT6(BPRX,BPREF)_U ;Fill Location
. S BPREC=BPREC_$$RXSTANAM^BPSSCRU2($P(BPX,U,6)) ;Status
. S BPREC=BPREC_$S($P(BPX,U,5):"/R",1:"/N")_U ;RL/NR
. S BPREC=BPREC_$$GET1^DIQ(366.17,$P(BPX,U,7),.01,"E") ;Non-Billable Status Reason - ICR 6136
;
I BPRTYPE=10 D Q
. N BPRXINFO,BPDUPST
. S BPDUPST=$P(BPX,U,16),BPRXINFO=""
. S BPREC=BPREC_$$DRGNAM^BPSRPT6($P(BPX,U,14),15)_U ;Drug
. S BPREC=BPREC_$TR($$GETNDC^BPSRPT6(BPRX,BPREF),"-")_U ;NDC
. S BPREC=BPREC_$$DATTIM^BPSRPT1(+BPX)_U ;Release Date
. ;RX INFO
. S BPREC=BPREC_$$MWC^BPSRPT6(BPRX,BPREF)_" " ;Fill Location
. S BPREC=BPREC_$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($P(BPX,U,3)))_" " ;Fill Type
. S BPREC=BPREC_$$RXSTATUS^BPSRPT6($P(BPX,U,3)) ;Status
. S BPREC=BPREC_$S($P(BPX,U):"/R",1:"/N")_U ;RL/NR
. ;
. S BPREC=BPREC_$$BILL^BPSRPT6(BPRX,BPREF,BPPSEQ)_U ;Bill#
. S BPREC=BPREC_$$RXCOB($G(BPPSEQ))_U ;RX COB
. S BPREC=BPREC_BPDUPST ;Status (duplicate)
Q
;
;Print Report Line 3
;
; Input Variable -> BPRTYPE,BPX
;
WRLINE3(BPRTYPE,BPREC,BPX) ;
N BP59,BPSARR,BPRJCNT,BPRJEXP,BPZZ,BPRICE
S BP59=+$P(BPX,U,3)
;
I (",7,")[BPRTYPE D Q
. S BPREC=BPREC_$$CLAIMID^BPSRPT2(BP59)_U ;Claim ID
. S BPRJCNT=$$REJTEXT^BPSRPT2(BP59,.BPSARR)
. S BPREC=BPREC_$S(BPRJCNT>1:"Y",1:"N") ;Mult Rej
. ;Write one record per reject/close code
. S:+BPRJCNT=0 BPRJCNT=1
. F BPZZ=1:1:BPRJCNT D
. . S BPREC2=$G(BPREC)_U_$P($G(BPSARR(BPZZ)),":")_U_$P($G(BPSARR(BPZZ)),":",2) W !,$E(BPREC2,1,255)
;
I (",2,")[BPRTYPE D Q
. S BPREC=BPREC_$P($$PRESCIN^BPSRPT6($P(BPX,U,3)),U)_U ;Prescriber ID
. S BPREC=BPREC_$E($P($$PRESCIN^BPSRPT6($P(BPX,U,3)),U,2),1,13)_U ;Prescriber Name (truncated to 13)
. S BPRJCNT=$$REJTEXT^BPSRPT2(BP59,.BPSARR)
. S BPREC=BPREC_$S(BPRJCNT>1:"Y",1:"N") ;Mult Rej
. ;Write one record per reject/close code
. S:+BPRJCNT=0 BPRJCNT=1
. F BPZZ=1:1:BPRJCNT S BPREC2="" D
. . S BPREC2=$G(BPREC)_U_$P($G(BPSARR(BPZZ)),":")_U_$P($G(BPSARR(BPZZ)),":",2) W !,$E(BPREC2,1,255)
;
I BPRTYPE=4 D
. ;Method
. I $$AUTOREV^BPSRPT1(BP59) S BPREC=BPREC_U_"AUTO"_U
. E S BPREC=BPREC_U_"REGULAR"_U
. ;Return Status
. I $P(BPX,U,15)["ACCEPTED" S BPREC=BPREC_"ACCEPTED"_U
. E S BPREC=BPREC_"REJECTED"_U
. ;Reason
. S BPREC=BPREC_$$RVSRSN^BPSRPT7(+$P(BPX,U,3))
;
I BPRTYPE=8 D
. S BPRICE=$$PRICEVAL^BPSRPT5(BP59)
. S BPREC=BPREC_$P($G(BPRICE),U,3)_U
. S BPREC=BPREC_$P($G(BPRICE),U,4)_U
. S BPREC=BPREC_$P($G(BPRICE),U,5)_U
. S BPREC=BPREC_$P($G(BPRICE),U,6)_U
. S BPREC=BPREC_$P($G(BPRICE),U,7)_U
. S BPREC=BPREC_$P($G(BPRICE),U,2)_U
. S BPREC=BPREC_$P($G(BPRICE),U,1)_U
;
;Write the record
I (",1,3,4,9,10,")[(","_BPRTYPE_",") W !,$E(BPREC,1,255) Q
W !,$G(BPREC)
Q
;
;Print Excel Header - was moved to BPSRPT8A
;
;return RX COB as the 1st letter of the RX COB indicator
RXCOB(BPPSEQ) ;
Q $S(BPPSEQ=1:"p",BPPSEQ=2:"s",1:"")
;BPSRPT8
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSRPT8 13676 printed Dec 13, 2024@01:52:49 Page 2
BPSRPT8 ;BHAM ISC/BEE - ECME REPORTS ;14-FEB-05
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,3,5,7,8,10,11,19,20,23,24,28**;JUN 2004;Build 22
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;Reference to IB NCPCP NON-BILLABLE STATUS REASONS (#366.17) supported by ICR 6136
+5 ;
+6 QUIT
+7 ;
+8 ;Routine to Display the Reports in Excel
+9 ;
+10 ;Print Report Line 1
+11 ;
+12 ; Input Variable -> BPRTYPE,BPDIV,BPGRPLAN,BPDFN,BPRX,BPREF,BPX,BPSRTDT
+13 ; BPBIL,BPINS,BPCOLL
+14 ;
WRLINE1(BPRTYPE,BPREC,BPDIV,BPGRPLAN,BPDFN,BPRX,BPREF,BPX,BPSRTDT,BPBIL,BPINS,BPCOLL,BPPSEQ) ;
+1 ;
+2 NEW BP59,BP02,BP03,BPREC2
+3 SET BP59=$PIECE(BPX,U,3)
+4 SET BP02=+$PIECE($GET(^BPST(BP59,0)),U,4)
+5 SET BP03=+$PIECE($GET(^BPST(BP59,0)),U,5)
+6 ;Division
+7 IF (",5,6,8,")[BPRTYPE
SET BPREC=$SELECT(BPDIV=0:"BLANK",$$DIVNAME^BPSSCRDS(BPDIV)]"":$$DIVNAME^BPSSCRDS(BPDIV),1:BPDIV)_U
+8 IF (",1,2,3,4,7,9,10,")[(","_BPRTYPE_",")
SET BPREC=$SELECT(BPDIV=0:"BLANK",$$DIVNAME^BPSSCRDS(BPDIV)]"":$EXTRACT($$DIVNAME^BPSSCRDS(BPDIV),1,12),1:$EXTRACT(BPDIV,1,12))_U
+9 ;
+10 ;Insurance
+11 IF BPRTYPE=8
SET BPREC=BPREC_$EXTRACT(BPGRPLAN,1,90)_U
+12 ;
+13 IF (",1,2,3,4,7,9,")[BPRTYPE
Begin DoDot:1
+14 ;Insurance
SET BPREC=BPREC_$EXTRACT(BPGRPLAN,1,21)_U
+15 ;BIN
IF BPRTYPE=2
SET BPREC=BPREC_$$INSBIN^BPSRPT6(BP59)_U
+16 ;Patient Name
SET BPREC=BPREC_$EXTRACT($$PATNAME^BPSRPT6(BPDFN),1,13)_U
+17 ;L4SSN
SET BPREC=BPREC_$$SSN4^BPSRPT6(BPDFN)_U
End DoDot:1
+18 ;
+19 IF (",5,6,8,")[BPRTYPE
Begin DoDot:1
+20 ;Patient Name
SET BPREC=BPREC_$$PATNAME^BPSRPT6(BPDFN)_U
+21 ;L4SSN
SET BPREC=BPREC_"("_$$SSN4^BPSRPT6(BPDFN)_")"_U
End DoDot:1
+22 ;
+23 IF (BPRTYPE=1)!(BPRTYPE=4)
Begin DoDot:1
+24 NEW PTRESP
+25 ;Eligibility
SET BPREC=BPREC_$$ELIGCODE^BPSSCR05($PIECE(BPX,U,3))_U
+26 ;RX Number
SET BPREC=BPREC_$$RXNUM^BPSRPT6(BPRX)_$$COPAY^BPSRPT6(BPRX)_U
+27 ;Refill/ECME Number
SET BPREC=BPREC_BPREF_"/"_$$ECMENUM^BPSRPT1($PIECE(BPX,U,3))_U
+28 ;Date
SET BPREC=BPREC_$$DATTIM^BPSRPT1(BPSRTDT)_U
+29 ;Ingredient Cost
SET BPREC=BPREC_$$INGRCST^BPSSCRLG(BP02)_U
+30 ;Dispensing Fee
SET BPREC=BPREC_$$DISPFEE^BPSSCRLG(BP02)_U
+31 ;$Billed
SET BPREC=BPREC_$TRANSLATE($JUSTIFY(BPBIL,10,2)," ")_U
+32 ;Ingredient Cost Paid
SET BPREC=BPREC_$$ICPAID^BPSSCRLG(BP03)_U
+33 ;Dispensing Fee Paid
SET BPREC=BPREC_$$DFPAID^BPSSCRLG(BP03)_U
+34 ;Patient Pay Amount
SET PTRESP=$$PTRESP^BPSSCRLG(BP03)
SET BPREC=BPREC_$SELECT('PTRESP:PTRESP,1:"-"_PTRESP)_U
+35 ;$Ins. Paid
SET BPREC=BPREC_$TRANSLATE($JUSTIFY(BPINS,10,2)," ")_U
+36 ;$Collected
SET BPREC=BPREC_$SELECT(BPCOLL]"":$TRANSLATE($JUSTIFY(BPCOLL,10,2)," "),1:"")_U
End DoDot:1
QUIT
+37 ;
+38 IF BPRTYPE=2
Begin DoDot:1
+39 ;Eligibility
SET BPREC=BPREC_$$ELIGCODE^BPSSCR05($PIECE(BPX,U,3))_U
+40 ;RX Number
SET BPREC=BPREC_$$RXNUM^BPSRPT6(BPRX)_$$COPAY^BPSRPT6(BPRX)_U
+41 ;Refill/ECME Number
SET BPREC=BPREC_BPREF_"/"_$$ECMENUM^BPSRPT1($PIECE(BPX,U,3))_U
+42 ;Date
SET BPREC=BPREC_$$DATTIM^BPSRPT1(BPSRTDT)_U
+43 ;Released On
SET BPREC=BPREC_$$DATTIM^BPSRPT1(+BPX)_U
+44 ;RX INFO
+45 ;Fill Location
SET BPREC=BPREC_$$MWC^BPSRPT6(BPRX,BPREF)_U
+46 ;Fill Type
SET BPREC=BPREC_$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($PIECE(BPX,U,3)))_U
+47 ;Status
SET BPREC=BPREC_$$RXSTATUS^BPSRPT6($PIECE(BPX,U,3))
+48 ;RL/NR
SET BPREC=BPREC_$SELECT($PIECE(BPX,U):"/R",1:"/N")_U
+49 SET BPREC=BPREC_$$RXCOB($GET(BPPSEQ))_U
+50 ;Open/Closed
SET BPREC=BPREC_$SELECT($$CLOSED02^BPSSCR03($PIECE(^BPST($PIECE(BPX,U,3),0),U,4))=1:"C",1:"O")_U
End DoDot:1
QUIT
+51 ;
+52 IF BPRTYPE=3
Begin DoDot:1
+53 NEW PTRESP
+54 ;RX Number
SET BPREC=BPREC_$$RXNUM^BPSRPT6(BPRX)_$$COPAY^BPSRPT6(BPRX)_U
+55 ;Refill/ECME Number
SET BPREC=BPREC_BPREF_"/"_$$ECMENUM^BPSRPT1($PIECE(BPX,U,3))_U
+56 ;Date
SET BPREC=BPREC_$$DATTIM^BPSRPT1(BPSRTDT)_U
+57 ;Ingredient Cost
SET BPREC=BPREC_$$INGRCST^BPSSCRLG(BP02)_U
+58 ;Dispensing Fee
SET BPREC=BPREC_$$DISPFEE^BPSSCRLG(BP02)_U
+59 ;$Billed
SET BPREC=BPREC_$TRANSLATE($JUSTIFY(BPBIL,10,2)," ")_U
+60 ;Ingredient Cost Paid
SET BPREC=BPREC_$$ICPAID^BPSSCRLG(BP03)_U
+61 ;Dispensing Fee Paid
SET BPREC=BPREC_$$DFPAID^BPSSCRLG(BP03)_U
+62 ;Patient Pay Amount
SET PTRESP=$$PTRESP^BPSSCRLG(BP03)
SET BPREC=BPREC_$SELECT('PTRESP:PTRESP,1:"-"_PTRESP)_U
+63 ;Insurance Response
SET BPREC=BPREC_$TRANSLATE($JUSTIFY(BPINS,10,2)," ")_U
End DoDot:1
QUIT
+64 ;
+65 IF BPRTYPE=5
Begin DoDot:1
+66 ;RX Number
SET BPREC=BPREC_$$RXNUM^BPSRPT6(BPRX)_$$COPAY^BPSRPT6(BPRX)_U
+67 ;Refill/ECME Number
SET BPREC=BPREC_BPREF_"/"_$$ECMENUM^BPSRPT1($PIECE(BPX,U,3))_U
+68 ;Completed
SET BPREC=BPREC_$$DATTIM^BPSRPT1($$TRANDT^BPSRPT2($PIECE(BPX,U,3),1))_U
+69 ;Trans Type
SET BPREC=BPREC_$$TTYPE^BPSRPT7($PIECE(BPX,U,4),$PIECE(BPX,U,5),BPPSEQ)_U
+70 ;Payer Response
SET BPREC=BPREC_$$RESPONSE^BPSRPT7($PIECE(BPX,U,4),$PIECE(BPX,U,5),BPPSEQ)_U
+71 ;RX COB
SET BPREC=BPREC_$$RXCOB($GET(BPPSEQ))_U
End DoDot:1
QUIT
+72 ;
+73 IF BPRTYPE=7
Begin DoDot:1
+74 ;RX INFO
+75 ;Eligibility
SET BPREC=BPREC_$$ELIGCODE^BPSSCR05($PIECE(BPX,U,3))_U
+76 ;RX Number
SET BPREC=BPREC_$$RXNUM^BPSRPT6(BPRX)_$$COPAY^BPSRPT6(BPRX)_U
+77 ;Refill/ECME Number
SET BPREC=BPREC_BPREF_"/"_$$ECMENUM^BPSRPT1($PIECE(BPX,U,3))_U
+78 ;Fill Location
SET BPREC=BPREC_$$MWC^BPSRPT6(BPRX,BPREF)_U
+79 ;Fill Type
SET BPREC=BPREC_$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($PIECE(BPX,U,3)))_U
+80 ;Status
SET BPREC=BPREC_$$RXSTATUS^BPSRPT6($PIECE(BPX,U,3))
+81 ;RL/NR
SET BPREC=BPREC_$SELECT($PIECE(BPX,U):"/R",1:"/N")_U
+82 SET BPREC=BPREC_$SELECT($PIECE(BPX,U,13):"REJ",1:"")_U
+83 ;Drug
SET BPREC=BPREC_$$DRGNAM^BPSRPT6($PIECE(BPX,U,14),15)_U
+84 SET BPREC=BPREC_$TRANSLATE($$GETNDC^BPSRPT6(BPRX,BPREF),"-")_U
End DoDot:1
QUIT
+85 ;
+86 IF (BPRTYPE=8)
Begin DoDot:1
+87 ;RX Number
SET BPREC=BPREC_$$RXNUM^BPSRPT6(BPRX)_$$COPAY^BPSRPT6(BPRX)_U
+88 ;Refill/ECME Number
SET BPREC=BPREC_BPREF_"/"_$$ECMENUM^BPSRPT1($PIECE(BPX,U,3))_U
+89 ;Date
SET BPREC=BPREC_$$DATTIM^BPSRPT1(BPSRTDT)_U
+90 ;$Billed
SET BPREC=BPREC_$TRANSLATE($JUSTIFY(BPBIL,10,2)," ")_U
+91 ;$Ins. Paid
SET BPREC=BPREC_$TRANSLATE($JUSTIFY(BPINS,10,2)," ")_U
+92 ;$Collected
SET BPREC=BPREC_$SELECT(BPCOLL]"":$TRANSLATE($JUSTIFY(BPCOLL,10,2)," "),1:"")_U
End DoDot:1
QUIT
+93 ;
+94 IF BPRTYPE=9
Begin DoDot:1
+95 NEW ELGCD
SET ELGCD=$PIECE(BPX,U,1)
+96 SET BPREC=BPREC_$SELECT(ELGCD="V":"VET",ELGCD="T":"TRI",ELGCD="C":"CVA",1:"UNK")_U
+97 ;RX Number
SET BPREC=BPREC_$$RXNUM^BPSRPT6(BPRX)_$$COPAY^BPSRPT6(BPRX)_U
+98 ;Refill
SET BPREC=BPREC_BPREF_U
+99 ;Date
SET BPREC=BPREC_$$DATTIM^BPSRPT1(BPSRTDT)_U
+100 ;$Drug Cost
SET BPREC=BPREC_$SELECT($PIECE(BPX,U,2)]"":$TRANSLATE($JUSTIFY($PIECE(BPX,U,2),10,2)," "),1:"")_U
End DoDot:1
QUIT
+101 ;
+102 IF BPRTYPE=10
Begin DoDot:1
+103 NEW BPDPAY
+104 SET BPDPAY=$PIECE(BPX,U,17)
+105 ;Insurance
SET BPREC=BPREC_$EXTRACT(BPGRPLAN,1,21)_U
+106 ;Patient Name
SET BPREC=BPREC_$EXTRACT($$PATNAME^BPSRPT6(BPDFN),1,13)_U
+107 ;L4SSN
SET BPREC=BPREC_$$SSN4^BPSRPT6(BPDFN)_U
+108 ;Eligibility
SET BPREC=BPREC_$$ELIGCODE^BPSSCR05($PIECE(BPX,U,3))_U
+109 ;RX Number
SET BPREC=BPREC_$$RXNUM^BPSRPT6(BPRX)_$$COPAY^BPSRPT6(BPRX)_U
+110 ;Refill/ECME Number
SET BPREC=BPREC_BPREF_"/"_$$ECMENUM^BPSRPT1($PIECE(BPX,U,3))_U
+111 ;Date
SET BPREC=BPREC_$$DATTIM^BPSRPT1(BPSRTDT)_U
+112 ;Ingredient Cost
SET BPREC=BPREC_$$INGRCST^BPSSCRLG(BP02)_U
+113 ;Dispensing Fee
SET BPREC=BPREC_$$DISPFEE^BPSSCRLG(BP02)_U
+114 ;$Billed
SET BPREC=BPREC_$TRANSLATE($JUSTIFY(BPBIL,10,2)," ")_U
+115 ;Ingredient Cost Paid
SET BPREC=BPREC_$$ICPAID^BPSSCRLG(BP03)_U
+116 ;Dispensing Fee Paid
SET BPREC=BPREC_$$DFPAID^BPSSCRLG(BP03)_U
+117 ;Pt. Resp (Ins)
SET BPREC=BPREC_$TRANSLATE($JUSTIFY(BPDPAY,10,2)," ")_U
+118 ;$Ins. Paid
SET BPREC=BPREC_$TRANSLATE($JUSTIFY(BPINS,10,2)," ")_U
+119 ;$Collected
SET BPREC=BPREC_$SELECT(BPCOLL]"":$TRANSLATE($JUSTIFY(BPCOLL,10,2)," "),1:"")_U
End DoDot:1
QUIT
+120 QUIT
+121 ;
+122 ;Print Report Line 2
+123 ;
+124 ; Input Variable -> BPRTYPE,BPX,BPRX,BPREF,BPBIL,BPGRPLAN
+125 ;
WRLINE2(BPRTYPE,BPREC,BPX,BPRX,BPREF,BPBIL,BPGRPLAN,BPPSEQ) ;
+1 NEW BP59,BP02
+2 SET BP59=$PIECE(BPX,U,3)
+3 SET BP02=+$PIECE($GET(^BPST(BP59,0)),U,4)
+4 ;
+5 IF (BPRTYPE=1)!(BPRTYPE=4)
Begin DoDot:1
+6 ;Drug
+7 SET BPREC=BPREC_$$DRGNAM^BPSRPT6($PIECE(BPX,U,14),15)_U
+8 ;Released On
SET BPREC=BPREC_$TRANSLATE($$GETNDC^BPSRPT6(BPRX,BPREF),"-")_U
+9 SET BPREC=BPREC_$$DATTIM^BPSRPT1(+BPX)_U
+10 ;RX INFO
+11 ;Fill Location
SET BPREC=BPREC_$$MWC^BPSRPT6(BPRX,BPREF)_U
+12 ;Fill Type
SET BPREC=BPREC_$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($PIECE(BPX,U,3)))_U
+13 ;Status
SET BPREC=BPREC_$$RXSTATUS^BPSRPT6($PIECE(BPX,U,3))
+14 ;RL/NR
SET BPREC=BPREC_$SELECT($PIECE(BPX,U):"/R",1:"/N")_U
+15 IF BPRTYPE=4
SET BPREC=BPREC_$$RXCOB($GET(BPPSEQ))_U
+16 SET BPREC=BPREC_$SELECT($PIECE(BPX,U,13):"REJ",1:"")
+17 ;Bill # and RX COB
IF BPRTYPE=1
SET BPREC=BPREC_U_$$BILL^BPSRPT6(BPRX,BPREF,BPPSEQ)_U_$$RXCOB($GET(BPPSEQ))
End DoDot:1
QUIT
+18 ;
+19 IF BPRTYPE=2
Begin DoDot:1
+20 ;Group ID
SET BPREC=BPREC_$EXTRACT($$GRPID^BPSRPT2(+$PIECE(BPX,U,3)),3,10)_U
+21 ;Ingredient Cost
SET BPREC=BPREC_$$INGRCST^BPSSCRLG(BP02)_U
+22 ;Dispensing Fee
SET BPREC=BPREC_$$DISPFEE^BPSSCRLG(BP02)_U
+23 ;$Billed
SET BPREC=BPREC_$TRANSLATE($JUSTIFY(BPBIL,10,2)," ")_U
+24 ;Qty
SET BPREC=BPREC_$$QTY^BPSRPT6($PIECE(BPX,U,3))_U
+25 ;NDC#
SET BPREC=BPREC_$$GETNDC^BPSRPT6(BPRX,BPREF)_U
+26 ;Drug
SET BPREC=BPREC_$$DRGNAM^BPSRPT6($PIECE(BPX,U,14),15)_U
End DoDot:1
QUIT
+27 ;
+28 IF BPRTYPE=3
Begin DoDot:1
+29 ;Drug
SET BPREC=BPREC_$$DRGNAM^BPSRPT6($PIECE(BPX,U,14),15)_U
+30 SET BPREC=BPREC_$TRANSLATE($$GETNDC^BPSRPT6(BPRX,BPREF),"-")_U
+31 ;RX INFO
+32 ;Fill Location
SET BPREC=BPREC_$$MWC^BPSRPT6(BPRX,BPREF)_U
+33 ;Fill Type
SET BPREC=BPREC_$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($PIECE(BPX,U,3)))_U
+34 ;Status
SET BPREC=BPREC_$$RXSTATUS^BPSRPT6($PIECE(BPX,U,3))
+35 ;RL/NR
SET BPREC=BPREC_$SELECT($PIECE(BPX,U):"/R",1:"/N")_U
+36 SET BPREC=BPREC_$$RXCOB($GET(BPPSEQ))_U
+37 ;Eligibility
SET BPREC=BPREC_$$ELIGCODE^BPSSCR05($PIECE(BPX,U,3))_U
+38 SET BPREC=BPREC_$SELECT($PIECE(BPX,U,13):"REJ",1:"")
End DoDot:1
QUIT
+39 ;
+40 IF BPRTYPE=5
Begin DoDot:1
+41 ;Drug
SET BPREC=BPREC_$$DRGNAM^BPSRPT6($PIECE(BPX,U,14),32)_U
+42 SET BPREC=BPREC_$TRANSLATE($$GETNDC^BPSRPT6(BPRX,BPREF),"-")_U
+43 ;RX INFO
+44 ;Fill Location
SET BPREC=BPREC_$$MWC^BPSRPT6(BPRX,BPREF)_U
+45 ;Fill Type
SET BPREC=BPREC_$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($PIECE(BPX,U,3)))_U
+46 ;Status
SET BPREC=BPREC_$$RXSTATUS^BPSRPT6($PIECE(BPX,U,3))
+47 ;RL/NR
SET BPREC=BPREC_$SELECT($PIECE(BPX,U):"/R",1:"/N")_U
+48 SET BPREC=BPREC_$SELECT($PIECE(BPX,U,13):"REJ",1:"")_U
+49 ;Insurance
IF $PIECE(BPGRPLAN,U,2)]""
SET BPREC=BPREC_$EXTRACT($PIECE(BPGRPLAN,U,2),1,30)
+50 ;Elapsed Time
SET BPREC=BPREC_U_$$ELAPSE^BPSRPT6($PIECE(BPX,U,3))
End DoDot:1
QUIT
+51 ;
+52 IF BPRTYPE=7
Begin DoDot:1
+53 ;Group ID
SET BPREC=BPREC_$EXTRACT($$GRPID^BPSRPT2(+$PIECE(BPX,U,3)),3,10)_U
+54 ;$Billed
SET BPREC=BPREC_$TRANSLATE($JUSTIFY(BPBIL,10,2)," ")_U
+55 ;Close Dt/Time
SET BPREC=BPREC_$$DATTIM^BPSRPT1(+$$CLOSEDT^BPSRPT2(+$PIECE(BPX,U,3)))_U
+56 ;Close By
SET BPREC=BPREC_$EXTRACT($$CLSBY^BPSRPT6(+$PIECE(BPX,U,3)),1,25)_U
+57 ;Close Reason
SET BPREC=BPREC_$EXTRACT($PIECE($$CLRSN^BPSRPT7(+$PIECE(BPX,U,3)),U,2),1,30)_U
End DoDot:1
QUIT
+58 ;
+59 IF BPRTYPE=8
Begin DoDot:1
+60 ;Drug
SET BPREC=BPREC_$$DRGNAM^BPSRPT6($PIECE(BPX,U,14),27)_U
+61 ;Fill Location
SET BPREC=BPREC_$$MWC^BPSRPT6(BPRX,BPREF)_" "
+62 ;Fill Type
SET BPREC=BPREC_$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($PIECE(BPX,U,3)))_" "
+63 ;Status
SET BPREC=BPREC_$$RXSTATUS^BPSRPT6($PIECE(BPX,U,3))
+64 ;RL/NR
SET BPREC=BPREC_$SELECT($PIECE(BPX,U):"/R",1:"/N")_U
+65 ;Group ID
SET BPREC=BPREC_$TRANSLATE($EXTRACT($$GRPID^BPSRPT2(+$PIECE(BPX,U,3)),3,10)," ","")_U
+66 ;Insurance
SET BPREC=BPREC_$EXTRACT(BPGRPLAN,1,30)_U
+67 ;Bill#
SET BPREC=BPREC_$$BILL^BPSRPT6(BPRX,BPREF,BPPSEQ)_U
End DoDot:1
QUIT
+68 ;
+69 IF BPRTYPE=9
Begin DoDot:1
+70 ;Drug
SET BPREC=BPREC_$$DRGNAM^BPSRPT6($PIECE(BPX,U,4),15)_U
+71 ;NDC
SET BPREC=BPREC_$TRANSLATE($$GETNDC^BPSRPT6(BPRX,BPREF),"-")_U
+72 ;Release Date
SET BPREC=BPREC_$$DATTIM^BPSRPT1($PIECE(BPX,U,5))_U
+73 ;Fill Location
SET BPREC=BPREC_$$MWC^BPSRPT6(BPRX,BPREF)_U
+74 ;Status
SET BPREC=BPREC_$$RXSTANAM^BPSSCRU2($PIECE(BPX,U,6))
+75 ;RL/NR
SET BPREC=BPREC_$SELECT($PIECE(BPX,U,5):"/R",1:"/N")_U
+76 ;Non-Billable Status Reason - ICR 6136
SET BPREC=BPREC_$$GET1^DIQ(366.17,$PIECE(BPX,U,7),.01,"E")
End DoDot:1
QUIT
+77 ;
+78 IF BPRTYPE=10
Begin DoDot:1
+79 NEW BPRXINFO,BPDUPST
+80 SET BPDUPST=$PIECE(BPX,U,16)
SET BPRXINFO=""
+81 ;Drug
SET BPREC=BPREC_$$DRGNAM^BPSRPT6($PIECE(BPX,U,14),15)_U
+82 ;NDC
SET BPREC=BPREC_$TRANSLATE($$GETNDC^BPSRPT6(BPRX,BPREF),"-")_U
+83 ;Release Date
SET BPREC=BPREC_$$DATTIM^BPSRPT1(+BPX)_U
+84 ;RX INFO
+85 ;Fill Location
SET BPREC=BPREC_$$MWC^BPSRPT6(BPRX,BPREF)_" "
+86 ;Fill Type
SET BPREC=BPREC_$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($PIECE(BPX,U,3)))_" "
+87 ;Status
SET BPREC=BPREC_$$RXSTATUS^BPSRPT6($PIECE(BPX,U,3))
+88 ;RL/NR
SET BPREC=BPREC_$SELECT($PIECE(BPX,U):"/R",1:"/N")_U
+89 ;
+90 ;Bill#
SET BPREC=BPREC_$$BILL^BPSRPT6(BPRX,BPREF,BPPSEQ)_U
+91 ;RX COB
SET BPREC=BPREC_$$RXCOB($GET(BPPSEQ))_U
+92 ;Status (duplicate)
SET BPREC=BPREC_BPDUPST
End DoDot:1
QUIT
+93 QUIT
+94 ;
+95 ;Print Report Line 3
+96 ;
+97 ; Input Variable -> BPRTYPE,BPX
+98 ;
WRLINE3(BPRTYPE,BPREC,BPX) ;
+1 NEW BP59,BPSARR,BPRJCNT,BPRJEXP,BPZZ,BPRICE
+2 SET BP59=+$PIECE(BPX,U,3)
+3 ;
+4 IF (",7,")[BPRTYPE
Begin DoDot:1
+5 ;Claim ID
SET BPREC=BPREC_$$CLAIMID^BPSRPT2(BP59)_U
+6 SET BPRJCNT=$$REJTEXT^BPSRPT2(BP59,.BPSARR)
+7 ;Mult Rej
SET BPREC=BPREC_$SELECT(BPRJCNT>1:"Y",1:"N")
+8 ;Write one record per reject/close code
+9 if +BPRJCNT=0
SET BPRJCNT=1
+10 FOR BPZZ=1:1:BPRJCNT
Begin DoDot:2
+11 SET BPREC2=$GET(BPREC)_U_$PIECE($GET(BPSARR(BPZZ)),":")_U_$PIECE($GET(BPSARR(BPZZ)),":",2)
WRITE !,$EXTRACT(BPREC2,1,255)
End DoDot:2
End DoDot:1
QUIT
+12 ;
+13 IF (",2,")[BPRTYPE
Begin DoDot:1
+14 ;Prescriber ID
SET BPREC=BPREC_$PIECE($$PRESCIN^BPSRPT6($PIECE(BPX,U,3)),U)_U
+15 ;Prescriber Name (truncated to 13)
SET BPREC=BPREC_$EXTRACT($PIECE($$PRESCIN^BPSRPT6($PIECE(BPX,U,3)),U,2),1,13)_U
+16 SET BPRJCNT=$$REJTEXT^BPSRPT2(BP59,.BPSARR)
+17 ;Mult Rej
SET BPREC=BPREC_$SELECT(BPRJCNT>1:"Y",1:"N")
+18 ;Write one record per reject/close code
+19 if +BPRJCNT=0
SET BPRJCNT=1
+20 FOR BPZZ=1:1:BPRJCNT
SET BPREC2=""
Begin DoDot:2
+21 SET BPREC2=$GET(BPREC)_U_$PIECE($GET(BPSARR(BPZZ)),":")_U_$PIECE($GET(BPSARR(BPZZ)),":",2)
WRITE !,$EXTRACT(BPREC2,1,255)
End DoDot:2
End DoDot:1
QUIT
+22 ;
+23 IF BPRTYPE=4
Begin DoDot:1
+24 ;Method
+25 IF $$AUTOREV^BPSRPT1(BP59)
SET BPREC=BPREC_U_"AUTO"_U
+26 IF '$TEST
SET BPREC=BPREC_U_"REGULAR"_U
+27 ;Return Status
+28 IF $PIECE(BPX,U,15)["ACCEPTED"
SET BPREC=BPREC_"ACCEPTED"_U
+29 IF '$TEST
SET BPREC=BPREC_"REJECTED"_U
+30 ;Reason
+31 SET BPREC=BPREC_$$RVSRSN^BPSRPT7(+$PIECE(BPX,U,3))
End DoDot:1
+32 ;
+33 IF BPRTYPE=8
Begin DoDot:1
+34 SET BPRICE=$$PRICEVAL^BPSRPT5(BP59)
+35 SET BPREC=BPREC_$PIECE($GET(BPRICE),U,3)_U
+36 SET BPREC=BPREC_$PIECE($GET(BPRICE),U,4)_U
+37 SET BPREC=BPREC_$PIECE($GET(BPRICE),U,5)_U
+38 SET BPREC=BPREC_$PIECE($GET(BPRICE),U,6)_U
+39 SET BPREC=BPREC_$PIECE($GET(BPRICE),U,7)_U
+40 SET BPREC=BPREC_$PIECE($GET(BPRICE),U,2)_U
+41 SET BPREC=BPREC_$PIECE($GET(BPRICE),U,1)_U
End DoDot:1
+42 ;
+43 ;Write the record
+44 IF (",1,3,4,9,10,")[(","_BPRTYPE_",")
WRITE !,$EXTRACT(BPREC,1,255)
QUIT
+45 WRITE !,$GET(BPREC)
+46 QUIT
+47 ;
+48 ;Print Excel Header - was moved to BPSRPT8A
+49 ;
+50 ;return RX COB as the 1st letter of the RX COB indicator
RXCOB(BPPSEQ) ;
+1 QUIT $SELECT(BPPSEQ=1:"p",BPPSEQ=2:"s",1:"")
+2 ;BPSRPT8
