source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCIUT1.m@ 1259

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

initial load of WorldVistAEHR

File size: 8.4 KB
Line 
1IBCIUT1 ;DSI/SLM - MISC UTILITIES FOR CLAIMSMANAGER INTERFACE ;21-DEC-2000
2 ;;2.0;INTEGRATED BILLING;**161,210**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 Q
5 ;
6NOW ;get current (or specific) date/time and convert to ClaimsManager format
7 ;
8 ;Input variable
9 ; x = date or date/time (for date/time other than now)
10 ;Output variable
11 ; y = date or date/time in claimsmanager format
12 ; (yyyymmdd) or (yyyymmddhhmmss)
13 ;
14 NEW YEAR,MON,DAY,HOUR,MIN,SEC
15 I '$G(X) S X=$$NOW^XLFDT
16 S YEAR=$E(X,1,3)+1700,MON=$E(X,4,5),DAY=$E(X,6,7)
17 I MON="00" S MON="01"
18 I DAY="00" S DAY="01"
19 I +$P(X,".",2) D
20 .S HOUR=$E($P(X,".",2),1,2),MIN=$E($P(X,".",2),3,4),SEC=$E($P(X,".",2),5,6)
21 .S Y=YEAR_MON_DAY_HOUR_MIN_SEC
22 E S Y=YEAR_MON_DAY
23 Q
24NOW1(X) ;change date from mmddyyyy to yyyymmdd
25 N DATE,MM,DD,YY
26 S MM=$E(X,1,2),DD=$E(X,3,4),YY=$E(X,5,8)
27 S DATE=YY_MM_DD
28 Q DATE
29NAMSP ;split name into three pieces LAST^FIRST^MIDDLE
30 ;Input variable
31 ; x = LAST,FIRST MIDDLE
32 ;Output variable
33 ; y = LAST^FIRST^MIDDLE
34 ;
35 N NAME S Y=""
36 S NAME(1)=$P(X,","),NAME(2)=$P(X,",",2,999)
37 S NAME(3)=$P(NAME(2)," ",2,999)
38 S NAME(2)=$P(NAME(2)," ",1)
39 S Y=NAME(1)_"^"_NAME(2)_"^"_NAME(3)
40 Q
41 ;
42CM(IBIFN) ;
43 ; ClaimsManager environment check for IB routines. Checks to make
44 ; sure CM is running and that the bill is a HCFA 1500 form type bill.
45 ; Any other condition will return false.
46 ;
47 N Y
48 S Y=0
49 I $G(IBIFN),$$CK0(),'$$CK1(IBIFN) S Y=1
50 Q Y
51 ;
52CK0() ;checks to see if running ClaimsManager
53 ;returns a 1 if running ClaimsManager
54 N Y
55 S Y=$S($P($G(^IBE(350.9,1,50)),U)=1:1,1:0)
56 Q Y
57 ;
58CK1(IBIFN) ;checks to see if it's a HCFA 1500 claim form
59 ;returns 0 if HCFA 1500, returns 1 if any other form type
60 ;
61 N IBX,IBY
62 S IBY=$P($G(^DGCR(399,IBIFN,0)),U,19)
63 S IBX=$S(IBY=2:0,1:1)
64 Q IBX
65 ;
66CK2() ;checks to see if ClaimsManager is working ok
67 ;returns a 1 if running ok
68 ;
69 N Y
70 S Y=$S($P($G(^IBE(350.9,1,50)),U,2)=1:1,1:0)
71 Q Y
72 ;
73ST(IBCIST) ;set status field to ibcist
74 ;
75 ;input variables
76 ; ibifn
77 ; ibcist
78 I '$D(IBIFN) Q
79 I '$D(IBCIST) Q
80 S IENS=IBIFN_",",FDA(351.9,IENS,.02)=IBCIST
81 D FILE^DIE("K","FDA")
82 K FDA,IENS
83 Q
84 ;
85STAT(IBIFN) ;return value of status field in 351.9
86 N IBCIST1
87 S IBCIST1=$P(^IBA(351.9,IBIFN,0),U,2)
88 Q IBCIST1
89 ;
90 ;
91LITMS(IBIFN) ; Returns the number of line items
92 NEW IBXARRAY,IBXARRY,IBXDATA,IBXERR
93 KILL ^TMP("IBXSAVE",$J)
94 D F^IBCEF("N-HCFA 1500 SERVICES (PRINT)",,,IBIFN)
95 Q +$O(IBXDATA(""),-1)
96 ;
97 ;
98LSTA(IBCISNT) ; return the correct Ingenix line status based on the value
99 ; of IBCISNT - where is the interface called from?
100 Q $S(IBCISNT=5:"P",IBCISNT=4:"D",IBCISNT=7:"D",1:"A")
101 ;
102RPHY(IBIFN) ; Attending/rendering physician information
103 ;
104 ; This function returns the physician information for bill# IBIFN.
105 ; Data is returned in a pieced string:
106 ;
107 ; [1] Name
108 ; for non-VA, this may be a facility (if no comma in Name)
109 ; [2] ID#
110 ; File 200 ien# for VA; "NVA"_ien# for non-VA
111 ; [3] Department
112 ; Service/Section file ien# for VA; "NVA" for non-VA
113 ; [4] Specialty
114 ;
115 NEW IBXDATA,IBXARRAY,IBXARRY,IBXERR,Y,IBPRV
116 S Y=""
117 D F^IBCEF("N-ATT/REND PHYSICIAN NAME",,,IBIFN)
118 S IBPRV=$P($G(IBXDATA),U,2)
119 I 'IBPRV G RPHYX
120 S $P(Y,U,1)=$P(IBXDATA,U,1)
121 S $P(Y,U,4)=$$BILLSPEC^IBCEU3(IBIFN,IBPRV)
122 ;
123 ; Check for VA provider first and then get out
124 I IBPRV'["IBA(355.93" D G RPHYX
125 . S $P(Y,U,2)=+IBPRV
126 . S $P(Y,U,3)=$P($G(^VA(200,+IBPRV,5)),U,1)
127 . Q
128 ;
129 ; Now we're dealing with a Non-VA provider
130 S $P(Y,U,2)="NVA"_+IBPRV
131 S $P(Y,U,3)="NVA"
132RPHYX ;
133 Q Y
134 ;
135CKNER() ;check for no errors
136 ;returns 1 if no errors, 0 if errors were found
137 N IBCIY,LSEG S LSEG=0,IBCIY=1
138 F S LSEG=$O(IBCIZ("RL",LSEG)) Q:'LSEG D
139 .I $P(IBCIZ("RL",LSEG,0),U,2)]"" S IBCIY=0
140 Q IBCIY
141CKLI(IBIFN) ;check for line items
142 N LITEM
143 I '$P($G(^IBA(351.9,IBIFN,3)),U,1) D UPDT^IBCIADD1 ; build if not there
144 S LITEM=$S(+$P($G(^IBA(351.9,IBIFN,5,0)),U,4)>0:1,1:0)
145 Q LITEM
146 ;
147 ;
148CKFT(IBIFN) ; Check for a form type change by the user
149 NEW D0,DA,DB,DC,DE,DH,DI,DIC,DIE,DIEL,DIFLD,DIG,DIH
150 NEW DIK,DIPA,DIV,DK,DL,DM,DP,DQ,DR,X,Y
151 NEW IBCISNT,IBCISTAT,IBCIREDT,IBCIERR
152 I '$$CK0() Q ; esg - 7/17/01 - bug fix
153 ;
154 ; If it's not there, but it is a hcfa 1500, then add it
155 I '$D(^IBA(351.9,IBIFN)),'$$CK1(IBIFN) D ST1^IBCIST G CKFTX
156 ;
157 ; If it's there, but no longer a hcfa 1500, then delete it.
158 ; esg - 1/3/2002 - If it has been sent to CM previously, then
159 ; we need to send it with new send type 7.
160 I $D(^IBA(351.9,IBIFN)),$$CK1(IBIFN) D
161 . I $P($G(^IBA(351.9,IBIFN,0)),U,15) S IBCISNT=7 D ST2^IBCIST
162 . S DIK="^IBA(351.9,",DA=IBIFN D ^DIK
163 . Q
164CKFTX ;
165 Q
166 ;
167 ;
168DIAG(IBIFN) ;return array of diagnosis codes for each line item
169 NEW IBXDATA,IBXARRAY,IBXARRY,IBXERR
170 NEW IBZDC1,SUB1,LITM,CODES,DNUM,DC,ICDIEN,CT
171 K ^TMP("IBXSAVE",$J,"DX")
172 S SUB1=$S($G(IBCIMSG)=1:"IBCIMSG",1:"DISPLAY")
173 K ^TMP(SUB1,$J,IBIFN,"ICD")
174 D F^IBCEF("N-HCFA 1500 SERVICES (PRINT)",,,IBIFN)
175 D F^IBCEF("N-DIAGNOSES","IBZDC1",,IBIFN)
176 ;
177 ; if IBCIMSG is on, need to count up the line items for the set below
178 I $G(IBCIMSG) S (CT,LITM)=0 F S LITM=$O(IBXDATA(LITM)) Q:'LITM S CT=CT+1
179 S LITM=0 F S LITM=$O(IBXDATA(LITM)) Q:'LITM D
180 .S CODES=$P(IBXDATA(LITM),U,7)
181 .S DNUM=0 F S DNUM=DNUM+1 Q:$P(CODES,",",DNUM)="" D
182 ..S DC(DNUM)=$P(CODES,",",DNUM)
183 ..S ICDIEN=$P(IBZDC1(DC(DNUM)),U,1)
184 ..S ^TMP(SUB1,$J,IBIFN,"ICD",LITM,DNUM)=$P($$ICD9^IBACSV(ICDIEN),U)
185 .I $G(IBCIMSG) S ^TMP(SUB1,$J,IBIFN,"ICD",LITM,0)=CT_U_(DNUM-1)
186 K ^TMP("IBXSAVE",$J,"DX")
187 Q
188 ;
189 ;
190EDATP(IBIFN,COMMCHG) ;edit assigned to person (ATP)
191 ;
192 ; This procedure reads in the Assigned to person from the user and
193 ; makes sure that some user gets assigned to the bill (IBIFN). The
194 ; parameter COMMCHG indicates whether or not the current user
195 ; modified the ClaimsManager comments in any way.
196 ;
197 ; This procedure also determines if a MailMan message should get
198 ; sent to the new assigned to person and invokes the procedure if
199 ; it should.
200 ;
201 NEW D,D0,DA,DIC,DIE,DR,I,IBCIATPO,IBCIATPN,IBCIDEF,X,Y
202 NEW IBCIGRP,IBCIGRPN,GRPONLY,CONMSG
203 S IBCIATPO=$P($G(^IBA(351.9,IBIFN,0)),U,12) ; original ATP
204 W !!!,?2,"Please enter the person to whom this bill should be assigned.",!
205 S IBCIDEF=IBCIATPO ; default the current ATP, but ...
206 I 'IBCIDEF S IBCIDEF=DUZ ; if not there, default the current user
207 S DA=IBIFN,DIE="^IBA(351.9,"
208 S DR=".12ASSIGNED TO PERSON//"_$P($G(^VA(200,IBCIDEF,0)),U,1)
209 D ^DIE
210 ;
211 ; Make sure someone got assigned. Stuff in the current user if
212 ; nobody got assigned. Set a variable indicating the new assigned
213 ; to person.
214 ;
215 I '$P($G(^IBA(351.9,IBIFN,0)),U,12) D
216 . S DIE="^IBA(351.9,",DA=IBIFN,DR=".12////"_DUZ D ^DIE
217 . Q
218 S IBCIATPN=$P($G(^IBA(351.9,IBIFN,0)),U,12) ; new ATP
219 ;
220 ; Display a confirmation message to the user
221 W !!!?2,"Claim ",$P($G(^DGCR(399,IBIFN,0)),U,1)," has been assigned to "
222 W $P($G(^VA(200,IBCIATPN,0)),U,1),"."
223 ;
224 ; Ask the user if they want to send the MailMan message to a specific
225 ; mail group in addition to the new assigned to person.
226 ; ESG - 9/4/01
227 ;
228 W !!!?2,"If you want to send a MailMan message about this bill assignment"
229 W !?2,"to a specific Mail Group, then please choose that Mail Group here.",!
230 S DIC="^XMB(3.8,",DIC(0)="ABEQV",DIC("A")="MAIL GROUP: "
231 D ^DIC
232 S (IBCIGRP,IBCIGRPN)=""
233 I Y>0 S IBCIGRP=+Y,IBCIGRPN=$P(Y,U,2) ; group ien and name
234 ;
235 ; Now determine if a MailMan message should get sent out and send it.
236 ; Don't send a MailMan message to yourself and don't send a message
237 ; if the assignment has not changed. However, if the user chose a
238 ; mail group at the above prompt, then always send a MailMan message
239 ; to that mail group.
240 ;
241 ; The GRPONLY variable is true if the assigned to person is the
242 ; current user OR if the assigned to person is the same as the original
243 ; assigned to person.
244 ;
245 S GRPONLY=(IBCIATPN=DUZ)!(IBCIATPN=IBCIATPO)
246 I 'IBCIGRP,GRPONLY G EDATPX ; No mailman in this case at all
247 ;
248 ; Call the procedure that creates the message
249 D CAT^IBCIUT6(IBIFN,DUZ,IBCIATPN,IBCIGRP,GRPONLY)
250 ;
251 ; The CONMSG array is the confirmation message array so the user
252 ; knows to whom a message was sent.
253 I 'GRPONLY S CONMSG(1)=$P($G(^VA(200,IBCIATPN,0)),U,1)
254 I IBCIGRP S CONMSG(2)=IBCIGRPN
255 ;
256 ; Build and display the confirmation message
257 W !!?2,"A MailMan message has been sent to "
258 S X=0
259 F S X=$O(CONMSG(X)) Q:'X W CONMSG(X) I $O(CONMSG(X)) W !?30,"and to "
260 W "."
261 ;
262EDATPX ;
263 ; Display a press return to continue message if coming in from
264 ; the Listman screens
265 I $D(VALMHDR) W !! S DIR("A")="Press RETURN to continue",DIR(0)="E",DIR("T")=10 D ^DIR K DIR
266 Q
Note: See TracBrowser for help on using the repository browser.