- 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 Jan 18, 2025@02:53:37 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