BPSOPR3 ;ALB/PHH - OPECC Productivity Report Print ;9/21/2015
;;1.0;E CLAIMS MGMT ENGINE;**20**;JUN 2004;Build 27
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
PRINT ; Entry point for printing the report
N BPSPG,BPSHDR,BPSIDX,BPSQUIT,DIR,DIRUT,DUOUT,DTOUT
;
S BPSPG=1
;
I 'BPEXCEL D
.D HDRINIT(.BPSHDR)
.D HDR(.BPSHDR,BPSPG)
;
; User chose to export the report to Excel
I BPEXCEL D
.W !,"DIVISION^USER^CURRENT STATUS^#TRANS IN DT RANGE^#TRANS TOTAL^ELIG^RX#^REF^ECME#^COB^DOS^TRANS DATE^PAID AMT"
;
S (BPSIDX,BPSQUIT)=0
F S BPSIDX=$O(@BPGLTMP@("REPORT",BPSIDX)) Q:'BPSIDX!(BPSQUIT) D
.W !,@BPGLTMP@("REPORT",BPSIDX)
.Q:BPEXCEL
.I $Y>(IOSL-3) D
..I $E(IOST,1,2)="C-" D
...W !
...S DIR(0)="E"
...D ^DIR
...K DIR
...I $D(DIRUT)!($D(DUOUT)) S BPSQUIT=1 K DIRUT,DTOUT,DUOUT
..Q:BPSQUIT
..S BPSPG=BPSPG+1
..D HDR(.BPSHDR,BPSPG)
;
I 'BPEXCEL W !!?5,"*** End of Report ***"
W !
I '$D(ZTQUEUED) U 0 S DIR(0)="E" D ^DIR K DIR U IO
Q
;
HDR(BPSHDR,BPSPG) ; Print header
N BPSOHDR1,BPSTMP,X
;
S (BPSOHDR1,BPSTMP)=BPSHDR(1)
D ADDCHAR(.BPSTMP," ",3-$L(BPSPG))
S BPSTMP=BPSTMP_BPSPG
S BPSHDR(1)=BPSTMP
;
W @IOF
F X=1:1:9 W !,BPSHDR(X)
;
S BPSHDR(1)=BPSOHDR1
Q
;
HDRINIT(BPSHDR) ; Setup header
N BPSRPTNM,BPSDTTM,HDR1,HDR2,X,BPSDIVNM,HDR3,HDR4,BPSUSRNM,HDR6,HDR7
;
S BPSRPTNM="OPECC PRODUCTIVITY "_$S(BPSUMDET=1:"SUMMARY ",1:"DETAIL ")_"REPORT"
S BPSDTTM=$$HTE^XLFDT($H)
S HDR1=BPSRPTNM
D ADDCHAR(.HDR1," ",$S(BPSUMDET=1:53,1:54))
S HDR1=HDR1_"Print Date: "_BPSDTTM
D ADDCHAR(.HDR1," ",121-$L(HDR1))
S HDR1=HDR1_"Page:"
S BPSHDR(1)=HDR1
;
S HDR2="DIVISION(S): "
I BPPHARM=0 S HDR2=HDR2_"ALL"
I BPPHARM=1 D
.S X=0
.F S X=$O(BPPHARM(X)) Q:'X S BPSDIVNM($P(BPPHARM(X),U,2))=""
.S X=""
.F S X=$O(BPSDIVNM(X)) Q:X="" D
..S HDR2=HDR2_X_", "
.S HDR2=$E(HDR2,1,$L(HDR2)-2)
S BPSHDR(2)=$E(HDR2,1,129)
;
S HDR3="ELIGIBILITY: "
I BPELIG=0 S HDR3=HDR3_"ALL"
I BPELIG=1 D
.S X=""
.F S X=$O(BPELIG(X)) Q:X="" D
..S HDR3=HDR3_$S(X="V":"VETERAN",X="T":"TRICARE",X="C":"CHAMPVA",1:"")_", "
.S HDR3=$E(HDR3,1,$L(HDR3)-2)
S BPSHDR(3)=HDR3
;
S HDR4="USERS: "
I BPUSER=0 S HDR4=HDR4_"ALL"
I BPUSER=1 D
.S X=0
.F S X=$O(BPUSER(X)) Q:'X S BPSUSRNM($P(BPUSER(X),U,2))=""
.S X=""
.F S X=$O(BPSUSRNM(X)) Q:X="" D
..S HDR4=HDR4_X_", "
.S HDR4=$E(HDR4,1,$L(HDR4)-2)
S BPSHDR(4)=$E(HDR4,1,129)
;
S BPSHDR(5)="ALL PRESCRIPTIONS BY TRANSACTION DATE: From "_$$FMTE^XLFDT(BPBEGDT,2)_" through "_$$FMTE^XLFDT(BPENDDT\1,2)
;
S HDR6=""
D ADDCHAR(.HDR6,"=",129)
S BPSHDR(6)=HDR6
;
S HDR7=""
D ADDCHAR(.HDR7," ",17)
S HDR7=HDR7_"CURRENT # TRANSACTIONS"
S BPSHDR(7)=HDR7
;
S BPSHDR(8)="USER STATUS DT RANGE TOTAL ELIG RX# REF/ECME# COB DOS TRANS DATE PAID AMT"
;
S BPSHDR(9)=HDR6
Q
;
ADDCHAR(BPSTXSTR,BPSCHAR,BPSCNT) ; Add characters to string
N X
Q:BPSCNT<1
F X=1:1:BPSCNT S BPSTXSTR=BPSTXSTR_BPSCHAR
Q
;
PROCESS(BP57) ; Process each Entry
N BPSCOB,BPRX,BPREF,BPSRXFC,BPSTRTYP,BPSDIV,BPSTATUS,BPSECME,BPSDOS
N BPSTRDT,BPSEC,BPSUSER,BPSPAMT,BPSRXFCI,BPSPRVST,BPSPRVAM,BPSPRVUT,BPSRJFND
;
; Get COB
S BPSCOB=$S($P($G(^BPSTL(BP57,0)),U,14):$P(^BPSTL(BP57,0),U,14),1:$E($P($P($G(^BPSTL(BP57,0)),U),".",2),5,5))
;
; Get RX#
S BPRX=+$P($G(^BPSTL(BP57,1)),U,11)
;
; Get REF - FILL NUMBER field #9 in 9002313.57
S BPREF=+$P($G(^BPSTL(BP57,1)),U)
;
; Unique ID for RX#-Fill#-COB to separate display line/counters
S BPSRXFC=BPRX_"-"_BPREF_"-"_BPSCOB
;
; Get Transaction Type
S BPSTRTYP=$P($G(^BPSTL(BP57,0)),U,15)
; Skip eligibility verification transactions
I BPSTRTYP="E" Q
;
; Limit report to the following RX ACTION field #1201 values
I '$F(".BB.ERES.ERWV.ERNB.EREV.P2.P2S.","."_$P($G(^BPSTL(BP57,12)),U,1)_".") Q
;
; Check for correct BPS Pharmacy (DIVISION)
S BPSDIV=+$P($G(^BPSTL(BP57,1)),U,7)
I BPPHARM=1,'$D(BPPHARM(BPSDIV)) Q
S BPSDIV=$$GET1^DIQ(9002313.56,BPSDIV,.01)
I BPSDIV="" Q
;
; Get Status
S BPSTATUS=$P($P($$STATUS^BPSOSRX(BPRX,BPREF,0,,BPSCOB),U),"E ",2)
;
; Get ECME
S BPSECME=$$ECMENUM^BPSOPR2(BP57)
;
; Get Date of Service
S BPSDOS=$$DATTIM^BPSRPT1(+$P($G(^BPSTL(BP57,12)),U,2))
;
; Get Trans Date
S BPSTRDT=$P($G(^BPSTL(BP57,0)),U,8)
I BPSTRDT="" Q
;
; Check for Eligibility Code
S BPSEC=$P($G(^BPSTL(BP57,9)),U,4)
I BPSEC="" Q
I BPELIG=1,'$D(BPELIG(BPSEC)) Q
;
; Update general RXFC info
S $P(@BPGLTMP@("DATA",BPSRXFC,BPSDIV),"^")=+$P($G(@BPGLTMP@("DATA",BPSRXFC,BPSDIV)),"^")+1
I BPSTATUS'="" S $P(@BPGLTMP@("DATA",BPSRXFC,BPSDIV),"^",3)=BPSTATUS
;
; Get User
S BPSUSER=+$P($G(^BPSTL(BP57,0)),U,10)
I BPUSER=1,'$D(BPUSER(BPSUSER)),'$D(@BPGLTMP@("DATA",BPSRXFC,BPSDIV)) Q
S BPSUSER=$$GET1^DIQ(200,BPSUSER,.01)
I BPSUSER="" Q
;
; Get Paid Amount
S BPSPAMT=$P($G(@BPGLTMP@("DATA",BPSRXFC,BPSDIV)),"^",4),BPSRXFCI=""
I BPSPAMT="" D
.S BPSRXFCI=$$GETRXFCI^BPSOPR2(BPSDIV,BPRX,BPREF,BPSCOB)
.S $P(@BPGLTMP@("DATA",BPSRXFC,BPSDIV),"^",2)=$P(BPSRXFCI,"^",3)
.S $P(@BPGLTMP@("DATA",BPSRXFC,BPSDIV),"^",4)=$S($P(BPSRXFCI,"^")="":0,1:$P(BPSRXFCI,"^"))
.S $P(@BPGLTMP@("DATA",BPSRXFC,BPSDIV),"^",6)=$P(BPSRXFCI,"^",2)
.I $P(BPSRXFCI,"^",4)="N",$P($G(@BPGLTMP@("DATA",BPSRXFC,BPSDIV)),"^",3)="" S $P(@BPGLTMP@("DATA",BPSRXFC,BPSDIV),"^",3)="NON-BILLABLE"
.S BPSPAMT=$P(BPSRXFCI,"^")
I BPSPAMT=0 S BPSPAMT=""
;
; Set variables for Non-Billable entries
I BPSTATUS="",$P($G(@BPGLTMP@("DATA",BPSRXFC,BPSDIV)),"^",3)="NON-BILLABLE" S BPSTRTYP="N"
I BPSTRTYP="N" S (BPSECME,BPSDOS,BPSPAMT)="",BPSTATUS="NON-BILLABLE"
;
; Update RXFC info for specific division/user
I BPUSER=0!(BPUSER=1&($D(BPUSER(+$P($G(^BPSTL(BP57,0)),U,10))))) D
.S BPSPRVST=$P($G(@BPGLTMP@("DATA",BPSRXFC,BPSDIV,BPSUSER)),"^")
.S BPSPRVAM=+$P($G(@BPGLTMP@("DATA",BPSRXFC,BPSDIV,BPSUSER)),"^",6)
.S BPSPRVUT=+$P($G(@BPGLTMP@("DATA",BPSRXFC,BPSDIV,BPSUSER)),"^",13)+1
.S @BPGLTMP@("DATA",BPSRXFC,BPSDIV,BPSUSER)=BPSTATUS_"^"_BPSEC_"^"_$$GET1^DIQ(52,BPRX,.01)_"^"_BPREF_"^"_BPSDOS_"^"_BPSPAMT_"^"_BPSECME_"^"_BPSCOB_"^"_BPSDIV_"^"_BPSUSER_"^"_BPSTRDT_"^"_BP57
.S $P(@BPGLTMP@("DATA",BPSRXFC,BPSDIV,BPSUSER),"^",13)=BPSPRVUT
.S $P(@BPGLTMP@("USRTOT",BPSDIV,BPSUSER),"^",4)=+$P($G(@BPGLTMP@("USRTOT",BPSDIV,BPSUSER)),"^",4)+1
.S $P(@BPGLTMP@("USRTOT",BPSDIV,BPSUSER),"^")=+$P($G(@BPGLTMP@("USRTOT",BPSDIV,BPSUSER)),"^")-(+BPSPRVAM)+(+BPSPAMT)
.;
.; Update count totals for Rejects found
.I BPSTATUS["PAYABLE"!(BPSTATUS["NON-BILLABLE") D
..S BPSRJFND=$P(@BPGLTMP@("DATA",BPSRXFC,BPSDIV),"^",5)
..I BPSRJFND="" D
...S BPSRJFND=$$CALCREJ^BPSOPR2(BPSDIV,BPSUSER,BPRX,BPREF,BPSCOB)
...S $P(@BPGLTMP@("DATA",BPSRXFC,BPSDIV),"^",5)=BPSRJFND
..I BPSTATUS["PAYABLE" D
...Q:BPSPRVST["PAYABLE"
...I BPSRJFND D Q
....S $P(@BPGLTMP@("USRTOT",BPSDIV,BPSUSER),"^",3)=+($P(@BPGLTMP@("USRTOT",BPSDIV,BPSUSER),"^",3))+1
...S $P(@BPGLTMP@("USRTOT",BPSDIV,BPSUSER),"^",2)=+($P(@BPGLTMP@("USRTOT",BPSDIV,BPSUSER),"^",2))+1
..I BPSTATUS["NON-BILLABLE",BPSPRVST["PAYABLE" D
...I BPSRJFND D Q
....S $P(@BPGLTMP@("USRTOT",BPSDIV,BPSUSER),"^",3)=+($P(@BPGLTMP@("USRTOT",BPSDIV,BPSUSER),"^",3))-1
...S $P(@BPGLTMP@("USRTOT",BPSDIV,BPSUSER),"^",2)=+($P(@BPGLTMP@("USRTOT",BPSDIV,BPSUSER),"^",2))-1
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSOPR3 7412 printed Dec 13, 2024@01:51:25 Page 2
BPSOPR3 ;ALB/PHH - OPECC Productivity Report Print ;9/21/2015
+1 ;;1.0;E CLAIMS MGMT ENGINE;**20**;JUN 2004;Build 27
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
PRINT ; Entry point for printing the report
+1 NEW BPSPG,BPSHDR,BPSIDX,BPSQUIT,DIR,DIRUT,DUOUT,DTOUT
+2 ;
+3 SET BPSPG=1
+4 ;
+5 IF 'BPEXCEL
Begin DoDot:1
+6 DO HDRINIT(.BPSHDR)
+7 DO HDR(.BPSHDR,BPSPG)
End DoDot:1
+8 ;
+9 ; User chose to export the report to Excel
+10 IF BPEXCEL
Begin DoDot:1
+11 WRITE !,"DIVISION^USER^CURRENT STATUS^#TRANS IN DT RANGE^#TRANS TOTAL^ELIG^RX#^REF^ECME#^COB^DOS^TRANS DATE^PAID AMT"
End DoDot:1
+12 ;
+13 SET (BPSIDX,BPSQUIT)=0
+14 FOR
SET BPSIDX=$ORDER(@BPGLTMP@("REPORT",BPSIDX))
if 'BPSIDX!(BPSQUIT)
QUIT
Begin DoDot:1
+15 WRITE !,@BPGLTMP@("REPORT",BPSIDX)
+16 if BPEXCEL
QUIT
+17 IF $Y>(IOSL-3)
Begin DoDot:2
+18 IF $EXTRACT(IOST,1,2)="C-"
Begin DoDot:3
+19 WRITE !
+20 SET DIR(0)="E"
+21 DO ^DIR
+22 KILL DIR
+23 IF $DATA(DIRUT)!($DATA(DUOUT))
SET BPSQUIT=1
KILL DIRUT,DTOUT,DUOUT
End DoDot:3
+24 if BPSQUIT
QUIT
+25 SET BPSPG=BPSPG+1
+26 DO HDR(.BPSHDR,BPSPG)
End DoDot:2
End DoDot:1
+27 ;
+28 IF 'BPEXCEL
WRITE !!?5,"*** End of Report ***"
+29 WRITE !
+30 IF '$DATA(ZTQUEUED)
USE 0
SET DIR(0)="E"
DO ^DIR
KILL DIR
USE IO
+31 QUIT
+32 ;
HDR(BPSHDR,BPSPG) ; Print header
+1 NEW BPSOHDR1,BPSTMP,X
+2 ;
+3 SET (BPSOHDR1,BPSTMP)=BPSHDR(1)
+4 DO ADDCHAR(.BPSTMP," ",3-$LENGTH(BPSPG))
+5 SET BPSTMP=BPSTMP_BPSPG
+6 SET BPSHDR(1)=BPSTMP
+7 ;
+8 WRITE @IOF
+9 FOR X=1:1:9
WRITE !,BPSHDR(X)
+10 ;
+11 SET BPSHDR(1)=BPSOHDR1
+12 QUIT
+13 ;
HDRINIT(BPSHDR) ; Setup header
+1 NEW BPSRPTNM,BPSDTTM,HDR1,HDR2,X,BPSDIVNM,HDR3,HDR4,BPSUSRNM,HDR6,HDR7
+2 ;
+3 SET BPSRPTNM="OPECC PRODUCTIVITY "_$SELECT(BPSUMDET=1:"SUMMARY ",1:"DETAIL ")_"REPORT"
+4 SET BPSDTTM=$$HTE^XLFDT($HOROLOG)
+5 SET HDR1=BPSRPTNM
+6 DO ADDCHAR(.HDR1," ",$SELECT(BPSUMDET=1:53,1:54))
+7 SET HDR1=HDR1_"Print Date: "_BPSDTTM
+8 DO ADDCHAR(.HDR1," ",121-$LENGTH(HDR1))
+9 SET HDR1=HDR1_"Page:"
+10 SET BPSHDR(1)=HDR1
+11 ;
+12 SET HDR2="DIVISION(S): "
+13 IF BPPHARM=0
SET HDR2=HDR2_"ALL"
+14 IF BPPHARM=1
Begin DoDot:1
+15 SET X=0
+16 FOR
SET X=$ORDER(BPPHARM(X))
if 'X
QUIT
SET BPSDIVNM($PIECE(BPPHARM(X),U,2))=""
+17 SET X=""
+18 FOR
SET X=$ORDER(BPSDIVNM(X))
if X=""
QUIT
Begin DoDot:2
+19 SET HDR2=HDR2_X_", "
End DoDot:2
+20 SET HDR2=$EXTRACT(HDR2,1,$LENGTH(HDR2)-2)
End DoDot:1
+21 SET BPSHDR(2)=$EXTRACT(HDR2,1,129)
+22 ;
+23 SET HDR3="ELIGIBILITY: "
+24 IF BPELIG=0
SET HDR3=HDR3_"ALL"
+25 IF BPELIG=1
Begin DoDot:1
+26 SET X=""
+27 FOR
SET X=$ORDER(BPELIG(X))
if X=""
QUIT
Begin DoDot:2
+28 SET HDR3=HDR3_$SELECT(X="V":"VETERAN",X="T":"TRICARE",X="C":"CHAMPVA",1:"")_", "
End DoDot:2
+29 SET HDR3=$EXTRACT(HDR3,1,$LENGTH(HDR3)-2)
End DoDot:1
+30 SET BPSHDR(3)=HDR3
+31 ;
+32 SET HDR4="USERS: "
+33 IF BPUSER=0
SET HDR4=HDR4_"ALL"
+34 IF BPUSER=1
Begin DoDot:1
+35 SET X=0
+36 FOR
SET X=$ORDER(BPUSER(X))
if 'X
QUIT
SET BPSUSRNM($PIECE(BPUSER(X),U,2))=""
+37 SET X=""
+38 FOR
SET X=$ORDER(BPSUSRNM(X))
if X=""
QUIT
Begin DoDot:2
+39 SET HDR4=HDR4_X_", "
End DoDot:2
+40 SET HDR4=$EXTRACT(HDR4,1,$LENGTH(HDR4)-2)
End DoDot:1
+41 SET BPSHDR(4)=$EXTRACT(HDR4,1,129)
+42 ;
+43 SET BPSHDR(5)="ALL PRESCRIPTIONS BY TRANSACTION DATE: From "_$$FMTE^XLFDT(BPBEGDT,2)_" through "_$$FMTE^XLFDT(BPENDDT\1,2)
+44 ;
+45 SET HDR6=""
+46 DO ADDCHAR(.HDR6,"=",129)
+47 SET BPSHDR(6)=HDR6
+48 ;
+49 SET HDR7=""
+50 DO ADDCHAR(.HDR7," ",17)
+51 SET HDR7=HDR7_"CURRENT # TRANSACTIONS"
+52 SET BPSHDR(7)=HDR7
+53 ;
+54 SET BPSHDR(8)="USER STATUS DT RANGE TOTAL ELIG RX# REF/ECME# COB DOS TRANS DATE PAID AMT"
+55 ;
+56 SET BPSHDR(9)=HDR6
+57 QUIT
+58 ;
ADDCHAR(BPSTXSTR,BPSCHAR,BPSCNT) ; Add characters to string
+1 NEW X
+2 if BPSCNT<1
QUIT
+3 FOR X=1:1:BPSCNT
SET BPSTXSTR=BPSTXSTR_BPSCHAR
+4 QUIT
+5 ;
PROCESS(BP57) ; Process each Entry
+1 NEW BPSCOB,BPRX,BPREF,BPSRXFC,BPSTRTYP,BPSDIV,BPSTATUS,BPSECME,BPSDOS
+2 NEW BPSTRDT,BPSEC,BPSUSER,BPSPAMT,BPSRXFCI,BPSPRVST,BPSPRVAM,BPSPRVUT,BPSRJFND
+3 ;
+4 ; Get COB
+5 SET BPSCOB=$SELECT($PIECE($GET(^BPSTL(BP57,0)),U,14):$PIECE(^BPSTL(BP57,0),U,14),1:$EXTRACT($PIECE($PIECE($GET(^BPSTL(BP57,0)),U),".",2),5,5))
+6 ;
+7 ; Get RX#
+8 SET BPRX=+$PIECE($GET(^BPSTL(BP57,1)),U,11)
+9 ;
+10 ; Get REF - FILL NUMBER field #9 in 9002313.57
+11 SET BPREF=+$PIECE($GET(^BPSTL(BP57,1)),U)
+12 ;
+13 ; Unique ID for RX#-Fill#-COB to separate display line/counters
+14 SET BPSRXFC=BPRX_"-"_BPREF_"-"_BPSCOB
+15 ;
+16 ; Get Transaction Type
+17 SET BPSTRTYP=$PIECE($GET(^BPSTL(BP57,0)),U,15)
+18 ; Skip eligibility verification transactions
+19 IF BPSTRTYP="E"
QUIT
+20 ;
+21 ; Limit report to the following RX ACTION field #1201 values
+22 IF '$FIND(".BB.ERES.ERWV.ERNB.EREV.P2.P2S.","."_$PIECE($GET(^BPSTL(BP57,12)),U,1)_".")
QUIT
+23 ;
+24 ; Check for correct BPS Pharmacy (DIVISION)
+25 SET BPSDIV=+$PIECE($GET(^BPSTL(BP57,1)),U,7)
+26 IF BPPHARM=1
IF '$DATA(BPPHARM(BPSDIV))
QUIT
+27 SET BPSDIV=$$GET1^DIQ(9002313.56,BPSDIV,.01)
+28 IF BPSDIV=""
QUIT
+29 ;
+30 ; Get Status
+31 SET BPSTATUS=$PIECE($PIECE($$STATUS^BPSOSRX(BPRX,BPREF,0,,BPSCOB),U),"E ",2)
+32 ;
+33 ; Get ECME
+34 SET BPSECME=$$ECMENUM^BPSOPR2(BP57)
+35 ;
+36 ; Get Date of Service
+37 SET BPSDOS=$$DATTIM^BPSRPT1(+$PIECE($GET(^BPSTL(BP57,12)),U,2))
+38 ;
+39 ; Get Trans Date
+40 SET BPSTRDT=$PIECE($GET(^BPSTL(BP57,0)),U,8)
+41 IF BPSTRDT=""
QUIT
+42 ;
+43 ; Check for Eligibility Code
+44 SET BPSEC=$PIECE($GET(^BPSTL(BP57,9)),U,4)
+45 IF BPSEC=""
QUIT
+46 IF BPELIG=1
IF '$DATA(BPELIG(BPSEC))
QUIT
+47 ;
+48 ; Update general RXFC info
+49 SET $PIECE(@BPGLTMP@("DATA",BPSRXFC,BPSDIV),"^")=+$PIECE($GET(@BPGLTMP@("DATA",BPSRXFC,BPSDIV)),"^")+1
+50 IF BPSTATUS'=""
SET $PIECE(@BPGLTMP@("DATA",BPSRXFC,BPSDIV),"^",3)=BPSTATUS
+51 ;
+52 ; Get User
+53 SET BPSUSER=+$PIECE($GET(^BPSTL(BP57,0)),U,10)
+54 IF BPUSER=1
IF '$DATA(BPUSER(BPSUSER))
IF '$DATA(@BPGLTMP@("DATA",BPSRXFC,BPSDIV))
QUIT
+55 SET BPSUSER=$$GET1^DIQ(200,BPSUSER,.01)
+56 IF BPSUSER=""
QUIT
+57 ;
+58 ; Get Paid Amount
+59 SET BPSPAMT=$PIECE($GET(@BPGLTMP@("DATA",BPSRXFC,BPSDIV)),"^",4)
SET BPSRXFCI=""
+60 IF BPSPAMT=""
Begin DoDot:1
+61 SET BPSRXFCI=$$GETRXFCI^BPSOPR2(BPSDIV,BPRX,BPREF,BPSCOB)
+62 SET $PIECE(@BPGLTMP@("DATA",BPSRXFC,BPSDIV),"^",2)=$PIECE(BPSRXFCI,"^",3)
+63 SET $PIECE(@BPGLTMP@("DATA",BPSRXFC,BPSDIV),"^",4)=$SELECT($PIECE(BPSRXFCI,"^")="":0,1:$PIECE(BPSRXFCI,"^"))
+64 SET $PIECE(@BPGLTMP@("DATA",BPSRXFC,BPSDIV),"^",6)=$PIECE(BPSRXFCI,"^",2)
+65 IF $PIECE(BPSRXFCI,"^",4)="N"
IF $PIECE($GET(@BPGLTMP@("DATA",BPSRXFC,BPSDIV)),"^",3)=""
SET $PIECE(@BPGLTMP@("DATA",BPSRXFC,BPSDIV),"^",3)="NON-BILLABLE"
+66 SET BPSPAMT=$PIECE(BPSRXFCI,"^")
End DoDot:1
+67 IF BPSPAMT=0
SET BPSPAMT=""
+68 ;
+69 ; Set variables for Non-Billable entries
+70 IF BPSTATUS=""
IF $PIECE($GET(@BPGLTMP@("DATA",BPSRXFC,BPSDIV)),"^",3)="NON-BILLABLE"
SET BPSTRTYP="N"
+71 IF BPSTRTYP="N"
SET (BPSECME,BPSDOS,BPSPAMT)=""
SET BPSTATUS="NON-BILLABLE"
+72 ;
+73 ; Update RXFC info for specific division/user
+74 IF BPUSER=0!(BPUSER=1&($DATA(BPUSER(+$PIECE($GET(^BPSTL(BP57,0)),U,10)))))
Begin DoDot:1
+75 SET BPSPRVST=$PIECE($GET(@BPGLTMP@("DATA",BPSRXFC,BPSDIV,BPSUSER)),"^")
+76 SET BPSPRVAM=+$PIECE($GET(@BPGLTMP@("DATA",BPSRXFC,BPSDIV,BPSUSER)),"^",6)
+77 SET BPSPRVUT=+$PIECE($GET(@BPGLTMP@("DATA",BPSRXFC,BPSDIV,BPSUSER)),"^",13)+1
+78 SET @BPGLTMP@("DATA",BPSRXFC,BPSDIV,BPSUSER)=BPSTATUS_"^"_BPSEC_"^"_$$GET1^DIQ(52,BPRX,.01)_"^"_BPREF_"^"_BPSDOS_"^"_BPSPAMT_"^"_BPSECME_"^"_BPSCOB_"^"_BPSDIV_"^"_BPSUSER_"^"_BPSTRDT_"^"_BP57
+79 SET $PIECE(@BPGLTMP@("DATA",BPSRXFC,BPSDIV,BPSUSER),"^",13)=BPSPRVUT
+80 SET $PIECE(@BPGLTMP@("USRTOT",BPSDIV,BPSUSER),"^",4)=+$PIECE($GET(@BPGLTMP@("USRTOT",BPSDIV,BPSUSER)),"^",4)+1
+81 SET $PIECE(@BPGLTMP@("USRTOT",BPSDIV,BPSUSER),"^")=+$PIECE($GET(@BPGLTMP@("USRTOT",BPSDIV,BPSUSER)),"^")-(+BPSPRVAM)+(+BPSPAMT)
+82 ;
+83 ; Update count totals for Rejects found
+84 IF BPSTATUS["PAYABLE"!(BPSTATUS["NON-BILLABLE")
Begin DoDot:2
+85 SET BPSRJFND=$PIECE(@BPGLTMP@("DATA",BPSRXFC,BPSDIV),"^",5)
+86 IF BPSRJFND=""
Begin DoDot:3
+87 SET BPSRJFND=$$CALCREJ^BPSOPR2(BPSDIV,BPSUSER,BPRX,BPREF,BPSCOB)
+88 SET $PIECE(@BPGLTMP@("DATA",BPSRXFC,BPSDIV),"^",5)=BPSRJFND
End DoDot:3
+89 IF BPSTATUS["PAYABLE"
Begin DoDot:3
+90 if BPSPRVST["PAYABLE"
QUIT
+91 IF BPSRJFND
Begin DoDot:4
+92 SET $PIECE(@BPGLTMP@("USRTOT",BPSDIV,BPSUSER),"^",3)=+($PIECE(@BPGLTMP@("USRTOT",BPSDIV,BPSUSER),"^",3))+1
End DoDot:4
QUIT
+93 SET $PIECE(@BPGLTMP@("USRTOT",BPSDIV,BPSUSER),"^",2)=+($PIECE(@BPGLTMP@("USRTOT",BPSDIV,BPSUSER),"^",2))+1
End DoDot:3
+94 IF BPSTATUS["NON-BILLABLE"
IF BPSPRVST["PAYABLE"
Begin DoDot:3
+95 IF BPSRJFND
Begin DoDot:4
+96 SET $PIECE(@BPGLTMP@("USRTOT",BPSDIV,BPSUSER),"^",3)=+($PIECE(@BPGLTMP@("USRTOT",BPSDIV,BPSUSER),"^",3))-1
End DoDot:4
QUIT
+97 SET $PIECE(@BPGLTMP@("USRTOT",BPSDIV,BPSUSER),"^",2)=+($PIECE(@BPGLTMP@("USRTOT",BPSDIV,BPSUSER),"^",2))-1
End DoDot:3
End DoDot:2
End DoDot:1
+98 QUIT
+99 ;
