BPSRPT5A.m

BPSRPT5A ;AITC/CKB - ECME REPORTS ;3/9/2020

 ;;1.0;E CLAIMS MGMT ENGINE;**28**;JUN 2004;Build 22

 ;;Per VA Directive 6402, this routine should not be modified.

 ;

 ;

 ;Routine to Display the Detailed Lines of the Report, the code was moved from BPSRPT5 

 ;

 ;Print Report Line 1

WRLINE1(BPRTYPE,BPREC,BPDIV,BPGRPLAN,BPDFN,BPRX,BPREF,BPX,BPSRTDT,BPBIL,BPINS,BPCOLL,BPEXCEL,BPPSEQ) ;

 ;Excel Output

 I $G(BPEXCEL) D WRLINE1^BPSRPT8(BPRTYPE,.BPREC,BPDIV,BPGRPLAN,BPDFN,BPRX,BPREF,BPX,BPSRTDT,BPBIL,BPINS,BPCOLL,BPPSEQ) Q

 ;Report Output

 W !,$$PATNAME^BPSRPT6(BPDFN)

 W ?27,"("_$$SSN4^BPSRPT6(BPDFN)_")"

 I (BPRTYPE=1)!(BPRTYPE=4) D  Q

 . N ELGCD S ELGCD=$$ELIGCODE^BPSSCR05($P(BPX,U,3))

 . W ?35,$S(ELGCD="V":"VET",ELGCD="T":"TRI",ELGCD="C":"CVA",1:"UNK")

 . W ?40,$$RXNUM^BPSRPT6(BPRX)_$$COPAY^BPSRPT6(BPRX)

 . W ?52,BPREF,"/",$$ECMENUM^BPSRPT1($P(BPX,U,3))

 . W ?73,$$DATTIM^BPSRPT1(BPSRTDT)

 . W ?83,$J(BPBIL,10,2),?105,$J(BPINS,10,2),?122,$S(BPCOLL]"":$J(BPCOLL,10,2),1:"")

 I BPRTYPE=2 D  Q

 . N ELGCD S ELGCD=$$ELIGCODE^BPSSCR05($P(BPX,U,3))

 . W ?35,$S(ELGCD="V":"VET",ELGCD="T":"TRI",ELGCD="C":"CVA",1:"UNK")

 . W ?40,$$RXNUM^BPSRPT6(BPRX)_$$COPAY^BPSRPT6(BPRX)

 . W ?52,BPREF,"/",$$ECMENUM^BPSRPT1($P(BPX,U,3))

 . W ?73,$$DATTIM^BPSRPT1(BPSRTDT)

 . W ?83,$$DATTIM^BPSRPT1(+BPX)

 . W ?96,$$MWC^BPSRPT6(BPRX,BPREF)

 . W ?99,$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($P(BPX,U,3)))

 . W ?103,$$RXSTATUS^BPSRPT6($P(BPX,U,3))

 . W ?105,$S($P(BPX,U):"/R",1:"/N")

 . W ?114,$$RXCOB^BPSRPT8(BPPSEQ)

 . W ?121,$S($$CLOSED02^BPSSCR03($P(^BPST($P(BPX,U,3),0),U,4))=1:"Closed",1:"Open")

 I BPRTYPE=3 D  Q

 . W ?35,$$RXNUM^BPSRPT6(BPRX)_$$COPAY^BPSRPT6(BPRX)

 . W ?47,BPREF,"/",$$ECMENUM^BPSRPT1($P(BPX,U,3))

 . W ?68,$$DATTIM^BPSRPT1(BPSRTDT)

 . W ?100,$J(BPBIL,10,2),?122,$J(BPINS,10,2)

 I BPRTYPE=5 D  Q

 . W ?35,$$RXNUM^BPSRPT6(BPRX)_$$COPAY^BPSRPT6(BPRX)

 . W ?47,BPREF,"/",$$ECMENUM^BPSRPT1($P(BPX,U,3))

 . W ?65,$$DATTIM^BPSRPT1($$TRANDT^BPSRPT2($P(BPX,U,3),1))

 . W ?83,$$TTYPE^BPSRPT7($P(BPX,U,4),$P(BPX,U,5),BPPSEQ)

 . W ?100,$$RESPONSE^BPSRPT7($P(BPX,U,4),$P(BPX,U,5),BPPSEQ)

 . W ?125,$$RXCOB^BPSRPT8(BPPSEQ)

 I BPRTYPE=7 D  Q

 . N ELGCD S ELGCD=$$ELIGCODE^BPSSCR05($P(BPX,U,3))

 . W ?35,$S(ELGCD="V":"VET",ELGCD="T":"TRI",ELGCD="C":"CVA",1:"UNK")

 . W ?40,$$RXNUM^BPSRPT6(BPRX)_$$COPAY^BPSRPT6(BPRX)

 . W ?52,BPREF,"/",$$ECMENUM^BPSRPT1($P(BPX,U,3))

 . W ?70,$$MWC^BPSRPT6(BPRX,BPREF)

 . W ?73,$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($P(BPX,U,3)))

 . W ?77,$$RXSTATUS^BPSRPT6($P(BPX,U,3))

 . W ?79,$S($P(BPX,U):"/R",1:"/N")

 . W ?84,$S($P(BPX,U,13):"REJ",1:"")

 . W ?89,$$DRGNAM^BPSRPT6($P(BPX,U,14),27)

 . W ?118,$$GETNDC^BPSRPT6(BPRX,BPREF)

 I BPRTYPE=8 D

 . W ?35,$$RXNUM^BPSRPT6(BPRX)_$$COPAY^BPSRPT6(BPRX)

 . W ?47,BPREF,"/",$$ECMENUM^BPSRPT1($P(BPX,U,3))

 . W ?68,$$DATTIM^BPSRPT1(BPSRTDT)

 . W ?78,$J(BPBIL,10,2),?100,$J(BPINS,10,2),?122,$S(BPCOLL]"":$J(BPCOLL,10,2),1:"")

 I BPRTYPE=9 D  Q

 . N ELGCD S ELGCD=$P(BPX,U,1)

 . W ?35,$S(ELGCD="V":"VET",ELGCD="T":"TRI",ELGCD="C":"CVA",1:"UNK") ; Eligibility

 . W ?40,$$RXNUM^BPSRPT6(BPRX)_$$COPAY^BPSRPT6(BPRX)  ; RX and Copay indicator

 . W ?52,BPREF                     ; Refill

 . W ?64,$$DATTIM^BPSRPT1(BPSRTDT) ; Transaction Date

 . W ?84,$J($P(BPX,U,2),10,2)      ; Drug Cost

 I BPRTYPE=10 D  Q

 . N ELGCD,BPDUPPAY

 . S BPDUPPAY=$P(BPX,U,17)

 . S ELGCD=$$ELIGCODE^BPSSCR05($P(BPX,U,3))

 . W ?35,$S(ELGCD="V":"VET",ELGCD="T":"TRI",ELGCD="C":"CVA",1:"UNK") ; Eligibility

 . W ?45,BPREF,"/",$$ECMENUM^BPSRPT1($P(BPX,U,3)) ; Refill/ECME#

 . W ?65,$$DATTIM^BPSRPT1(BPSRTDT)                ; Transaction Date

 . W ?77,$J(BPBIL,10,2)                           ; $Billed

 . W ?90,$J(BPINS,13,2)                           ; $Ins Response

 . W ?106,$S(BPCOLL]"":$J(BPCOLL,10,2),1:"")      ; $Collected

 . W ?118,$J(BPDUPPAY,12,2)                       ; Pt. Resp (Ins)

 Q

 ;

 ;Print Report Line 2

