- IBCE837A ;ALB/TMP - OUTPUT FOR 837 TRANSMISSION - CONTINUED ;8/6/03 10:50am
- ;;2.0;INTEGRATED BILLING;**137,191,211,232,296,377,592,623,641,718**;21-MAR-94;Build 73
- ;;Per VA Directive 6402, this routine should not be modified.
- ;
- UPD(MSGNUM,BATCH,CNT,BILLS,DESC,IBBTYP,IBINS) ; Upd current batch + bills w/new status
- ;MSGNUM = mail msg # for batch
- ;BATCH = batch #
- ;CNT = # of bills in batch
- ;BILLS = array BILLS(bill ien in 364) in batch
- ;DESC = 1-80 character description of batch
- ;IBBTYP = X-Y where X = P for professional, I for institution, or D for Dental ;JWS;IB*2.0*592;US131
- ; Y = 1 for test or 0 for live transmission
- ; or 2 for live claim resubmitted as test
- ;IBINS = ien of single insurance company for the batch (optional)
- ;
- N DIC,DIE,DR,DA,IBBATCH,IBIFN,IBIEN,IBYY,IBTXTEST,IBMRA
- S IBBATCH=$O(^IBA(364.1,"B",+BATCH,"")) Q:'IBBATCH
- S IBTXTEST=+$P(IBBTYP,"-",2)
- I '$P($G(^IBE(350.9,1,8)),U,7) S IBINS=""
- ;
- ;JWS;IB*2.0*641v14 update status to A0 for FHIR claims
- S DIE="^IBA(364.1,",DA=IBBATCH,DR=".02////"_$S($$GET1^DIQ(350.9,"1,",8.21,"I"):"A0",1:"P")_";.03///"_CNT_";.04///"_MSGNUM_";.05///0;.07////1;.08///^S X="""_DESC_""""_$S($G(IBINS):";.12////"_IBINS,1:"")
- ;
- I '$P($G(^TMP("IBRESUBMIT",$J)),U,3) S DR=DR_";1.01///NOW;1.02///.5"
- I $P($G(^TMP("IBRESUBMIT",$J)),U,2) S DR=DR_";.15////"_$P(^($J),U,2)
- ;JWS;IB*2.0*592;US131
- S DR=DR_";.14////"_$S('IBTXTEST:0,1:1)_";.06////"_$S($E(IBBTYP)="P":2,$E(IBBTYP)="D":7,1:3) D ^DIE ; Update batch
- ;
- I IBTXTEST=2 D ADDTXM^IBCEPTM(.BILLS,IBBATCH,$$NOW^XLFDT()) Q
- I IBTXTEST'=2 S IBIEN=0 F S IBIEN=$O(BILLS(IBIEN)) Q:'IBIEN D ;Update each bill
- . ;JWS;IB*2.0*623;update field .09 837 FHIR ReQUEST if using 837 FHIR trans method
- . ;JWS;IB*2.0*641v14 update status to A0 for FHIR claims
- . S DA=IBIEN,DIE="^IBA(364,",DR=".02////"_IBBATCH_";.03///"_$S($$GET1^DIQ(350.9,"1,",8.21,"I"):"A0",1:"P")_";.04///NOW"
- . I $D(^IBA(364,"AC",1,DA)) S DR=DR_";.09////2"
- . D ^DIE
- . S IBIFN=+$G(^IBA(364,IBIEN,0))
- . ; If this claim has just been retransmitted, set the .06 field for the previous transmission entry
- . N PRVTXI,PRVTXD
- . S PRVTXI=$O(^IBA(364,"B",IBIFN,IBIEN),-1) ; previous transmission for this claim
- . I PRVTXI D
- .. S PRVTXD=$G(^IBA(364,PRVTXI,0))
- .. I '$F(".R.E.","."_$P(PRVTXD,U,3)_".") Q ; prev trans must have status of "R" or "E"
- .. I $P(PRVTXD,U,7,8)'=$P($G(^IBA(364,IBIEN,0)),U,7,8) Q ; test bill and COB must be the same
- .. S DA=PRVTXI,DIE=364,DR=".06///"_IBBATCH D ^DIE ; update the resubmit batch number
- .. Q
- . ;
- .Q:$D(^TMP("IBRESUBMIT",$J))!($P($G(^DGCR(399,IBIFN,0)),U,13)=4)!(+$$TXMT^IBCEF4(IBIEN)=2)
- .S IBMRA=$$NEEDMRA^IBEFUNC(IBIFN)
- .I IBMRA="C",$P($G(^DGCR(399,IBIFN,0)),U,13)=2 S IBMRA=1
- .I IBIFN D
- ..S (DIC,DIE)="^DGCR(399,",DA=$P($G(^IBA(364,IBIEN,0)),U),DR="[IB STATUS]",IBYY=$S('IBMRA:"@91",1:"@911") D:DA ^DIE
- ..D BSTAT^IBCDC(IBIFN) ; remove from AB list
- Q
- ;
- PRE ; Run before processing a bill entry
- K IBXSAVE,IBXERR,^UTILITY("VAPA",$J),^TMP("IBXSAVE",$J),^TMP($J),^TMP("DIERR",$J)
- Q
- ;
- POST ; Run after processing a bill entry for cleanup
- N Q
- I $G(IBXERR)'="" D
- .S ^TMP("IBXERR",$J,IBXIEN)=IBXERR K ^TMP("IBXDATA",$J)
- .K ^TMP("IBHDR1",$J)
- .I $D(^TMP("IBRESUBMIT",$J)),'$G(^TMP("IBEDI_TEST_BATCH",$J)) D ;Set not resub flag for non-test bill
- ..N Z,Z0
- ..S Z0=$P($G(^TMP("IBRESUBMIT",$J)),U) Q:Z0=""
- ..S Z=$O(^IBA(364,"ABABI",+$O(^IBA(364.1,"B",Z0,"")),IBXIEN,""))
- ..I Z S ^TMP("IBNOT",$J,Z)=IBXIEN
- K IBXSAVE,IBXNOREQ,^TMP("IBXSAVE",$J),^TMP($J)
- ;;IB*2.0*718;JWS;12/27/21;EBILL-1629;Incorporate FSC Overrides
- D POST^IBCE837P
- S Q="VA" F S Q=$O(^UTILITY(Q)) Q:$E(Q,1,2)'="VA" I $D(^(Q,$J)) K ^UTILITY(Q,$J)
- D CLEAN^DILF
- Q
- ;
- MAILIT(IBQUEUE,IBBILL,IBCTM,IBDUZ,IBDESC,IBBTYP,IBINS) ; Send mail msg, update bills
- ;IBQUEUE = mail queue name to send 837 transactions to
- ;IBBILL = array of ien's in file 364 of bills in batch - IBBILL(IEN)=""
- ;IBCTM = # of bills in batch, returned reset to 0
- ;IBDUZ = ien of user 'running' extract (if any)
- ;IBDESC = description of batch
- ;IBBTYP = X-Y where X = P for professional, I for institution, or D for Dental ;JWS;IB*2.0*592;US131
- ; Y = 1 or 2 for test or 0 for live transmission
- ;IBINS = ien of insurance company if only one/batch option (optional)
- ;
- N DIK,DA,XMTO,XMZ,XMBODY,XMDUZ,XMSUBJ,IBBDA,IBBNO
- ;
- S IBBNO=+$P($G(^TMP("IBHDR",$J)),U),IBBDA=$O(^IBA(364.1,"B",IBBNO,""))
- I '$P($G(^IBE(350.9,1,8)),U,7) S IBINS=""
- ;
- I IBCTM D
- . ;JWS;IB*2.0*623
- . I $$GET1^DIQ(350.9,"1,",8.21,"I") Q ;G MAILQ
- . I +$G(^TMP("IBEDI_TEST_BATCH",$J)) S IBQUEUE="MCT"
- . I IBQUEUE'="",IBQUEUE'["@" S XMTO("XXX@Q-"_IBQUEUE_".DOMAIN.EXT")=""
- . ;
- . ; ******Note to self - remove when going to sites although it shouldn't hurt if you forget - WCJ **********
- . I '$$PROD^XUPROD(1) S XMTO("G.CLAIMS4US")=""
- . ;
- . I IBQUEUE["@" S XMTO(IBQUEUE)=""
- . S XMDUZ=$G(IBDUZ),XMBODY="^TMP(""IBXMSG"","_$J_")",XMSUBJ=$S($P(IBBTYP,U,2):"** TEST"_$S($P(IBBTYP,U,2)=2:"/RESUB OF LIVE",1:""),1:"")_" CLAIM BATCH: "_$S(IBQUEUE'["@":IBQUEUE,1:$P(IBQUEUE,"@"))_"/"_IBBNO
- . K XMZ
- . D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO,,.XMZ)
- . I $G(XMZ) D
- .. D UPD(XMZ,$P($G(^TMP("IBHDR",$J)),U),IBCTM,.IBBILL,IBDESC,IBBTYP,IBINS) ;Update batch/bills
- .. S ^TMP("IBCE-BATCH",$J,IBBNO)=IBBDA_U_IBCTM_U_$P($G(^TMP("IBRESUBMIT",$J)),U)
- MAILQ ;
- S IBCTM=0
- ;JWS;IB*2.0*623;do not do for FHIR transmissions
- I '$$GET1^DIQ(350.9,"1,",8.21,"I") D CHKBTCH(+$G(^TMP("IBHDR",$J)))
- K ^TMP("IBHDR",$J),^TMP("IBHDR1",$J),^TMP("IBXMSG",$J),IBBILL
- Q
- ;
- CHKNEW(IBQ,IBBILL,IBCTM,IBDESC,IBBTYP,IBINS,IBSITE,IBSIZE) ;
- ; Determine if ok to send msg
- ; Check for one insurance per batch if IBINS defined
- ; Returns IBSIZE, IBCTM, IBBILL (pass by reference)
- ;
- ; IBQ = data queue name
- ; IBBILL = the 'list' of bill #'s in the batch
- ; IBCTM = the # of claims output so far to the batch
- ; IBDESC = the batch description text
- ; IBBTYP = X-Y where X = P for professional, I for institution, or D for Dental
- ; Y = 1 for test or 0 for live transmission
- ; IBINS = the ien of the single insurance co. for the batch (optional)
- ; IBSITE = the '8' node of file 350.9 (IB PARAMETERS)
- ; IBSIZE = the 'running' size of the output message
- ;
- Q:$S($G(IBINS)="":0,1:'$P(IBSITE,U,7))
- ;
- ; New batch needed
- I IBCTM D MAILIT(IBQ,.IBBILL,.IBCTM,"",IBDESC,IBBTYP,IBINS) S IBSIZE=0
- Q
- ;
- ERRMSG(XMBODY) ; Send bulletin for error message
- N XMTO,XMSUBJ
- S XMTO("I:G.IB EDI")="",XMSUBJ="EDI 837 TRANSMISSION ERRORS"
- ;
- D SENDMSG^XMXAPI(,XMSUBJ,XMBODY,.XMTO)
- D ALERT("One or more EDI bills were not transmitted. Check your mail for details","G.IB EDI")
- Q
- ;
- CLEANUP ; Cleans up bill transmission environment
- ;
- N IBTEST
- S IBTEST=+$G(^TMP("IBEDI_TEST_BATCH",$J))
- L -^IBA(364,0)
- I $D(^TMP("IBRESUBMIT",$J,"IBXERR"))!$D(^TMP("IBONE",$J,"IBXERR"))!$D(^TMP("IBSELX",$J,"IBXERR")) D ;Error message to mail group
- . N XMTO,XMBODY,XMDUZ,XMSUBJ,XMZ,IBFUNC
- . S IBFUNC=$S($D(^TMP("IBRESUBMIT",$J,"IBXERR")):$S('IBTEST:1,1:4),$D(^TMP("IBONE",$J,"IBXERR")):2,1:3)
- . Q:'IBFUNC
- . S XMTO("I:G.IB EDI")="",XMDUZ="",XMBODY="^TMP("""_$S(IBFUNC=1!(IBFUNC=4):"IBRESUBMIT",1:"IBONE")_""","_$J_",""IBXERR"")"
- . S XMSUBJ="EDI 837 B"_$P("ATCH^ILL^ILL(s)^ILL(s)",U,IBFUNC)_" NOT "_$S($G(^TMP("IBONE",$J)):"RE",1:"")_"SUBMITTED"_$S('IBTEST:"",1:" AS TEST CLAIMS")
- . D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO,,.XMZ)
- . K ^TMP("IBRESUBMIT",$J),^TMP("IBONE",$J)
- ;
- I $D(^TMP("IBRESUBMIT",$J)),'IBTEST D RESUBUP^IBCEM02 ;Upd resubmtd batch bills
- I '$D(^TMP("IBSELX",$J)) K ^TMP("IBCE-BATCH",$J)
- K ^TMP("IBXERR",$J),IBXERR
- I 'IBTEST D CHKBTCH(+$G(^TMP("IBHDR",$J)))
- CLEANP ; Entrypoint for extract data disply
- K ^TMP("IBTXMT",$J),^TMP("IBXINS",$J)
- K ^TMP("IBRESUBMIT",$J),^TMP("IBRESUB",$J),^TMP("IBNOT",$J),^TMP("IBONE",$J),^TMP("IBHDR",$J),^TMP("IBTX",$J),^TMP("IBEDI_TEST_BATCH",$J)
- K ^UTILITY("VADM",$J)
- D CLEAN^DILF
- K ZTREQ S ZTREQ="@"
- Q
- ;
- ALERT(XQAMSG,IBGRP) ; Send alert message
- N XQA
- S XQA(IBGRP)=""
- D SETUP^XQALERT
- Q
- CHKBTCH(IBBNO) ; Delete batch whose batch # is IBBNO if no entries in file 364
- ; and not a resubmitted batch
- N IBZ,DA,DIK
- S IBZ=+$O(^IBA(364.1,"B",+IBBNO,""))
- I IBZ,'$O(^IBA(364,"C",IBZ,0)),'$P($G(^IBA(364.1,IBZ,0)),U,14) S DA=IBZ,DIK="^IBA(364.1," D ^DIK
- Q
- ;
- TESTLIM(IBINS) ; Check for test bill limit per day has been reached
- N IB3,DA,DIK
- S IB3=$G(^DIC(36,IBINS,3))
- I $P(IB3,U,5)'=DT S $P(IB3,U,7)=0
- ;JWS;IB*2.0*623v24;for test env don't skip
- I '$$PROD^XUPROD(1) G 1
- I ($P(IB3,U,7)+$G(^TMP("IBICT",$J,IBINS))+1)>$P(IB3,U,6) D Q
- . S IBINS="" ;max # hit
- . S DA=IBX,DIK="^IBA(364," D ^DIK
- 1 S ^TMP("IBICT",$J,IBINS)=$G(^TMP("IBICT",$J,IBINS))+1
- Q
- ;
- SETVAR(IBXIEN,IBINS,IB0,IBSEC,IBNID,IB837R,IBDIV) ;
- ; Set up variables needed for subscripts in sort global
- ; ejk added IBSEC logic for patch 296
- ; IBSEC=1 if primary bill, 2 if 2nd/non-MRA, 3 if 2nd/MRA
- S IBSEC=$S($$COBN^IBCEF(IBXIEN)=1:1,'$$MRASEC^IBCEF4(IBXIEN):2,1:3)
- S IBNID=$$PAYERID^IBCEF2(IBXIEN)
- S IB837R=$$RECVR^IBCEF2(IBXIEN)
- S IBDIV=$P($S($P(IB0,U,22):$$SITE^VASITE(DT,$P(IB0,U,22)),1:$$SITE^VASITE()),U,3)
- I IBNID'="","RPIHS"[$E(IBNID),$E(IBNID,2,$L(IBNID))="PRNT" S IBNID=IBNID_"*"_IBINS
- I IBNID="" S IBNID="*"_IBINS
- S $P(IBNID,"*",3)=$S($P(IB0,U,22):$P(IB0,U,22),1:"")
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCE837A 9523 printed Feb 18, 2025@23:35:50 Page 2
- IBCE837A ;ALB/TMP - OUTPUT FOR 837 TRANSMISSION - CONTINUED ;8/6/03 10:50am
- +1 ;;2.0;INTEGRATED BILLING;**137,191,211,232,296,377,592,623,641,718**;21-MAR-94;Build 73
- +2 ;;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- UPD(MSGNUM,BATCH,CNT,BILLS,DESC,IBBTYP,IBINS) ; Upd current batch + bills w/new status
- +1 ;MSGNUM = mail msg # for batch
- +2 ;BATCH = batch #
- +3 ;CNT = # of bills in batch
- +4 ;BILLS = array BILLS(bill ien in 364) in batch
- +5 ;DESC = 1-80 character description of batch
- +6 ;IBBTYP = X-Y where X = P for professional, I for institution, or D for Dental ;JWS;IB*2.0*592;US131
- +7 ; Y = 1 for test or 0 for live transmission
- +8 ; or 2 for live claim resubmitted as test
- +9 ;IBINS = ien of single insurance company for the batch (optional)
- +10 ;
- +11 NEW DIC,DIE,DR,DA,IBBATCH,IBIFN,IBIEN,IBYY,IBTXTEST,IBMRA
- +12 SET IBBATCH=$ORDER(^IBA(364.1,"B",+BATCH,""))
- if 'IBBATCH
- QUIT
- +13 SET IBTXTEST=+$PIECE(IBBTYP,"-",2)
- +14 IF '$PIECE($GET(^IBE(350.9,1,8)),U,7)
- SET IBINS=""
- +15 ;
- +16 ;JWS;IB*2.0*641v14 update status to A0 for FHIR claims
- +17 SET DIE="^IBA(364.1,"
- SET DA=IBBATCH
- SET DR=".02////"_$SELECT($$GET1^DIQ(350.9,"1,",8.21,"I"):"A0",1:"P")_";.03///"_CNT_";.04///"_MSGNUM_";.05///0;.07////1;.08///^S X="""_DESC_""""_$SELECT($GET(IBINS):";.12////"_IBINS,1:"")
- +18 ;
- +19 IF '$PIECE($GET(^TMP("IBRESUBMIT",$JOB)),U,3)
- SET DR=DR_";1.01///NOW;1.02///.5"
- +20 IF $PIECE($GET(^TMP("IBRESUBMIT",$JOB)),U,2)
- SET DR=DR_";.15////"_$PIECE(^($JOB),U,2)
- +21 ;JWS;IB*2.0*592;US131
- +22 ; Update batch
- SET DR=DR_";.14////"_$SELECT('IBTXTEST:0,1:1)_";.06////"_$SELECT($EXTRACT(IBBTYP)="P":2,$EXTRACT(IBBTYP)="D":7,1:3)
- DO ^DIE
- +23 ;
- +24 IF IBTXTEST=2
- DO ADDTXM^IBCEPTM(.BILLS,IBBATCH,$$NOW^XLFDT())
- QUIT
- +25 ;Update each bill
- IF IBTXTEST'=2
- SET IBIEN=0
- FOR
- SET IBIEN=$ORDER(BILLS(IBIEN))
- if 'IBIEN
- QUIT
- Begin DoDot:1
- +26 ;JWS;IB*2.0*623;update field .09 837 FHIR ReQUEST if using 837 FHIR trans method
- +27 ;JWS;IB*2.0*641v14 update status to A0 for FHIR claims
- +28 SET DA=IBIEN
- SET DIE="^IBA(364,"
- SET DR=".02////"_IBBATCH_";.03///"_$SELECT($$GET1^DIQ(350.9,"1,",8.21,"I"):"A0",1:"P")_";.04///NOW"
- +29 IF $DATA(^IBA(364,"AC",1,DA))
- SET DR=DR_";.09////2"
- +30 DO ^DIE
- +31 SET IBIFN=+$GET(^IBA(364,IBIEN,0))
- +32 ; If this claim has just been retransmitted, set the .06 field for the previous transmission entry
- +33 NEW PRVTXI,PRVTXD
- +34 ; previous transmission for this claim
- SET PRVTXI=$ORDER(^IBA(364,"B",IBIFN,IBIEN),-1)
- +35 IF PRVTXI
- Begin DoDot:2
- +36 SET PRVTXD=$GET(^IBA(364,PRVTXI,0))
- +37 ; prev trans must have status of "R" or "E"
- IF '$FIND(".R.E.","."_$PIECE(PRVTXD,U,3)_".")
- QUIT
- +38 ; test bill and COB must be the same
- IF $PIECE(PRVTXD,U,7,8)'=$PIECE($GET(^IBA(364,IBIEN,0)),U,7,8)
- QUIT
- +39 ; update the resubmit batch number
- SET DA=PRVTXI
- SET DIE=364
- SET DR=".06///"_IBBATCH
- DO ^DIE
- +40 QUIT
- End DoDot:2
- +41 ;
- +42 if $DATA(^TMP("IBRESUBMIT",$JOB))!($PIECE($GET(^DGCR(399,IBIFN,0)),U,13)=4)!(+$$TXMT^IBCEF4(IBIEN)=2)
- QUIT
- +43 SET IBMRA=$$NEEDMRA^IBEFUNC(IBIFN)
- +44 IF IBMRA="C"
- IF $PIECE($GET(^DGCR(399,IBIFN,0)),U,13)=2
- SET IBMRA=1
- +45 IF IBIFN
- Begin DoDot:2
- +46 SET (DIC,DIE)="^DGCR(399,"
- SET DA=$PIECE($GET(^IBA(364,IBIEN,0)),U)
- SET DR="[IB STATUS]"
- SET IBYY=$SELECT('IBMRA:"@91",1:"@911")
- if DA
- DO ^DIE
- +47 ; remove from AB list
- DO BSTAT^IBCDC(IBIFN)
- End DoDot:2
- End DoDot:1
- +48 QUIT
- +49 ;
- PRE ; Run before processing a bill entry
- +1 KILL IBXSAVE,IBXERR,^UTILITY("VAPA",$JOB),^TMP("IBXSAVE",$JOB),^TMP($JOB),^TMP("DIERR",$JOB)
- +2 QUIT
- +3 ;
- POST ; Run after processing a bill entry for cleanup
- +1 NEW Q
- +2 IF $GET(IBXERR)'=""
- Begin DoDot:1
- +3 SET ^TMP("IBXERR",$JOB,IBXIEN)=IBXERR
- KILL ^TMP("IBXDATA",$JOB)
- +4 KILL ^TMP("IBHDR1",$JOB)
- +5 ;Set not resub flag for non-test bill
- IF $DATA(^TMP("IBRESUBMIT",$JOB))
- IF '$GET(^TMP("IBEDI_TEST_BATCH",$JOB))
- Begin DoDot:2
- +6 NEW Z,Z0
- +7 SET Z0=$PIECE($GET(^TMP("IBRESUBMIT",$JOB)),U)
- if Z0=""
- QUIT
- +8 SET Z=$ORDER(^IBA(364,"ABABI",+$ORDER(^IBA(364.1,"B",Z0,"")),IBXIEN,""))
- +9 IF Z
- SET ^TMP("IBNOT",$JOB,Z)=IBXIEN
- End DoDot:2
- End DoDot:1
- +10 KILL IBXSAVE,IBXNOREQ,^TMP("IBXSAVE",$JOB),^TMP($JOB)
- +11 ;;IB*2.0*718;JWS;12/27/21;EBILL-1629;Incorporate FSC Overrides
- +12 DO POST^IBCE837P
- +13 SET Q="VA"
- FOR
- SET Q=$ORDER(^UTILITY(Q))
- if $EXTRACT(Q,1,2)'="VA"
- QUIT
- IF $DATA(^(Q,$JOB))
- KILL ^UTILITY(Q,$JOB)
- +14 DO CLEAN^DILF
- +15 QUIT
- +16 ;
- MAILIT(IBQUEUE,IBBILL,IBCTM,IBDUZ,IBDESC,IBBTYP,IBINS) ; Send mail msg, update bills
- +1 ;IBQUEUE = mail queue name to send 837 transactions to
- +2 ;IBBILL = array of ien's in file 364 of bills in batch - IBBILL(IEN)=""
- +3 ;IBCTM = # of bills in batch, returned reset to 0
- +4 ;IBDUZ = ien of user 'running' extract (if any)
- +5 ;IBDESC = description of batch
- +6 ;IBBTYP = X-Y where X = P for professional, I for institution, or D for Dental ;JWS;IB*2.0*592;US131
- +7 ; Y = 1 or 2 for test or 0 for live transmission
- +8 ;IBINS = ien of insurance company if only one/batch option (optional)
- +9 ;
- +10 NEW DIK,DA,XMTO,XMZ,XMBODY,XMDUZ,XMSUBJ,IBBDA,IBBNO
- +11 ;
- +12 SET IBBNO=+$PIECE($GET(^TMP("IBHDR",$JOB)),U)
- SET IBBDA=$ORDER(^IBA(364.1,"B",IBBNO,""))
- +13 IF '$PIECE($GET(^IBE(350.9,1,8)),U,7)
- SET IBINS=""
- +14 ;
- +15 IF IBCTM
- Begin DoDot:1
- +16 ;JWS;IB*2.0*623
- +17 ;G MAILQ
- IF $$GET1^DIQ(350.9,"1,",8.21,"I")
- QUIT
- +18 IF +$GET(^TMP("IBEDI_TEST_BATCH",$JOB))
- SET IBQUEUE="MCT"
- +19 IF IBQUEUE'=""
- IF IBQUEUE'["@"
- SET XMTO("XXX@Q-"_IBQUEUE_".DOMAIN.EXT")=""
- +20 ;
- +21 ; ******Note to self - remove when going to sites although it shouldn't hurt if you forget - WCJ **********
- +22 IF '$$PROD^XUPROD(1)
- SET XMTO("G.CLAIMS4US")=""
- +23 ;
- +24 IF IBQUEUE["@"
- SET XMTO(IBQUEUE)=""
- +25 SET XMDUZ=$GET(IBDUZ)
- SET XMBODY="^TMP(""IBXMSG"","_$JOB_")"
- SET XMSUBJ=$SELECT($PIECE(IBBTYP,U,2):"** TEST"_$SELECT($PIECE(IBBTYP,U,2)=2:"/RESUB OF LIVE",1:""),1:"")_" CLAIM BATCH: "_$SELECT(IBQUEUE'["@":IBQUEUE,1:$PIECE(IBQUEUE,"@"))_"/"_IBBNO
- +26 KILL XMZ
- +27 DO SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO,,.XMZ)
- +28 IF $GET(XMZ)
- Begin DoDot:2
- +29 ;Update batch/bills
- DO UPD(XMZ,$PIECE($GET(^TMP("IBHDR",$JOB)),U),IBCTM,.IBBILL,IBDESC,IBBTYP,IBINS)
- +30 SET ^TMP("IBCE-BATCH",$JOB,IBBNO)=IBBDA_U_IBCTM_U_$PIECE($GET(^TMP("IBRESUBMIT",$JOB)),U)
- End DoDot:2
- End DoDot:1
- MAILQ ;
- +1 SET IBCTM=0
- +2 ;JWS;IB*2.0*623;do not do for FHIR transmissions
- +3 IF '$$GET1^DIQ(350.9,"1,",8.21,"I")
- DO CHKBTCH(+$GET(^TMP("IBHDR",$JOB)))
- +4 KILL ^TMP("IBHDR",$JOB),^TMP("IBHDR1",$JOB),^TMP("IBXMSG",$JOB),IBBILL
- +5 QUIT
- +6 ;
- CHKNEW(IBQ,IBBILL,IBCTM,IBDESC,IBBTYP,IBINS,IBSITE,IBSIZE) ;
- +1 ; Determine if ok to send msg
- +2 ; Check for one insurance per batch if IBINS defined
- +3 ; Returns IBSIZE, IBCTM, IBBILL (pass by reference)
- +4 ;
- +5 ; IBQ = data queue name
- +6 ; IBBILL = the 'list' of bill #'s in the batch
- +7 ; IBCTM = the # of claims output so far to the batch
- +8 ; IBDESC = the batch description text
- +9 ; IBBTYP = X-Y where X = P for professional, I for institution, or D for Dental
- +10 ; Y = 1 for test or 0 for live transmission
- +11 ; IBINS = the ien of the single insurance co. for the batch (optional)
- +12 ; IBSITE = the '8' node of file 350.9 (IB PARAMETERS)
- +13 ; IBSIZE = the 'running' size of the output message
- +14 ;
- +15 if $SELECT($GET(IBINS)=""
- QUIT
- +16 ;
- +17 ; New batch needed
- +18 IF IBCTM
- DO MAILIT(IBQ,.IBBILL,.IBCTM,"",IBDESC,IBBTYP,IBINS)
- SET IBSIZE=0
- +19 QUIT
- +20 ;
- ERRMSG(XMBODY) ; Send bulletin for error message
- +1 NEW XMTO,XMSUBJ
- +2 SET XMTO("I:G.IB EDI")=""
- SET XMSUBJ="EDI 837 TRANSMISSION ERRORS"
- +3 ;
- +4 DO SENDMSG^XMXAPI(,XMSUBJ,XMBODY,.XMTO)
- +5 DO ALERT("One or more EDI bills were not transmitted. Check your mail for details","G.IB EDI")
- +6 QUIT
- +7 ;
- CLEANUP ; Cleans up bill transmission environment
- +1 ;
- +2 NEW IBTEST
- +3 SET IBTEST=+$GET(^TMP("IBEDI_TEST_BATCH",$JOB))
- +4 LOCK -^IBA(364,0)
- +5 ;Error message to mail group
- IF $DATA(^TMP("IBRESUBMIT",$JOB,"IBXERR"))!$DATA(^TMP("IBONE",$JOB,"IBXERR"))!$DATA(^TMP("IBSELX",$JOB,"IBXERR"))
- Begin DoDot:1
- +6 NEW XMTO,XMBODY,XMDUZ,XMSUBJ,XMZ,IBFUNC
- +7 SET IBFUNC=$SELECT($DATA(^TMP("IBRESUBMIT",$JOB,"IBXERR")):$SELECT('IBTEST:1,1:4),$DATA(^TMP("IBONE",$JOB,"IBXERR")):2,1:3)
- +8 if 'IBFUNC
- QUIT
- +9 SET XMTO("I:G.IB EDI")=""
- SET XMDUZ=""
- SET XMBODY="^TMP("""_$SELECT(IBFUNC=1!(IBFUNC=4):"IBRESUBMIT",1:"IBONE")_""","_$JOB_",""IBXERR"")"
- +10 SET XMSUBJ="EDI 837 B"_$PIECE("ATCH^ILL^ILL(s)^ILL(s)",U,IBFUNC)_" NOT "_$SELECT($GET(^TMP("IBONE",$JOB)):"RE",1:"")_"SUBMITTED"_$SELECT('IBTEST:"",1:" AS TEST CLAIMS")
- +11 DO SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO,,.XMZ)
- +12 KILL ^TMP("IBRESUBMIT",$JOB),^TMP("IBONE",$JOB)
- End DoDot:1
- +13 ;
- +14 ;Upd resubmtd batch bills
- IF $DATA(^TMP("IBRESUBMIT",$JOB))
- IF 'IBTEST
- DO RESUBUP^IBCEM02
- +15 IF '$DATA(^TMP("IBSELX",$JOB))
- KILL ^TMP("IBCE-BATCH",$JOB)
- +16 KILL ^TMP("IBXERR",$JOB),IBXERR
- +17 IF 'IBTEST
- DO CHKBTCH(+$GET(^TMP("IBHDR",$JOB)))
- CLEANP ; Entrypoint for extract data disply
- +1 KILL ^TMP("IBTXMT",$JOB),^TMP("IBXINS",$JOB)
- +2 KILL ^TMP("IBRESUBMIT",$JOB),^TMP("IBRESUB",$JOB),^TMP("IBNOT",$JOB),^TMP("IBONE",$JOB),^TMP("IBHDR",$JOB),^TMP("IBTX",$JOB),^TMP("IBEDI_TEST_BATCH",$JOB)
- +3 KILL ^UTILITY("VADM",$JOB)
- +4 DO CLEAN^DILF
- +5 KILL ZTREQ
- SET ZTREQ="@"
- +6 QUIT
- +7 ;
- ALERT(XQAMSG,IBGRP) ; Send alert message
- +1 NEW XQA
- +2 SET XQA(IBGRP)=""
- +3 DO SETUP^XQALERT
- +4 QUIT
- CHKBTCH(IBBNO) ; Delete batch whose batch # is IBBNO if no entries in file 364
- +1 ; and not a resubmitted batch
- +2 NEW IBZ,DA,DIK
- +3 SET IBZ=+$ORDER(^IBA(364.1,"B",+IBBNO,""))
- +4 IF IBZ
- IF '$ORDER(^IBA(364,"C",IBZ,0))
- IF '$PIECE($GET(^IBA(364.1,IBZ,0)),U,14)
- SET DA=IBZ
- SET DIK="^IBA(364.1,"
- DO ^DIK
- +5 QUIT
- +6 ;
- TESTLIM(IBINS) ; Check for test bill limit per day has been reached
- +1 NEW IB3,DA,DIK
- +2 SET IB3=$GET(^DIC(36,IBINS,3))
- +3 IF $PIECE(IB3,U,5)'=DT
- SET $PIECE(IB3,U,7)=0
- +4 ;JWS;IB*2.0*623v24;for test env don't skip
- +5 IF '$$PROD^XUPROD(1)
- GOTO 1
- +6 IF ($PIECE(IB3,U,7)+$GET(^TMP("IBICT",$JOB,IBINS))+1)>$PIECE(IB3,U,6)
- Begin DoDot:1
- +7 ;max # hit
- SET IBINS=""
- +8 SET DA=IBX
- SET DIK="^IBA(364,"
- DO ^DIK
- End DoDot:1
- QUIT
- 1 SET ^TMP("IBICT",$JOB,IBINS)=$GET(^TMP("IBICT",$JOB,IBINS))+1
- +1 QUIT
- +2 ;
- SETVAR(IBXIEN,IBINS,IB0,IBSEC,IBNID,IB837R,IBDIV) ;
- +1 ; Set up variables needed for subscripts in sort global
- +2 ; ejk added IBSEC logic for patch 296
- +3 ; IBSEC=1 if primary bill, 2 if 2nd/non-MRA, 3 if 2nd/MRA
- +4 SET IBSEC=$SELECT($$COBN^IBCEF(IBXIEN)=1:1,'$$MRASEC^IBCEF4(IBXIEN):2,1:3)
- +5 SET IBNID=$$PAYERID^IBCEF2(IBXIEN)
- +6 SET IB837R=$$RECVR^IBCEF2(IBXIEN)
- +7 SET IBDIV=$PIECE($SELECT($PIECE(IB0,U,22):$$SITE^VASITE(DT,$PIECE(IB0,U,22)),1:$$SITE^VASITE()),U,3)
- +8 IF IBNID'=""
- IF "RPIHS"[$EXTRACT(IBNID)
- IF $EXTRACT(IBNID,2,$LENGTH(IBNID))="PRNT"
- SET IBNID=IBNID_"*"_IBINS
- +9 IF IBNID=""
- SET IBNID="*"_IBINS
- +10 SET $PIECE(IBNID,"*",3)=$SELECT($PIECE(IB0,U,22):$PIECE(IB0,U,22),1:"")
- +11 QUIT
- +12 ;