BPSRPT5 ;BHAM ISC/BEE - ECME REPORTS ;14-FEB-05
;;1.0;E CLAIMS MGMT ENGINE;**1,3,5,7,8,10,11,19,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
;
;Routine to Display the Reports
;
; WRLINE1, WRLINE2 and WRLINE3 were moved to BPSRPT5A
;
;Display the Report
REPORT(REF,BPEXCEL,BPSCR,BPRPTNAM,BPSUMDET,BPPAGE) ;
N BPBIL,BPBLINE,BPCOLL,BPDFN,BPDIV,BPELTM,BPDPAY,BPGELTM,BPGBIL,BPGINS,BPGCOLL,BPGDPAY,BPGCNT,BPGRPLAN,BPINS,BPLINES,BPREC,BPREF,BPRX,BPSRTDT,BPSTATUS,BPX,BPSGTOT,NP,BPSDATA
N BPTBIL,BPTCOLL,BPTINS,BPTDPAY
N BPPSEQ,BPBILINF,BPRICINF,BPINSBIN
N BPGPRICE,BPG128,BPG129,BPG133,BPG134,BPG135,BPG136,BPG137
N BPIPRICE,BPI128,BPI129,BPI133,BPI134,BPI135,BPI136,BPI137
N BPTPRICE,BPT128,BPT129,BPT133,BPT134,BPT135,BPT136,BPT137
I '$D(@REF) D HDR^BPSRPT7(BPRTYPE,BPRPTNAM,.BPPAGE) W !,"No data meets the criteria." G XREPORT
S (BPGBIL,BPGINS,BPGCOLL,BPGDPAY,BPGCNT,BPGELTM,BPGPRICE,BPG128,BPG129,BPG133,BPG134,BPG135,BPG136,BPG137)=0
S BPDIV="" F S BPDIV=$O(@REF@(BPDIV)) Q:BPDIV="" D Q:BPQ
.S BPGRPLAN=""
.D HDR^BPSRPT7(BPRTYPE,BPRPTNAM,.BPPAGE)
.N BPCNT S (BPTBIL,BPTINS,BPTCOLL,BPTDPAY,BPCNT,BPELTM,BPTPRICE,BPT128,BPT129,BPT133,BPT134,BPT135,BPT136,BPT137)=0
.F S BPGRPLAN=$O(@REF@(BPDIV,BPGRPLAN)) Q:BPGRPLAN="" D Q:BPQ
.. S BPINSBIN=0
.. N BPSCLM,BPREC,BPTOT,BPIBIL,BPICNT,BPICOL,BPIINS,BPIDPAY
.. S (BPIBIL,BPICNT,BPICOL,BPIINS,BPIPRICE,BPIDPAY)=0
.. S (BPI128,BPI129,BPI133,BPI134,BPI135,BPI136,BPI137)=0
.. S BPDFN="" F S BPDFN=$O(@REF@(BPDIV,BPGRPLAN,BPDFN)) Q:BPDFN="" D Q:BPQ
... S BPSRTDT="" F S BPSRTDT=$O(@REF@(BPDIV,BPGRPLAN,BPDFN,BPSRTDT)) Q:BPSRTDT="" D Q:BPQ
.... S BPRX="" F S BPRX=$O(@REF@(BPDIV,BPGRPLAN,BPDFN,BPSRTDT,BPRX)) Q:BPRX="" D Q:BPQ
..... S BPREF="" F S BPREF=$O(@REF@(BPDIV,BPGRPLAN,BPDFN,BPSRTDT,BPRX,BPREF)) Q:BPREF="" D Q:BPQ
...... S BPX=@REF@(BPDIV,BPGRPLAN,BPDFN,BPSRTDT,BPRX,BPREF)
...... I BPSUMDET=0,BPINSBIN=0 D
....... D WRPLAN(BPGRPLAN) S BPINSBIN=1 ;Set Insurance/Bin Indicator
....... S BPBLINE="" ;Reset Blank Line Indicator
...... S BPCNT=BPCNT+1,BPGCNT=BPGCNT+1,BPICNT=BPICNT+1
...... S BPPSEQ=+$$COB59^BPSUTIL2($P(BPX,U,3))
...... I BPRTYPE=5 D
....... S BPELTM=BPELTM+$$ELAPSE^BPSRPT6($P(BPX,U,3))
....... S BPGELTM=BPGELTM+$$ELAPSE^BPSRPT6($P(BPX,U,3))
...... I BPRTYPE=9 D
....... S (BPBIL,BPINS,BPTINS,BPGINS,BPIINS,BPBILINF,BPCOLL,BPTCOLL,BPGCOLL,BPICOL)=""
....... S BPTBIL=BPTBIL+$P(BPX,U,2),BPGBIL=BPGBIL+$P(BPX,U,2),BPIBIL=BPIBIL+$P(BPX,U,2)
...... E D
....... S BPBIL=$$BILLED^BPSRPT7A($P(BPX,U,3)),BPTBIL=BPTBIL+BPBIL,BPGBIL=BPGBIL+BPBIL,BPIBIL=BPIBIL+BPBIL
....... S BPINS=$$INSPAID^BPSRPT2($P(BPX,U,3)),BPTINS=BPTINS+BPINS,BPGINS=BPGINS+BPINS,BPIINS=BPIINS+BPINS
....... S BPBILINF=$$COLLECTD^BPSRPT6(BPRX,BPREF,BPPSEQ)
....... S BPCOLL=+BPBILINF,BPTCOLL=BPTCOLL+BPCOLL,BPGCOLL=BPGCOLL+BPCOLL,BPICOL=BPICOL+BPCOLL
...... I BPRTYPE=10 D
....... S BPDPAY=$P(BPX,U,17)
....... S BPTDPAY=BPTDPAY+BPDPAY,BPGDPAY=BPGDPAY+BPDPAY,BPIDPAY=BPIDPAY+BPDPAY
...... I BPRTYPE=6 D Q
....... S BPSTATUS=$P(BPX,U,7)
....... I BPSTATUS["REJECT" S $P(BPSCLM(BPSRTDT),U,3)=$P($G(BPSCLM(BPSRTDT)),U,3)+BPBIL
....... I BPSTATUS["PAYABLE" S $P(BPSCLM(BPSRTDT),U,4)=$P($G(BPSCLM(BPSRTDT)),U,4)+BPBIL
....... S $P(BPSCLM(BPSRTDT),U,2)=$P($G(BPSCLM(BPSRTDT)),U,2)+BPBIL
....... S $P(BPSCLM(BPSRTDT),U,5)=$P($G(BPSCLM(BPSRTDT)),U,5)+BPINS
....... S $P(BPSCLM(BPSRTDT),U)=$P($G(BPSCLM(BPSRTDT)),U)+1
...... I BPRTYPE=8 D
....... ;Get Pricing Information for totals
....... S BPRICINF=$$PRICEVAL(+$P(BPX,U,3))
....... S BPI128=BPI128+$P($G(BPRICINF),U),BPI129=BPI129+$P($G(BPRICINF),U,2),BPI133=BPI133+$P($G(BPRICINF),U,3),BPI134=BPI134+$P($G(BPRICINF),U,4)
....... S BPI135=BPI135+$P($G(BPRICINF),U,5),BPI136=BPI136+$P($G(BPRICINF),U,6),BPI137=BPI137+$P($G(BPRICINF),U,7)
....... S BPT128=BPT128+$P($G(BPRICINF),U),BPT129=BPT129+$P($G(BPRICINF),U,2),BPT133=BPT133+$P($G(BPRICINF),U,3),BPT134=BPT134+$P($G(BPRICINF),U,4)
....... S BPT135=BPT135+$P($G(BPRICINF),U,5),BPT136=BPT136+$P($G(BPRICINF),U,6),BPT137=BPT137+$P($G(BPRICINF),U,7)
....... S BPG128=BPG128+$P($G(BPRICINF),U),BPG129=BPG129+$P($G(BPRICINF),U,2),BPG133=BPG133+$P($G(BPRICINF),U,3),BPG134=BPG134+$P($G(BPRICINF),U,4)
....... S BPG135=BPG135+$P($G(BPRICINF),U,5),BPG136=BPG136+$P($G(BPRICINF),U,6),BPG137=BPG137+$P($G(BPRICINF),U,7)
....... S BPIPRICE=BPI128_U_BPI129_U_BPI133_U_BPI134_U_BPI135_U_BPI136_U_BPI137
....... S BPTPRICE=BPT128_U_BPT129_U_BPT133_U_BPT134_U_BPT135_U_BPT136_U_BPT137
....... S BPGPRICE=BPG128_U_BPG129_U_BPG133_U_BPG134_U_BPG135_U_BPG136_U_BPG137
...... ;Display Detail Section
...... Q:BPSUMDET=1
...... S BPREC="" ;Reset Excel Display Variable
...... I 'BPEXCEL,BPRTYPE=1,BPBLINE=1 S NP=$$CHKP(2) Q:BPQ I BPBLINE=1 W ! ;Print blank line
...... S NP=$$CHKP(1) Q:BPQ D WRLINE1^BPSRPT5A(BPRTYPE,.BPREC,BPDIV,BPGRPLAN,BPDFN,BPRX,BPREF,BPX,BPSRTDT,BPBIL,BPINS,BPCOLL,BPEXCEL,BPPSEQ)
...... S NP=$$CHKP(1) Q:BPQ D WRLINE2^BPSRPT5A(BPRTYPE,.BPREC,BPX,BPRX,BPREF,BPBIL,BPGRPLAN,BPEXCEL,.BPICNT,BPPSEQ)
...... D WRLINE3^BPSRPT5A(BPRTYPE,.BPREC,BPX,BPEXCEL)
...... I (",2,7,8")[BPRTYPE,'BPEXCEL D Q:BPQ
....... D COMMENT(+$P(BPX,U,3)) Q:BPQ
....... S NP=$$CHKP(1) Q:BPQ
....... I (",2,")'[BPRTYPE W !,?10,"Claim ID: ",$$CLAIMID^BPSRPT2(+$P(BPX,U,3))
....... E W !,?10,$$DRGNAM^BPSRPT6($P(BPX,U,14),34)
....... N BPSARR,BPRJCNT,BPZZ S BPRJCNT=$$REJTEXT^BPSRPT2(+$P(BPX,U,3),.BPSARR)
....... F BPZZ=1:1:BPRJCNT S NP=$$CHKP(1) Q:BPQ W !,?10,BPSARR(BPZZ) Q:BPQ
...... I 'BPEXCEL,BPRTYPE=1 S BPBLINE=1 ;Set Blank Line Display Indicator
.. I BPRTYPE=6 D PTBDT^BPSRPT7A(BPDIV,BPSUMDET,.BPSCLM,.BPSGTOT)
.. I 'BPQ,(",1,2,3,4,7,8,9,10,")[(","_BPRTYPE_","),'BPEXCEL S NP=$$CHKP(5) Q:BPQ D ITOT^BPSRPT7A(BPRTYPE,BPDIV,BPGRPLAN,BPIBIL,BPIINS,BPICOL,BPIDPAY,.BPICNT,BPIPRICE)
.I 'BPEXCEL,'BPQ,BPRTYPE'=6 S NP=$$CHKP(5) Q:BPQ D TOTALS^BPSRPT7(BPRTYPE,BPDIV,BPTBIL,BPTINS,BPTCOLL,BPTDPAY,.BPCNT,BPELTM,BPTPRICE)
.I 'BPEXCEL,'BPQ,$O(@REF@(BPDIV))]"" D:$G(BPSCR) PAUSE^BPSRPT1 Q:BPQ
;Print Grand Totals
I 'BPEXCEL D
.I 'BPQ,BPRTYPE=6 D PGTOT6^BPSRPT7A($G(BPSGTOT))
.I 'BPQ,BPRTYPE'=6 S NP=$$CHKP(5) Q:BPQ D PGTOT^BPSRPT7A(BPRTYPE,BPGBIL,BPGINS,BPGCOLL,BPGDPAY,.BPGCNT,BPGELTM,BPGPRICE)
;
XREPORT Q
;
;Display Comments
;Input Variable: BP59 - Lookup to BPS TRANSACTION (#59)
S I="" F S I=$O(^BPST(BP59,11,"B",I),-1) Q:'I D Q:BPQ
.S NP=$$CHKP(1) Q:BPQ
.S J=$O(^BPST(BP59,11,"B",I,"")) Q:J=""
.S CNODE=$G(^BPST(BP59,11,J,0))
.W !,?10,$$DATTIM^BPSRPT1(+$P($P(CNODE,U),"."))," - ",$P(CNODE,U,3)
Q
;
;Display the Insurance
; Input Variable -> BPSDATA -> if 0, skip page check
; BPEXCEL -> 1 - Print to Excel/0 Regular Display
WRPLAN(BPGRPLAN) ;
N GPIEN,INS,NP
;
I BPSUMDET'=0 Q
I BPEXCEL Q
;Skip for Recent Transactions and Totals by Date Reports
I BPRTYPE=5!(BPRTYPE=6) Q
I $G(BPSDATA) S NP=$$CHKP(5) Q:BPQ!NP
;Get and display the Insurance Name
S INS=$E(BPGRPLAN,1,90)
I INS]"" D
. D ULINE("-")
. W !,INS
. ;include the Insurance Bin after the Insurance name
. I (",2,")[BPRTYPE D
. . W " - ",$$INSBIN^BPSRPT6($P(BPX,U,3))
. D ULINE("-")
Q
;
;Check for End of Page
; Input variables -> BPLINES -> Number of lines from bottom
; BPEXCEL -> 1 - Print to Excel/0 Regular Display
; Output variable -> BPSDATA -> 0 -> New screen, no data displayed yet
; 1 -> Data displayed on current screen
CHKP(BPLINES) Q:$G(BPEXCEL) 0
S BPLINES=BPLINES+1
I $G(BPSCR) S BPLINES=BPLINES+2
I $G(BPSCR),'$G(BPSDATA) S BPSDATA=1 Q 0
S BPSDATA=1
I $Y>(IOSL-BPLINES) D:$G(BPSCR) PAUSE^BPSRPT1 Q:$G(BPQ) 0 D HDR^BPSRPT7(BPRTYPE,BPRPTNAM,.BPPAGE) Q 1
Q 0
;
;Print one line of characters
ULINE(X) N I
W ! F I=1:1:132 W $G(X,"-")
Q
BILLCOB(BPRX,BPREF,BPPSEQ) ;
N BPSBILL
S BPSBILL=$$BILL^BPSRPT6(BPRX,BPREF,BPPSEQ)
I BPSBILL="" Q ""
Q $J(BPSBILL_" "_$$RXCOB^BPSRPT8(BPPSEQ)_" ",17)
;
PRICING(BP59) ; Check if the Spending Account Remaining field has non-zero data
; Returns: 1 if true, 0 if not
N BPSRESP,BPSPOS
D RESP59^BPSRPT2(BP59,.BPSRESP,.BPSPOS)
Q:(BPSRESP="")!(BPSPOS="") 0
I +$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,BPSPOS,120)),U,8)) Q 1
Q 0
;
PRICEVAL(BP59) ;
N BPSRESP,BPSPOS,RETV,BPS120,BPS130
S RETV=0
D RESP59^BPSRPT2(BP59,.BPSRESP,.BPSPOS)
Q:(BPSRESP="")!(BPSPOS="") RETV
S BPS120=$G(^BPSR(BPSRESP,1000,BPSPOS,120)),BPS130=$G(^BPSR(BPSRESP,1000,BPSPOS,130))
S RETV=$$DFF2EXT^BPSECFM($P($G(BPS120),U,8))_U_$$DFF2EXT^BPSECFM($P($G(BPS120),U,9))_U_$$DFF2EXT^BPSECFM($P($G(BPS130),U,3))_U_$$DFF2EXT^BPSECFM($P($G(BPS130),U,4))
S RETV=RETV_U_$$DFF2EXT^BPSECFM($P($G(BPS130),U,5))_U_$$DFF2EXT^BPSECFM($P($G(BPS130),U,6))_U_$$DFF2EXT^BPSECFM($P($G(BPS130),U,7))
Q RETV
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSRPT5 9046 printed Dec 13, 2024@01:52:45 Page 2
BPSRPT5 ;BHAM ISC/BEE - ECME REPORTS ;14-FEB-05
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,3,5,7,8,10,11,19,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 ;Routine to Display the Reports
+7 ;
+8 ; WRLINE1, WRLINE2 and WRLINE3 were moved to BPSRPT5A
+9 ;
+10 ;Display the Report
REPORT(REF,BPEXCEL,BPSCR,BPRPTNAM,BPSUMDET,BPPAGE) ;
+1 NEW BPBIL,BPBLINE,BPCOLL,BPDFN,BPDIV,BPELTM,BPDPAY,BPGELTM,BPGBIL,BPGINS,BPGCOLL,BPGDPAY,BPGCNT,BPGRPLAN,BPINS,BPLINES,BPREC,BPREF,BPRX,BPSRTDT,BPSTATUS,BPX,BPSGTOT,NP,BPSDATA
+2 NEW BPTBIL,BPTCOLL,BPTINS,BPTDPAY
+3 NEW BPPSEQ,BPBILINF,BPRICINF,BPINSBIN
+4 NEW BPGPRICE,BPG128,BPG129,BPG133,BPG134,BPG135,BPG136,BPG137
+5 NEW BPIPRICE,BPI128,BPI129,BPI133,BPI134,BPI135,BPI136,BPI137
+6 NEW BPTPRICE,BPT128,BPT129,BPT133,BPT134,BPT135,BPT136,BPT137
+7 IF '$DATA(@REF)
DO HDR^BPSRPT7(BPRTYPE,BPRPTNAM,.BPPAGE)
WRITE !,"No data meets the criteria."
GOTO XREPORT
+8 SET (BPGBIL,BPGINS,BPGCOLL,BPGDPAY,BPGCNT,BPGELTM,BPGPRICE,BPG128,BPG129,BPG133,BPG134,BPG135,BPG136,BPG137)=0
+9 SET BPDIV=""
FOR
SET BPDIV=$ORDER(@REF@(BPDIV))
if BPDIV=""
QUIT
Begin DoDot:1
+10 SET BPGRPLAN=""
+11 DO HDR^BPSRPT7(BPRTYPE,BPRPTNAM,.BPPAGE)
+12 NEW BPCNT
SET (BPTBIL,BPTINS,BPTCOLL,BPTDPAY,BPCNT,BPELTM,BPTPRICE,BPT128,BPT129,BPT133,BPT134,BPT135,BPT136,BPT137)=0
+13 FOR
SET BPGRPLAN=$ORDER(@REF@(BPDIV,BPGRPLAN))
if BPGRPLAN=""
QUIT
Begin DoDot:2
+14 SET BPINSBIN=0
+15 NEW BPSCLM,BPREC,BPTOT,BPIBIL,BPICNT,BPICOL,BPIINS,BPIDPAY
+16 SET (BPIBIL,BPICNT,BPICOL,BPIINS,BPIPRICE,BPIDPAY)=0
+17 SET (BPI128,BPI129,BPI133,BPI134,BPI135,BPI136,BPI137)=0
+18 SET BPDFN=""
FOR
SET BPDFN=$ORDER(@REF@(BPDIV,BPGRPLAN,BPDFN))
if BPDFN=""
QUIT
Begin DoDot:3
+19 SET BPSRTDT=""
FOR
SET BPSRTDT=$ORDER(@REF@(BPDIV,BPGRPLAN,BPDFN,BPSRTDT))
if BPSRTDT=""
QUIT
Begin DoDot:4
+20 SET BPRX=""
FOR
SET BPRX=$ORDER(@REF@(BPDIV,BPGRPLAN,BPDFN,BPSRTDT,BPRX))
if BPRX=""
QUIT
Begin DoDot:5
+21 SET BPREF=""
FOR
SET BPREF=$ORDER(@REF@(BPDIV,BPGRPLAN,BPDFN,BPSRTDT,BPRX,BPREF))
if BPREF=""
QUIT
Begin DoDot:6
+22 SET BPX=@REF@(BPDIV,BPGRPLAN,BPDFN,BPSRTDT,BPRX,BPREF)
+23 IF BPSUMDET=0
IF BPINSBIN=0
Begin DoDot:7
+24 ;Set Insurance/Bin Indicator
DO WRPLAN(BPGRPLAN)
SET BPINSBIN=1
+25 ;Reset Blank Line Indicator
SET BPBLINE=""
End DoDot:7
+26 SET BPCNT=BPCNT+1
SET BPGCNT=BPGCNT+1
SET BPICNT=BPICNT+1
+27 SET BPPSEQ=+$$COB59^BPSUTIL2($PIECE(BPX,U,3))
+28 IF BPRTYPE=5
Begin DoDot:7
+29 SET BPELTM=BPELTM+$$ELAPSE^BPSRPT6($PIECE(BPX,U,3))
+30 SET BPGELTM=BPGELTM+$$ELAPSE^BPSRPT6($PIECE(BPX,U,3))
End DoDot:7
+31 IF BPRTYPE=9
Begin DoDot:7
+32 SET (BPBIL,BPINS,BPTINS,BPGINS,BPIINS,BPBILINF,BPCOLL,BPTCOLL,BPGCOLL,BPICOL)=""
+33 SET BPTBIL=BPTBIL+$PIECE(BPX,U,2)
SET BPGBIL=BPGBIL+$PIECE(BPX,U,2)
SET BPIBIL=BPIBIL+$PIECE(BPX,U,2)
End DoDot:7
+34 IF '$TEST
Begin DoDot:7
+35 SET BPBIL=$$BILLED^BPSRPT7A($PIECE(BPX,U,3))
SET BPTBIL=BPTBIL+BPBIL
SET BPGBIL=BPGBIL+BPBIL
SET BPIBIL=BPIBIL+BPBIL
+36 SET BPINS=$$INSPAID^BPSRPT2($PIECE(BPX,U,3))
SET BPTINS=BPTINS+BPINS
SET BPGINS=BPGINS+BPINS
SET BPIINS=BPIINS+BPINS
+37 SET BPBILINF=$$COLLECTD^BPSRPT6(BPRX,BPREF,BPPSEQ)
+38 SET BPCOLL=+BPBILINF
SET BPTCOLL=BPTCOLL+BPCOLL
SET BPGCOLL=BPGCOLL+BPCOLL
SET BPICOL=BPICOL+BPCOLL
End DoDot:7
+39 IF BPRTYPE=10
Begin DoDot:7
+40 SET BPDPAY=$PIECE(BPX,U,17)
+41 SET BPTDPAY=BPTDPAY+BPDPAY
SET BPGDPAY=BPGDPAY+BPDPAY
SET BPIDPAY=BPIDPAY+BPDPAY
End DoDot:7
+42 IF BPRTYPE=6
Begin DoDot:7
+43 SET BPSTATUS=$PIECE(BPX,U,7)
+44 IF BPSTATUS["REJECT"
SET $PIECE(BPSCLM(BPSRTDT),U,3)=$PIECE($GET(BPSCLM(BPSRTDT)),U,3)+BPBIL
+45 IF BPSTATUS["PAYABLE"
SET $PIECE(BPSCLM(BPSRTDT),U,4)=$PIECE($GET(BPSCLM(BPSRTDT)),U,4)+BPBIL
+46 SET $PIECE(BPSCLM(BPSRTDT),U,2)=$PIECE($GET(BPSCLM(BPSRTDT)),U,2)+BPBIL
+47 SET $PIECE(BPSCLM(BPSRTDT),U,5)=$PIECE($GET(BPSCLM(BPSRTDT)),U,5)+BPINS
+48 SET $PIECE(BPSCLM(BPSRTDT),U)=$PIECE($GET(BPSCLM(BPSRTDT)),U)+1
End DoDot:7
QUIT
+49 IF BPRTYPE=8
Begin DoDot:7
+50 ;Get Pricing Information for totals
+51 SET BPRICINF=$$PRICEVAL(+$PIECE(BPX,U,3))
+52 SET BPI128=BPI128+$PIECE($GET(BPRICINF),U)
SET BPI129=BPI129+$PIECE($GET(BPRICINF),U,2)
SET BPI133=BPI133+$PIECE($GET(BPRICINF),U,3)
SET BPI134=BPI134+$PIECE($GET(BPRICINF),U,4)
+53 SET BPI135=BPI135+$PIECE($GET(BPRICINF),U,5)
SET BPI136=BPI136+$PIECE($GET(BPRICINF),U,6)
SET BPI137=BPI137+$PIECE($GET(BPRICINF),U,7)
+54 SET BPT128=BPT128+$PIECE($GET(BPRICINF),U)
SET BPT129=BPT129+$PIECE($GET(BPRICINF),U,2)
SET BPT133=BPT133+$PIECE($GET(BPRICINF),U,3)
SET BPT134=BPT134+$PIECE($GET(BPRICINF),U,4)
+55 SET BPT135=BPT135+$PIECE($GET(BPRICINF),U,5)
SET BPT136=BPT136+$PIECE($GET(BPRICINF),U,6)
SET BPT137=BPT137+$PIECE($GET(BPRICINF),U,7)
+56 SET BPG128=BPG128+$PIECE($GET(BPRICINF),U)
SET BPG129=BPG129+$PIECE($GET(BPRICINF),U,2)
SET BPG133=BPG133+$PIECE($GET(BPRICINF),U,3)
SET BPG134=BPG134+$PIECE($GET(BPRICINF),U,4)
+57 SET BPG135=BPG135+$PIECE($GET(BPRICINF),U,5)
SET BPG136=BPG136+$PIECE($GET(BPRICINF),U,6)
SET BPG137=BPG137+$PIECE($GET(BPRICINF),U,7)
+58 SET BPIPRICE=BPI128_U_BPI129_U_BPI133_U_BPI134_U_BPI135_U_BPI136_U_BPI137
+59 SET BPTPRICE=BPT128_U_BPT129_U_BPT133_U_BPT134_U_BPT135_U_BPT136_U_BPT137
+60 SET BPGPRICE=BPG128_U_BPG129_U_BPG133_U_BPG134_U_BPG135_U_BPG136_U_BPG137
End DoDot:7
+61 ;Display Detail Section
+62 if BPSUMDET=1
QUIT
+63 ;Reset Excel Display Variable
SET BPREC=""
+64 ;Print blank line
IF 'BPEXCEL
IF BPRTYPE=1
IF BPBLINE=1
SET NP=$$CHKP(2)
if BPQ
QUIT
IF BPBLINE=1
WRITE !
+65 SET NP=$$CHKP(1)
if BPQ
QUIT
DO WRLINE1^BPSRPT5A(BPRTYPE,.BPREC,BPDIV,BPGRPLAN,BPDFN,BPRX,BPREF,BPX,BPSRTDT,BPBIL,BPINS,BPCOLL,BPEXCEL,BPPSEQ)
+66 SET NP=$$CHKP(1)
if BPQ
QUIT
DO WRLINE2^BPSRPT5A(BPRTYPE,.BPREC,BPX,BPRX,BPREF,BPBIL,BPGRPLAN,BPEXCEL,.BPICNT,BPPSEQ)
+67 DO WRLINE3^BPSRPT5A(BPRTYPE,.BPREC,BPX,BPEXCEL)
+68 IF (",2,7,8")[BPRTYPE
IF 'BPEXCEL
Begin DoDot:7
+69 DO COMMENT(+$PIECE(BPX,U,3))
if BPQ
QUIT
+70 SET NP=$$CHKP(1)
if BPQ
QUIT
+71 IF (",2,")'[BPRTYPE
WRITE !,?10,"Claim ID: ",$$CLAIMID^BPSRPT2(+$PIECE(BPX,U,3))
+72 IF '$TEST
WRITE !,?10,$$DRGNAM^BPSRPT6($PIECE(BPX,U,14),34)
+73 NEW BPSARR,BPRJCNT,BPZZ
SET BPRJCNT=$$REJTEXT^BPSRPT2(+$PIECE(BPX,U,3),.BPSARR)
+74 FOR BPZZ=1:1:BPRJCNT
SET NP=$$CHKP(1)
if BPQ
QUIT
WRITE !,?10,BPSARR(BPZZ)
if BPQ
QUIT
End DoDot:7
if BPQ
QUIT
+75 ;Set Blank Line Display Indicator
IF 'BPEXCEL
IF BPRTYPE=1
SET BPBLINE=1
End DoDot:6
if BPQ
QUIT
End DoDot:5
if BPQ
QUIT
End DoDot:4
if BPQ
QUIT
End DoDot:3
if BPQ
QUIT
+76 IF BPRTYPE=6
DO PTBDT^BPSRPT7A(BPDIV,BPSUMDET,.BPSCLM,.BPSGTOT)
+77 IF 'BPQ
IF (",1,2,3,4,7,8,9,10,")[(","_BPRTYPE_",")
IF 'BPEXCEL
SET NP=$$CHKP(5)
if BPQ
QUIT
DO ITOT^BPSRPT7A(BPRTYPE,BPDIV,BPGRPLAN,BPIBIL,BPIINS,BPICOL,BPIDPAY,.BPICNT,BPIPRICE)
End DoDot:2
if BPQ
QUIT
+78 IF 'BPEXCEL
IF 'BPQ
IF BPRTYPE'=6
SET NP=$$CHKP(5)
if BPQ
QUIT
DO TOTALS^BPSRPT7(BPRTYPE,BPDIV,BPTBIL,BPTINS,BPTCOLL,BPTDPAY,.BPCNT,BPELTM,BPTPRICE)
+79 IF 'BPEXCEL
IF 'BPQ
IF $ORDER(@REF@(BPDIV))]""
if $GET(BPSCR)
DO PAUSE^BPSRPT1
if BPQ
QUIT
End DoDot:1
if BPQ
QUIT
+80 ;Print Grand Totals
+81 IF 'BPEXCEL
Begin DoDot:1
+82 IF 'BPQ
IF BPRTYPE=6
DO PGTOT6^BPSRPT7A($GET(BPSGTOT))
+83 IF 'BPQ
IF BPRTYPE'=6
SET NP=$$CHKP(5)
if BPQ
QUIT
DO PGTOT^BPSRPT7A(BPRTYPE,BPGBIL,BPGINS,BPGCOLL,BPGDPAY,.BPGCNT,BPGELTM,BPGPRICE)
End DoDot:1
+84 ;
XREPORT QUIT
+1 ;
+2 ;Display Comments
+3 ;Input Variable: BP59 - Lookup to BPS TRANSACTION (#59)
+1 SET I=""
FOR
SET I=$ORDER(^BPST(BP59,11,"B",I),-1)
if 'I
QUIT
Begin DoDot:1
+2 SET NP=$$CHKP(1)
if BPQ
QUIT
+3 SET J=$ORDER(^BPST(BP59,11,"B",I,""))
if J=""
QUIT
+4 SET CNODE=$GET(^BPST(BP59,11,J,0))
+5 WRITE !,?10,$$DATTIM^BPSRPT1(+$PIECE($PIECE(CNODE,U),"."))," - ",$PIECE(CNODE,U,3)
End DoDot:1
if BPQ
QUIT
+6 QUIT
+7 ;
+8 ;Display the Insurance
+9 ; Input Variable -> BPSDATA -> if 0, skip page check
+10 ; BPEXCEL -> 1 - Print to Excel/0 Regular Display
WRPLAN(BPGRPLAN) ;
+1 NEW GPIEN,INS,NP
+2 ;
+3 IF BPSUMDET'=0
QUIT
+4 IF BPEXCEL
QUIT
+5 ;Skip for Recent Transactions and Totals by Date Reports
+6 IF BPRTYPE=5!(BPRTYPE=6)
QUIT
+7 IF $GET(BPSDATA)
SET NP=$$CHKP(5)
if BPQ!NP
QUIT
+8 ;Get and display the Insurance Name
+9 SET INS=$EXTRACT(BPGRPLAN,1,90)
+10 IF INS]""
Begin DoDot:1
+11 DO ULINE("-")
+12 WRITE !,INS
+13 ;include the Insurance Bin after the Insurance name
+14 IF (",2,")[BPRTYPE
Begin DoDot:2
+15 WRITE " - ",$$INSBIN^BPSRPT6($PIECE(BPX,U,3))
End DoDot:2
+16 DO ULINE("-")
End DoDot:1
+17 QUIT
+18 ;
+19 ;Check for End of Page
+20 ; Input variables -> BPLINES -> Number of lines from bottom
+21 ; BPEXCEL -> 1 - Print to Excel/0 Regular Display
+22 ; Output variable -> BPSDATA -> 0 -> New screen, no data displayed yet
+23 ; 1 -> Data displayed on current screen
CHKP(BPLINES) if $GET(BPEXCEL)
QUIT 0
+1 SET BPLINES=BPLINES+1
+2 IF $GET(BPSCR)
SET BPLINES=BPLINES+2
+3 IF $GET(BPSCR)
IF '$GET(BPSDATA)
SET BPSDATA=1
QUIT 0
+4 SET BPSDATA=1
+5 IF $Y>(IOSL-BPLINES)
if $GET(BPSCR)
DO PAUSE^BPSRPT1
if $GET(BPQ)
QUIT 0
DO HDR^BPSRPT7(BPRTYPE,BPRPTNAM,.BPPAGE)
QUIT 1
+6 QUIT 0
+7 ;
+8 ;Print one line of characters
ULINE(X) NEW I
+1 WRITE !
FOR I=1:1:132
WRITE $GET(X,"-")
+2 QUIT
BILLCOB(BPRX,BPREF,BPPSEQ) ;
+1 NEW BPSBILL
+2 SET BPSBILL=$$BILL^BPSRPT6(BPRX,BPREF,BPPSEQ)
+3 IF BPSBILL=""
QUIT ""
+4 QUIT $JUSTIFY(BPSBILL_" "_$$RXCOB^BPSRPT8(BPPSEQ)_" ",17)
+5 ;
PRICING(BP59) ; Check if the Spending Account Remaining field has non-zero data
+1 ; Returns: 1 if true, 0 if not
+2 NEW BPSRESP,BPSPOS
+3 DO RESP59^BPSRPT2(BP59,.BPSRESP,.BPSPOS)
+4 if (BPSRESP="")!(BPSPOS="")
QUIT 0
+5 IF +$$DFF2EXT^BPSECFM($PIECE($GET(^BPSR(BPSRESP,1000,BPSPOS,120)),U,8))
QUIT 1
+6 QUIT 0
+7 ;
PRICEVAL(BP59) ;
+1 NEW BPSRESP,BPSPOS,RETV,BPS120,BPS130
+2 SET RETV=0
+3 DO RESP59^BPSRPT2(BP59,.BPSRESP,.BPSPOS)
+4 if (BPSRESP="")!(BPSPOS="")
QUIT RETV
+5 SET BPS120=$GET(^BPSR(BPSRESP,1000,BPSPOS,120))
SET BPS130=$GET(^BPSR(BPSRESP,1000,BPSPOS,130))
+6 SET RETV=$$DFF2EXT^BPSECFM($PIECE($GET(BPS120),U,8))_U_$$DFF2EXT^BPSECFM($PIECE($GET(BPS120),U,9))_U_$$DFF2EXT^BPSECFM($PIECE($GET(BPS130),U,3))_U_$$DFF2EXT^BPSECFM($PIECE($GET(BPS130),U,4))
+7 SET RETV=RETV_U_$$DFF2EXT^BPSECFM($PIECE($GET(BPS130),U,5))_U_$$DFF2EXT^BPSECFM($PIECE($GET(BPS130),U,6))_U_$$DFF2EXT^BPSECFM($PIECE($GET(BPS130),U,7))
+8 QUIT RETV
+9 ;