WRLINE2(BPRTYPE,BPREC,BPX,BPRX,BPREF,BPBIL,BPGRPLAN,BPEXCEL,BPICNT,BPPSEQ) ;

 ;Excel Output

 N BPSX

 I $G(BPEXCEL) D WRLINE2^BPSRPT8(BPRTYPE,.BPREC,BPX,BPRX,BPREF,BPBIL,BPGRPLAN,BPPSEQ) Q

 ;Report Output

 I (BPRTYPE=1)!(BPRTYPE=4) D  Q

 . W !,?4,$$DRGNAM^BPSRPT6($P(BPX,U,14),27),?32,$$GETNDC^BPSRPT6(BPRX,BPREF)

 . I BPRTYPE=1 W ?47,$$DATTIM^BPSRPT1(+BPX)

 . W ?68,$$MWC^BPSRPT6(BPRX,BPREF)

 . W ?71,$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($P(BPX,U,3)))

 . W ?75,$$RXSTATUS^BPSRPT6($P(BPX,U,3))

 . W ?77,$S($P(BPX,U):"/R",1:"/N")

 . W ?82,$S($P(BPX,U,13):"REJ",1:"")

 . I BPRTYPE=4 W ?92,$$RXCOB^BPSRPT8(BPPSEQ)

 . I BPRTYPE=1 W ?115,$$BILLCOB^BPSRPT5(BPRX,BPREF,BPPSEQ)

 I BPRTYPE=2 D  Q

 . W !,?3,$E($$CRDHLDID^BPSRPT2(+$P(BPX,U,3)),3,23)

 . W ?26,$E($$GRPID^BPSRPT2(+$P(BPX,U,3)),3,17)

 . W ?41,$J(BPBIL,10,2)

 . W ?54,$$QTY^BPSRPT6($P(BPX,U,3))

 . W ?61,$$GETNDC^BPSRPT6(BPRX,BPREF)

 . S BPSX=$$PRESCIN^BPSRPT6($P(BPX,U,3))

 . W ?82,$P(BPSX,U),?98,$P(BPSX,U,2)

 I BPRTYPE=3 D  Q

 . W !,?4,$$DRGNAM^BPSRPT6($P(BPX,U,14),32)

 . W ?41,$$GETNDC^BPSRPT6(BPRX,BPREF)

 . W ?68,$$MWC^BPSRPT6(BPRX,BPREF)

 . W ?71,$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($P(BPX,U,3)))

 . W ?74,$$RXSTATUS^BPSRPT6($P(BPX,U,3))

 . W ?76,$S($P(BPX,U):"/R",1:"/N")

 . W ?81,$S($P(BPX,U,13):"REJ",1:"")

 . W ?88,$$RXCOB^BPSRPT8(BPPSEQ)

 . N ELGCD S ELGCD=$$ELIGCODE^BPSSCR05($P(BPX,U,3))

 . W ?96,$S(ELGCD="V":"VET",ELGCD="T":"TRI",ELGCD="C":"CVA",1:"UNK")

 I BPRTYPE=5 D  Q

 . W !,?4,$$DRGNAM^BPSRPT6($P(BPX,U,14),23)

 . W ?28,$$GETNDC^BPSRPT6(BPRX,BPREF)

 . W ?47,$$MWC^BPSRPT6(BPRX,BPREF)

 . W ?50,$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($P(BPX,U,3)))

 . W ?53,$$RXSTATUS^BPSRPT6($P(BPX,U,3))

 . W ?55,$S($P(BPX,U):"/R",1:"/N")

 . W ?60,$S($P(BPX,U,13):"REJ",1:"")

 . I $P(BPGRPLAN,U,2)]"" W ?69,$E($P(BPGRPLAN,U,2),1,30)

 . W ?122,$J($$ELAPSE^BPSRPT6($P(BPX,U,3)),10)

 I BPRTYPE=7 D  Q

 . W !,?3,$E($$CRDHLDID^BPSRPT2(+$P(BPX,U,3)),3,23)

 . W ?28,$E($$GRPID^BPSRPT2(+$P(BPX,U,3)),3,17)

 . W ?46,$$DATTIM^BPSRPT1(+$$CLOSEDT^BPSRPT2(+$P(BPX,U,3)))

 . N BPCLBY S BPCLBY=$E($$CLSBY^BPSRPT6(+$P(BPX,U,3)),1,25) S:BPCLBY="" BPCLBY="BLANK"

 . W ?65,BPCLBY S BPCNT(BPCLBY)=$G(BPCNT(BPCLBY))+1,BPGCNT(BPCLBY)=$G(BPGCNT(BPCLBY))+1,BPICNT(BPCLBY)=$G(BPICNT(BPCLBY))+1

 . W ?93,$E($P($$CLRSN^BPSRPT7(+$P(BPX,U,3)),U,2),1,30)

 . W ?128,$$RXCOB^BPSRPT8(BPPSEQ)

 I BPRTYPE=8 D  Q

 . W !,?2,$$DRGNAM^BPSRPT6($P(BPX,U,14),34)

 . W ?38,$$MWC^BPSRPT6(BPRX,BPREF)

 . W ?42,$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($P(BPX,U,3)))

 . W ?46,$$RXSTATUS^BPSRPT6($P(BPX,U,3))

 . W ?48,$S($P(BPX,U):"/R",1:"/N")

 . W ?54,$E($$GRPID^BPSRPT2(+$P(BPX,U,3)),3,10)

 . W ?72,$E(BPGRPLAN,1,50)

 . W ?125,$$BILL^BPSRPT6(BPRX,BPREF,BPPSEQ)

 I BPRTYPE=9 D  Q

 . W !,?4,$$DRGNAM^BPSRPT6($P(BPX,U,4),27) ;Drug

 . W ?32,$$GETNDC^BPSRPT6(BPRX,BPREF)  ;NDC

 . W ?47,$$DATTIM^BPSRPT1($P(BPX,U,5)) ;Release Date

 . W ?62,$$MWC^BPSRPT6(BPRX,BPREF)     ;Fill Location

 . W ?65,$$RXSTANAM^BPSSCRU2($P(BPX,U,6))  ;Status

 . W ?67,$S($P(BPX,U,5):"/R",1:"/N")   ;Released

 . W ?75,$E($$GET1^DIQ(366.17,$P(BPX,U,7),.01,"E"),1,57) ;Non-Billalble Reason - ICR 6136

 I BPRTYPE=10 D  Q

 . N BPDUPST

 . S BPDUPST=$P(BPX,U,16)

 . W !,?4,$$DRGNAM^BPSRPT6($P(BPX,U,14),27) ; Drug

 . W ?32,$$GETNDC^BPSRPT6(BPRX,BPREF)       ; NDC

 . W ?47,$$DATTIM^BPSRPT1(+BPX)             ; Released On Date

 . W ?68,$$MWC^BPSRPT6(BPRX,BPREF)          ; Fill Location

 . W ?71,$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($P(BPX,U,3)))

 . W ?75,$$RXSTATUS^BPSRPT6($P(BPX,U,3))

 . W ?77,$S($P(BPX,U):"/R",1:"/N")

 . W ?82,$S($P(BPX,U,13):"REJ",1:"")

 . W ?94,$$BILL^BPSRPT6(BPRX,BPREF,BPPSEQ)   ; Bill #

 . W ?113,$$RXCOB^BPSRPT8(BPPSEQ)            ; COB

 . W ?122,BPDUPST                            ; Status (Duplicate Trans Status)

 Q

 ;

 ;Print Report Line 3

