IBCECOB ;ALB/CXW - IB COB MANAGEMENT SCREEN ;16-JUN-1999
;;2.0;INTEGRATED BILLING;**137,155,288,432,488,516,547,576,727**;21-MAR-94;Build 34
;;Per VA Directive 6402, this routine should not be modified.
;
EN ; -- main entry point for COB management
K IBSRT,IBMRADUP,IBSRCH
I $G(IBMRANOT) D EN^VALM("IBCEM COB MANAGEMENT") ;WCJ;IB*2.0*432
I '$G(IBMRANOT) D EN^VALM("IBCEM MRA MANAGEMENT") ;WCJ;IB*2.0*432
Q
;
HDR ; -- header code
;I '$G(IBMRANOT) S VALMSG="!=Data Mismatch/MSE Enter ?? for more actions"
I '$G(IBMRANOT) S VALMSG="!=Data Mismatch/MSE | *=Review in Process" ;IB*2*576 - vd
I $G(IBMRANOT) S VALMSG="!=Data Mismatch/MSE | *=Review in Process| ??=Help" ;TPF;EBILL-2436;IB*2.0*727
Q
;
INIT ; -- init variables and list array
N DIC,DIRUT,DIROUT,DTOUT,DUOUT,X,Y,DIR,IB1,IBQUIT
K ^TMP("IBBIL",$J),^TMP("IBBIL-DIV",$J)
S IBSRT=""
S IB1=1
W !
F S DIC="^VA(200,",DIC(0)="AEMQ",DIC("A")="Select "_$S('IB1:"Another ",1:"")_"BILLER: "_$S('IB1:"",1:"ALL//") D ^DIC K DIC D Q:Y<0
. Q:Y<0
. I $D(^TMP("IBBIL",$J,+Y)) W !,"This biller has already been selected" Q
. S ^TMP("IBBIL",$J,+Y)=""
. S IB1=0
I $D(DTOUT)!$D(DUOUT) S VALMQUIT=1 G INITQ
;
I '$G(IBMRANOT) G DIVX
;
DIV ; division
W !
S DIR(0)="SA^A:All Divisions;S:Selected Divisions"
S DIR("A")="Include All Divisions or Selected Divisions? "
S DIR("B")="All"
D ^DIR K DIR
I $D(DIROUT)!$D(DIRUT) S VALMQUIT=1 G INITQ ;Timeout or User "^"
I Y="A" G DIVX
;
W !
S IBQUIT=0
F D I IBQUIT S IBQUIT=IBQUIT-1 Q
. S DIC=40.8,DIC(0)="AEMQ",DIC("A")=" Select Division: "
. I $O(^TMP("IBBIL-DIV",$J,"")) S DIC("A")=" Select Another Division: "
. D ^DIC K DIC ; lookup
. I X="^^" S IBQUIT=2 Q ; user entered ^^
. I +Y'>0 S IBQUIT=1 Q ; user is done
. S ^TMP("IBBIL-DIV",$J,+Y)=$P(Y,U,2)
. Q
;
I IBQUIT S VALMQUIT=1 G INITQ ;User "^" out of the selection
;
I '$O(^TMP("IBBIL-DIV",$J,"")) D G DIV
. W *7,!!?3,"No divisions have been selected. Please try again."
. Q
;
DIVX ; Exit Division selection.
;
W !
I '$G(IBMRANOT) S DIR("A")="Within Division " G SRT
;
CLM ; patch 547 - new claim prompt for CBW
;
S DIR("A")="(P)rimary Claims,(S)econdary Claims or (B)oth: ",DIR("B")="Both"
S DIR(0)="SBA^P -:Primary Claims;S -:Secondary Claims;B -:Both"
S DIR("?")="This field determines whether you want to search for just primary claims, just secondary/tertiary claims or both."
D ^DIR K DIR S DIR("A")=""
I $D(DTOUT)!$D(DUOUT) S VALMQUIT=1 G INITQ
S IBSRCH=$E(Y)
W !
;
SRT ;
S DIR("A")=DIR("A")_"Sort By: ",DIR("B")="BILLER"
S DIR(0)="SBA^B:BILLER;D:DAYS SINCE TRANSMISSION OF LATEST BILL;L:DATE LAST "_$S($G(IBMRANOT):"EOB",1:"MRA")_" RECEIVED;"
; IB*2.0*547 add Tertiary and Primary Insurance Company sorts for CBW
S:'$G(IBMRANOT) DIR(0)=DIR(0)_"I:SECONDARY INSURANCE COMPANY;M:"_$S($G(IBMRANOT):"EOB",1:"MRA")_" STATUS;P:PATIENT NAME;R:PATIENT RESPONSIBILITY;S:SERVICE DATE"
S:$G(IBMRANOT)=1 DIR(0)=DIR(0)_"I:SECONDARY INSURANCE COMPANY;M:"_$S($G(IBMRANOT):"EOB",1:"MRA")_" STATUS;P:PATIENT NAME;R:PATIENT RESPONSIBILITY;S:SERVICE DATE;K:PRIMARY INSURANCE COMPANY"
S DIR("?")="Enter the code to indicate how the list should be sorted." D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT) S VALMQUIT=1 G INITQ
S IBSRT=Y
;
W !
S IBMRADUP=0
S DIR("A")="Do you want to include Denied "_$S($G(IBMRANOT):"EOB",1:"MRA")_"s for Duplicate Claim/Service",DIR("B")="No",DIR(0)="YO"
D ^DIR K DIR
I $D(DTOUT)!$D(DUOUT) S VALMQUIT=1 G INITQ
I Y S IBMRADUP=1
;
D BLD^IBCECOB1
;
INITQ Q
;
HELP ; -- help code
S X="?" D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K ^TMP("IBBIL",$J),^TMP("IBBIL-DIV",$J)
K ^TMP("IBCECOB",$J),^TMP("IBCECOB1",$J)
K ^TMP("IBCOBST",$J),^TMP("IBCOBSTX",$J)
D CLEAN^VALM10
Q
;
EXP ; -- expand code to show additional details of the EOB record
NEW IBDA,IBIFN,LSTENTRY
D SEL^IBCECOB2(.IBDA,1) ; selects a bill
S LSTENTRY=+$O(IBDA(0)) I 'LSTENTRY G EXPQ ; list entry number
S IBIFN=+$G(IBDA(LSTENTRY)) I 'IBIFN G EXPQ ; bill#
;
; If only one MRA on file, call the listman screen and quit
I $$MRACNT^IBCEMU1(IBIFN)=1 D EN^VALM("IBCEM MRA DETAIL") G EXPQ
;
EXPLOOP ; At this point, we know there are multiple MRA's on file
;
D FULL^VALM1
I $$SEL^IBCEMU1(IBIFN,1,LSTENTRY) D G EXPLOOP ; MRA lister/selection
. NEW IBIFN,LSTENTRY,IBDASAVE ; protect variables
. M IBDASAVE=IBDA ; save off IBDA array
. D EN^VALM("IBCEM MRA DETAIL") ; call the listman
. M IBDA=IBDASAVE ; restore IBDA array
. Q
EXPQ ;
S VALMBCK="R"
Q
;
COBPOSS(IB364) ; Returns 1 if transmit bill ien in IB364 is currently
; in a status where COB may be performed on the bill
; Used by index "ACOB", file 364
N IBWNR,IBNSEQ,IB01,IBM1,IBU1,IB0,IBOK,IBMRA
S IBOK=1
S IB0=$G(^IBA(364,IB364,0))
;;IBWNR = IF MEDICARE, WILL THEY REIMBURSE ; IBMRA = CLAIM MRA STATUS, 0=NO MRA NEEDED, 1N=MRA NEEDED, NOT YET REQUESTED
;; 1R=MRA REQUESTED, C=VALID MRA RECEIVED, A=MRA SKIPPED
S IBWNR=$$WNRBILL^IBEFUNC(+IB0),IBMRA=$P($G(^DGCR(399,+IB0,"TX")),U,5)
S IB01=$G(^DGCR(399,+IB0,0)),IBM1=$G(^("M1")),IBU1=$G(^("U1"))
I 'IBWNR,IBU1-$P(IBU1,U,2)'>0 S IBOK=0 G COBQ ; Bill has a 0 balance
I $S('IBWNR:$E($P(IB0,U,3))'="A",1:IBMRA'="1N"&(IBMRA'="A")) S IBOK=0 G COBQ ; Not in correct transmit status
S IBNSEQ=+$TR($P(IB0,U,8),"PST","230")
I 'IBNSEQ!'$D(^DGCR(399,+IB0,"I"_IBNSEQ)) S IBOK=0 G COBQ ; No next ins
I "234"'[$P(IB01,U,13) S IBOK=0 G COBQ ; Bill invalid status for COB
I IBNSEQ D
. N Z,IBSTOP
. S IBSTOP=0
. F Z=IBNSEQ:1:3 D Q:IBSTOP
.. I $D(^DGCR(399,+IB0,"I"_Z)) D
... ;Insurance must reimburse
... I $P($G(^DIC(36,+^DGCR(399,+IB0,"I"_Z),0)),U,2)="N" S IBOK=0 Q
... I $P(IBM1,U,4+Z) S IBOK=0,IBSTOP=1 Q ; Already has a next seq bill
... S (IBOK,IBSTOP)=1
;
COBQ Q IBOK
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCECOB 6082 printed Jan 18, 2025@03:10:51 Page 2
IBCECOB ;ALB/CXW - IB COB MANAGEMENT SCREEN ;16-JUN-1999
+1 ;;2.0;INTEGRATED BILLING;**137,155,288,432,488,516,547,576,727**;21-MAR-94;Build 34
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN ; -- main entry point for COB management
+1 KILL IBSRT,IBMRADUP,IBSRCH
+2 ;WCJ;IB*2.0*432
IF $GET(IBMRANOT)
DO EN^VALM("IBCEM COB MANAGEMENT")
+3 ;WCJ;IB*2.0*432
IF '$GET(IBMRANOT)
DO EN^VALM("IBCEM MRA MANAGEMENT")
+4 QUIT
+5 ;
HDR ; -- header code
+1 ;I '$G(IBMRANOT) S VALMSG="!=Data Mismatch/MSE Enter ?? for more actions"
+2 ;IB*2*576 - vd
IF '$GET(IBMRANOT)
SET VALMSG="!=Data Mismatch/MSE | *=Review in Process"
+3 ;TPF;EBILL-2436;IB*2.0*727
IF $GET(IBMRANOT)
SET VALMSG="!=Data Mismatch/MSE | *=Review in Process| ??=Help"
+4 QUIT
+5 ;
INIT ; -- init variables and list array
+1 NEW DIC,DIRUT,DIROUT,DTOUT,DUOUT,X,Y,DIR,IB1,IBQUIT
+2 KILL ^TMP("IBBIL",$JOB),^TMP("IBBIL-DIV",$JOB)
+3 SET IBSRT=""
+4 SET IB1=1
+5 WRITE !
+6 FOR
SET DIC="^VA(200,"
SET DIC(0)="AEMQ"
SET DIC("A")="Select "_$SELECT('IB1:"Another ",1:"")_"BILLER: "_$SELECT('IB1:"",1:"ALL//")
DO ^DIC
KILL DIC
Begin DoDot:1
+7 if Y<0
QUIT
+8 IF $DATA(^TMP("IBBIL",$JOB,+Y))
WRITE !,"This biller has already been selected"
QUIT
+9 SET ^TMP("IBBIL",$JOB,+Y)=""
+10 SET IB1=0
End DoDot:1
if Y<0
QUIT
+11 IF $DATA(DTOUT)!$DATA(DUOUT)
SET VALMQUIT=1
GOTO INITQ
+12 ;
+13 IF '$GET(IBMRANOT)
GOTO DIVX
+14 ;
DIV ; division
+1 WRITE !
+2 SET DIR(0)="SA^A:All Divisions;S:Selected Divisions"
+3 SET DIR("A")="Include All Divisions or Selected Divisions? "
+4 SET DIR("B")="All"
+5 DO ^DIR
KILL DIR
+6 ;Timeout or User "^"
IF $DATA(DIROUT)!$DATA(DIRUT)
SET VALMQUIT=1
GOTO INITQ
+7 IF Y="A"
GOTO DIVX
+8 ;
+9 WRITE !
+10 SET IBQUIT=0
+11 FOR
Begin DoDot:1
+12 SET DIC=40.8
SET DIC(0)="AEMQ"
SET DIC("A")=" Select Division: "
+13 IF $ORDER(^TMP("IBBIL-DIV",$JOB,""))
SET DIC("A")=" Select Another Division: "
+14 ; lookup
DO ^DIC
KILL DIC
+15 ; user entered ^^
IF X="^^"
SET IBQUIT=2
QUIT
+16 ; user is done
IF +Y'>0
SET IBQUIT=1
QUIT
+17 SET ^TMP("IBBIL-DIV",$JOB,+Y)=$PIECE(Y,U,2)
+18 QUIT
End DoDot:1
IF IBQUIT
SET IBQUIT=IBQUIT-1
QUIT
+19 ;
+20 ;User "^" out of the selection
IF IBQUIT
SET VALMQUIT=1
GOTO INITQ
+21 ;
+22 IF '$ORDER(^TMP("IBBIL-DIV",$JOB,""))
Begin DoDot:1
+23 WRITE *7,!!?3,"No divisions have been selected. Please try again."
+24 QUIT
End DoDot:1
GOTO DIV
+25 ;
DIVX ; Exit Division selection.
+1 ;
+2 WRITE !
+3 IF '$GET(IBMRANOT)
SET DIR("A")="Within Division "
GOTO SRT
+4 ;
CLM ; patch 547 - new claim prompt for CBW
+1 ;
+2 SET DIR("A")="(P)rimary Claims,(S)econdary Claims or (B)oth: "
SET DIR("B")="Both"
+3 SET DIR(0)="SBA^P -:Primary Claims;S -:Secondary Claims;B -:Both"
+4 SET DIR("?")="This field determines whether you want to search for just primary claims, just secondary/tertiary claims or both."
+5 DO ^DIR
KILL DIR
SET DIR("A")=""
+6 IF $DATA(DTOUT)!$DATA(DUOUT)
SET VALMQUIT=1
GOTO INITQ
+7 SET IBSRCH=$EXTRACT(Y)
+8 WRITE !
+9 ;
SRT ;
+1 SET DIR("A")=DIR("A")_"Sort By: "
SET DIR("B")="BILLER"
+2 SET DIR(0)="SBA^B:BILLER;D:DAYS SINCE TRANSMISSION OF LATEST BILL;L:DATE LAST "_$SELECT($GET(IBMRANOT):"EOB",1:"MRA")_" RECEIVED;"
+3 ; IB*2.0*547 add Tertiary and Primary Insurance Company sorts for CBW
+4 if '$GET(IBMRANOT)
SET DIR(0)=DIR(0)_"I:SECONDARY INSURANCE COMPANY;M:"_$SELECT($GET(IBMRANOT):"EOB",1:"MRA")_" STATUS;P:PATIENT NAME;R:PATIENT RESPONSIBILITY;S:SERVICE DATE"
+5 if $GET(IBMRANOT)=1
SET DIR(0)=DIR(0)_"I:SECONDARY INSURANCE COMPANY;M:"_$SELECT($GET(IBMRANOT):"EOB",1:"MRA")_" STATUS;P:PATIENT NAME;R:PATIENT RESPONSIBILITY;S:SERVICE DATE;K:PRIMARY INSURANCE COMPANY"
+6 SET DIR("?")="Enter the code to indicate how the list should be sorted."
DO ^DIR
KILL DIR
+7 IF $DATA(DTOUT)!$DATA(DUOUT)
SET VALMQUIT=1
GOTO INITQ
+8 SET IBSRT=Y
+9 ;
+10 WRITE !
+11 SET IBMRADUP=0
+12 SET DIR("A")="Do you want to include Denied "_$SELECT($GET(IBMRANOT):"EOB",1:"MRA")_"s for Duplicate Claim/Service"
SET DIR("B")="No"
SET DIR(0)="YO"
+13 DO ^DIR
KILL DIR
+14 IF $DATA(DTOUT)!$DATA(DUOUT)
SET VALMQUIT=1
GOTO INITQ
+15 IF Y
SET IBMRADUP=1
+16 ;
+17 DO BLD^IBCECOB1
+18 ;
INITQ QUIT
+1 ;
HELP ; -- help code
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
+3 ;
EXIT ; -- exit code
+1 KILL ^TMP("IBBIL",$JOB),^TMP("IBBIL-DIV",$JOB)
+2 KILL ^TMP("IBCECOB",$JOB),^TMP("IBCECOB1",$JOB)
+3 KILL ^TMP("IBCOBST",$JOB),^TMP("IBCOBSTX",$JOB)
+4 DO CLEAN^VALM10
+5 QUIT
+6 ;
EXP ; -- expand code to show additional details of the EOB record
+1 NEW IBDA,IBIFN,LSTENTRY
+2 ; selects a bill
DO SEL^IBCECOB2(.IBDA,1)
+3 ; list entry number
SET LSTENTRY=+$ORDER(IBDA(0))
IF 'LSTENTRY
GOTO EXPQ
+4 ; bill#
SET IBIFN=+$GET(IBDA(LSTENTRY))
IF 'IBIFN
GOTO EXPQ
+5 ;
+6 ; If only one MRA on file, call the listman screen and quit
+7 IF $$MRACNT^IBCEMU1(IBIFN)=1
DO EN^VALM("IBCEM MRA DETAIL")
GOTO EXPQ
+8 ;
EXPLOOP ; At this point, we know there are multiple MRA's on file
+1 ;
+2 DO FULL^VALM1
+3 ; MRA lister/selection
IF $$SEL^IBCEMU1(IBIFN,1,LSTENTRY)
Begin DoDot:1
+4 ; protect variables
NEW IBIFN,LSTENTRY,IBDASAVE
+5 ; save off IBDA array
MERGE IBDASAVE=IBDA
+6 ; call the listman
DO EN^VALM("IBCEM MRA DETAIL")
+7 ; restore IBDA array
MERGE IBDA=IBDASAVE
+8 QUIT
End DoDot:1
GOTO EXPLOOP
EXPQ ;
+1 SET VALMBCK="R"
+2 QUIT
+3 ;
COBPOSS(IB364) ; Returns 1 if transmit bill ien in IB364 is currently
+1 ; in a status where COB may be performed on the bill
+2 ; Used by index "ACOB", file 364
+3 NEW IBWNR,IBNSEQ,IB01,IBM1,IBU1,IB0,IBOK,IBMRA
+4 SET IBOK=1
+5 SET IB0=$GET(^IBA(364,IB364,0))
+6 ;;IBWNR = IF MEDICARE, WILL THEY REIMBURSE ; IBMRA = CLAIM MRA STATUS, 0=NO MRA NEEDED, 1N=MRA NEEDED, NOT YET REQUESTED
+7 ;; 1R=MRA REQUESTED, C=VALID MRA RECEIVED, A=MRA SKIPPED
+8 SET IBWNR=$$WNRBILL^IBEFUNC(+IB0)
SET IBMRA=$PIECE($GET(^DGCR(399,+IB0,"TX")),U,5)
+9 SET IB01=$GET(^DGCR(399,+IB0,0))
SET IBM1=$GET(^("M1"))
SET IBU1=$GET(^("U1"))
+10 ; Bill has a 0 balance
IF 'IBWNR
IF IBU1-$PIECE(IBU1,U,2)'>0
SET IBOK=0
GOTO COBQ
+11 ; Not in correct transmit status
IF $SELECT('IBWNR:$EXTRACT($PIECE(IB0,U,3))'="A",1:IBMRA'="1N"&(IBMRA'="A"))
SET IBOK=0
GOTO COBQ
+12 SET IBNSEQ=+$TRANSLATE($PIECE(IB0,U,8),"PST","230")
+13 ; No next ins
IF 'IBNSEQ!'$DATA(^DGCR(399,+IB0,"I"_IBNSEQ))
SET IBOK=0
GOTO COBQ
+14 ; Bill invalid status for COB
IF "234"'[$PIECE(IB01,U,13)
SET IBOK=0
GOTO COBQ
+15 IF IBNSEQ
Begin DoDot:1
+16 NEW Z,IBSTOP
+17 SET IBSTOP=0
+18 FOR Z=IBNSEQ:1:3
Begin DoDot:2
+19 IF $DATA(^DGCR(399,+IB0,"I"_Z))
Begin DoDot:3
+20 ;Insurance must reimburse
+21 IF $PIECE($GET(^DIC(36,+^DGCR(399,+IB0,"I"_Z),0)),U,2)="N"
SET IBOK=0
QUIT
+22 ; Already has a next seq bill
IF $PIECE(IBM1,U,4+Z)
SET IBOK=0
SET IBSTOP=1
QUIT
+23 SET (IBOK,IBSTOP)=1
End DoDot:3
End DoDot:2
if IBSTOP
QUIT
End DoDot:1
+24 ;
COBQ QUIT IBOK
+1 ;
