Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BPSPRRX5

BPSPRRX5.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;
  1. ;select refill by fill date
  1. SELREFIL(BPSARR,BPSPRMPT,BPSMESS) ;
  1. N BPSSTR,BPSCNT,DIR,X,Y
  1. S BPX=""
  1. S BPSCNT=0
  1. S DIR("A")=BPSPRMPT
  1. S DIR("L",1)=$G(BPSMESS)
  1. S DIR("L",2)=""
  1. S DIR("L",3)=" Fill Date"
  1. S DIR("L",4)=" ==== =========="
  1. F S BPX=$O(BPSARR(BPX)) Q:BPX="" D
  1. . S BPSCNT=BPSCNT+1
  1. . S $P(BPSSTR,";",BPSCNT)=BPX_":"_$$FMTE^XLFDT($P($G(BPSARR(BPX)),U,2),"5Z")
  1. . S DIR("L",BPSCNT+4)=" "_BPX_" "_$$FMTE^XLFDT($P($G(BPSARR(BPX)),U,2),"5Z")
  1. S DIR("L")=" "
  1. S DIR(0)="SO^"_BPSSTR
  1. D ^DIR
  1. I X="^" Q "-1^"
  1. I X="" Q ""
  1. Q BPSARR(+Y)
  1. ;
  1. ;check if there is any e-claim for this RX/refill
  1. ;BPSRXIEN-ien of file# 52
  1. ;BPSREF-refill #
  1. ;BPCOBIND - payer sequence (1 -primary, 2- secondary)
  1. ;Return value "CODE ^ IEN59 ^ ECME STATUS ^ "
  1. ;where
  1. ;CODE is one of the following:
  1. ;0-not found OR the entry found in BPS TRANSACTION is a non-billable entry
  1. ;1-payable
  1. ;2-not payable (rejected/reversed)
  1. ;3-in progress (including scheduled requests)
  1. ;IEN59 is ien of the BPS TRANSACTION
  1. ;ECME STATUS is the ECME claims status text like "E PAYABLE"
  1. ;
  1. FINDECLM(BPSRXIEN,BPSREF,BPCOBIND) ;
  1. N BPS59,BPSSTAT,BPPAYBLE
  1. S BPS59=+$$IEN59^BPSOSRX(BPSRXIEN,BPSREF,BPCOBIND)
  1. I +$G(^BPST(BPS59,0))=0 Q 0
  1. I $$NB^BPSSCR03(BPS59) Q 0_U_BPS59_U ; BPS*1*20 - non-billable entries return code 0 here
  1. S BPSSTAT=$P($$STATUS^BPSOSRX(BPSRXIEN,BPSREF,,,BPCOBIND),U)
  1. S BPPAYBLE=$$PAYABLE^BPSOSRX5(BPSSTAT)
  1. I BPSSTAT["IN PROGRESS" Q 3_U_BPS59_U_BPSSTAT
  1. I BPPAYBLE=1 Q 1_U_BPS59_U_BPSSTAT
  1. I BPPAYBLE=0 Q 2_U_BPS59_U_BPSSTAT
  1. Q 0
  1. ;
  1. ;Display e-claim details
  1. ;BPSIEN59-ien of the #9002313.59 BPS TRANSACTION file
  1. DISPECLM(BP59) ;
  1. W !,"Drug name NDC DOS RX# FILL/ECME# TYPE STATUS"
  1. W !,"==============================================================================="
  1. W !,$$CLMINFO(BP59)
  1. Q
  1. ;
  1. CLMINFO(BP59) ;
  1. N BPX,BPX1,BPCOB,BPSSTAT,BPPAYBLE,DOSDT
  1. S BPCOB=$$COB59^BPSUTIL2(BP59)
  1. S BPX1=$$RXREF^BPSSCRU2(BP59)
  1. S BPX=$$LJ^BPSSCR02($$DRGNAME^BPSSCRU2(BP59),12)_" "_$$LJ^BPSSCR02($$NDC^BPSSCRU2(+BPX1,+$P(BPX1,U,2)),13)_" "
  1. ;
  1. ;SLT - BPS*1.0*11
  1. S DOSDT=$$LASTDOS^BPSUTIL2(BP59,0)
  1. ;
  1. S BPX=BPX_$$LJ^BPSSCR02(DOSDT,5)_" "
  1. S BPX=BPX_$$LJ^BPSSCR02($$RXNUM^BPSSCRU2(+BPX1),11)_" "_+$P(BPX1,U,2)_"/"
  1. S BPX=BPX_$$LJ^BPSSCR02($$ECMENUM^BPSSCRU2(BP59),12)_" "_$$MWCNAME^BPSSCRU2($$GETMWC^BPSSCRU2(BP59))_" "
  1. S BPX=BPX_$$RTBB^BPSSCRU2(BP59)_" "_$$RXST^BPSSCRU2(BP59)_"/"_$$RL^BPSSCRU2(BP59)
  1. S BPSSTAT=$P($$STATUS^BPSOSRX(+BPX1,+$P(BPX1,U,2),,,BPCOB),U)
  1. S BPPAYBLE=$$PAYABLE^BPSOSRX5(BPSSTAT)
  1. I BPPAYBLE Q BPX_" PAYABLE"
  1. I BPSSTAT["IN PROGRESS" Q BPX_" IN PROGRESS"
  1. I BPSSTAT["E REVERSAL ACCEPTED" Q BPX_" REVERSED"
  1. I BPSSTAT["E REJECTED" Q BPX_" REJECTED"
  1. Q BPX_" OTHER"
  1. ;
  1. ;get the plan (#355.3) from the BPS TRANSACTION file record
  1. GETPL59(BP59) ;
  1. Q $P($G(^BPST(BP59,10,+$P($G(^BPST(BP59,9)),U,1),0)),U)
  1. ;
  1. ;get the RATE TYPE (#399.3) from the BPS TRANSACTION file record
  1. GETRTP59(BP59) ;
  1. Q $P($G(^BPST(BP59,10,+$P($G(^BPST(BP59,9)),U,1),0)),U,8)
  1. ;
  1. ;get the primary bill (#399) from the BPS TRANSACTION file record
  1. GETBIL59(BP59) ;
  1. Q $P($G(^BPST(BP59,10,+$P($G(^BPST(BP59,9)),U,1),2)),U,8)
  1. ;
  1. SELCOB(BPSPRMPT,BPSMESS) ;
  1. N DIR,X,Y
  1. S DIR("A")=BPSPRMPT
  1. S DIR(0)="SO^1:PRIMARY;2:SECONDARY"
  1. S DIR("L",1)=BPSMESS
  1. S DIR("L",2)=""
  1. S DIR("L",3)=" 1 PRIMARY"
  1. S DIR("L",4)=" 2 SECONDARY"
  1. S DIR("L")=" "
  1. D ^DIR
  1. I X="^" Q "-1^"
  1. Q +Y
  1. ;
  1. SECNOPRM(BPSRX,BPSRF,BPSDOS,BPSDFN,BPDISPPR) ;
  1. ;Submit a secondary claim if there is no primary claim
  1. ;Input:
  1. ; BPSRX - Prescription IEN
  1. ; BPSRF - Fill Number
  1. ; BPSDOS - Date of Service
  1. ; BPSDRN - Patient IEN
  1. ; BPDISPPR - display bill information for
  1. ; "1" - primary
  1. ; "2" - secondary
  1. ; "1,2" - both
  1. ;
  1. ;Return Value:
  1. ; Either the response from EN^BPSNCPDP or an error condition listed below
  1. ; -100^Action cancelled
  1. ; -101^Existing e-claim
  1. ; -102^Claim in progress
  1. ; -103^Invalid or wrong bill#
  1. ; -104^Existing rejected/reversed e-claim
  1. ; -105^The same group plan selected
  1. ; -106^The primary insurer needs to be billed first.
  1. ; -107^Existing active bill
  1. ;
  1. N BPSBINFO,BPSRXCOB,BPSINIEN,BPPAYSEQ,BPSECLM,BP2NDBIL,BPSRET,BPSQ,BPY,BPYDEF
  1. N BPSPLNSL,BPSECOND,BPSWHERE,BPSPLAN,BPSPL59,BPRTTP59,BPSARR,BPRESUBM
  1. ;
  1. ;Default = original submission
  1. S BPRESUBM=0
  1. ;
  1. ; Check if there is the secondary claim
  1. S BPSECLM=$$FINDECLM^BPSPRRX5(BPSRX,BPSRF,2)
  1. I +BPSECLM=3 Q "-102^Claim in progress"
  1. I +BPSECLM=1 Q "-109^Existing PAYABLE e-claim. Please reverse it before resubmitting."
  1. S BPSQ=0
  1. I +BPSECLM=2 D Q:BPSQ=1 "-100^Action cancelled"
  1. . D DISPECLM^BPSPRRX5(+$P(BPSECLM,U,2))
  1. . W !!,"There is an existing rejected/reversed secondary e-claim(s) for the RX/refill."
  1. . I $$YESNO^BPSSCRRS("Do you want to submit a new secondary claim(Y/N)","N")=1 S BPRESUBM=1
  1. . I BPRESUBM'=1 S BPSQ=1
  1. ;
  1. ; Check for active secondary bill(s)
  1. D Q:+$P(BP2NDBIL,U,2)>0 "-107^Existing active secondary bill"
  1. . N BPSARR,BPS399,BPSCNT
  1. . ;check for the existing secondary bill
  1. . S BP2NDBIL=$$RXBILL^IBNCPUT3(BPSRX,BPSRF,"S","",.BPSARR)
  1. . I +BP2NDBIL=0 Q ;not found
  1. . S BPS399=0
  1. . S BPSCNT=0
  1. . F S BPS399=$O(BPSARR(BPS399)) Q:+BPS399=0 D
  1. . . N BPPSEQ
  1. . . S BPSCNT=BPSCNT+1
  1. . . I $G(BPDISPPR)[2 D
  1. . . . W:BPSCNT=1 !!,"Secondary bill(s) found:"
  1. . . . S BPSRET=$P(BPSARR(BPS399),U,5)
  1. . . . S BPPSEQ=$S($P(BPSRET,U)="S":"Secondary",$P(BPSRET,U)="T":"Tertiary",$P(BPSRET,U)="P":"Primary",1:"Unknown")
  1. . . . 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))
  1. . W !
  1. ;
  1. ; Check for ePharmacy secondary ins policy
  1. S BPYDEF="N"
  1. I '$$SECINSCK^BPSPRRX(BPSDFN,BPSDOS) D
  1. . S BPYDEF="Y"
  1. . W !!,"Unable to find a secondary insurance policy which is e-Pharmacy billable."
  1. . W !,"You must correct this in order to continue.",!
  1. . Q
  1. ;
  1. ; Ask the user if he wants to jump to the BCN PATIENT INSURANCE option
  1. S BPY=$$YESNO^BPSSCRRS("DO YOU WISH TO ADD/EDIT INSURANCE COMPANY DATA FOR THIS PATIENT?(Y/N)",BPYDEF)
  1. I BPY=1 D EN1^IBNCPDPI(BPSDFN)
  1. I BPY=-1 Q "-100^Action cancelled"
  1. ;
  1. ; Check for ePharmacy secondary ins policy (after possible edit)
  1. I '$$SECINSCK^BPSPRRX(BPSDFN,BPSDOS) Q "-115^No Secondary e-Pharmacy Insurance Policy."
  1. ;
  1. ; Get data from the primary claim, if it exists
  1. S BPSRET=$$PRIMDATA^BPSPRRX6(BPSRX,BPSRF,.BPSECOND)
  1. ;
  1. ; If the primary claim data is missing and this is a resubmit, get data from the most recent
  1. ; secondary claim
  1. I 'BPSRET,BPRESUBM=1,$$SECDATA^BPSPRRX6(BPSRX,BPSRF,.BPSPL59,.BPSECOND,.BPRTTP59)
  1. ;
  1. ; No primary bill
  1. S BPSECOND("PRIMARY BILL")=""
  1. ;
  1. ; Display the data and allow the user to edit
  1. I $$PROMPTS^BPSPRRX3(BPSRX,BPSRF,BPSDOS,.BPSECOND)=-1 Q "-100^Action cancelled"
  1. ;
  1. ; Continue?
  1. W !
  1. I $$YESNO^BPSSCRRS("SUBMIT CLAIM TO "_$G(BPSECOND("INS NAME"))_" ?(Y/N)","Y")'=1 Q "-100^Action cancelled"
  1. ;
  1. ; Set the flag that indicates to BPSNCPDP that it should not recompile the data from BPS Transactions
  1. S BPSECOND("NEW COB DATA")=1
  1. ;
  1. D ACTDTY^BPSPRRX7(BPSRX,BPSRF,BPSDFN,BPSDOS)
  1. ;
  1. ; Set BWHERE dependent on resubmit or not
  1. I BPRESUBM=0 S BPSWHERE="P2"
  1. I BPRESUBM=1 S BPSWHERE="P2S"
  1. ;
  1. ; Submit the claim
  1. S BPSRET=$$SUBMCLM^BPSPRRX2(BPSRX,BPSRF,BPSDOS,BPSWHERE,2,BPSECOND("PLAN"),.BPSECOND,BPSECOND("RTYPE"))
  1. I +BPSRET=4 W !!,$P(BPSRET,U,2),!
  1. Q BPSRET
  1. ;
  1. GETOPPRA(BPSRESP,BPARR) ; get the Other Payer-Patient Responsibility Amount/Qualifier pairs from the Primary payer response
  1. ; BPS*1*20
  1. ; Input: BPSRESP - response file ien
  1. ; Output: array BPARR (pass by reference)
  1. ; BPARR = count of amount/qualifier pairs
  1. ; BPARR(#) = AMOUNT ^ QUALIFIER
  1. ;
  1. ; This subroutine will gather specific dollar amounts from the response file and build the appropriate
  1. ; amount/qualifier pairs.
  1. ; 352-NQ Other Payer-Patient Responsibility Amount
  1. ; 351-NP Other Payer-Patient Responsibility Amount Qualifier (see the ECL for valid qualifiers)
  1. ;
  1. N AMT
  1. K BPARR
  1. S BPARR=0
  1. I '$G(BPSRESP) G GETPPX
  1. I '$D(^BPSR(BPSRESP,1000)) G GETPPX
  1. ;
  1. ; First check for patient pay amount (505-F5) Qualifier 06.
  1. ; Per NCPDP implementation standard, when this exists, this is the only Other Payer-Pt Resp Amount pair. Count=1.
  1. S AMT=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,500)),U,5))
  1. 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.
  1. ;
  1. S AMT=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,500)),U,17)) ; 517-FH Qualifier 01
  1. I AMT S BPARR=BPARR+1,BPARR(BPARR)=AMT_U_"01"
  1. S AMT=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,130)),U,4)) ; 134-UK Qualifier 02
  1. I AMT S BPARR=BPARR+1,BPARR(BPARR)=AMT_U_"02"
  1. S AMT=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,500)),U,23)) ; 523-FN Qualifier 03
  1. I AMT S BPARR=BPARR+1,BPARR(BPARR)=AMT_U_"03"
  1. S AMT=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,500)),U,20)) ; 520-FK Qualifier 04
  1. I AMT S BPARR=BPARR+1,BPARR(BPARR)=AMT_U_"04"
  1. S AMT=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,500)),U,18)) ; 518-FI Qualifier 05
  1. I AMT S BPARR=BPARR+1,BPARR(BPARR)=AMT_U_"05"
  1. S AMT=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,570)),U,2)) ; 572-4U Qualifier 07
  1. I AMT S BPARR=BPARR+1,BPARR(BPARR)=AMT_U_"07"
  1. S AMT=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,130)),U,5)) ; 135-UM Qualifier 08
  1. I AMT S BPARR=BPARR+1,BPARR(BPARR)=AMT_U_"08"
  1. S AMT=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,120)),U,9)) ; 129-UD Qualifier 09
  1. I AMT S BPARR=BPARR+1,BPARR(BPARR)=AMT_U_"09"
  1. S AMT=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,130)),U,3)) ; 133-UJ Qualifier 10
  1. I AMT S BPARR=BPARR+1,BPARR(BPARR)=AMT_U_"10"
  1. S AMT=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,130)),U,6)) ; 136-UN Qualifier 11
  1. I AMT S BPARR=BPARR+1,BPARR(BPARR)=AMT_U_"11"
  1. S AMT=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,130)),U,7)) ; 137-UP Qualifier 12
  1. I AMT S BPARR=BPARR+1,BPARR(BPARR)=AMT_U_"12"
  1. S AMT=$$DFF2EXT^BPSECFM($P($G(^BPSR(BPSRESP,1000,1,570)),U,1)) ; 571-NZ Qualifier 13
  1. I AMT S BPARR=BPARR+1,BPARR(BPARR)=AMT_U_"13"
  1. ;
  1. GETPPX ;
  1. Q
  1. ;
  1. ;BPSPRRX5