BPSRPT8.m

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 ---BPSRPT8   13676     printed  Apr 23, 2025@18:07:18                                                                                                                                                                                                    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