BPSPRRX5 ;ALB/SS - ePharmacy secondary billing ;12-DEC-08
;;1.0;E CLAIMS MGMT ENGINE;**8,10,11,20,28**;JUN 2004;Build 22
;;Per VA Directive 6402, this routine should not be modified.
;
;
;select refill by fill date
SELREFIL(BPSARR,BPSPRMPT,BPSMESS) ;
N BPSSTR,BPSCNT,DIR,X,Y
S BPX=""
S BPSCNT=0
S DIR("A")=BPSPRMPT
S DIR("L",1)=$G(BPSMESS)
S DIR("L",2)=""
S DIR("L",3)=" Fill Date"
S DIR("L",4)=" ==== =========="
F S BPX=$O(BPSARR(BPX)) Q:BPX="" D
. S BPSCNT=BPSCNT+1
. S $P(BPSSTR,";",BPSCNT)=BPX_":"_$$FMTE^XLFDT($P($G(BPSARR(BPX)),U,2),"5Z")
. S DIR("L",BPSCNT+4)=" "_BPX_" "_$$FMTE^XLFDT($P($G(BPSARR(BPX)),U,2),"5Z")
S DIR("L")=" "
S DIR(0)="SO^"_BPSSTR
D ^DIR
I X="^" Q "-1^"
I X="" Q ""
Q BPSARR(+Y)
;
;check if there is any e-claim for this RX/refill
;BPSRXIEN-ien of file# 52
;BPSREF-refill #
;BPCOBIND - payer sequence (1 -primary, 2- secondary)
;Return value "CODE ^ IEN59 ^ ECME STATUS ^ "
;where
;CODE is one of the following:
;0-not found OR the entry found in BPS TRANSACTION is a non-billable entry
;1-payable
;2-not payable (rejected/reversed)
;3-in progress (including scheduled requests)
;IEN59 is ien of the BPS TRANSACTION
;ECME STATUS is the ECME claims status text like "E PAYABLE"
;
FINDECLM(BPSRXIEN,BPSREF,BPCOBIND) ;
N BPS59,BPSSTAT,BPPAYBLE
S BPS59=+$$IEN59^BPSOSRX(BPSRXIEN,BPSREF,BPCOBIND)
I +$G(^BPST(BPS59,0))=0 Q 0
I $$NB^BPSSCR03(BPS59) Q 0_U_BPS59_U ; BPS*1*20 - non-billable entries return code 0 here
S BPSSTAT=$P($$STATUS^BPSOSRX(BPSRXIEN,BPSREF,,,BPCOBIND),U)
S BPPAYBLE=$$PAYABLE^BPSOSRX5(BPSSTAT)
I BPSSTAT["IN PROGRESS" Q 3_U_BPS59_U_BPSSTAT
I BPPAYBLE=1 Q 1_U_BPS59_U_BPSSTAT
I BPPAYBLE=0 Q 2_U_BPS59_U_BPSSTAT
Q 0
;
;Display e-claim details
;BPSIEN59-ien of the #9002313.59 BPS TRANSACTION file
DISPECLM(BP59) ;
W !,"Drug name NDC DOS RX# FILL/ECME# TYPE STATUS"
W !,"==============================================================================="
W !,$$CLMINFO(BP59)
Q
;
CLMINFO(BP59) ;
N BPX,BPX1,BPCOB,BPSSTAT,BPPAYBLE,DOSDT
S BPCOB=$$COB59^BPSUTIL2(BP59)
S BPX1=$$RXREF^BPSSCRU2(BP59)
S BPX=$$LJ^BPSSCR02($$DRGNAME^BPSSCRU2(BP59),12)_" "_$$LJ^BPSSCR02($$NDC^BPSSCRU2(+BPX1,+$P(BPX1,U,2)),13)_" "
;
;SLT - BPS*1.0*11
S DOSDT=$$LASTDOS^BPSUTIL2(BP59,0)
;
S BPX=BPX_$$LJ^BPSSCR02(DOSDT,5)_" "
S BPX=BPX_$$LJ^BPSSCR02($$RXNUM^BPSSCRU2(+BPX1),11)_" "_+$P(BPX1,U,2)_"/"
S BPX=BPX_$$LJ^BPSSCR02($$ECMENUM^BPSSCRU2(BP59),12)_" "_$$MWCNAME^BPSSCRU2($$GETMWC^BPSSCRU2(BP59))_" "
S BPX=BPX_$$RTBB^BPSSCRU2(BP59)_" "_$$RXST^BPSSCRU2(BP59)_"/"_$$RL^BPSSCRU2(BP59)
S BPSSTAT=$P($$STATUS^BPSOSRX(+BPX1,+$P(BPX1,U,2),,,BPCOB),U)
S BPPAYBLE=$$PAYABLE^BPSOSRX5(BPSSTAT)
I BPPAYBLE Q BPX_" PAYABLE"
I BPSSTAT["IN PROGRESS" Q BPX_" IN PROGRESS"
I BPSSTAT["E REVERSAL ACCEPTED" Q BPX_" REVERSED"
I BPSSTAT["E REJECTED" Q BPX_" REJECTED"
Q BPX_" OTHER"
;
;get the plan (#355.3) from the BPS TRANSACTION file record
GETPL59(BP59) ;
Q $P($G(^BPST(BP59,10,+$P($G(^BPST(BP59,9)),U,1),0)),U)
;
;get the RATE TYPE (#399.3) from the BPS TRANSACTION file record
GETRTP59(BP59) ;
Q $P($G(^BPST(BP59,10,+$P($G(^BPST(BP59,9)),U,1),0)),U,8)
;
;get the primary bill (#399) from the BPS TRANSACTION file record
GETBIL59(BP59) ;
Q $P($G(^BPST(BP59,10,+$P($G(^BPST(BP59,9)),U,1),2)),U,8)
;
SELCOB(BPSPRMPT,BPSMESS) ;
N DIR,X,Y
S DIR("A")=BPSPRMPT
S DIR(0)="SO^1:PRIMARY;2:SECONDARY"
S DIR("L",1)=BPSMESS
S DIR("L",2)=""
S DIR("L",3)=" 1 PRIMARY"
S DIR("L",4)=" 2 SECONDARY"
S DIR("L")=" "
D ^DIR
I X="^" Q "-1^"
Q +Y
;
SECNOPRM(BPSRX,BPSRF,BPSDOS,BPSDFN,BPDISPPR) ;
;Submit a secondary claim if there is no primary claim
;Input:
; BPSRX - Prescription IEN
; BPSRF - Fill Number
; BPSDOS - Date of Service
; BPSDRN - Patient IEN
; BPDISPPR - display bill information for
; "1" - primary
; "2" - secondary
; "1,2" - both
;
;Return Value:
; Either the response from EN^BPSNCPDP or an error condition listed below
; -100^Action cancelled
; -101^Existing e-claim
; -102^Claim in progress
; -103^Invalid or wrong bill#
; -104^Existing rejected/reversed e-claim
; -105^The same group plan selected
; -106^The primary insurer needs to be billed first.
; -107^Existing active bill
;
N BPSBINFO,BPSRXCOB,BPSINIEN,BPPAYSEQ,BPSECLM,BP2NDBIL,BPSRET,BPSQ,BPY,BPYDEF
N BPSPLNSL,BPSECOND,BPSWHERE,BPSPLAN,BPSPL59,BPRTTP59,BPSARR,BPRESUBM
;
;Default = original submission
S BPRESUBM=0
;
; Check if there is the secondary claim
S BPSECLM=$$FINDECLM^BPSPRRX5(BPSRX,BPSRF,2)
I +BPSECLM=3 Q "-102^Claim in progress"
I +BPSECLM=1 Q "-109^Existing PAYABLE e-claim. Please reverse it before resubmitting."
S BPSQ=0
I +BPSECLM=2 D Q:BPSQ=1 "-100^Action cancelled"
. D DISPECLM^BPSPRRX5(+$P(BPSECLM,U,2))
. W !!,"There is an existing rejected/reversed secondary e-claim(s) for the RX/refill."
. I $$YESNO^BPSSCRRS("Do you want to submit a new secondary claim(Y/N)","N")=1 S BPRESUBM=1
. I BPRESUBM'=1 S BPSQ=1
;
; Check for active secondary bill(s)
D Q:+$P(BP2NDBIL,U,2)>0 "-107^Existing active secondary bill"
. N BPSARR,BPS399,BPSCNT
. ;check for the existing secondary bill
. S BP2NDBIL=$$RXBILL^IBNCPUT3(BPSRX,BPSRF,"S","",.BPSARR)
. I +BP2NDBIL=0 Q ;not found
. S BPS399=0
. S BPSCNT=0
. F S BPS399=$O(BPSARR(BPS399)) Q:+BPS399=0 D
. . N BPPSEQ
. . S BPSCNT=BPSCNT+1
. . I $G(BPDISPPR)[2 D
. . . W:BPSCNT=1 !!,"Secondary bill(s) found:"
. . . S BPSRET=$P(BPSARR(BPS399),U,5)
. . . S BPPSEQ=$S($P(BPSRET,U)="S":"Secondary",$P(BPSRET,U)="T":"Tertiary",$P(BPSRET,U)="P":"Primary",1:"Unknown")
. . . D DISPBILL^BPSPRRX2(BPPSEQ,$P(BPSARR(BPS399),U,4),$P(BPSARR(BPS399),U,1),$P(BPSARR(BPS399),U,2),BPSRX,BPSRF,$P(BPSARR(BPS399),U,3),(BPSCNT=1))
. W !
;
; Check for ePharmacy secondary ins policy
S BPYDEF="N"
I '$$SECINSCK^BPSPRRX(BPSDFN,BPSDOS) D
. S BPYDEF="Y"
. W !!,"Unable to find a secondary insurance policy which is e-Pharmacy billable."
. W !,"You must correct this in order to continue.",!
. Q
;
; Ask the user if he wants to jump to the BCN PATIENT INSURANCE option
S BPY=$$YESNO^BPSSCRRS("DO YOU WISH TO ADD/EDIT INSURANCE COMPANY DATA FOR THIS PATIENT?(Y/N)",BPYDEF)
I BPY=1 D EN1^IBNCPDPI(BPSDFN)
I BPY=-1 Q "-100^Action cancelled"
;
; Check for ePharmacy secondary ins policy (after possible edit)
I '$$SECINSCK^BPSPRRX(BPSDFN,BPSDOS) Q "-115^No Secondary e-Pharmacy Insurance Policy."
;
; Get data from the primary claim, if it exists
S BPSRET=$$PRIMDATA^BPSPRRX6(BPSRX,BPSRF,.BPSECOND)
;
; If the primary claim data is missing and this is a resubmit, get data from the most recent
; secondary claim
I 'BPSRET,BPRESUBM=1,$$SECDATA^BPSPRRX6(BPSRX,BPSRF,.BPSPL59,.BPSECOND,.BPRTTP59)
;
; No primary bill
S BPSECOND("PRIMARY BILL")=""
;
; Display the data and allow the user to edit
I $$PROMPTS^BPSPRRX3(BPSRX,BPSRF,BPSDOS,.BPSECOND)=-1 Q "-100^Action cancelled"
;
; Continue?
W !
I $$YESNO^BPSSCRRS("SUBMIT CLAIM TO "_$G(BPSECOND("INS NAME"))_" ?(Y/N)","Y")'=1 Q "-100^Action cancelled"
;
; Set the flag that indicates to BPSNCPDP that it should not recompile the data from BPS Transactions
S BPSECOND("NEW COB DATA")=1
;
D ACTDTY^BPSPRRX7(BPSRX,BPSRF,BPSDFN,BPSDOS)
;
; Set BWHERE dependent on resubmit or not
I BPRESUBM=0 S BPSWHERE="P2"
I BPRESUBM=1 S BPSWHERE="P2S"
;
; Submit the claim
S BPSRET=$$SUBMCLM^BPSPRRX2(BPSRX,BPSRF,BPSDOS,BPSWHERE,2,BPSECOND("PLAN"),.BPSECOND,BPSECOND("RTYPE"))
I +BPSRET=4 W !!,$P(BPSRET,U,2),!
Q BPSRET
;
GETOPPRA(BPSRESP,BPARR) ; get the Other Payer-Patient Responsibility Amount/Qualifier pairs from the Primary payer response
; BPS*1*20
; Input: BPSRESP - response file ien
; Output: array BPARR (pass by reference)
; BPARR = count of amount/qualifier pairs
; BPARR(#) = AMOUNT ^ QUALIFIER
;
; This subroutine will gather specific dollar amounts from the response file and build the appropriate
; amount/qualifier pairs.
; 352-NQ Other Payer-Patient Responsibility Amount
; 351-NP Other Payer-Patient Responsibility Amount Qualifier (see the ECL for valid qualifiers)
;
N AMT
K BPARR
S BPARR=0
I '$G(BPSRESP) G GETPPX
I '$D(^BPSR(BPSRESP,1000)) G GETPPX
;
; First check for patient pay amount (505-F5) Qualifier 06.
; Per NCPDP implementation standard, when this exists, this is the only Other Payer-Pt Resp Amount pair. Count=1.
S AMT=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,500)),U,5))
I AMT S BPARR=BPARR+1,BPARR(BPARR)=AMT_U_"06" G GETPPX ; get out here if 505-F5 Qualifier 06 exists, we're done.
;
S AMT=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,500)),U,17)) ; 517-FH Qualifier 01
I AMT S BPARR=BPARR+1,BPARR(BPARR)=AMT_U_"01"
S AMT=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,130)),U,4)) ; 134-UK Qualifier 02
I AMT S BPARR=BPARR+1,BPARR(BPARR)=AMT_U_"02"
S AMT=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,500)),U,23)) ; 523-FN Qualifier 03
I AMT S BPARR=BPARR+1,BPARR(BPARR)=AMT_U_"03"
S AMT=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,500)),U,20)) ; 520-FK Qualifier 04
I AMT S BPARR=BPARR+1,BPARR(BPARR)=AMT_U_"04"
S AMT=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,500)),U,18)) ; 518-FI Qualifier 05
I AMT S BPARR=BPARR+1,BPARR(BPARR)=AMT_U_"05"
S AMT=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,570)),U,2)) ; 572-4U Qualifier 07
I AMT S BPARR=BPARR+1,BPARR(BPARR)=AMT_U_"07"
S AMT=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,130)),U,5)) ; 135-UM Qualifier 08
I AMT S BPARR=BPARR+1,BPARR(BPARR)=AMT_U_"08"
S AMT=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,120)),U,9)) ; 129-UD Qualifier 09
I AMT S BPARR=BPARR+1,BPARR(BPARR)=AMT_U_"09"
S AMT=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,130)),U,3)) ; 133-UJ Qualifier 10
I AMT S BPARR=BPARR+1,BPARR(BPARR)=AMT_U_"10"
S AMT=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,130)),U,6)) ; 136-UN Qualifier 11
I AMT S BPARR=BPARR+1,BPARR(BPARR)=AMT_U_"11"
S AMT=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,130)),U,7)) ; 137-UP Qualifier 12
I AMT S BPARR=BPARR+1,BPARR(BPARR)=AMT_U_"12"
S AMT=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,570)),U,1)) ; 571-NZ Qualifier 13
I AMT S BPARR=BPARR+1,BPARR(BPARR)=AMT_U_"13"
;
GETPPX ;
Q
;
;BPSPRRX5
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSPRRX5 10575 printed Sep 23, 2025@19:28:38 Page 2
BPSPRRX5 ;ALB/SS - ePharmacy secondary billing ;12-DEC-08
+1 ;;1.0;E CLAIMS MGMT ENGINE;**8,10,11,20,28**;JUN 2004;Build 22
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;
+5 ;select refill by fill date
SELREFIL(BPSARR,BPSPRMPT,BPSMESS) ;
+1 NEW BPSSTR,BPSCNT,DIR,X,Y
+2 SET BPX=""
+3 SET BPSCNT=0
+4 SET DIR("A")=BPSPRMPT
+5 SET DIR("L",1)=$GET(BPSMESS)
+6 SET DIR("L",2)=""
+7 SET DIR("L",3)=" Fill Date"
+8 SET DIR("L",4)=" ==== =========="
+9 FOR
SET BPX=$ORDER(BPSARR(BPX))
if BPX=""
QUIT
Begin DoDot:1
+10 SET BPSCNT=BPSCNT+1
+11 SET $PIECE(BPSSTR,";",BPSCNT)=BPX_":"_$$FMTE^XLFDT($PIECE($GET(BPSARR(BPX)),U,2),"5Z")
+12 SET DIR("L",BPSCNT+4)=" "_BPX_" "_$$FMTE^XLFDT($PIECE($GET(BPSARR(BPX)),U,2),"5Z")
End DoDot:1
+13 SET DIR("L")=" "
+14 SET DIR(0)="SO^"_BPSSTR
+15 DO ^DIR
+16 IF X="^"
QUIT "-1^"
+17 IF X=""
QUIT ""
+18 QUIT BPSARR(+Y)
+19 ;
+20 ;check if there is any e-claim for this RX/refill
+21 ;BPSRXIEN-ien of file# 52
+22 ;BPSREF-refill #
+23 ;BPCOBIND - payer sequence (1 -primary, 2- secondary)
+24 ;Return value "CODE ^ IEN59 ^ ECME STATUS ^ "
+25 ;where
+26 ;CODE is one of the following:
+27 ;0-not found OR the entry found in BPS TRANSACTION is a non-billable entry
+28 ;1-payable
+29 ;2-not payable (rejected/reversed)
+30 ;3-in progress (including scheduled requests)
+31 ;IEN59 is ien of the BPS TRANSACTION
+32 ;ECME STATUS is the ECME claims status text like "E PAYABLE"
+33 ;
FINDECLM(BPSRXIEN,BPSREF,BPCOBIND) ;
+1 NEW BPS59,BPSSTAT,BPPAYBLE
+2 SET BPS59=+$$IEN59^BPSOSRX(BPSRXIEN,BPSREF,BPCOBIND)
+3 IF +$GET(^BPST(BPS59,0))=0
QUIT 0
+4 ; BPS*1*20 - non-billable entries return code 0 here
IF $$NB^BPSSCR03(BPS59)
QUIT 0_U_BPS59_U
+5 SET BPSSTAT=$PIECE($$STATUS^BPSOSRX(BPSRXIEN,BPSREF,,,BPCOBIND),U)
+6 SET BPPAYBLE=$$PAYABLE^BPSOSRX5(BPSSTAT)
+7 IF BPSSTAT["IN PROGRESS"
QUIT 3_U_BPS59_U_BPSSTAT
+8 IF BPPAYBLE=1
QUIT 1_U_BPS59_U_BPSSTAT
+9 IF BPPAYBLE=0
QUIT 2_U_BPS59_U_BPSSTAT
+10 QUIT 0
+11 ;
+12 ;Display e-claim details
+13 ;BPSIEN59-ien of the #9002313.59 BPS TRANSACTION file
DISPECLM(BP59) ;
+1 WRITE !,"Drug name NDC DOS RX# FILL/ECME# TYPE STATUS"
+2 WRITE !,"==============================================================================="
+3 WRITE !,$$CLMINFO(BP59)
+4 QUIT
+5 ;
CLMINFO(BP59) ;
+1 NEW BPX,BPX1,BPCOB,BPSSTAT,BPPAYBLE,DOSDT
+2 SET BPCOB=$$COB59^BPSUTIL2(BP59)
+3 SET BPX1=$$RXREF^BPSSCRU2(BP59)
+4 SET BPX=$$LJ^BPSSCR02($$DRGNAME^BPSSCRU2(BP59),12)_" "_$$LJ^BPSSCR02($$NDC^BPSSCRU2(+BPX1,+$PIECE(BPX1,U,2)),13)_" "
+5 ;
+6 ;SLT - BPS*1.0*11
+7 SET DOSDT=$$LASTDOS^BPSUTIL2(BP59,0)
+8 ;
+9 SET BPX=BPX_$$LJ^BPSSCR02(DOSDT,5)_" "
+10 SET BPX=BPX_$$LJ^BPSSCR02($$RXNUM^BPSSCRU2(+BPX1),11)_" "_+$PIECE(BPX1,U,2)_"/"
+11 SET BPX=BPX_$$LJ^BPSSCR02($$ECMENUM^BPSSCRU2(BP59),12)_" "_$$MWCNAME^BPSSCRU2($$GETMWC^BPSSCRU2(BP59))_" "
+12 SET BPX=BPX_$$RTBB^BPSSCRU2(BP59)_" "_$$RXST^BPSSCRU2(BP59)_"/"_$$RL^BPSSCRU2(BP59)
+13 SET BPSSTAT=$PIECE($$STATUS^BPSOSRX(+BPX1,+$PIECE(BPX1,U,2),,,BPCOB),U)
+14 SET BPPAYBLE=$$PAYABLE^BPSOSRX5(BPSSTAT)
+15 IF BPPAYBLE
QUIT BPX_" PAYABLE"
+16 IF BPSSTAT["IN PROGRESS"
QUIT BPX_" IN PROGRESS"
+17 IF BPSSTAT["E REVERSAL ACCEPTED"
QUIT BPX_" REVERSED"
+18 IF BPSSTAT["E REJECTED"
QUIT BPX_" REJECTED"
+19 QUIT BPX_" OTHER"
+20 ;
+21 ;get the plan (#355.3) from the BPS TRANSACTION file record
GETPL59(BP59) ;
+1 QUIT $PIECE($GET(^BPST(BP59,10,+$PIECE($GET(^BPST(BP59,9)),U,1),0)),U)
+2 ;
+3 ;get the RATE TYPE (#399.3) from the BPS TRANSACTION file record
GETRTP59(BP59) ;
+1 QUIT $PIECE($GET(^BPST(BP59,10,+$PIECE($GET(^BPST(BP59,9)),U,1),0)),U,8)
+2 ;
+3 ;get the primary bill (#399) from the BPS TRANSACTION file record
GETBIL59(BP59) ;
+1 QUIT $PIECE($GET(^BPST(BP59,10,+$PIECE($GET(^BPST(BP59,9)),U,1),2)),U,8)
+2 ;
SELCOB(BPSPRMPT,BPSMESS) ;
+1 NEW DIR,X,Y
+2 SET DIR("A")=BPSPRMPT
+3 SET DIR(0)="SO^1:PRIMARY;2:SECONDARY"
+4 SET DIR("L",1)=BPSMESS
+5 SET DIR("L",2)=""
+6 SET DIR("L",3)=" 1 PRIMARY"
+7 SET DIR("L",4)=" 2 SECONDARY"
+8 SET DIR("L")=" "
+9 DO ^DIR
+10 IF X="^"
QUIT "-1^"
+11 QUIT +Y
+12 ;
SECNOPRM(BPSRX,BPSRF,BPSDOS,BPSDFN,BPDISPPR) ;
+1 ;Submit a secondary claim if there is no primary claim
+2 ;Input:
+3 ; BPSRX - Prescription IEN
+4 ; BPSRF - Fill Number
+5 ; BPSDOS - Date of Service
+6 ; BPSDRN - Patient IEN
+7 ; BPDISPPR - display bill information for
+8 ; "1" - primary
+9 ; "2" - secondary
+10 ; "1,2" - both
+11 ;
+12 ;Return Value:
+13 ; Either the response from EN^BPSNCPDP or an error condition listed below
+14 ; -100^Action cancelled
+15 ; -101^Existing e-claim
+16 ; -102^Claim in progress
+17 ; -103^Invalid or wrong bill#
+18 ; -104^Existing rejected/reversed e-claim
+19 ; -105^The same group plan selected
+20 ; -106^The primary insurer needs to be billed first.
+21 ; -107^Existing active bill
+22 ;
+23 NEW BPSBINFO,BPSRXCOB,BPSINIEN,BPPAYSEQ,BPSECLM,BP2NDBIL,BPSRET,BPSQ,BPY,BPYDEF
+24 NEW BPSPLNSL,BPSECOND,BPSWHERE,BPSPLAN,BPSPL59,BPRTTP59,BPSARR,BPRESUBM
+25 ;
+26 ;Default = original submission
+27 SET BPRESUBM=0
+28 ;
+29 ; Check if there is the secondary claim
+30 SET BPSECLM=$$FINDECLM^BPSPRRX5(BPSRX,BPSRF,2)
+31 IF +BPSECLM=3
QUIT "-102^Claim in progress"
+32 IF +BPSECLM=1
QUIT "-109^Existing PAYABLE e-claim. Please reverse it before resubmitting."
+33 SET BPSQ=0
+34 IF +BPSECLM=2
Begin DoDot:1
+35 DO DISPECLM^BPSPRRX5(+$PIECE(BPSECLM,U,2))
+36 WRITE !!,"There is an existing rejected/reversed secondary e-claim(s) for the RX/refill."
+37 IF $$YESNO^BPSSCRRS("Do you want to submit a new secondary claim(Y/N)","N")=1
SET BPRESUBM=1
+38 IF BPRESUBM'=1
SET BPSQ=1
End DoDot:1
if BPSQ=1
QUIT "-100^Action cancelled"
+39 ;
+40 ; Check for active secondary bill(s)
+41 Begin DoDot:1
+42 NEW BPSARR,BPS399,BPSCNT
+43 ;check for the existing secondary bill
+44 SET BP2NDBIL=$$RXBILL^IBNCPUT3(BPSRX,BPSRF,"S","",.BPSARR)
+45 ;not found
IF +BP2NDBIL=0
QUIT
+46 SET BPS399=0
+47 SET BPSCNT=0
+48 FOR
SET BPS399=$ORDER(BPSARR(BPS399))
if +BPS399=0
QUIT
Begin DoDot:2
+49 NEW BPPSEQ
+50 SET BPSCNT=BPSCNT+1
+51 IF $GET(BPDISPPR)[2
Begin DoDot:3
+52 if BPSCNT=1
WRITE !!,"Secondary bill(s) found:"
+53 SET BPSRET=$PIECE(BPSARR(BPS399),U,5)
+54 SET BPPSEQ=$SELECT($PIECE(BPSRET,U)="S":"Secondary",$PIECE(BPSRET,U)="T":"Tertiary",$PIECE(BPSRET,U)="P":"Primary",1:"Unknown")
+55 DO DISPBILL^BPSPRRX2(BPPSEQ,$PIECE(BPSARR(BPS399),U,4),$PIECE(BPSARR(BPS399),U,1),$PIECE(BPSARR(BPS399),U,2),BPSRX,BPSRF,$PIECE(BPSARR(BPS399),U,3),(BPSCNT=1))
End DoDot:3
End DoDot:2
+56 WRITE !
End DoDot:1
if +$PIECE(BP2NDBIL,U,2)>0
QUIT "-107^Existing active secondary bill"
+57 ;
+58 ; Check for ePharmacy secondary ins policy
+59 SET BPYDEF="N"
+60 IF '$$SECINSCK^BPSPRRX(BPSDFN,BPSDOS)
Begin DoDot:1
+61 SET BPYDEF="Y"
+62 WRITE !!,"Unable to find a secondary insurance policy which is e-Pharmacy billable."
+63 WRITE !,"You must correct this in order to continue.",!
+64 QUIT
End DoDot:1
+65 ;
+66 ; Ask the user if he wants to jump to the BCN PATIENT INSURANCE option
+67 SET BPY=$$YESNO^BPSSCRRS("DO YOU WISH TO ADD/EDIT INSURANCE COMPANY DATA FOR THIS PATIENT?(Y/N)",BPYDEF)
+68 IF BPY=1
DO EN1^IBNCPDPI(BPSDFN)
+69 IF BPY=-1
QUIT "-100^Action cancelled"
+70 ;
+71 ; Check for ePharmacy secondary ins policy (after possible edit)
+72 IF '$$SECINSCK^BPSPRRX(BPSDFN,BPSDOS)
QUIT "-115^No Secondary e-Pharmacy Insurance Policy."
+73 ;
+74 ; Get data from the primary claim, if it exists
+75 SET BPSRET=$$PRIMDATA^BPSPRRX6(BPSRX,BPSRF,.BPSECOND)
+76 ;
+77 ; If the primary claim data is missing and this is a resubmit, get data from the most recent
+78 ; secondary claim
+79 IF 'BPSRET
IF BPRESUBM=1
IF $$SECDATA^BPSPRRX6(BPSRX,BPSRF,.BPSPL59,.BPSECOND,.BPRTTP59)
+80 ;
+81 ; No primary bill
+82 SET BPSECOND("PRIMARY BILL")=""
+83 ;
+84 ; Display the data and allow the user to edit
+85 IF $$PROMPTS^BPSPRRX3(BPSRX,BPSRF,BPSDOS,.BPSECOND)=-1
QUIT "-100^Action cancelled"
+86 ;
+87 ; Continue?
+88 WRITE !
+89 IF $$YESNO^BPSSCRRS("SUBMIT CLAIM TO "_$GET(BPSECOND("INS NAME"))_" ?(Y/N)","Y")'=1
QUIT "-100^Action cancelled"
+90 ;
+91 ; Set the flag that indicates to BPSNCPDP that it should not recompile the data from BPS Transactions
+92 SET BPSECOND("NEW COB DATA")=1
+93 ;
+94 DO ACTDTY^BPSPRRX7(BPSRX,BPSRF,BPSDFN,BPSDOS)
+95 ;
+96 ; Set BWHERE dependent on resubmit or not
+97 IF BPRESUBM=0
SET BPSWHERE="P2"
+98 IF BPRESUBM=1
SET BPSWHERE="P2S"
+99 ;
+100 ; Submit the claim
+101 SET BPSRET=$$SUBMCLM^BPSPRRX2(BPSRX,BPSRF,BPSDOS,BPSWHERE,2,BPSECOND("PLAN"),.BPSECOND,BPSECOND("RTYPE"))
+102 IF +BPSRET=4
WRITE !!,$PIECE(BPSRET,U,2),!
+103 QUIT BPSRET
+104 ;
GETOPPRA(BPSRESP,BPARR) ; get the Other Payer-Patient Responsibility Amount/Qualifier pairs from the Primary payer response
+1 ; BPS*1*20
+2 ; Input: BPSRESP - response file ien
+3 ; Output: array BPARR (pass by reference)
+4 ; BPARR = count of amount/qualifier pairs
+5 ; BPARR(#) = AMOUNT ^ QUALIFIER
+6 ;
+7 ; This subroutine will gather specific dollar amounts from the response file and build the appropriate
+8 ; amount/qualifier pairs.
+9 ; 352-NQ Other Payer-Patient Responsibility Amount
+10 ; 351-NP Other Payer-Patient Responsibility Amount Qualifier (see the ECL for valid qualifiers)
+11 ;
+12 NEW AMT
+13 KILL BPARR
+14 SET BPARR=0
+15 IF '$GET(BPSRESP)
GOTO GETPPX
+16 IF '$DATA(^BPSR(BPSRESP,1000))
GOTO GETPPX
+17 ;
+18 ; First check for patient pay amount (505-F5) Qualifier 06.
+19 ; Per NCPDP implementation standard, when this exists, this is the only Other Payer-Pt Resp Amount pair. Count=1.
+20 SET AMT=$$DFF2EXT^BPSECFM($PIECE($GET(^BPSR(BPSRESP,1000,1,500)),U,5))
+21 ; get out here if 505-F5 Qualifier 06 exists, we're done.
IF AMT
SET BPARR=BPARR+1
SET BPARR(BPARR)=AMT_U_"06"
GOTO GETPPX
+22 ;
+23 ; 517-FH Qualifier 01
SET AMT=$$DFF2EXT^BPSECFM($PIECE($GET(^BPSR(BPSRESP,1000,1,500)),U,17))
+24 IF AMT
SET BPARR=BPARR+1
SET BPARR(BPARR)=AMT_U_"01"
+25 ; 134-UK Qualifier 02
SET AMT=$$DFF2EXT^BPSECFM($PIECE($GET(^BPSR(BPSRESP,1000,1,130)),U,4))
+26 IF AMT
SET BPARR=BPARR+1
SET BPARR(BPARR)=AMT_U_"02"
+27 ; 523-FN Qualifier 03
SET AMT=$$DFF2EXT^BPSECFM($PIECE($GET(^BPSR(BPSRESP,1000,1,500)),U,23))
+28 IF AMT
SET BPARR=BPARR+1
SET BPARR(BPARR)=AMT_U_"03"
+29 ; 520-FK Qualifier 04
SET AMT=$$DFF2EXT^BPSECFM($PIECE($GET(^BPSR(BPSRESP,1000,1,500)),U,20))
+30 IF AMT
SET BPARR=BPARR+1
SET BPARR(BPARR)=AMT_U_"04"
+31 ; 518-FI Qualifier 05
SET AMT=$$DFF2EXT^BPSECFM($PIECE($GET(^BPSR(BPSRESP,1000,1,500)),U,18))
+32 IF AMT
SET BPARR=BPARR+1
SET BPARR(BPARR)=AMT_U_"05"
+33 ; 572-4U Qualifier 07
SET AMT=$$DFF2EXT^BPSECFM($PIECE($GET(^BPSR(BPSRESP,1000,1,570)),U,2))
+34 IF AMT
SET BPARR=BPARR+1
SET BPARR(BPARR)=AMT_U_"07"
+35 ; 135-UM Qualifier 08
SET AMT=$$DFF2EXT^BPSECFM($PIECE($GET(^BPSR(BPSRESP,1000,1,130)),U,5))
+36 IF AMT
SET BPARR=BPARR+1
SET BPARR(BPARR)=AMT_U_"08"
+37 ; 129-UD Qualifier 09
SET AMT=$$DFF2EXT^BPSECFM($PIECE($GET(^BPSR(BPSRESP,1000,1,120)),U,9))
+38 IF AMT
SET BPARR=BPARR+1
SET BPARR(BPARR)=AMT_U_"09"
+39 ; 133-UJ Qualifier 10
SET AMT=$$DFF2EXT^BPSECFM($PIECE($GET(^BPSR(BPSRESP,1000,1,130)),U,3))
+40 IF AMT
SET BPARR=BPARR+1
SET BPARR(BPARR)=AMT_U_"10"
+41 ; 136-UN Qualifier 11
SET AMT=$$DFF2EXT^BPSECFM($PIECE($GET(^BPSR(BPSRESP,1000,1,130)),U,6))
+42 IF AMT
SET BPARR=BPARR+1
SET BPARR(BPARR)=AMT_U_"11"
+43 ; 137-UP Qualifier 12
SET AMT=$$DFF2EXT^BPSECFM($PIECE($GET(^BPSR(BPSRESP,1000,1,130)),U,7))
+44 IF AMT
SET BPARR=BPARR+1
SET BPARR(BPARR)=AMT_U_"12"
+45 ; 571-NZ Qualifier 13
SET AMT=$$DFF2EXT^BPSECFM($PIECE($GET(^BPSR(BPSRESP,1000,1,570)),U,1))
+46 IF AMT
SET BPARR=BPARR+1
SET BPARR(BPARR)=AMT_U_"13"
+47 ;
GETPPX ;
+1 QUIT
+2 ;
+3 ;BPSPRRX5