WRLINE3(BPRTYPE,BPREC,BPX,BPEXCEL) N BP59,BPRICINF

 S BP59=+$P(BPX,U,3)

 ;Excel Output

 I $G(BPEXCEL) D WRLINE3^BPSRPT8(BPRTYPE,.BPREC,BPX) Q

 ;Report Output

 I BPRTYPE=4 D  Q

 . S NP=$$CHKP^BPSRPT5(1) Q:BPQ

 . ;Released On

 . W !,?6,$$DATTIM^BPSRPT1(+BPX)

 . ;Method

 . I $$AUTOREV^BPSRPT1(BP59) W ?22,"AUTO/"

 . E  W ?22,"REGULAR/"

 . ;Return Status

 . I $P(BPX,U,15)["ACCEPTED" W "ACCEPTED/"

 . E  W "REJECTED/"

 . ;Reason

 . W $$RVSRSN^BPSRPT7(+$P(BPX,U,3))

 ;

 I BPRTYPE=8 D  Q

 . S BPRICINF=$$PRICEVAL^BPSRPT5(BP59)

 . W !,?4,$S($P(BPRICINF,U,3)]"":$P(BPRICINF,U,3),1:"N/A")

 . W ?23,$S($P(BPRICINF,U,4)]"":$P(BPRICINF,U,4),1:"N/A")

 . W ?38,$S($P(BPRICINF,U,5)]"":$P(BPRICINF,U,5),1:"N/A")

 . W ?56,$S($P(BPRICINF,U,6)]"":$P(BPRICINF,U,6),1:"N/A")

 . W ?81,$S($P(BPRICINF,U,7)]"":$P(BPRICINF,U,7),1:"N/A")

 . W ?96,$S($P(BPRICINF,U,2)]"":$P(BPRICINF,U,2),1:"N/A")

 . W ?111,$S($P(BPRICINF,U,1)]"":$P(BPRICINF,U,1),1:"N/A")

 ;

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---BPSRPT5A   8713     printed  Dec 13, 2024@01:52:46                                                                                                                                                                                                    Page 2

