| 1 | IBCE837 ;ALB/TMP - OUTPUT FOR 837 TRANSMISSION ;8/6/03 10:48am
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**137,191,197,232,296,349**;21-MAR-94;Build 46
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | EN ; Auto-txmt
|
|---|
| 6 | N IBSITE8,IBRUN,X,X1,X2,DA,DIE,DR
|
|---|
| 7 | K ^TMP("IBRESUBMIT",$J),^TMP("IBONE",$J)
|
|---|
| 8 | S IBSITE8=$G(^IBE(350.9,1,8)),IBRUN=1
|
|---|
| 9 | Q:'$P(IBSITE8,U,3)!'$P(IBSITE8,U,10)
|
|---|
| 10 | I '$$MGCHK^IBCE(0) Q
|
|---|
| 11 | I $P(IBSITE8,U,5) D Q:'IBRUN
|
|---|
| 12 | . S X2=+$P(IBSITE8,U,3),X1=$P(IBSITE8,U,5) D C^%DTC
|
|---|
| 13 | . I X>DT S IBRUN=0 Q
|
|---|
| 14 | D QTXMT^IBCE837B(IBSITE8)
|
|---|
| 15 | I $P(IBSITE8,U,5)'=DT S DIE="^IBE(350.9,",DR="8.05////"_DT,DA=1 D ^DIE
|
|---|
| 16 | Q
|
|---|
| 17 | ;
|
|---|
| 18 | SETUP(IBEXTRP) ; Txmn set up
|
|---|
| 19 | ; IBEXTRP=1 prnt 837 data
|
|---|
| 20 | N IB
|
|---|
| 21 | K ^TMP("IBXMSG",$J),^TMP("IBTXMT",$J),^TMP("IBHDR",$J),^TMP("IBHDR1",$J),^TMP("IBXERR",$J),IBXERR,^TMP("IBXINS",$J),^TMP("IBTX",$J),^TMP("IBEDI_TEST_BATCH",$J)
|
|---|
| 22 | ; Chk extract running
|
|---|
| 23 | Q:$G(IBEXTRP)
|
|---|
| 24 | ; Chk resubmit tst
|
|---|
| 25 | I $P($G(^TMP("IBRESUBMIT",$J)),U,4) S ^TMP("IBEDI_TEST_BATCH",$J)=1 Q
|
|---|
| 26 | I '$D(^TMP("IBRESUBMIT",$J)),'$D(^TMP("IBONE",$J)) D Q:$D(IBXERR)
|
|---|
| 27 | . L +^IBA(364,0):5
|
|---|
| 28 | . I '$T D Q
|
|---|
| 29 | .. S IBXERR=1,^TMP("IBXERR",$J,1)="A PREVIOUS EDI EXTRACT IS RUNNING - ANOTHER CANNOT BE STARTED "_$$FMTE^XLFDT($$NOW^XLFDT(),2)
|
|---|
| 30 | ;
|
|---|
| 31 | I $D(^TMP("IBRESUBMIT",$J)) D Q:$D(IBXERR)
|
|---|
| 32 | .N Z,Z0
|
|---|
| 33 | .S Z0=$P($G(^TMP("IBRESUBMIT",$J)),U,2),Z=$$LOCK^IBCEM02(364.1,Z0)
|
|---|
| 34 | .I 'Z D
|
|---|
| 35 | ..S IBXERR=1
|
|---|
| 36 | ..S ^TMP("IBRESUBMIT",$J,"IBXERR",1)="Another user is currently processing batch "_Z0_". Batch NOT resubmitted."
|
|---|
| 37 | .I 'Z D
|
|---|
| 38 | ..S IBXERR=1
|
|---|
| 39 | ..S ^TMP("IBRESUBMIT",$J,"IBXERR",1)="Another user is currently processing batch "_Z0_". Batch NOT resubmitted."
|
|---|
| 40 | ..S ^TMP("IBRESUBMIT",$J,"IBXERR",2)="Resubmit was attempted by: "_$P($G(^VA(200,DUZ,0)),U)_" ("_DUZ_")"
|
|---|
| 41 | I $D(^TMP("IBONE",$J)) S IB=$G(^($J))+1 D Q:$D(IBXERR)
|
|---|
| 42 | .N Z,Z0
|
|---|
| 43 | .S Z0=$O(^TMP("IBONE",$J,"")),Z=$$LOCK^IBCEM02(364,Z0)
|
|---|
| 44 | .I 'Z D
|
|---|
| 45 | ..S IBXERR=1
|
|---|
| 46 | ..S ^TMP("IBONE",$J,"IBXERR",1)="Another user is currently processing bill "_$P($G(^DGCR(399,+$G(^IBA(364,Z0,0)),0)),U)_". Bill NOT "_$P("^re",U,IB)_"submitted."
|
|---|
| 47 | ..S ^TMP("IBONE",$J,"IBXERR",2)=$P("S^Res",U,IB)_"ubmit was attempted by: "_$P($G(^VA(200,DUZ,0)),U)_" ("_DUZ_")"
|
|---|
| 48 | Q
|
|---|
| 49 | ;
|
|---|
| 50 | FIND ; Find/sort by CMS-1500/UB-04, test/live, ins ID # & div
|
|---|
| 51 | ;
|
|---|
| 52 | N IBX,IB0,IBCBH,IBINS,IBXIEN,IBNID,IBGBL,IBTXTEST,IBBTYP,IB837R,IBDIV,IBNOTX,IBTXST,IBTEST,IBSEC
|
|---|
| 53 | K ^TMP($J,"BILL"),^TMP("IBICT",$J)
|
|---|
| 54 | ;
|
|---|
| 55 | S IBGBL=$S($D(^TMP("IBONE",$J)):"^TMP(""IBONE"","_$J_")",$D(^TMP("IBSELX",$J)):"^TMP(""IBSELX"","_$J_")",'$D(^TMP("IBRESUBMIT",$J)):"^IBA(364,""ASTAT"",""X"")",1:"^TMP(""IBRESUBMIT"","_$J_")")
|
|---|
| 56 | S IBTEST=+$G(^TMP("IBEDI_TEST_BATCH",$J))
|
|---|
| 57 | ;
|
|---|
| 58 | S IBX="" F S IBX=$O(@IBGBL@(IBX)) Q:'IBX D
|
|---|
| 59 | .S IBXIEN=+$G(^IBA(364,IBX,0)),IB0=$G(^DGCR(399,IBXIEN,0))
|
|---|
| 60 | .S IBTXST=$$TXMT^IBCEF4(IBXIEN,.IBNOTX)
|
|---|
| 61 | .Q:IBTXST="" ; no txmt
|
|---|
| 62 | .Q:$S(IB0="":1,$P(IB0,U,13)>4&'IBTEST:1,1:$D(^TMP($J,"BILL",$P(IB0,U))))
|
|---|
| 63 | .S IBCBH=$P(IB0,U,21) S:"PST"'[IBCBH!(IBCBH="") IBCBH="P"
|
|---|
| 64 | .S IBINS=$P($G(^DGCR(399,IBXIEN,"I"_($F("PST",IBCBH)-1))),U)
|
|---|
| 65 | .S IBTXTEST=$S(IBTEST:2,1:+$$TEST^IBCEF4(IBXIEN))
|
|---|
| 66 | .S IBBTYP=$P("P^I",U,($$FT^IBCEF(IBXIEN)=3)+1)_"-"_IBTXTEST
|
|---|
| 67 | .Q:$$TESTPT^IBCEU($P(IB0,U,2))&'IBTXTEST ;Test pt
|
|---|
| 68 | .;
|
|---|
| 69 | .I IBTXTEST=1 D TESTLIM^IBCE837A(.IBINS)
|
|---|
| 70 | .;
|
|---|
| 71 | .I IBINS,$P(IB0,U,2) D
|
|---|
| 72 | .. D SETVAR^IBCE837A(IBXIEN,IBINS,IB0,.IBSEC,.IBNID,.IB837R,.IBDIV)
|
|---|
| 73 | ..S:'$D(^TMP("IBXINS",$J,IBDIV_U_IBBTYP,IBNID)) ^(IBNID)=IBINS S ^TMP("IBTXMT",$J,IBDIV_U_IBBTYP,IB837R_U_IBSEC,IBNID,$P(IB0,U,2),IBXIEN_U_IBX)=IBX
|
|---|
| 74 | .;
|
|---|
| 75 | .S ^TMP($J,"BILL",$P(IB0,U))=""
|
|---|
| 76 | ;
|
|---|
| 77 | I $D(^TMP("IBTXMT",$J)) S ^TMP("IBXDATA",$J)=IBNID
|
|---|
| 78 | K ^TMP($J,"BILL")
|
|---|
| 79 | Q
|
|---|
| 80 | ;
|
|---|
| 81 | OUTPUT ; 837
|
|---|
| 82 | ;
|
|---|
| 83 | N IB837,IBSITE,IBMAX,IBQUEUE,IBTQUEUE,IBNID,IBCT,IBCTM,IBSIZE,IBBILL,IBLCNT,IBDFN,IBREF,IBSIZEM,IBPARMS,IBD,IBDESC,IBINS,IBQ,IB3,IBBTYP,IBTXTEST,IBDEFPRT,IB837R,IBBTYPX
|
|---|
| 84 | ;
|
|---|
| 85 | K ^TMP("IBCE-BATCH",$J)
|
|---|
| 86 | S IBSITE=$G(^IBE(350.9,1,8)),IBMAX=$P(IBSITE,U,4),IB837=+$O(^IBE(353,"B","IB 837 TRANSMISSION",0)),IB837=$S($P($G(^IBE(353,+IB837,2)),U,8):$P(^(2),U,8),1:IB837) S:'IBMAX IBMAX=999
|
|---|
| 87 | ;
|
|---|
| 88 | I 'IB837 D Q
|
|---|
| 89 | . N IBZ,XMBODY
|
|---|
| 90 | . S XMBODY="IBZ"
|
|---|
| 91 | . S IBZ(1)="The transmission form for sending electronic claims is not in your form file",IBZ(2)="NO CLAIMS WERE OUTPUT - FORM = IB 837 TRANSMISSION"
|
|---|
| 92 | . D ERRMSG^IBCE837A(XMBODY)
|
|---|
| 93 | ;
|
|---|
| 94 | S (IBCT,IBCTM,IBSIZE)=0,IBQUEUE=$P(IBSITE,U),IBTQUEUE=$P(IBSITE,U,9),IBDESC=""
|
|---|
| 95 | ;
|
|---|
| 96 | Q:IBQUEUE=""&(IBTQUEUE="")
|
|---|
| 97 | ;
|
|---|
| 98 | S IBQ="",IBBTYPX=""
|
|---|
| 99 | ; Sort: div_^_bill type_-_test stat,ins co transmission destination^sec status,dfn,claim #
|
|---|
| 100 | F S IBBTYPX=$O(^TMP("IBTXMT",$J,IBBTYPX)),IBBTYP=$P(IBBTYPX,U,2) D:IBCTM CHKNEW^IBCE837A(IBQ,.IBBILL,.IBCTM,IBDESC,IBBTYP,"",IBSITE,.IBSIZE) Q:IBBTYPX="" D
|
|---|
| 101 | . S IBDEFPRT=$S($E(IBBTYP)="P":"SPRINT",1:"SPRINT")
|
|---|
| 102 | . S IBTXTEST=+$P(IBBTYP,"-",2),IBQ=$S('IBTXTEST:IBQUEUE,IBTXTEST=2:"MCT",1:IBTQUEUE)
|
|---|
| 103 | . Q:IBQ="" ; Queue
|
|---|
| 104 | . ;
|
|---|
| 105 | . S IBD=$S($E(IBBTYP)="P":"PROF",1:"INST")_" CLAIMS-"_$$HTE^XLFDT($H,2)_" "
|
|---|
| 106 | . S IBDESC=$S('$P(IBSITE,U,7):$S('IBTXTEST:"",1:"TEST ")_IBD,1:"")
|
|---|
| 107 | . ;
|
|---|
| 108 | . S IB837R=""
|
|---|
| 109 | . F S IB837R=$O(^TMP("IBTXMT",$J,IBBTYPX,IB837R)) D:IBCTM CHKNEW^IBCE837A(IBQ,.IBBILL,.IBCTM,IBDESC,IBBTYP,"",IBSITE,.IBSIZE) Q:IB837R="" D
|
|---|
| 110 | .. S (IBINS,IBNID)="",IBLCNT=0
|
|---|
| 111 | .. F S IBNID=$O(^TMP("IBTXMT",$J,IBBTYPX,IB837R,IBNID)) K ^TMP("IBHDR1",$J) D:IBCTM CHKNEW^IBCE837A(IBQ,.IBBILL,.IBCTM,IBDESC,IBBTYP,IBINS,IBSITE,.IBSIZE) Q:IBNID="" D
|
|---|
| 112 | ...;
|
|---|
| 113 | ...S IBDFN=0,IBINS=+$G(^TMP("IBXINS",$J,IBBTYPX,IBNID))
|
|---|
| 114 | ... ;
|
|---|
| 115 | ...I $P(IBSITE,U,7) D ; 1 ins/batch
|
|---|
| 116 | .... S IBLCNT=0
|
|---|
| 117 | .... S IBDESC=$E($S('IBTXTEST:"",1:"TEST ")_IBD_$P($G(^DIC(36,IBINS,0)),U),1,80)
|
|---|
| 118 | ... ;
|
|---|
| 119 | ...F S IBDFN=$O(^TMP("IBTXMT",$J,IBBTYPX,IB837R,IBNID,IBDFN)) Q:'IBDFN S IBREF="" F S IBREF=$O(^TMP("IBTXMT",$J,IBBTYPX,IB837R,IBNID,IBDFN,IBREF)) Q:'IBREF D
|
|---|
| 120 | ....I '(IBCTM#IBMAX),IBCTM D MAILIT^IBCE837A(IBQ,.IBBILL,.IBCTM,"",IBDESC,IBBTYP,IBINS) S IBSIZE=0 ;exceeds max #
|
|---|
| 121 | ....D BILLPARM^IBCEFG0(+IBREF,.IBPARMS)
|
|---|
| 122 | ....S IBSIZEM=$$EXTRACT^IBCEFG(IB837,+IBREF,1,.IBPARMS)
|
|---|
| 123 | ....I (IBSIZEM+IBSIZE)>30000,IBSIZE D ; exceeds max size
|
|---|
| 124 | .....D MAILIT^IBCE837A(IBQ,.IBBILL,.IBCTM,"",IBDESC,IBBTYP,IBINS) S IBSIZE=0 K ^TMP("IBXDATA",$J) S IBSIZEM=$$EXTRACT^IBCEFG(IB837,+IBREF,1,.IBPARMS)
|
|---|
| 125 | ....I 'IBSIZEM D:'IBCTM Q
|
|---|
| 126 | ..... D CHKBTCH^IBCE837A(+$G(^TMP("IBHDR",$J))) K ^TMP("IBHDR",$J)
|
|---|
| 127 | ....S IBCT=IBCT+1,IBCTM=IBCTM+1
|
|---|
| 128 | ....D:$D(^TMP("IBXDATA",$J)) MESSAGE(.IBLCNT,$P(IBREF,U,2),.IBBILL,.IBCTM,.IBSIZE,IBSIZEM,"",IBBTYP,IBINS)
|
|---|
| 129 | ..;
|
|---|
| 130 | ..I $G(IBTXTEST)=1 S IBINS=0 F S IBINS=$O(^TMP("IBICT",$J,IBINS)) Q:'IBINS S IB3=$G(^DIC(36,IBINS,3)) D
|
|---|
| 131 | ... N DIE,DA,DR
|
|---|
| 132 | ...S DIE="^DIC(36,",DA=IBINS,DR="3.05////"_DT_";3.07////"_($S($P(IB3,U,5)'=DT:0,1:$P(IB3,U,7))+^TMP("IBICT",$J,IBINS)) D ^DIE
|
|---|
| 133 | ;
|
|---|
| 134 | I $O(^TMP("IBXERR",$J,"")) D ;Error to mail grp
|
|---|
| 135 | .N XMTO,XMBODY,XMDUZ,XMSUBJ,IBCT,IBERR
|
|---|
| 136 | .K ^TMP("IBXMSG",$J)
|
|---|
| 137 | .S ^TMP("IBXMSG",$J,1)="The following authorized bill(s) were not transmitted due to errors indicated.",^(2)="Once the errors are corrected, the bill(s) will be included in the next run.",^(3)=" "
|
|---|
| 138 | .;
|
|---|
| 139 | .S IBERR=0,IBCT=3
|
|---|
| 140 | .F S IBERR=$O(^TMP("IBXERR",$J,IBERR)) Q:'IBERR S IBCT=IBCT+1,^TMP("IBXMSG",$J,IBCT)="Bill #: "_$P($G(^DGCR(399,IBERR,0)),U),IBCT=IBCT+1,^TMP("IBXMSG",$J,IBCT)=$J("",5)_^TMP("IBXERR",$J,IBERR)
|
|---|
| 141 | .S XMBODY="^TMP(""IBXMSG"","_$J_")" D ERRMSG^IBCE837A(XMBODY)
|
|---|
| 142 | .;
|
|---|
| 143 | .K ^TMP("IBXMSG",$J),^TMP("IBICT",$J)
|
|---|
| 144 | ;
|
|---|
| 145 | I $O(^TMP("IBCE-BATCH",$J,"")) D
|
|---|
| 146 | .N IB,IB0,IBL,IBT,IBX,XMTO,XMDUZ,XMSUBJ,IBRESUB,IBTESTB,XMZ
|
|---|
| 147 | .S IBRESUB=$D(^TMP("IBRESUBMIT",$J))
|
|---|
| 148 | .;
|
|---|
| 149 | .S IBT(1)="The following batches were "_$S('IBRESUB:"",1:"re-")_"submitted to Austin "_$S(IBTXTEST'=2:"",1:"as TEST ")_$$HTE^XLFDT($H,"2D")_":"
|
|---|
| 150 | .S IBT(2)=$S('IBRESUB:" ",1:" [Resubmitted by: "_$P($G(^VA(200,+DUZ,0)),U)_" (#"_DUZ_")]") S:IBRESUB IBT(3)=" "
|
|---|
| 151 | .;
|
|---|
| 152 | .S IBL=$S('IBRESUB:2,1:3),IB=""
|
|---|
| 153 | .F S IB=$O(^TMP("IBCE-BATCH",$J,IB)) Q:IB="" S IBL=IBL+1,IB0=$G(^(IB)) D
|
|---|
| 154 | .. S IBX=IB
|
|---|
| 155 | .. I $P(IB0,U,3)'="",IBTXTEST=2 S IBX=$P(IB0,U,3)_" (AS BATCH "_IB_")"
|
|---|
| 156 | ..S IBT(IBL)=" "_IBX_" "_$P($G(^IBA(364.1,+IB0,0)),U,8),IBL=IBL+1,IBT(IBL)=" ("_+$P(IB0,U,2)_" bills)"
|
|---|
| 157 | .;
|
|---|
| 158 | .S XMTO("I:G.IB EDI")="",XMDUZ="",XMBODY="IBT",XMSUBJ="EDI 837 "_$S('IBRESUB:"",1:"RE-")_"SUBMISSION BATCH LIST"_$S(IBTXTEST'=2:"",1:" FOR TEST")
|
|---|
| 159 | .D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO,,.XMZ)
|
|---|
| 160 | .;
|
|---|
| 161 | .S:IBRESUB ^TMP("IBRESUBMIT",$J,0)=1
|
|---|
| 162 | Q
|
|---|
| 163 | ;
|
|---|
| 164 | CLEANUP ; moved
|
|---|
| 165 | D CLEANUP^IBCE837A
|
|---|
| 166 | Q
|
|---|
| 167 | ;
|
|---|
| 168 | MESSAGE(IBLCNT,IBIEN,IBBILL,IBCTM,IBSIZE,IBSIZEM,IBDUZ,IBBTYP,IBINS) ; Create msg in ^TMP("IBXMSG",$J)
|
|---|
| 169 | ;IBLCNT = last msg line extracted
|
|---|
| 170 | ;IBIEN = ien file 364 bill entry
|
|---|
| 171 | ;IBBILL = array file 364 ien's of bills being sent
|
|---|
| 172 | ; IBBILL(IEN)=""
|
|---|
| 173 | ;IBSIZE = # bytes in msg
|
|---|
| 174 | ;IBSIZEM = # bytes in record to be added to msg
|
|---|
| 175 | ;IBCTM = # bills in batch
|
|---|
| 176 | ;IBDUZ = user ien running extract (Postmaster if auto)
|
|---|
| 177 | ;IBBTYP = x-y where x = P for prof, I for inst
|
|---|
| 178 | ; y = 1 for test, 0 for live txmt
|
|---|
| 179 | ;IBINS = ien of 1 ins co for batch
|
|---|
| 180 | ;
|
|---|
| 181 | N IB,IBL,IB1,IB2,IB3,IBQ,IBREC,IBDEL
|
|---|
| 182 | S IBDEL=$O(^IBA(364.5,"B","N-SEGMENT DELIMITER","")),IBDEL=$P($G(^IBA(364.5,+IBDEL,0)),U,8) S:IBDEL="" IBDEL="~"
|
|---|
| 183 | S IBSIZE=IBSIZE+IBSIZEM,IB1="",IBREC=""
|
|---|
| 184 | F S IB1=$O(^TMP("IBXDATA",$J,1,IB1)) Q:IB1="" D
|
|---|
| 185 | .S (IBREC,IB2)=""
|
|---|
| 186 | .F S IB2=$O(^TMP("IBXDATA",$J,1,IB1,IB2)) Q:$S(IB2="":1,IB1=1:"",1:'$O(^(IB2,1))) D
|
|---|
| 187 | ..S IB3="",IBREC=""
|
|---|
| 188 | ..F S IB3=$O(^TMP("IBXDATA",$J,1,IB1,IB2,IB3)) D:IB3=""&($L(IBREC)) SETG Q:IB3="" S:$S(IB3=1:1,1:$P(IBREC,U)'="") $P(IBREC,U,IB3)=$$UP^XLFSTR(^TMP("IBXDATA",$J,1,IB1,IB2,IB3))
|
|---|
| 189 | S IBBILL(IBIEN)=""
|
|---|
| 190 | K ^TMP("IBXDATA",$J)
|
|---|
| 191 | Q
|
|---|
| 192 | ;
|
|---|
| 193 | SETHDR ; hdr for curr batch
|
|---|
| 194 | S ^TMP("IBHDR",$J)=$G(^TMP("IBXDATA",$J,1,5,1,2))
|
|---|
| 195 | Q
|
|---|
| 196 | ;
|
|---|
| 197 | SETHDR1 ; hdr node for curr ins
|
|---|
| 198 | S ^TMP("IBHDR1",$J)=$G(^TMP("IBXDATA",$J,1,20,1,8))
|
|---|
| 199 | Q
|
|---|
| 200 | ;
|
|---|
| 201 | SETG ; msg global for each segment
|
|---|
| 202 | S IBREC=$TR(IBREC,IBDEL)
|
|---|
| 203 | S IBREC=IBREC_IBDEL,IBSIZE=IBSIZE+$L(IBDEL)
|
|---|
| 204 | S IBLCNT=IBLCNT+1,^TMP("IBXMSG",$J,IBLCNT)=IBREC
|
|---|
| 205 | Q
|
|---|
| 206 | ;
|
|---|
| 207 | ONE ; Txmt 1 or more bills for test or in 'X' status for live
|
|---|
| 208 | Q:'$$MGCHK^IBCE(0)
|
|---|
| 209 | D SETUP(0)
|
|---|
| 210 | I '$D(IBXERR) D FIND,OUTPUT
|
|---|
| 211 | D CLEANUP^IBCE837A
|
|---|
| 212 | Q
|
|---|
| 213 | ;
|
|---|
