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