BPSRPT2 ;BHAM ISC/BEE - ECME REPORTS ;14-FEB-05
;;1.0;E CLAIMS MGMT ENGINE;**1,3,5,28**;JUN 2004;Build 22
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
;Save One Report Entry
;
; Input variables -> See BPSRPT0 for description
; BPTMPGL,BPDFN,BPRX,BPREF,BP59,BPENDDT,BPPHARM,BPSUMDET,BPGRPLAN,BPRLDT,BPPAYBL,BPREJFL,BPRXDRG
;
SETTMP(BPTMPGL,BPDFN,BPRX,BPREF,BP59,BPBEGDT,BPENDDT,BPPHARM,BPSUMDET,BPGRPLAN,BPRLDT,BPPAYBL,BPREJFL,BPRXDRG,BPSTATUS,BPDUPST,BPDUPPAY) ;
N BPCLSDT,BPDATA,BPDIV,BPFILDT,BPISSDT,BPSMSG,BPSREJ,BPREST,BPSRWR,BPTDTTM,BPTRDT
;
;Check for bad data
I BPREF,$$IFREFILL^BPSRPT6(BPRX,BPREF)=0 G EXIT
;
;Retrieve Close Date
S BPCLSDT=$P($$CLOSEDT(BP59),".")
;
;If NO refills
I BPREF=0 D
. S BPFILDT=$$RXFILDT^BPSRPT6(BPRX)
. S BPISSDT=$$RXISSDT^BPSRPT6(BPRX)
;
;If Refills
I BPREF>0 D
. S BPFILDT=$$REFFILDT^BPSRPT6(BPRX,BPREF)
. S BPISSDT=$$REFISSDT^BPSRPT6(BPRX,BPREF)
;
;Get Transaction Date/Transaction Date and Time
S BPTRDT=$$TRANDT(BP59,0)
S BPTDTTM=$$TRANDT(BP59,1)
;
;Get Result, Message, Reject Information, and BPS Pharmacy
S BPREST=$$RESULT(BP59,.BPSRWR)
S BPSMSG=$$MSG(BPSRWR,.BPSMSG,BP59)
S BPSREJ=$S(BPREJFL=0:"",1:$$REJECT(BPREST,.BPSREJ,BP59))
S BPDIV=+$P($G(^BPST(BP59,1)),"^",7)
;
;Set up data node
S BPDATA=BPRLDT_U_BPTRDT_U_BP59_U_BPRX_U_BPREF_U_BPREST_U_BPSTATUS_U_BPFILDT_U_BPISSDT_U_U_U
S BPDATA=BPDATA_BPPAYBL_U_BPREJFL_U_BPRXDRG_U_BPSRWR_U_BPDUPST_U_BPDUPPAY
;
;For Totals by Date - No Insurance Sort
I BPRTYPE=6 S BPGRPLAN="~"
;
;Sort by transaction date
I BPRTYPE'=7 D:$$CHKDT(+$G(BPTRDT),BPBEGDT,BPENDDT)
. ;
. ;For Recent Transactions tack on Txn date and Time to Ins
. I BPRTYPE=5 S BPGRPLAN=-BPTDTTM_"^"_BPGRPLAN
. S @BPTMPGL@(BPDIV,BPGRPLAN,BPDFN,BPTRDT,BPRX,BPREF)=BPDATA
;
;Sort by close date
I BPRTYPE=7 D:$$CHKDT(+$G(BPCLSDT),BPBEGDT,BPENDDT)
. S @BPTMPGL@(BPDIV,BPGRPLAN,BPDFN,BPCLSDT,BPRX,BPREF)=BPDATA
;
EXIT Q
;
;Get Transaction date and Time
;
; Input Variables -> BP59 - ptr to BPS TRANSACTION
; TIME - 1 - Return DT.TM, 0 - DT
; Returned Value -> Transaction or Transaction Date.Time
;
TRANDT(BP59,TIME) N X
S X=$P($G(^BPST(BP59,0)),U,8)
Q $S(TIME=0:X\1,1:X)
;
;Determine the Claim Close Date
;
; Input Variable -> BP59 = ptr to BPS TRANSACTIONS
; Returned Value -> CL = Claim Close Date and Time
;
CLOSEDT(BP59) N CL,BP02
S BP02=+$P($G(^BPST(BP59,0)),U,4)
S CL=+$P($G(^BPSC(BP02,900)),U,2)
Q CL
;
;Get Result
;
RESULT(BP59,RWR) N X
I BP59 S RWR=$$CATEG^BPSOSUC(BP59)
E S RWR=""
I RWR?1"E ".E D
. S X=RWR
. I X="E PAYABLE" S X=4
. E I X="E CAPTURED" S X=3
. E I X="E DUPLICATE" S X=2
. E I X="E REJECTED" S X=1
. E I X="E REVERSAL ACCEPTED" S X=11
. E I X="E REVERSAL REJECTED" S X=12
. E S X=0
E I RWR="PAPER" S X=9
E I RWR="PAPER REVERSAL" S X=19
E S X=15
Q X
;
;Message
;
MSG(RWR,MSGTEXT,BP59) N BPRET
S BPRET=0
; If the claim has any message text, store it
I RWR?1"E ".E D
. S X=$$MESSAG59(BP59,1)
. I X]"" S MSGTEXT(1)=X
. S X=$$MESSAG59(BP59,2)
. I X]"" S MSGTEXT(2)=X
. I $D(MSGTEXT) S MSGTEXT="MSGTEXT"
. S BPRET=1
Q BPRET
;
;Reject Text
;
; Output Variable -> BPSRTEXT,BPRET
;
REJECT(RWR,BPSRTEXT,BP59) N BPRET,BPSRESP,BPSECME,BPSPOS
S BPRET=0
; If it's a rejected claim, build the rejection text
I RWR="E REJECTED"!(RWR="E REVERSAL REJECTED") D
. D RESP59(BP59,.BPSRESP,.BPSECME) ; set BPSRESP,BPSECME pointers
. D REJTEXT^BPSOS03(BPSRESP,BPSPOS,.BPSRTEXT)
. ; word processing text goes into FDA(FILE,IENS,FIELD,n)=text
. S BPSRTEXT=$S($D(BPSRTEXT):"REJTEXT",1:"")
. S:$D(BPSRTEXT) BPRET=1
Q BPRET
;
;Messages
;
MESSAG59(BP59,N) N MSG,BPSRESP,BPSPOS
I 'BP59 S MSG="" G XMSG59
D RESP59(59,.BPSRESP,.BPSPOS) I 'BPSRESP!'BPSPOS S MSG="" G XMSG59
I '$D(N) S N=0
I N=1 S MSG=$$MESSAGE^BPSOS03(BPSRESP,BPSPOS,1) I 1
I N=2 S MSG=$$MESSAGE^BPSOS03(BPSRESP,BPSPOS,2) I 1
E S MSG=$$MESSAGE^BPSOS03(BPSRESP,BPSPOS)
XMSG59 Q MSG
;
;Responds
RESP59(BP59,BPSRESP,BPSPOS) ;EP - caller should N BPSRESP,BPSPOS
;Input: BP59
;Output:
; BPSRESP,BPSPOS by reference
I $G(^BPST(BP59,4)) D ; reversal
. S BPSRESP=$P($G(^BPST(BP59,4)),U,2)
. S BPSPOS=1
E D
. S BPSRESP=$P($G(^BPST(BP59,0)),U,5)
. S BPSPOS=$P($G(^BPST(BP59,0)),U,9)
Q
;
;Check and compare dates
CHKDT(BPTSTDT,BPBEGDT,BPENDDT) ;
I BPTSTDT=0 Q 0
I BPTSTDT'<BPBEGDT,BPTSTDT'>BPENDDT Q 1
Q 0
;
;Populate passed in Array
;
REJTEXT(BP59,ARR) N BBX,BPSRESP,BPSPOS,A,I,X,R
S BBX=$G(^BPST(BP59,0))
S BPSRESP=$P(BBX,U,5)
S BPSPOS=$P(BBX,U,9)
S (A,I)=0
I BPSRESP&BPSPOS D
. K ARR
. F S A=$O(^BPSR(BPSRESP,1000,BPSPOS,511,A)) Q:'A D
. . S R=$P(^BPSR(BPSRESP,1000,BPSPOS,511,A,0),U)
. . Q:R=""
. . N S S S=$O(^BPSF(9002313.93,"B",R,0))
. . I S S X=$TR($G(^BPSF(9002313.93,S,0)),U,":")
. . E S X=R_" unrecognized reject code"
. . S I=I+1,ARR(I)=X
. . K S
Q I
;
;Get Claim ID
CLAIMID(BP59) N BP02
S BP02=+$P($G(^BPST(BP59,0)),U,4)
Q $P($G(^BPSC(BP02,0)),U)
;
;Determine $Ins Paid
;
INSPAID(BP59) N X,RESP,POSITION
S X=$G(^BPST(BP59,0))
S RESP=$P(X,U,5)
S POSITION=$P(X,U,9)
Q $S(RESP&POSITION:$$INSPAID1^BPSOS03(RESP,POSITION),1:0)
;
;Get the Cardholder ID
CRDHLDID(BP59) N BP02
S BP02=+$P($G(^BPST(BP59,0)),U,4)
Q $P($G(^BPSC(BP02,300)),U,2)
;
GRPID(BP59) ;sent by IB in RX^IBNCPDP
N BP02
S BP02=+$P($G(^BPST(BP59,0)),U,4)
Q $P($G(^BPSC(BP02,300)),U)
;
;Get the PATIENT PAY AMOUNT (#505) from file #9002313.0301
;
;Input: BPSRESP -BPS RESPONSE file IEN
; BPSPOS - POSITION IN CLAIM (#14) in file #9002313.59
;Output: BPPPAMT - PATIENT PAY AMOUNT
;
GETPPAY(BPSRESP,BPSPOS) ;
N BPPPAMT
;(#505) PATIENT PAY AMOUNT
S BPPPAMT=$$GET1^DIQ(9002313.0301,BPSPOS_","_BPSRESP_",",505,"I")
; Convert a Signed Numeric Field to a Decimal Value
; '000021G' will be converted to '2.17' and Nulls will be converted to '0.00'
S BPPPAMT=$$DFF2EXT^BPSECFM(BPPPAMT)
Q BPPPAMT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSRPT2 6125 printed Sep 23, 2025@19:28:54 Page 2
BPSRPT2 ;BHAM ISC/BEE - ECME REPORTS ;14-FEB-05
+1 ;;1.0;E CLAIMS MGMT ENGINE;**1,3,5,28**;JUN 2004;Build 22
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
+6 ;Save One Report Entry
+7 ;
+8 ; Input variables -> See BPSRPT0 for description
+9 ; BPTMPGL,BPDFN,BPRX,BPREF,BP59,BPENDDT,BPPHARM,BPSUMDET,BPGRPLAN,BPRLDT,BPPAYBL,BPREJFL,BPRXDRG
+10 ;
SETTMP(BPTMPGL,BPDFN,BPRX,BPREF,BP59,BPBEGDT,BPENDDT,BPPHARM,BPSUMDET,BPGRPLAN,BPRLDT,BPPAYBL,BPREJFL,BPRXDRG,BPSTATUS,BPDUPST,BPDUPPAY) ;
+1 NEW BPCLSDT,BPDATA,BPDIV,BPFILDT,BPISSDT,BPSMSG,BPSREJ,BPREST,BPSRWR,BPTDTTM,BPTRDT
+2 ;
+3 ;Check for bad data
+4 IF BPREF
IF $$IFREFILL^BPSRPT6(BPRX,BPREF)=0
GOTO EXIT
+5 ;
+6 ;Retrieve Close Date
+7 SET BPCLSDT=$PIECE($$CLOSEDT(BP59),".")
+8 ;
+9 ;If NO refills
+10 IF BPREF=0
Begin DoDot:1
+11 SET BPFILDT=$$RXFILDT^BPSRPT6(BPRX)
+12 SET BPISSDT=$$RXISSDT^BPSRPT6(BPRX)
End DoDot:1
+13 ;
+14 ;If Refills
+15 IF BPREF>0
Begin DoDot:1
+16 SET BPFILDT=$$REFFILDT^BPSRPT6(BPRX,BPREF)
+17 SET BPISSDT=$$REFISSDT^BPSRPT6(BPRX,BPREF)
End DoDot:1
+18 ;
+19 ;Get Transaction Date/Transaction Date and Time
+20 SET BPTRDT=$$TRANDT(BP59,0)
+21 SET BPTDTTM=$$TRANDT(BP59,1)
+22 ;
+23 ;Get Result, Message, Reject Information, and BPS Pharmacy
+24 SET BPREST=$$RESULT(BP59,.BPSRWR)
+25 SET BPSMSG=$$MSG(BPSRWR,.BPSMSG,BP59)
+26 SET BPSREJ=$SELECT(BPREJFL=0:"",1:$$REJECT(BPREST,.BPSREJ,BP59))
+27 SET BPDIV=+$PIECE($GET(^BPST(BP59,1)),"^",7)
+28 ;
+29 ;Set up data node
+30 SET BPDATA=BPRLDT_U_BPTRDT_U_BP59_U_BPRX_U_BPREF_U_BPREST_U_BPSTATUS_U_BPFILDT_U_BPISSDT_U_U_U
+31 SET BPDATA=BPDATA_BPPAYBL_U_BPREJFL_U_BPRXDRG_U_BPSRWR_U_BPDUPST_U_BPDUPPAY
+32 ;
+33 ;For Totals by Date - No Insurance Sort
+34 IF BPRTYPE=6
SET BPGRPLAN="~"
+35 ;
+36 ;Sort by transaction date
+37 IF BPRTYPE'=7
if $$CHKDT(+$GET(BPTRDT),BPBEGDT,BPENDDT)
Begin DoDot:1
+38 ;
+39 ;For Recent Transactions tack on Txn date and Time to Ins
+40 IF BPRTYPE=5
SET BPGRPLAN=-BPTDTTM_"^"_BPGRPLAN
+41 SET @BPTMPGL@(BPDIV,BPGRPLAN,BPDFN,BPTRDT,BPRX,BPREF)=BPDATA
End DoDot:1
+42 ;
+43 ;Sort by close date
+44 IF BPRTYPE=7
if $$CHKDT(+$GET(BPCLSDT),BPBEGDT,BPENDDT)
Begin DoDot:1
+45 SET @BPTMPGL@(BPDIV,BPGRPLAN,BPDFN,BPCLSDT,BPRX,BPREF)=BPDATA
End DoDot:1
+46 ;
EXIT QUIT
+1 ;
+2 ;Get Transaction date and Time
+3 ;
+4 ; Input Variables -> BP59 - ptr to BPS TRANSACTION
+5 ; TIME - 1 - Return DT.TM, 0 - DT
+6 ; Returned Value -> Transaction or Transaction Date.Time
+7 ;
TRANDT(BP59,TIME) NEW X
+1 SET X=$PIECE($GET(^BPST(BP59,0)),U,8)
+2 QUIT $SELECT(TIME=0:X\1,1:X)
+3 ;
+4 ;Determine the Claim Close Date
+5 ;
+6 ; Input Variable -> BP59 = ptr to BPS TRANSACTIONS
+7 ; Returned Value -> CL = Claim Close Date and Time
+8 ;
CLOSEDT(BP59) NEW CL,BP02
+1 SET BP02=+$PIECE($GET(^BPST(BP59,0)),U,4)
+2 SET CL=+$PIECE($GET(^BPSC(BP02,900)),U,2)
+3 QUIT CL
+4 ;
+5 ;Get Result
+6 ;
RESULT(BP59,RWR) NEW X
+1 IF BP59
SET RWR=$$CATEG^BPSOSUC(BP59)
+2 IF '$TEST
SET RWR=""
+3 IF RWR?1"E ".E
Begin DoDot:1
+4 SET X=RWR
+5 IF X="E PAYABLE"
SET X=4
+6 IF '$TEST
IF X="E CAPTURED"
SET X=3
+7 IF '$TEST
IF X="E DUPLICATE"
SET X=2
+8 IF '$TEST
IF X="E REJECTED"
SET X=1
+9 IF '$TEST
IF X="E REVERSAL ACCEPTED"
SET X=11
+10 IF '$TEST
IF X="E REVERSAL REJECTED"
SET X=12
+11 IF '$TEST
SET X=0
End DoDot:1
+12 IF '$TEST
IF RWR="PAPER"
SET X=9
+13 IF '$TEST
IF RWR="PAPER REVERSAL"
SET X=19
+14 IF '$TEST
SET X=15
+15 QUIT X
+16 ;
+17 ;Message
+18 ;
MSG(RWR,MSGTEXT,BP59) NEW BPRET
+1 SET BPRET=0
+2 ; If the claim has any message text, store it
+3 IF RWR?1"E ".E
Begin DoDot:1
+4 SET X=$$MESSAG59(BP59,1)
+5 IF X]""
SET MSGTEXT(1)=X
+6 SET X=$$MESSAG59(BP59,2)
+7 IF X]""
SET MSGTEXT(2)=X
+8 IF $DATA(MSGTEXT)
SET MSGTEXT="MSGTEXT"
+9 SET BPRET=1
End DoDot:1
+10 QUIT BPRET
+11 ;
+12 ;Reject Text
+13 ;
+14 ; Output Variable -> BPSRTEXT,BPRET
+15 ;
REJECT(RWR,BPSRTEXT,BP59) NEW BPRET,BPSRESP,BPSECME,BPSPOS
+1 SET BPRET=0
+2 ; If it's a rejected claim, build the rejection text
+3 IF RWR="E REJECTED"!(RWR="E REVERSAL REJECTED")
Begin DoDot:1
+4 ; set BPSRESP,BPSECME pointers
DO RESP59(BP59,.BPSRESP,.BPSECME)
+5 DO REJTEXT^BPSOS03(BPSRESP,BPSPOS,.BPSRTEXT)
+6 ; word processing text goes into FDA(FILE,IENS,FIELD,n)=text
+7 SET BPSRTEXT=$SELECT($DATA(BPSRTEXT):"REJTEXT",1:"")
+8 if $DATA(BPSRTEXT)
SET BPRET=1
End DoDot:1
+9 QUIT BPRET
+10 ;
+11 ;Messages
+12 ;
MESSAG59(BP59,N) NEW MSG,BPSRESP,BPSPOS
+1 IF 'BP59
SET MSG=""
GOTO XMSG59
+2 DO RESP59(59,.BPSRESP,.BPSPOS)
IF 'BPSRESP!'BPSPOS
SET MSG=""
GOTO XMSG59
+3 IF '$DATA(N)
SET N=0
+4 IF N=1
SET MSG=$$MESSAGE^BPSOS03(BPSRESP,BPSPOS,1)
IF 1
+5 IF N=2
SET MSG=$$MESSAGE^BPSOS03(BPSRESP,BPSPOS,2)
IF 1
+6 IF '$TEST
SET MSG=$$MESSAGE^BPSOS03(BPSRESP,BPSPOS)
XMSG59 QUIT MSG
+1 ;
+2 ;Responds
RESP59(BP59,BPSRESP,BPSPOS) ;EP - caller should N BPSRESP,BPSPOS
+1 ;Input: BP59
+2 ;Output:
+3 ; BPSRESP,BPSPOS by reference
+4 ; reversal
IF $GET(^BPST(BP59,4))
Begin DoDot:1
+5 SET BPSRESP=$PIECE($GET(^BPST(BP59,4)),U,2)
+6 SET BPSPOS=1
End DoDot:1
+7 IF '$TEST
Begin DoDot:1
+8 SET BPSRESP=$PIECE($GET(^BPST(BP59,0)),U,5)
+9 SET BPSPOS=$PIECE($GET(^BPST(BP59,0)),U,9)
End DoDot:1
+10 QUIT
+11 ;
+12 ;Check and compare dates
CHKDT(BPTSTDT,BPBEGDT,BPENDDT) ;
+1 IF BPTSTDT=0
QUIT 0
+2 IF BPTSTDT'<BPBEGDT
IF BPTSTDT'>BPENDDT
QUIT 1
+3 QUIT 0
+4 ;
+5 ;Populate passed in Array
+6 ;
REJTEXT(BP59,ARR) NEW BBX,BPSRESP,BPSPOS,A,I,X,R
+1 SET BBX=$GET(^BPST(BP59,0))
+2 SET BPSRESP=$PIECE(BBX,U,5)
+3 SET BPSPOS=$PIECE(BBX,U,9)
+4 SET (A,I)=0
+5 IF BPSRESP&BPSPOS
Begin DoDot:1
+6 KILL ARR
+7 FOR
SET A=$ORDER(^BPSR(BPSRESP,1000,BPSPOS,511,A))
if 'A
QUIT
Begin DoDot:2
+8 SET R=$PIECE(^BPSR(BPSRESP,1000,BPSPOS,511,A,0),U)
+9 if R=""
QUIT
+10 NEW S
SET S=$ORDER(^BPSF(9002313.93,"B",R,0))
+11 IF S
SET X=$TRANSLATE($GET(^BPSF(9002313.93,S,0)),U,":")
+12 IF '$TEST
SET X=R_" unrecognized reject code"
+13 SET I=I+1
SET ARR(I)=X
+14 KILL S
End DoDot:2
End DoDot:1
+15 QUIT I
+16 ;
+17 ;Get Claim ID
CLAIMID(BP59) NEW BP02
+1 SET BP02=+$PIECE($GET(^BPST(BP59,0)),U,4)
+2 QUIT $PIECE($GET(^BPSC(BP02,0)),U)
+3 ;
+4 ;Determine $Ins Paid
+5 ;
INSPAID(BP59) NEW X,RESP,POSITION
+1 SET X=$GET(^BPST(BP59,0))
+2 SET RESP=$PIECE(X,U,5)
+3 SET POSITION=$PIECE(X,U,9)
+4 QUIT $SELECT(RESP&POSITION:$$INSPAID1^BPSOS03(RESP,POSITION),1:0)
+5 ;
+6 ;Get the Cardholder ID
CRDHLDID(BP59) NEW BP02
+1 SET BP02=+$PIECE($GET(^BPST(BP59,0)),U,4)
+2 QUIT $PIECE($GET(^BPSC(BP02,300)),U,2)
+3 ;
GRPID(BP59) ;sent by IB in RX^IBNCPDP
+1 NEW BP02
+2 SET BP02=+$PIECE($GET(^BPST(BP59,0)),U,4)
+3 QUIT $PIECE($GET(^BPSC(BP02,300)),U)
+4 ;
+5 ;Get the PATIENT PAY AMOUNT (#505) from file #9002313.0301
+6 ;
+7 ;Input: BPSRESP -BPS RESPONSE file IEN
+8 ; BPSPOS - POSITION IN CLAIM (#14) in file #9002313.59
+9 ;Output: BPPPAMT - PATIENT PAY AMOUNT
+10 ;
GETPPAY(BPSRESP,BPSPOS) ;
+1 NEW BPPPAMT
+2 ;(#505) PATIENT PAY AMOUNT
+3 SET BPPPAMT=$$GET1^DIQ(9002313.0301,BPSPOS_","_BPSRESP_",",505,"I")
+4 ; Convert a Signed Numeric Field to a Decimal Value
+5 ; '000021G' will be converted to '2.17' and Nulls will be converted to '0.00'
+6 SET BPPPAMT=$$DFF2EXT^BPSECFM(BPPPAMT)
+7 QUIT BPPPAMT
