IBCECOB2 ;ALB/CXW - IB COB MANAGEMENT SCREEN ;16-JUN-1999
;;2.0;INTEGRATED BILLING;**137,155,433,432,447,488,516,592,641,727**;21-MAR-1994;Build 34
;;Per VA Directive 6402, this routine should not be modified.
;
EDI ;history detail display
N IBIFN,IBDA
D SEL(.IBDA,1)
S IBDA=+$O(IBDA(0)),IBIFN=+$G(IBDA(IBDA))
D EDI1(IBIFN)
S VALMBCK="R"
Q
;
EDI1(IBIFN) ;
N DFN
Q:'IBIFN
S DFN=$P($G(^DGCR(399,IBIFN,0)),U,2)
D EN^VALM("IBJT EDI STATUS")
K:$D(IBFASTXT) IBFASTXT
Q
;
EDI2(IBIFN) ;
N DFN
Q:'IBIFN
S DFN=$P($G(^DGCR(399,IBIFN,0)),U,2)
D EN^VALM("IBJT EDI STATUS ALONE")
K:$D(IBFASTXT) IBFASTXT
Q
;
CSA ;claims status awaiting resolution
N IBDAX
D EN^IBCECSA
I $D(IBFASTXT) K IBFASTXT
S VALMBCK="R"
Q
;
RVEOB ;Review EOB
D FULL^VALM1 W !
N IBDA,IBIFN,IBCMT,IBSEL
D SEL(.IBDA,1)
S IBSEL=+$O(IBDA(0))
S IBDA=$G(IBDA(IBSEL))
S IBIFN=$P(IBDA,U),IBDA=$P(IBDA,U,3)
I 'IBIFN G VEOBQ
S IBCMT=$G(^TMP("IBCECOB1",$J,IBSEL))
I IBCMT'="" D EN^VALM("IBCEM MRA REVIEW")
VEOBQ K ^TMP("IBCECOC",$J)
S VALMBCK="R"
Q
;
TPJI ;Third Party joint Inquiry
N IBDA,IBIFN
D SEL(.IBDA,1)
S IBDA=+$O(IBDA(0)),IBIFN=+$G(IBDA(IBDA))
I IBDA="" G TPJIQ
D TPJI1(IBIFN)
TPJIQ S VALMBCK="R"
Q
;
TPJI1(IBIFN) ;
N DFN,IBNOTPJI
Q:'IBIFN
S DFN=$P($G(^DGCR(399,IBIFN,0)),U,2),IBNOTPJI=1
D EN^VALM("IBJT CLAIM INFO")
K:$D(IBFASTXT) IBFASTXT
Q
;
PBILL ;Print bill
N IBIFN,IBDA,IBRESUB
D SEL(.IBDA,1)
S IBDA=$O(IBDA(0)),IBIFN=+$G(IBDA(+IBDA))
I IBDA="" G PBOUT
S IBRESUB=$$RESUB^IBCECSA4(IBIFN,1,"P")
I IBRESUB'>0 W !,*7,"This is not a transmittable bill or review not needed" D PAUSE^VALM1 G PBOUT
I IBRESUB=2 D G PBOUT
. N IB364
. S IB364=+$P($G(IBDA(IBDA)),U,2)
. D PRINT1^IBCEM03(IBIFN,.IBDA,IB364)
D PBILL1(IBIFN,.IBRESULT) ;WCJ;US3380MODIFIED THIS LINE BUT WHY???
PBOUT S VALMBCK="R"
Q
;
PMRA ;Print MRA
N IBIFN,IBDA,IBDAX
D SEL(.IBDA,1)
;IB*2.0*592 JRA Fix <UNDEFINED> error occurring when IBDA(+IBDA) does not exist. Also, ensure that IBDAX'=""
; since it's used as a subscript to ^IBM.
;S IBDA=$O(IBDA(0)),IBIFN=+$G(IBDA(+IBDA)),IBDAX=$P(IBDA(+IBDA),U,3) ;IB*2.0*592 JRA ';'
S IBDA=$O(IBDA(0)),IBIFN=+$G(IBDA(+IBDA)),IBDAX=+$P($G(IBDA(+IBDA)),U,3) ;IB*2.0*592 JRA Add $G to SET of IBDAX and +$P
G:'IBIFN PRMQ
I '$G(IBMRANOT),$D(^IBM(361.1,IBDAX,"ERR")),'$$WARNMSE G PRMQ ; Claim contains Message Storage Errors
D MRA^IBCEMRAA(.IBIFN)
PRMQ S VALMBCK="R"
Q
PBILL1(IBIFN,IBRESULT) ;WCJ;IB641;US3380;added IBRESULT parameter
N IBAC1,IBAC,DFN
S IBRESULT=0 ;WCJ;IB641;US3380;default IBRESULT to 0 (not yet successful)
Q:'IBIFN
S DFN=$P($G(^DGCR(399,IBIFN,0)),U,2)
S IBAC=4,IBAC1=1
;D 4^IBCB1
D ALT4^IBCB1(.IBRESULT) ; WCJ;IB641;US3380;added parameter to show whether it actually got printed
D FULL^VALM1,PAUSE^VALM1
Q
;
CANCEL ;Cancel bill
; IBDA(IBDA)=IBIFN^IB364^ien of 361.1^user selection seq^user name~duz#
;
N IBIFN,IBDA,IB364,IBEOBIFN,X,IBDENCT
;
; Check for security key
I '$$KCHK^XUSRB("IB AUTHORIZE") D G CANCELQ
. D FULL^VALM1 S VALMBCK="R"
. W !!?5,"You don't hold the proper security key to access this function."
. W !?5,"The necessary key is IB AUTHORIZE. Please see your manager."
. D PAUSE^VALM1
. Q
;
D SEL(.IBDA,1)
S IBDA=$O(IBDA(0)),IBIFN=+$G(IBDA(+IBDA)),IB364=$P($G(IBDA(+IBDA)),U,2)
S IBEOBIFN=$P($G(IBDA(+IBDA)),U,3)
;
; IB*2.0*432 - if not mra, only allow cancel of denied claims. If no EOB, check AR status instead
I 'IBEOBIFN,$G(IBMRANOT)=1,$P($$ARSTATA^IBJTU4(IBIFN),U)="COLLECTED/CLOSED" D G CANCELQ
. D FULL^VALM1 S VALMBCK="R"
. W !!,*7,"You can only cancel denied claims. This claim is in a COLLECTED/CLOSED status"
. W !,"Use Remove Action to remove claim from this worklist."
. D PAUSE^VALM1
. Q
;
; IB*2.0*432 - if not mra, only allow cancel of claims with multiple EOBS if none have processed.
I $G(IBMRANOT)=1,'$$DENCHK(IBIFN,.IBDENCT),$G(IBDENCT)>1 D G CANCELQ
. D FULL^VALM1 S VALMBCK="R"
. W !!,*7,"Multiple EOBs exist for this claim and at least one has EOB status of PROCESSED."
. W !,"Use Remove Action to remove claim from this worklist."
. D PAUSE^VALM1
. Q
;
; IB*2.0*432 - if not mra, only allow cancel of denied claims
I IBEOBIFN,$G(IBMRANOT)=1,$P($G(^IBM(361.1,IBEOBIFN,0)),U,13)'=2 D G CANCELQ
. D FULL^VALM1 S VALMBCK="R"
. W !!?5,*7,"You can only cancel denied claims."
. D PAUSE^VALM1
. Q
;
;WCJ;IB727;check to see if all lines are covered in the MRA
N IBRETSPLT
I '$G(IBMRANOT),$$SPLIT^IBCEMU1(IBEOBIFN),$$SPLIT2^IBCEMU1(IBEOBIFN)=0!($$SPLIT2^IBCEMU1(IBEOBIFN)=-1&($$SPLTMRA^IBCEMU1(IBIFN,.IBRETSPLT)<2)) D G CANCELQ
. D FULL^VALM1 S VALMBCK="R"
. W !!?5,"All claim lines must be adjudicated before cancelling a split claim."
. D PAUSE^VALM1
;
I IBDA D
. I '$$LOCK^IBCEU0(361.1,IBEOBIFN) Q
. D CANCEL^IBCEM3(.IBDA,IBIFN,IB364)
. D UNLOCK^IBCEU0(361.1,IBEOBIFN)
S VALMBCK="R"
;
; for non-MRA claims cancelled from worklist, set field 38
I $G(IBMRANOT)=1,$P($G(^DGCR(399,IBIFN,0)),U,13)=7 S X=$$WLRMVF^IBCECOB1($S($G(IBIFN)'="":IBIFN,1:+$G(IBDA(IBDA))),"CA")
I $G(IBDA)'="" D BLD^IBCECOB1
CANCELQ Q
;
CRD ; Correct Rejected/Denied claim protocol action
N IBCNCRD
S IBCNCRD=1
CLONE ; 'Copy/cancel bill' protocol action
;N IBDA,IBQ,IBEOBIFN,IBKEY,X,IBDENCT
N IBDA,IBQ,IBEOBIFN,IBKEY,X,IBDENCT,IBIFN ;WCJ;IB727
;
; Check for security key
;IB*2.0*516/TAZ - Remove check for IB CLON
;I '$$KCHK^XUSRB("IB AUTHORIZE") D G CLONEQ
;S IBKEY=$S($G(IBCNCRD)=1:"IB AUTHORIZE",1:"IB CLON")
S IBKEY="IB AUTHORIZE"
I '$$KCHK^XUSRB(IBKEY) D G CLONEQ
. D FULL^VALM1 S VALMBCK="R"
. ;W !!?5,"You don't hold the proper security key to access this function."
. ;W !?5,"The necessary key is IB AUTHORIZE. Please see your manager."
. W !!?5,"You must hold the "_IBKEY_" security key to access this function."
. W !?5,"Please see your manager."
. D PAUSE^VALM1
. Q
;
D SEL(.IBDA,1)
;S IBDA=$O(IBDA(""))
S IBDA=$O(IBDA(0)),IBIFN=+$G(IBDA(+IBDA)) ; IB727
I IBDA="" G CLONEQ
;
; IB*2.0*432 - if not mra, only allow cancel of claims with multiple EOBS if none have processed.
I $G(IBMRANOT)=1,'$$DENCHK(+IBDA(IBDA),.IBDENCT),$G(IBDENCT)>1 D G CANCELQ
. D FULL^VALM1 S VALMBCK="R"
. W !!,*7,"Multiple EOBs exist for this claim and at least one has EOB status of PROCESSED."
. W !,"Use Remove Action to remove claim from this worklist."
. D PAUSE^VALM1
. Q
;
;WCJ;IB727;check to see if all lines are covered in the MRA
N IBEOBIFN,IBRETSPLT
S IBEOBIFN=$P($G(IBDA(+IBDA)),U,3)
I '$G(IBMRANOT),$$SPLIT^IBCEMU1(IBEOBIFN),$$SPLIT2^IBCEMU1(IBEOBIFN)=0!($$SPLIT2^IBCEMU1(IBEOBIFN)=-1&($$SPLTMRA^IBCEMU1(IBIFN,.IBRETSPLT)<2)) D G CLONEQ
. D FULL^VALM1 S VALMBCK="R"
. W !!?5,"All claim lines must be adjudicated before "_$S($G(IBCNCRD):"crd'ing",1:" cloning")_" a split claim."
. D PAUSE^VALM1
;
S IBEOBIFN=$P($G(IBDA(+IBDA)),U,3)
I '$$LOCK^IBCEU0(361.1,IBEOBIFN) G CLONEQ
D COPYCLON(+$G(IBDA(IBDA)),$P($G(IBDA(+IBDA)),U,2),.IBQ)
D UNLOCK^IBCEU0(361.1,IBEOBIFN)
;
; for non-MRA claims cloned or corrected from worklist, set field 38
I $G(IBMRANOT)=1,$G(IBQ)'="" S X=$$WLRMVF^IBCECOB1(+$G(IBDA(IBDA)),$S($G(IBCNCRD)=1:"CR",1:"CL"))
;
CLONEQ ;
S VALMBCK="R"
D:$G(IBQ)'="" BLD^IBCECOB1
Q
;
COPYCLON(IBIFN,IB364,IBQ) ; Generic entry point for clone a bill from EDI processing
; IBIFN = original bill ien
; IB364 = the ien of the transmission bill entry in file 364
; IBQ = If bill is not cancelled, this is returned as null
; - pass by reference -
;
N IBQUIT,IBCCCC,IBHV,Y,IBCAN,IBCE,IBDA,IBCNCOPY
;I '$$CANCKS^IBCEM3("CC",IBIFN) S IBQ="" G CCQ
I $G(IBCNCRD)'=1,'$$CANCKS^IBCEM3("CC",IBIFN) S IBQ="" G CCQ
;
;S IBCAN=2,IBCE("EDI")=1,Y=IBIFN,IBCCCC=0,IBHV("IBIFN")=IBIFN,IBHV("IBIFN1")="",IBCNCOPY=1
S IBCAN=2,IBCE("EDI")=1,Y=IBIFN,IBCCCC=0,IBHV("IBIFN")=IBIFN,IBHV("IBIFN1")=""
I $G(IBCNCRD)'=1 S IBCNCOPY=1 D ^IBCCC
I $G(IBCNCRD)=1 D CRD^IBCCC
;D ^IBCCC
S IBIFN=IBHV("IBIFN")
K IBCE("EDI") S IBQ=1
I $P($G(^DGCR(399,IBIFN,0)),U,13)'=7 S IBQ=""
I IBHV("IBIFN1") D
. N IBU
. S IBU="R"
. S IBNIEN=+IBHV("IBIFN1")
. I "23"'[$P($G(^DGCR(399,+IBHV("IBIFN1"),0)),U,13) D
.. W:'$G(IBCEAUTO) !,*7,"Please note: the new bill was not AUTHORIZED.",!,"It can only be accessed now via the normal, non-EDI functions.",!,"Status of new bill is ",$$EXPAND^IBTRE(399,.13,$P(^DGCR(399,IBHV("IBIFN1"),0),U,13)) S IBU="C"
. D UPDEDI^IBCEM(IB364,IBU)
;
I '$G(IBCEAUTO) D PAUSE^VALM1
CCQ Q
;
PRO ; Copy for secondary/tertiary bill
N VALMY,IBDA,Z,IBIFN,IBIFNH,IB364,IBCE,IBNCN
;I '$P($G(^IBE(350.9,1,8)),U,12) D G PROQ
I '$P($G(^IBE(350.9,1,8)),U,12),$G(IBMRANOT)'=1 D G PROQ
. D FULL^VALM1
. W !!?5,"MRA's may not be processed at this time."
. W !?5,"The IB site parameter ""Allow MRA Processing?"" is set to NO."
. D PAUSE^VALM1
. Q
D SEL(.IBDA,1)
S Z=$O(IBDA(0)),Z=$G(IBDA(+Z)) G:'Z PROQ
S IBIFN=$P(Z,U),IB364=$P(Z,U,2),IBDA=$P(Z,U,3),IBIFNH=IBIFN
N IBEOBIFN ;WCJ;IB727 v17
S IBEOBIFN=IBDA ;WCJ;IB727 v17
I 'IBIFN G PROQ
I '$G(IBMRANOT),$D(^IBM(361.1,IBDA,"ERR")),'$$WARNMSE G PROQ ; Claim contains Message Storage Errors
;
;I $G(IBMRANOT),($$GET1^DIQ(399,IBIFN_",",36,"","","")="IB803"),'$$WARNIBMRANOT G PROQ ;TPF;EBILL-2436;IB*2.0*727
I $G(IBMRANOT),$$FILERR^IBCAPP2(IBIFN),'$$WARNIBMRANOT G PROQ ;TPF;EBILL-3061;IB*2.0*727 v15
;
;WCJ;IB727;check to see if all lines are covered in the MRA
N IBRETSPLT ;N IBEOBIFN,IBRETSPLT ;WCJ;IB727 v17
;S IBEOBIFN=$P($G(IBDA(+IBDA)),U,3) ;WCJ;IB727 v17
I '$G(IBMRANOT),$$SPLIT^IBCEMU1(IBEOBIFN),$$SPLIT2^IBCEMU1(IBEOBIFN)=0!($$SPLIT2^IBCEMU1(IBEOBIFN)=-1&($$SPLTMRA^IBCEMU1(IBIFN,.IBRETSPLT)<2)) D G PROQ
. D FULL^VALM1 S VALMBCK="R"
. W !!?5,"All claim lines must be adjudicated before processing a split claim to subsequent payer."
. D PAUSE^VALM1
;
I '$$LOCK^IBCEU0(361.1,IBDA) G PROQ
D COBCOPY(IBIFN,IB364,2,IBDA,"BLD^IBCECOB1",.IBNCN)
D UNLOCK^IBCEU0(361.1,IBDA)
;
; for non-MRA claims copied from work list, set field 38
I $G(IBMRANOT)=1,$G(IBNCN)'="",($G(IBNCN)'=$G(IBIFN)) D
.S X=$$WLRMVF^IBCECOB1($G(IBIFN),"PC")
.;I $P($G(^DGCR(399,+IBNCN,"S")),U,9)'=1 D
.;.W:'$G(IBCEAUTO) !,*7,"Please note: the new bill was not AUTHORIZED.",!,"It can only be accessed now via the normal, non-EDI functions.",!,"Status of new bill is ",$$EXPAND^IBTRE(399,.13,$P(^DGCR(399,IBNCN,0),U,13))
.;.D PAUSE^VALM1
.D:$G(IBMRANOT)=1 BLD^IBCECOB1
.Q
;
PROQ S VALMBCK="R"
Q
;
COBCOPY(IBIFN,IB364,IBFROM,IBIEN,IBBLD,IBNCN) ; Generic entry point for EDI COB copy
; IBIFN = original bill ien
; IB364 = the ien of the transmission bill entry in file 364
; IBFROM = 1 if called from CSA, 2 if called from COB/EOB processing
; IBIEN = entry in 361 (IBFROM=1) or 361.1 (IBFROM=2) being processed
; IBBLD = the name of the entrypoint that will rebuild the display
; IBNCN = by reference, returns the new claim ien if user completed the Copy process
;
N IBCBASK,IBCBCOPY,IBCAN,IBIFNH,IBNSTAT,IBOSTAT,IBPRCOB,IBSECHK,IBLMVAR,IBAC,IBMRAIEN,IBDA,IBAUTO
N IBCOB,IBCOBIL,IBCOBN,IBINS,IBINSN,IBINSOLD,IBMRAIO,IBMRAO,IBNMOLD,IBQUIT
S (IBCBASK,IBCBCOPY,IBCAN,IBAUTO)=1,(IBPRCOB,IBSECHK)=0,(IBMRAIEN,IBDA)=IBIEN
I $G(IBMRANOT)'=1,'IB364!'IBIFN W !,"Transmission record is missing for this bill" D PAUSE^VALM1 G COBCOPX
;
S IBIFNH=IBIFN
I IBFROM=2 S IBPRCOB=1
; IB*2.0*447 Check PR to include excess and percentages where applicable
;I $S($G(IBMRANOT)=1:$$TOT(IBIFN)'>0,1:$$PREOBTOT^IBCEU0(IBIFN,$G(IBMRANOT))'>0) D G COBCOPX
I $$TOT(IBIFN,$G(IBMRANOT))'>0 D G COBCOPX
. D FULL^VALM1
. W !!?5,"There is no "_$S($G(IBMRANOT)=1:"balance remaining",1:"patient responsibility and/or excess charges")_" for this claim."
. W !?5,"This claim may not be processed."
. D PAUSE^VALM1
. Q
;
I $G(IBDA)'="",$P($G(^IBM(361.1,IBDA,0)),U,16)="1.5" D G COBCOPX
. W !!,"This claim has already been processed as a sec/tert claim."
. W !,"You will need to complete the authorization process for this claim."
. D PAUSE^VALM1
. D AUTH
. Q
;
; If multiple EOBs and one is processed, make sure collected closed.
I $G(IBMRANOT),$$CCCHK(IBIFN)<0 D G COBCOPX
. W !,"Multiple EOBs exist for this claim and at least one has EOB status of PROCESSED."
. W !,"Claim cannot be sent to next payer until AR status is Collected/Closed."
. D PAUSE^VALM1
. Q
;
; Get out if no next payer
I '$P($G(^DGCR(399,IBIFN,"I"_($$COBN^IBCEF(IBIFN)+1))),U,1) D G COBCOPX
. W !,"There is no next payer for this bill"
. D PAUSE^VALM1
. Q
;
D DSPRB^IBCCCB0(IBIFN) ; display related bills
S IBCE("EDI")=1
D CHKB^IBCCCB ; process COB, create secondary bill
S IBNCN=$G(IBCE("EDI","NEW")) ; get new claim ien
S IBIFN=IBIFNH
I IBSECHK G COBCOPX
;
; if user came from CBW, no need to view and authorize a 2nd time (already happens in IBCCCB)
Q:$G(IBMRANOT)=1
S IBV=1 D VIEW^IBCB2 ; display billing screens
D AUTH ; authorize bill
COBCOPX ;
Q
;
AUTH ; procedure to authorize the claim and refresh the screen
K ^UTILITY($J) S IBAC=1,IBQUIT=0 D 3^IBCB1
I '$D(IOUON)!'$D(IORVON) D ENS^%ZISS
I $P($G(^IBM(361.1,IBMRAIEN,0)),U,16)=3 D UPDEDI^IBCEM(IB364,"Z")
I $G(IBBLD)'="" D @IBBLD
D PAUSE^VALM1
AUTHX ;
Q
;
RES ;Resubmit bill by print
N IBDA,IBIFN,IB364
D SEL(.IBDA,1)
S IBDA=+$O(IBDA(0)),IBIFN=+$G(IBDA(+IBDA)),IB364=+$P($G(IBDA(IBDA)),U,2)
I 'IBIFN G RESQ
D PRINT1^IBCEM03(IBIFN,.IBDA,IB364)
D PAUSE^VALM1
I $G(IBDA)'="" D BLD^IBCECOB1
RESQ S VALMBCK="R"
Q
;
EBI ;View an unauthorized transmitted bill
N IBFLG,IBDA,IBIFN,IB364,DFN
K ^TMP($J,"IBBILL")
D FULL^VALM1
;
D SEL(.IBDA,1)
S IBDA=+$O(IBDA(""))
S IBIFN=+$G(IBDA(IBDA)),IB364=+$P($G(IBDA(IBDA)),U,2),DFN=$P($G(^DGCR(399,IBIFN,0)),U,2)
G:'IBIFN EDITQ
S IBV=1 D VIEW^IBCB2
I '$D(IOUON)!'$D(IORVON) D ENS^%ZISS
D BLD^IBCECOB1
EDITQ S VALMBCK="R"
Q
;
SEL(IBDA,ONE) ; Select entry(s) from list
; IBDA = array returned if selections made
; IBDA(n)=ien of bill selected (file 399)
; ONE = if set to 1, only one selection can be made at a time
N IB
K IBDA
D FULL^VALM1
D EN^VALM2($G(XQORNOD(0)),$S('$G(ONE):"",1:"S"))
S IBDA=0 F S IBDA=$O(VALMY(IBDA)) Q:'IBDA S IBDA(IBDA)=$P($G(^TMP("IBCECOB",$J,+IBDA)),U,2,6)
Q
;
EXIT ; Exit out of COB
D FASTEXIT^IBCEFG4
I $G(IBFASTXT)=1 S IBFASTXT=5
Q
;
TOT(IBIFN,IBMRANOT) ; calculate if any balance remaining on non-MRA claim
; IBIFN = claim ien
; IBMRANOT = MRW/CBW flag (1=user came from CBW) added with IB*2.0*447
N IBPRTOT,IBBLD,IBCBN,IBU2
I $G(IBMRANOT)'=1 Q $S($$MSEDT^IBCEMU4(IBIFN)'="":$$MSPRE^IBCEMU4(IBIFN),1:$$PREOBTOT^IBCEU0(IBIFN))
; total up the payer paid amounts, if this is a 2ndary claim, be sure to account for what the primary paid also
S IBU2=$G(^DGCR(399,IBIFN,"U2")),IBCBN=$$COBN^IBCEF(IBIFN),IBPRTOT=$$EOBTOT^IBCEU1(IBIFN,IBCBN)
S:IBPRTOT<0 IBPRTOT=0 ; don't allow negative prior payment or offset
S:IBCBN=2 IBPRTOT=IBPRTOT+$P(IBU2,U,4)
S:IBCBN=3 IBPRTOT=IBPRTOT+$P(IBU2,U,4)+$P(IBU2,U,5)
S:IBPRTOT<0 IBPRTOT=0 ; don't allow negative prior payment or offset
; Subtract payer paid amount from Total Charges from BILLS/CLAIMS (#399) file, don't allow neg
S IBBLD=$P($G(^DGCR(399,IBIFN,"U1")),U,1)-IBPRTOT
S:IBBLD<0 IBBLD=0
Q IBBLD
;
CCCHK(IBIFN) ; If there are multiple EOBS on file for this claim, then one of them must be processed and AR status must be collected closed to process.
; returns 1 if true
; 0 if there are not multiple EOBs or mulitple EOBs and none are processed (all denials)
; -1 if false
N IBDA,IBCT,IBPROC,IBARSTAT,IBEOBNDX,IBEOB
S IBCT=0,IBPROC=0
F IBEOBNDX="B","C" D
.S IBDA=0 F S IBDA=$O(^IBM(361.1,IBEOBNDX,IBIFN,IBDA)) Q:'+IBDA D
..Q:$D(IBEOB(IBDA))
..Q:$P($G(^IBM(361.1,IBDA,0)),U,4)=1 ; only count EOBs
..S IBEOB(IBDA)="",IBCT=IBCT+1
..I $P($G(^IBM(361.1,IBDA,0)),U,13)=1 S IBPROC=1
I IBCT<2 Q 0 ; less than 2 EOBs
I 'IBPROC Q 0 ; no EOBs with status processed
S IBARSTAT=$$ARSTATA^IBJTU4(IBIFN) ; get status of AR
I $P(IBARSTAT,U)="COLLECTED/CLOSED" Q 1
Q -1
;
DENCHK(IBIFN,IBCT) ; Make sure all EOBs from this claim are denied.
; Input: IBIFN - IEN to 399
; IBCT - by reference. Return count of EOBs.
; Output: returns 1 if there is at least one EOB and that none of the EOBS are processed.
; otherwise 0
;
N IBDA,IBPROC,IBEOBNDX,IBEOB
S IBCT=0,IBPROC=0
F IBEOBNDX="B","C" D
.S IBDA=0 F S IBDA=$O(^IBM(361.1,IBEOBNDX,IBIFN,IBDA)) Q:'+IBDA D
..Q:$D(IBEOB(IBDA))
..Q:$P($G(^IBM(361.1,IBDA,0)),U,4)=1 ; only count EOBs
..S IBEOB(IBDA)="",IBCT=IBCT+1
..I $P($G(^IBM(361.1,IBDA,0)),U,13)=1 S IBPROC=1
I IBCT,'IBPROC Q 1 ; there is at least one EOB and none of the EOBS are processed.
Q 0 ;
;
WARNMSE() ; Display MSE Warning and check if we should continue.
D FULL^VALM1
N DIR,X,Y
S DIR("A",1)="WARNING : The MRA for this claim caused a Data Mismatch/Message Storage Error."
S DIR("A",2)="If you continue, the secondary claim may not contain the correct data."
S DIR("A")="Do you wish to continue? ",DIR("B")="NO",DIR(0)="YA" D ^DIR
I Y>0 Q 1 ; Okay to continue.
Q 0 ;
;
WARNIBMRANOT() ;TPF;EBILL-2436;IB*2.0*727;WCJ-lessened to warning
D FULL^VALM1
N DIR,X,Y
S DIR("A",1)="WARNING: An EOB/MRA for this claim caused a Data Mismatch/Message Storage Error."
S DIR("A",2)="If you continue, the subsequent claim may not contain the correct data."
S DIR("A")="Do you wish to continue? ",DIR("B")="NO",DIR(0)="YA" D ^DIR
I Y>0 Q 1 ; Okay to continue.
Q 0 ;
;
D FULL^VALM1
W !!,"WARNING: An EOB for this Claim has an MSE error and cannot be processed."
N DIR
S DIR(0)="E"
D ^DIR
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCECOB2 17983 printed Oct 16, 2024@18:10:20 Page 2
IBCECOB2 ;ALB/CXW - IB COB MANAGEMENT SCREEN ;16-JUN-1999
+1 ;;2.0;INTEGRATED BILLING;**137,155,433,432,447,488,516,592,641,727**;21-MAR-1994;Build 34
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
EDI ;history detail display
+1 NEW IBIFN,IBDA
+2 DO SEL(.IBDA,1)
+3 SET IBDA=+$ORDER(IBDA(0))
SET IBIFN=+$GET(IBDA(IBDA))
+4 DO EDI1(IBIFN)
+5 SET VALMBCK="R"
+6 QUIT
+7 ;
EDI1(IBIFN) ;
+1 NEW DFN
+2 if 'IBIFN
QUIT
+3 SET DFN=$PIECE($GET(^DGCR(399,IBIFN,0)),U,2)
+4 DO EN^VALM("IBJT EDI STATUS")
+5 if $DATA(IBFASTXT)
KILL IBFASTXT
+6 QUIT
+7 ;
EDI2(IBIFN) ;
+1 NEW DFN
+2 if 'IBIFN
QUIT
+3 SET DFN=$PIECE($GET(^DGCR(399,IBIFN,0)),U,2)
+4 DO EN^VALM("IBJT EDI STATUS ALONE")
+5 if $DATA(IBFASTXT)
KILL IBFASTXT
+6 QUIT
+7 ;
CSA ;claims status awaiting resolution
+1 NEW IBDAX
+2 DO EN^IBCECSA
+3 IF $DATA(IBFASTXT)
KILL IBFASTXT
+4 SET VALMBCK="R"
+5 QUIT
+6 ;
RVEOB ;Review EOB
+1 DO FULL^VALM1
WRITE !
+2 NEW IBDA,IBIFN,IBCMT,IBSEL
+3 DO SEL(.IBDA,1)
+4 SET IBSEL=+$ORDER(IBDA(0))
+5 SET IBDA=$GET(IBDA(IBSEL))
+6 SET IBIFN=$PIECE(IBDA,U)
SET IBDA=$PIECE(IBDA,U,3)
+7 IF 'IBIFN
GOTO VEOBQ
+8 SET IBCMT=$GET(^TMP("IBCECOB1",$JOB,IBSEL))
+9 IF IBCMT'=""
DO EN^VALM("IBCEM MRA REVIEW")
VEOBQ KILL ^TMP("IBCECOC",$JOB)
+1 SET VALMBCK="R"
+2 QUIT
+3 ;
TPJI ;Third Party joint Inquiry
+1 NEW IBDA,IBIFN
+2 DO SEL(.IBDA,1)
+3 SET IBDA=+$ORDER(IBDA(0))
SET IBIFN=+$GET(IBDA(IBDA))
+4 IF IBDA=""
GOTO TPJIQ
+5 DO TPJI1(IBIFN)
TPJIQ SET VALMBCK="R"
+1 QUIT
+2 ;
TPJI1(IBIFN) ;
+1 NEW DFN,IBNOTPJI
+2 if 'IBIFN
QUIT
+3 SET DFN=$PIECE($GET(^DGCR(399,IBIFN,0)),U,2)
SET IBNOTPJI=1
+4 DO EN^VALM("IBJT CLAIM INFO")
+5 if $DATA(IBFASTXT)
KILL IBFASTXT
+6 QUIT
+7 ;
PBILL ;Print bill
+1 NEW IBIFN,IBDA,IBRESUB
+2 DO SEL(.IBDA,1)
+3 SET IBDA=$ORDER(IBDA(0))
SET IBIFN=+$GET(IBDA(+IBDA))
+4 IF IBDA=""
GOTO PBOUT
+5 SET IBRESUB=$$RESUB^IBCECSA4(IBIFN,1,"P")
+6 IF IBRESUB'>0
WRITE !,*7,"This is not a transmittable bill or review not needed"
DO PAUSE^VALM1
GOTO PBOUT
+7 IF IBRESUB=2
Begin DoDot:1
+8 NEW IB364
+9 SET IB364=+$PIECE($GET(IBDA(IBDA)),U,2)
+10 DO PRINT1^IBCEM03(IBIFN,.IBDA,IB364)
End DoDot:1
GOTO PBOUT
+11 ;WCJ;US3380MODIFIED THIS LINE BUT WHY???
DO PBILL1(IBIFN,.IBRESULT)
PBOUT SET VALMBCK="R"
+1 QUIT
+2 ;
PMRA ;Print MRA
+1 NEW IBIFN,IBDA,IBDAX
+2 DO SEL(.IBDA,1)
+3 ;IB*2.0*592 JRA Fix <UNDEFINED> error occurring when IBDA(+IBDA) does not exist. Also, ensure that IBDAX'=""
+4 ; since it's used as a subscript to ^IBM.
+5 ;S IBDA=$O(IBDA(0)),IBIFN=+$G(IBDA(+IBDA)),IBDAX=$P(IBDA(+IBDA),U,3) ;IB*2.0*592 JRA ';'
+6 ;IB*2.0*592 JRA Add $G to SET of IBDAX and +$P
SET IBDA=$ORDER(IBDA(0))
SET IBIFN=+$GET(IBDA(+IBDA))
SET IBDAX=+$PIECE($GET(IBDA(+IBDA)),U,3)
+7 if 'IBIFN
GOTO PRMQ
+8 ; Claim contains Message Storage Errors
IF '$GET(IBMRANOT)
IF $DATA(^IBM(361.1,IBDAX,"ERR"))
IF '$$WARNMSE
GOTO PRMQ
+9 DO MRA^IBCEMRAA(.IBIFN)
PRMQ SET VALMBCK="R"
+1 QUIT
PBILL1(IBIFN,IBRESULT) ;WCJ;IB641;US3380;added IBRESULT parameter
+1 NEW IBAC1,IBAC,DFN
+2 ;WCJ;IB641;US3380;default IBRESULT to 0 (not yet successful)
SET IBRESULT=0
+3 if 'IBIFN
QUIT
+4 SET DFN=$PIECE($GET(^DGCR(399,IBIFN,0)),U,2)
+5 SET IBAC=4
SET IBAC1=1
+6 ;D 4^IBCB1
+7 ; WCJ;IB641;US3380;added parameter to show whether it actually got printed
DO ALT4^IBCB1(.IBRESULT)
+8 DO FULL^VALM1
DO PAUSE^VALM1
+9 QUIT
+10 ;
CANCEL ;Cancel bill
+1 ; IBDA(IBDA)=IBIFN^IB364^ien of 361.1^user selection seq^user name~duz#
+2 ;
+3 NEW IBIFN,IBDA,IB364,IBEOBIFN,X,IBDENCT
+4 ;
+5 ; Check for security key
+6 IF '$$KCHK^XUSRB("IB AUTHORIZE")
Begin DoDot:1
+7 DO FULL^VALM1
SET VALMBCK="R"
+8 WRITE !!?5,"You don't hold the proper security key to access this function."
+9 WRITE !?5,"The necessary key is IB AUTHORIZE. Please see your manager."
+10 DO PAUSE^VALM1
+11 QUIT
End DoDot:1
GOTO CANCELQ
+12 ;
+13 DO SEL(.IBDA,1)
+14 SET IBDA=$ORDER(IBDA(0))
SET IBIFN=+$GET(IBDA(+IBDA))
SET IB364=$PIECE($GET(IBDA(+IBDA)),U,2)
+15 SET IBEOBIFN=$PIECE($GET(IBDA(+IBDA)),U,3)
+16 ;
+17 ; IB*2.0*432 - if not mra, only allow cancel of denied claims. If no EOB, check AR status instead
+18 IF 'IBEOBIFN
IF $GET(IBMRANOT)=1
IF $PIECE($$ARSTATA^IBJTU4(IBIFN),U)="COLLECTED/CLOSED"
Begin DoDot:1
+19 DO FULL^VALM1
SET VALMBCK="R"
+20 WRITE !!,*7,"You can only cancel denied claims. This claim is in a COLLECTED/CLOSED status"
+21 WRITE !,"Use Remove Action to remove claim from this worklist."
+22 DO PAUSE^VALM1
+23 QUIT
End DoDot:1
GOTO CANCELQ
+24 ;
+25 ; IB*2.0*432 - if not mra, only allow cancel of claims with multiple EOBS if none have processed.
+26 IF $GET(IBMRANOT)=1
IF '$$DENCHK(IBIFN,.IBDENCT)
IF $GET(IBDENCT)>1
Begin DoDot:1
+27 DO FULL^VALM1
SET VALMBCK="R"
+28 WRITE !!,*7,"Multiple EOBs exist for this claim and at least one has EOB status of PROCESSED."
+29 WRITE !,"Use Remove Action to remove claim from this worklist."
+30 DO PAUSE^VALM1
+31 QUIT
End DoDot:1
GOTO CANCELQ
+32 ;
+33 ; IB*2.0*432 - if not mra, only allow cancel of denied claims
+34 IF IBEOBIFN
IF $GET(IBMRANOT)=1
IF $PIECE($GET(^IBM(361.1,IBEOBIFN,0)),U,13)'=2
Begin DoDot:1
+35 DO FULL^VALM1
SET VALMBCK="R"
+36 WRITE !!?5,*7,"You can only cancel denied claims."
+37 DO PAUSE^VALM1
+38 QUIT
End DoDot:1
GOTO CANCELQ
+39 ;
+40 ;WCJ;IB727;check to see if all lines are covered in the MRA
+41 NEW IBRETSPLT
+42 IF '$GET(IBMRANOT)
IF $$SPLIT^IBCEMU1(IBEOBIFN)
IF $$SPLIT2^IBCEMU1(IBEOBIFN)=0!($$SPLIT2^IBCEMU1(IBEOBIFN)=-1&($$SPLTMRA^IBCEMU1(IBIFN,.IBRETSPLT)<2))
Begin DoDot:1
+43 DO FULL^VALM1
SET VALMBCK="R"
+44 WRITE !!?5,"All claim lines must be adjudicated before cancelling a split claim."
+45 DO PAUSE^VALM1
End DoDot:1
GOTO CANCELQ
+46 ;
+47 IF IBDA
Begin DoDot:1
+48 IF '$$LOCK^IBCEU0(361.1,IBEOBIFN)
QUIT
+49 DO CANCEL^IBCEM3(.IBDA,IBIFN,IB364)
+50 DO UNLOCK^IBCEU0(361.1,IBEOBIFN)
End DoDot:1
+51 SET VALMBCK="R"
+52 ;
+53 ; for non-MRA claims cancelled from worklist, set field 38
+54 IF $GET(IBMRANOT)=1
IF $PIECE($GET(^DGCR(399,IBIFN,0)),U,13)=7
SET X=$$WLRMVF^IBCECOB1($SELECT($GET(IBIFN)'="":IBIFN,1:+$GET(IBDA(IBDA))),"CA")
+55 IF $GET(IBDA)'=""
DO BLD^IBCECOB1
CANCELQ QUIT
+1 ;
CRD ; Correct Rejected/Denied claim protocol action
+1 NEW IBCNCRD
+2 SET IBCNCRD=1
CLONE ; 'Copy/cancel bill' protocol action
+1 ;N IBDA,IBQ,IBEOBIFN,IBKEY,X,IBDENCT
+2 ;WCJ;IB727
NEW IBDA,IBQ,IBEOBIFN,IBKEY,X,IBDENCT,IBIFN
+3 ;
+4 ; Check for security key
+5 ;IB*2.0*516/TAZ - Remove check for IB CLON
+6 ;I '$$KCHK^XUSRB("IB AUTHORIZE") D G CLONEQ
+7 ;S IBKEY=$S($G(IBCNCRD)=1:"IB AUTHORIZE",1:"IB CLON")
+8 SET IBKEY="IB AUTHORIZE"
+9 IF '$$KCHK^XUSRB(IBKEY)
Begin DoDot:1
+10 DO FULL^VALM1
SET VALMBCK="R"
+11 ;W !!?5,"You don't hold the proper security key to access this function."
+12 ;W !?5,"The necessary key is IB AUTHORIZE. Please see your manager."
+13 WRITE !!?5,"You must hold the "_IBKEY_" security key to access this function."
+14 WRITE !?5,"Please see your manager."
+15 DO PAUSE^VALM1
+16 QUIT
End DoDot:1
GOTO CLONEQ
+17 ;
+18 DO SEL(.IBDA,1)
+19 ;S IBDA=$O(IBDA(""))
+20 ; IB727
SET IBDA=$ORDER(IBDA(0))
SET IBIFN=+$GET(IBDA(+IBDA))
+21 IF IBDA=""
GOTO CLONEQ
+22 ;
+23 ; IB*2.0*432 - if not mra, only allow cancel of claims with multiple EOBS if none have processed.
+24 IF $GET(IBMRANOT)=1
IF '$$DENCHK(+IBDA(IBDA),.IBDENCT)
IF $GET(IBDENCT)>1
Begin DoDot:1
+25 DO FULL^VALM1
SET VALMBCK="R"
+26 WRITE !!,*7,"Multiple EOBs exist for this claim and at least one has EOB status of PROCESSED."
+27 WRITE !,"Use Remove Action to remove claim from this worklist."
+28 DO PAUSE^VALM1
+29 QUIT
End DoDot:1
GOTO CANCELQ
+30 ;
+31 ;WCJ;IB727;check to see if all lines are covered in the MRA
+32 NEW IBEOBIFN,IBRETSPLT
+33 SET IBEOBIFN=$PIECE($GET(IBDA(+IBDA)),U,3)
+34 IF '$GET(IBMRANOT)
IF $$SPLIT^IBCEMU1(IBEOBIFN)
IF $$SPLIT2^IBCEMU1(IBEOBIFN)=0!($$SPLIT2^IBCEMU1(IBEOBIFN)=-1&($$SPLTMRA^IBCEMU1(IBIFN,.IBRETSPLT)<2))
Begin DoDot:1
+35 DO FULL^VALM1
SET VALMBCK="R"
+36 WRITE !!?5,"All claim lines must be adjudicated before "_$SELECT($GET(IBCNCRD):"crd'ing",1:" cloning")_" a split claim."
+37 DO PAUSE^VALM1
End DoDot:1
GOTO CLONEQ
+38 ;
+39 SET IBEOBIFN=$PIECE($GET(IBDA(+IBDA)),U,3)
+40 IF '$$LOCK^IBCEU0(361.1,IBEOBIFN)
GOTO CLONEQ
+41 DO COPYCLON(+$GET(IBDA(IBDA)),$PIECE($GET(IBDA(+IBDA)),U,2),.IBQ)
+42 DO UNLOCK^IBCEU0(361.1,IBEOBIFN)
+43 ;
+44 ; for non-MRA claims cloned or corrected from worklist, set field 38
+45 IF $GET(IBMRANOT)=1
IF $GET(IBQ)'=""
SET X=$$WLRMVF^IBCECOB1(+$GET(IBDA(IBDA)),$SELECT($GET(IBCNCRD)=1:"CR",1:"CL"))
+46 ;
CLONEQ ;
+1 SET VALMBCK="R"
+2 if $GET(IBQ)'=""
DO BLD^IBCECOB1
+3 QUIT
+4 ;
COPYCLON(IBIFN,IB364,IBQ) ; Generic entry point for clone a bill from EDI processing
+1 ; IBIFN = original bill ien
+2 ; IB364 = the ien of the transmission bill entry in file 364
+3 ; IBQ = If bill is not cancelled, this is returned as null
+4 ; - pass by reference -
+5 ;
+6 NEW IBQUIT,IBCCCC,IBHV,Y,IBCAN,IBCE,IBDA,IBCNCOPY
+7 ;I '$$CANCKS^IBCEM3("CC",IBIFN) S IBQ="" G CCQ
+8 IF $GET(IBCNCRD)'=1
IF '$$CANCKS^IBCEM3("CC",IBIFN)
SET IBQ=""
GOTO CCQ
+9 ;
+10 ;S IBCAN=2,IBCE("EDI")=1,Y=IBIFN,IBCCCC=0,IBHV("IBIFN")=IBIFN,IBHV("IBIFN1")="",IBCNCOPY=1
+11 SET IBCAN=2
SET IBCE("EDI")=1
SET Y=IBIFN
SET IBCCCC=0
SET IBHV("IBIFN")=IBIFN
SET IBHV("IBIFN1")=""
+12 IF $GET(IBCNCRD)'=1
SET IBCNCOPY=1
DO ^IBCCC
+13 IF $GET(IBCNCRD)=1
DO CRD^IBCCC
+14 ;D ^IBCCC
+15 SET IBIFN=IBHV("IBIFN")
+16 KILL IBCE("EDI")
SET IBQ=1
+17 IF $PIECE($GET(^DGCR(399,IBIFN,0)),U,13)'=7
SET IBQ=""
+18 IF IBHV("IBIFN1")
Begin DoDot:1
+19 NEW IBU
+20 SET IBU="R"
+21 SET IBNIEN=+IBHV("IBIFN1")
+22 IF "23"'[$PIECE($GET(^DGCR(399,+IBHV("IBIFN1"),0)),U,13)
Begin DoDot:2
+23 if '$GET(IBCEAUTO)
WRITE !,*7,"Please note: the new bill was not AUTHORIZED.",!,"It can only be accessed now via the normal, non-EDI functions.",!,"Status of new bill is ",$$EXPAND^IBTRE(399,.13,$PIECE(^DGCR(399,IBHV("IBIFN1"),0),U,13))
SET IBU="C"
End DoDot:2
+24 DO UPDEDI^IBCEM(IB364,IBU)
End DoDot:1
+25 ;
+26 IF '$GET(IBCEAUTO)
DO PAUSE^VALM1
CCQ QUIT
+1 ;
PRO ; Copy for secondary/tertiary bill
+1 NEW VALMY,IBDA,Z,IBIFN,IBIFNH,IB364,IBCE,IBNCN
+2 ;I '$P($G(^IBE(350.9,1,8)),U,12) D G PROQ
+3 IF '$PIECE($GET(^IBE(350.9,1,8)),U,12)
IF $GET(IBMRANOT)'=1
Begin DoDot:1
+4 DO FULL^VALM1
+5 WRITE !!?5,"MRA's may not be processed at this time."
+6 WRITE !?5,"The IB site parameter ""Allow MRA Processing?"" is set to NO."
+7 DO PAUSE^VALM1
+8 QUIT
End DoDot:1
GOTO PROQ
+9 DO SEL(.IBDA,1)
+10 SET Z=$ORDER(IBDA(0))
SET Z=$GET(IBDA(+Z))
if 'Z
GOTO PROQ
+11 SET IBIFN=$PIECE(Z,U)
SET IB364=$PIECE(Z,U,2)
SET IBDA=$PIECE(Z,U,3)
SET IBIFNH=IBIFN
+12 ;WCJ;IB727 v17
NEW IBEOBIFN
+13 ;WCJ;IB727 v17
SET IBEOBIFN=IBDA
+14 IF 'IBIFN
GOTO PROQ
+15 ; Claim contains Message Storage Errors
IF '$GET(IBMRANOT)
IF $DATA(^IBM(361.1,IBDA,"ERR"))
IF '$$WARNMSE
GOTO PROQ
+16 ;
+17 ;I $G(IBMRANOT),($$GET1^DIQ(399,IBIFN_",",36,"","","")="IB803"),'$$WARNIBMRANOT G PROQ ;TPF;EBILL-2436;IB*2.0*727
+18 ;TPF;EBILL-3061;IB*2.0*727 v15
IF $GET(IBMRANOT)
IF $$FILERR^IBCAPP2(IBIFN)
IF '$$WARNIBMRANOT
GOTO PROQ
+19 ;
+20 ;WCJ;IB727;check to see if all lines are covered in the MRA
+21 ;N IBEOBIFN,IBRETSPLT ;WCJ;IB727 v17
NEW IBRETSPLT
+22 ;S IBEOBIFN=$P($G(IBDA(+IBDA)),U,3) ;WCJ;IB727 v17
+23 IF '$GET(IBMRANOT)
IF $$SPLIT^IBCEMU1(IBEOBIFN)
IF $$SPLIT2^IBCEMU1(IBEOBIFN)=0!($$SPLIT2^IBCEMU1(IBEOBIFN)=-1&($$SPLTMRA^IBCEMU1(IBIFN,.IBRETSPLT)<2))
Begin DoDot:1
+24 DO FULL^VALM1
SET VALMBCK="R"
+25 WRITE !!?5,"All claim lines must be adjudicated before processing a split claim to subsequent payer."
+26 DO PAUSE^VALM1
End DoDot:1
GOTO PROQ
+27 ;
+28 IF '$$LOCK^IBCEU0(361.1,IBDA)
GOTO PROQ
+29 DO COBCOPY(IBIFN,IB364,2,IBDA,"BLD^IBCECOB1",.IBNCN)
+30 DO UNLOCK^IBCEU0(361.1,IBDA)
+31 ;
+32 ; for non-MRA claims copied from work list, set field 38
+33 IF $GET(IBMRANOT)=1
IF $GET(IBNCN)'=""
IF ($GET(IBNCN)'=$GET(IBIFN))
Begin DoDot:1
+34 SET X=$$WLRMVF^IBCECOB1($GET(IBIFN),"PC")
+35 ;I $P($G(^DGCR(399,+IBNCN,"S")),U,9)'=1 D
+36 ;.W:'$G(IBCEAUTO) !,*7,"Please note: the new bill was not AUTHORIZED.",!,"It can only be accessed now via the normal, non-EDI functions.",!,"Status of new bill is ",$$EXPAND^IBTRE(399,.13,$P(^DGCR(399,IBNCN,0),U,13))
+37 ;.D PAUSE^VALM1
+38 if $GET(IBMRANOT)=1
DO BLD^IBCECOB1
+39 QUIT
End DoDot:1
+40 ;
PROQ SET VALMBCK="R"
+1 QUIT
+2 ;
COBCOPY(IBIFN,IB364,IBFROM,IBIEN,IBBLD,IBNCN) ; Generic entry point for EDI COB copy
+1 ; IBIFN = original bill ien
+2 ; IB364 = the ien of the transmission bill entry in file 364
+3 ; IBFROM = 1 if called from CSA, 2 if called from COB/EOB processing
+4 ; IBIEN = entry in 361 (IBFROM=1) or 361.1 (IBFROM=2) being processed
+5 ; IBBLD = the name of the entrypoint that will rebuild the display
+6 ; IBNCN = by reference, returns the new claim ien if user completed the Copy process
+7 ;
+8 NEW IBCBASK,IBCBCOPY,IBCAN,IBIFNH,IBNSTAT,IBOSTAT,IBPRCOB,IBSECHK,IBLMVAR,IBAC,IBMRAIEN,IBDA,IBAUTO
+9 NEW IBCOB,IBCOBIL,IBCOBN,IBINS,IBINSN,IBINSOLD,IBMRAIO,IBMRAO,IBNMOLD,IBQUIT
+10 SET (IBCBASK,IBCBCOPY,IBCAN,IBAUTO)=1
SET (IBPRCOB,IBSECHK)=0
SET (IBMRAIEN,IBDA)=IBIEN
+11 IF $GET(IBMRANOT)'=1
IF 'IB364!'IBIFN
WRITE !,"Transmission record is missing for this bill"
DO PAUSE^VALM1
GOTO COBCOPX
+12 ;
+13 SET IBIFNH=IBIFN
+14 IF IBFROM=2
SET IBPRCOB=1
+15 ; IB*2.0*447 Check PR to include excess and percentages where applicable
+16 ;I $S($G(IBMRANOT)=1:$$TOT(IBIFN)'>0,1:$$PREOBTOT^IBCEU0(IBIFN,$G(IBMRANOT))'>0) D G COBCOPX
+17 IF $$TOT(IBIFN,$GET(IBMRANOT))'>0
Begin DoDot:1
+18 DO FULL^VALM1
+19 WRITE !!?5,"There is no "_$SELECT($GET(IBMRANOT)=1:"balance remaining",1:"patient responsibility and/or excess charges")_" for this claim."
+20 WRITE !?5,"This claim may not be processed."
+21 DO PAUSE^VALM1
+22 QUIT
End DoDot:1
GOTO COBCOPX
+23 ;
+24 IF $GET(IBDA)'=""
IF $PIECE($GET(^IBM(361.1,IBDA,0)),U,16)="1.5"
Begin DoDot:1
+25 WRITE !!,"This claim has already been processed as a sec/tert claim."
+26 WRITE !,"You will need to complete the authorization process for this claim."
+27 DO PAUSE^VALM1
+28 DO AUTH
+29 QUIT
End DoDot:1
GOTO COBCOPX
+30 ;
+31 ; If multiple EOBs and one is processed, make sure collected closed.
+32 IF $GET(IBMRANOT)
IF $$CCCHK(IBIFN)<0
Begin DoDot:1
+33 WRITE !,"Multiple EOBs exist for this claim and at least one has EOB status of PROCESSED."
+34 WRITE !,"Claim cannot be sent to next payer until AR status is Collected/Closed."
+35 DO PAUSE^VALM1
+36 QUIT
End DoDot:1
GOTO COBCOPX
+37 ;
+38 ; Get out if no next payer
+39 IF '$PIECE($GET(^DGCR(399,IBIFN,"I"_($$COBN^IBCEF(IBIFN)+1))),U,1)
Begin DoDot:1
+40 WRITE !,"There is no next payer for this bill"
+41 DO PAUSE^VALM1
+42 QUIT
End DoDot:1
GOTO COBCOPX
+43 ;
+44 ; display related bills
DO DSPRB^IBCCCB0(IBIFN)
+45 SET IBCE("EDI")=1
+46 ; process COB, create secondary bill
DO CHKB^IBCCCB
+47 ; get new claim ien
SET IBNCN=$GET(IBCE("EDI","NEW"))
+48 SET IBIFN=IBIFNH
+49 IF IBSECHK
GOTO COBCOPX
+50 ;
+51 ; if user came from CBW, no need to view and authorize a 2nd time (already happens in IBCCCB)
+52 if $GET(IBMRANOT)=1
QUIT
+53 ; display billing screens
SET IBV=1
DO VIEW^IBCB2
+54 ; authorize bill
DO AUTH
COBCOPX ;
+1 QUIT
+2 ;
AUTH ; procedure to authorize the claim and refresh the screen
+1 KILL ^UTILITY($JOB)
SET IBAC=1
SET IBQUIT=0
DO 3^IBCB1
+2 IF '$DATA(IOUON)!'$DATA(IORVON)
DO ENS^%ZISS
+3 IF $PIECE($GET(^IBM(361.1,IBMRAIEN,0)),U,16)=3
DO UPDEDI^IBCEM(IB364,"Z")
+4 IF $GET(IBBLD)'=""
DO @IBBLD
+5 DO PAUSE^VALM1
AUTHX ;
+1 QUIT
+2 ;
RES ;Resubmit bill by print
+1 NEW IBDA,IBIFN,IB364
+2 DO SEL(.IBDA,1)
+3 SET IBDA=+$ORDER(IBDA(0))
SET IBIFN=+$GET(IBDA(+IBDA))
SET IB364=+$PIECE($GET(IBDA(IBDA)),U,2)
+4 IF 'IBIFN
GOTO RESQ
+5 DO PRINT1^IBCEM03(IBIFN,.IBDA,IB364)
+6 DO PAUSE^VALM1
+7 IF $GET(IBDA)'=""
DO BLD^IBCECOB1
RESQ SET VALMBCK="R"
+1 QUIT
+2 ;
EBI ;View an unauthorized transmitted bill
+1 NEW IBFLG,IBDA,IBIFN,IB364,DFN
+2 KILL ^TMP($JOB,"IBBILL")
+3 DO FULL^VALM1
+4 ;
+5 DO SEL(.IBDA,1)
+6 SET IBDA=+$ORDER(IBDA(""))
+7 SET IBIFN=+$GET(IBDA(IBDA))
SET IB364=+$PIECE($GET(IBDA(IBDA)),U,2)
SET DFN=$PIECE($GET(^DGCR(399,IBIFN,0)),U,2)
+8 if 'IBIFN
GOTO EDITQ
+9 SET IBV=1
DO VIEW^IBCB2
+10 IF '$DATA(IOUON)!'$DATA(IORVON)
DO ENS^%ZISS
+11 DO BLD^IBCECOB1
EDITQ SET VALMBCK="R"
+1 QUIT
+2 ;
SEL(IBDA,ONE) ; Select entry(s) from list
+1 ; IBDA = array returned if selections made
+2 ; IBDA(n)=ien of bill selected (file 399)
+3 ; ONE = if set to 1, only one selection can be made at a time
+4 NEW IB
+5 KILL IBDA
+6 DO FULL^VALM1
+7 DO EN^VALM2($GET(XQORNOD(0)),$SELECT('$GET(ONE):"",1:"S"))
+8 SET IBDA=0
FOR
SET IBDA=$ORDER(VALMY(IBDA))
if 'IBDA
QUIT
SET IBDA(IBDA)=$PIECE($GET(^TMP("IBCECOB",$JOB,+IBDA)),U,2,6)
+9 QUIT
+10 ;
EXIT ; Exit out of COB
+1 DO FASTEXIT^IBCEFG4
+2 IF $GET(IBFASTXT)=1
SET IBFASTXT=5
+3 QUIT
+4 ;
TOT(IBIFN,IBMRANOT) ; calculate if any balance remaining on non-MRA claim
+1 ; IBIFN = claim ien
+2 ; IBMRANOT = MRW/CBW flag (1=user came from CBW) added with IB*2.0*447
+3 NEW IBPRTOT,IBBLD,IBCBN,IBU2
+4 IF $GET(IBMRANOT)'=1
QUIT $SELECT($$MSEDT^IBCEMU4(IBIFN)'="":$$MSPRE^IBCEMU4(IBIFN),1:$$PREOBTOT^IBCEU0(IBIFN))
+5 ; total up the payer paid amounts, if this is a 2ndary claim, be sure to account for what the primary paid also
+6 SET IBU2=$GET(^DGCR(399,IBIFN,"U2"))
SET IBCBN=$$COBN^IBCEF(IBIFN)
SET IBPRTOT=$$EOBTOT^IBCEU1(IBIFN,IBCBN)
+7 ; don't allow negative prior payment or offset
if IBPRTOT<0
SET IBPRTOT=0
+8 if IBCBN=2
SET IBPRTOT=IBPRTOT+$PIECE(IBU2,U,4)
+9 if IBCBN=3
SET IBPRTOT=IBPRTOT+$PIECE(IBU2,U,4)+$PIECE(IBU2,U,5)
+10 ; don't allow negative prior payment or offset
if IBPRTOT<0
SET IBPRTOT=0
+11 ; Subtract payer paid amount from Total Charges from BILLS/CLAIMS (#399) file, don't allow neg
+12 SET IBBLD=$PIECE($GET(^DGCR(399,IBIFN,"U1")),U,1)-IBPRTOT
+13 if IBBLD<0
SET IBBLD=0
+14 QUIT IBBLD
+15 ;
CCCHK(IBIFN) ; If there are multiple EOBS on file for this claim, then one of them must be processed and AR status must be collected closed to process.
+1 ; returns 1 if true
+2 ; 0 if there are not multiple EOBs or mulitple EOBs and none are processed (all denials)
+3 ; -1 if false
+4 NEW IBDA,IBCT,IBPROC,IBARSTAT,IBEOBNDX,IBEOB
+5 SET IBCT=0
SET IBPROC=0
+6 FOR IBEOBNDX="B","C"
Begin DoDot:1
+7 SET IBDA=0
FOR
SET IBDA=$ORDER(^IBM(361.1,IBEOBNDX,IBIFN,IBDA))
if '+IBDA
QUIT
Begin DoDot:2
+8 if $DATA(IBEOB(IBDA))
QUIT
+9 ; only count EOBs
if $PIECE($GET(^IBM(361.1,IBDA,0)),U,4)=1
QUIT
+10 SET IBEOB(IBDA)=""
SET IBCT=IBCT+1
+11 IF $PIECE($GET(^IBM(361.1,IBDA,0)),U,13)=1
SET IBPROC=1
End DoDot:2
End DoDot:1
+12 ; less than 2 EOBs
IF IBCT<2
QUIT 0
+13 ; no EOBs with status processed
IF 'IBPROC
QUIT 0
+14 ; get status of AR
SET IBARSTAT=$$ARSTATA^IBJTU4(IBIFN)
+15 IF $PIECE(IBARSTAT,U)="COLLECTED/CLOSED"
QUIT 1
+16 QUIT -1
+17 ;
DENCHK(IBIFN,IBCT) ; Make sure all EOBs from this claim are denied.
+1 ; Input: IBIFN - IEN to 399
+2 ; IBCT - by reference. Return count of EOBs.
+3 ; Output: returns 1 if there is at least one EOB and that none of the EOBS are processed.
+4 ; otherwise 0
+5 ;
+6 NEW IBDA,IBPROC,IBEOBNDX,IBEOB
+7 SET IBCT=0
SET IBPROC=0
+8 FOR IBEOBNDX="B","C"
Begin DoDot:1
+9 SET IBDA=0
FOR
SET IBDA=$ORDER(^IBM(361.1,IBEOBNDX,IBIFN,IBDA))
if '+IBDA
QUIT
Begin DoDot:2
+10 if $DATA(IBEOB(IBDA))
QUIT
+11 ; only count EOBs
if $PIECE($GET(^IBM(361.1,IBDA,0)),U,4)=1
QUIT
+12 SET IBEOB(IBDA)=""
SET IBCT=IBCT+1
+13 IF $PIECE($GET(^IBM(361.1,IBDA,0)),U,13)=1
SET IBPROC=1
End DoDot:2
End DoDot:1
+14 ; there is at least one EOB and none of the EOBS are processed.
IF IBCT
IF 'IBPROC
QUIT 1
+15 ;
QUIT 0
+16 ;
WARNMSE() ; Display MSE Warning and check if we should continue.
+1 DO FULL^VALM1
+2 NEW DIR,X,Y
+3 SET DIR("A",1)="WARNING : The MRA for this claim caused a Data Mismatch/Message Storage Error."
+4 SET DIR("A",2)="If you continue, the secondary claim may not contain the correct data."
+5 SET DIR("A")="Do you wish to continue? "
SET DIR("B")="NO"
SET DIR(0)="YA"
DO ^DIR
+6 ; Okay to continue.
IF Y>0
QUIT 1
+7 ;
QUIT 0
+8 ;
WARNIBMRANOT() ;TPF;EBILL-2436;IB*2.0*727;WCJ-lessened to warning
+1 DO FULL^VALM1
+2 NEW DIR,X,Y
+3 SET DIR("A",1)="WARNING: An EOB/MRA for this claim caused a Data Mismatch/Message Storage Error."
+4 SET DIR("A",2)="If you continue, the subsequent claim may not contain the correct data."
+5 SET DIR("A")="Do you wish to continue? "
SET DIR("B")="NO"
SET DIR(0)="YA"
DO ^DIR
+6 ; Okay to continue.
IF Y>0
QUIT 1
+7 ;
QUIT 0
+8 ;
+9 DO FULL^VALM1
+10 WRITE !!,"WARNING: An EOB for this Claim has an MSE error and cannot be processed."
+11 NEW DIR
+12 SET DIR(0)="E"
+13 DO ^DIR
+14 QUIT 0
