- 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 Feb 18, 2025@23:38:51 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 ;