Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCEOB21

IBCEOB21.m

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