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

IBCESRV2.m

Go to the documentation of this file.
  1. IBCESRV2 ;ALB/TMP - Server based Auto-update utilities - IB EDI ;03/05/96
  1. ;;2.0;INTEGRATED BILLING;**137,191,155,296,403**;21-MAR-94;Build 24
  1. ;;Per VHA Directive 2004-038, this routine should not be modified.
  1. Q
  1. ;
  1. CON837 ; Confirmation of 837 batch - auto update
  1. ;Input expected: IBTDA = the ien of the message entry in file 364.2
  1. ;
  1. N IB0,IBBDA,IBBILL,IBMSG,IBFLAG,IBTYP,IBBST,DR,DA,DIE,Z
  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)
  1. ;
  1. Q:IBTYP'["837REC"
  1. ;
  1. I $P(IB0,U,14) D UPDTEST^IBCEPTM(IBTDA) Q ; Test claim message from claim resubmitted claim
  1. ;
  1. ; Austin receipt is '837REC0',
  1. ; other non-payer confirmations are '837REC1',
  1. ; payer confirmations are '837REC2'
  1. S IBTYP=+$P(IBTYP,"837REC",2)
  1. S IBBST=$P($G(^IBA(364.1,IBBDA,0)),U,2)
  1. ;
  1. I $S(IBBST?1"A"1N:IBTYP<+$P(IBBST,"A",2),1:0) D Q
  1. . ;Don't allow status to go backwards
  1. . D DELMSG(IBTDA)
  1. ;
  1. D UPDCONF(IBBDA,IBTDA,IBTYP,1)
  1. ;
  1. Q
  1. ;
  1. BILLSTAC(IBBILL,IBTYP) ;Change status of transmit bill
  1. ; IBBILL = the ien of the entry in file 364 to update
  1. ; IBTYP = code for new status (see field 364;.03 for details)
  1. ;
  1. N IBSTAT,DIE,DA,DR,X,Y
  1. ;
  1. S IBSTAT=$P($G(^IBA(364,IBBILL,0)),U,3)
  1. ;
  1. Q:IBSTAT=IBTYP!(IBTYP="") ;Status hasn't changed or new status is null
  1. Q:"CREZ"[IBSTAT ;Don't update status of completed transmit record
  1. ;
  1. ; Don't allow the status to go backwards
  1. I $E(IBSTAT)="A","PX"[IBTYP Q
  1. I $E(IBSTAT)="A",$E(IBTYP)="A",$P(IBTYP,"A",2)<$P(IBSTAT,"A",2) Q
  1. ;
  1. S DIE="^IBA(364,",DA=IBBILL,DR=".03////"_IBTYP_";.04///NOW" D ^DIE
  1. Q
  1. ;
  1. REJ837 ; Rejections 837
  1. ;Input IBTDA = the ien of the message entry in file 364.2
  1. ;
  1. Q:'$G(IBTDA)
  1. ;
  1. D UPDREJ(+$P($G(^IBA(364.2,IBTDA,0)),U,4),IBTDA)
  1. Q
  1. ;
  1. DELMSG(IBTDA) ;
  1. ; Delete message after it successfully updates the database.
  1. ; IBTDA = the ien of the message in file 364.2
  1. D TRADEL^IBCESRV1(IBTDA)
  1. Q
  1. ;
  1. BILLSTAR(IBBILL,IBTDA) ;Change status of transmit bill and bill on rejection
  1. ; IBBILL = ien of bill (399)
  1. ; IBTDA = ien of error message
  1. ;
  1. N DR,DIE,DA,IBSTAT,IBDA,IBCBH
  1. ;
  1. S IBDA=$S($P($G(^IBA(364.2,IBTDA,0)),U,5):$P(^(0),U,5),1:+$O(^IBA(364,"B",IBBILL,""),-1))
  1. S IBSTAT=$P($G(^IBA(364,IBDA,0)),U,3),IBCBH=$P($G(^DGCR(399,IBBILL,0)),U,21)
  1. ;
  1. Q:"CREZ"[IBSTAT ;Don't update status of completed transmit record
  1. ;
  1. I IBSTAT'="E" S DIE="^IBA(364,",DA=IBDA,DR=".03////E;.04///NOW;.05////"_IBTDA D ^DIE
  1. ;
  1. ; Don't process further if only testing transmission with insurance co
  1. Q:+$G(^DIC(36,+$P($G(^DGCR(399,IBBILL,"I"_($F("PST",IBCBH)-1))),U),3))=2
  1. ;
  1. ; Suspend bill if waiting for MRA - allows it to be edited
  1. ;I $P($G(^DGCR(399,IBBILL,0)),U,13)=2,$$NEEDMRA^IBEFUNC(IBBILL)="1N" S DIE="^DGCR(399,",DA=IBBILL,DR=".13////6" D:DA ^DIE
  1. Q
  1. ;
  1. UPDMSG(IBTDA,STAT,UPD) ; Update msg with status of 'P','U' or delete message
  1. ; STAT = 'P' 'U' for pending or updating, 'R' to delete
  1. ; UPD = flag that says update the data base updated field (.12) if 1
  1. ;
  1. N DIE,DA,DR
  1. ;
  1. I STAT="R" D DELMSG(IBTDA) Q
  1. ;
  1. I $P($G(^IBA(364.2,IBTDA,0)),U,6)'=STAT D
  1. . S DR=".06////"_STAT_$S($G(UPD):".12////1",1:"")
  1. . S DIE="^IBA(364.2,",DA=IBTDA
  1. . I $G(^IBA(364.2,DA,0)) D ^DIE
  1. Q
  1. ;
  1. STOREM(IBTDA,IBTEXT,IBE) ;Store message text in file 364.2
  1. ; INPUT:
  1. ; IBTDA = ien in file 364 message field entry #IBTDA
  1. ; IBTEXT = name of the array where the message text is retrieved from
  1. ; or "@" to delete the text from the message field
  1. ; OUTPUT:
  1. ; IBE = array of errors (IBE("DIERR")) returned, pass by reference
  1. ;
  1. N IBZ,X,Y
  1. ;
  1. Q:$S($G(IBTEXT)="@":0,1:$D(@IBTEXT)<10)
  1. ;
  1. K IBE("DIERR")
  1. ;
  1. F IBZ=1:1:20 D WP^DIE(364.2,IBTDA_",",2,"AK",""_IBTEXT_"","IBE") Q:$S('$D(IBE("DIERR")):1,+IBE("DIERR")=1:$G(IBE("DIERR",1))'=110,1:1) K IBE("DIERR") H .5 ; On lock error, retry up to 20 times
  1. Q
  1. ;
  1. CKRES(IBBDA,IBDEF,IBLIST) ;Chk to see if the batch file can be updated to
  1. ; completely resubmitted based on finding all bills in it
  1. ; having a status of cancelled, resubmitted, deleted or closed
  1. ; or if none of these statuses, they at least have a transmission
  1. ; record for the same bill created at a later date/time.
  1. ;
  1. ; IBBDA : Batch # ien in file 364.1
  1. ; IBDEF : Default to set the batch status to.
  1. ; 0 or undefined, status will set to 0 (NOT INCOMPLETE)
  1. ; if no incomplete submissions found
  1. ; 1 status will set to 1 (INCOMPLETE)
  1. ; if any incomplete submissions found
  1. ; -1 status will not be updated
  1. ; IBLIST : If passed by reference and IBLIST=1, returns list of bill
  1. ; #'s not resubmitted in IBLIST(ien of file 364)=""
  1. ;
  1. N IB,IBINC,IBBILL,DIE,DR,DA,Z,Z0
  1. ;
  1. S IBDEF=+$G(IBDEF),IBINC=0
  1. Q:$S('$G(IBBDA):1,IBDEF'<0:'$P($G(^IBA(364.1,IBBDA,0)),U,10),1:0)
  1. ;
  1. I $G(IBLIST) K IBLIST S IBLIST=1
  1. S IB="" F S IB=$O(^IBA(364,"ABAST",IBBDA,IB)) Q:IB="" I "CRDZ"'[IB D Q:'$G(IBLIST)
  1. . S Z=0 F S Z=$O(^IBA(364,"ABAST",IBBDA,IB,Z)) Q:'Z D
  1. .. S Z0=($$LAST364^IBCEF4(+$G(^IBA(364,Z,0)))=Z)
  1. .. I Z0,'$G(IBLIST) S IBINC=1 Q
  1. .. I $G(IBLIST),Z0 S IBLIST(Z)=""
  1. ;
  1. I $S('IBDEF:'IBINC,IBDEF>0:IBINC,1:0) S DA=IBBDA,DIE="^IBA(364.1,",DR=".1////"_IBDEF D ^DIE
  1. ;
  1. Q
  1. ;
  1. UPDCONF(IBBDA,IBTDA,IBTYP,IBAUTO) ; Add status msgs to STATUS file #361
  1. ; Update data base from confirmation msg
  1. ; IBBDA = ien of batch
  1. ; IBTDA = ien of message
  1. ; IBTYP = type of message
  1. ; (0=Austin confirmation, 1=confirmation by non-payer
  1. ; 2=confirmation by payer)
  1. ; IBAUTO = flag for update mode
  1. ; 0 or null : manual 1 : auto
  1. ; ^TMP("IBCONF",$J,bill ien)="" where bill ien is the internal entry
  1. ; number of any bills in file 364 to be excluded from the
  1. ; confirmation due to reported errors
  1. ;
  1. N IBBILL,IBIDA,PRCASV,DA,DIE,DR,IBFLAG,IB0,IBS
  1. ;
  1. D UPDMSG(IBTDA,"U",0)
  1. ;
  1. S IB0=$G(^IBA(364.2,IBTDA,0))
  1. S IBS="A"_IBTYP
  1. ;
  1. S IBBILL="" F S IBBILL=$O(^IBA(364,"ABABI",+IBBDA,IBBILL)) Q:'IBBILL D
  1. . Q:$D(^TMP("IBCONF",$J,IBBILL)) ;Bill was rejected
  1. . ;Update status of all valid bills in a batch
  1. . S IBIDA=0 F S IBIDA=$O(^IBA(364,"ABABI",IBBDA,IBBILL,IBIDA)) Q:'IBIDA D
  1. .. D BILLSTAC(IBIDA,IBS)
  1. . ;
  1. . I 'IBTYP D
  1. .. S DR="20///NOW"
  1. .. S:$P($G(^DGCR(399,IBBILL,"TX")),U,5)="1N" DR=DR_";24///1R"
  1. .. S DA=IBBILL,DIE="^DGCR(399," D ^DIE
  1. ;
  1. I 'IBTYP D DELMSG(IBTDA) ; remove Austin batch confirmation record from file 364.2
  1. ;
  1. I 'IBBDA,$P(IB0,U,5) D
  1. . N IB
  1. . S IB=$P($G(^IBA(364,+$P(IB0,U,5),0)),U,2) ; batch
  1. . D BILLSTAC($P(IB0,U,5),IBS) ;Upd individual transmitted bill entry
  1. . I $G(^IBA(364.1,+IB,0)),$P($G(^(0)),U,2)'="A0" S DIE="^IBA(364.1,",DA=+IB,DR=".02////A0" D ^DIE
  1. ;
  1. I IBBDA,$P($G(^IBA(364.1,+IBBDA,0)),U,2)'=IBS D
  1. . S DA=IBBDA,DIE="^IBA(364.1,"
  1. . S DR=".02////"_IBS_$S($G(IBFLAG)'="":";.06////"_IBFLAG,1:"")_";1.05////"_$P(IB0,U,10)_";1.06///NOW"
  1. . D ^DIE
  1. ;
  1. ; Add message to bill status file 361 for bill
  1. I IBTYP D UPD361^IBCEST(IBTDA)
  1. ;
  1. S ZTREQ="@"
  1. K ^TMP("IBCONF",$J)
  1. Q
  1. ;
  1. UPDREJ(IBBDA,IBTDA) ; Update data base from rejection msg
  1. ; IBBDA = ien of batch
  1. ; IBTDA = ien of message
  1. ;
  1. N DA,DR,DIE,IBBILL,IBTBILL,IB0
  1. ;
  1. D UPDMSG(IBTDA,"U",0)
  1. ;
  1. S IB0=$G(^IBA(364.2,IBTDA,0)),IBTBILL=+$P(IB0,U,5),IBBILL=+$G(^IBA(364,IBTBILL,0))
  1. ;
  1. I $P(IB0,U,14) D UPDTEST^IBCEPTM(IBTDA) Q ; Test claim message from claim resubmission - store in test msg file instead
  1. ;
  1. I IBBILL D BILLSTAR(IBBILL,IBTDA) ;Update individual bill
  1. ;
  1. I IBBDA,'IBBILL D
  1. . S DA=IBBDA,DIE="^IBA(364.1,"
  1. . S DR=".11////"_IBTDA_";.06////1;1.05////"_$P(IB0,U,10)_";1.06///NOW;.05////1"
  1. . D ^DIE ;Batch Rejected
  1. .;
  1. . ;Update status of all bills in batch, bill file
  1. . F S IBBILL=$O(^IBA(364,"ABABI",IBBDA,IBBILL)) Q:'IBBILL D BILLSTAR(IBBILL,IBTDA)
  1. ;
  1. ;Add message to bill status file 361 for bill
  1. D UPD361^IBCEST(IBTDA)
  1. ;
  1. S ZTREQ="@"
  1. Q
  1. ;
  1. MAILIT ; Mails the report text (bulletin) to the IB EDI SUPERVISOR mail grp;
  1. N IB0,IBHD,IBL,IBZ,IBOK,XMTO,XMSUBJ,XMBODY,XMDUZ,XMZ,Z
  1. K ^TMP("IBMSG",$J),^TMP("IBMSGH",$J)
  1. Q:'$G(IBTDA) ;Assume this exists and is the IEN of the message in 364.2
  1. S (IBL,IBZ,IBHD)=0,IBOK=1
  1. F S IBZ=$O(^IBA(364.2,IBTDA,2,IBZ)) Q:'IBZ S IB0=$G(^(IBZ,0)) D
  1. . Q:$P(IB0,U)="REPORT"!($E(IB0,1,4)="99^$")
  1. . ;
  1. . I $P(IB0,U)="SUBJECT" D Q
  1. .. I $O(^TMP("IBMSG",$J,0)) D SEND(.IBOK) ; send last report
  1. .. S ^TMP("IBMSGH",$J)=$P(IB0,"SUBJECT^",2)
  1. . ;
  1. . I $E(IB0,1,18)="*** NEW PAGE ***" D Q
  1. .. F Z=1:1:5 S IBL=IBL+1,^TMP("IBMSG",$J,IBL)=" "
  1. .. S ^TMP("IBMSG",$J,IBL)="*** END OF PAGE ***"
  1. .. F Z=1,2 S IBL=IBL+1,^TMP("IBMSG",$J,IBL)=" "
  1. . S IBL=IBL+1,^TMP("IBMSG",$J,IBL)=IB0
  1. . ;
  1. I $O(^TMP("IBMSG",$J,0)) D SEND(.IBOK)
  1. I IBOK D DELMSG($G(IBTDA))
  1. K ^TMP("IBMSG",$J),^TMP($J,"IBMSGH",$J)
  1. Q
  1. ;
  1. SEND(IBOK) ; Send actual message for 1 report
  1. ;
  1. N XMSUBJ,XMBODY,XMTO,XMZ,XMDUZ
  1. S XMSUBJ=$G(^TMP("IBMSGH",$J)),XMBODY="^TMP(""IBMSG"",$J)",XMTO("I:G.IB EDI SUPERVISOR")=""
  1. D SENDMSG^XMXAPI(,$E(XMSUBJ,1,65),XMBODY,.XMTO,,.XMZ)
  1. I '$G(XMZ) S IBOK=0
  1. K ^TMP("IBMSG",$J),^TMP("IBMSGH",$J)
  1. Q
  1. ;