source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEST.m@ 794

Last change on this file since 794 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 9.3 KB
Line 
1IBCEST ;ALB/TMP - 837 EDI STATUS MESSAGE PROCESSING ;17-APR-96
2 ;;2.0;INTEGRATED BILLING;**137,189,197,135,283,320,368**;21-MAR-94;Build 21
3 ;;Per VHA Directive 2004-038, this routine should not be modified.
4 ; IA 4042 for call to AUDITX^PRCAUDT
5 Q
6 ;
7UPD361(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 .. F S Z0=$P(Z0," ",2,99) Q:$E(Z0)'=" "
29 .. Q:Z0=""
30 .. 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
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 ;
52STORE(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 ;
146UPDQ L -^IBA(364.2,IBTDA,0)
147 Q
148 ;
149BLDMSG(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 ;
162UPDINS(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 ;
201UPDINSQ Q
202 ;
203MSGLNSZ(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 ;
Note: See TracBrowser for help on using the repository browser.