IBCEOB21 ;ALB/TMP - EOB MAINTENANCE ACTIONS ;18-FEB-99
;;2.0;INTEGRATED BILLING;**137,155,432**;21-MAR-94;Build 192
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
EDIT ; Edit a previously entered manual EOB
N IBDA,IB0,DIE,DR,X,Y,DA
;
D FULL^VALM1
S IBDA=$$SEL()
G:'IBDA EDITQ
;
S IB0=$G(^IBM(361.1,IBDA,0))
I $P(IB0,U,17)'=1 D G EDITQ
. W !,*7,"Cannot edit an EOB that was not entered manually!!"
. D PAUSE^VALM1
;
I $P(IB0,U,15)'=$$COBN^IBCEF(IBIFN) D G EDITQ
. W !,*7,"Can only edit an EOB for the current insurance sequence"
. D PAUSE^VALM1
;
S DIE="^IBM(361.1,",DA=IBDA
S DR="100.03///"_DUZ_";100.04///^S X=""NOW"";.06;.13;.16//^S X=$$EXTERNAL^DILFD(361.1,.16,,3)"_$S($$AMTCHG(DA):";1.01",1:"")_";21"
D ^DIE
;
D BLD^IBCEOB2
;
D PAUSE^VALM1
EDITQ S VALMBCK="R"
Q
;
DELETE ; Delete a previously entered manual EOB
N IB0,IBDA,IBE,DIR,X,Y,DA,DIK
;
D FULL^VALM1
S IBDA=$$SEL(.IBE)
G:'IBDA DELQ
;
S IB0=$G(^IBM(361.1,IBDA,0))
I $P(IB0,U,17)'=1 D G DELQ
. W !,*7,"Cannot delete an EOB that was not entered manually!!"
. D PAUSE^VALM1
;
I $P(IB0,U,15)'=$$COBN^IBCEF(IBIFN) D G DELQ
. W !,*7,"Cannot only edit an EOB for the current insurance sequence"
. D PAUSE^VALM1
;
W !!,IBE,!
S DIR("A")="ARE YOU REALLY SURE YOU WANT TO DELETE THIS EOB?: ",DIR("B")="NO",DIR(0)="YA" D ^DIR K DIR
G:Y'=1 DELQ
;
S DIK="^IBM(361.1,",DA=IBDA D ^DIK
W !!,"EOB Deleted!!",!
;
D BLD^IBCEOB2
;
D PAUSE^VALM1
DELQ S VALMBCK="R"
Q
;
NEW ; Add a manual EOB for the current COB sequence for the claim
N DO,DD,DIC,DIE,DLAYGO,Y,X,IBEOB,IBOK,IB364
;
D FULL^VALM1
;
K DO,DD
S IB364=$$LAST364^IBCEF4(IBIFN)
S DIC="^IBM(361.1,",DIC(0)="L",X=IBIFN,DLAYGO=361.1
S DIC("DR")=".15////"_$$COBN^IBCEF(IBIFN)_";.04////0;.05////"_$$NOW^XLFDT_";.17////1;.18///"_DUZ_$S(IB364:";.19////"_IB364,1:"")
D FILE^DICN K DO,DD,DLAYGO,DIC
G:Y<0 NEWQ
S DIE="^IBM(361.1,",DA=+Y,DR=".06//^S X=""NOW"";S DIE(""NO^"")="""";.13//^S X=$$EXTERNAL^DILFD(361.1,.13,,1);.16//^S X=$$EXTERNAL^DILFD(361.1,.16,,3);K DIE(""NO^"");1.01;21"
W ! D ^DIE K DIE
S IBEOB=$P($G(^IBM(361.1,DA,0)),U,6),IBOK=1
I IBEOB D
. I $P($G(^IBM(361.1,DA,1)),U,1)="" D
.. S DIR(0)="YA",DIR("A",1)="Nothing entered for payer amt paid",DIR("A")="Are you sure you want to file this EOB?: ",DIR("B")="NO"
.. W ! D ^DIR W ! K DIR
.. I Y'=1 S (IBEOB,IBOK)=0
. I IBOK W !,"EOB added",!
I 'IBEOB D
. Q:DA'>0
. S DIK="^IBM(361.1," D ^DIK
. I IBOK W !!,"EOB Date/Time needed, not entered"
. W !,"No EOB added!!",!
D BLD^IBCEOB2
NEWQ D PAUSE^VALM1
S VALMBCK="R"
Q
;
VIEW ; View an MRA
N IBDA,IBSEL,IBIFN,IBEOBIFN,IBIFNSAV
;
D FULL^VALM1
D SEL(.IBDA,1) ; select a bill from the main list
S IBSEL=+$O(IBDA(0)) I 'IBSEL G VIEWQ ; list#
S IBIFN=$P($G(IBDA(IBSEL)),U,1) I 'IBIFN G VIEWQ ; bill#
; IB*2.0*432 if nothing in EOB file for non-MRA claim, warn user and quit.
;S IBEOBIFN=$P($G(IBDA(IBSEL)),U,3) I 'IBEOBIFN G VIEWQ ; eob ien
S IBEOBIFN=$P($G(IBDA(IBSEL)),U,3) I 'IBEOBIFN,$G(IBMRANOT)=1 D G VIEWQ
. D FULL^VALM1
. W !!?5,"There is no electronic EOB for this claim."
. D PAUSE^VALM1
. Q
;
; If only one MRA on file, then call the Listman and quit
I $$MRACNT^IBCEMU1(IBIFN,$G(IBMRANOT))=1 D EN^VALM("IBCEM VIEW EOB") G VIEWQ
;
VLOOP ; Multiple MRA's on file. Allow user to select the MRA to view
D FULL^VALM1
S IBEOBIFN=$$SEL^IBCEMU1(IBIFN,1)
I 'IBEOBIFN G VIEWQ
S IBIFNSAV=IBIFN ; save off the bill#
D EN^VALM("IBCEM VIEW EOB") ; call the Listman
S IBIFN=IBIFNSAV ; restore the bill# (just in case)
G VLOOP
;
VIEWQ ;
S VALMBCK="R"
Q
;
AMTCHG(DA) ; Function to determine if amt on EOB can be modified
; DA = ien of EOB entry (file 361.1)
; Function returns 1 if OK to change, 0 if the next bill in COB
; sequence has already been sent or the bill has been closed.
N IBOK,IBIFN,IBCOBN,IB0,IBNB
S IBOK=1
S IBIFN=+$G(^IBM(361.1,+DA,0)),IB0=$G(^DGCR(399,IBIFN,0))
I $P(IB0,U,13)=6 S IBOK=0 G AMTQ ; Bill is closed...can't change EOB amt
S IBCOBN=$$COBN^IBCEF(IBIFN)
I IBCOBN=3 G AMTQ ; Already the last bill
S IBNB=+$P($G(^DGCR(399,IBIFN,"M")),U,IBCOBN+5) ; Get next bill #
I 'IBNB G AMTQ ; No next bill
I $P($G(^DGCR(399,IBNB,0)),U,13)<3 G AMTQ
S IBOK=0
;
AMTQ Q IBOK
;
SEL(IBDA,ONE) ; Select entry(s) from list
; IBDA = array returned if selections made
; ONE = if set to 1, only one selection can be made at a time
N VALMY
K IBDA
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
;
CHANGE ; Select another bill to display
N IBNULL,IBIFN1
D FULL^VALM1
K VALMQUIT
S IBIFN1=IBIFN
S IBIFN=$$BILL^IBCEOB2(.VALMQUIT,.IBNULL)
I '$G(IBNULL) S IBIFN=IBIFN1 K VALMQUIT
I '$D(VALMQUIT) S VALMBCK="R"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCEOB21 4994 printed Dec 13, 2024@02:11:23 Page 2
IBCEOB21 ;ALB/TMP - EOB MAINTENANCE ACTIONS ;18-FEB-99
+1 ;;2.0;INTEGRATED BILLING;**137,155,432**;21-MAR-94;Build 192
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
EDIT ; Edit a previously entered manual EOB
+1 NEW IBDA,IB0,DIE,DR,X,Y,DA
+2 ;
+3 DO FULL^VALM1
+4 SET IBDA=$$SEL()
+5 if 'IBDA
GOTO EDITQ
+6 ;
+7 SET IB0=$GET(^IBM(361.1,IBDA,0))
+8 IF $PIECE(IB0,U,17)'=1
Begin DoDot:1
+9 WRITE !,*7,"Cannot edit an EOB that was not entered manually!!"
+10 DO PAUSE^VALM1
End DoDot:1
GOTO EDITQ
+11 ;
+12 IF $PIECE(IB0,U,15)'=$$COBN^IBCEF(IBIFN)
Begin DoDot:1
+13 WRITE !,*7,"Can only edit an EOB for the current insurance sequence"
+14 DO PAUSE^VALM1
End DoDot:1
GOTO EDITQ
+15 ;
+16 SET DIE="^IBM(361.1,"
SET DA=IBDA
+17 SET DR="100.03///"_DUZ_";100.04///^S X=""NOW"";.06;.13;.16//^S X=$$EXTERNAL^DILFD(361.1,.16,,3)"_$SELECT($$AMTCHG(DA):";1.01",1:"")_";21"
+18 DO ^DIE
+19 ;
+20 DO BLD^IBCEOB2
+21 ;
+22 DO PAUSE^VALM1
EDITQ SET VALMBCK="R"
+1 QUIT
+2 ;
DELETE ; Delete a previously entered manual EOB
+1 NEW IB0,IBDA,IBE,DIR,X,Y,DA,DIK
+2 ;
+3 DO FULL^VALM1
+4 SET IBDA=$$SEL(.IBE)
+5 if 'IBDA
GOTO DELQ
+6 ;
+7 SET IB0=$GET(^IBM(361.1,IBDA,0))
+8 IF $PIECE(IB0,U,17)'=1
Begin DoDot:1
+9 WRITE !,*7,"Cannot delete an EOB that was not entered manually!!"
+10 DO PAUSE^VALM1
End DoDot:1
GOTO DELQ
+11 ;
+12 IF $PIECE(IB0,U,15)'=$$COBN^IBCEF(IBIFN)
Begin DoDot:1
+13 WRITE !,*7,"Cannot only edit an EOB for the current insurance sequence"
+14 DO PAUSE^VALM1
End DoDot:1
GOTO DELQ
+15 ;
+16 WRITE !!,IBE,!
+17 SET DIR("A")="ARE YOU REALLY SURE YOU WANT TO DELETE THIS EOB?: "
SET DIR("B")="NO"
SET DIR(0)="YA"
DO ^DIR
KILL DIR
+18 if Y'=1
GOTO DELQ
+19 ;
+20 SET DIK="^IBM(361.1,"
SET DA=IBDA
DO ^DIK
+21 WRITE !!,"EOB Deleted!!",!
+22 ;
+23 DO BLD^IBCEOB2
+24 ;
+25 DO PAUSE^VALM1
DELQ SET VALMBCK="R"
+1 QUIT
+2 ;
NEW ; Add a manual EOB for the current COB sequence for the claim
+1 NEW DO,DD,DIC,DIE,DLAYGO,Y,X,IBEOB,IBOK,IB364
+2 ;
+3 DO FULL^VALM1
+4 ;
+5 KILL DO,DD
+6 SET IB364=$$LAST364^IBCEF4(IBIFN)
+7 SET DIC="^IBM(361.1,"
SET DIC(0)="L"
SET X=IBIFN
SET DLAYGO=361.1
+8 SET DIC("DR")=".15////"_$$COBN^IBCEF(IBIFN)_";.04////0;.05////"_$$NOW^XLFDT_";.17////1;.18///"_DUZ_$S(IB364:";.19////"_IB364,1:"")
+9 DO FILE^DICN
KILL DO,DD,DLAYGO,DIC
+10 if Y<0
GOTO NEWQ
+11 SET DIE="^IBM(361.1,"
SET DA=+Y
SET DR=".06//^S X=""NOW"";S DIE(""NO^"")="""";.13//^S X=$$EXTERNAL^DILFD(361.1,.13,,1);.16//^S X=$$EXTERNAL^DILFD(361.1,.16,,3);K DIE(""NO^"");1.01;21"
+12 WRITE !
DO ^DIE
KILL DIE
+13 SET IBEOB=$PIECE($GET(^IBM(361.1,DA,0)),U,6)
SET IBOK=1
+14 IF IBEOB
Begin DoDot:1
+15 IF $PIECE($GET(^IBM(361.1,DA,1)),U,1)=""
Begin DoDot:2
+16 SET DIR(0)="YA"
SET DIR("A",1)="Nothing entered for payer amt paid"
SET DIR("A")="Are you sure you want to file this EOB?: "
SET DIR("B")="NO"
+17 WRITE !
DO ^DIR
WRITE !
KILL DIR
+18 IF Y'=1
SET (IBEOB,IBOK)=0
End DoDot:2
+19 IF IBOK
WRITE !,"EOB added",!
End DoDot:1
+20 IF 'IBEOB
Begin DoDot:1
+21 if DA'>0
QUIT
+22 SET DIK="^IBM(361.1,"
DO ^DIK
+23 IF IBOK
WRITE !!,"EOB Date/Time needed, not entered"
+24 WRITE !,"No EOB added!!",!
End DoDot:1
+25 DO BLD^IBCEOB2
NEWQ DO PAUSE^VALM1
+1 SET VALMBCK="R"
+2 QUIT
+3 ;
VIEW ; View an MRA
+1 NEW IBDA,IBSEL,IBIFN,IBEOBIFN,IBIFNSAV
+2 ;
+3 DO FULL^VALM1
+4 ; select a bill from the main list
DO SEL(.IBDA,1)
+5 ; list#
SET IBSEL=+$ORDER(IBDA(0))
IF 'IBSEL
GOTO VIEWQ
+6 ; bill#
SET IBIFN=$PIECE($GET(IBDA(IBSEL)),U,1)
IF 'IBIFN
GOTO VIEWQ
+7 ; IB*2.0*432 if nothing in EOB file for non-MRA claim, warn user and quit.
+8 ;S IBEOBIFN=$P($G(IBDA(IBSEL)),U,3) I 'IBEOBIFN G VIEWQ ; eob ien
+9 SET IBEOBIFN=$PIECE($GET(IBDA(IBSEL)),U,3)
IF 'IBEOBIFN
IF $GET(IBMRANOT)=1
Begin DoDot:1
+10 DO FULL^VALM1
+11 WRITE !!?5,"There is no electronic EOB for this claim."
+12 DO PAUSE^VALM1
+13 QUIT
End DoDot:1
GOTO VIEWQ
+14 ;
+15 ; If only one MRA on file, then call the Listman and quit
+16 IF $$MRACNT^IBCEMU1(IBIFN,$GET(IBMRANOT))=1
DO EN^VALM("IBCEM VIEW EOB")
GOTO VIEWQ
+17 ;
VLOOP ; Multiple MRA's on file. Allow user to select the MRA to view
+1 DO FULL^VALM1
+2 SET IBEOBIFN=$$SEL^IBCEMU1(IBIFN,1)
+3 IF 'IBEOBIFN
GOTO VIEWQ
+4 ; save off the bill#
SET IBIFNSAV=IBIFN
+5 ; call the Listman
DO EN^VALM("IBCEM VIEW EOB")
+6 ; restore the bill# (just in case)
SET IBIFN=IBIFNSAV
+7 GOTO VLOOP
+8 ;
VIEWQ ;
+1 SET VALMBCK="R"
+2 QUIT
+3 ;
AMTCHG(DA) ; Function to determine if amt on EOB can be modified
+1 ; DA = ien of EOB entry (file 361.1)
+2 ; Function returns 1 if OK to change, 0 if the next bill in COB
+3 ; sequence has already been sent or the bill has been closed.
+4 NEW IBOK,IBIFN,IBCOBN,IB0,IBNB
+5 SET IBOK=1
+6 SET IBIFN=+$GET(^IBM(361.1,+DA,0))
SET IB0=$GET(^DGCR(399,IBIFN,0))
+7 ; Bill is closed...can't change EOB amt
IF $PIECE(IB0,U,13)=6
SET IBOK=0
GOTO AMTQ
+8 SET IBCOBN=$$COBN^IBCEF(IBIFN)
+9 ; Already the last bill
IF IBCOBN=3
GOTO AMTQ
+10 ; Get next bill #
SET IBNB=+$PIECE($GET(^DGCR(399,IBIFN,"M")),U,IBCOBN+5)
+11 ; No next bill
IF 'IBNB
GOTO AMTQ
+12 IF $PIECE($GET(^DGCR(399,IBNB,0)),U,13)<3
GOTO AMTQ
+13 SET IBOK=0
+14 ;
AMTQ QUIT IBOK
+1 ;
SEL(IBDA,ONE) ; Select entry(s) from list
+1 ; IBDA = array returned if selections made
+2 ; ONE = if set to 1, only one selection can be made at a time
+3 NEW VALMY
+4 KILL IBDA
+5 DO EN^VALM2($GET(XQORNOD(0)),$SELECT('$GET(ONE):"",1:"S"))
+6 SET IBDA=0
FOR
SET IBDA=$ORDER(VALMY(IBDA))
if 'IBDA
QUIT
SET IBDA(IBDA)=$PIECE($GET(^TMP("IBCECOB",$JOB,+IBDA)),U,2,6)
+7 QUIT
+8 ;
CHANGE ; Select another bill to display
+1 NEW IBNULL,IBIFN1
+2 DO FULL^VALM1
+3 KILL VALMQUIT
+4 SET IBIFN1=IBIFN
+5 SET IBIFN=$$BILL^IBCEOB2(.VALMQUIT,.IBNULL)
+6 IF '$GET(IBNULL)
SET IBIFN=IBIFN1
KILL VALMQUIT
+7 IF '$DATA(VALMQUIT)
SET VALMBCK="R"
+8 QUIT
+9 ;
