- BPSPRRX ;ALB/SS - ePharmacy secondary billing ;12-DEC-08
- ;;1.0;E CLAIMS MGMT ENGINE;**8,9,11,28**;JUN 2004;Build 22
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- ;Entry point for the menu option [BPS COB PROCESS SECONDARY AND TRICARE CLAIMS]
- ;
- EN1 ;
- N BPSRXN,BPS399,BPSZ,BPSQLOOP,BPPAYSEQ,BPSRET,BPS52,BPSRF,BPSDOS,BPSDFN
- N BPQLOOP2,BPSELIG,BPSPCLS,BP59,BPSEQ,BPSINS
- S BPSQLOOP=0
- S BPSRET=""
- F D Q:BPSQLOOP=1
- . ; Prompt for RX#
- . S BPSZ=$$PROMPTRX()
- . I +BPSZ=0 Q
- . I +BPSZ<0 S BPSQLOOP=1 Q
- . S BPSDFN=$P(BPSZ,U,4),BPSRXN=$P(BPSZ,U,3),BPS52=$P(BPSZ,U,2)
- . ;select refill
- . S BPSZ=$$RXREFIL^BPSPRRX6(BPS52,BPSDFN,BPSRXN)
- . I +BPSZ=-1 S BPSQLOOP=1 Q
- . S BPSRF=+BPSZ
- . S BPSDOS=$$DOSDATE^BPSSCRRS(BPS52,BPSRF)
- . ;
- . ;Verify that the patient has valid ePharmacy coverage for the DOS
- . I '$$INSUR^IBBAPI(BPSDFN,BPSDOS,"E",.BPSINS,"1,7,8") D S BPSQLOOP=1 Q
- . . W !!,"Unable to find an ECME billable insurance policy within the"
- . . W !,"date of service for this RX/Fill. The patient insurance policy"
- . . W !,"must have a valid ePharmacy Group Plan associated with it."
- . . W !!,"You must correct this in order to continue.",!
- . . Q
- . ;
- . S BPQLOOP2=0
- . ;select payer sequence
- . F D Q:BPQLOOP2=1
- . . S BPPAYSEQ=$$SELCOB^BPSPRRX5("SELECT PAYER SEQUENCE","Select payer sequence for billing:")
- . . I +BPPAYSEQ=-1 S BPQLOOP2=1,BPSQLOOP=1 Q
- . . I +BPPAYSEQ'=1,(+BPPAYSEQ'=2) Q
- . . ;
- . . W !
- . . ;Make sure claim isn't closed
- . . S BP59=$$IEN59^BPSOSRX(BPS52,BPSRF,BPPAYSEQ)
- . . I $$CLOSED02^BPSSCR03($P($G(^BPST(BP59,0)),U,4)) D Q
- . . . S BPSEQ=$S(BPPAYSEQ=1:"primary",1:"secondary")
- . . . W !!,"A ",BPSEQ," claim exists that is closed and cannot be Resubmitted.",!,"Please reopen the closed ",BPSEQ," claim to resubmit."
- . . . S BPQLOOP2=1 Q
- . . ;
- . . ;create primary claim for entered RX/refill
- . . I BPPAYSEQ=1 S BPSRET=$$PRI4RXRF(BPS52,BPSRF,BPSDOS,BPSDFN) D DISPLMES(BPSRET,1) S:(+BPSRET'<0)!(+BPSRET=-100) BPQLOOP2=1,BPSQLOOP=1 Q
- . . ;
- . . ;create secondary claim for entered RX/refill
- . . ;cannot bill non-released RX
- . . I BPPAYSEQ=2 I $$RELDATE^BPSBCKJ(BPS52,BPSRF)']"" D DISPLMES("-108^RX/refill not released") S BPQLOOP2=1 S:+BPSRET=-100 BPSQLOOP=1 Q
- . . I BPPAYSEQ=2 D Q:BPQLOOP2=1
- . . . ;If this is a secondary, make sure Primary is either Payable or Closed.
- . . . ;Get Primary claim status
- . . . S BPSPCLS=$$FINDECLM^BPSPRRX5(BPS52,BPSRF,1)
- . . . I $P(BPSPCLS,U)>1 D Q:BPQLOOP2=1
- . . . . Q:$$CLOSED02^BPSSCR03($P($G(^BPST($P(BPSPCLS,U,2),0)),U,4))
- . . . . W !,"The secondary claim cannot be Submitted unless the primary is either payable",!,"or closed. Please resubmit or close the primary claim first."
- . . . . S BPQLOOP2=1 Q
- . . . S BPSRET=$$SEC4RXRF(BPS52,BPSRF,BPSDOS,$G(BPSDFN)) D DISPLMES(BPSRET,2) S:(+BPSRET'<0)!(+BPSRET=-100) BPQLOOP2=1,BPSQLOOP=1 Q
- ;
- Q
- ;
- ;create primary claim for entered RX/refill
- PRI4RXRF(BPS52,BPSRF,BPSDOS,BPSDFN) ;
- N BPSECLM,BPNEWCLM,BPSARR,BPSQ,BPRESUBM
- ;check if there is a primary e-claim
- S BPSECLM=$$FINDECLM^BPSPRRX5(BPS52,BPSRF,1)
- I +BPSECLM=3 Q "-102^Claim in progress"
- I +BPSECLM=1 Q "-109^Existing PAYABLE e-claim. Please reverse it before resubmitting."
- S BPNEWCLM=0
- I +BPSECLM=2 D I BPNEWCLM'=1 Q "-100^Action cancelled"
- . D DISPECLM^BPSPRRX5(+$P(BPSECLM,U,2))
- . W !!,"There is an existing rejected/reversed e-claim for the RX/refill."
- . S BPNEWCLM=$$YESNO^BPSSCRRS("Do you want to submit a new primary claim(Y/N)","N")
- ;
- ; if not found or if existing rejected/reversed claim then continue , otherwise - quit
- ;
- S BPSQ=0
- ;check for primary bill
- S BPSZ=$$RXBILL^IBNCPUT3(BPS52,BPSRF,"P","",.BPSARR)
- I +BPSZ>0,+$P(BPSZ,U,2)>0 Q "-107^Existing active primary bill #"_$P($G(BPSARR(+$P(BPSZ,U,2))),U,1)
- I +BPSZ>0,+$P(BPSZ,U,2)=0 D I +BPSQ'=0 Q BPSQ
- . N BPS399,BPSCNT
- . S (BPSCNT,BPS399)=0
- . F S BPS399=$O(BPSARR(BPS399)) Q:+BPS399=0 D
- . . N BPPSEQ,BPSRET
- . . S BPSCNT=BPSCNT+1
- . . S BPSRET=$P(BPSARR(BPS399),U,5)
- . . S BPPSEQ=$S(BPSRET="S":"Secondary",BPSRET="T":"Tertiary",BPSRET="P":"Primary",1:"Unknown")
- . . W:BPSCNT=1 !!,"Non-active primary bill(s) found:"
- . . 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))
- . W !
- . I $$YESNO^BPSSCRRS("DO YOU WISH TO CREATE A NEW PRIMARY BILL ?(Y/N)","N")'=1 S BPSQ="-100^Action cancelled"
- Q $$PRIMARY^BPSPRRX4(BPS52,BPSRF,BPSDFN,BPSDOS,BPSECLM,BPNEWCLM)
- ;
- ;create secondary claim for entered RX/refill
- SEC4RXRF(BPS52,BPSRF,BPSDOS,BPSDFN) ;
- N BPSARR,BPSRET,BPS399
- ;
- ; Try to find the primary bill
- S BPSRET=$$RXBILL^IBNCPUT3(BPS52,BPSRF,"P","",.BPSARR)
- ;
- ; SECNOPRM creates a secondary claim when there is no primary bill
- I +BPSRET=0 Q $$SECNOPRM^BPSPRRX5(BPS52,BPSRF,BPSDOS,$G(BPSDFN),"1,2")
- ;
- ; Get the active claim
- S BPS399=+$P(BPSRET,U,2)
- ;
- ; If no active claim, then get the most recent claim
- I BPS399'>0 S BPS399=+$O(BPSARR(999999999),-1)
- ;
- ; Check if there any secondary bills
- K BPSARR
- S BPSRET=$$RXBILL^IBNCPUT3(BPS52,BPSRF,"S","",.BPSARR)
- I +BPSRET>0,+$P(BPSRET,U,2)>0 Q "-107^Existing active secondary bill #"_$P($G(BPSARR(+$P(BPSRET,U,2))),U,1)
- ;
- ; Submit secondary claim when there is a primary bill
- Q $$SECONDRY(BPS52,BPSRF,BPSDOS,BPS399,"1,2")
- ;
- DISPLMES(BPSZ,BPSPSEQ) ;
- ;Display messages
- ; -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
- ; -107^Existing active bill
- ; -108^RX not released
- ; -109^Existing PAYABLE e-claim. Please reverse it before resubmitting.
- ; -110^No valid group insurance plans
- ;
- I BPSZ'<0 Q
- I +BPSZ=-100 W !!,$P(BPSZ,U,2),! Q
- I +$G(BPSPSEQ)=0 W !!,"Cannot submit e-claim:",!," ",$P(BPSZ,U,2),!
- I $G(BPSPSEQ)=2 D
- . I +BPSZ=-105 W !,"Select another plan - the plan selected has been used for primary billing",!! Q
- . W !,"Cannot submit secondary claim:",!," ",$P(BPSZ,U,2),!
- I $G(BPSPSEQ)=1 D
- . W !,"Cannot submit primary claim:",!," ",$P(BPSZ,U,2),!
- Q
- ;
- SECONDRY(BPSRX,BPSRF,BPSDOS,BPS399,BPDISPPR) ;
- ;Submit a secondary claim if there is a primary bill
- ;Input:
- ; BPSRX - Prescription IEN
- ; BPSRF - Fill Number
- ; BPSDOS - Date of Service
- ; BPS399 - primary bill (ien of file #399)
- ; BPDISPPR - display bill information for
- ; "1" - primary
- ; "2" - secondary
- ; "1,2" - both
- ;
- ;Submission result:
- ; Return value of EN^BPSNCPDP or an error code/text
- ; -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,BPSDFN,BPSRET,BPRATTYP,BPSQ,BPY
- N BPSPLNSL,BPSECOND,BPSWHERE,BPSPLAN,BPSPL59,BPRTTP59,BPSARR,BPYDEF,BPRESUBM
- ;
- ;Default = original submission
- S BPRESUBM=0
- ;
- ;Get primary bill data
- S BPSRET=$$BILINF^IBNCPUT3(BPS399,.BPSBINFO)
- I +BPSRET=-1 Q "-103"_U_$P(BPSRET,U,2)
- ;
- S BPSDFN=+$P(BPSRET,U,2)
- S BPPAYSEQ=$S($P(BPSRET,U)="S":"Secondary",$P(BPSRET,U)="T":"Tertiary",$P(BPSRET,U)="P":"Primary",1:"Unknown")
- S BPSRXCOB=$S($P(BPSRET,U)="S":2,$P(BPSRET,U)="T":3,1:1)
- S BPSINIEN=BPSBINFO("INS IEN")
- ;
- ;Display primary bill data
- I $G(BPDISPPR)[1 D
- . W !,"Primary bill:"
- . D DISPBILL^BPSPRRX2(BPPAYSEQ,BPSBINFO("INS NAME"),BPSBINFO("BILL #"),BPSBINFO("AR STATUS"),BPSRX,BPSRF,"",1)
- . W !
- ;
- ;Check if there is the secondary ePharmacy 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 an existing 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(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"
- ;
- ; If still no ePharmacy secondary ins policy, quit with error
- I '$$SECINSCK(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)
- ;
- ; Set the PRIMARY BILL array element with the bill selected by this procedure
- S BPSECOND("PRIMARY BILL")=BPS399
- ;
- ; 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"
- ;
- ; NEW COB DATA will indicate to BPSNCPDP that it should NOT rebuild the data from the BPS Transaction and
- ; the previous secondary claim
- S BPSECOND("NEW COB DATA")=1
- ;
- D ACTDTY^BPSPRRX7(BPSRX,BPSRF,BPSDFN,BPSDOS)
- ;
- ; Set BWHERE dependent on whether this is an original submission or a resubmit
- 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
- ;
- PROMPTRX() ;
- ; Prompts for RX# and gets confirmation
- ;returns:
- ; 1^RXIEN^RX#^DFN - Successful
- ; 0 - Timeout or Quit by user
- ; -1 = User entered "^"
- N BPRET,BPSRX,BPSDFN,BPSPTNM,BPSRXN,BPSRXST,BPSDRUG,BPSDIC,BPSRXD
- N X,Y,DIQ,DR,DA,DIC,DTOUT,DUOUT
- S BPRET=0,(BPSDIC,DIC)=52,X=""
- S BPSDIC(0)="AENQ"
- W ! D DIC^PSODI(52,.BPSDIC,X) ;DBIA 4858
- I (Y=-1)!$D(DUOUT)!$D(DTOUT) Q +Y
- S (DA,BPSRX)=+Y,BPSRXN=$P(Y,U,2),DIQ="BPSRXD",DIQ(0)="IE",DR=".01;2;6;100"
- D DIQ^PSODI(52,DIC,DR,DA,.DIQ) ;DBIA 4858
- S BPSDFN=BPSRXD(52,DA,2,"I")
- S BPSPTNM=BPSRXD(52,DA,2,"E")
- S BPSDRUG=BPSRXD(52,DA,6,"E")
- S BPSRXST=BPSRXD(52,DA,100,"E")
- W !!,?1,"Patient",?25,"RX#",?37,"Drug Name",?63,"RX Status"
- W !,?1,$E(BPSPTNM,1,23),?25,$E(BPSRXN,1,11),?37,$E(BPSDRUG,1,25),?63,$E(BPSRXST,1,16),!
- Q $S($$YESNO^BPSSCRRS("DO YOU WANT TO CONTINUE?(Y/N)","Y")=1:1,1:0)_U_BPSRX_U_BPSRXN_U_BPSDFN
- ;
- SECINSCK(DFN,DOS) ;
- ; secondary insurance check
- ; check to see if patient has at least one ePharmacy secondary insurance policy
- ; function value = 1 if there is one, 0 otherwise
- ;
- N OK,BPSRET,BPSINS,BPX
- S OK=0
- I '$G(DFN)!'$G(DOS) G SECINX
- S BPSRET=$$INSUR^IBBAPI(DFN,DOS,"E",.BPSINS,"1,7,8")
- I '$D(BPSINS) G SECINX
- S BPX=0 F S BPX=$O(BPSINS("IBBAPI","INSUR",BPX)) Q:'BPX D Q:OK
- . I $P($G(BPSINS("IBBAPI","INSUR",BPX,7)),U,1)=2 S OK=1 Q
- . Q
- SECINX ;
- Q OK
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSPRRX 12361 printed Feb 18, 2025@23:18:43 Page 2
- BPSPRRX ;ALB/SS - ePharmacy secondary billing ;12-DEC-08
- +1 ;;1.0;E CLAIMS MGMT ENGINE;**8,9,11,28**;JUN 2004;Build 22
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ;Entry point for the menu option [BPS COB PROCESS SECONDARY AND TRICARE CLAIMS]
- +5 ;
- EN1 ;
- +1 NEW BPSRXN,BPS399,BPSZ,BPSQLOOP,BPPAYSEQ,BPSRET,BPS52,BPSRF,BPSDOS,BPSDFN
- +2 NEW BPQLOOP2,BPSELIG,BPSPCLS,BP59,BPSEQ,BPSINS
- +3 SET BPSQLOOP=0
- +4 SET BPSRET=""
- +5 FOR
- Begin DoDot:1
- +6 ; Prompt for RX#
- +7 SET BPSZ=$$PROMPTRX()
- +8 IF +BPSZ=0
- QUIT
- +9 IF +BPSZ<0
- SET BPSQLOOP=1
- QUIT
- +10 SET BPSDFN=$PIECE(BPSZ,U,4)
- SET BPSRXN=$PIECE(BPSZ,U,3)
- SET BPS52=$PIECE(BPSZ,U,2)
- +11 ;select refill
- +12 SET BPSZ=$$RXREFIL^BPSPRRX6(BPS52,BPSDFN,BPSRXN)
- +13 IF +BPSZ=-1
- SET BPSQLOOP=1
- QUIT
- +14 SET BPSRF=+BPSZ
- +15 SET BPSDOS=$$DOSDATE^BPSSCRRS(BPS52,BPSRF)
- +16 ;
- +17 ;Verify that the patient has valid ePharmacy coverage for the DOS
- +18 IF '$$INSUR^IBBAPI(BPSDFN,BPSDOS,"E",.BPSINS,"1,7,8")
- Begin DoDot:2
- +19 WRITE !!,"Unable to find an ECME billable insurance policy within the"
- +20 WRITE !,"date of service for this RX/Fill. The patient insurance policy"
- +21 WRITE !,"must have a valid ePharmacy Group Plan associated with it."
- +22 WRITE !!,"You must correct this in order to continue.",!
- +23 QUIT
- End DoDot:2
- SET BPSQLOOP=1
- QUIT
- +24 ;
- +25 SET BPQLOOP2=0
- +26 ;select payer sequence
- +27 FOR
- Begin DoDot:2
- +28 SET BPPAYSEQ=$$SELCOB^BPSPRRX5("SELECT PAYER SEQUENCE","Select payer sequence for billing:")
- +29 IF +BPPAYSEQ=-1
- SET BPQLOOP2=1
- SET BPSQLOOP=1
- QUIT
- +30 IF +BPPAYSEQ'=1
- IF (+BPPAYSEQ'=2)
- QUIT
- +31 ;
- +32 WRITE !
- +33 ;Make sure claim isn't closed
- +34 SET BP59=$$IEN59^BPSOSRX(BPS52,BPSRF,BPPAYSEQ)
- +35 IF $$CLOSED02^BPSSCR03($PIECE($GET(^BPST(BP59,0)),U,4))
- Begin DoDot:3
- +36 SET BPSEQ=$SELECT(BPPAYSEQ=1:"primary",1:"secondary")
- +37 WRITE !!,"A ",BPSEQ," claim exists that is closed and cannot be Resubmitted.",!,"Please reopen the closed ",BPSEQ," claim to resubmit."
- +38 SET BPQLOOP2=1
- QUIT
- End DoDot:3
- QUIT
- +39 ;
- +40 ;create primary claim for entered RX/refill
- +41 IF BPPAYSEQ=1
- SET BPSRET=$$PRI4RXRF(BPS52,BPSRF,BPSDOS,BPSDFN)
- DO DISPLMES(BPSRET,1)
- if (+BPSRET'<0)!(+BPSRET=-100)
- SET BPQLOOP2=1
- SET BPSQLOOP=1
- QUIT
- +42 ;
- +43 ;create secondary claim for entered RX/refill
- +44 ;cannot bill non-released RX
- +45 IF BPPAYSEQ=2
- IF $$RELDATE^BPSBCKJ(BPS52,BPSRF)']""
- DO DISPLMES("-108^RX/refill not released")
- SET BPQLOOP2=1
- if +BPSRET=-100
- SET BPSQLOOP=1
- QUIT
- +46 IF BPPAYSEQ=2
- Begin DoDot:3
- +47 ;If this is a secondary, make sure Primary is either Payable or Closed.
- +48 ;Get Primary claim status
- +49 SET BPSPCLS=$$FINDECLM^BPSPRRX5(BPS52,BPSRF,1)
- +50 IF $PIECE(BPSPCLS,U)>1
- Begin DoDot:4
- +51 if $$CLOSED02^BPSSCR03($PIECE($GET(^BPST($PIECE(BPSPCLS,U,2),0)),U,4))
- QUIT
- +52 WRITE !,"The secondary claim cannot be Submitted unless the primary is either payable",!,"or closed. Please resubmit or close the primary claim first."
- +53 SET BPQLOOP2=1
- QUIT
- End DoDot:4
- if BPQLOOP2=1
- QUIT
- +54 SET BPSRET=$$SEC4RXRF(BPS52,BPSRF,BPSDOS,$GET(BPSDFN))
- DO DISPLMES(BPSRET,2)
- if (+BPSRET'<0)!(+BPSRET=-100)
- SET BPQLOOP2=1
- SET BPSQLOOP=1
- QUIT
- End DoDot:3
- if BPQLOOP2=1
- QUIT
- End DoDot:2
- if BPQLOOP2=1
- QUIT
- End DoDot:1
- if BPSQLOOP=1
- QUIT
- +55 ;
- +56 QUIT
- +57 ;
- +58 ;create primary claim for entered RX/refill
- PRI4RXRF(BPS52,BPSRF,BPSDOS,BPSDFN) ;
- +1 NEW BPSECLM,BPNEWCLM,BPSARR,BPSQ,BPRESUBM
- +2 ;check if there is a primary e-claim
- +3 SET BPSECLM=$$FINDECLM^BPSPRRX5(BPS52,BPSRF,1)
- +4 IF +BPSECLM=3
- QUIT "-102^Claim in progress"
- +5 IF +BPSECLM=1
- QUIT "-109^Existing PAYABLE e-claim. Please reverse it before resubmitting."
- +6 SET BPNEWCLM=0
- +7 IF +BPSECLM=2
- Begin DoDot:1
- +8 DO DISPECLM^BPSPRRX5(+$PIECE(BPSECLM,U,2))
- +9 WRITE !!,"There is an existing rejected/reversed e-claim for the RX/refill."
- +10 SET BPNEWCLM=$$YESNO^BPSSCRRS("Do you want to submit a new primary claim(Y/N)","N")
- End DoDot:1
- IF BPNEWCLM'=1
- QUIT "-100^Action cancelled"
- +11 ;
- +12 ; if not found or if existing rejected/reversed claim then continue , otherwise - quit
- +13 ;
- +14 SET BPSQ=0
- +15 ;check for primary bill
- +16 SET BPSZ=$$RXBILL^IBNCPUT3(BPS52,BPSRF,"P","",.BPSARR)
- +17 IF +BPSZ>0
- IF +$PIECE(BPSZ,U,2)>0
- QUIT "-107^Existing active primary bill #"_$PIECE($GET(BPSARR(+$PIECE(BPSZ,U,2))),U,1)
- +18 IF +BPSZ>0
- IF +$PIECE(BPSZ,U,2)=0
- Begin DoDot:1
- +19 NEW BPS399,BPSCNT
- +20 SET (BPSCNT,BPS399)=0
- +21 FOR
- SET BPS399=$ORDER(BPSARR(BPS399))
- if +BPS399=0
- QUIT
- Begin DoDot:2
- +22 NEW BPPSEQ,BPSRET
- +23 SET BPSCNT=BPSCNT+1
- +24 SET BPSRET=$PIECE(BPSARR(BPS399),U,5)
- +25 SET BPPSEQ=$SELECT(BPSRET="S":"Secondary",BPSRET="T":"Tertiary",BPSRET="P":"Primary",1:"Unknown")
- +26 if BPSCNT=1
- WRITE !!,"Non-active primary bill(s) found:"
- +27 DO DISPBILL^BPSPRRX2(BPPSEQ,$PIECE(BPSARR(BPS399),U,4),$PIECE(BPSARR(BPS399),U,1),$PIECE(BPSARR(BPS399),U,2),BPS52,BPSRF,$PIECE(BPSARR(BPS399),U,3),(BPSCNT=1))
- End DoDot:2
- +28 WRITE !
- +29 IF $$YESNO^BPSSCRRS("DO YOU WISH TO CREATE A NEW PRIMARY BILL ?(Y/N)","N")'=1
- SET BPSQ="-100^Action cancelled"
- End DoDot:1
- IF +BPSQ'=0
- QUIT BPSQ
- +30 QUIT $$PRIMARY^BPSPRRX4(BPS52,BPSRF,BPSDFN,BPSDOS,BPSECLM,BPNEWCLM)
- +31 ;
- +32 ;create secondary claim for entered RX/refill
- SEC4RXRF(BPS52,BPSRF,BPSDOS,BPSDFN) ;
- +1 NEW BPSARR,BPSRET,BPS399
- +2 ;
- +3 ; Try to find the primary bill
- +4 SET BPSRET=$$RXBILL^IBNCPUT3(BPS52,BPSRF,"P","",.BPSARR)
- +5 ;
- +6 ; SECNOPRM creates a secondary claim when there is no primary bill
- +7 IF +BPSRET=0
- QUIT $$SECNOPRM^BPSPRRX5(BPS52,BPSRF,BPSDOS,$GET(BPSDFN),"1,2")
- +8 ;
- +9 ; Get the active claim
- +10 SET BPS399=+$PIECE(BPSRET,U,2)
- +11 ;
- +12 ; If no active claim, then get the most recent claim
- +13 IF BPS399'>0
- SET BPS399=+$ORDER(BPSARR(999999999),-1)
- +14 ;
- +15 ; Check if there any secondary bills
- +16 KILL BPSARR
- +17 SET BPSRET=$$RXBILL^IBNCPUT3(BPS52,BPSRF,"S","",.BPSARR)
- +18 IF +BPSRET>0
- IF +$PIECE(BPSRET,U,2)>0
- QUIT "-107^Existing active secondary bill #"_$PIECE($GET(BPSARR(+$PIECE(BPSRET,U,2))),U,1)
- +19 ;
- +20 ; Submit secondary claim when there is a primary bill
- +21 QUIT $$SECONDRY(BPS52,BPSRF,BPSDOS,BPS399,"1,2")
- +22 ;
- DISPLMES(BPSZ,BPSPSEQ) ;
- +1 ;Display messages
- +2 ; -100^Action cancelled
- +3 ; -101^Existing e-claim
- +4 ; -102^Claim in progress
- +5 ; -103^Invalid or wrong bill#
- +6 ; -104^Existing rejected/reversed e-claim
- +7 ; -105^The same group plan selected
- +8 ; -107^Existing active bill
- +9 ; -108^RX not released
- +10 ; -109^Existing PAYABLE e-claim. Please reverse it before resubmitting.
- +11 ; -110^No valid group insurance plans
- +12 ;
- +13 IF BPSZ'<0
- QUIT
- +14 IF +BPSZ=-100
- WRITE !!,$PIECE(BPSZ,U,2),!
- QUIT
- +15 IF +$GET(BPSPSEQ)=0
- WRITE !!,"Cannot submit e-claim:",!," ",$PIECE(BPSZ,U,2),!
- +16 IF $GET(BPSPSEQ)=2
- Begin DoDot:1
- +17 IF +BPSZ=-105
- WRITE !,"Select another plan - the plan selected has been used for primary billing",!!
- QUIT
- +18 WRITE !,"Cannot submit secondary claim:",!," ",$PIECE(BPSZ,U,2),!
- End DoDot:1
- +19 IF $GET(BPSPSEQ)=1
- Begin DoDot:1
- +20 WRITE !,"Cannot submit primary claim:",!," ",$PIECE(BPSZ,U,2),!
- End DoDot:1
- +21 QUIT
- +22 ;
- SECONDRY(BPSRX,BPSRF,BPSDOS,BPS399,BPDISPPR) ;
- +1 ;Submit a secondary claim if there is a primary bill
- +2 ;Input:
- +3 ; BPSRX - Prescription IEN
- +4 ; BPSRF - Fill Number
- +5 ; BPSDOS - Date of Service
- +6 ; BPS399 - primary bill (ien of file #399)
- +7 ; BPDISPPR - display bill information for
- +8 ; "1" - primary
- +9 ; "2" - secondary
- +10 ; "1,2" - both
- +11 ;
- +12 ;Submission result:
- +13 ; Return value of EN^BPSNCPDP or an error code/text
- +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,BPSDFN,BPSRET,BPRATTYP,BPSQ,BPY
- +24 NEW BPSPLNSL,BPSECOND,BPSWHERE,BPSPLAN,BPSPL59,BPRTTP59,BPSARR,BPYDEF,BPRESUBM
- +25 ;
- +26 ;Default = original submission
- +27 SET BPRESUBM=0
- +28 ;
- +29 ;Get primary bill data
- +30 SET BPSRET=$$BILINF^IBNCPUT3(BPS399,.BPSBINFO)
- +31 IF +BPSRET=-1
- QUIT "-103"_U_$PIECE(BPSRET,U,2)
- +32 ;
- +33 SET BPSDFN=+$PIECE(BPSRET,U,2)
- +34 SET BPPAYSEQ=$SELECT($PIECE(BPSRET,U)="S":"Secondary",$PIECE(BPSRET,U)="T":"Tertiary",$PIECE(BPSRET,U)="P":"Primary",1:"Unknown")
- +35 SET BPSRXCOB=$SELECT($PIECE(BPSRET,U)="S":2,$PIECE(BPSRET,U)="T":3,1:1)
- +36 SET BPSINIEN=BPSBINFO("INS IEN")
- +37 ;
- +38 ;Display primary bill data
- +39 IF $GET(BPDISPPR)[1
- Begin DoDot:1
- +40 WRITE !,"Primary bill:"
- +41 DO DISPBILL^BPSPRRX2(BPPAYSEQ,BPSBINFO("INS NAME"),BPSBINFO("BILL #"),BPSBINFO("AR STATUS"),BPSRX,BPSRF,"",1)
- +42 WRITE !
- End DoDot:1
- +43 ;
- +44 ;Check if there is the secondary ePharmacy claim
- +45 SET BPSECLM=$$FINDECLM^BPSPRRX5(BPSRX,BPSRF,2)
- +46 IF +BPSECLM=3
- QUIT "-102^Claim in progress"
- +47 IF +BPSECLM=1
- QUIT "-109^Existing PAYABLE e-claim. Please reverse it before resubmitting."
- +48 SET BPSQ=0
- +49 IF +BPSECLM=2
- Begin DoDot:1
- +50 DO DISPECLM^BPSPRRX5(+$PIECE(BPSECLM,U,2))
- +51 WRITE !!,"There is an existing rejected/reversed secondary e-claim(s) for the RX/refill."
- +52 IF $$YESNO^BPSSCRRS("Do you want to submit a new secondary claim(Y/N)","N")=1
- SET BPRESUBM=1
- +53 IF BPRESUBM'=1
- SET BPSQ=1
- End DoDot:1
- if BPSQ=1
- QUIT "-100^Action cancelled"
- +54 ;
- +55 ; Check for an existing secondary bill(s)
- +56 Begin DoDot:1
- +57 NEW BPSARR,BPS399,BPSCNT
- +58 ;check for the existing secondary bill
- +59 SET BP2NDBIL=$$RXBILL^IBNCPUT3(BPSRX,BPSRF,"S","",.BPSARR)
- +60 ;not found
- IF +BP2NDBIL=0
- QUIT
- +61 SET BPS399=0
- +62 SET BPSCNT=0
- +63 FOR
- SET BPS399=$ORDER(BPSARR(BPS399))
- if +BPS399=0
- QUIT
- Begin DoDot:2
- +64 NEW BPPSEQ
- +65 SET BPSCNT=BPSCNT+1
- +66 IF $GET(BPDISPPR)[2
- Begin DoDot:3
- +67 if BPSCNT=1
- WRITE !!,"Secondary bill(s) found:"
- +68 SET BPSRET=$PIECE(BPSARR(BPS399),U,5)
- +69 SET BPPSEQ=$SELECT($PIECE(BPSRET,U)="S":"Secondary",$PIECE(BPSRET,U)="T":"Tertiary",$PIECE(BPSRET,U)="P":"Primary",1:"Unknown")
- +70 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
- +71 WRITE !
- End DoDot:1
- if +$PIECE(BP2NDBIL,U,2)>0
- QUIT "-107^Existing active secondary bill"
- +72 ;
- +73 ; Check for ePharmacy secondary ins policy
- +74 SET BPYDEF="N"
- +75 IF '$$SECINSCK(BPSDFN,BPSDOS)
- Begin DoDot:1
- +76 SET BPYDEF="Y"
- +77 WRITE !!,"Unable to find a secondary insurance policy which is e-Pharmacy billable."
- +78 WRITE !,"You must correct this in order to continue.",!
- +79 QUIT
- End DoDot:1
- +80 ;
- +81 ; Ask the user if he wants to jump to the BCN PATIENT INSURANCE option
- +82 SET BPY=$$YESNO^BPSSCRRS("DO YOU WISH TO ADD/EDIT INSURANCE COMPANY DATA FOR THIS PATIENT?(Y/N)",BPYDEF)
- +83 IF BPY=1
- DO EN1^IBNCPDPI(BPSDFN)
- +84 IF BPY=-1
- QUIT "-100^Action cancelled"
- +85 ;
- +86 ; If still no ePharmacy secondary ins policy, quit with error
- +87 IF '$$SECINSCK(BPSDFN,BPSDOS)
- QUIT "-115^No Secondary e-Pharmacy Insurance Policy."
- +88 ;
- +89 ; Get data from the primary claim, if it exists
- +90 SET BPSRET=$$PRIMDATA^BPSPRRX6(BPSRX,BPSRF,.BPSECOND)
- +91 ;
- +92 ; If the primary claim data is missing and this is a resubmit, get data from the most recent
- +93 ; secondary claim
- +94 IF 'BPSRET
- IF BPRESUBM=1
- IF $$SECDATA^BPSPRRX6(BPSRX,BPSRF,.BPSPL59,.BPSECOND,.BPRTTP59)
- +95 ;
- +96 ; Set the PRIMARY BILL array element with the bill selected by this procedure
- +97 SET BPSECOND("PRIMARY BILL")=BPS399
- +98 ;
- +99 ; Display the data and allow the user to edit
- +100 IF $$PROMPTS^BPSPRRX3(BPSRX,BPSRF,BPSDOS,.BPSECOND)=-1
- QUIT "-100^Action cancelled"
- +101 ;
- +102 ; Continue?
- +103 WRITE !
- +104 IF $$YESNO^BPSSCRRS("SUBMIT CLAIM TO "_$GET(BPSECOND("INS NAME"))_" ?(Y/N)","Y")'=1
- QUIT "-100^Action cancelled"
- +105 ;
- +106 ; NEW COB DATA will indicate to BPSNCPDP that it should NOT rebuild the data from the BPS Transaction and
- +107 ; the previous secondary claim
- +108 SET BPSECOND("NEW COB DATA")=1
- +109 ;
- +110 DO ACTDTY^BPSPRRX7(BPSRX,BPSRF,BPSDFN,BPSDOS)
- +111 ;
- +112 ; Set BWHERE dependent on whether this is an original submission or a resubmit
- +113 IF BPRESUBM=0
- SET BPSWHERE="P2"
- +114 IF BPRESUBM=1
- SET BPSWHERE="P2S"
- +115 ;
- +116 ; Submit the claim
- +117 SET BPSRET=$$SUBMCLM^BPSPRRX2(BPSRX,BPSRF,BPSDOS,BPSWHERE,2,BPSECOND("PLAN"),.BPSECOND,BPSECOND("RTYPE"))
- +118 IF +BPSRET=4
- WRITE !!,$PIECE(BPSRET,U,2),!
- +119 QUIT BPSRET
- +120 ;
- PROMPTRX() ;
- +1 ; Prompts for RX# and gets confirmation
- +2 ;returns:
- +3 ; 1^RXIEN^RX#^DFN - Successful
- +4 ; 0 - Timeout or Quit by user
- +5 ; -1 = User entered "^"
- +6 NEW BPRET,BPSRX,BPSDFN,BPSPTNM,BPSRXN,BPSRXST,BPSDRUG,BPSDIC,BPSRXD
- +7 NEW X,Y,DIQ,DR,DA,DIC,DTOUT,DUOUT
- +8 SET BPRET=0
- SET (BPSDIC,DIC)=52
- SET X=""
- +9 SET BPSDIC(0)="AENQ"
- +10 ;DBIA 4858
- WRITE !
- DO DIC^PSODI(52,.BPSDIC,X)
- +11 IF (Y=-1)!$DATA(DUOUT)!$DATA(DTOUT)
- QUIT +Y
- +12 SET (DA,BPSRX)=+Y
- SET BPSRXN=$PIECE(Y,U,2)
- SET DIQ="BPSRXD"
- SET DIQ(0)="IE"
- SET DR=".01;2;6;100"
- +13 ;DBIA 4858
- DO DIQ^PSODI(52,DIC,DR,DA,.DIQ)
- +14 SET BPSDFN=BPSRXD(52,DA,2,"I")
- +15 SET BPSPTNM=BPSRXD(52,DA,2,"E")
- +16 SET BPSDRUG=BPSRXD(52,DA,6,"E")
- +17 SET BPSRXST=BPSRXD(52,DA,100,"E")
- +18 WRITE !!,?1,"Patient",?25,"RX#",?37,"Drug Name",?63,"RX Status"
- +19 WRITE !,?1,$EXTRACT(BPSPTNM,1,23),?25,$EXTRACT(BPSRXN,1,11),?37,$EXTRACT(BPSDRUG,1,25),?63,$EXTRACT(BPSRXST,1,16),!
- +20 QUIT $SELECT($$YESNO^BPSSCRRS("DO YOU WANT TO CONTINUE?(Y/N)","Y")=1:1,1:0)_U_BPSRX_U_BPSRXN_U_BPSDFN
- +21 ;
- SECINSCK(DFN,DOS) ;
- +1 ; secondary insurance check
- +2 ; check to see if patient has at least one ePharmacy secondary insurance policy
- +3 ; function value = 1 if there is one, 0 otherwise
- +4 ;
- +5 NEW OK,BPSRET,BPSINS,BPX
- +6 SET OK=0
- +7 IF '$GET(DFN)!'$GET(DOS)
- GOTO SECINX
- +8 SET BPSRET=$$INSUR^IBBAPI(DFN,DOS,"E",.BPSINS,"1,7,8")
- +9 IF '$DATA(BPSINS)
- GOTO SECINX
- +10 SET BPX=0
- FOR
- SET BPX=$ORDER(BPSINS("IBBAPI","INSUR",BPX))
- if 'BPX
- QUIT
- Begin DoDot:1
- +11 IF $PIECE($GET(BPSINS("IBBAPI","INSUR",BPX,7)),U,1)=2
- SET OK=1
- QUIT
- +12 QUIT
- End DoDot:1
- if OK
- QUIT
- SECINX ;
- +1 QUIT OK
- +2 ;