BPSRPT5A  ;AITC/CKB - ECME REPORTS ;3/9/2020

 +1       ;;1.0;E CLAIMS MGMT ENGINE;**28**;JUN 2004;Build 22

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ;

 +4       ;

 +5       ;Routine to Display the Detailed Lines of the Report, the code was moved from BPSRPT5 

 +6       ;

 +7       ;Print Report Line 1

WRLINE1(BPRTYPE,BPREC,BPDIV,BPGRPLAN,BPDFN,BPRX,BPREF,BPX,BPSRTDT,BPBIL,BPINS,BPCOLL,BPEXCEL,BPPSEQ) ;

 +1       ;Excel Output

 +2        IF $GET(BPEXCEL)

               DO WRLINE1^BPSRPT8(BPRTYPE,.BPREC,BPDIV,BPGRPLAN,BPDFN,BPRX,BPREF,BPX,BPSRTDT,BPBIL,BPINS,BPCOLL,BPPSEQ)

               QUIT 

 +3       ;Report Output

 +4        WRITE !,$$PATNAME^BPSRPT6(BPDFN)

 +5        WRITE ?27,"("_$$SSN4^BPSRPT6(BPDFN)_")"

 +6        IF (BPRTYPE=1)!(BPRTYPE=4)

               Begin DoDot:1

 +7                NEW ELGCD

                   SET ELGCD=$$ELIGCODE^BPSSCR05($PIECE(BPX,U,3))

 +8                WRITE ?35,$SELECT(ELGCD="V":"VET",ELGCD="T":"TRI",ELGCD="C":"CVA",1:"UNK")

 +9                WRITE ?40,$$RXNUM^BPSRPT6(BPRX)_$$COPAY^BPSRPT6(BPRX)

 +10               WRITE ?52,BPREF,"/",$$ECMENUM^BPSRPT1($PIECE(BPX,U,3))

 +11               WRITE ?73,$$DATTIM^BPSRPT1(BPSRTDT)

 +12               WRITE ?83,$JUSTIFY(BPBIL,10,2),?105,$JUSTIFY(BPINS,10,2),?122,$SELECT(BPCOLL]"":$JUSTIFY(BPCOLL,10,2),1:"")

               End DoDot:1

               QUIT 

 +13       IF BPRTYPE=2

               Begin DoDot:1

 +14               NEW ELGCD

                   SET ELGCD=$$ELIGCODE^BPSSCR05($PIECE(BPX,U,3))

 +15               WRITE ?35,$SELECT(ELGCD="V":"VET",ELGCD="T":"TRI",ELGCD="C":"CVA",1:"UNK")

 +16               WRITE ?40,$$RXNUM^BPSRPT6(BPRX)_$$COPAY^BPSRPT6(BPRX)

 +17               WRITE ?52,BPREF,"/",$$ECMENUM^BPSRPT1($PIECE(BPX,U,3))

 +18               WRITE ?73,$$DATTIM^BPSRPT1(BPSRTDT)

 +19               WRITE ?83,$$DATTIM^BPSRPT1(+BPX)

 +20               WRITE ?96,$$MWC^BPSRPT6(BPRX,BPREF)

 +21               WRITE ?99,$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($PIECE(BPX,U,3)))

 +22               WRITE ?103,$$RXSTATUS^BPSRPT6($PIECE(BPX,U,3))

 +23               WRITE ?105,$SELECT($PIECE(BPX,U):"/R",1:"/N")

 +24               WRITE ?114,$$RXCOB^BPSRPT8(BPPSEQ)

 +25               WRITE ?121,$SELECT($$CLOSED02^BPSSCR03($PIECE(^BPST($PIECE(BPX,U,3),0),U,4))=1:"Closed",1:"Open")

               End DoDot:1

               QUIT 

 +26       IF BPRTYPE=3

               Begin DoDot:1

 +27               WRITE ?35,$$RXNUM^BPSRPT6(BPRX)_$$COPAY^BPSRPT6(BPRX)

 +28               WRITE ?47,BPREF,"/",$$ECMENUM^BPSRPT1($PIECE(BPX,U,3))

 +29               WRITE ?68,$$DATTIM^BPSRPT1(BPSRTDT)

 +30               WRITE ?100,$JUSTIFY(BPBIL,10,2),?122,$JUSTIFY(BPINS,10,2)

               End DoDot:1

               QUIT 

 +31       IF BPRTYPE=5

               Begin DoDot:1

 +32               WRITE ?35,$$RXNUM^BPSRPT6(BPRX)_$$COPAY^BPSRPT6(BPRX)

 +33               WRITE ?47,BPREF,"/",$$ECMENUM^BPSRPT1($PIECE(BPX,U,3))

 +34               WRITE ?65,$$DATTIM^BPSRPT1($$TRANDT^BPSRPT2($PIECE(BPX,U,3),1))

 +35               WRITE ?83,$$TTYPE^BPSRPT7($PIECE(BPX,U,4),$PIECE(BPX,U,5),BPPSEQ)

 +36               WRITE ?100,$$RESPONSE^BPSRPT7($PIECE(BPX,U,4),$PIECE(BPX,U,5),BPPSEQ)

 +37               WRITE ?125,$$RXCOB^BPSRPT8(BPPSEQ)

               End DoDot:1

               QUIT 

 +38       IF BPRTYPE=7

               Begin DoDot:1

 +39               NEW ELGCD

                   SET ELGCD=$$ELIGCODE^BPSSCR05($PIECE(BPX,U,3))

 +40               WRITE ?35,$SELECT(ELGCD="V":"VET",ELGCD="T":"TRI",ELGCD="C":"CVA",1:"UNK")

 +41               WRITE ?40,$$RXNUM^BPSRPT6(BPRX)_$$COPAY^BPSRPT6(BPRX)

 +42               WRITE ?52,BPREF,"/",$$ECMENUM^BPSRPT1($PIECE(BPX,U,3))

 +43               WRITE ?70,$$MWC^BPSRPT6(BPRX,BPREF)

 +44               WRITE ?73,$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($PIECE(BPX,U,3)))

 +45               WRITE ?77,$$RXSTATUS^BPSRPT6($PIECE(BPX,U,3))

 +46               WRITE ?79,$SELECT($PIECE(BPX,U):"/R",1:"/N")

 +47               WRITE ?84,$SELECT($PIECE(BPX,U,13):"REJ",1:"")

 +48               WRITE ?89,$$DRGNAM^BPSRPT6($PIECE(BPX,U,14),27)

 +49               WRITE ?118,$$GETNDC^BPSRPT6(BPRX,BPREF)

               End DoDot:1

               QUIT 

 +50       IF BPRTYPE=8

               Begin DoDot:1

 +51               WRITE ?35,$$RXNUM^BPSRPT6(BPRX)_$$COPAY^BPSRPT6(BPRX)

 +52               WRITE ?47,BPREF,"/",$$ECMENUM^BPSRPT1($PIECE(BPX,U,3))

 +53               WRITE ?68,$$DATTIM^BPSRPT1(BPSRTDT)

 +54               WRITE ?78,$JUSTIFY(BPBIL,10,2),?100,$JUSTIFY(BPINS,10,2),?122,$SELECT(BPCOLL]"":$JUSTIFY(BPCOLL,10,2),1:"")

               End DoDot:1

 +55       IF BPRTYPE=9

               Begin DoDot:1

 +56               NEW ELGCD

                   SET ELGCD=$PIECE(BPX,U,1)

 +57      ; Eligibility

                   WRITE ?35,$SELECT(ELGCD="V":"VET",ELGCD="T":"TRI",ELGCD="C":"CVA",1:"UNK")

 +58      ; RX and Copay indicator

                   WRITE ?40,$$RXNUM^BPSRPT6(BPRX)_$$COPAY^BPSRPT6(BPRX)

 +59      ; Refill

                   WRITE ?52,BPREF

 +60      ; Transaction Date

                   WRITE ?64,$$DATTIM^BPSRPT1(BPSRTDT)

 +61      ; Drug Cost

                   WRITE ?84,$JUSTIFY($PIECE(BPX,U,2),10,2)

               End DoDot:1

               QUIT 

 +62       IF BPRTYPE=10

               Begin DoDot:1

 +63               NEW ELGCD,BPDUPPAY

 +64               SET BPDUPPAY=$PIECE(BPX,U,17)

 +65               SET ELGCD=$$ELIGCODE^BPSSCR05($PIECE(BPX,U,3))

 +66      ; Eligibility

                   WRITE ?35,$SELECT(ELGCD="V":"VET",ELGCD="T":"TRI",ELGCD="C":"CVA",1:"UNK")

 +67      ; Refill/ECME#

                   WRITE ?45,BPREF,"/",$$ECMENUM^BPSRPT1($PIECE(BPX,U,3))

 +68      ; Transaction Date

                   WRITE ?65,$$DATTIM^BPSRPT1(BPSRTDT)

 +69      ; $Billed

                   WRITE ?77,$JUSTIFY(BPBIL,10,2)

 +70      ; $Ins Response

                   WRITE ?90,$JUSTIFY(BPINS,13,2)

 +71      ; $Collected

                   WRITE ?106,$SELECT(BPCOLL]"":$JUSTIFY(BPCOLL,10,2),1:"")

 +72      ; Pt. Resp (Ins)

                   WRITE ?118,$JUSTIFY(BPDUPPAY,12,2)

               End DoDot:1

               QUIT 

 +73       QUIT 

 +74      ;

 +75      ;Print Report Line 2

