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