| 1 | IBCEST ;ALB/TMP - 837 EDI STATUS MESSAGE PROCESSING ;17-APR-96
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**137,189,197,135,283,320**;21-MAR-94
|
|---|
| 3 | ; IA 4042 for call to AUDITX^PRCAUDT
|
|---|
| 4 | Q
|
|---|
| 5 | ;
|
|---|
| 6 | UPD361(IBTDA) ; Update IB BILL STATUS MESSAGES file
|
|---|
| 7 | ; IBTDA = ien of return message in file 364.2
|
|---|
| 8 | ;
|
|---|
| 9 | N IB,IB0,IBSEQ,IB00,IBBILL,IBBTCH,IBMNUM
|
|---|
| 10 | ;
|
|---|
| 11 | I '$$LOCK^IBCEM(IBTDA) G UPDQ ;Lock message in file 364.2
|
|---|
| 12 | ;
|
|---|
| 13 | S IB0=$G(^IBA(364.2,IBTDA,0))
|
|---|
| 14 | S IBMNUM=$P(IB0,U) ; Message number
|
|---|
| 15 | S IB00=$G(^IBA(364,+$P(IB0,U,5),0)) ; Transmit bill entry
|
|---|
| 16 | S IBBILL=+IB00 ; Actual bill ien in file 399
|
|---|
| 17 | S IBBTCH=$P(IB0,U,4) ; Batch #
|
|---|
| 18 | ;
|
|---|
| 19 | ; Auto-audit bills based on status code on '10' record of status msg
|
|---|
| 20 | ; flat file
|
|---|
| 21 | I IBBILL,$P($T(PRCAUDT+1^PRCAUDT),"**",2)[",173" D
|
|---|
| 22 | . N Z,Z0,Z1,OK
|
|---|
| 23 | . Q:+$$STA^PRCAFN(IBBILL)'=104
|
|---|
| 24 | . S (Z,OK)=0
|
|---|
| 25 | . F S Z=$O(^IBA(364.2,IBTDA,2,Z)) Q:'Z S Z0=$P($G(^(Z,0)),"##RAW DATA: ",2) I +Z0=10 S Z0=$P(Z0,U,5) D Q:OK
|
|---|
| 26 | .. ; Strip leading spaces
|
|---|
| 27 | .. F S Z0=$P(Z0," ",2,99) Q:$E(Z0)'=" "
|
|---|
| 28 | .. Q:Z0=""
|
|---|
| 29 | .. I "A3^AC^A7^A8^AA^2P^10^11"[Z0,$P($G(^DGCR(399.3,+$P($G(^DGCR(399,IBBILL,0)),U,7),0)),U,11) D AUDITX^PRCAUDT(IBBILL) S OK=1 ; IA 4042
|
|---|
| 30 | ;
|
|---|
| 31 | I $S(IBMNUM="":1,1:'IBBILL&(IBBTCH="")) D DELMSG^IBCESRV2(IBTDA) G UPDQ
|
|---|
| 32 | ;
|
|---|
| 33 | ; Individual bill
|
|---|
| 34 | I IBBILL D G UPDQ
|
|---|
| 35 | . N IBA1,IBMSG0,IBPID
|
|---|
| 36 | . S IBPID="",IBA1=0
|
|---|
| 37 | . F S IBA1=$O(^IBA(364.2,IBTDA,2,IBA1)) Q:'IBA1 S IBMSG0=$P($G(^(IBA1,0)),"##RAW DATA: ",2) I +IBMSG0=277,$P(IBMSG0,U,5)="N" S IBPID=$P(IBMSG0,U,11) Q
|
|---|
| 38 | . S IBSEQ=$P(IB00,U,8) S:IBSEQ="" IBSEQ="P"
|
|---|
| 39 | . D STORE(IB0,IBBTCH,IBMNUM,IBTDA,IBBILL,IBSEQ,IBPID,1)
|
|---|
| 40 | ;
|
|---|
| 41 | ; Batch - update each bill separately
|
|---|
| 42 | S IBBILL=""
|
|---|
| 43 | F S IBBILL=$O(^IBA(364,"ABABI",+IBBTCH,IBBILL)) Q:'IBBILL D
|
|---|
| 44 | . Q:$D(^TMP("IBCONF",$J,IBBILL)) ;Bill was rejected
|
|---|
| 45 | . S IB=$O(^IBA(364,"ABABI",+IBBTCH,IBBILL,0)) Q:'IB
|
|---|
| 46 | . S IBSEQ=$P($G(^IBA(364,IB,0)),U,8) S:IBSEQ="" IBSEQ="P"
|
|---|
| 47 | . D STORE(IB0,IBBTCH,IBMNUM,IBTDA,IBBILL,IBSEQ,"",0)
|
|---|
| 48 | ;
|
|---|
| 49 | Q
|
|---|
| 50 | ;
|
|---|
| 51 | STORE(IB0,IBBTCH,IBMNUM,IBTDA,IBBILL,IBSEQ,IBPID,IB1) ;
|
|---|
| 52 | ;
|
|---|
| 53 | ; IB0 = 0-node of message in file 364.2
|
|---|
| 54 | ; IBBTCH = ien of batch in file 364.1
|
|---|
| 55 | ; IBMNUM = actual message number
|
|---|
| 56 | ; IBTDA = ien of message in file 364.2
|
|---|
| 57 | ; IBBILL = ien of bill in 399
|
|---|
| 58 | ; IBSEQ = P/S/T/ for COB sequence related to message
|
|---|
| 59 | ; IBPID = the payer id returned from clearinghouse for the claim
|
|---|
| 60 | ; IB1 = flag that says if the message was for a single bill or a batch.
|
|---|
| 61 | ; Batch statuses have an additional standard text entry.
|
|---|
| 62 | ; 1 = single bill 0 = batch
|
|---|
| 63 | ;
|
|---|
| 64 | N DA,DIK,DIE,DIC,X,Y,DR,DO,DD,DLAYGO,Z,Z0,Z1,IBT,IBDUP,IBFLDS,IBY,IBAUTO
|
|---|
| 65 | ;
|
|---|
| 66 | S X=IBBILL,IBDUP=0
|
|---|
| 67 | ;
|
|---|
| 68 | I $D(^IBM(361,"AC",IBMNUM\1)) D ; Message already there for bill
|
|---|
| 69 | . S Z=0 F S Z=$O(^IBM(361,"AC",IBMNUM\1,Z)) Q:'Z I +$G(^IBM(361,Z,0))=IBBILL S IBDUP=Z Q
|
|---|
| 70 | ;
|
|---|
| 71 | S IBFLDS=".02////"_$P(IB0,U,3)
|
|---|
| 72 | S IBFLDS=IBFLDS_";.03////"_$S($$EXTERNAL^DILFD(364.2,.02,"U",$P(IB0,U,2))["REJ":"R",1:"I")_";.05////"_IBBTCH_";.06////"_IBMNUM_";.04////"_+$P(IB0,U,8)_";.07////"_IBSEQ_$S($P(IB0,U,5):";.11////"_$P(IB0,U,5),1:"")
|
|---|
| 73 | S IBFLDS=IBFLDS_";.12////"_$P(IB0,U,10)_";.09////0"
|
|---|
| 74 | S IBFLDS=IBFLDS_";.15////"_$$CHKSUM^IBCEST1("^IBA(364.2,"_IBTDA_",2)")
|
|---|
| 75 | I IBPID'="" D
|
|---|
| 76 | . S IBPID("TYPE")=$S($$FT^IBCEF(IBBILL)=2:"P",1:"I")
|
|---|
| 77 | . D UPDINS(.IBPID,$$POLICY^IBCEF(IBBILL,1,$TR(IBSEQ,"PST","123")),IBBILL)
|
|---|
| 78 | ;
|
|---|
| 79 | I IBDUP D I $D(Y) G UPDQ
|
|---|
| 80 | . ; Stuff fields into existing entry
|
|---|
| 81 | . ; (may be needed for reprocessing of aborted updates)
|
|---|
| 82 | . S DIE="^IBM(361,",DA=IBDUP,DR=IBFLDS_";1///@"
|
|---|
| 83 | . D ^DIE
|
|---|
| 84 | . I $D(Y) S IBY=-1 Q ;Update not successful
|
|---|
| 85 | . S IBY=IBDUP
|
|---|
| 86 | ;
|
|---|
| 87 | K IBT
|
|---|
| 88 | I 'IBDUP D ; Create new entry and stuff fields
|
|---|
| 89 | . S DIC(0)="L",DIC="^IBM(361,",DLAYGO=361
|
|---|
| 90 | . S DIC("DR")=IBFLDS
|
|---|
| 91 | . D FILE^DICN
|
|---|
| 92 | . K DO,DD,DLAYGO,DIC
|
|---|
| 93 | . S IBY=+Y
|
|---|
| 94 | . Q:IBY'>0
|
|---|
| 95 | . ;
|
|---|
| 96 | . ; IB*2*320 - Check for duplicate status message
|
|---|
| 97 | . NEW IBNEW,IBOLD,PCE,Z,DIK,DA
|
|---|
| 98 | . S IBNEW=""
|
|---|
| 99 | . F PCE=3,4,5,7,8,11,15 S IBNEW=IBNEW_$P($G(^IBM(361,IBY,0)),U,PCE)_U
|
|---|
| 100 | . S Z=0
|
|---|
| 101 | . F S Z=$O(^IBM(361,"B",IBBILL,Z)) Q:'Z I Z'=IBY D Q:IBY'>0
|
|---|
| 102 | .. S IBOLD=""
|
|---|
| 103 | .. F PCE=3,4,5,7,8,11,15 S IBOLD=IBOLD_$P($G(^IBM(361,Z,0)),U,PCE)_U
|
|---|
| 104 | .. I IBNEW'=IBOLD Q ; no duplicate so get the next one
|
|---|
| 105 | .. S DIK="^IBM(361,",DA=IBY,IBY=-1 D ^DIK D DELMSG^IBCESRV2(IBTDA)
|
|---|
| 106 | .. Q
|
|---|
| 107 | . Q
|
|---|
| 108 | ;
|
|---|
| 109 | I IBY>0 D ;Move text over
|
|---|
| 110 | . K IBT
|
|---|
| 111 | . ;
|
|---|
| 112 | . D BLDMSG(IB1,IBTDA,.IBT,.IBAUTO)
|
|---|
| 113 | . ;
|
|---|
| 114 | . ; IB*2*320 - esg - 2Q messages will be filed as informational
|
|---|
| 115 | . I $P($G(^IBM(361,+IBY,0)),U,3)="R",$G(IBT(1))["2Q CLAIM REJECTED BY CLEARINGHOUSE" D
|
|---|
| 116 | .. S IBAUTO=1
|
|---|
| 117 | .. S DIE=361,DA=+IBY,DR=".03////I" D ^DIE
|
|---|
| 118 | .. Q
|
|---|
| 119 | . ;
|
|---|
| 120 | . ; if info msg, ck for no review needed based on first line of text
|
|---|
| 121 | . I $G(IBAUTO),$P($G(^IBM(361,+IBY,0)),U,3)="I" D
|
|---|
| 122 | .. S DIE="^IBM(361,",DR=".09////2;.14////1;.1////F",DA=+IBY D ^DIE
|
|---|
| 123 | .. I IB1,$P($G(^IBM(361,+IBY,0)),U,11),$$PRINTUPD^IBCEU0($G(IBT(1)),$P($G(^IBM(361,+IBY,0)),U,11))
|
|---|
| 124 | . ;
|
|---|
| 125 | . D WP^DIE(361,+IBY_",",1,"A","IBT") ; file message text
|
|---|
| 126 | . ;
|
|---|
| 127 | . ; Delete message after it successfully updates the database.
|
|---|
| 128 | . D DELMSG^IBCESRV2(IBTDA)
|
|---|
| 129 | . Q
|
|---|
| 130 | ;
|
|---|
| 131 | UPDQ L -^IBA(364.2,IBTDA,0)
|
|---|
| 132 | Q
|
|---|
| 133 | ;
|
|---|
| 134 | BLDMSG(IB1,IBTDA,IBT,IBAUTO) ; Builds message text
|
|---|
| 135 | ; IB1 = flag for batch message
|
|---|
| 136 | ; IBTDA = ien of entry in file 364.2
|
|---|
| 137 | ; IBT = array returned with message text
|
|---|
| 138 | ; IBAUTO = if passed by reference, returns 1 if text indicates review
|
|---|
| 139 | ; not needed
|
|---|
| 140 | N IBDATA,IBCK,IBZ,IBZ0,IBZ1,Z
|
|---|
| 141 | S (IBZ,IBZ0,IBDATA,IBAUTO,IBCK)=0
|
|---|
| 142 | I 'IB1 S IBT(1)="Status message received for batch "_$P($G(^IBA(364.1,IBBTCH,0)),U)_" dated "_$$FMTE^XLFDT($P($G(^IBA(364.2,IBTDA,0)),U,10),2),IBZ0=1
|
|---|
| 143 | ; Don't move the raw data over, just move the text of the message
|
|---|
| 144 | F S IBZ=$O(^IBA(364.2,IBTDA,2,IBZ)) Q:'IBZ S IBZ1=$G(^(IBZ,0)) S IBDATA=($E(IBZ1,1,2)="##") Q:IBDATA S IBZ0=IBZ0+1,IBT(IBZ0)=IBZ1 I 'IBCK S Z=$$CKREVU^IBCEM4(IBZ1,,,.IBCK),IBAUTO=$S(IBCK:0,Z:1,1:IBAUTO)
|
|---|
| 145 | ;
|
|---|
| 146 | ; Convert Message Lines in IBT to be no longer than 70 chars
|
|---|
| 147 | D MSGLNSZ(.IBT)
|
|---|
| 148 | Q
|
|---|
| 149 | ;
|
|---|
| 150 | UPDINS(IBPID,IBINS,IBIFN) ; Update the insurance id or the bill printed at
|
|---|
| 151 | ; the EDI contractor's print shop and mailed to the ins co.
|
|---|
| 152 | ; IBPID = the id returned from the EDI contractor for the ins co
|
|---|
| 153 | ; ("TYPE") = P if professional id or I if institutional id
|
|---|
| 154 | ; IBINS = the ien of the insurance co it was sent to (file 36)
|
|---|
| 155 | ; IBIFN = the ien of the claim (file 399)
|
|---|
| 156 | ;
|
|---|
| 157 | N IBID,IBIDFLD,IBPRT,IBLOOK,DA,DR,DIE,X,Y,Z
|
|---|
| 158 | ;
|
|---|
| 159 | Q:'$G(IBINS)!($G(IBPID)="")
|
|---|
| 160 | ;
|
|---|
| 161 | ; Strip spaces off the end of data
|
|---|
| 162 | S IBLOOK=""
|
|---|
| 163 | I $L(IBPID) F Z=$L(IBPID):-1:1 I $E(IBPID,Z)'=" " S IBLOOK=$E(IBPID,1,Z) Q
|
|---|
| 164 | ;
|
|---|
| 165 | S IBPRT=($E(IBLOOK,2,5)="PRNT")
|
|---|
| 166 | I IBPRT D ; Set printed via EDI field on bill
|
|---|
| 167 | . S DA=IBIFN,DIE="^DGCR(399,",DR="26////1" D ^DIE
|
|---|
| 168 | ;
|
|---|
| 169 | S IBLOOK=$E($S('IBPRT:$P(IBLOOK,"PAYID=",2),1:""),1,5)
|
|---|
| 170 | Q:IBLOOK=""!($E(IBLOOK,2,5)="PRNT")
|
|---|
| 171 | S IBIDFLD="3.0"_$S($G(IBPID("TYPE"))="I":4,1:2)
|
|---|
| 172 | S IBID=$P($G(^DIC(36,+IBINS,3)),U,IBIDFLD*100#100)
|
|---|
| 173 | Q:IBID=IBLOOK
|
|---|
| 174 | I IBID="" D G UPDINSQ ; Update insurance co electronic id # if blank
|
|---|
| 175 | . S DIE="^DIC(36,",DR=IBIDFLD_"////"_IBLOOK,DA=IBINS D ^DIE
|
|---|
| 176 | I IBID'="",IBLOOK'="" D ; Bulletin that the id on file and id returned
|
|---|
| 177 | . ; are different
|
|---|
| 178 | . N XMTO,XMDUZ,XMBODY,IBXM,XMSUBJ,XMZ
|
|---|
| 179 | . S XMTO("I:G.IB EDI")=""
|
|---|
| 180 | . S XMDUZ="",XMBODY="IBXM",XMSUBJ="PAYER ID RETURNED IS DIFFERENT THAN PAYER ID ON FILE"
|
|---|
| 181 | . S IBXM(1)="BILL # : "_$P($G(^DGCR(399,IBIFN,0)),U)
|
|---|
| 182 | . S IBXM(2)="PAYER : "_$P($G(^DIC(36,+IBINS,0)),U)
|
|---|
| 183 | . S IBXM(3)="BILL TYPE : "_$S($G(IBPID("TYPE"))="I":"INSTITUT",1:"PROFESS")_"IONAL"
|
|---|
| 184 | . S IBXM(4)="ID ON FILE : "_IBID
|
|---|
| 185 | . S IBXM(5)="ID RETURNED: "_IBLOOK
|
|---|
| 186 | . S IBXM(6)=" ",IBXM(7)=" Please determine which id number is correct and correct the id in the",IBXM(8)="insurance file for this payer, if needed"
|
|---|
| 187 | . D SENDMSG^XMXAPI(XMDUZ,XMSUBJ,XMBODY,.XMTO,,.XMZ)
|
|---|
| 188 | ;
|
|---|
| 189 | UPDINSQ Q
|
|---|
| 190 | ;
|
|---|
| 191 | MSGLNSZ(MSG) ; Change Input Message Lines to be no more than 70 characters long each
|
|---|
| 192 | ;
|
|---|
| 193 | ; Input/Output: MSG - array of Input Message Lines; this is also the Output Message
|
|---|
| 194 | ; which is an array of Converted Message Lines (with lines no more than 70 chars each)
|
|---|
| 195 | ;
|
|---|
| 196 | N LN,XARY,XARYLN,CNT,OUTMSG,TMPMSG,LDNGSP
|
|---|
| 197 | S LN="",CNT=0
|
|---|
| 198 | F S LN=$O(MSG(LN)) Q:LN="" D ;
|
|---|
| 199 | . ;
|
|---|
| 200 | . ; Find any leading spaces in original message line,
|
|---|
| 201 | . ; to be used if line got split below
|
|---|
| 202 | . S TMPMSG=$$TRIM^XLFSTR(MSG(LN),"L"," ") ;Trim Leading Spaces
|
|---|
| 203 | . S LDNGSP=$P(MSG(LN),TMPMSG,1) ;get leading spaces if any
|
|---|
| 204 | . ;
|
|---|
| 205 | . ; Converts a single line to multiple lines with a maximum width of 70 each
|
|---|
| 206 | . ; If line is 70 chars or less, this call returns the exact line
|
|---|
| 207 | . K XARY D FSTRNG^IBJU1(MSG(LN),70,.XARY)
|
|---|
| 208 | . ;
|
|---|
| 209 | . ; Scan lines and merge them into the final output array (OUTMSG)
|
|---|
| 210 | . ; On lines 2 and higher, add Leading Spaces found above, if any.
|
|---|
| 211 | . S XARYLN=""
|
|---|
| 212 | . F S XARYLN=$O(XARY(XARYLN)) Q:XARYLN="" S CNT=CNT+1,OUTMSG(CNT)=$S(XARYLN=1:XARY(XARYLN),1:LDNGSP_XARY(XARYLN))
|
|---|
| 213 | ;
|
|---|
| 214 | ; Move the final Message Lines (OUTMSG) into MSG array to be returned
|
|---|
| 215 | K MSG M MSG=OUTMSG
|
|---|
| 216 | Q ;MSGLNSZ
|
|---|
| 217 | ;
|
|---|
