source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCIUT6.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: 8.8 KB
Line 
1IBCIUT6 ;DSI/ESG - MAILMAN UTILITIES ;22-JUN-2001
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
6 ;
7CAT(IBIFN,IBCIFRM,IBCITO,IBCIGRP,GRPONLY) ; MailMan message sending
8 ; This procedure is called when the user is assigning a bill to
9 ; another user.
10 ;
11 ; Input variables
12 ; IBIFN - IEN of claim
13 ; IBCIFRM - DUZ of person assigning the claim
14 ; IBCITO - DUZ of person being assigned the claim
15 ; IBCIGRP - IEN of the Mail Group to receive this msg
16 ; (optional - default is "")
17 ; GRPONLY - 1/0 flag indicating if the Mail Group is the only
18 ; entity to receive the mail message.
19 ; (optional - default is 0)
20 ;
21 NEW ERRDATA,ERRLVL,IBCIASI,IBCIASN,IBCIBII,IBCIBIL,IBCIBIR,IBCICAR
22 NEW IBCICLNO,IBCICLNP,IBCICNM,IBCICOD,IBCIDAT,IBCIDOB,IBCIDPT,IBCIEVEN
23 NEW IBCIEVV,IBCIFRM1,IBCIINS,IBCINAM,IBCIPAD,IBCIPRV,IBCIPTI,IBCISER
24 NEW IBCISEX,IBCISRR,IBCISSN,IBCITO1,L1,L2,L3,LINENO,MNEMONIC,PREVLINE
25 NEW SEP,TEXT,VALMHDR,XMDUN,XMDUZ,XMZ,XMMG,XMSUB,XMTEXT,XMY
26 ;
27 S IBCIGRP=$G(IBCIGRP,"")
28 S GRPONLY=$G(GRPONLY,0)
29 I IBCIGRP S IBCIGRP=$P($G(^XMB(3.8,IBCIGRP,0)),U,1) ; Mail Group name
30 S IBCICLNP=$P(^DGCR(399,IBIFN,0),U,1)
31 S IBCIFRM1=$P(^VA(200,IBCIFRM,0),U,1)
32 S IBCITO1=$P(^VA(200,IBCITO,0),U,1)
33 S XMDUZ=IBCIFRM
34 S XMSUB="ClaimsManager Claim "_IBCICLNP_" Assigned to "_IBCITO1
35 ;
36 S L1=1
37 S TEXT(L1)=$J(IBCICLNP_" has been assigned to: ",32)_IBCITO1,L1=L1+1
38 S TEXT(L1)=$J("by: ",32)_IBCIFRM1,L1=L1+1
39 S TEXT(L1)=" ",L1=L1+1
40 ;
41 ; If comments exist, then display them here
42 ;
43 I $P($G(^IBA(351.9,IBIFN,2,0)),U,4) D
44 . S TEXT(L1)=$$CMTINFO^IBCIUT5(IBIFN),L1=L1+1
45 . S TEXT(L1)=" ",L1=L1+1
46 . S L2=0
47 . F S L2=$O(^IBA(351.9,IBIFN,2,L2)) Q:'L2 D
48 .. S TEXT(L1)=^IBA(351.9,IBIFN,2,L2,0),L1=L1+1
49 .. Q
50 . S TEXT(L1)=" ",L1=L1+1
51 . S TEXT(L1)=" ",L1=L1+1
52 . Q
53 ;
54 ; Now get and display the patient and claim data
55 ;
56 D GDATA^IBCIWK,HDR^IBCIMG
57 S $P(SEP,"-",80)="" ; 79 dashes
58 S TEXT(L1)=$E(SEP,1,24)_" Patient and Claim Information "
59 S TEXT(L1)=TEXT(L1)_$E(SEP,1,24),L1=L1+1
60 S TEXT(L1)=VALMHDR(1),L1=L1+1
61 S TEXT(L1)=VALMHDR(2),L1=L1+1
62 S TEXT(L1)=VALMHDR(3),L1=L1+1
63 S TEXT(L1)=SEP,L1=L1+1
64 S TEXT(L1)=" ",L1=L1+1
65 S TEXT(L1)=$J("ClaimsManager Errors and Line Item Data",59),L1=L1+1
66 S TEXT(L1)=" ",L1=L1+1
67 ;
68 ; Display a message if there are no errors in the file
69 I '$P($G(^IBA(351.9,IBIFN,1,0)),U,4) D
70 . S TEXT(L1)=$J("*** No ClaimsManager Errors to Report ***",60),L1=L1+1
71 . S TEXT(L1)=" ",L1=L1+1
72 . Q
73 ;
74 ; Loop through the CM errors and get and display the data
75 S L2=0
76 S PREVLINE=-9999999
77 F S L2=$O(^IBA(351.9,IBIFN,1,L2)) Q:'L2 D
78 . S ERRDATA=$G(^IBA(351.9,IBIFN,1,L2,0))
79 . S LINENO=+$P(ERRDATA,U,2)
80 . I LINENO'=PREVLINE D LINEDATA(IBIFN,LINENO) S PREVLINE=LINENO
81 . S MNEMONIC=$P(ERRDATA,U,1)
82 . S ERRLVL="Error Level: "_$P(ERRDATA,"~",2)
83 . S TEXT(L1)="("_L2_") ClaimsManager Error: "_MNEMONIC
84 . S TEXT(L1)=(TEXT(L1)_$J(ERRLVL,78-$L(TEXT(L1)))),L1=L1+1
85 . S L3=0
86 . F S L3=$O(^IBA(351.9,IBIFN,1,L2,1,L3)) Q:'L3 D
87 .. S TEXT(L1)=" "_$G(^IBA(351.9,IBIFN,1,L2,1,L3,0)),L1=L1+1
88 .. Q
89 . S TEXT(L1)=" ",L1=L1+1
90 . Q
91 ;
92 ; Now time to do the MailMan stuff
93 S XMTEXT="TEXT(" ; msg text
94 I 'GRPONLY S XMY("I:"_IBCITO)="" ; info only msg to recipient
95 I 'GRPONLY S XMY("I:"_IBCIFRM)="" ; info only msg to sender
96 I IBCIGRP'="" S XMY("I:G."_IBCIGRP)="" ; info only msg to group
97 D ^XMD
98 ;
99 ; look at the IB site parameter file to see if we should send
100 ; priority or normal MailMan messages
101 I '$G(XMZ) G CATX ; no msg created
102 I $P($G(^IBE(350.9,1,50)),U,7)="N" G CATX ; normal messages
103 S $P(^XMB(3.9,XMZ,0),U,7)="P" ; priority messages
104CATX ;
105 Q
106 ;
107 ;
108LINEDATA(IBIFN,LINE) ; Get and display the line item info
109 NEW BEGDATE,CHRG,COLHDR,CPT,DXCODE,DXSTRING,ENDDATE,KILLTMP
110 NEW LNA,LNB,MOD,MODS,MOD2,POS,SEQ,TOS,UNIT,X,X1,X2,X3,X4,Y
111 ;
112 ; Conditionally build the 3,4,5 nodes. Use this flag to indicate
113 ; whether or not to kill these nodes when we're done.
114 S KILLTMP=0
115 I '$P($G(^IBA(351.9,IBIFN,3)),U,1) S KILLTMP=1 D UPDT^IBCIADD1
116 S COLHDR="----------BEG DATE----END DATE----POS---TOS--CPT------"
117 S COLHDR=COLHDR_"MOD-------CHARGE-----UNIT"
118 S LNA=$G(^IBA(351.9,IBIFN,5,LINE,0))
119 S LNB=$G(^IBA(351.9,IBIFN,5,LINE,2))
120 S BEGDATE=$P(LNA,U,6)
121 S BEGDATE=$E(BEGDATE,5,6)_"/"_$E(BEGDATE,7,8)_"/"_$E(BEGDATE,1,4)
122 S ENDDATE=$P(LNA,U,7)
123 S ENDDATE=$E(ENDDATE,5,6)_"/"_$E(ENDDATE,7,8)_"/"_$E(ENDDATE,1,4)
124 S POS=$P(LNA,U,8)
125 S TOS=$P(LNB,U,11)
126 S CPT=$P(LNA,U,9)
127 S MODS=$TR($P($G(^IBA(351.9,IBIFN,5,LINE,3)),U,1),",")
128 S MOD=$E(MODS,1,6),MOD2=$E(MODS,7,999)
129 S CHRG=$FN($P(LNA,U,11),"",2)
130 S UNIT=$P(LNB,U,12)
131 ;
132 ; Get the diagnosis information for this line
133 KILL ^TMP("DISPLAY",$J)
134 S DXSTRING=""
135 D DIAG^IBCIUT1(IBIFN)
136 S SEQ=0
137 F S SEQ=$O(^TMP("DISPLAY",$J,IBIFN,"ICD",LINE,SEQ)) Q:'SEQ D
138 . S DXCODE=^TMP("DISPLAY",$J,IBIFN,"ICD",LINE,SEQ)
139 . I DXSTRING="" S DXSTRING=DXCODE
140 . E S DXSTRING=DXSTRING_" / "_DXCODE
141 . Q
142 KILL ^TMP("DISPLAY",$J)
143 ;
144 ; Now build the text strings for the line item data
145 S TEXT(L1)=COLHDR,L1=L1+1
146 S TEXT(L1)=" Line: "
147 S X=LINE,X1=3,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
148 S X=BEGDATE,X1=12,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
149 S X=ENDDATE,X1=12,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
150 S X=POS,X1=6,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
151 S X=TOS,X1=5,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
152 S X=CPT,X1=9,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
153 S X=MOD,X1=6,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
154 S X=CHRG,X1=10,X2="R" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
155 S TEXT(L1)=TEXT(L1)_" "
156 S X=UNIT,X1=3,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
157 S L1=L1+1
158 S TEXT(L1)=" Dx's: "
159 I $L(DXSTRING)<46,MOD2'="" D
160 . S X=DXSTRING,X1=47,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
161 . S X=MOD2,X1=8,X2="L" S TEXT(L1)=TEXT(L1)_$$FILL^IBCIUT2
162 . Q
163 E S TEXT(L1)=TEXT(L1)_DXSTRING
164 S L1=L1+1
165 ;
166LINDATX ;
167 I KILLTMP D DELTI^IBCIUT4
168 Q
169 ;
170TOP(IBIFN) ; This utility returns the type of plan for the current payer
171 ; sequenced insurance company. This is currently used for the
172 ; ClaimsManager UserDefined field #4.
173 ; The data in this field is the actual type of plan defined on VistA.
174 N IBCITOP,GRPPLAN,IBCISEQ,INSSEQ,TOPIEN
175 S IBCITOP=""
176 S IBCISEQ=$$COBN^IBCEF(IBIFN)
177 S INSSEQ="I"_IBCISEQ
178 S GRPPLAN=$P($G(^DGCR(399,IBIFN,INSSEQ)),U,18)
179 I GRPPLAN="" G TOPX
180 S TOPIEN=$P($G(^IBA(355.3,GRPPLAN,0)),U,9)
181 I TOPIEN="" G TOPX
182 S IBCITOP=$P($G(^IBE(355.1,TOPIEN,0)),U,2)
183TOPX ;
184 Q IBCITOP
185 ;
186CLRCMQ(MSG) ;
187 ; This procedure will try to clear out the CM result queue by opening
188 ; and using every available port and just reading in any and all
189 ; data CM is wanting to send.
190 ;
191 ; Input: MSG is either 0 or 1 which will determine if status messages
192 ; and/or error messages are displayed on the screen.
193 ; MSG=0 silent mode
194 ; MSG=1 display on screen mode
195 ;
196 ; Output: None (either it will work or it won't)
197 ;
198 NEW IBCIIP,PORTS,IBCISOCK,JTOT,POP,J,TRASH,SET,IBCIMT
199 NEW X,Y,DTOUT,DUOUT,DIRUT,DIROUT
200 S MSG=$G(MSG,1)
201 S IBCIMT=$$ENV^IBCIUT5
202 I 'MSG,IBCIMT="T" G CLRX ; don't allow silent mode from TEST acct
203 ;
204 ; If a site isn't using the interface, then display message and exit
205 I '$$CK0^IBCIUT1(),MSG D G CLRX
206 . U IO(0)
207 . W !!!?5,"The ClaimsManager product is not being used."
208 . W !!?5,"This option is not available.",!!
209 . S DIR(0)="E" D ^DIR K DIR
210 . Q
211 ;
212 I MSG D I 'Y G CLRX
213 . U IO(0)
214 . W @IOF
215 . W !?20,"Clear ClaimsManager Results Queue",!
216 . W !?2,"This option attempts to clear out the ClaimsManager Results Queue so"
217 . W !?2,"ClaimsManager can get back in sync with VistA. If this process doesn't"
218 . W !?2,"correct the problems, then Ingenix should be called (800-765-6818)."
219 . W !
220 . I IBCIMT="T" D
221 .. W !?2,"Please note that you're doing this from the TEST account. This may be"
222 .. W !?2,"risky if there are Production users using ClaimsManager."
223 .. W !
224 .. Q
225 . S DIR(0)="Y"
226 . S DIR("A")="OK to proceed"
227 . S DIR("B")="YES"
228 . DO ^DIR K DIR
229 . Q
230 ;
231 L +^IBCITCP:15 E W:MSG !!,"Couldn't Lock all Ports" G CLRX
232 S IBCIIP=$P($G(^IBE(350.9,1,50)),U,5)
233 I IBCIIP="" W:MSG !!,"No IP address" G CLRX
234 M PORTS=^IBE(350.9,1,50.06,"B")
235 I '$D(PORTS) W:MSG !!,"No Ports defined" G CLRX
236 S SET=0
237AGAIN ;
238 S SET=SET+1
239 W:MSG !!,"Set ",SET
240 S IBCISOCK="",JTOT=0
241 F S IBCISOCK=$O(PORTS(IBCISOCK)) Q:IBCISOCK="" D
242 . W:MSG !?1,"Port# ",IBCISOCK
243 . D CALL^%ZISTCP(IBCIIP,IBCISOCK,1)
244 . I POP W:MSG ?16,"FAILURE: Couldn't open port!!" Q
245 . F J=0:1 R TRASH#1:1 Q:'$T Q:$A(TRASH)=3 Q:TRASH=""
246 . S JTOT=JTOT+J
247 . W $C(1,6,3),!
248 . D CLOSE^%ZISTCP
249 . I 'MSG Q
250 . U IO(0)
251 . W ?15,$J(J,5)," characters read"
252 . W ?40,"ACK sent to CM"
253 . W ?58,"Port Closed"
254 . Q
255 W:MSG !,"Results of Set ",SET,": "
256 I JTOT W:MSG "Data was detected. Repeating the process." H 1 G AGAIN
257 W:MSG "No data found. Process is complete.",!!
258CLRX ;
259 L -^IBCITCP
260 Q
261 ;
Note: See TracBrowser for help on using the repository browser.