BPSOSRX3 ;ALB/SS - ECME REQUESTS ;02-JAN-08
;;1.0;E CLAIMS MGMT ENGINE;**7,8,10,11,23,24**;JUN 2004;Build 43
;;Per VA Directive 6402, this routine should not be modified.
;
;Input
;BPREQTYP - request type:
; "C" - Submit a claim to ECME
; If the claim has already been processed, and it's resubmitted, then a reversal will be
; done first, and then the resubmit. Intervening call to $$STATUS may show progress
; of the reversal before the resubmitted claim is processed.
; "U"- Reverse submitted claim.
; The reversal will actually be done ONLY if the most recent processing of the claim
; resulted in something reversible, namely E PAYABLE or E REVERSAL REJECTED
; "E" - Eligibility Verification Request
;KEY1 - First Key for the BPS Request file
;KEY2 - Second Key for the BPS Request file
;MOREDATA - Array of data for transaction/claim
;BPCOBIND - payer sequence
;BILLNDC - NDC passed into EN^BPSNCPDP sent in BILLNDC variable or determined by EN^BPSNCPDP if it was null
;at the very first time when EN^BPSNCPDP was called in "F" (foreground) mode
;BPSKIP(optional)=1 : skip the field, used when CLAIM request is created while the previous
;request is in progress. That means - billing determination will be done upon activation)
;Return values:
; 1^BPS REQUEST ien = accepted for processing
; 0^reason = failure (should never happen)
MKRQST(BPREQTYP,KEY1,KEY2,MOREDATA,BPIENS78,BPCOBIND,BILLNDC,BPSKIP) ;
N BPIEN77,BPCOB,BPQ,BPIEN772,BPERRMSG,BPIEN59,BPIEN78,BPZ
N RETVAL,STAT,TYPE,RESULT,SUBMITDT,BPNOW,BPACTTYP,BP77LCK
N DUR,BPIEN771,BPCNT,BPSDUPL
S BPSKIP=+$G(BPSKIP)
I $G(BPREQTYP)="" Q "0^Parameter error-Request Type"
I '$G(KEY1) Q "0^Parameter error-Key1"
I BPREQTYP="E",$G(KEY2)'>9000 Q "0^Parameter error-Key2 for eligibility"
I '$G(BPCOBIND)="" Q "0^Parameter error-COB Indicator"
I '$G(KEY2) S KEY2=0
S BPIEN59=+$$IEN59^BPSOSRX(KEY1,KEY2,BPCOBIND)
;
;new record
S BPERRMSG="Cannot create record in BPS REQUEST"
S BPIEN77=$$INSITEM^BPSUTIL2(9002313.77,"",KEY1,"","","^BPS(9002313.77)",10)
I BPIEN77<1 Q "0^"_BPERRMSG
S BPNOW=$$NOW^BPSOSRX()
S BPACTTYP=$G(MOREDATA("RX ACTION"))
; fill out the fields
S BPERRMSG="Missing data for the "
I $$FILLFLDS^BPSUTIL2(9002313.77,".02",BPIEN77,KEY2)<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,.02)
I $$FILLFLDS^BPSUTIL2(9002313.77,".03",BPIEN77,BPCOBIND)<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,.03)
;set delay with the testing tool
S BPZ=+$$SETDELAY^BPSTEST(BPIEN59) I BPZ>0 I $$FILLFLDS^BPSUTIL2(9002313.77,".08",BPIEN77,BPZ)<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,.08)
;set the process flag to "WAITING"
I $$FILLFLDS^BPSUTIL2(9002313.77,".04",BPIEN77,0)<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,.04)
I $$FILLFLDS^BPSUTIL2(9002313.77,"6.01",BPIEN77,BPNOW)<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,6.01)
I $$FILLFLDS^BPSUTIL2(9002313.77,"6.05",BPIEN77,BPNOW)<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,6.05)
I $$ACTFIELD(BPSKIP,BPREQTYP,"6.02") I $$FILLFLDS^BPSUTIL2(9002313.77,"6.02",BPIEN77,+$G(MOREDATA("USER")))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,6.02)
I $$FILLFLDS^BPSUTIL2(9002313.77,"6.06",BPIEN77,+DUZ)<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,6.06)
I $$ACTFIELD(BPSKIP,BPREQTYP,"1.01") I $$FILLFLDS^BPSUTIL2(9002313.77,"1.01",BPIEN77,$G(MOREDATA("RX ACTION")))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.01)
I $G(MOREDATA("DIVISION")),$$FILLFLDS^BPSUTIL2(9002313.77,"1.02",BPIEN77,MOREDATA("DIVISION"))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.02)
I $$FILLFLDS^BPSUTIL2(9002313.77,"1.04",BPIEN77,BPREQTYP)<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.04)
;if this is a queued "C" request then the billing will be done again upon activation so MOREDATA(BILL) is undefined
;that is why we are not checking this field
I $$ACTFIELD(BPSKIP,BPREQTYP,"1.05") I $$FILLFLDS^BPSUTIL2(9002313.77,"1.05",BPIEN77,$P($G(MOREDATA("BILL")),U))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.05)
I '$D(MOREDATA("ELIG")) I $$ACTFIELD(BPSKIP,BPREQTYP,"1.06") I $$FILLFLDS^BPSUTIL2(9002313.77,"1.06",BPIEN77,$P($G(MOREDATA("BILL")),U,3))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.06)
I $D(MOREDATA("ELIG")) I $$ACTFIELD(BPSKIP,BPREQTYP,"1.06") I $$FILLFLDS^BPSUTIL2(9002313.77,"1.06",BPIEN77,$G(MOREDATA("ELIG")))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.06)
I $P($G(MOREDATA("BILL")),U,2)'="" I $$ACTFIELD(BPSKIP,BPREQTYP,"1.07") I $$FILLFLDS^BPSUTIL2(9002313.77,"1.07",BPIEN77,$P($G(MOREDATA("BILL")),U,2))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.07)
I $$ACTFIELD(BPSKIP,BPREQTYP,"1.13") I $$FILLFLDS^BPSUTIL2(9002313.77,"1.13",BPIEN77,$G(MOREDATA("RX")))<1,BPREQTYP'="E" Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.13)
I $$ACTFIELD(BPSKIP,BPREQTYP,"1.14") I $$FILLFLDS^BPSUTIL2(9002313.77,"1.14",BPIEN77,$P($G(MOREDATA("BPSDATA",1)),U,4))<1,BPREQTYP'="E" Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.14)
I $$ACTFIELD(BPSKIP,BPREQTYP,"1.15") I $$FILLFLDS^BPSUTIL2(9002313.77,"1.15",BPIEN77,$G(MOREDATA("PATIENT")))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.15)
I $$ACTFIELD(BPSKIP,BPREQTYP,"1.16"),$$FILLFLDS^BPSUTIL2(9002313.77,"1.16",BPIEN77,$P($G(MOREDATA("IBDATA",1,3)),U,7))<1,BPREQTYP="E" Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.16)
I $$ACTFIELD(BPSKIP,BPREQTYP,"2.01") I $$FILLFLDS^BPSUTIL2(9002313.77,"2.01",BPIEN77,+$G(MOREDATA("DATE OF SERVICE")))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,2.01)
I $$ACTFIELD(BPSKIP,BPREQTYP,"2.02") I $$FILLFLDS^BPSUTIL2(9002313.77,"2.02",BPIEN77,$G(MOREDATA("REVERSAL REASON")))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,2.02)
I $L($G(MOREDATA("BPOVRIEN")))>0 I $$FILLFLDS^BPSUTIL2(9002313.77,"2.04",BPIEN77,$G(MOREDATA("BPOVRIEN")))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,2.04)
I $L($G(MOREDATA("BPSCLARF")))>0 I $$FILLFLDS^BPSUTIL2(9002313.77,"2.05",BPIEN77,$G(MOREDATA("BPSCLARF")))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,2.05)
I $L($G(BILLNDC))>0 I $$FILLFLDS^BPSUTIL2(9002313.77,"2.06",BPIEN77,BILLNDC)<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,2.06)
I $L($P($G(MOREDATA("BPSAUTH")),U))>0 I $$FILLFLDS^BPSUTIL2(9002313.77,"2.07",BPIEN77,$E($P(MOREDATA("BPSAUTH"),U,1),1,2))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,2.07)
I $L($P($G(MOREDATA("BPSAUTH")),U,2))>0 I $$FILLFLDS^BPSUTIL2(9002313.77,"2.08",BPIEN77,$E($P(MOREDATA("BPSAUTH"),U,2),1,11))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,2.08)
I $L($G(MOREDATA("BPSDELAY")))>0,$$FILLFLDS^BPSUTIL2(9002313.77,"2.1",BPIEN77,MOREDATA("BPSDELAY"))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,2.1)
I $$ACTFIELD(BPSKIP,BPREQTYP,"4.01") I $$FILLFLDS^BPSUTIL2(9002313.77,"4.01",BPIEN77,$P($G(MOREDATA("BPSDATA",1)),U,1))
I $$ACTFIELD(BPSKIP,BPREQTYP,"4.02") I $$FILLFLDS^BPSUTIL2(9002313.77,"4.02",BPIEN77,$P($G(MOREDATA("BPSDATA",1)),U,2))
I $$ACTFIELD(BPSKIP,BPREQTYP,"4.03") I $$FILLFLDS^BPSUTIL2(9002313.77,"4.03",BPIEN77,$P($G(MOREDATA("BPSDATA",1)),U,3))
I $$ACTFIELD(BPSKIP,BPREQTYP,"4.04"),$$FILLFLDS^BPSUTIL2(9002313.77,"4.04",BPIEN77,$P($G(MOREDATA("BPSDATA",1)),U,4))
I $P($G(MOREDATA("BPSDATA",1)),U,5)'="" I $$ACTFIELD(BPSKIP,BPREQTYP,"4.05") I $$FILLFLDS^BPSUTIL2(9002313.77,"4.05",BPIEN77,$P($G(MOREDATA("BPSDATA",1)),U,5))
I $P($G(MOREDATA("BPSDATA",1)),U,6)'="" I $$ACTFIELD(BPSKIP,BPREQTYP,"4.06") I $$FILLFLDS^BPSUTIL2(9002313.77,"4.06",BPIEN77,$P($G(MOREDATA("BPSDATA",1)),U,6))
I $$ACTFIELD(BPSKIP,BPREQTYP,"4.07") I $$FILLFLDS^BPSUTIL2(9002313.77,"4.07",BPIEN77,$P($G(MOREDATA("BPSDATA",1)),U,7))
I $$ACTFIELD(BPSKIP,BPREQTYP,"4.08") I $$FILLFLDS^BPSUTIL2(9002313.77,"4.08",BPIEN77,$P($G(MOREDATA("BPSDATA",1)),U,8))
I $$ACTFIELD(BPSKIP,BPREQTYP,"4.09") I $$FILLFLDS^BPSUTIL2(9002313.77,"4.09",BPIEN77,$P($G(MOREDATA("BPSDATA",1)),U,9))
I $G(MOREDATA("CLOSE AFT REV"))=1 I $$FILLFLDS^BPSUTIL2(9002313.77,"7.01",BPIEN77,1)<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,7.01)
I $G(MOREDATA("CLOSE AFT REV REASON"))>0 I $$FILLFLDS^BPSUTIL2(9002313.77,"7.02",BPIEN77,+$G(MOREDATA("CLOSE AFT REV REASON")))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,7.02)
I $L($G(MOREDATA("CLOSE AFT REV COMMENT")))>0 I $$FILLFLDS^BPSUTIL2(9002313.77,"7.03",BPIEN77,$G(MOREDATA("CLOSE AFT REV COMMENT")))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,7.03)
I $G(BPSARRY("SC/EI OVR"))=1 I $$FILLFLDS^BPSUTIL2(9002313.77,"2.09",BPIEN77,1)<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,2.09)
;
; secondary billing and primary Tricare billing related fields
I $G(MOREDATA("RTYPE"))'="" I $$FILLFLDS^BPSUTIL2(9002313.77,"1.08",BPIEN77,MOREDATA("RTYPE"))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.08)
I $G(MOREDATA("PRIMARY BILL"))'="" I $$FILLFLDS^BPSUTIL2(9002313.77,"1.09",BPIEN77,MOREDATA("PRIMARY BILL"))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.09)
I $G(MOREDATA("PRIOR PAYMENT"))'="" I $$FILLFLDS^BPSUTIL2(9002313.77,"1.1",BPIEN77,MOREDATA("PRIOR PAYMENT"))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.1)
I $G(MOREDATA("337-4C"))'="" I $$FILLFLDS^BPSUTIL2(9002313.77,1.11,BPIEN77,MOREDATA("337-4C"))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.11) ; cob other payments count
I $G(MOREDATA("308-C8"))'="" I $$FILLFLDS^BPSUTIL2(9002313.77,1.12,BPIEN77,MOREDATA("308-C8"))<1 Q "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.12) ; other coverage code
;
; store secondary billing related data entered by the user - esg 6/8/10
S BPQ=0,BPERRMSG=""
I BPCOBIND=2 D
. N AMTIEN,BPIEN1,BPIEN2,BPIEN778,BPZ,BPZ1,BPZ2,OPAMT,OPAPQ,OPAYD,OPPRA,OPREJ,PIEN,REJIEN
. S PIEN=0 F S PIEN=$O(MOREDATA("OTHER PAYER",PIEN)) Q:'PIEN!BPQ D
.. S OPAYD=$G(MOREDATA("OTHER PAYER",PIEN,0)) Q:OPAYD=""
.. ;
.. ; count up the number of multiples we have in each set
.. S BPZ=0 F BPZ1=0:1 S BPZ=$O(MOREDATA("OTHER PAYER",PIEN,"P",BPZ)) Q:'BPZ
.. S BPZ=0 F BPZ2=0:1 S BPZ=$O(MOREDATA("OTHER PAYER",PIEN,"R",BPZ)) Q:'BPZ
.. I BPZ1,BPZ2 S BPQ=1,BPERRMSG="Can't have both payments and rejects for the same OTHER PAYER" Q
.. ;
.. ; add a new entry to subfile 9002313.778
.. S BPIEN778=$$INSITEM^BPSUTIL2(9002313.778,BPIEN77,PIEN,PIEN,"",,0)
.. I BPIEN778<1 S BPERRMSG="Can't create entry in COB OTHER PAYERS multiple of the BPS REQUESTS file",BPQ=1 Q
.. S BPERRMSG="Can't populate field in COB OTHER PAYERS multiple" ; just in case BPQ is set below
.. ;
.. ; set the rest of the pieces at this level
.. I $P(OPAYD,U,2)'="" I $$FILLFLDS^BPSUTIL2(9002313.778,.02,PIEN_","_BPIEN77,$P(OPAYD,U,2))<1 S BPQ=1 Q
.. I $P(OPAYD,U,3)'="" I $$FILLFLDS^BPSUTIL2(9002313.778,.03,PIEN_","_BPIEN77,$P(OPAYD,U,3))<1 S BPQ=1 Q
.. I $P(OPAYD,U,4)'="" I $$FILLFLDS^BPSUTIL2(9002313.778,.04,PIEN_","_BPIEN77,$P(OPAYD,U,4))<1 S BPQ=1 Q
.. I $P(OPAYD,U,5)'="" I $$FILLFLDS^BPSUTIL2(9002313.778,.05,PIEN_","_BPIEN77,$P(OPAYD,U,5))<1 S BPQ=1 Q
.. I $$FILLFLDS^BPSUTIL2(9002313.778,.06,PIEN_","_BPIEN77,BPZ1)<1 S BPQ=1 Q
.. I $$FILLFLDS^BPSUTIL2(9002313.778,.07,PIEN_","_BPIEN77,BPZ2)<1 S BPQ=1 Q
.. I $P(OPAYD,U,11)'="" I $$FILLFLDS^BPSUTIL2(9002313.778,.11,PIEN_","_BPIEN77,$P(OPAYD,U,11))<1 S BPQ=1 Q
.. S BPERRMSG=""
.. ;
.. ; now loop thru the other payer payment array
.. S AMTIEN=0 F S AMTIEN=$O(MOREDATA("OTHER PAYER",PIEN,"P",AMTIEN)) Q:'AMTIEN!BPQ D
... S OPAMT=$G(MOREDATA("OTHER PAYER",PIEN,"P",AMTIEN,0))
... S OPAPQ=$P(OPAMT,U,2) ; 342-HC other payer amt paid qualifier (ncpdp 5.1 blank is OK)
... S OPPRA=$P(OPAMT,U,3) ; 352-NQ, Other Payer-Patient Responsibility Amount
... S OPAMT=+OPAMT ; 431-DV other payer amt paid
... ;
... ; add a new entry to subfile 9002313.7781
... S BPIEN1=$$INSITEM^BPSUTIL2(9002313.7781,PIEN_","_BPIEN77,OPAMT,AMTIEN,"",,0)
... I BPIEN1<1 S BPERRMSG="Can't create entry in 9002313.7781 subfile",BPQ=1 Q
... ;
... ; set piece 2
... I OPAPQ'="" I $$FILLFLDS^BPSUTIL2(9002313.7781,.02,AMTIEN_","_PIEN_","_BPIEN77,OPAPQ)<1 D
.... S BPQ=1,BPERRMSG="Can't populate .02 field in 9002313.7781 subfile"
.... Q
... ;
... ; set piece 3
... I OPPRA'="" I $$FILLFLDS^BPSUTIL2(9002313.7781,.03,AMTIEN_","_PIEN_","_BPIEN77,OPPRA)<1 D
.... S BPQ=1,BPERRMSG="Can't populate .03 field in 9002313.7781 subfile"
.... Q
... ;
... Q
.. ;
.. ; now loop thru the other payer reject array
.. S REJIEN=0 F S REJIEN=$O(MOREDATA("OTHER PAYER",PIEN,"R",REJIEN)) Q:'REJIEN!BPQ D
... S OPREJ=$G(MOREDATA("OTHER PAYER",PIEN,"R",REJIEN,0)) Q:OPREJ="" Q:$P(OPREJ,U,1)=""
... ;
... ; add a new entry to subfile 9002313.7782
... S BPIEN2=$$INSITEM^BPSUTIL2(9002313.7782,PIEN_","_BPIEN77,$P(OPREJ,U,1),REJIEN,"",,0)
... I BPIEN2<1 S BPERRMSG="Can't create entry in 9002313.7782 subfile",BPQ=1 Q
... Q
.. Q
. Q
I BPQ Q "0^"_BPERRMSG_" (COB DATA)"
;
;store DURREC info
S BPQ=0
S DUR=0
F S DUR=$O(MOREDATA("DUR",DUR)) Q:+DUR=0!(BPQ=1) D
. S BPIEN771=$$INSITEM^BPSUTIL2(9002313.771,BPIEN77,$P(MOREDATA("DUR",DUR,0),U),DUR,"",,0)
. I BPIEN771<1 S BPERRMSG="Cannot create DUR record in DUR multiple of the BPS REQUEST file",BPQ=1 Q
. S BPERRMSG="Cannot populate a field in DUR multiple"
. I $$FILLFLDS^BPSUTIL2(9002313.771,".02",DUR_","_BPIEN77,$P(MOREDATA("DUR",DUR,0),U,2))<1 S BPQ=1 Q
. I $$FILLFLDS^BPSUTIL2(9002313.771,".03",DUR_","_BPIEN77,$P(MOREDATA("DUR",DUR,0),U,3))<1 S BPQ=1 Q
I BPQ=1 Q "0^"_BPERRMSG_" DUR DATA"
;
;store ins to IB INSURER DATA
S BPQ=0
S BPCOB=0 F S BPCOB=$O(BPIENS78(BPCOB)) Q:+BPCOB=0!(BPQ=1) D
. S BPIEN772=$$INSITEM^BPSUTIL2(9002313.772,BPIEN77,BPCOB,BPCOB,"",,0)
. I BPIEN772<1 S BPERRMSG="Cannot create record in IBDATA multiple of the BPS REQUEST file",BPQ=1 Q
. S BPERRMSG="Cannot populate a field in IBDATA multiple"
. I $$FILLFLDS^BPSUTIL2(9002313.772,".02",BPCOB_","_BPIEN77,$S(BPCOBIND=BPCOB:1,1:0))<1 S BPQ=1 Q
. I $$FILLFLDS^BPSUTIL2(9002313.772,".03",BPCOB_","_BPIEN77,BPIENS78(BPCOB))<1 S BPQ=1 Q
I BPQ=1 Q "0^"_BPERRMSG_"INSURER DATA"
;
;return 1 (success) and IEN of the 9002313.77 entry
Q "1^"_BPIEN77
;
;check if the field is used in MOREDATA for the specified REQUEST TYPE - CLAIM="C" /UNCLAIM="U"
ACTFIELD(BPSKIP,BPREQTYP,BPFLD) ;
;For Reversal or Skip, only do RX Action, Date of Service, Reversal Reason, and User who made the Request
I (BPREQTYP="U")!(BPSKIP=1) Q ";1.01;2.01;2.02;6.02;"[(";"_BPFLD_";")
;For Eligibility Verification, skip Eligibility
I BPREQTYP="E",";1.06;"[(";"_BPFLD_";") Q 0
Q 1
;
;Lock BPS REQUEST
LOCK77(BPTIMOUT,IEN59,BPSRC) ;
N BPRET
L +^BPS(9002313.77):+$G(BPTIMOUT)
S BPRET=$T
I $G(IEN59)>0 D LOG^BPSOSL(IEN59,$G(BPSRC)_$S(BPRET=1:"-Lock",1:"-Failed to Lock")_" BPS REQUEST file")
Q BPRET
;
;UnLock BPS REQUEST
UNLOCK77(IEN59,BPSRC) ;
L -^BPS(9002313.77)
I $G(IEN59)>0 D LOG^BPSOSL(IEN59,$G(BPSRC)_"-Unlock BPS REQUEST file")
Q
;
;BP77 - ien of BPS REQUEST
ERRFIELD(BP77,BPRFILE,BPMESS,BPFILENO,BPFLDNO) ;
I $G(BP77)>0 D DELREQST^BPSOSRX4(BP77) ;delete incomplete record
Q $$FIELDMSG^BPSOSRX2(BPRFILE,BPMESS,BPFILENO,BPFLDNO)
;
;BPSOSRX3
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPSOSRX3 15154 printed Oct 16, 2024@17:52:50 Page 2
BPSOSRX3 ;ALB/SS - ECME REQUESTS ;02-JAN-08
+1 ;;1.0;E CLAIMS MGMT ENGINE;**7,8,10,11,23,24**;JUN 2004;Build 43
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;Input
+5 ;BPREQTYP - request type:
+6 ; "C" - Submit a claim to ECME
+7 ; If the claim has already been processed, and it's resubmitted, then a reversal will be
+8 ; done first, and then the resubmit. Intervening call to $$STATUS may show progress
+9 ; of the reversal before the resubmitted claim is processed.
+10 ; "U"- Reverse submitted claim.
+11 ; The reversal will actually be done ONLY if the most recent processing of the claim
+12 ; resulted in something reversible, namely E PAYABLE or E REVERSAL REJECTED
+13 ; "E" - Eligibility Verification Request
+14 ;KEY1 - First Key for the BPS Request file
+15 ;KEY2 - Second Key for the BPS Request file
+16 ;MOREDATA - Array of data for transaction/claim
+17 ;BPCOBIND - payer sequence
+18 ;BILLNDC - NDC passed into EN^BPSNCPDP sent in BILLNDC variable or determined by EN^BPSNCPDP if it was null
+19 ;at the very first time when EN^BPSNCPDP was called in "F" (foreground) mode
+20 ;BPSKIP(optional)=1 : skip the field, used when CLAIM request is created while the previous
+21 ;request is in progress. That means - billing determination will be done upon activation)
+22 ;Return values:
+23 ; 1^BPS REQUEST ien = accepted for processing
+24 ; 0^reason = failure (should never happen)
MKRQST(BPREQTYP,KEY1,KEY2,MOREDATA,BPIENS78,BPCOBIND,BILLNDC,BPSKIP) ;
+1 NEW BPIEN77,BPCOB,BPQ,BPIEN772,BPERRMSG,BPIEN59,BPIEN78,BPZ
+2 NEW RETVAL,STAT,TYPE,RESULT,SUBMITDT,BPNOW,BPACTTYP,BP77LCK
+3 NEW DUR,BPIEN771,BPCNT,BPSDUPL
+4 SET BPSKIP=+$GET(BPSKIP)
+5 IF $GET(BPREQTYP)=""
QUIT "0^Parameter error-Request Type"
+6 IF '$GET(KEY1)
QUIT "0^Parameter error-Key1"
+7 IF BPREQTYP="E"
IF $GET(KEY2)'>9000
QUIT "0^Parameter error-Key2 for eligibility"
+8 IF '$GET(BPCOBIND)=""
QUIT "0^Parameter error-COB Indicator"
+9 IF '$GET(KEY2)
SET KEY2=0
+10 SET BPIEN59=+$$IEN59^BPSOSRX(KEY1,KEY2,BPCOBIND)
+11 ;
+12 ;new record
+13 SET BPERRMSG="Cannot create record in BPS REQUEST"
+14 SET BPIEN77=$$INSITEM^BPSUTIL2(9002313.77,"",KEY1,"","","^BPS(9002313.77)",10)
+15 IF BPIEN77<1
QUIT "0^"_BPERRMSG
+16 SET BPNOW=$$NOW^BPSOSRX()
+17 SET BPACTTYP=$GET(MOREDATA("RX ACTION"))
+18 ; fill out the fields
+19 SET BPERRMSG="Missing data for the "
+20 IF $$FILLFLDS^BPSUTIL2(9002313.77,".02",BPIEN77,KEY2)<1
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,.02)
+21 IF $$FILLFLDS^BPSUTIL2(9002313.77,".03",BPIEN77,BPCOBIND)<1
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,.03)
+22 ;set delay with the testing tool
+23 SET BPZ=+$$SETDELAY^BPSTEST(BPIEN59)
IF BPZ>0
IF $$FILLFLDS^BPSUTIL2(9002313.77,".08",BPIEN77,BPZ)<1
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,.08)
+24 ;set the process flag to "WAITING"
+25 IF $$FILLFLDS^BPSUTIL2(9002313.77,".04",BPIEN77,0)<1
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,.04)
+26 IF $$FILLFLDS^BPSUTIL2(9002313.77,"6.01",BPIEN77,BPNOW)<1
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,6.01)
+27 IF $$FILLFLDS^BPSUTIL2(9002313.77,"6.05",BPIEN77,BPNOW)<1
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,6.05)
+28 IF $$ACTFIELD(BPSKIP,BPREQTYP,"6.02")
IF $$FILLFLDS^BPSUTIL2(9002313.77,"6.02",BPIEN77,+$GET(MOREDATA("USER")))<1
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,6.02)
+29 IF $$FILLFLDS^BPSUTIL2(9002313.77,"6.06",BPIEN77,+DUZ)<1
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,6.06)
+30 IF $$ACTFIELD(BPSKIP,BPREQTYP,"1.01")
IF $$FILLFLDS^BPSUTIL2(9002313.77,"1.01",BPIEN77,$GET(MOREDATA("RX ACTION")))<1
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.01)
+31 IF $GET(MOREDATA("DIVISION"))
IF $$FILLFLDS^BPSUTIL2(9002313.77,"1.02",BPIEN77,MOREDATA("DIVISION"))<1
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.02)
+32 IF $$FILLFLDS^BPSUTIL2(9002313.77,"1.04",BPIEN77,BPREQTYP)<1
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.04)
+33 ;if this is a queued "C" request then the billing will be done again upon activation so MOREDATA(BILL) is undefined
+34 ;that is why we are not checking this field
+35 IF $$ACTFIELD(BPSKIP,BPREQTYP,"1.05")
IF $$FILLFLDS^BPSUTIL2(9002313.77,"1.05",BPIEN77,$PIECE($GET(MOREDATA("BILL")),U))<1
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.05)
+36 IF '$DATA(MOREDATA("ELIG"))
IF $$ACTFIELD(BPSKIP,BPREQTYP,"1.06")
IF $$FILLFLDS^BPSUTIL2(9002313.77,"1.06",BPIEN77,$PIECE($GET(MOREDATA("BILL")),U,3))<1
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.06)
+37 IF $DATA(MOREDATA("ELIG"))
IF $$ACTFIELD(BPSKIP,BPREQTYP,"1.06")
IF $$FILLFLDS^BPSUTIL2(9002313.77,"1.06",BPIEN77,$GET(MOREDATA("ELIG")))<1
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.06)
+38 IF $PIECE($GET(MOREDATA("BILL")),U,2)'=""
IF $$ACTFIELD(BPSKIP,BPREQTYP,"1.07")
IF $$FILLFLDS^BPSUTIL2(9002313.77,"1.07",BPIEN77,$PIECE($GET(MOREDATA("BILL")),U,2))<1
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.07)
+39 IF $$ACTFIELD(BPSKIP,BPREQTYP,"1.13")
IF $$FILLFLDS^BPSUTIL2(9002313.77,"1.13",BPIEN77,$GET(MOREDATA("RX")))<1
IF BPREQTYP'="E"
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.13)
+40 IF $$ACTFIELD(BPSKIP,BPREQTYP,"1.14")
IF $$FILLFLDS^BPSUTIL2(9002313.77,"1.14",BPIEN77,$PIECE($GET(MOREDATA("BPSDATA",1)),U,4))<1
IF BPREQTYP'="E"
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.14)
+41 IF $$ACTFIELD(BPSKIP,BPREQTYP,"1.15")
IF $$FILLFLDS^BPSUTIL2(9002313.77,"1.15",BPIEN77,$GET(MOREDATA("PATIENT")))<1
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.15)
+42 IF $$ACTFIELD(BPSKIP,BPREQTYP,"1.16")
IF $$FILLFLDS^BPSUTIL2(9002313.77,"1.16",BPIEN77,$PIECE($GET(MOREDATA("IBDATA",1,3)),U,7))<1
IF BPREQTYP="E"
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.16)
+43 IF $$ACTFIELD(BPSKIP,BPREQTYP,"2.01")
IF $$FILLFLDS^BPSUTIL2(9002313.77,"2.01",BPIEN77,+$GET(MOREDATA("DATE OF SERVICE")))<1
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,2.01)
+44 IF $$ACTFIELD(BPSKIP,BPREQTYP,"2.02")
IF $$FILLFLDS^BPSUTIL2(9002313.77,"2.02",BPIEN77,$GET(MOREDATA("REVERSAL REASON")))<1
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,2.02)
+45 IF $LENGTH($GET(MOREDATA("BPOVRIEN")))>0
IF $$FILLFLDS^BPSUTIL2(9002313.77,"2.04",BPIEN77,$GET(MOREDATA("BPOVRIEN")))<1
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,2.04)
+46 IF $LENGTH($GET(MOREDATA("BPSCLARF")))>0
IF $$FILLFLDS^BPSUTIL2(9002313.77,"2.05",BPIEN77,$GET(MOREDATA("BPSCLARF")))<1
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,2.05)
+47 IF $LENGTH($GET(BILLNDC))>0
IF $$FILLFLDS^BPSUTIL2(9002313.77,"2.06",BPIEN77,BILLNDC)<1
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,2.06)
+48 IF $LENGTH($PIECE($GET(MOREDATA("BPSAUTH")),U))>0
IF $$FILLFLDS^BPSUTIL2(9002313.77,"2.07",BPIEN77,$EXTRACT($PIECE(MOREDATA("BPSAUTH"),U,1),1,2))<1
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,2.07)
+49 IF $LENGTH($PIECE($GET(MOREDATA("BPSAUTH")),U,2))>0
IF $$FILLFLDS^BPSUTIL2(9002313.77,"2.08",BPIEN77,$EXTRACT($PIECE(MOREDATA("BPSAUTH"),U,2),1,11))<1
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,2.08)
+50 IF $LENGTH($GET(MOREDATA("BPSDELAY")))>0
IF $$FILLFLDS^BPSUTIL2(9002313.77,"2.1",BPIEN77,MOREDATA("BPSDELAY"))<1
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,2.1)
+51 IF $$ACTFIELD(BPSKIP,BPREQTYP,"4.01")
IF $$FILLFLDS^BPSUTIL2(9002313.77,"4.01",BPIEN77,$PIECE($GET(MOREDATA("BPSDATA",1)),U,1))
+52 IF $$ACTFIELD(BPSKIP,BPREQTYP,"4.02")
IF $$FILLFLDS^BPSUTIL2(9002313.77,"4.02",BPIEN77,$PIECE($GET(MOREDATA("BPSDATA",1)),U,2))
+53 IF $$ACTFIELD(BPSKIP,BPREQTYP,"4.03")
IF $$FILLFLDS^BPSUTIL2(9002313.77,"4.03",BPIEN77,$PIECE($GET(MOREDATA("BPSDATA",1)),U,3))
+54 IF $$ACTFIELD(BPSKIP,BPREQTYP,"4.04")
IF $$FILLFLDS^BPSUTIL2(9002313.77,"4.04",BPIEN77,$PIECE($GET(MOREDATA("BPSDATA",1)),U,4))
+55 IF $PIECE($GET(MOREDATA("BPSDATA",1)),U,5)'=""
IF $$ACTFIELD(BPSKIP,BPREQTYP,"4.05")
IF $$FILLFLDS^BPSUTIL2(9002313.77,"4.05",BPIEN77,$PIECE($GET(MOREDATA("BPSDATA",1)),U,5))
+56 IF $PIECE($GET(MOREDATA("BPSDATA",1)),U,6)'=""
IF $$ACTFIELD(BPSKIP,BPREQTYP,"4.06")
IF $$FILLFLDS^BPSUTIL2(9002313.77,"4.06",BPIEN77,$PIECE($GET(MOREDATA("BPSDATA",1)),U,6))
+57 IF $$ACTFIELD(BPSKIP,BPREQTYP,"4.07")
IF $$FILLFLDS^BPSUTIL2(9002313.77,"4.07",BPIEN77,$PIECE($GET(MOREDATA("BPSDATA",1)),U,7))
+58 IF $$ACTFIELD(BPSKIP,BPREQTYP,"4.08")
IF $$FILLFLDS^BPSUTIL2(9002313.77,"4.08",BPIEN77,$PIECE($GET(MOREDATA("BPSDATA",1)),U,8))
+59 IF $$ACTFIELD(BPSKIP,BPREQTYP,"4.09")
IF $$FILLFLDS^BPSUTIL2(9002313.77,"4.09",BPIEN77,$PIECE($GET(MOREDATA("BPSDATA",1)),U,9))
+60 IF $GET(MOREDATA("CLOSE AFT REV"))=1
IF $$FILLFLDS^BPSUTIL2(9002313.77,"7.01",BPIEN77,1)<1
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,7.01)
+61 IF $GET(MOREDATA("CLOSE AFT REV REASON"))>0
IF $$FILLFLDS^BPSUTIL2(9002313.77,"7.02",BPIEN77,+$GET(MOREDATA("CLOSE AFT REV REASON")))<1
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,7.02)
+62 IF $LENGTH($GET(MOREDATA("CLOSE AFT REV COMMENT")))>0
IF $$FILLFLDS^BPSUTIL2(9002313.77,"7.03",BPIEN77,$GET(MOREDATA("CLOSE AFT REV COMMENT")))<1
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,7.03)
+63 IF $GET(BPSARRY("SC/EI OVR"))=1
IF $$FILLFLDS^BPSUTIL2(9002313.77,"2.09",BPIEN77,1)<1
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,2.09)
+64 ;
+65 ; secondary billing and primary Tricare billing related fields
+66 IF $GET(MOREDATA("RTYPE"))'=""
IF $$FILLFLDS^BPSUTIL2(9002313.77,"1.08",BPIEN77,MOREDATA("RTYPE"))<1
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.08)
+67 IF $GET(MOREDATA("PRIMARY BILL"))'=""
IF $$FILLFLDS^BPSUTIL2(9002313.77,"1.09",BPIEN77,MOREDATA("PRIMARY BILL"))<1
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.09)
+68 IF $GET(MOREDATA("PRIOR PAYMENT"))'=""
IF $$FILLFLDS^BPSUTIL2(9002313.77,"1.1",BPIEN77,MOREDATA("PRIOR PAYMENT"))<1
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.1)
+69 ; cob other payments count
IF $GET(MOREDATA("337-4C"))'=""
IF $$FILLFLDS^BPSUTIL2(9002313.77,1.11,BPIEN77,MOREDATA("337-4C"))<1
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.11)
+70 ; other coverage code
IF $GET(MOREDATA("308-C8"))'=""
IF $$FILLFLDS^BPSUTIL2(9002313.77,1.12,BPIEN77,MOREDATA("308-C8"))<1
QUIT "0^"_$$ERRFIELD(BPIEN77,1,BPERRMSG,9002313.77,1.12)
+71 ;
+72 ; store secondary billing related data entered by the user - esg 6/8/10
+73 SET BPQ=0
SET BPERRMSG=""
+74 IF BPCOBIND=2
Begin DoDot:1
+75 NEW AMTIEN,BPIEN1,BPIEN2,BPIEN778,BPZ,BPZ1,BPZ2,OPAMT,OPAPQ,OPAYD,OPPRA,OPREJ,PIEN,REJIEN
+76 SET PIEN=0
FOR
SET PIEN=$ORDER(MOREDATA("OTHER PAYER",PIEN))
if 'PIEN!BPQ
QUIT
Begin DoDot:2
+77 SET OPAYD=$GET(MOREDATA("OTHER PAYER",PIEN,0))
if OPAYD=""
QUIT
+78 ;
+79 ; count up the number of multiples we have in each set
+80 SET BPZ=0
FOR BPZ1=0:1
SET BPZ=$ORDER(MOREDATA("OTHER PAYER",PIEN,"P",BPZ))
if 'BPZ
QUIT
+81 SET BPZ=0
FOR BPZ2=0:1
SET BPZ=$ORDER(MOREDATA("OTHER PAYER",PIEN,"R",BPZ))
if 'BPZ
QUIT
+82 IF BPZ1
IF BPZ2
SET BPQ=1
SET BPERRMSG="Can't have both payments and rejects for the same OTHER PAYER"
QUIT
+83 ;
+84 ; add a new entry to subfile 9002313.778
+85 SET BPIEN778=$$INSITEM^BPSUTIL2(9002313.778,BPIEN77,PIEN,PIEN,"",,0)
+86 IF BPIEN778<1
SET BPERRMSG="Can't create entry in COB OTHER PAYERS multiple of the BPS REQUESTS file"
SET BPQ=1
QUIT
+87 ; just in case BPQ is set below
SET BPERRMSG="Can't populate field in COB OTHER PAYERS multiple"
+88 ;
+89 ; set the rest of the pieces at this level
+90 IF $PIECE(OPAYD,U,2)'=""
IF $$FILLFLDS^BPSUTIL2(9002313.778,.02,PIEN_","_BPIEN77,$PIECE(OPAYD,U,2))<1
SET BPQ=1
QUIT
+91 IF $PIECE(OPAYD,U,3)'=""
IF $$FILLFLDS^BPSUTIL2(9002313.778,.03,PIEN_","_BPIEN77,$PIECE(OPAYD,U,3))<1
SET BPQ=1
QUIT
+92 IF $PIECE(OPAYD,U,4)'=""
IF $$FILLFLDS^BPSUTIL2(9002313.778,.04,PIEN_","_BPIEN77,$PIECE(OPAYD,U,4))<1
SET BPQ=1
QUIT
+93 IF $PIECE(OPAYD,U,5)'=""
IF $$FILLFLDS^BPSUTIL2(9002313.778,.05,PIEN_","_BPIEN77,$PIECE(OPAYD,U,5))<1
SET BPQ=1
QUIT
+94 IF $$FILLFLDS^BPSUTIL2(9002313.778,.06,PIEN_","_BPIEN77,BPZ1)<1
SET BPQ=1
QUIT
+95 IF $$FILLFLDS^BPSUTIL2(9002313.778,.07,PIEN_","_BPIEN77,BPZ2)<1
SET BPQ=1
QUIT
+96 IF $PIECE(OPAYD,U,11)'=""
IF $$FILLFLDS^BPSUTIL2(9002313.778,.11,PIEN_","_BPIEN77,$PIECE(OPAYD,U,11))<1
SET BPQ=1
QUIT
+97 SET BPERRMSG=""
+98 ;
+99 ; now loop thru the other payer payment array
+100 SET AMTIEN=0
FOR
SET AMTIEN=$ORDER(MOREDATA("OTHER PAYER",PIEN,"P",AMTIEN))
if 'AMTIEN!BPQ
QUIT
Begin DoDot:3
+101 SET OPAMT=$GET(MOREDATA("OTHER PAYER",PIEN,"P",AMTIEN,0))
+102 ; 342-HC other payer amt paid qualifier (ncpdp 5.1 blank is OK)
SET OPAPQ=$PIECE(OPAMT,U,2)
+103 ; 352-NQ, Other Payer-Patient Responsibility Amount
SET OPPRA=$PIECE(OPAMT,U,3)
+104 ; 431-DV other payer amt paid
SET OPAMT=+OPAMT
+105 ;
+106 ; add a new entry to subfile 9002313.7781
+107 SET BPIEN1=$$INSITEM^BPSUTIL2(9002313.7781,PIEN_","_BPIEN77,OPAMT,AMTIEN,"",,0)
+108 IF BPIEN1<1
SET BPERRMSG="Can't create entry in 9002313.7781 subfile"
SET BPQ=1
QUIT
+109 ;
+110 ; set piece 2
+111 IF OPAPQ'=""
IF $$FILLFLDS^BPSUTIL2(9002313.7781,.02,AMTIEN_","_PIEN_","_BPIEN77,OPAPQ)<1
Begin DoDot:4
+112 SET BPQ=1
SET BPERRMSG="Can't populate .02 field in 9002313.7781 subfile"
+113 QUIT
End DoDot:4
+114 ;
+115 ; set piece 3
+116 IF OPPRA'=""
IF $$FILLFLDS^BPSUTIL2(9002313.7781,.03,AMTIEN_","_PIEN_","_BPIEN77,OPPRA)<1
Begin DoDot:4
+117 SET BPQ=1
SET BPERRMSG="Can't populate .03 field in 9002313.7781 subfile"
+118 QUIT
End DoDot:4
+119 ;
+120 QUIT
End DoDot:3
+121 ;
+122 ; now loop thru the other payer reject array
+123 SET REJIEN=0
FOR
SET REJIEN=$ORDER(MOREDATA("OTHER PAYER",PIEN,"R",REJIEN))
if 'REJIEN!BPQ
QUIT
Begin DoDot:3
+124 SET OPREJ=$GET(MOREDATA("OTHER PAYER",PIEN,"R",REJIEN,0))
if OPREJ=""
QUIT
if $PIECE(OPREJ,U,1)=""
QUIT
+125 ;
+126 ; add a new entry to subfile 9002313.7782
+127 SET BPIEN2=$$INSITEM^BPSUTIL2(9002313.7782,PIEN_","_BPIEN77,$PIECE(OPREJ,U,1),REJIEN,"",,0)
+128 IF BPIEN2<1
SET BPERRMSG="Can't create entry in 9002313.7782 subfile"
SET BPQ=1
QUIT
+129 QUIT
End DoDot:3
+130 QUIT
End DoDot:2
+131 QUIT
End DoDot:1
+132 IF BPQ
QUIT "0^"_BPERRMSG_" (COB DATA)"
+133 ;
+134 ;store DURREC info
+135 SET BPQ=0
+136 SET DUR=0
+137 FOR
SET DUR=$ORDER(MOREDATA("DUR",DUR))
if +DUR=0!(BPQ=1)
QUIT
Begin DoDot:1
+138 SET BPIEN771=$$INSITEM^BPSUTIL2(9002313.771,BPIEN77,$PIECE(MOREDATA("DUR",DUR,0),U),DUR,"",,0)
+139 IF BPIEN771<1
SET BPERRMSG="Cannot create DUR record in DUR multiple of the BPS REQUEST file"
SET BPQ=1
QUIT
+140 SET BPERRMSG="Cannot populate a field in DUR multiple"
+141 IF $$FILLFLDS^BPSUTIL2(9002313.771,".02",DUR_","_BPIEN77,$PIECE(MOREDATA("DUR",DUR,0),U,2))<1
SET BPQ=1
QUIT
+142 IF $$FILLFLDS^BPSUTIL2(9002313.771,".03",DUR_","_BPIEN77,$PIECE(MOREDATA("DUR",DUR,0),U,3))<1
SET BPQ=1
QUIT
End DoDot:1
+143 IF BPQ=1
QUIT "0^"_BPERRMSG_" DUR DATA"
+144 ;
+145 ;store ins to IB INSURER DATA
+146 SET BPQ=0
+147 SET BPCOB=0
FOR
SET BPCOB=$ORDER(BPIENS78(BPCOB))
if +BPCOB=0!(BPQ=1)
QUIT
Begin DoDot:1
+148 SET BPIEN772=$$INSITEM^BPSUTIL2(9002313.772,BPIEN77,BPCOB,BPCOB,"",,0)
+149 IF BPIEN772<1
SET BPERRMSG="Cannot create record in IBDATA multiple of the BPS REQUEST file"
SET BPQ=1
QUIT
+150 SET BPERRMSG="Cannot populate a field in IBDATA multiple"
+151 IF $$FILLFLDS^BPSUTIL2(9002313.772,".02",BPCOB_","_BPIEN77,$SELECT(BPCOBIND=BPCOB:1,1:0))<1
SET BPQ=1
QUIT
+152 IF $$FILLFLDS^BPSUTIL2(9002313.772,".03",BPCOB_","_BPIEN77,BPIENS78(BPCOB))<1
SET BPQ=1
QUIT
End DoDot:1
+153 IF BPQ=1
QUIT "0^"_BPERRMSG_"INSURER DATA"
+154 ;
+155 ;return 1 (success) and IEN of the 9002313.77 entry
+156 QUIT "1^"_BPIEN77
+157 ;
+158 ;check if the field is used in MOREDATA for the specified REQUEST TYPE - CLAIM="C" /UNCLAIM="U"
ACTFIELD(BPSKIP,BPREQTYP,BPFLD) ;
+1 ;For Reversal or Skip, only do RX Action, Date of Service, Reversal Reason, and User who made the Request
+2 IF (BPREQTYP="U")!(BPSKIP=1)
QUIT ";1.01;2.01;2.02;6.02;"[(";"_BPFLD_";")
+3 ;For Eligibility Verification, skip Eligibility
+4 IF BPREQTYP="E"
IF ";1.06;"[(";"_BPFLD_";")
QUIT 0
+5 QUIT 1
+6 ;
+7 ;Lock BPS REQUEST
LOCK77(BPTIMOUT,IEN59,BPSRC) ;
+1 NEW BPRET
+2 LOCK +^BPS(9002313.77):+$GET(BPTIMOUT)
+3 SET BPRET=$TEST
+4 IF $GET(IEN59)>0
DO LOG^BPSOSL(IEN59,$GET(BPSRC)_$SELECT(BPRET=1:"-Lock",1:"-Failed to Lock")_" BPS REQUEST file")
+5 QUIT BPRET
+6 ;
+7 ;UnLock BPS REQUEST
UNLOCK77(IEN59,BPSRC) ;
+1 LOCK -^BPS(9002313.77)
+2 IF $GET(IEN59)>0
DO LOG^BPSOSL(IEN59,$GET(BPSRC)_"-Unlock BPS REQUEST file")
+3 QUIT
+4 ;
+5 ;BP77 - ien of BPS REQUEST
ERRFIELD(BP77,BPRFILE,BPMESS,BPFILENO,BPFLDNO) ;
+1 ;delete incomplete record
IF $GET(BP77)>0
DO DELREQST^BPSOSRX4(BP77)
+2 QUIT $$FIELDMSG^BPSOSRX2(BPRFILE,BPMESS,BPFILENO,BPFLDNO)
+3 ;
+4 ;BPSOSRX3
