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

IBCESRV3.m

Go to the documentation of this file. 
  1. IBCESRV3 ;ALB/TMP - Server based Auto-update utilities - IB EDI ;03/05/96
  1.  ;;2.0;INTEGRATED BILLING;**137,155,400**;21-MAR-94;Build 52
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ; IA 4129 for call to DUZ^XUP
  1.  Q
  1.  ;
  1. EOB835 ; Explanation of Benefits - auto update
  1.  ; Input expected: IBTDA = the ien of the message entry in file 364.2
  1.  ;
  1.  ; This is the background task that is queued to run by TaskManager.
  1.  ; This procedure is called via indirection in TRTN^IBCESRV1 which is
  1.  ; called by ADD^IBCESRV.
  1.  ;
  1.  N IB0,IBBDA,IBBILL,IBMSG,IBFLAG,IBTYP,IBBST,DR,DA,DIE,Z,MRAUSER
  1.  ;
  1.  Q:'$G(IBTDA)
  1.  S IB0=$G(^IBA(364.2,IBTDA,0)),IBBDA=+$P(IB0,U,4)  ; Batch ien
  1.  S IBTYP=$P($G(^IBE(364.3,+$P(IB0,U,2),0)),U)      ; IB message type
  1.  Q:IBTYP'="835EOB"
  1.  ;
  1.  ; The MRA Project is using a specific non-human user for all
  1.  ; 835 EOB/MRA filing processes.  Change the DUZ to be this user.
  1.  ; *** VA SACC approved this exemption 5-June-2003 ***
  1.  ; *** Integration Agreement 4129 - Activated on 30-June-2003 ***
  1.  ;
  1.  S MRAUSER=$$MRAUSR^IBCEMU1()
  1.  I MRAUSER>0,$$ISITMRA(IBTDA) NEW DUZ D DUZ^XUP(MRAUSER)
  1.  ;
  1.  D UPDEOB(IBTDA)
  1.  ;
  1.  Q
  1.  ;
  1. UPDEOB(IBTDA) ; Explanation of Benefits or MRA
  1.  ;   Update data base from msg (store EOB in file 361.1)
  1.  ; IBTDA = ien of message in file 364.2
  1.  ;
  1.  N IBBILL,PRCASV,DA,DIE,DR,DA,X,Y,IBFLAG,IB0,IBS
  1.  N IBEOB,IBAUTO,IBIFN,IBERRMSG
  1.  ;
  1.  D UPDMSG^IBCESRV2(IBTDA,"U",0)    ; updating data in 364.2
  1.  S IB0=$G(^IBA(364.2,IBTDA,0))
  1.  ;
  1.  I '$P(IB0,U,5) G UPDEOBX          ; no transmit bill# in file 364
  1.  S IBEOB=$$UPDEOB^IBCEOB(IBTDA)    ; new entry in file 361.1
  1.  I 'IBEOB G UPDEOBX                ;   exit if some failure
  1.  ;
  1.  ; update transmission status of transmission Bill# in file 364
  1.  ;   status is closed (code "Z")
  1.  D BILLSTAC^IBCESRV2($P(IB0,U,5),"Z") ;Upd indiv transmitted bill
  1.  ;
  1.  ; Delete the entry from file 364.2
  1.  D DELMSG^IBCESRV2(IBTDA)
  1.  ;
  1.  ; If the EOB is not a Medicare MRA, then we can stop here
  1.  I $P($G(^IBM(361.1,IBEOB,0)),U,4)'=1 G UPDEOBX
  1.  ; 
  1.  ; *** Medicare MRA processing ***
  1.  ;
  1.  ; update the claim MRA status of the file 399 bill
  1.  ; to be "C" - Valid MRA received
  1.  D MRASTAT(IBEOB,"C")
  1.  ;
  1.  ; Invoke the EOB criteria check and attempt to create and authorize
  1.  ; the secondary bill
  1.  S IBAUTO=$$CRIT^IBCEMQC(IBEOB)
  1.  I 'IBAUTO D AUTOMSG(IBEOB,$P(IBAUTO,U,2)) G UPDEOBX
  1.  S IBIFN=$P($G(^IBA(364,+$P(IB0,U,5),0)),U,1)   ; bill# from file 364
  1.  ;
  1.  ; Process COB, create secondary bill
  1.  S IBERRMSG=""
  1.  D AUTOCOB^IBCEMQA(IBIFN,IBEOB,.IBERRMSG)
  1.  I IBERRMSG'="" D AUTOMSG(IBEOB,IBERRMSG) G UPDEOBX
  1.  ;
  1.  ; Authorize the secondary bill
  1.  D AUTH^IBCEMQA(IBIFN,.IBERRMSG)
  1.  I IBERRMSG'="" D AUTOMSG(IBEOB,IBERRMSG) G UPDEOBX
  1.  ;
  1. UPDEOBX ;
  1.  S ZTREQ="@"
  1.  Q
  1.  ;
  1. AUTOMSG(IBEOB,MSG) ; File the automatic bill generation failure message
  1.  NEW DIE,DA,DR,D,D0,DI,DIC,DQ,X,Y
  1.  S IBEOB=+$G(IBEOB),MSG=$G(MSG)
  1.  I '$D(^IBM(361.1,IBEOB)) G AUMSGX
  1.  I MSG="" G AUMSGX
  1.  S DIE=361.1,DA=IBEOB,DR="30.01////"_MSG_";30.02////"_$$NOW^XLFDT
  1.  D ^DIE
  1. AUMSGX ;
  1.  Q
  1.  ;
  1. MRASTAT(IBEOB,STAT) ; Update the claim MRA status field on the bill
  1.  ; File 399, Field 24 - CLAIM MRA STATUS
  1.  NEW DIE,DA,DR,D,D0,DI,DIC,DIG,DIH,DIU,DIV,DQ,X,Y,IBIFN
  1.  S IBEOB=+$G(IBEOB),STAT=$G(STAT)
  1.  I '$D(^IBM(361.1,IBEOB)) G MRASTX
  1.  I STAT="" G MRASTX
  1.  S IBIFN=+$P($G(^IBM(361.1,IBEOB,0)),U,1)
  1.  I '$D(^DGCR(399,IBIFN,"TX")) G MRASTX
  1.  ;
  1.  S DIE=399,DA=IBIFN,DR="24////"_STAT
  1.  D ^DIE
  1. MRASTX ;
  1.  Q
  1.  ;
  1. ISITMRA(IBTDA) ; Function to return whether or not this transmission
  1.  ; is a Medicare MRA or a normal EOB
  1.  NEW IEN,MRA,STOP,DATA
  1.  S (IEN,MRA,STOP)=0
  1.  F  S IEN=$O(^IBA(364.2,IBTDA,2,IEN)) Q:'IEN  D  Q:STOP
  1.  . S DATA=$$EXT^IBCEMU1($G(^IBA(364.2,IBTDA,2,IEN,0))) Q:DATA=""
  1.  . I $P(DATA,U,1)'="835EOB" Q
  1.  . I $P(DATA,U,5)="Y" S MRA=1
  1.  . S STOP=1
  1.  . Q
  1. ISMRAX ;
  1.  Q MRA
  1.  ;