WRLINE2(BPRTYPE,BPREC,BPX,BPRX,BPREF,BPBIL,BPGRPLAN,BPEXCEL,BPICNT,BPPSEQ) ;

 +1       ;Excel Output

 +2        NEW BPSX

 +3        IF $GET(BPEXCEL)

               DO WRLINE2^BPSRPT8(BPRTYPE,.BPREC,BPX,BPRX,BPREF,BPBIL,BPGRPLAN,BPPSEQ)

               QUIT 

 +4       ;Report Output

 +5        IF (BPRTYPE=1)!(BPRTYPE=4)

               Begin DoDot:1

 +6                WRITE !,?4,$$DRGNAM^BPSRPT6($PIECE(BPX,U,14),27),?32,$$GETNDC^BPSRPT6(BPRX,BPREF)

 +7                IF BPRTYPE=1

                       WRITE ?47,$$DATTIM^BPSRPT1(+BPX)

 +8                WRITE ?68,$$MWC^BPSRPT6(BPRX,BPREF)

 +9                WRITE ?71,$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($PIECE(BPX,U,3)))

 +10               WRITE ?75,$$RXSTATUS^BPSRPT6($PIECE(BPX,U,3))

 +11               WRITE ?77,$SELECT($PIECE(BPX,U):"/R",1:"/N")

 +12               WRITE ?82,$SELECT($PIECE(BPX,U,13):"REJ",1:"")

 +13               IF BPRTYPE=4

                       WRITE ?92,$$RXCOB^BPSRPT8(BPPSEQ)

 +14               IF BPRTYPE=1

                       WRITE ?115,$$BILLCOB^BPSRPT5(BPRX,BPREF,BPPSEQ)

               End DoDot:1

               QUIT 

 +15       IF BPRTYPE=2

               Begin DoDot:1

 +16               WRITE !,?3,$EXTRACT($$CRDHLDID^BPSRPT2(+$PIECE(BPX,U,3)),3,23)

 +17               WRITE ?26,$EXTRACT($$GRPID^BPSRPT2(+$PIECE(BPX,U,3)),3,17)

 +18               WRITE ?41,$JUSTIFY(BPBIL,10,2)

 +19               WRITE ?54,$$QTY^BPSRPT6($PIECE(BPX,U,3))

 +20               WRITE ?61,$$GETNDC^BPSRPT6(BPRX,BPREF)

 +21               SET BPSX=$$PRESCIN^BPSRPT6($PIECE(BPX,U,3))

 +22               WRITE ?82,$PIECE(BPSX,U),?98,$PIECE(BPSX,U,2)

               End DoDot:1

               QUIT 

 +23       IF BPRTYPE=3

               Begin DoDot:1

 +24               WRITE !,?4,$$DRGNAM^BPSRPT6($PIECE(BPX,U,14),32)

 +25               WRITE ?41,$$GETNDC^BPSRPT6(BPRX,BPREF)

 +26               WRITE ?68,$$MWC^BPSRPT6(BPRX,BPREF)

 +27               WRITE ?71,$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($PIECE(BPX,U,3)))

 +28               WRITE ?74,$$RXSTATUS^BPSRPT6($PIECE(BPX,U,3))

 +29               WRITE ?76,$SELECT($PIECE(BPX,U):"/R",1:"/N")

 +30               WRITE ?81,$SELECT($PIECE(BPX,U,13):"REJ",1:"")

 +31               WRITE ?88,$$RXCOB^BPSRPT8(BPPSEQ)

 +32               NEW ELGCD

                   SET ELGCD=$$ELIGCODE^BPSSCR05($PIECE(BPX,U,3))

 +33               WRITE ?96,$SELECT(ELGCD="V":"VET",ELGCD="T":"TRI",ELGCD="C":"CVA",1:"UNK")

               End DoDot:1

               QUIT 

 +34       IF BPRTYPE=5

               Begin DoDot:1

 +35               WRITE !,?4,$$DRGNAM^BPSRPT6($PIECE(BPX,U,14),23)

 +36               WRITE ?28,$$GETNDC^BPSRPT6(BPRX,BPREF)

 +37               WRITE ?47,$$MWC^BPSRPT6(BPRX,BPREF)

 +38               WRITE ?50,$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($PIECE(BPX,U,3)))

 +39               WRITE ?53,$$RXSTATUS^BPSRPT6($PIECE(BPX,U,3))

 +40               WRITE ?55,$SELECT($PIECE(BPX,U):"/R",1:"/N")

 +41               WRITE ?60,$SELECT($PIECE(BPX,U,13):"REJ",1:"")

 +42               IF $PIECE(BPGRPLAN,U,2)]""

                       WRITE ?69,$EXTRACT($PIECE(BPGRPLAN,U,2),1,30)

 +43               WRITE ?122,$JUSTIFY($$ELAPSE^BPSRPT6($PIECE(BPX,U,3)),10)

               End DoDot:1

               QUIT 

 +44       IF BPRTYPE=7

               Begin DoDot:1

 +45               WRITE !,?3,$EXTRACT($$CRDHLDID^BPSRPT2(+$PIECE(BPX,U,3)),3,23)

 +46               WRITE ?28,$EXTRACT($$GRPID^BPSRPT2(+$PIECE(BPX,U,3)),3,17)

 +47               WRITE ?46,$$DATTIM^BPSRPT1(+$$CLOSEDT^BPSRPT2(+$PIECE(BPX,U,3)))

 +48               NEW BPCLBY

                   SET BPCLBY=$EXTRACT($$CLSBY^BPSRPT6(+$PIECE(BPX,U,3)),1,25)

                   if BPCLBY=""

                       SET BPCLBY="BLANK"

 +49               WRITE ?65,BPCLBY

                   SET BPCNT(BPCLBY)=$GET(BPCNT(BPCLBY))+1

                   SET BPGCNT(BPCLBY)=$GET(BPGCNT(BPCLBY))+1

                   SET BPICNT(BPCLBY)=$GET(BPICNT(BPCLBY))+1

 +50               WRITE ?93,$EXTRACT($PIECE($$CLRSN^BPSRPT7(+$PIECE(BPX,U,3)),U,2),1,30)

 +51               WRITE ?128,$$RXCOB^BPSRPT8(BPPSEQ)

               End DoDot:1

               QUIT 

 +52       IF BPRTYPE=8

               Begin DoDot:1

 +53               WRITE !,?2,$$DRGNAM^BPSRPT6($PIECE(BPX,U,14),34)

 +54               WRITE ?38,$$MWC^BPSRPT6(BPRX,BPREF)

 +55               WRITE ?42,$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($PIECE(BPX,U,3)))

 +56               WRITE ?46,$$RXSTATUS^BPSRPT6($PIECE(BPX,U,3))

 +57               WRITE ?48,$SELECT($PIECE(BPX,U):"/R",1:"/N")

 +58               WRITE ?54,$EXTRACT($$GRPID^BPSRPT2(+$PIECE(BPX,U,3)),3,10)

 +59               WRITE ?72,$EXTRACT(BPGRPLAN,1,50)

 +60               WRITE ?125,$$BILL^BPSRPT6(BPRX,BPREF,BPPSEQ)

               End DoDot:1

               QUIT 

 +61       IF BPRTYPE=9

               Begin DoDot:1

 +62      ;Drug

                   WRITE !,?4,$$DRGNAM^BPSRPT6($PIECE(BPX,U,4),27)

 +63      ;NDC

                   WRITE ?32,$$GETNDC^BPSRPT6(BPRX,BPREF)

 +64      ;Release Date

                   WRITE ?47,$$DATTIM^BPSRPT1($PIECE(BPX,U,5))

 +65      ;Fill Location

                   WRITE ?62,$$MWC^BPSRPT6(BPRX,BPREF)

 +66      ;Status

                   WRITE ?65,$$RXSTANAM^BPSSCRU2($PIECE(BPX,U,6))

 +67      ;Released

                   WRITE ?67,$SELECT($PIECE(BPX,U,5):"/R",1:"/N")

 +68      ;Non-Billalble Reason - ICR 6136

                   WRITE ?75,$EXTRACT($$GET1^DIQ(366.17,$PIECE(BPX,U,7),.01,"E"),1,57)

               End DoDot:1

               QUIT 

 +69       IF BPRTYPE=10

               Begin DoDot:1

 +70               NEW BPDUPST

 +71               SET BPDUPST=$PIECE(BPX,U,16)

 +72      ; Drug

                   WRITE !,?4,$$DRGNAM^BPSRPT6($PIECE(BPX,U,14),27)

 +73      ; NDC

                   WRITE ?32,$$GETNDC^BPSRPT6(BPRX,BPREF)

 +74      ; Released On Date

                   WRITE ?47,$$DATTIM^BPSRPT1(+BPX)

 +75      ; Fill Location

                   WRITE ?68,$$MWC^BPSRPT6(BPRX,BPREF)

 +76               WRITE ?71,$$RTBCKNAM^BPSRPT1($$RTBCK^BPSRPT1($PIECE(BPX,U,3)))

 +77               WRITE ?75,$$RXSTATUS^BPSRPT6($PIECE(BPX,U,3))

 +78               WRITE ?77,$SELECT($PIECE(BPX,U):"/R",1:"/N")

 +79               WRITE ?82,$SELECT($PIECE(BPX,U,13):"REJ",1:"")

 +80      ; Bill #

                   WRITE ?94,$$BILL^BPSRPT6(BPRX,BPREF,BPPSEQ)

 +81      ; COB

                   WRITE ?113,$$RXCOB^BPSRPT8(BPPSEQ)

 +82      ; Status (Duplicate Trans Status)

                   WRITE ?122,BPDUPST

               End DoDot:1

               QUIT 

 +83       QUIT 

 +84      ;

 +85      ;Print Report Line 3

