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

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

initial load of FOIAVistA 6/30/08 version

File size: 9.0 KB
Line 
1IBCINPT ;DSI/ESG - Extract data and create NPT file ;27-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 ;
5ENTRY ; Entry point for routine (or called from the top)
6 NEW IBCIRTN,STOP,IBCIPATH,IBCIFILE
7 D INIT
8 D INTRO
9 I STOP G EXIT
10 D GETPATH ; get the NPT file location & Open the file
11 I STOP G EXIT
12 D EXTRACT ; build the scratch global
13 D OUTPUT ; build the file
14EXIT ;
15 ; Routine Exit
16 Q
17 ;
18 ;
19INIT ; Procedure to initialize some routine-wide variables
20 S IBCIRTN="IBCINPT" ; routine name, IO handle
21 S STOP=0 ; stop flag
22 S IBCIFILE="IBCINPT.DAT" ; name of file that gets created
23INITX ;
24 Q
25 ;
26 ;
27INTRO ; This procedure displays introductory text and asks if the user
28 ; wants to proceed with the creation of the NPT file.
29 ;
30 W @IOF
31 NEW Y,STARTDT,ENDDT,IBCIMSG,DIR,X,DTOUT,DUOUT,DIRUT,DIROUT
32 ;
33 S Y=DT-30000 D DD^%DT S STARTDT=Y
34 S Y=DT D DD^%DT S ENDDT=Y
35 S IBCIMSG(1)=" This option is responsible for creating the NPT file"
36 S IBCIMSG(2)=" (New Patient History) for the ClaimsManager application from Ingenix."
37 S IBCIMSG(3)=" A 3 year history is needed so this option will extract claims data"
38 S IBCIMSG(4)=" from "_STARTDT_" through "_ENDDT_"."
39 S IBCIMSG(5)=" This process may take several minutes."
40 S IBCIMSG(6)=""
41 ;
42 S IBCIMSG(3,"F")="!!"
43 S IBCIMSG(5,"F")="!!"
44 ;
45 DO EN^DDIOL(.IBCIMSG)
46 ;
47 ; Now for the user response
48 ;
49 S DIR(0)="Y"
50 S DIR("A")=" Do you wish to proceed"
51 S DIR("B")="NO"
52 DO ^DIR
53 I 'Y S STOP=1
54INTROX ;
55 Q
56 ;
57 ;
58GETPATH ; This procedure tries to get a valid directory location or path
59 ; from the user. The file is also opened in this procedure.
60 ;
61 NEW IBCIMSG,DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT,POP
62 ;
63 ; Some introductory text for the user
64 S IBCIMSG(1)=" The file that will be created is called "_IBCIFILE_"."
65 S IBCIMSG(2)=" You may specify a valid directory location (path) for this file."
66 S IBCIMSG(3)=" After this file has been created, it needs to be accessible to the"
67 S IBCIMSG(4)=" ClaimsManager application. This can be done either through network"
68 S IBCIMSG(5)=" connections or by manually moving it to the ClaimsManager server."
69 S IBCIMSG(6)=""
70 ;
71 S IBCIMSG(1,"F")="!!"
72 S IBCIMSG(2,"F")="!!"
73 S IBCIMSG(3,"F")="!!"
74 ;
75 DO EN^DDIOL(.IBCIMSG)
76 ;
77 ; read user response to directory question
78 ;
79GET1 ;
80 KILL DIR
81 S DIR(0)="FOr"
82 S DIR("A")=" Directory"
83 S DIR("A",1)=" Please enter the directory location (path) for "_IBCIFILE
84 S DIR("A",2)=""
85 S DIR("B")=$$PWD^%ZISH() ; retrieves the current directory
86 S DIR("?")=" Enter the location where the file should be created."
87 S DIR("?",1)=" Enter the full path specification up to, but not including,"
88 S DIR("?",2)=" the filename. This includes any trailing slashes or brackets."
89 S DIR("?",3)=" If the operating system allows shortcuts, you can use them."
90 S DIR("?",4)=" Examples of valid paths include:"
91 S DIR("?",5)=""
92 S DIR("?",6)=" DOS/Win c:\scratch\"
93 S DIR("?",7)=" UNIX /home/scratch/"
94 S DIR("?",8)=" VMS USER$:[SCRATCH]"
95 S DIR("?",9)=""
96 ;
97 DO ^DIR
98 ;
99 ; Process the user response
100 ;
101 I $D(DTOUT) S STOP=1 G GETPTHX ; time-out
102 I $D(DUOUT) S STOP=1 G GETPTHX ; any leading "^" input
103 ;
104 ; save the path in the proper variable name
105 S IBCIPATH=Y
106 ;
107 ; attempt to open the file
108 DO OPEN^%ZISH(IBCIRTN,IBCIPATH,IBCIFILE,"W")
109 U IO(0)
110 ;
111 I POP D G GET1
112 . ;
113 . ; This means that the file was not opened.
114 . K IBCIMSG
115 . S IBCIMSG(1)=" """_IBCIPATH_""" is not a valid directory location or path."
116 . S IBCIMSG(2)=" Please press ""?"" for more assistance."
117 . S IBCIMSG(3)=""
118 . ;
119 . S IBCIMSG(1,"F")="!!"
120 . ;
121 . DO EN^DDIOL(.IBCIMSG)
122 . Q
123 ;
124 ; At this point, the file has been opened successfully.
125 ; Display a message about the full file spec and get final confirmation
126 ;
127 KILL IBCIMSG,DIR
128 S IBCIMSG(1)=" The full file specification including path and filename is:"
129 S IBCIMSG(2)=""
130 S IBCIMSG(3)=" "_IBCIPATH_IBCIFILE
131 S IBCIMSG(4)=""
132 ;
133 S IBCIMSG(1,"F")="!!"
134 ;
135 DO EN^DDIOL(.IBCIMSG)
136 ;
137 ; Now for the final user confirmation
138 ;
139 S DIR(0)="Y"
140 S DIR("A")=" OK to begin"
141 S DIR("B")="YES"
142 DO ^DIR
143 ;
144 I 'Y D G GET1 ; user said NO to begin the extract
145 . DO CLOSE^%ZISH(IBCIRTN) ; close the file
146 . DO EN^DDIOL(" ") ; write a blank line to the screen
147 . Q
148 ;
149GETPTHX ;
150 Q
151 ;
152 ;
153EXTRACT ; This procedure extracts the data for the NPT file into a scratch
154 ; global.
155 ;
156 NEW STARTDT,EVNDT,D0,BILL,STATUS,DFN,D1,PROC,IBCIPROV,IBCIPRDT,HCFA,SSN
157 NEW TOTBILLS,TOTRECS,DISPMON,DISPYR,MONTH,SAVMONTH,IBCIMSG,X,Y,%H
158 S TOTBILLS=0,TOTRECS=0
159 KILL ^TMP($J,IBCIRTN) ; initialize scratch global with user/date
160 S %H=$H DO YX^%DTC
161 S ^TMP($J,IBCIRTN)=DUZ_U_Y
162 DO EN^DDIOL(" ") ; write blank line
163 DO WAIT^DICD ; message telling user to wait
164 DO EN^DDIOL(" ") ; write blank line
165 S STARTDT=DT-30000 ; three years ago
166 S STARTDT=$O(^DGCR(399,"D",STARTDT),-1)
167 S EVNDT=STARTDT
168 S SAVMONTH=""
169 F S EVNDT=$O(^DGCR(399,"D",EVNDT)) Q:'EVNDT D
170 . S MONTH=$E(EVNDT,4,5)
171 . I MONTH'=SAVMONTH D
172 .. S Y=EVNDT D DD^%DT
173 .. S DISPMON=$E(Y,1,3)
174 .. S DISPYR=$E(Y,9,12)
175 .. DO EN^DDIOL(" Processing "_DISPMON_" "_DISPYR)
176 .. S SAVMONTH=MONTH
177 .. Q
178 . S D0=0
179 . F S D0=$O(^DGCR(399,"D",EVNDT,D0)) Q:'D0 D
180 .. S TOTBILLS=TOTBILLS+1
181 .. S BILL=$G(^DGCR(399,D0,0))
182 .. S STATUS=$P(BILL,U,13) ; field #.13 STATUS
183 .. I STATUS="" Q
184 .. I $F(".1.7.","."_STATUS_".") Q ; we don't want these
185 .. S DFN=$P(BILL,U,2) ; field #.02 PATIENT NAME
186 .. S SSN=$P($G(^DPT(DFN,0)),U,9) ; SSN# of patient
187 .. I SSN="" Q
188 .. ;
189 .. ; esg - 6/8/01
190 .. ; Use the new Patch 51 procedures to get the provider data if
191 .. ; there is data in the provider multiple.
192 .. ; Use the Operating (2), Rendering (3), and Attending (4) providers
193 .. ; and get their specialties to build the patient history file.
194 .. ;
195 .. I $P($G(^DGCR(399,D0,"PRV",0)),U,4) D
196 ... NEW PRVTYP,IBXARRAY,IBXARRY,IBXDATA,IBXERR,IBPRV
197 ... S IBCIPRDT=$P(EVNDT,".",1) ; use the bill's event date
198 ... I IBCIPRDT="" Q
199 ... D F^IBCEF("N-ALL PROVIDERS",,,D0) ; Patch 51 utility
200 ... F PRVTYP=2,3,4 D
201 .... S IBPRV=$P($G(IBXDATA(PRVTYP,1)),U,3)
202 .... S HCFA=$$BILLSPEC^IBCEU3(D0,IBPRV)
203 .... I HCFA="" Q
204 .... ;
205 .... ; All the data should be here so file it
206 .... ; Update the record counter if we've never seen this
207 .... ; patient/specialty pairing before
208 .... I '$D(^TMP($J,IBCIRTN,SSN,HCFA)) S TOTRECS=TOTRECS+1
209 .... S ^TMP($J,IBCIRTN,SSN,HCFA,IBCIPRDT)=""
210 .... Q
211 ... Q
212 .. ;
213 .. ; Now loop through the procedures sub-file and extract data
214 .. S D1=0
215 .. F S D1=$O(^DGCR(399,D0,"CP",D1)) Q:'D1 D
216 ... S PROC=$G(^DGCR(399,D0,"CP",D1,0))
217 ... S IBCIPROV=$P(PROC,U,18) ; field #18 PROVIDER
218 ... I IBCIPROV="" Q
219 ... S IBCIPRDT=$P(PROC,U,2) ; field #1 PROCEDURE DATE
220 ... I IBCIPRDT="" Q
221 ... ;
222 ... ; invoke utility from Kernel patch XU*8.0*132
223 ... S HCFA=$$GET^XUA4A72(IBCIPROV,IBCIPRDT)
224 ... S HCFA=$P(HCFA,U,8) ; 2-digit HCFA specialty code
225 ... I HCFA="" Q
226 ... ;
227 ... ; All the data should be here so file it
228 ... ; Update the record counter if we've never seen this
229 ... ; patient/specialty pairing before
230 ... I '$D(^TMP($J,IBCIRTN,SSN,HCFA)) S TOTRECS=TOTRECS+1
231 ... S ^TMP($J,IBCIRTN,SSN,HCFA,IBCIPRDT)=""
232 ... Q
233 .. Q
234 . Q
235 ;
236 ;
237 KILL IBCIMSG
238 S IBCIMSG(1)=" The compile process has completed successfully."
239 S IBCIMSG(2)=" The number of bills that were reviewed is "_$FN(TOTBILLS,",")_"."
240 S IBCIMSG(3)=" The number of records that will be in the NPT file is "_$FN(TOTRECS,",")_"."
241 S IBCIMSG(4)=" All that's left to do is to copy these records into the NPT file."
242 S IBCIMSG(5)=""
243 ;
244 S IBCIMSG(1,"F")="!!"
245 S IBCIMSG(2,"F")="!!"
246 S IBCIMSG(4,"F")="!!"
247 ;
248 DO EN^DDIOL(.IBCIMSG)
249 ;
250EXTRX ;
251 Q
252 ;
253 ;
254OUTPUT ; This procedure loops through the scratch global and writes each
255 ; record to the open file. We only need to write the record with
256 ; the most recent date of service for each patient/HCFA specialty
257 ; code pair. This is why we are not looping through all dates,
258 ; but doing a $Order with the -1 parameter to get the most recent
259 ; date. The file is also closed in this procedure and a confirmation
260 ; message is shown to the user.
261 ;
262 NEW SSN,HCFA,DATE,SVCDT,IBCIMSG,POP,X,X1,X2,X3,X4,Y
263 ;
264 ; Use the file for writing
265 U IO
266 ;
267 ; loop through global and output record into file
268 S (SSN,HCFA)=""
269 F S SSN=$O(^TMP($J,IBCIRTN,SSN)) Q:SSN="" D
270 . F S HCFA=$O(^TMP($J,IBCIRTN,SSN,HCFA)) Q:HCFA="" D
271 .. S DATE=$O(^TMP($J,IBCIRTN,SSN,HCFA,""),-1)
272 .. S SVCDT=($E(DATE,1,3)+1700)_$E(DATE,4,7)
273 .. ;
274 .. ; Output the records to the file
275 .. S X=SSN,X1=20,X4="T" W $$FILL^IBCIUT2
276 .. S X=HCFA,X1=10,X4="T" W $$FILL^IBCIUT2
277 .. S X=SVCDT,X1=17,X4="T" W $$FILL^IBCIUT2
278 .. W !
279 .. Q
280 . Q
281 ;
282 ; The file has been created so close it and tell the user
283 DO CLOSE^%ZISH(IBCIRTN)
284 U IO(0)
285 S IBCIMSG(1)=" The NPT file creation process is complete!"
286 S IBCIMSG(2)=""
287 S IBCIMSG(1,"F")="!!"
288 DO EN^DDIOL(.IBCIMSG)
289 ;
290 ; clean up the scratch global
291 KILL ^TMP($J,IBCIRTN)
292 ;
293OUTPUTX ;
294 Q
295 ;
Note: See TracBrowser for help on using the repository browser.