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

IBCE837A.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. UPD(MSGNUM,BATCH,CNT,BILLS,DESC,IBBTYP,IBINS) ; Upd current batch + bills w/new status
  1. ;MSGNUM = mail msg # for batch
  1. ;BATCH = batch #
  1. ;CNT = # of bills in batch
  1. ;BILLS = array BILLS(bill ien in 364) in batch
  1. ;DESC = 1-80 character description of batch
  1. ;IBBTYP = X-Y where X = P for professional, I for institution, or D for Dental ;JWS;IB*2.0*592;US131
  1. ; Y = 1 for test or 0 for live transmission
  1. ; or 2 for live claim resubmitted as test
  1. ;IBINS = ien of single insurance company for the batch (optional)
  1. ;
  1. N DIC,DIE,DR,DA,IBBATCH,IBIFN,IBIEN,IBYY,IBTXTEST,IBMRA
  1. S IBBATCH=$O(^IBA(364.1,"B",+BATCH,"")) Q:'IBBATCH
  1. S IBTXTEST=+$P(IBBTYP,"-",2)
  1. I '$P($G(^IBE(350.9,1,8)),U,7) S IBINS=""
  1. ;
  1. ;JWS;IB*2.0*641v14 update status to A0 for FHIR claims
  1. 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:"")
  1. ;
  1. I '$P($G(^TMP("IBRESUBMIT",$J)),U,3) S DR=DR_";1.01///NOW;1.02///.5"
  1. I $P($G(^TMP("IBRESUBMIT",$J)),U,2) S DR=DR_";.15////"_$P(^($J),U,2)
  1. ;JWS;IB*2.0*592;US131
  1. 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
  1. ;
  1. I IBTXTEST=2 D ADDTXM^IBCEPTM(.BILLS,IBBATCH,$$NOW^XLFDT()) Q
  1. I IBTXTEST'=2 S IBIEN=0 F S IBIEN=$O(BILLS(IBIEN)) Q:'IBIEN D ;Update each bill
  1. . ;JWS;IB*2.0*623;update field .09 837 FHIR ReQUEST if using 837 FHIR trans method
  1. . ;JWS;IB*2.0*641v14 update status to A0 for FHIR claims
  1. . S DA=IBIEN,DIE="^IBA(364,",DR=".02////"_IBBATCH_";.03///"_$S($$GET1^DIQ(350.9,"1,",8.21,"I"):"A0",1:"P")_";.04///NOW"
  1. . I $D(^IBA(364,"AC",1,DA)) S DR=DR_";.09////2"
  1. . D ^DIE
  1. . S IBIFN=+$G(^IBA(364,IBIEN,0))
  1. . ; If this claim has just been retransmitted, set the .06 field for the previous transmission entry
  1. . N PRVTXI,PRVTXD
  1. . S PRVTXI=$O(^IBA(364,"B",IBIFN,IBIEN),-1) ; previous transmission for this claim
  1. . I PRVTXI D
  1. .. S PRVTXD=$G(^IBA(364,PRVTXI,0))
  1. .. I '$F(".R.E.","."_$P(PRVTXD,U,3)_".") Q ; prev trans must have status of "R" or "E"
  1. .. I $P(PRVTXD,U,7,8)'=$P($G(^IBA(364,IBIEN,0)),U,7,8) Q ; test bill and COB must be the same
  1. .. S DA=PRVTXI,DIE=364,DR=".06///"_IBBATCH D ^DIE ; update the resubmit batch number
  1. .. Q
  1. . ;
  1. .Q:$D(^TMP("IBRESUBMIT",$J))!($P($G(^DGCR(399,IBIFN,0)),U,13)=4)!(+$$TXMT^IBCEF4(IBIEN)=2)
  1. .S IBMRA=$$NEEDMRA^IBEFUNC(IBIFN)
  1. .I IBMRA="C",$P($G(^DGCR(399,IBIFN,0)),U,13)=2 S IBMRA=1
  1. .I IBIFN D
  1. ..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
  1. ..D BSTAT^IBCDC(IBIFN) ; remove from AB list
  1. Q
  1. ;
  1. PRE ; Run before processing a bill entry
  1. K IBXSAVE,IBXERR,^UTILITY("VAPA",$J),^TMP("IBXSAVE",$J),^TMP($J),^TMP("DIERR",$J)
  1. Q
  1. ;
  1. POST ; Run after processing a bill entry for cleanup
  1. N Q
  1. I $G(IBXERR)'="" D
  1. .S ^TMP("IBXERR",$J,IBXIEN)=IBXERR K ^TMP("IBXDATA",$J)
  1. .K ^TMP("IBHDR1",$J)
  1. .I $D(^TMP("IBRESUBMIT",$J)),'$G(^TMP("IBEDI_TEST_BATCH",$J)) D ;Set not resub flag for non-test bill
  1. ..N Z,Z0
  1. ..S Z0=$P($G(^TMP("IBRESUBMIT",$J)),U) Q:Z0=""
  1. ..S Z=$O(^IBA(364,"ABABI",+$O(^IBA(364.1,"B",Z0,"")),IBXIEN,""))
  1. ..I Z S ^TMP("IBNOT",$J,Z)=IBXIEN
  1. K IBXSAVE,IBXNOREQ,^TMP("IBXSAVE",$J),^TMP($J)
  1. ;;IB*2.0*718;JWS;12/27/21;EBILL-1629;Incorporate FSC Overrides
  1. D POST^IBCE837P
  1. S Q="VA" F S Q=$O(^UTILITY(Q)) Q:$E(Q,1,2)'="VA" I $D(^(Q,$J)) K ^UTILITY(Q,$J)
  1. D CLEAN^DILF
  1. Q
  1. ;
  1. MAILIT(IBQUEUE,IBBILL,IBCTM,IBDUZ,IBDESC,IBBTYP,IBINS) ; Send mail msg, update bills
  1. ;IBQUEUE = mail queue name to send 837 transactions to
  1. ;IBBILL = array of ien's in file 364 of bills in batch - IBBILL(IEN)=""
  1. ;IBCTM = # of bills in batch, returned reset to 0
  1. ;IBDUZ = ien of user 'running' extract (if any)
  1. ;IBDESC = description of batch
  1. ;IBBTYP = X-Y where X = P for professional, I for institution, or D for Dental ;JWS;IB*2.0*592;US131
  1. ; Y = 1 or 2 for test or 0 for live transmission
  1. ;IBINS = ien of insurance company if only one/batch option (optional)
  1. ;
  1. N DIK,DA,XMTO,XMZ,XMBODY,XMDUZ,XMSUBJ,IBBDA,IBBNO
  1. ;
  1. S IBBNO=+$P($G(^TMP("IBHDR",$J)),U),IBBDA=$O(^IBA(364.1,"B",IBBNO,""))
  1. I '$P($G(^IBE(350.9,1,8)),U,7) S IBINS=""
  1. ;
  1. I IBCTM D
  1. . ;JWS;IB*2.0*623
  1. . I $$GET1^DIQ(350.9,"1,",8.21,"I") Q ;G MAILQ
  1. . I +$G(^TMP("IBEDI_TEST_BATCH",$J)) S IBQUEUE="MCT"
  1. . I IBQUEUE'="",IBQUEUE'["@" S XMTO("XXX@Q-"_IBQUEUE_".DOMAIN.EXT")=""
  1. . ;
  1. . ; ******Note to self - remove when going to sites although it shouldn't hurt if you forget - WCJ **********
  1. . I '$$PROD^XUPROD(1) S XMTO("G.CLAIMS4US")=""
  1. . ;
  1. . I IBQUEUE["@" S XMTO(IBQUEUE)=""
  1. . 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
  1. . K XMZ
  1. . D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO,,.XMZ)
  1. . I $G(XMZ) D
  1. .. D UPD(XMZ,$P($G(^TMP("IBHDR",$J)),U),IBCTM,.IBBILL,IBDESC,IBBTYP,IBINS) ;Update batch/bills
  1. .. S ^TMP("IBCE-BATCH",$J,IBBNO)=IBBDA_U_IBCTM_U_$P($G(^TMP("IBRESUBMIT",$J)),U)
  1. MAILQ ;
  1. S IBCTM=0
  1. ;JWS;IB*2.0*623;do not do for FHIR transmissions
  1. I '$$GET1^DIQ(350.9,"1,",8.21,"I") D CHKBTCH(+$G(^TMP("IBHDR",$J)))
  1. K ^TMP("IBHDR",$J),^TMP("IBHDR1",$J),^TMP("IBXMSG",$J),IBBILL
  1. Q
  1. ;
  1. CHKNEW(IBQ,IBBILL,IBCTM,IBDESC,IBBTYP,IBINS,IBSITE,IBSIZE) ;
  1. ; Determine if ok to send msg
  1. ; Check for one insurance per batch if IBINS defined
  1. ; Returns IBSIZE, IBCTM, IBBILL (pass by reference)
  1. ;
  1. ; IBQ = data queue name
  1. ; IBBILL = the 'list' of bill #'s in the batch
  1. ; IBCTM = the # of claims output so far to the batch
  1. ; IBDESC = the batch description text
  1. ; IBBTYP = X-Y where X = P for professional, I for institution, or D for Dental
  1. ; Y = 1 for test or 0 for live transmission
  1. ; IBINS = the ien of the single insurance co. for the batch (optional)
  1. ; IBSITE = the '8' node of file 350.9 (IB PARAMETERS)
  1. ; IBSIZE = the 'running' size of the output message
  1. ;
  1. Q:$S($G(IBINS)="":0,1:'$P(IBSITE,U,7))
  1. ;
  1. ; New batch needed
  1. I IBCTM D MAILIT(IBQ,.IBBILL,.IBCTM,"",IBDESC,IBBTYP,IBINS) S IBSIZE=0
  1. Q
  1. ;
  1. ERRMSG(XMBODY) ; Send bulletin for error message
  1. N XMTO,XMSUBJ
  1. S XMTO("I:G.IB EDI")="",XMSUBJ="EDI 837 TRANSMISSION ERRORS"
  1. ;
  1. D SENDMSG^XMXAPI(,XMSUBJ,XMBODY,.XMTO)
  1. D ALERT("One or more EDI bills were not transmitted. Check your mail for details","G.IB EDI")
  1. Q
  1. ;
  1. CLEANUP ; Cleans up bill transmission environment
  1. ;
  1. N IBTEST
  1. S IBTEST=+$G(^TMP("IBEDI_TEST_BATCH",$J))
  1. L -^IBA(364,0)
  1. I $D(^TMP("IBRESUBMIT",$J,"IBXERR"))!$D(^TMP("IBONE",$J,"IBXERR"))!$D(^TMP("IBSELX",$J,"IBXERR")) D ;Error message to mail group
  1. . N XMTO,XMBODY,XMDUZ,XMSUBJ,XMZ,IBFUNC
  1. . S IBFUNC=$S($D(^TMP("IBRESUBMIT",$J,"IBXERR")):$S('IBTEST:1,1:4),$D(^TMP("IBONE",$J,"IBXERR")):2,1:3)
  1. . Q:'IBFUNC
  1. . S XMTO("I:G.IB EDI")="",XMDUZ="",XMBODY="^TMP("""_$S(IBFUNC=1!(IBFUNC=4):"IBRESUBMIT",1:"IBONE")_""","_$J_",""IBXERR"")"
  1. . 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")
  1. . D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO,,.XMZ)
  1. . K ^TMP("IBRESUBMIT",$J),^TMP("IBONE",$J)
  1. ;
  1. I $D(^TMP("IBRESUBMIT",$J)),'IBTEST D RESUBUP^IBCEM02 ;Upd resubmtd batch bills
  1. I '$D(^TMP("IBSELX",$J)) K ^TMP("IBCE-BATCH",$J)
  1. K ^TMP("IBXERR",$J),IBXERR
  1. I 'IBTEST D CHKBTCH(+$G(^TMP("IBHDR",$J)))
  1. CLEANP ; Entrypoint for extract data disply
  1. K ^TMP("IBTXMT",$J),^TMP("IBXINS",$J)
  1. K ^TMP("IBRESUBMIT",$J),^TMP("IBRESUB",$J),^TMP("IBNOT",$J),^TMP("IBONE",$J),^TMP("IBHDR",$J),^TMP("IBTX",$J),^TMP("IBEDI_TEST_BATCH",$J)
  1. K ^UTILITY("VADM",$J)
  1. D CLEAN^DILF
  1. K ZTREQ S ZTREQ="@"
  1. Q
  1. ;
  1. ALERT(XQAMSG,IBGRP) ; Send alert message
  1. N XQA
  1. S XQA(IBGRP)=""
  1. D SETUP^XQALERT
  1. Q
  1. CHKBTCH(IBBNO) ; Delete batch whose batch # is IBBNO if no entries in file 364
  1. ; and not a resubmitted batch
  1. N IBZ,DA,DIK
  1. S IBZ=+$O(^IBA(364.1,"B",+IBBNO,""))
  1. 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
  1. Q
  1. ;
  1. TESTLIM(IBINS) ; Check for test bill limit per day has been reached
  1. N IB3,DA,DIK
  1. S IB3=$G(^DIC(36,IBINS,3))
  1. I $P(IB3,U,5)'=DT S $P(IB3,U,7)=0
  1. ;JWS;IB*2.0*623v24;for test env don't skip
  1. I '$$PROD^XUPROD(1) G 1
  1. I ($P(IB3,U,7)+$G(^TMP("IBICT",$J,IBINS))+1)>$P(IB3,U,6) D Q
  1. . S IBINS="" ;max # hit
  1. . S DA=IBX,DIK="^IBA(364," D ^DIK
  1. 1 S ^TMP("IBICT",$J,IBINS)=$G(^TMP("IBICT",$J,IBINS))+1
  1. Q
  1. ;
  1. SETVAR(IBXIEN,IBINS,IB0,IBSEC,IBNID,IB837R,IBDIV) ;
  1. ; Set up variables needed for subscripts in sort global
  1. ; ejk added IBSEC logic for patch 296
  1. ; IBSEC=1 if primary bill, 2 if 2nd/non-MRA, 3 if 2nd/MRA
  1. S IBSEC=$S($$COBN^IBCEF(IBXIEN)=1:1,'$$MRASEC^IBCEF4(IBXIEN):2,1:3)
  1. S IBNID=$$PAYERID^IBCEF2(IBXIEN)
  1. S IB837R=$$RECVR^IBCEF2(IBXIEN)
  1. S IBDIV=$P($S($P(IB0,U,22):$$SITE^VASITE(DT,$P(IB0,U,22)),1:$$SITE^VASITE()),U,3)
  1. I IBNID'="","RPIHS"[$E(IBNID),$E(IBNID,2,$L(IBNID))="PRNT" S IBNID=IBNID_"*"_IBINS
  1. I IBNID="" S IBNID="*"_IBINS
  1. S $P(IBNID,"*",3)=$S($P(IB0,U,22):$P(IB0,U,22),1:"")
  1. Q
  1. ;