WRLINE3(BPRTYPE,BPREC,BPX,BPEXCEL)  NEW BP59,BPRICINF

 +1        SET BP59=+$PIECE(BPX,U,3)

 +2       ;Excel Output

 +3        IF $GET(BPEXCEL)

               DO WRLINE3^BPSRPT8(BPRTYPE,.BPREC,BPX)

               QUIT 

 +4       ;Report Output

 +5        IF BPRTYPE=4

               Begin DoDot:1

 +6                SET NP=$$CHKP^BPSRPT5(1)

                   if BPQ

                       QUIT 

 +7       ;Released On

 +8                WRITE !,?6,$$DATTIM^BPSRPT1(+BPX)

 +9       ;Method

 +10               IF $$AUTOREV^BPSRPT1(BP59)

                       WRITE ?22,"AUTO/"

 +11              IF '$TEST

                       WRITE ?22,"REGULAR/"

 +12      ;Return Status

 +13               IF $PIECE(BPX,U,15)["ACCEPTED"

                       WRITE "ACCEPTED/"

 +14              IF '$TEST

                       WRITE "REJECTED/"

 +15      ;Reason

 +16               WRITE $$RVSRSN^BPSRPT7(+$PIECE(BPX,U,3))

               End DoDot:1

               QUIT 

 +17      ;

 +18       IF BPRTYPE=8

               Begin DoDot:1

 +19               SET BPRICINF=$$PRICEVAL^BPSRPT5(BP59)

 +20               WRITE !,?4,$SELECT($PIECE(BPRICINF,U,3)]"":$PIECE(BPRICINF,U,3),1:"N/A")

 +21               WRITE ?23,$SELECT($PIECE(BPRICINF,U,4)]"":$PIECE(BPRICINF,U,4),1:"N/A")

 +22               WRITE ?38,$SELECT($PIECE(BPRICINF,U,5)]"":$PIECE(BPRICINF,U,5),1:"N/A")

 +23               WRITE ?56,$SELECT($PIECE(BPRICINF,U,6)]"":$PIECE(BPRICINF,U,6),1:"N/A")

 +24               WRITE ?81,$SELECT($PIECE(BPRICINF,U,7)]"":$PIECE(BPRICINF,U,7),1:"N/A")

 +25               WRITE ?96,$SELECT($PIECE(BPRICINF,U,2)]"":$PIECE(BPRICINF,U,2),1:"N/A")

 +26               WRITE ?111,$SELECT($PIECE(BPRICINF,U,1)]"":$PIECE(BPRICINF,U,1),1:"N/A")

               End DoDot:1

               QUIT 

 +27      ;

 +28       QUIT 

 +29      ;