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

BPSPRRX.m

Go to the documentation of this file.
  1. BPSPRRX ;ALB/SS - ePharmacy secondary billing ;12-DEC-08
  1. ;;1.0;E CLAIMS MGMT ENGINE;**8,9,11,28**;JUN 2004;Build 22
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;Entry point for the menu option [BPS COB PROCESS SECONDARY AND TRICARE CLAIMS]
  1. ;
  1. EN1 ;
  1. N BPSRXN,BPS399,BPSZ,BPSQLOOP,BPPAYSEQ,BPSRET,BPS52,BPSRF,BPSDOS,BPSDFN
  1. N BPQLOOP2,BPSELIG,BPSPCLS,BP59,BPSEQ,BPSINS
  1. S BPSQLOOP=0
  1. S BPSRET=""
  1. F D Q:BPSQLOOP=1
  1. . ; Prompt for RX#
  1. . S BPSZ=$$PROMPTRX()
  1. . I +BPSZ=0 Q
  1. . I +BPSZ<0 S BPSQLOOP=1 Q
  1. . S BPSDFN=$P(BPSZ,U,4),BPSRXN=$P(BPSZ,U,3),BPS52=$P(BPSZ,U,2)
  1. . ;select refill
  1. . S BPSZ=$$RXREFIL^BPSPRRX6(BPS52,BPSDFN,BPSRXN)
  1. . I +BPSZ=-1 S BPSQLOOP=1 Q
  1. . S BPSRF=+BPSZ
  1. . S BPSDOS=$$DOSDATE^BPSSCRRS(BPS52,BPSRF)
  1. . ;
  1. . ;Verify that the patient has valid ePharmacy coverage for the DOS
  1. . I '$$INSUR^IBBAPI(BPSDFN,BPSDOS,"E",.BPSINS,"1,7,8") D S BPSQLOOP=1 Q
  1. . . W !!,"Unable to find an ECME billable insurance policy within the"
  1. . . W !,"date of service for this RX/Fill. The patient insurance policy"
  1. . . W !,"must have a valid ePharmacy Group Plan associated with it."
  1. . . W !!,"You must correct this in order to continue.",!
  1. . . Q
  1. . ;
  1. . S BPQLOOP2=0
  1. . ;select payer sequence
  1. . F D Q:BPQLOOP2=1
  1. . . S BPPAYSEQ=$$SELCOB^BPSPRRX5("SELECT PAYER SEQUENCE","Select payer sequence for billing:")
  1. . . I +BPPAYSEQ=-1 S BPQLOOP2=1,BPSQLOOP=1 Q
  1. . . I +BPPAYSEQ'=1,(+BPPAYSEQ'=2) Q
  1. . . ;
  1. . . W !
  1. . . ;Make sure claim isn't closed
  1. . . S BP59=$$IEN59^BPSOSRX(BPS52,BPSRF,BPPAYSEQ)
  1. . . I $$CLOSED02^BPSSCR03($P($G(^BPST(BP59,0)),U,4)) D Q
  1. . . . S BPSEQ=$S(BPPAYSEQ=1:"primary",1:"secondary")
  1. . . . W !!,"A ",BPSEQ," claim exists that is closed and cannot be Resubmitted.",!,"Please reopen the closed ",BPSEQ," claim to resubmit."
  1. . . . S BPQLOOP2=1 Q
  1. . . ;
  1. . . ;create primary claim for entered RX/refill
  1. . . I BPPAYSEQ=1 S BPSRET=$$PRI4RXRF(BPS52,BPSRF,BPSDOS,BPSDFN) D DISPLMES(BPSRET,1) S:(+BPSRET'<0)!(+BPSRET=-100) BPQLOOP2=1,BPSQLOOP=1 Q
  1. . . ;
  1. . . ;create secondary claim for entered RX/refill
  1. . . ;cannot bill non-released RX
  1. . . I BPPAYSEQ=2 I $$RELDATE^BPSBCKJ(BPS52,BPSRF)']"" D DISPLMES("-108^RX/refill not released") S BPQLOOP2=1 S:+BPSRET=-100 BPSQLOOP=1 Q
  1. . . I BPPAYSEQ=2 D Q:BPQLOOP2=1
  1. . . . ;If this is a secondary, make sure Primary is either Payable or Closed.
  1. . . . ;Get Primary claim status
  1. . . . S BPSPCLS=$$FINDECLM^BPSPRRX5(BPS52,BPSRF,1)
  1. . . . I $P(BPSPCLS,U)>1 D Q:BPQLOOP2=1
  1. . . . . Q:$$CLOSED02^BPSSCR03($P($G(^BPST($P(BPSPCLS,U,2),0)),U,4))
  1. . . . . W !,"The secondary claim cannot be Submitted unless the primary is either payable",!,"or closed. Please resubmit or close the primary claim first."
  1. . . . . S BPQLOOP2=1 Q
  1. . . . S BPSRET=$$SEC4RXRF(BPS52,BPSRF,BPSDOS,$G(BPSDFN)) D DISPLMES(BPSRET,2) S:(+BPSRET'<0)!(+BPSRET=-100) BPQLOOP2=1,BPSQLOOP=1 Q
  1. ;
  1. Q
  1. ;
  1. ;create primary claim for entered RX/refill
  1. PRI4RXRF(BPS52,BPSRF,BPSDOS,BPSDFN) ;
  1. N BPSECLM,BPNEWCLM,BPSARR,BPSQ,BPRESUBM
  1. ;check if there is a primary e-claim
  1. S BPSECLM=$$FINDECLM^BPSPRRX5(BPS52,BPSRF,1)
  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 BPNEWCLM=0
  1. I +BPSECLM=2 D I BPNEWCLM'=1 Q "-100^Action cancelled"
  1. . D DISPECLM^BPSPRRX5(+$P(BPSECLM,U,2))
  1. . W !!,"There is an existing rejected/reversed e-claim for the RX/refill."
  1. . S BPNEWCLM=$$YESNO^BPSSCRRS("Do you want to submit a new primary claim(Y/N)","N")
  1. ;
  1. ; if not found or if existing rejected/reversed claim then continue , otherwise - quit
  1. ;
  1. S BPSQ=0
  1. ;check for primary bill
  1. S BPSZ=$$RXBILL^IBNCPUT3(BPS52,BPSRF,"P","",.BPSARR)
  1. I +BPSZ>0,+$P(BPSZ,U,2)>0 Q "-107^Existing active primary bill #"_$P($G(BPSARR(+$P(BPSZ,U,2))),U,1)
  1. I +BPSZ>0,+$P(BPSZ,U,2)=0 D I +BPSQ'=0 Q BPSQ
  1. . N BPS399,BPSCNT
  1. . S (BPSCNT,BPS399)=0
  1. . F S BPS399=$O(BPSARR(BPS399)) Q:+BPS399=0 D
  1. . . N BPPSEQ,BPSRET
  1. . . S BPSCNT=BPSCNT+1
  1. . . S BPSRET=$P(BPSARR(BPS399),U,5)
  1. . . S BPPSEQ=$S(BPSRET="S":"Secondary",BPSRET="T":"Tertiary",BPSRET="P":"Primary",1:"Unknown")
  1. . . W:BPSCNT=1 !!,"Non-active primary bill(s) found:"
  1. . . D DISPBILL^BPSPRRX2(BPPSEQ,$P(BPSARR(BPS399),U,4),$P(BPSARR(BPS399),U,1),$P(BPSARR(BPS399),U,2),BPS52,BPSRF,$P(BPSARR(BPS399),U,3),(BPSCNT=1))
  1. . W !
  1. . I $$YESNO^BPSSCRRS("DO YOU WISH TO CREATE A NEW PRIMARY BILL ?(Y/N)","N")'=1 S BPSQ="-100^Action cancelled"
  1. Q $$PRIMARY^BPSPRRX4(BPS52,BPSRF,BPSDFN,BPSDOS,BPSECLM,BPNEWCLM)
  1. ;
  1. ;create secondary claim for entered RX/refill
  1. SEC4RXRF(BPS52,BPSRF,BPSDOS,BPSDFN) ;
  1. N BPSARR,BPSRET,BPS399
  1. ;
  1. ; Try to find the primary bill
  1. S BPSRET=$$RXBILL^IBNCPUT3(BPS52,BPSRF,"P","",.BPSARR)
  1. ;
  1. ; SECNOPRM creates a secondary claim when there is no primary bill
  1. I +BPSRET=0 Q $$SECNOPRM^BPSPRRX5(BPS52,BPSRF,BPSDOS,$G(BPSDFN),"1,2")
  1. ;
  1. ; Get the active claim
  1. S BPS399=+$P(BPSRET,U,2)
  1. ;
  1. ; If no active claim, then get the most recent claim
  1. I BPS399'>0 S BPS399=+$O(BPSARR(999999999),-1)
  1. ;
  1. ; Check if there any secondary bills
  1. K BPSARR
  1. S BPSRET=$$RXBILL^IBNCPUT3(BPS52,BPSRF,"S","",.BPSARR)
  1. I +BPSRET>0,+$P(BPSRET,U,2)>0 Q "-107^Existing active secondary bill #"_$P($G(BPSARR(+$P(BPSRET,U,2))),U,1)
  1. ;
  1. ; Submit secondary claim when there is a primary bill
  1. Q $$SECONDRY(BPS52,BPSRF,BPSDOS,BPS399,"1,2")
  1. ;
  1. DISPLMES(BPSZ,BPSPSEQ) ;
  1. ;Display messages
  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. ; -107^Existing active bill
  1. ; -108^RX not released
  1. ; -109^Existing PAYABLE e-claim. Please reverse it before resubmitting.
  1. ; -110^No valid group insurance plans
  1. ;
  1. I BPSZ'<0 Q
  1. I +BPSZ=-100 W !!,$P(BPSZ,U,2),! Q
  1. I +$G(BPSPSEQ)=0 W !!,"Cannot submit e-claim:",!," ",$P(BPSZ,U,2),!
  1. I $G(BPSPSEQ)=2 D
  1. . I +BPSZ=-105 W !,"Select another plan - the plan selected has been used for primary billing",!! Q
  1. . W !,"Cannot submit secondary claim:",!," ",$P(BPSZ,U,2),!
  1. I $G(BPSPSEQ)=1 D
  1. . W !,"Cannot submit primary claim:",!," ",$P(BPSZ,U,2),!
  1. Q
  1. ;
  1. SECONDRY(BPSRX,BPSRF,BPSDOS,BPS399,BPDISPPR) ;
  1. ;Submit a secondary claim if there is a primary bill
  1. ;Input:
  1. ; BPSRX - Prescription IEN
  1. ; BPSRF - Fill Number
  1. ; BPSDOS - Date of Service
  1. ; BPS399 - primary bill (ien of file #399)
  1. ; BPDISPPR - display bill information for
  1. ; "1" - primary
  1. ; "2" - secondary
  1. ; "1,2" - both
  1. ;
  1. ;Submission result:
  1. ; Return value of EN^BPSNCPDP or an error code/text
  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,BPSDFN,BPSRET,BPRATTYP,BPSQ,BPY
  1. N BPSPLNSL,BPSECOND,BPSWHERE,BPSPLAN,BPSPL59,BPRTTP59,BPSARR,BPYDEF,BPRESUBM
  1. ;
  1. ;Default = original submission
  1. S BPRESUBM=0
  1. ;
  1. ;Get primary bill data
  1. S BPSRET=$$BILINF^IBNCPUT3(BPS399,.BPSBINFO)
  1. I +BPSRET=-1 Q "-103"_U_$P(BPSRET,U,2)
  1. ;
  1. S BPSDFN=+$P(BPSRET,U,2)
  1. S BPPAYSEQ=$S($P(BPSRET,U)="S":"Secondary",$P(BPSRET,U)="T":"Tertiary",$P(BPSRET,U)="P":"Primary",1:"Unknown")
  1. S BPSRXCOB=$S($P(BPSRET,U)="S":2,$P(BPSRET,U)="T":3,1:1)
  1. S BPSINIEN=BPSBINFO("INS IEN")
  1. ;
  1. ;Display primary bill data
  1. I $G(BPDISPPR)[1 D
  1. . W !,"Primary bill:"
  1. . D DISPBILL^BPSPRRX2(BPPAYSEQ,BPSBINFO("INS NAME"),BPSBINFO("BILL #"),BPSBINFO("AR STATUS"),BPSRX,BPSRF,"",1)
  1. . W !
  1. ;
  1. ;Check if there is the secondary ePharmacy 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 an existing 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(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. ; If still no ePharmacy secondary ins policy, quit with error
  1. I '$$SECINSCK(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. ; Set the PRIMARY BILL array element with the bill selected by this procedure
  1. S BPSECOND("PRIMARY BILL")=BPS399
  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. ; NEW COB DATA will indicate to BPSNCPDP that it should NOT rebuild the data from the BPS Transaction and
  1. ; the previous secondary claim
  1. S BPSECOND("NEW COB DATA")=1
  1. ;
  1. D ACTDTY^BPSPRRX7(BPSRX,BPSRF,BPSDFN,BPSDOS)
  1. ;
  1. ; Set BWHERE dependent on whether this is an original submission or a resubmit
  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. PROMPTRX() ;
  1. ; Prompts for RX# and gets confirmation
  1. ;returns:
  1. ; 1^RXIEN^RX#^DFN - Successful
  1. ; 0 - Timeout or Quit by user
  1. ; -1 = User entered "^"
  1. N BPRET,BPSRX,BPSDFN,BPSPTNM,BPSRXN,BPSRXST,BPSDRUG,BPSDIC,BPSRXD
  1. N X,Y,DIQ,DR,DA,DIC,DTOUT,DUOUT
  1. S BPRET=0,(BPSDIC,DIC)=52,X=""
  1. S BPSDIC(0)="AENQ"
  1. W ! D DIC^PSODI(52,.BPSDIC,X) ;DBIA 4858
  1. I (Y=-1)!$D(DUOUT)!$D(DTOUT) Q +Y
  1. S (DA,BPSRX)=+Y,BPSRXN=$P(Y,U,2),DIQ="BPSRXD",DIQ(0)="IE",DR=".01;2;6;100"
  1. D DIQ^PSODI(52,DIC,DR,DA,.DIQ) ;DBIA 4858
  1. S BPSDFN=BPSRXD(52,DA,2,"I")
  1. S BPSPTNM=BPSRXD(52,DA,2,"E")
  1. S BPSDRUG=BPSRXD(52,DA,6,"E")
  1. S BPSRXST=BPSRXD(52,DA,100,"E")
  1. W !!,?1,"Patient",?25,"RX#",?37,"Drug Name",?63,"RX Status"
  1. W !,?1,$E(BPSPTNM,1,23),?25,$E(BPSRXN,1,11),?37,$E(BPSDRUG,1,25),?63,$E(BPSRXST,1,16),!
  1. Q $S($$YESNO^BPSSCRRS("DO YOU WANT TO CONTINUE?(Y/N)","Y")=1:1,1:0)_U_BPSRX_U_BPSRXN_U_BPSDFN
  1. ;
  1. SECINSCK(DFN,DOS) ;
  1. ; secondary insurance check
  1. ; check to see if patient has at least one ePharmacy secondary insurance policy
  1. ; function value = 1 if there is one, 0 otherwise
  1. ;
  1. N OK,BPSRET,BPSINS,BPX
  1. S OK=0
  1. I '$G(DFN)!'$G(DOS) G SECINX
  1. S BPSRET=$$INSUR^IBBAPI(DFN,DOS,"E",.BPSINS,"1,7,8")
  1. I '$D(BPSINS) G SECINX
  1. S BPX=0 F S BPX=$O(BPSINS("IBBAPI","INSUR",BPX)) Q:'BPX D Q:OK
  1. . I $P($G(BPSINS("IBBAPI","INSUR",BPX,7)),U,1)=2 S OK=1 Q
  1. . Q
  1. SECINX ;
  1. Q OK
  1. ;