BPSRPT7 ;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.
;
Q
;
;Routine to Display the Reports (Continued)
;
; The following sub-routines were moved to BPSRPT7A:
; PTBDT,PGTOT6,PGTOT,ITOT,BILLED
;
;Get Close Reason
;
; Input Variable -> BP59 = ptr to BPS TRANSACTIONS
; Returned Value -> Claim Close Reason
;
CLRSN(BP59) N BP02,CIEN,CL
S CL=""
S BP02=+$P($G(^BPST(BP59,0)),U,4)
S CIEN=+$P($G(^BPSC(BP02,900)),U,4)
I CIEN'=0 S CL=$$GETCLR^BPSRPT6(CIEN)
Q CIEN_"^"_CL
;
;Get Reversal Reason
;
; Input Variable -> BP59 = ptr to BPS TRANSACTIONS
; Returned Value -> Claim Reversal Reason
;
RVSRSN(BP59) Q $P($G(^BPST(BP59,4)),U,4)
;
;Return the Transaction Type - SUBMIT or REVERSAL
;
TTYPE(BPRX,BPREF,BPSEQ) N BPSTATUS,TTYPE
S TTYPE="SUBMIT"
S BPSTATUS=$$STATUS^BPSRPT6(BPRX,BPREF,$G(BPSEQ))
I BPSTATUS["REVERSAL" S TTYPE="REVERSAL"
Q TTYPE
;
;Return the payer response
;
RESPONSE(BPRX,BPREF,BPSEQ) Q $P($$STATUS^BPSRPT6(BPRX,BPREF,$G(BPSEQ)),U)
;
;Print Report Subtotals
;
TOTALS(BPRTYPE,BPDIV,BPTBIL,BPTINS,BPTCOLL,BPTDPAY,BPCNT,BPELTM,BPRICE) ;
I (BPRTYPE=1)!(BPRTYPE=4) D Q
.W !!,?83,"----------",?105,"----------",?122,"----------"
.W !,"SUBTOTALS for DIV:",$E($$BPDIV(BPDIV),1,52),?83,$J(BPTBIL,10,2),?105,$J(BPTINS,10,2),?122,$J(BPTCOLL,10,2)
.W !,"COUNT",?83,$J(BPCNT,10),?105,$J(BPCNT,10),?122,$J(BPCNT,10)
.W:BPCNT !,"MEAN",?83,$J(BPTBIL/BPCNT,10,2),?105,$J(BPTINS/BPCNT,10,2),?122,$J(BPTCOLL/BPCNT,10,2)
I BPRTYPE=3 D Q
.W !!,?100,"----------",?122,"----------"
.W !,"SUBTOTALS for DIV:",$E($$BPDIV(BPDIV),1,52),?100,$J(BPTBIL,10,2),?122,$J(BPTINS,10,2)
.W !,"COUNT",?100,$J(BPCNT,10),?122,$J(BPCNT,10)
.W:BPCNT !,"MEAN",?100,$J(BPTBIL/BPCNT,10,2),?122,$J(BPTINS/BPCNT,10,2)
I BPRTYPE=2 D Q
.W !!,?41,"----------"
.W !,"SUBTOTALS for DIV:",$E($$BPDIV(BPDIV),1,22),?41,$J(BPTBIL,10,2)
.W !,"COUNT",?41,$J(BPCNT,10)
.W:BPCNT !,"MEAN",?41,$J(BPTBIL/BPCNT,10,2)
I (BPRTYPE=5) D Q
.W !!,"SUBTOTALS for DIV: ",$E($$BPDIV(BPDIV),1,43),?65,"---------------"
.W !,"TOTAL CLAIMS",?65,$J(BPCNT,15)
.W !,"AVERAGE ELAPSED TIME PER CLAIM",?65,$J($S(BPCNT=0:"0",1:(BPELTM\BPCNT)),15)
I (BPRTYPE=7) D Q
.W !!,"SUBTOTALS for DIV:",$E($$BPDIV(BPDIV),1,43)
.N BPBILR
.S BPBILR="" F S BPBILR=$O(BPCNT(BPBILR)) Q:BPBILR="" D Q:BPQ
..S NP=$$CHKP^BPSRPT5(1) Q:BPQ
..W !,?3,BPBILR,?65,$J($G(BPCNT(BPBILR)),5)
.Q:$G(BPQ)
.W !,?65,"-----"
.W !,"CLOSED CLAIMS SUBTOTAL",?65,$J(BPCNT,5)
I BPRTYPE=8 D Q
.W !!,?78,"----------",?100,"----------",?122,"----------"
.W !,"SUBTOTALS for DIV:",$E($$BPDIV(BPDIV),1,52),?78,$J(BPTBIL,10,2),?100,$J(BPTINS,10,2),?122,$J(BPTCOLL,10,2)
.W !,?4,$J($P(BPRICE,U,3),10,2),?23,$J($P(BPRICE,U,4),10,2),?38,$J($P(BPRICE,U,5),10,2),?56,$J($P(BPRICE,U,6),10,2),?81,$J($P(BPRICE,U,7),10,2),?96,$J($P(BPRICE,U,2),10,2),?111,$J($P(BPRICE,U),10,2)
.W !,"COUNT",?78,$J(BPCNT,10),?100,$J(BPCNT,10),?122,$J(BPCNT,10)
.W !,?4,$J(BPCNT,10),?23,$J(BPCNT,10),?38,$J(BPCNT,10),?56,$J(BPCNT,10),?81,$J(BPCNT,10),?96,$J(BPCNT,10),?111,$J(BPCNT,10)
.W:BPCNT !,"MEAN",?78,$J(BPTBIL/BPCNT,10,2),?100,$J(BPTINS/BPCNT,10,2),?122,$J(BPTCOLL/BPCNT,10,2)
.W !,?4,$J($P(BPRICE,U,3)/BPCNT,10,2),?23,$J($P(BPRICE,U,4)/BPCNT,10,2),?38,$J($P(BPRICE,U,5)/BPCNT,10,2),?56,$J($P(BPRICE,U,6)/BPCNT,10,2),?81,$J($P(BPRICE,U,7)/BPCNT,10,2),?96,$J($P(BPRICE,U,2)/BPCNT,10,2),?111,$J($P(BPRICE,U)/BPCNT,10,2)
;
I BPRTYPE=9 D Q
.W !!,?84,"----------"
.W !,"SUBTOTALS for DIV:",$E($$BPDIV(BPDIV),1,52),?84,$J(BPTBIL,10,2)
.W !,"COUNT",?84,$J(BPCNT,10)
.W:BPCNT !,"MEAN",?84,$J(BPTBIL/BPCNT,10,2)
;
I BPRTYPE=10 D Q
.W !!,?77,"----------",?90,$J("----------",13),?106,"----------",?118,$J("----------",12)
.W !,"SUBTOTALS for DIV:",$E($$BPDIV(BPDIV),1,52),?77,$J(BPTBIL,10,2),?90,$J(BPTINS,13,2),?106,$J(BPTCOLL,10,2),?118,$J(BPTDPAY,12,2)
.W !,"COUNT",?77,$J(BPCNT,10),?90,$J(BPCNT,13),?106,$J(BPCNT,10),?118,$J(BPCNT,12)
.W:BPCNT !,"MEAN",?77,$J(BPTBIL/BPCNT,10,2),?90,$J(BPTINS/BPCNT,13,2),?106,$J(BPTCOLL/BPCNT,10,2),?118,$J(BPTDPAY/BPCNT,12,2)
Q
;
;Print Report Header
; Input variables (passed in) - BPRTYPE -> number of report
; - BPRPTNAM -> report name
; - BPPAGE -> report page number
; Input variables (defined in BPSRPT0) - BPPHARM,BPSUMDET,BPNOW,BPMWC,BPRTBCK,BPINSINF
; BPREJCD,BPCCRSN,BPAUTREV,BPACREJ,BPQSTDRG
; BPDRUG,BPDRGCL,BPRESC,BPOPCL,BPRLNRL,
; BPSORT,BPBEGDT,BPENDDT
; Output variable - BPSDATA -> Reset to 0 to show no actual data has been printed
; on the screen
; BPPAGE -> First set in BPSRPT0, report page number
; BPBLINE -> Controls whether to print a blank line
;
HDR(BPRTYPE,BPRPTNAM,BPPAGE) ;
;Display Excel Header
I BPEXCEL D HDR^BPSRPT8A(BPRTYPE) Q
;
; Define BPPDATA - Tells whether data has been displayed for a screen
S BPSDATA=0
S BPBLINE=""
S BPPAGE=$G(BPPAGE)+1
W @IOF
W "ECME "_BPRPTNAM_" "_$S(BPSUMDET=1:"SUMMARY",1:"DETAIL")_" REPORT"
I (",2,10,")'[(","_BPRTYPE_",") D
. W ?89,"Print Date: "_$G(BPNOW)_" Page:",$J(BPPAGE,3)
. W !,"DIVISION(S): ",$$GETDIVS^BPSRPT4(72,.BPPHARM)
. W ?86,"Fill Locations: "_$S(BPMWC="A":"C,M,W",1:BPMWC)
;
I (",2,")[BPRTYPE D
. W ?87,"Print Date: "_$G(BPNOW)_" Page:",$J(BPPAGE,3)
. W !,"DIVISION(S): ",$$GETDIVS^BPSRPT4(72,.BPPHARM)
. W ?84,"Fill Locations: "_$S(BPMWC="A":"C,M,W",1:BPMWC)
;
I (",1,2,3,4,7,")[BPRTYPE D
. W ?110,"Fill Type: "
. I BPRTBCK=1 W "RT,BB,P2,RS" Q
. F I=1:1:$L(BPRTBCK,",") W:I'=1 "," S RTBCKX=$P(BPRTBCK,",",I) W $S(RTBCKX=2:"RT",RTBCKX=3:"BB",RTBCKX=4:"P2",RTBCKX=5:"RS",1:"")
;
I (",1,2,3,4,7,9,")[BPRTYPE W !,"Insurance: "_$S(BPINSINF=0:"ALL",1:"SELECTED")
;
I (",5,6,8,")[BPRTYPE D
. W ?110,"Fill type: "_$S(BPRTBCK=2:"RT",BPRTBCK=3:"BB",BPRTBCK=4:"P2",BPRTBCK=5:"RS",1:"RT,BB,P2,RS")
. W !,"Insurance: "_$S(BPINSINF=0:"ALL",1:$$BPINS(BPINSINF))
;
I (",7,")[BPRTYPE W ?44,"Close Reason: ",$S(BPCCRSN'=0:"SELECTED",1:"ALL")
I (",4,")[BPRTYPE D
. W ?44,$J($S(BPAUTREV=0:"ALL",1:"AUTO"),4)," Reversals"
. W ?60,$J($S(BPACREJ=1:"REJECTED",BPACREJ=2:"ACCEPTED",1:"ALL"),8)," Returned Status"
;
I (",5,6,8,")[BPRTYPE W ?87,"Drugs/Classes: "_$S(BPQSTDRG=2:$$DRGNAM^BPSRPT6(BPDRUG,30),BPQSTDRG=3:$E(BPDRGCL,1,30),1:"ALL")
I (",1,2,3,4,7,9,")[BPRTYPE W ?87,"Drugs/Classes: "_$S(BPQSTDRG'=1:"SELECTED",1:"ALL")
;
I (",2,")[BPRTYPE D
. W !,"Reject Code: ",$S(BPREJCD'=0:"SELECTED",1:"ALL")
. W ?87,"Eligibility: " D
. . I BPELIG1=0 W "CVA,TRI,VET" Q
. . S (ABVELIG,LIST,N)="" F S N=$O(BPELIG1(N)) Q:N="" D
. . . S ABVELIG=$S(N="C":"CVA",N="T":"TRI",N="V":"VET",1:""),LIST=LIST_$G(ABVELIG)_","
. . W $E(LIST,1,$L(LIST)-1)
. W ?113,"Open/Closed: ",$S(BPOPCL=1:"CLOSED",BPOPCL=2:"OPEN",1:"ALL")
. W !,"Prescriber: ",$S(BPRESC'=0:"SELECTED",1:"ALL")
. W ?91,"Patient: ",$S(BPQSTPAT'=0:"SELECTED",1:"ALL")
;
I (",1,3,4,7,9,")[BPRTYPE D
. W !,"Eligibility: " D
. . I BPELIG1=0 W "CVA,TRI,VET" Q ; ALL was selected
. . S (ABVELIG,LIST,N)="" F S N=$O(BPELIG1(N)) Q:N="" D
. . . S ABVELIG=$S(N="C":"CVA",N="T":"TRI",N="V":"VET",1:""),LIST=LIST_$G(ABVELIG)_","
. . W $E(LIST,1,$L(LIST)-1)
. W ?91,"Patient: ",$S(BPQSTPAT'=0:"SELECTED",1:"ALL")
;
I (",9,")[BPRTYPE W !,"NON-BILLABLE STATUS: "_$S(BPNBSTS=0:"ALL",1:$$NBSTS(.BPNBSTS))
;
I BPRTYPE=10 D
. W ?87,"Print Date: "_$G(BPNOW)_" Page:",$J(BPPAGE,3)
. W !,"DIVISION(S): ",$$GETDIVS^BPSRPT4(68,.BPPHARM)
. ; Fill Location, Fill Type and Drugs/Classes default to 'ALL', user not prompted
. W ?86,"Fill Locations: ALL"
. W ?110,"Fill Type: ALL"
. W !,"Insurance: "_$S(BPINSINF=0:"ALL",1:$$BPINS(BPINSINF))
. W ?87,"Drugs/Classes: ALL"
. W !,"Eligibility: " D
. . I BPELIG1=0 W "CVA,TRI,VET" Q
. . S (ABVELIG,LIST,N)="" F S N=$O(BPELIG1(N)) Q:N="" D
. . . S ABVELIG=$S(N="C":"CVA",N="T":"TRI",N="V":"VET",1:""),LIST=LIST_$G(ABVELIG)_","
. . W $E(LIST,1,$L(LIST)-1)
. W ?93,"Patient: ",$S(BPQSTPAT'=0:"SELECTED",1:"ALL")
. W !,"Status: "_$S(BPDUP=0:"ALL",1:BPDUP)
;
W !,$S(BPRTYPE=5:"PRESCRIPTIONS",BPRLNRL=2:"RELEASED PRESCRIPTIONS",BPRLNRL=3:"PRESCRIPTIONS (NOT RELEASED)",1:"ALL PRESCRIPTIONS")
W " BY "_$S(BPRTYPE=7:"CLOSE",1:"TRANSACTION")_" DATE: "
W "From "_$$DATTIM^BPSRPT1(BPBEGDT)_" through "_$$DATTIM^BPSRPT1($P(BPENDDT,"."))
;
I BPRTYPE=10 D
. W !!,"Status Codes: S= Duplicate of Approved, D= Duplicate of Paid, Q= Duplicate of Capture"
;
D ULINE^BPSRPT5("=") Q:$G(BPQ)
D HEADLN1^BPSRPT4(BPRTYPE)
D HEADLN2^BPSRPT4(BPRTYPE)
D HEADLN3^BPSRPT4(BPRTYPE)
D ULINE^BPSRPT5("=")
;
;Print Division
I $G(BPDIV)]"" D
.W !,"DIVISION: ",$S(BPDIV=0:"BLANK",BPDIV="ALL DIVISIONS":"ALL DIVISIONS",$$DIVNAME^BPSSCRDS(BPDIV)]"":$$DIVNAME^BPSSCRDS(BPDIV),1:BPDIV)
.I BPRTYPE=5!(BPRTYPE=6)!(BPSUMDET=1)!(BPGRPLAN="") D ULINE^BPSRPT5("-")
;
;Print Insurance If Defined
I BPSUMDET=0,$G(BPGRPLAN)]"",$G(BPGRPLAN)'=0,$G(BPGRPLAN)'="~" D WRPLAN^BPSRPT5(BPGRPLAN)
Q
;
;Special Division Handling
;
BPDIV(BPDIV) Q $S(BPDIV=0:"BLANK",$$DIVNAME^BPSSCRDS(BPDIV)]"":$$DIVNAME^BPSSCRDS(BPDIV),1:BPDIV)
;
;Get selected insurance names based on user selection
;If length is greater than 68 append "..."
;Input: BPINSINF = Semi-colon separated list of file 36 IENs
;Output: comma separated list of related file 36 names
BPINS(BPINSINF) ;
N BPINS,BPINAME,RETV
S RETV=""
F I=2:1 S BPINS=$P($G(BPINSINF),";",I) Q:BPINS="" D
. S BPINAME=$$INSNM^IBNCPDPI(BPINS) Q:BPINAME=""
. I RETV'="" S RETV=RETV_", "_BPINAME Q
. S RETV=BPINAME
I $L(RETV)>68 S RETV=$E(RETV,1,68)_"..."
Q RETV
;
ELIG(ELIG) ;
; Display multiple eligibilities
; Input:
; ELIG - Array of multiple eligibilities
; Output
; Text of eligibilities
;
I $D(ELIG)=0 Q ""
N N,LIST
S LIST=""
S N="" F S N=$O(ELIG(N)) Q:N="" D
. S LIST=LIST_$G(ELIG(N))_","
Q $E(LIST,1,$L(LIST)-1)
;
NBSTS(NBSTS) ;
; Display multiple non-billable statuses
; Input:
; NBSTS - Array of multiple non-billable statuses
; Output
; Text of non-billable statuses
;
I $D(NBSTS)=0 Q ""
N N,LIST
S LIST=""
S N="" F S N=$O(NBSTS(N)) Q:N="" D
. S LIST=LIST_$G(NBSTS(N))_","
Q $E(LIST,1,$L(LIST)-1)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSRPT7 10621 printed Sep 23, 2025@19:29:01 Page 2
BPSRPT7 ;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 QUIT
+5 ;
+6 ;Routine to Display the Reports (Continued)
+7 ;
+8 ; The following sub-routines were moved to BPSRPT7A:
+9 ; PTBDT,PGTOT6,PGTOT,ITOT,BILLED
+10 ;
+11 ;Get Close Reason
+12 ;
+13 ; Input Variable -> BP59 = ptr to BPS TRANSACTIONS
+14 ; Returned Value -> Claim Close Reason
+15 ;
CLRSN(BP59) NEW BP02,CIEN,CL
+1 SET CL=""
+2 SET BP02=+$PIECE($GET(^BPST(BP59,0)),U,4)
+3 SET CIEN=+$PIECE($GET(^BPSC(BP02,900)),U,4)
+4 IF CIEN'=0
SET CL=$$GETCLR^BPSRPT6(CIEN)
+5 QUIT CIEN_"^"_CL
+6 ;
+7 ;Get Reversal Reason
+8 ;
+9 ; Input Variable -> BP59 = ptr to BPS TRANSACTIONS
+10 ; Returned Value -> Claim Reversal Reason
+11 ;
RVSRSN(BP59) QUIT $PIECE($GET(^BPST(BP59,4)),U,4)
+1 ;
+2 ;Return the Transaction Type - SUBMIT or REVERSAL
+3 ;
TTYPE(BPRX,BPREF,BPSEQ) NEW BPSTATUS,TTYPE
+1 SET TTYPE="SUBMIT"
+2 SET BPSTATUS=$$STATUS^BPSRPT6(BPRX,BPREF,$GET(BPSEQ))
+3 IF BPSTATUS["REVERSAL"
SET TTYPE="REVERSAL"
+4 QUIT TTYPE
+5 ;
+6 ;Return the payer response
+7 ;
RESPONSE(BPRX,BPREF,BPSEQ) QUIT $PIECE($$STATUS^BPSRPT6(BPRX,BPREF,$GET(BPSEQ)),U)
+1 ;
+2 ;Print Report Subtotals
+3 ;
TOTALS(BPRTYPE,BPDIV,BPTBIL,BPTINS,BPTCOLL,BPTDPAY,BPCNT,BPELTM,BPRICE) ;
+1 IF (BPRTYPE=1)!(BPRTYPE=4)
Begin DoDot:1
+2 WRITE !!,?83,"----------",?105,"----------",?122,"----------"
+3 WRITE !,"SUBTOTALS for DIV:",$EXTRACT($$BPDIV(BPDIV),1,52),?83,$JUSTIFY(BPTBIL,10,2),?105,$JUSTIFY(BPTINS,10,2),?122,$JUSTIFY(BPTCOLL,10,2)
+4 WRITE !,"COUNT",?83,$JUSTIFY(BPCNT,10),?105,$JUSTIFY(BPCNT,10),?122,$JUSTIFY(BPCNT,10)
+5 if BPCNT
WRITE !,"MEAN",?83,$JUSTIFY(BPTBIL/BPCNT,10,2),?105,$JUSTIFY(BPTINS/BPCNT,10,2),?122,$JUSTIFY(BPTCOLL/BPCNT,10,2)
End DoDot:1
QUIT
+6 IF BPRTYPE=3
Begin DoDot:1
+7 WRITE !!,?100,"----------",?122,"----------"
+8 WRITE !,"SUBTOTALS for DIV:",$EXTRACT($$BPDIV(BPDIV),1,52),?100,$JUSTIFY(BPTBIL,10,2),?122,$JUSTIFY(BPTINS,10,2)
+9 WRITE !,"COUNT",?100,$JUSTIFY(BPCNT,10),?122,$JUSTIFY(BPCNT,10)
+10 if BPCNT
WRITE !,"MEAN",?100,$JUSTIFY(BPTBIL/BPCNT,10,2),?122,$JUSTIFY(BPTINS/BPCNT,10,2)
End DoDot:1
QUIT
+11 IF BPRTYPE=2
Begin DoDot:1
+12 WRITE !!,?41,"----------"
+13 WRITE !,"SUBTOTALS for DIV:",$EXTRACT($$BPDIV(BPDIV),1,22),?41,$JUSTIFY(BPTBIL,10,2)
+14 WRITE !,"COUNT",?41,$JUSTIFY(BPCNT,10)
+15 if BPCNT
WRITE !,"MEAN",?41,$JUSTIFY(BPTBIL/BPCNT,10,2)
End DoDot:1
QUIT
+16 IF (BPRTYPE=5)
Begin DoDot:1
+17 WRITE !!,"SUBTOTALS for DIV: ",$EXTRACT($$BPDIV(BPDIV),1,43),?65,"---------------"
+18 WRITE !,"TOTAL CLAIMS",?65,$JUSTIFY(BPCNT,15)
+19 WRITE !,"AVERAGE ELAPSED TIME PER CLAIM",?65,$JUSTIFY($SELECT(BPCNT=0:"0",1:(BPELTM\BPCNT)),15)
End DoDot:1
QUIT
+20 IF (BPRTYPE=7)
Begin DoDot:1
+21 WRITE !!,"SUBTOTALS for DIV:",$EXTRACT($$BPDIV(BPDIV),1,43)
+22 NEW BPBILR
+23 SET BPBILR=""
FOR
SET BPBILR=$ORDER(BPCNT(BPBILR))
if BPBILR=""
QUIT
Begin DoDot:2
+24 SET NP=$$CHKP^BPSRPT5(1)
if BPQ
QUIT
+25 WRITE !,?3,BPBILR,?65,$JUSTIFY($GET(BPCNT(BPBILR)),5)
End DoDot:2
if BPQ
QUIT
+26 if $GET(BPQ)
QUIT
+27 WRITE !,?65,"-----"
+28 WRITE !,"CLOSED CLAIMS SUBTOTAL",?65,$JUSTIFY(BPCNT,5)
End DoDot:1
QUIT
+29 IF BPRTYPE=8
Begin DoDot:1
+30 WRITE !!,?78,"----------",?100,"----------",?122,"----------"
+31 WRITE !,"SUBTOTALS for DIV:",$EXTRACT($$BPDIV(BPDIV),1,52),?78,$JUSTIFY(BPTBIL,10,2),?100,$JUSTIFY(BPTINS,10,2),?122,$JUSTIFY(BPTCOLL,10,2)
+32 WRITE !,?4,$JUSTIFY($PIECE(BPRICE,U,3),10,2),?23,$JUSTIFY($PIECE(BPRICE,U,4),10,2),?38,$JUSTIFY($PIECE(BPRICE,U,5),10,2),?56,$JUSTIFY($PIECE(BPRICE,U,6),10,2),?81,$JUSTIFY($PIECE(BPRICE,U,7),10,2),?96,$JUSTIFY(...
... $PIECE(BPRICE,U,2),10,2),?111,$JUSTIFY($PIECE(BPRICE,U),10,2)
+33 WRITE !,"COUNT",?78,$JUSTIFY(BPCNT,10),?100,$JUSTIFY(BPCNT,10),?122,$JUSTIFY(BPCNT,10)
+34 WRITE !,?4,$JUSTIFY(BPCNT,10),?23,$JUSTIFY(BPCNT,10),?38,$JUSTIFY(BPCNT,10),?56,$JUSTIFY(BPCNT,10),?81,$JUSTIFY(BPCNT,10),?96,$JUSTIFY(BPCNT,10),?111,$JUSTIFY(BPCNT,10)
+35 if BPCNT
WRITE !,"MEAN",?78,$JUSTIFY(BPTBIL/BPCNT,10,2),?100,$JUSTIFY(BPTINS/BPCNT,10,2),?122,$JUSTIFY(BPTCOLL/BPCNT,10,2)
+36 WRITE !,?4,$JUSTIFY($PIECE(BPRICE,U,3)/BPCNT,10,2),?23,...
WRITE $JUSTIFY($PIECE(BPRICE,U,4)/BPCNT,10,2),?38,$JUSTIFY($PIECE(BPRICE,U,5)/BPCNT,10,2),?56,$JUSTIFY($PIECE(BPRICE,U,6)/BPCNT,10,2),?81,$JUSTIFY($PIECE(BPRICE,U,7)/BPCNT,10,2),?96,$JUSTIFY($PIECE(BPRICE,U,2)/BPCNT,10,2),?111,...
... $JUSTIFY($PIECE(BPRICE,U)/BPCNT,10,2)
End DoDot:1
QUIT
+37 ;
+38 IF BPRTYPE=9
Begin DoDot:1
+39 WRITE !!,?84,"----------"
+40 WRITE !,"SUBTOTALS for DIV:",$EXTRACT($$BPDIV(BPDIV),1,52),?84,$JUSTIFY(BPTBIL,10,2)
+41 WRITE !,"COUNT",?84,$JUSTIFY(BPCNT,10)
+42 if BPCNT
WRITE !,"MEAN",?84,$JUSTIFY(BPTBIL/BPCNT,10,2)
End DoDot:1
QUIT
+43 ;
+44 IF BPRTYPE=10
Begin DoDot:1
+45 WRITE !!,?77,"----------",?90,$JUSTIFY("----------",13),?106,"----------",?118,$JUSTIFY("----------",12)
+46 WRITE !,"SUBTOTALS for DIV:",$EXTRACT($$BPDIV(BPDIV),1,52),?77,$JUSTIFY(BPTBIL,10,2),?90,$JUSTIFY(BPTINS,13,2),?106,$JUSTIFY(BPTCOLL,10,2),?118,$JUSTIFY(BPTDPAY,12,2)
+47 WRITE !,"COUNT",?77,$JUSTIFY(BPCNT,10),?90,$JUSTIFY(BPCNT,13),?106,$JUSTIFY(BPCNT,10),?118,$JUSTIFY(BPCNT,12)
+48 if BPCNT
WRITE !,"MEAN",?77,$JUSTIFY(BPTBIL/BPCNT,10,2),?90,$JUSTIFY(BPTINS/BPCNT,13,2),?106,$JUSTIFY(BPTCOLL/BPCNT,10,2),?118,$JUSTIFY(BPTDPAY/BPCNT,12,2)
End DoDot:1
QUIT
+49 QUIT
+50 ;
+51 ;Print Report Header
+52 ; Input variables (passed in) - BPRTYPE -> number of report
+53 ; - BPRPTNAM -> report name
+54 ; - BPPAGE -> report page number
+55 ; Input variables (defined in BPSRPT0) - BPPHARM,BPSUMDET,BPNOW,BPMWC,BPRTBCK,BPINSINF
+56 ; BPREJCD,BPCCRSN,BPAUTREV,BPACREJ,BPQSTDRG
+57 ; BPDRUG,BPDRGCL,BPRESC,BPOPCL,BPRLNRL,
+58 ; BPSORT,BPBEGDT,BPENDDT
+59 ; Output variable - BPSDATA -> Reset to 0 to show no actual data has been printed
+60 ; on the screen
+61 ; BPPAGE -> First set in BPSRPT0, report page number
+62 ; BPBLINE -> Controls whether to print a blank line
+63 ;
HDR(BPRTYPE,BPRPTNAM,BPPAGE) ;
+1 ;Display Excel Header
+2 IF BPEXCEL
DO HDR^BPSRPT8A(BPRTYPE)
QUIT
+3 ;
+4 ; Define BPPDATA - Tells whether data has been displayed for a screen
+5 SET BPSDATA=0
+6 SET BPBLINE=""
+7 SET BPPAGE=$GET(BPPAGE)+1
+8 WRITE @IOF
+9 WRITE "ECME "_BPRPTNAM_" "_$SELECT(BPSUMDET=1:"SUMMARY",1:"DETAIL")_" REPORT"
+10 IF (",2,10,")'[(","_BPRTYPE_",")
Begin DoDot:1
+11 WRITE ?89,"Print Date: "_$GET(BPNOW)_" Page:",$JUSTIFY(BPPAGE,3)
+12 WRITE !,"DIVISION(S): ",$$GETDIVS^BPSRPT4(72,.BPPHARM)
+13 WRITE ?86,"Fill Locations: "_$SELECT(BPMWC="A":"C,M,W",1:BPMWC)
End DoDot:1
+14 ;
+15 IF (",2,")[BPRTYPE
Begin DoDot:1
+16 WRITE ?87,"Print Date: "_$GET(BPNOW)_" Page:",$JUSTIFY(BPPAGE,3)
+17 WRITE !,"DIVISION(S): ",$$GETDIVS^BPSRPT4(72,.BPPHARM)
+18 WRITE ?84,"Fill Locations: "_$SELECT(BPMWC="A":"C,M,W",1:BPMWC)
End DoDot:1
+19 ;
+20 IF (",1,2,3,4,7,")[BPRTYPE
Begin DoDot:1
+21 WRITE ?110,"Fill Type: "
+22 IF BPRTBCK=1
WRITE "RT,BB,P2,RS"
QUIT
+23 FOR I=1:1:$LENGTH(BPRTBCK,",")
if I'=1
WRITE ","
SET RTBCKX=$PIECE(BPRTBCK,",",I)
WRITE $SELECT(RTBCKX=2:"RT",RTBCKX=3:"BB",RTBCKX=4:"P2",RTBCKX=5:"RS",1:"")
End DoDot:1
+24 ;
+25 IF (",1,2,3,4,7,9,")[BPRTYPE
WRITE !,"Insurance: "_$SELECT(BPINSINF=0:"ALL",1:"SELECTED")
+26 ;
+27 IF (",5,6,8,")[BPRTYPE
Begin DoDot:1
+28 WRITE ?110,"Fill type: "_$SELECT(BPRTBCK=2:"RT",BPRTBCK=3:"BB",BPRTBCK=4:"P2",BPRTBCK=5:"RS",1:"RT,BB,P2,RS")
+29 WRITE !,"Insurance: "_$SELECT(BPINSINF=0:"ALL",1:$$BPINS(BPINSINF))
End DoDot:1
+30 ;
+31 IF (",7,")[BPRTYPE
WRITE ?44,"Close Reason: ",$SELECT(BPCCRSN'=0:"SELECTED",1:"ALL")
+32 IF (",4,")[BPRTYPE
Begin DoDot:1
+33 WRITE ?44,$JUSTIFY($SELECT(BPAUTREV=0:"ALL",1:"AUTO"),4)," Reversals"
+34 WRITE ?60,$JUSTIFY($SELECT(BPACREJ=1:"REJECTED",BPACREJ=2:"ACCEPTED",1:"ALL"),8)," Returned Status"
End DoDot:1
+35 ;
+36 IF (",5,6,8,")[BPRTYPE
WRITE ?87,"Drugs/Classes: "_$SELECT(BPQSTDRG=2:$$DRGNAM^BPSRPT6(BPDRUG,30),BPQSTDRG=3:$EXTRACT(BPDRGCL,1,30),1:"ALL")
+37 IF (",1,2,3,4,7,9,")[BPRTYPE
WRITE ?87,"Drugs/Classes: "_$SELECT(BPQSTDRG'=1:"SELECTED",1:"ALL")
+38 ;
+39 IF (",2,")[BPRTYPE
Begin DoDot:1
+40 WRITE !,"Reject Code: ",$SELECT(BPREJCD'=0:"SELECTED",1:"ALL")
+41 WRITE ?87,"Eligibility: "
Begin DoDot:2
+42 IF BPELIG1=0
WRITE "CVA,TRI,VET"
QUIT
+43 SET (ABVELIG,LIST,N)=""
FOR
SET N=$ORDER(BPELIG1(N))
if N=""
QUIT
Begin DoDot:3
+44 SET ABVELIG=$SELECT(N="C":"CVA",N="T":"TRI",N="V":"VET",1:"")
SET LIST=LIST_$GET(ABVELIG)_","
End DoDot:3
+45 WRITE $EXTRACT(LIST,1,$LENGTH(LIST)-1)
End DoDot:2
+46 WRITE ?113,"Open/Closed: ",$SELECT(BPOPCL=1:"CLOSED",BPOPCL=2:"OPEN",1:"ALL")
+47 WRITE !,"Prescriber: ",$SELECT(BPRESC'=0:"SELECTED",1:"ALL")
+48 WRITE ?91,"Patient: ",$SELECT(BPQSTPAT'=0:"SELECTED",1:"ALL")
End DoDot:1
+49 ;
+50 IF (",1,3,4,7,9,")[BPRTYPE
Begin DoDot:1
+51 WRITE !,"Eligibility: "
Begin DoDot:2
+52 ; ALL was selected
IF BPELIG1=0
WRITE "CVA,TRI,VET"
QUIT
+53 SET (ABVELIG,LIST,N)=""
FOR
SET N=$ORDER(BPELIG1(N))
if N=""
QUIT
Begin DoDot:3
+54 SET ABVELIG=$SELECT(N="C":"CVA",N="T":"TRI",N="V":"VET",1:"")
SET LIST=LIST_$GET(ABVELIG)_","
End DoDot:3
+55 WRITE $EXTRACT(LIST,1,$LENGTH(LIST)-1)
End DoDot:2
+56 WRITE ?91,"Patient: ",$SELECT(BPQSTPAT'=0:"SELECTED",1:"ALL")
End DoDot:1
+57 ;
+58 IF (",9,")[BPRTYPE
WRITE !,"NON-BILLABLE STATUS: "_$SELECT(BPNBSTS=0:"ALL",1:$$NBSTS(.BPNBSTS))
+59 ;
+60 IF BPRTYPE=10
Begin DoDot:1
+61 WRITE ?87,"Print Date: "_$GET(BPNOW)_" Page:",$JUSTIFY(BPPAGE,3)
+62 WRITE !,"DIVISION(S): ",$$GETDIVS^BPSRPT4(68,.BPPHARM)
+63 ; Fill Location, Fill Type and Drugs/Classes default to 'ALL', user not prompted
+64 WRITE ?86,"Fill Locations: ALL"
+65 WRITE ?110,"Fill Type: ALL"
+66 WRITE !,"Insurance: "_$SELECT(BPINSINF=0:"ALL",1:$$BPINS(BPINSINF))
+67 WRITE ?87,"Drugs/Classes: ALL"
+68 WRITE !,"Eligibility: "
Begin DoDot:2
+69 IF BPELIG1=0
WRITE "CVA,TRI,VET"
QUIT
+70 SET (ABVELIG,LIST,N)=""
FOR
SET N=$ORDER(BPELIG1(N))
if N=""
QUIT
Begin DoDot:3
+71 SET ABVELIG=$SELECT(N="C":"CVA",N="T":"TRI",N="V":"VET",1:"")
SET LIST=LIST_$GET(ABVELIG)_","
End DoDot:3
+72 WRITE $EXTRACT(LIST,1,$LENGTH(LIST)-1)
End DoDot:2
+73 WRITE ?93,"Patient: ",$SELECT(BPQSTPAT'=0:"SELECTED",1:"ALL")
+74 WRITE !,"Status: "_$SELECT(BPDUP=0:"ALL",1:BPDUP)
End DoDot:1
+75 ;
+76 WRITE !,$SELECT(BPRTYPE=5:"PRESCRIPTIONS",BPRLNRL=2:"RELEASED PRESCRIPTIONS",BPRLNRL=3:"PRESCRIPTIONS (NOT RELEASED)",1:"ALL PRESCRIPTIONS")
+77 WRITE " BY "_$SELECT(BPRTYPE=7:"CLOSE",1:"TRANSACTION")_" DATE: "
+78 WRITE "From "_$$DATTIM^BPSRPT1(BPBEGDT)_" through "_$$DATTIM^BPSRPT1($PIECE(BPENDDT,"."))
+79 ;
+80 IF BPRTYPE=10
Begin DoDot:1
+81 WRITE !!,"Status Codes: S= Duplicate of Approved, D= Duplicate of Paid, Q= Duplicate of Capture"
End DoDot:1
+82 ;
+83 DO ULINE^BPSRPT5("=")
if $GET(BPQ)
QUIT
+84 DO HEADLN1^BPSRPT4(BPRTYPE)
+85 DO HEADLN2^BPSRPT4(BPRTYPE)
+86 DO HEADLN3^BPSRPT4(BPRTYPE)
+87 DO ULINE^BPSRPT5("=")
+88 ;
+89 ;Print Division
+90 IF $GET(BPDIV)]""
Begin DoDot:1
+91 WRITE !,"DIVISION: ",$SELECT(BPDIV=0:"BLANK",BPDIV="ALL DIVISIONS":"ALL DIVISIONS",$$DIVNAME^BPSSCRDS(BPDIV)]"":$$DIVNAME^BPSSCRDS(BPDIV),1:BPDIV)
+92 IF BPRTYPE=5!(BPRTYPE=6)!(BPSUMDET=1)!(BPGRPLAN="")
DO ULINE^BPSRPT5("-")
End DoDot:1
+93 ;
+94 ;Print Insurance If Defined
+95 IF BPSUMDET=0
IF $GET(BPGRPLAN)]""
IF $GET(BPGRPLAN)'=0
IF $GET(BPGRPLAN)'="~"
DO WRPLAN^BPSRPT5(BPGRPLAN)
+96 QUIT
+97 ;
+98 ;Special Division Handling
+99 ;
BPDIV(BPDIV) QUIT $SELECT(BPDIV=0:"BLANK",$$DIVNAME^BPSSCRDS(BPDIV)]"":$$DIVNAME^BPSSCRDS(BPDIV),1:BPDIV)
+1 ;
+2 ;Get selected insurance names based on user selection
+3 ;If length is greater than 68 append "..."
+4 ;Input: BPINSINF = Semi-colon separated list of file 36 IENs
+5 ;Output: comma separated list of related file 36 names
BPINS(BPINSINF) ;
+1 NEW BPINS,BPINAME,RETV
+2 SET RETV=""
+3 FOR I=2:1
SET BPINS=$PIECE($GET(BPINSINF),";",I)
if BPINS=""
QUIT
Begin DoDot:1
+4 SET BPINAME=$$INSNM^IBNCPDPI(BPINS)
if BPINAME=""
QUIT
+5 IF RETV'=""
SET RETV=RETV_", "_BPINAME
QUIT
+6 SET RETV=BPINAME
End DoDot:1
+7 IF $LENGTH(RETV)>68
SET RETV=$EXTRACT(RETV,1,68)_"..."
+8 QUIT RETV
+9 ;
ELIG(ELIG) ;
+1 ; Display multiple eligibilities
+2 ; Input:
+3 ; ELIG - Array of multiple eligibilities
+4 ; Output
+5 ; Text of eligibilities
+6 ;
+7 IF $DATA(ELIG)=0
QUIT ""
+8 NEW N,LIST
+9 SET LIST=""
+10 SET N=""
FOR
SET N=$ORDER(ELIG(N))
if N=""
QUIT
Begin DoDot:1
+11 SET LIST=LIST_$GET(ELIG(N))_","
End DoDot:1
+12 QUIT $EXTRACT(LIST,1,$LENGTH(LIST)-1)
+13 ;
NBSTS(NBSTS) ;
+1 ; Display multiple non-billable statuses
+2 ; Input:
+3 ; NBSTS - Array of multiple non-billable statuses
+4 ; Output
+5 ; Text of non-billable statuses
+6 ;
+7 IF $DATA(NBSTS)=0
QUIT ""
+8 NEW N,LIST
+9 SET LIST=""
+10 SET N=""
FOR
SET N=$ORDER(NBSTS(N))
if N=""
QUIT
Begin DoDot:1
+11 SET LIST=LIST_$GET(NBSTS(N))_","
End DoDot:1
+12 QUIT $EXTRACT(LIST,1,$LENGTH(LIST)-1)
