IBY727PO ;EDE/TPF - POST INSTALL ROUTINE FOR IB*2.0*727
;;2.0;INTEGRATED BILLING;**727**;;Build 34
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;
POST ;EP - POST INSTALL TO REMOVE EOB CLAIMS WITH MSE ERRORS FROM WORKLIST
Q:(($P($$SITE^VASITE,U,3)=683)!(($P($$SITE^VASITE,U,3)=684)))&'($$PROD^XUPROD(1))
N IBIENS,IBFDA,IBIFN
S IBIFN=0
F S IBIFN=$O(^DGCR(399,"CAP",1,IBIFN)) Q:'IBIFN D
.;Q:'($$GET1^DIQ(399,IBIFN_",",36,"","","")="IB803") ;TPF;EBILL-;IB*2.0*727 V14
.Q:$$MELG(IBIFN,1) ;IF TRUE CLAIM SHOULD BE ON THE WORKLIST;TPF;EBILL-3054;IB*2.0*727 v15
.S X=$$WLRMVF^IBCECOB1(IBIFN,"RM",1)
Q
;
;This is the original MELG without the quit commented out in p727
MELG(IBIFN,IBMRADUP) ; function to check all EOBs for a claim and determine if they are
; eligible for inclusion on the COB management worklist, uses both B & C x-ref
; IBIFN - claim ien (required)
; IBMRADUP - indicates user said NO to "include denied for duplicate" prompt
;
; Returns EOB ien to use for display, if at least 1 EOB passed all checks
; if multiple EOBs passed but some have filing errors, returns the 1st EOB found that does NOT have filing errors
; if all EOBs have filing errors, tries to find one that is a PROCESSED status and return that one for CBW display
; Returns -1 if claim should appear on the worklist with no EOB
; Returns 0 if no EOBs passed the checks and claim should not appear on the worklist, also removes it
;
; IBCK = Total number of EOBs found for this claim ien
; IBECT = Total number of EOBs that failed the EOB TYPE check
; IBCT = Total number of EOBs for a claim that passed ALL the checks
;
N IBDA,IBCT,IBEOBNDX,IBEOB,IB3611,IBCK,IBETC
S IBCT=0,IBCK=0,IBETC=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))
..S IB3611=$G(^IBM(361.1,IBDA,0)),IBCK=IBCK+1
..Q:$D(^IBM(361.1,IBDA,"ERR")) ;TPF;EBILL-3054;IB*2.0*727 v15
..; if this is a denied EOB and user does NOT want to include denied as duplicates and this EOB was denied as duplicate, don't include
..I $P(IB3611,U,13)=2,'$G(IBMRADUP),$$DENDUP^IBCEMU4(IBDA,1) Q
..; eob type must be correct for this worklist
..I $P(IB3611,U,4)=1 S IBETC=IBETC+1 Q
..; allow filing errors on worklist, but try to find at least 1 Processed EOB w/out errors
..I $D(^IBM(361.1,IBDA,"ERR")) S:$P($G(^IBM(361.1,IBDA,0)),U,13)'=1 IBEOB("DER",IBDA)="" S:$P($G(^IBM(361.1,IBDA,0)),U,13)=1 IBEOB("PER",IBDA)="" Q
..S IBEOB(IBDA)="",IBCT=IBCT+1
; if no EOB was found to check, return -1 to process as no EOB
Q:IBCK=0 -1
; if no EOB passed, check to see if the EOBs were all MRA primaries that failed the EOB type check (2ndary/tertiaries were paper)
I IBCT=0,$$WNRBILL^IBEFUNC(IBIFN,1),$$COBN^IBCEF(IBIFN)>1,(IBCK=IBETC) Q -1
; if no EOB's passed, check for filing errors and use that EOB, with Processed EOB's taking priority over denied
I IBCT=0,$D(IBEOB("PER")) Q $O(IBEOB("PER",0))
I IBCT=0,$D(IBEOB("DER")) Q $O(IBEOB("DER",0))
; if no EOB passed and not MRA primary w/subsequent paper EOB's or filing errors, do not put on CBW
Q:IBCT=0 0
; if one or more EOBs passed, return the 1st one that passed the checks as the one to use for CBW display
Q $O(IBEOB(0))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY727PO 3314 printed Dec 13, 2024@02:35:13 Page 2
IBY727PO ;EDE/TPF - POST INSTALL ROUTINE FOR IB*2.0*727
+1 ;;2.0;INTEGRATED BILLING;**727**;;Build 34
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;
POST ;EP - POST INSTALL TO REMOVE EOB CLAIMS WITH MSE ERRORS FROM WORKLIST
+1 if (($PIECE($$SITE^VASITE,U,3)=683)!(($PIECE($$SITE^VASITE,U,3)=684)))&'($$PROD^XUPROD(1))
QUIT
+2 NEW IBIENS,IBFDA,IBIFN
+3 SET IBIFN=0
+4 FOR
SET IBIFN=$ORDER(^DGCR(399,"CAP",1,IBIFN))
if 'IBIFN
QUIT
Begin DoDot:1
+5 ;Q:'($$GET1^DIQ(399,IBIFN_",",36,"","","")="IB803") ;TPF;EBILL-;IB*2.0*727 V14
+6 ;IF TRUE CLAIM SHOULD BE ON THE WORKLIST;TPF;EBILL-3054;IB*2.0*727 v15
if $$MELG(IBIFN,1)
QUIT
+7 SET X=$$WLRMVF^IBCECOB1(IBIFN,"RM",1)
End DoDot:1
+8 QUIT
+9 ;
+10 ;This is the original MELG without the quit commented out in p727
MELG(IBIFN,IBMRADUP) ; function to check all EOBs for a claim and determine if they are
+1 ; eligible for inclusion on the COB management worklist, uses both B & C x-ref
+2 ; IBIFN - claim ien (required)
+3 ; IBMRADUP - indicates user said NO to "include denied for duplicate" prompt
+4 ;
+5 ; Returns EOB ien to use for display, if at least 1 EOB passed all checks
+6 ; if multiple EOBs passed but some have filing errors, returns the 1st EOB found that does NOT have filing errors
+7 ; if all EOBs have filing errors, tries to find one that is a PROCESSED status and return that one for CBW display
+8 ; Returns -1 if claim should appear on the worklist with no EOB
+9 ; Returns 0 if no EOBs passed the checks and claim should not appear on the worklist, also removes it
+10 ;
+11 ; IBCK = Total number of EOBs found for this claim ien
+12 ; IBECT = Total number of EOBs that failed the EOB TYPE check
+13 ; IBCT = Total number of EOBs for a claim that passed ALL the checks
+14 ;
+15 NEW IBDA,IBCT,IBEOBNDX,IBEOB,IB3611,IBCK,IBETC
+16 SET IBCT=0
SET IBCK=0
SET IBETC=0
+17 FOR IBEOBNDX="B","C"
Begin DoDot:1
+18 SET IBDA=0
FOR
SET IBDA=$ORDER(^IBM(361.1,IBEOBNDX,IBIFN,IBDA))
if '+IBDA
QUIT
Begin DoDot:2
+19 if $DATA(IBEOB(IBDA))
QUIT
+20 SET IB3611=$GET(^IBM(361.1,IBDA,0))
SET IBCK=IBCK+1
+21 ;TPF;EBILL-3054;IB*2.0*727 v15
if $DATA(^IBM(361.1,IBDA,"ERR"))
QUIT
+22 ; if this is a denied EOB and user does NOT want to include denied as duplicates and this EOB was denied as duplicate, don't include
+23 IF $PIECE(IB3611,U,13)=2
IF '$GET(IBMRADUP)
IF $$DENDUP^IBCEMU4(IBDA,1)
QUIT
+24 ; eob type must be correct for this worklist
+25 IF $PIECE(IB3611,U,4)=1
SET IBETC=IBETC+1
QUIT
+26 ; allow filing errors on worklist, but try to find at least 1 Processed EOB w/out errors
+27 IF $DATA(^IBM(361.1,IBDA,"ERR"))
if $PIECE($GET(^IBM(361.1,IBDA,0)),U,13)'=1
SET IBEOB("DER",IBDA)=""
if $PIECE($GET(^IBM(361.1,IBDA,0)),U,13)=1
SET IBEOB("PER",IBDA)=""
QUIT
+28 SET IBEOB(IBDA)=""
SET IBCT=IBCT+1
End DoDot:2
End DoDot:1
+29 ; if no EOB was found to check, return -1 to process as no EOB
+30 if IBCK=0
QUIT -1
+31 ; if no EOB passed, check to see if the EOBs were all MRA primaries that failed the EOB type check (2ndary/tertiaries were paper)
+32 IF IBCT=0
IF $$WNRBILL^IBEFUNC(IBIFN,1)
IF $$COBN^IBCEF(IBIFN)>1
IF (IBCK=IBETC)
QUIT -1
+33 ; if no EOB's passed, check for filing errors and use that EOB, with Processed EOB's taking priority over denied
+34 IF IBCT=0
IF $DATA(IBEOB("PER"))
QUIT $ORDER(IBEOB("PER",0))
+35 IF IBCT=0
IF $DATA(IBEOB("DER"))
QUIT $ORDER(IBEOB("DER",0))
+36 ; if no EOB passed and not MRA primary w/subsequent paper EOB's or filing errors, do not put on CBW
+37 if IBCT=0
QUIT 0
+38 ; if one or more EOBs passed, return the 1st one that passed the checks as the one to use for CBW display
+39 QUIT $ORDER(IBEOB(0))
