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

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

initial load of FOIAVistA 6/30/08 version
File size: 8.6 KB
Line 
1IBCESRV2 ;ALB/TMP - Server based Auto-update utilities - IB EDI ;03/05/96
2 ;;2.0;INTEGRATED BILLING;**137,191,155,296**;21-MAR-94
3 Q
4 ;
5CON837 ; Confirmation of 837 batch - auto update
6 ;Input expected: IBTDA = the ien of the message entry in file 364.2
7 ;
8 N IB0,IBBDA,IBBILL,IBMSG,IBFLAG,IBTYP,IBBST,DR,DA,DIE,Z
9 Q:'$G(IBTDA)
10 S IB0=$G(^IBA(364.2,IBTDA,0)),IBBDA=+$P(IB0,U,4) ;Batch ien
11 S IBTYP=$P($G(^IBE(364.3,+$P(IB0,U,2),0)),U)
12 ;
13 Q:IBTYP'["837REC"
14 ;
15 I $P(IB0,U,14) D UPDTEST^IBCEPTM(IBTDA) Q ; Test claim message from claim resubmitted claim
16 ;
17 ; Austin receipt is '837REC0',
18 ; other non-payer confirmations are '837REC1',
19 ; payer confirmations are '837REC2'
20 S IBTYP=+$P(IBTYP,"837REC",2)
21 S IBBST=$P($G(^IBA(364.1,IBBDA,0)),U,2)
22 ;
23 I $S(IBBST?1"A"1N:IBTYP<+$P(IBBST,"A",2),1:0) D Q
24 . ;Don't allow status to go backwards
25 . D DELMSG(IBTDA)
26 ;
27 D UPDCONF(IBBDA,IBTDA,IBTYP,1)
28 ;
29 Q
30 ;
31BILLSTAC(IBBILL,IBTYP) ;Change status of transmit bill
32 ; IBBILL = the ien of the entry in file 364 to update
33 ; IBTYP = code for new status (see field 364;.03 for details)
34 ;
35 N IBSTAT,DIE,DA,DR,X,Y
36 ;
37 S IBSTAT=$P($G(^IBA(364,IBBILL,0)),U,3)
38 ;
39 Q:IBSTAT=IBTYP!(IBTYP="") ;Status hasn't changed or new status is null
40 Q:"CREZ"[IBSTAT ;Don't update status of completed transmit record
41 ;
42 ; Don't allow the status to go backwards
43 I $E(IBSTAT)="A","PX"[IBTYP Q
44 I $E(IBSTAT)="A",$E(IBTYP)="A",$P(IBTYP,"A",2)<$P(IBSTAT,"A",2) Q
45 ;
46 S DIE="^IBA(364,",DA=IBBILL,DR=".03////"_IBTYP_";.04///NOW" D ^DIE
47 Q
48 ;
49REJ837 ; Rejections 837
50 ;Input IBTDA = the ien of the message entry in file 364.2
51 ;
52 Q:'$G(IBTDA)
53 ;
54 D UPDREJ(+$P($G(^IBA(364.2,IBTDA,0)),U,4),IBTDA)
55 Q
56 ;
57DELMSG(IBTDA) ;
58 ; Delete message after it successfully updates the database.
59 ; IBTDA = the ien of the message in file 364.2
60 D TRADEL^IBCESRV1(IBTDA)
61 Q
62 ;
63BILLSTAR(IBBILL,IBTDA) ;Change status of transmit bill and bill on rejection
64 ; IBBILL = ien of bill (399)
65 ; IBTDA = ien of error message
66 ;
67 N DR,DIE,DA,IBSTAT,IBDA,IBCBH
68 ;
69 S IBDA=$S($P($G(^IBA(364.2,IBTDA,0)),U,5):$P(^(0),U,5),1:+$O(^IBA(364,"B",IBBILL,""),-1))
70 S IBSTAT=$P($G(^IBA(364,IBDA,0)),U,3),IBCBH=$P($G(^DGCR(399,IBBILL,0)),U,21)
71 ;
72 Q:"CREZ"[IBSTAT ;Don't update status of completed transmit record
73 ;
74 I IBSTAT'="E" S DIE="^IBA(364,",DA=IBDA,DR=".03////E;.04///NOW;.05////"_IBTDA D ^DIE
75 ;
76 ; Don't process further if only testing transmission with insurance co
77 Q:+$G(^DIC(36,+$P($G(^DGCR(399,IBBILL,"I"_($F("PST",IBCBH)-1))),U),3))=2
78 ;
79 ; Suspend bill if waiting for MRA - allows it to be edited
80 ;I $P($G(^DGCR(399,IBBILL,0)),U,13)=2,$$NEEDMRA^IBEFUNC(IBBILL)="1N" S DIE="^DGCR(399,",DA=IBBILL,DR=".13////6" D:DA ^DIE
81 Q
82 ;
83UPDMSG(IBTDA,STAT,UPD) ; Update msg with status of 'P','U' or delete message
84 ; STAT = 'P' 'U' for pending or updating, 'R' to delete
85 ; UPD = flag that says update the data base updated field (.12) if 1
86 ;
87 N DIE,DA,DR
88 ;
89 I STAT="R" D DELMSG(IBTDA) Q
90 ;
91 I $P($G(^IBA(364.2,IBTDA,0)),U,6)'=STAT D
92 . S DR=".06////"_STAT_$S($G(UPD):".12////1",1:"")
93 . S DIE="^IBA(364.2,",DA=IBTDA
94 . I $G(^IBA(364.2,DA,0)) D ^DIE
95 Q
96 ;
97STOREM(IBTDA,IBTEXT,IBE) ;Store message text in file 364.2
98 ; INPUT:
99 ; IBTDA = ien in file 364 message field entry #IBTDA
100 ; IBTEXT = name of the array where the message text is retrieved from
101 ; or "@" to delete the text from the message field
102 ; OUTPUT:
103 ; IBE = array of errors (IBE("DIERR")) returned, pass by reference
104 ;
105 N IBZ,X,Y
106 ;
107 Q:$S($G(IBTEXT)="@":0,1:$D(@IBTEXT)<10)
108 ;
109 K IBE("DIERR")
110 ;
111 F IBZ=1:1:20 D WP^DIE(364.2,IBTDA_",",2,"AK",""_IBTEXT_"","IBE") Q:$S('$D(IBE("DIERR")):1,+IBE("DIERR")=1:$G(IBE("DIERR",1))'=110,1:1) K IBE("DIERR") H .5 ; On lock error, retry up to 20 times
112 Q
113 ;
114CKRES(IBBDA,IBDEF,IBLIST) ;Chk to see if the batch file can be updated to
115 ; completely resubmitted based on finding all bills in it
116 ; having a status of cancelled, resubmitted, deleted or closed
117 ; or if none of these statuses, they at least have a transmission
118 ; record for the same bill created at a later date/time.
119 ;
120 ; IBBDA : Batch # ien in file 364.1
121 ; IBDEF : Default to set the batch status to.
122 ; 0 or undefined, status will set to 0 (NOT INCOMPLETE)
123 ; if no incomplete submissions found
124 ; 1 status will set to 1 (INCOMPLETE)
125 ; if any incomplete submissions found
126 ; -1 status will not be updated
127 ; IBLIST : If passed by reference and IBLIST=1, returns list of bill
128 ; #'s not resubmitted in IBLIST(ien of file 364)=""
129 ;
130 N IB,IBINC,IBBILL,DIE,DR,DA,Z,Z0
131 ;
132 S IBDEF=+$G(IBDEF),IBINC=0
133 Q:$S('$G(IBBDA):1,IBDEF'<0:'$P($G(^IBA(364.1,IBBDA,0)),U,10),1:0)
134 ;
135 I $G(IBLIST) K IBLIST S IBLIST=1
136 S IB="" F S IB=$O(^IBA(364,"ABAST",IBBDA,IB)) Q:IB="" I "CRDZ"'[IB D Q:'$G(IBLIST)
137 . S Z=0 F S Z=$O(^IBA(364,"ABAST",IBBDA,IB,Z)) Q:'Z D
138 .. S Z0=($$LAST364^IBCEF4(+$G(^IBA(364,Z,0)))=Z)
139 .. I Z0,'$G(IBLIST) S IBINC=1 Q
140 .. I $G(IBLIST),Z0 S IBLIST(Z)=""
141 ;
142 I $S('IBDEF:'IBINC,IBDEF>0:IBINC,1:0) S DA=IBBDA,DIE="^IBA(364.1,",DR=".1////"_IBDEF D ^DIE
143 ;
144 Q
145 ;
146UPDCONF(IBBDA,IBTDA,IBTYP,IBAUTO) ; Add status msgs to STATUS file #361
147 ; Update data base from confirmation msg
148 ; IBBDA = ien of batch
149 ; IBTDA = ien of message
150 ; IBTYP = type of message
151 ; (0=Austin confirmation, 1=confirmation by non-payer
152 ; 2=confirmation by payer)
153 ; IBAUTO = flag for update mode
154 ; 0 or null : manual 1 : auto
155 ; ^TMP("IBCONF",$J,bill ien)="" where bill ien is the internal entry
156 ; number of any bills in file 364 to be excluded from the
157 ; confirmation due to reported errors
158 ;
159 N IBBILL,IBIDA,PRCASV,DA,DIE,DR,IBFLAG,IB0,IBS
160 ;
161 D UPDMSG(IBTDA,"U",0)
162 ;
163 S IB0=$G(^IBA(364.2,IBTDA,0))
164 S IBS="A"_IBTYP
165 ;
166 S IBBILL="" F S IBBILL=$O(^IBA(364,"ABABI",+IBBDA,IBBILL)) Q:'IBBILL D
167 . Q:$D(^TMP("IBCONF",$J,IBBILL)) ;Bill was rejected
168 . ;Update status of all valid bills in a batch
169 . S IBIDA=0 F S IBIDA=$O(^IBA(364,"ABABI",IBBDA,IBBILL,IBIDA)) Q:'IBIDA D
170 .. D BILLSTAC(IBIDA,IBS)
171 . ;
172 . I 'IBTYP D
173 .. S DR="20///N0W"
174 .. S:$P($G(^DGCR(399,IBBILL,"TX")),U,5)="1N" DR=DR_";24///1R"
175 .. S DA=IBBILL,DIE="^DGCR(399," D ^DIE
176 ;
177 I 'IBTYP D DELMSG(IBTDA)
178 ;
179 I 'IBBDA,$P(IB0,U,5) D
180 . N IB
181 . S IB=$P($G(^IBA(364,+$P(IB0,U,5),0)),U,2) ; batch
182 . D BILLSTAC($P(IB0,U,5),IBS) ;Upd individual transmitted bill entry
183 . I $G(^IBA(364.1,+IB,0)),$P($G(^(0)),U,2)'="A0" S DIE="^IBA(364.1,",DA=+IB,DR=".02////A0" D ^DIE
184 ;
185 I IBBDA,$P($G(^IBA(364.1,+IBBDA,0)),U,2)'=IBS D
186 . S DA=IBBDA,DIE="^IBA(364.1,"
187 . S DR=".02////"_IBS_$S($G(IBFLAG)'="":";.06////"_IBFLAG,1:"")_";1.05////"_$P(IB0,U,10)_";1.06///NOW"
188 . D ^DIE
189 ;
190 ; Add message to bill status file 361 for bill
191 I IBTYP D UPD361^IBCEST(IBTDA)
192 ;
193 S ZTREQ="@"
194 K ^TMP("IBCONF",$J)
195 Q
196 ;
197UPDREJ(IBBDA,IBTDA) ; Update data base from rejection msg
198 ; IBBDA = ien of batch
199 ; IBTDA = ien of message
200 ;
201 N DA,DR,DIE,IBBILL,IBTBILL,IB0
202 ;
203 D UPDMSG(IBTDA,"U",0)
204 ;
205 S IB0=$G(^IBA(364.2,IBTDA,0)),IBTBILL=+$P(IB0,U,5),IBBILL=+$G(^IBA(364,IBTBILL,0))
206 ;
207 I $P(IB0,U,14) D UPDTEST^IBCEPTM(IBTDA) Q ; Test claim message from claim resubmission - store in test msg file instead
208 ;
209 I IBBILL D BILLSTAR(IBBILL,IBTDA) ;Update individual bill
210 ;
211 I IBBDA,'IBBILL D
212 . S DA=IBBDA,DIE="^IBA(364.1,"
213 . S DR=".11////"_IBTDA_";.06////1;1.05////"_$P(IB0,U,10)_";1.06///NOW;.05////1"
214 . D ^DIE ;Batch Rejected
215 .;
216 . ;Update status of all bills in batch, bill file
217 . F S IBBILL=$O(^IBA(364,"ABABI",IBBDA,IBBILL)) Q:'IBBILL D BILLSTAR(IBBILL,IBTDA)
218 ;
219 ;Add message to bill status file 361 for bill
220 D UPD361^IBCEST(IBTDA)
221 ;
222 S ZTREQ="@"
223 Q
224 ;
225MAILIT ; Mails the report text (bulletin) to the IB EDI SUPERVISOR mail grp;
226 N IB0,IBHD,IBL,IBZ,IBOK,XMTO,XMSUBJ,XMBODY,XMDUZ,XMZ,Z
227 K ^TMP("IBMSG",$J),^TMP("IBMSGH",$J)
228 Q:'$G(IBTDA) ;Assume this exists and is the IEN of the message in 364.2
229 S (IBL,IBZ,IBHD)=0,IBOK=1
230 F S IBZ=$O(^IBA(364.2,IBTDA,2,IBZ)) Q:'IBZ S IB0=$G(^(IBZ,0)) D
231 . Q:$P(IB0,U)="REPORT"!($E(IB0,1,4)="99^$")
232 . ;
233 . I $P(IB0,U)="SUBJECT" D Q
234 .. I $O(^TMP("IBMSG",$J,0)) D SEND(.IBOK) ; send last report
235 .. S ^TMP("IBMSGH",$J)=$P(IB0,"SUBJECT^",2)
236 . ;
237 . I $E(IB0,1,18)="*** NEW PAGE ***" D Q
238 .. F Z=1:1:5 S IBL=IBL+1,^TMP("IBMSG",$J,IBL)=" "
239 .. S ^TMP("IBMSG",$J,IBL)="*** END OF PAGE ***"
240 .. F Z=1,2 S IBL=IBL+1,^TMP("IBMSG",$J,IBL)=" "
241 . S IBL=IBL+1,^TMP("IBMSG",$J,IBL)=IB0
242 . ;
243 I $O(^TMP("IBMSG",$J,0)) D SEND(.IBOK)
244 I IBOK D DELMSG($G(IBTDA))
245 K ^TMP("IBMSG",$J),^TMP($J,"IBMSGH",$J)
246 Q
247 ;
248SEND(IBOK) ; Send actual message for 1 report
249 ;
250 N XMSUBJ,XMBODY,XMTO,XMZ,XMDUZ
251 S XMSUBJ=$G(^TMP("IBMSGH",$J)),XMBODY="^TMP(""IBMSG"",$J)",XMTO("I:G.IB EDI SUPERVISOR")=""
252 D SENDMSG^XMXAPI(,$E(XMSUBJ,1,65),XMBODY,.XMTO,,.XMZ)
253 I '$G(XMZ) S IBOK=0
254 K ^TMP("IBMSG",$J),^TMP("IBMSGH",$J)
255 Q
256 ;
Note: See TracBrowser for help on using the repository browser.