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

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

initial load of FOIAVistA 6/30/08 version

File size: 7.9 KB
Line 
1IBCIUT2 ;DSI/SLM - CLAIMSMANAGER MESSAGE UTILITIES ;21-DEC-2000
2 ;;2.0;INTEGRATED BILLING;**161**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 Q
6MSGHDR ;build message id segment
7 ;
8 K IBCIU
9 S IBCIU(1)=$C(28),IBCIU(2)=$C(29),IBCIU(3)=$C(30),IBCIU(4)=$C(94),IBCIU(5)=$C(39),IBCIU(6)=$C(37)
10 S IBCIAA="" F I=1:1:6 S IBCIAA=IBCIAA_IBCIU(I)
11 K IBCIHDR S IBCIHDR=IBCIAA_"CLAIM"_IBCIU(1)
12 ;
13RSEG ;build route segment
14 N X,X1,X2,X3,X4,Y
15 S IBCIHDR=IBCIHDR_IBCIU(3)_IBCIU(3)
16 S X=IBCIMT,X1=3,IBCIMT=$$FILL
17 K X D NOW^IBCIUT1 S X=Y,X1=16,IBCIMDT=$$FILL
18 S X="",X1=20,IBCIMCID=$$FILL,IBCIMP="H"
19 S IBCIUID="DVAUSER",X=IBCIUID,X1=10,IBCIUID=$$FILL
20 S IBCISAP="VISTA",X=IBCISAP,X1=20,IBCISAP=$$FILL
21 S IBCIRAP="CLAIMS MANAGER",X=IBCIRAP,X1=20,IBCIRAP=$$FILL
22 S IBCISI="",X=IBCISI,X1=30,X3=".",IBCISI=$$FILL K X3
23 ;
24 S IBCIHDR=IBCIHDR_IBCIMT_IBCIMDT_IBCIMCID_IBCIMP_IBCIUID
25 S IBCIHDR=IBCIHDR_IBCIU(3)_IBCISAP_IBCIU(3)_IBCIRAP
26 S IBCIHDR=IBCIHDR_IBCIU(3)_IBCISI_IBCIU(1)
27 ;
28 Q
29FILL() ;pad x with characters
30 ;
31 ;Input variables
32 ; X = input value in non-fixed format
33 ; X1 = desired length of the output (default is 80 if undefined)
34 ; X2 = justify 'R' or 'L' (if undefined or not [ R or L, default is 'L')
35 ; X3 = character you want x padded with (default is " ")
36 ; X4 = truncate flag - if [ 'T' and x>x1 it will be truncated (default is 'T')
37 ;
38 ;Output variable
39 ; Y
40 ;
41 S Y=""
42 Q:'$D(X) Y
43 ;
44 ;initialize variables for fill
45 ;
46 I '$D(X1) S X1=80
47 I X1<1 S X1=80
48 I '$D(X2) S X2="L"
49 I "RL"'[X2 S X2="L"
50 I X2["R"&(X2["L") S X2="L"
51 I '$D(X3) S X3=" "
52 I X3']"" S X3=" "
53 I '$D(X4) S X4="T"
54 ;
55 I X4["T"&($L(X)>X1) S Y=$E(X,1,X1) Q Y
56 ;
57 S Y="",$P(Y,X3,X1+1)="",Y=$E(Y,1,X1-$L(X))
58 I X2["R" S Y=Y_X
59 I X2["L" S Y=X_Y
60 Q Y
61 ;
62 ;asnd(ibifn) comments
63 ;Input Variable
64 ; ibifn
65 ;Output Variable
66 ; y = 1 if successful, = 0 if not.
67ASND(IBIFN) ;auto send to ClaimsManager
68 N IBCIY S IBCIY=0,IBCIERR="" K PROBLEM
69 Q:'$D(IBIFN) IBCIY
70 ;change status in 351.9
71 I IBCISNT'=3 D
72 .S IBCIST=$S(IBCISNT=6:8,IBCISNT=5:5,IBCISNT=4:9,1:2)
73 .D ST^IBCIUT1(IBCIST)
74 ;
75 D UPDT^IBCIADD1 ;update 351.9 for all cases
76 ;
77 I IBCISNT<3 D ;a normal claim that has not been authorized
78 .D EN^IBCIMSG,SEND
79 .I '$G(PROBLEM) S IBCIY=1 D
80 ..I $P(^IBA(351.9,IBIFN,0),U,15)'=1 D ;set received by cm to yes
81 ...S DIE="^IBA(351.9,",DA=IBIFN,DR=".15///1" D ^DIE K DIE,DA,DR
82 ..I $P($G(^IBA(351.9,IBIFN,2,0)),U,4) D DCOM^IBCIUT4(IBIFN)
83 ..I $$CKNER^IBCIUT1() D Q ;if no errors then...
84 ...S (IBCISTAT,IBCIST)=3 D ST^IBCIUT1(IBCIST) ;update status=3
85 ...D DELTI^IBCIUT4 ;delete temp info when passed w/o errors
86 ...D DELER^IBCIUT4 ;delete error information too
87 ...D DASN^IBCIUT5(IBIFN) ;remove the assigned to person
88 ...Q
89 ..D Z1AR^IBCIUT4 ;errors found then..
90 ..S (IBCISTAT,IBCIST)=4 D ST^IBCIUT1(IBCIST)
91 ..I IBCISNT=2 D COMMENT^IBCIUT7(IBIFN,4) ; log a comment in auto-send
92 ..Q ; mode when errors are found
93 .I $G(PROBLEM) S IBCIERR=$$P1^IBCIUT4(PROBLEM) D ;comm errors
94 ..S (IBCISTAT,IBCIST)=6 D ST^IBCIUT1(IBCIST) Q
95 ;
96 I IBCISNT=3 D ;test send
97 .D EN^IBCIMSG,SEND
98 .I '$G(PROBLEM) S IBCIY=1 D
99 ..I $$CKNER^IBCIUT1() S IBCISTAT=3 Q ;no errors...
100 ..D Z1AR^IBCIUT4 S IBCISTAT=4 Q ;error(s) found
101 .I $G(PROBLEM) S IBCIERR=$$P1^IBCIUT4(PROBLEM),IBCISTAT=6 Q ;comm errors
102 .D TST ;put in tmp global
103 ;
104 I IBCISNT=4!(IBCISNT=5) D ;canceled, overridden
105 .D EN^IBCIMSG,SEND
106 .I '$G(PROBLEM) S IBCIY=1 D
107 ..S IBCISTAT=$$STAT^IBCIUT1(IBIFN)
108 ..D DELTI^IBCIUT4 ;delete temp information
109 ..D DASN^IBCIUT5(IBIFN) ;remove the assigned to person
110 ..I IBCISNT=4 D DELER^IBCIUT4 ;delete errors
111 .I $G(PROBLEM) D ;comm error
112 ..S (IBCISTAT,IBCIST)=$S(IBCISNT=5:11,IBCISNT=4:10,1:6)
113 ..D ST^IBCIUT1(IBCIST)
114 ..S IBCIERR=$$P1^IBCIUT4(PROBLEM)
115 ;
116 I IBCISNT=6 D ;historical
117 .S IBCISNT=1 D EN^IBCIMSG,SEND ;send first as a normal claim
118 .I '$G(PROBLEM) D Q
119 ..I '$$CKNER^IBCIUT1() D Z1AR^IBCIUT4 ;store them
120 ..H 2 ; pause between sendings to CM
121 ..S IBCISNT=6 D EN^IBCIMSG,SEND ;reset ibcisnt to 6 and send again
122 ..I '$G(PROBLEM) S IBCIY=1 D Q
123 ...S (IBCISTAT,IBCIST)=8 D ST^IBCIUT1(IBCIST)
124 ...D DELTI^IBCIUT4 ; remove the temp nodes
125 ...Q
126 ..I $G(PROBLEM) D Q ;comm error on second send
127 ...S (IBCISTAT,IBCIST)=6 D ST^IBCIUT1(IBCIST)
128 ...S IBCIERR=$$P1^IBCIUT4(PROBLEM)
129 .I $G(PROBLEM) D Q ;comm error on first send
130 ..S (IBCISTAT,IBCIST)=6 D ST^IBCIUT1(IBCIST)
131 ..S IBCIERR=$$P1^IBCIUT4(PROBLEM)
132 ..S IBCISNT=6
133 ;
134 ; Add new send type - esg - 1/3/2002
135 I IBCISNT=7 D ; delete lines from a UB bill on CM
136 . D EN^IBCIMSG,SEND
137 . S IBCISTAT=""
138 . I '$G(PROBLEM) S IBCIY=1
139 . I $G(PROBLEM) S IBCIERR=$$P1^IBCIUT4(PROBLEM)
140 . Q
141 ;
142 I '$G(IBCIERR) S IBCIERR=""
143 Q IBCIY
144 ;
145WRT ;write the message to io
146 ;
147 N I,J,ICD0,LITMS,MOD,TOTMOD
148 S IBCICC=0,IBCIOS=^%ZOSF("OS") D MSGHDR W IBCIHDR
149 S FLUSH=$S(IBCIOS["MSM":"#",IBCIOS["OpenM":"!",1:"!")
150 S IBCICC=IBCICC+$L(IBCIHDR) D ^IBCIUDF
151 ;
152 ; Data elements in the Header Segment
153 F I=1:1:19 D
154 .S IBCICC=IBCICC+$L(^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,I))
155 .I IBCICC>200 W @FLUSH S IBCICC=0
156 .W ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,I)
157 ;
158 ; Determine the # of line items. Write the data elements in the
159 ; Line Segments (ExtLineID field through Units field)
160 ;
161 S LITMS=$P($G(^IBA(351.9,IBIFN,5,0)),U,4)
162 I LITMS W IBCIU(1) F J=1:1:LITMS D
163 .F I=20:1:52 D
164 ..S IBCICC=IBCICC+$L(^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,J,I))
165 ..I IBCICC>200 W @FLUSH S IBCICC=0
166 ..W ^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,J,I)
167 .;
168 .W IBCIU(3) ; field delimiter between Units and ICDCode
169 .;
170 .; icd codes - was node 53, now just an array
171 .; Repeating Field
172 .F I=1:1:$P($G(^TMP("IBCIMSG",$J,IBIFN,"ICD",J,0)),U,2) D
173 ..S IBCICC=IBCICC+$L(^TMP("IBCIMSG",$J,IBIFN,"ICD",J,I))
174 ..I IBCICC>200 W @FLUSH S IBCICC=0
175 ..W ^TMP("IBCIMSG",$J,IBIFN,"ICD",J,I)
176 ..I I'=$P(^TMP("IBCIMSG",$J,IBIFN,"ICD",J,0),U,2) W IBCIU(4)
177 .;
178 .W IBCIU(3) ; field delimiter between ICDCode and Modifier
179 .;
180 .; cpt code node 54 multiple
181 .; CPT Modifier(s). Repeating Field
182 .S TOTMOD=$P(^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,J,54,0),U,1)
183 .F I=1:1:TOTMOD D
184 ..S MOD=^TMP("IBCIMSG",$J,IBIFN,IBCICLNP,J,54,I)
185 ..S IBCICC=IBCICC+$L(MOD)
186 ..I IBCICC>200 W @FLUSH S IBCICC=0
187 ..W MOD
188 ..I I'=TOTMOD W IBCIU(4)
189 .;
190 .W IBCIU(3) ; field delimiter between Modifier and UDF#1
191 .;
192 .; insert the user defined fields, 2 extra field delimiters, and
193 .; a line segment repetition delimiter if we're not done
194 .;
195 .F I=1:1:25 W IBCIUDF(I),IBCIU(3)
196 .W IBCIU(3),IBCIU(3)
197 .I J'=LITMS W IBCIU(2)
198 ;
199 D CLEAN1
200 Q
201 ;
202SEND ;open the tcp/ip port and send msg then read response
203 I '$$OPENUSE^IBCIUT5 S PROBLEM=99 Q
204 W $C(1) D WRT W $C(3),@FLUSH
205 D READ^IBCIUT3(.IBCIZ,.PROBLEM,IBCISOCK)
206 KILL FLUSH,IBCICC,IBCIOS,IBCISOCK
207 Q
208 ;
209TST ;if test send, put errors in tmp global
210 N IBCIDA,IBCIDA1,IBCICNT K ^TMP("IBCITST",$J) S IBCICNT=1
211 S IBCIDA=0 F S IBCIDA=$O(IBCIZ1(IBCIDA)) Q:'IBCIDA D
212 .S IBCIDA1=0 S ^TMP("IBCITST",$J,IBCICNT,IBCIDA1)=IBCIZ1(IBCIDA,IBCIDA1)
213 .F S IBCIDA1=$O(IBCIZ1(IBCIDA,IBCIDA1)) Q:'IBCIDA1 D
214 ..S ^TMP("IBCITST",$J,IBCICNT,1,IBCIDA1,0)=IBCIZ1(IBCIDA,IBCIDA1)
215 .S IBCICNT=IBCICNT+1
216 Q
217 ;
218CLEAN1 ; clean up the variables
219 K ^TMP("IBCIMSG",$J),IBCIU,IBCICLNP,IBCIUDF
220CLEAN ;
221 K ^TMP("IBXSAVE",$J)
222 K X,Y,N1,D0,DA,DIC,DIE,DR,I,II,J,%,CT
223 K IBCIAA,IBCIAPC,IBCIAPID,IBCIBDPS,IBCIBPDE
224 K IBCIBPDI,IBCIBPFI,IBCIBPID,IBCIBPLA,IBCIBPMI,IBCIBPSP
225 K IBCIBPTI,IBCIBPUP,IBCICL,IBCICPT,IBCIDE,IBCIDFN,IBCIBDOS
226 K IBCIDOB,IBCIEB,IBCIEBID,IBCIEDOS,IBCIET,IBCIHDR
227 K IBCILSEG,IBCILSTA,IBCIMCID,IBCIMDT,IBCIMP
228 K IBCIOGID,IBCIOID,IBCIPAC,IBCIPID,IBCIPOS,IBCIPPID
229 K IBCIPTFI,IBCIPTLA,IBCIPTMI,IBCIRAP,IBCIRPDE,IBCIRPDI,IBCIRPFI
230 K IBCIRPID,IBCIRPLA,IBCIRPMI,IBCIRPSP,IBCIRPTI,IBCIRPUP,IBCISAMT
231 K IBCISAP,IBCISEX,IBCISI,IBCISPAI,IBCISPC,IBCISPDE,IBCISPDI
232 K IBCISPFI,IBCISPID,IBCISPLA,IBCISPMI,IBCISPSP,IBCISPTI,IBCISPUP
233 K IBCIST,IBCITC,IBCITOS,IBCIUID,IBCIUNIT,IBCIXLID,IBX,IBY
234 K IENS,NODE3,NODE4,NODE50,NODE51,NODE52,RCD1,CPD1
235 K IBCIZ,IBCIZ1,IBXARRAY,IBXARRY,IBXDAT1,IBXDATA,IBXERR
236 K IBCITSI,X1,X2,X3,X4,IBCILSI,CTR
237 Q
238 ;
Note: See TracBrowser for help on using the repository browser.