source: cprs/branches/tmg-cprs/m_files/TMGSEQL1.m@ 1083

Last change on this file since 1083 was 796, checked in by Kevin Toppenberg, 14 years ago

Initial upload
File size: 38.0 KB
Line 
1TMGSEQL1 ;TMG/kst/Interface with SequelSystems PMS ;03/25/06
2 ;;1.0;TMG-LIB;**1**;01/09/06
3
4 ;"TMG SEQUEL IMPORT FUNCTIONS
5 ;"Kevin Toppenberg MD
6 ;"GNU General Public License (GPL) applies
7 ;"1-9-2006
8
9
10 ;"=======================================================================
11 ;" API -- Public Functions.
12 ;"=======================================================================
13 ;"ASKIMPORT
14 ;"RUNNOW provide an entry point for running import NOW. This will delete prior alerts
15 ;"AUTOIN ;"entry point for scheduled task
16 ;"QUIETIN
17
18 ;"$$IMPORTFILE(FilePath,FileName,F2Name,ErrArray,ChgLog,PrgCallback,F2Path,DelFiles,UserID)
19 ;"$$IMPORTGLOBAL(GRef,G2Ref,ErrArray,ChgLog,PrgCallback,UserID)
20
21 ;"=======================================================================
22 ;"PRIVATE API FUNCTIONS
23 ;"=======================================================================
24 ;"$$ProcessPt(OneLine,ErrArray,ChgLog,SSNArray,DUZ)
25 ;"$$ParseLine(OneLine,Array,SSNArray)
26 ;"UpdateDB(PtInfo,AutoRegister,ErrArray,ChgLog)
27 ;"$$InactivePt(PMSAcctNum,SSNArray)
28 ;"$$InvalidProvider(SequelProvider)
29 ;"$$InvalPtName(FName,LName)
30
31
32 ;"=======================================================================
33 ;"DEPENDENCIES
34 ;"TMGIOUTL
35 ;"TMGMISC
36 ;"=======================================================================
37 ;"=======================================================================
38
39
40
41 ;"=======================================================================
42 ;" Below are three custom files that are used by the TMGSEQL* code
43 ;"=======================================================================
44
45
46 ;"File: 22706 TMG DEMOGRAPHICS IMPORT ERRORS Branch: 1
47 ;"REF NODE;PIECE FLD NUM FIELD NAME
48 ;"===============================================================================
49 ;" 1 0;1 .01 ACCOUNT NUMBER [RNJ9,0]
50 ;" 2 4;1 .02 CREATION DATE [D]
51 ;" 3 4;2 .03 PATIENT NAME [F]
52 ;" 4 0;2 1 MESSAGE [F]
53 ;" 2;0 2 IMPORT DATA <-WP [22706.02]
54 ;" 5 -0;1 .01 -IMPORT DATA [W]
55 ;" 3;0 3 DIERR MESSAGE <-WP [22706.03]
56 ;" 6 -0;1 .01 -DIERR MESSAGE [W]
57 ;" 7 4;3 4 ALERT IEN [NJ9,0]
58 ;" <> <> <>
59 ;" A.) FILE NAME:------------- TMG DEMOGRAPHICS IMPORT ERRORS
60 ;" F.) FILE ACCESS:
61 ;" B.) FILE NUMBER:----------- 22706 DD______ @
62 ;" Read____ @
63 ;" C.) NUM OF FLDS:----------- 9 Write___ @
64 ;" Delete__ @
65 ;" D.) DATA GLOBAL:----------- ^TMG(22706, Laygo___ @
66 ;"
67 ;" E.) TOTAL GLOBAL ENTRIES:-- 76 G.) PRINTING STATUS:-- Off
68 ;"================================================================================
69
70
71
72 ;"File: 22707 TMG NAME SEX Branch: 1
73 ;"REF NODE;PIECE FLD NUM FIELD NAME
74 ;"===============================================================================
75 ;" 1 0;1 .01 FIRST NAME [RF]
76 ;" 2 0;2 1 SEX [S]
77 ;"<> <> <>
78 ;" A.) FILE NAME:------------- TMG NAME SEX
79 ;" F.) FILE ACCESS:
80 ;" B.) FILE NUMBER:----------- 22707 DD______ @
81 ;" Read____ @
82 ;" C.) NUM OF FLDS:----------- 2 Write___ @
83 ;" Delete__ @
84 ;" D.) DATA GLOBAL:----------- ^TMG(22707, Laygo___ @
85 ;"
86 ;" E.) TOTAL GLOBAL ENTRIES:-- 698 G.) PRINTING STATUS:-- Off
87 ;"================================================================================
88
89
90
91 ;"File: 22711 TMG UPLOAD SETTINGS Branch: 1
92 ;"REF NODE;PIECE FLD NUM FIELD NAME
93 ;"===============================================================================
94 ;" 1 0;1 .01 NAME [RFX]
95 ;" 2 0;2 1 DEBUG SHOW [NJ1,0X]
96 ;" 3 1;1 1.1 DEBUG OUTPUT FILE [F]
97 ;" 4 2;1 1.15 DEBUG OUTPUT PATH [F]
98 ;" 5 1;2 1.2 DEBUG CUMULATIVE [NJ1,0]
99 ;" 6 3;1 2 IMPORT DATAFILE NAME [F]
100 ;" 7 5;1 2.1 IMPORT DATAFILE 2 NAME [F]
101 ;" 8 4;1 2.5 IMPORT DATAFILE PATH [F]
102 ;" 9 6;1 3 ALERT RECIPIENT <-Pntr [P200']
103 ;" 10 6;2 4 LAST IMPORT DATE [D]
104 ;" 11 6;3 5 DELETE DATAFILE AFTER IMPORT? [S]
105 ;" 12 6;4 6 PICK GENDER FROM NAME? [S]
106 ;" 13 6;5 7 IMPORT FREQUENCY (IN HOURS) [NJ4,0]
107 ;" <> <> <>
108 ;" A.) FILE NAME:------------- TMG UPLOAD SETTINGS
109 ;" F.) FILE ACCESS:
110 ;" B.) FILE NUMBER:----------- 22711 DD______ @
111 ;" Read____ @
112 ;" C.) NUM OF FLDS:----------- 12 Write___ @
113 ;" Delete__ @
114 ;" D.) DATA GLOBAL:----------- ^TMG(22711, Laygo___ @
115 ;"
116 ;" E.) TOTAL GLOBAL ENTRIES:-- 1 G.) PRINTING STATUS:-- Off
117 ;"================================================================================
118
119
120
121
122ASKIMPORT
123 ;"Purpose: To ask user for filename and then import data.
124 ;"Input: None
125 ;"Output: Database is updated with data from file.
126 ;"Result: None
127
128 new DiscardName
129 new DefPath set DefPath="/tmp/"
130 new DefFName set DefFName="demographics.csv"
131 new DefF2Name set DefF2Name="demographics2.csv"
132 new FPath,FName,F2Name
133 new ErrArray,ChLog
134 new result
135
136 new PrgsFn set PrgsFn="do ProgressBar^TMGUSRIF(TMGCUR,""Progress"",1,TMGMAX,,TMGSTART)"
137 set PrgsFn=PrgsFn_" read *TMGkeyin:0 set:(TMGkeyin=27) TMGABORT=1"
138
139 set DiscardName=$$GetFName^TMGIOUTL("Please enter file to import.",.DefPath,.DefFName,,.FPath,.FName)
140 if DiscardName="" goto AIDone
141
142 set DiscardName=$$GetFName^TMGIOUTL("Please enter 2nd file to import.",.DefPath,.DefF2Name,,.FPath,.F2Name)
143 if DiscardName="" goto AIDone
144
145 set result=$$IMPORTFILE(FPath,FName,F2Name,.ErrArray,.ChLog,PrgsFn)
146
147AIDone
148 quit
149
150
151RUNNOW
152 ;"Purpose: To provide an entry point for running import NOW. This will delete prior alerts
153 ;"Input: none. Settings stored in File 22711 are used
154 ;"Output: None. Progress shown to console. The database should be updated
155 ;"Results: none
156
157 write !!,"Import Sequel Demographics Now...",!
158
159 new FName,F2Name,FPath
160 new result
161 new ErrArray,ChLog
162 new DelFiles
163 new UserID
164
165 set FName=$$GET1^DIQ(22711,"1,","IMPORT DATAFILE NAME")
166 set F2Name=$$GET1^DIQ(22711,"1,","IMPORT DATAFILE 2 NAME")
167 set FPath=$$GET1^DIQ(22711,"1,","IMPORT DATAFILE PATH")
168 set DelFiles=+$$GET1^DIQ(22711,"1,","DELETE DATAFILE AFTER IMPORT?","I")
169 set UserID=$$GET1^DIQ(22711,"1,","ALERT RECIPIENT","I")
170
171 new PrgsFn set PrgsFn="do ProgressBar^TMGUSRIF(TMGCUR,""Progress"",1,TMGMAX,,TMGSTART)"
172 set PrgsFn=PrgsFn_" read *TMGkeyin:0 set:(TMGkeyin=27) TMGABORT=1"
173
174 set result=$$IMPORTFILE(FPath,FName,F2Name,,,PrgsFn,,DelFiles,UserID)
175
176 quit
177
178
179AUTOIN
180 ;"Purpose: To provide an entry point for a scheduled task. This will delete prior alerts
181 ;"Input: none. Settings stored in File 22711 are used
182 ;"Output: None. There should be no console output. The database should be updated
183 ;"Results: none
184
185 new InitTime set InitTime=$H
186
187 new UserID set UserID=$$GET1^DIQ(22711,"1,","ALERT RECIPIENT","I")
188
189 do ;"clear out 'next run task number'
190 . new TMGFDA,TMGMSG
191 . set TMGFDA(22711,"1,",8)="@" ;"#4 = TASK FOR NEXT RUN
192 . do FILE^DIE("E","TMGFDA","TMGMSG") ;" note: ignores TMGMSG or errors.
193
194 new temp set temp=$$QuietClear^TMGSEQL3(UserID) ;"clear prior alerts & errors
195 do QUIETIN ;" do import
196
197 ;"Here I schedule the next task to run again.
198 new HrInterval set HrInterval=$$GET1^DIQ(22711,"1,","IMPORT FREQUENCY (IN HOURS)","I")
199 if +HrInterval>0 do
200 . new time set time=$$HADD^XLFDT(InitTime,0,HrInterval,0)
201 . new task set task=$$Schedule^TMGSEQL3(time,"AUTOIN^TMGSEQL1","Import of demographic data from Sequel billing system.")
202 . ;"store 'next run task number'
203 . set TMGFDA(22711,"1,",8)="`"_task ;"#4 = TASK FOR NEXT RUN
204 . do FILE^DIE("E","TMGFDA","TMGMSG") ;" note: ignores TMGMSG or errors.
205
206 quit
207
208
209QUIETIN
210 ;"Purpose: To import data based on settings, with no user interaction (in or out)
211 ;"Input: none. Settings stored in File 22711 are used
212 ;"Output: None. There should be no console output. The database should be updated
213 ;"Results: none
214
215 new FName,F2Name,FPath
216 new result
217 new ErrArray,ChLog
218 new DelFiles
219 new UserID
220
221 set FName=$$GET1^DIQ(22711,"1,","IMPORT DATAFILE NAME")
222 set F2Name=$$GET1^DIQ(22711,"1,","IMPORT DATAFILE 2 NAME")
223 set FPath=$$GET1^DIQ(22711,"1,","IMPORT DATAFILE PATH")
224 set DelFiles=+$$GET1^DIQ(22711,"1,","DELETE DATAFILE AFTER IMPORT?","I")
225 set UserID=$$GET1^DIQ(22711,"1,","ALERT RECIPIENT","I")
226
227 set result=$$IMPORTFILE(FPath,FName,F2Name,,,,,DelFiles,UserID)
228
229 quit
230
231
232IMPORTFILE(FilePath,FileName,F2Name,ErrArray,ChgLog,PrgCallback,F2Path,DelFiles,UserID)
233 ;"Purpose: To import data from file specified.
234 ;"Input: FilePath: Path of file to input.
235 ;" FileName: The Name of file of file to input.
236 ;" Note: This is written to import a specific file
237 ;" created by SequelMed Systems, filled with
238 ;" patient demographics, in CVS format
239 ;" Note: This file will be DELETED if DelFiles=1
240 ;" F2Name : the name of the second demographics file in input
241 ;" The reason for 2 files is because Sequel doesn't report the SSN in the
242 ;" primary demographics report. So a second report must be used, and these
243 ;" two files are merged to provide complete patient demographics.
244 ;" Note: This file will be DELETED if DelFiles=1
245 ;" ErrArray: PASS BY REFERENCE. Array to receive failed data lines.
246 ;" ChgLog: PASS BY REFERENCE. An array to receive record of changes made to database
247 ;" PrgCallback: OPTIONAL -- if supplied, then M code contained in this string
248 ;" will be xecuted periodically, to allow display of a progress bar etc.
249 ;" Note: the following variables with global scope will be declared and
250 ;" available for use: TMGCUR (current count), TMGMAX (max count),
251 ;" TMGSTART (the start time
252 ;" External function can signal a request an abort by setting TMGABORT=1
253 ;" F2Path: OPTIONAL -- path of 2nd demographics file. Default=FilePath
254 ;" DelFiles: OPTIONAL -- if 1, then source files (FileName and F2Name) are deleted after import
255 ;" UserID : OPTIONAL -- user to receive alerts regarding errors. Default is current user (DUZ)
256 ;"Note: I have learned that SequelMed billing system exports ALL patients in the primary
257 ;" export file, including one that have been marked inactive do to invalid data etc.
258 ;" Thus, while the second file (F2Name) has limited info, it contains the list of
259 ;" ACTIVE patients. So if a name is not included in the 2nd file, then its info will
260 ;" be ignored in the 1st file.
261 ;"Output: Database is updated with data from file.
262 ;"Result: 1 successful completion, 0=error
263
264 new GRef,GRef1
265 new G2Ref,G2Ref1
266 new result
267
268 set F2Path=$get(F2Path,FilePath)
269
270 set GRef=$name(^TMP("TMG","SEQUELIMPORT","DATA",1,$J)) ;"I use this to process array
271 set GRef1=$name(@GRef@(1)) ;"I use this to load file
272 kill @GRef
273 set result=$$FTG^%ZISH(FilePath,FileName,GRef1,6) ;"load file into a global
274 if result=0 goto IFDONE
275
276 set G2Ref=$name(^TMP("TMG","SEQUELIMPORT","DATA",2,$J)) ;"I use this to process array
277 set G2Ref1=$name(@G2Ref@(1)) ;"I use this to load file
278 kill @G2Ref
279 set result=$$FTG^%ZISH(F2Path,F2Name,G2Ref1,6) ;"load file into a global
280 if result=0 goto IFDONE
281
282 set UserID=$get(UserID,+$get(DUZ))
283
284 set result=$$IMPORTGLOBAL(GRef,G2Ref,.ErrArray,.ChLog,.PrgCallback,UserID)
285
286 ;"Note: @GRef, @G2Ref killed at end of $$IMPORTGLOBAL()
287
288 do ;"record the current time as the time of last import
289 . do NOW^%DTC
290 . new TMGFDA,TMGMSG
291 . set TMGFDA(22711,"1,",4)=% ;"#4 = LAST IMPORT DATE
292 . do FILE^DIE("E","TMGFDA","TMGMSG") ;" note: ignores TMGMSG or errors.
293
294 if $get(DelFiles)=1 do
295 . ;"Notice: After I implemented this, I realized that I have a permissions problem
296 . ;" at my site... the uploaded files belong to the uploaded user, and deletion by
297 . ;" this user is being blocked. I'll leave in for now...
298 . new temp
299 . set temp=$$DelFile^TMGIOUTL(FilePath_FileName)
300 . set temp=$$DelFile^TMGIOUTL(F2Path_F2Name)
301
302IFDONE
303 quit result
304
305IMPORTGLOBAL(GRef,G2Ref,ErrArray,ChLog,PrgCallback,UserID)
306 ;"Purpose: To import data from global specified.
307 ;"Input: GRef -- the NAME of array holding the data to import (1st file)
308 ;" Format: @GRef@(1)=OneLine
309 ;" @GRef@(2)=OneLine .. etc.
310 ;" Note: This is written to import a specific file
311 ;" created by SequelMed Systems, filled with
312 ;" patient demographics, in CVS format
313 ;" Note: Array will be KILLED at the end of this function.
314 ;" G2Ref -- the NAME of array holding the data to import (2nd file)
315 ;" Note: Array will be KILLED at the end of this function.
316 ;" ErrArray: PASS BY REFERENCE. Array to receive failed data lines.
317 ;" ChgLog: PASS BY REFERENCE. An array to receive record of changes made to database
318 ;" PrgCallback: OPTIONAL -- if supplied, then M code contained in this string
319 ;" will be xecuted periodically, to allow display of a progress bar etc.
320 ;" Note: the following variables with global scope will be declared and
321 ;" available for use: TMGCUR (current count), TMGMAX (max count),
322 ;" TMGSTART (the start time
323 ;" External function can signal a request an abort by setting TMGABORT=1
324 ;" UserID : OPTIONAL -- user to receive alerts regarding errors. Default is current user (DUZ)
325 ;"Output: Database is updated with data from file.
326 ;"Result: 1 successful completion, 0=error
327
328 new TMGInvalid ;"Will be used as a globally-scoped variable in the module
329 new result set result=1
330 new delay set delay=0
331 new TMGCUR,TMGMAX,TMGSTART,TMGABORT ;"avail for PrgCallback function
332 set TMGABORT=0
333 set TMGMAX=+$order(@GRef@(""),-1)
334 set TMGSTART=$H ;"store starting time.
335 set UserID=$get(UserID,+$get(DUZ))
336
337 new SSNArray
338 do XtractSSNum(G2Ref,.SSNArray)
339
340 set TMGCUR=$order(@GRef@(""))
341 if TMGCUR'="" for do quit:(TMGCUR="")!(TMGABORT=1)
342 . new OneLine
343 . set OneLine=$get(@GRef@(TMGCUR))
344 . set result=$$ProcessPt(OneLine,.ErrArray,.ChgLog,.SSNArray,UserID)
345 . set delay=delay+1
346 . if (delay>30),$get(PrgCallback)'="" do ;"update progress bar every 30 cycles
347 . . new $etrap set $etrap="write ""(Invalid M Code!. Error Trapped.)"" set $etrap="""",$ecode="""""
348 . . xecute PrgCallback ;"call the specified progress code.
349 . . set delay=0
350 . set TMGCUR=$order(@GRef@(TMGCUR))
351
352 kill @GRef
353 kill @G2Ref
354 quit result
355
356
357
358ProcessPt(OneLine,ErrArray,ChgLog,SSNArray,DUZ,InputFn)
359 ;"Purpose: To process one line from patient demographics file.
360 ;"Input: OneLine-- One line from CVS demographics file.
361 ;" Format is as follows, *** all on one line (comma delimited)
362 ;" 01- patient_seq_num,
363 ;" 02- facility_short_name,
364 ;" 03- pat_last_name,
365 ;" 04- pat_first_name,
366 ;" 05- pat_account_num,
367 ;" 06- pat_address,
368 ;" 07- state,
369 ;" 08- resp_last_name,
370 ;" 09- resp_first_name,
371 ;" 10- facility_seq_num,
372 ;" 11- register_date,
373 ;" 12- location_name,
374 ;" 13- city,
375 ;" 14- provider_short_name,
376 ;" 15- zipcode,
377 ;" 16- class_name,
378 ;" 17- pat_dob,
379 ;" 18- ref_prov_short_name,
380 ;" 19- pat_tel_num,
381 ;" 20- last_visit_days,
382 ;" 21- name,
383 ;" 22- description
384 ;" ADDENDUM:
385 ;" sometimes SEX will be appended to line. Format:
386 ;" previous data^MALE or previous data^FEMALE
387 ;" sometimes SSN will be appended to line. Format:
388 ;" previous data^(sex)^SSNUM
389 ;" ErrArray: PASS BY REFERENCE. Array to receive failed data lines.
390 ;" ChgLog: PASS BY REFERENCE. An array to receive record of changes made to database
391 ;" SSNArray: OPTIONAL -- PASS BY REFERENCE. An array with social security numbers,
392 ;" as created by XtractSSNum()
393 ;" DUZ: The user who will recieve alerts of errors
394 ;" InputFn: OPTIONAL-- the name of a function to turn parse on csv line
395 ;" default value is "ParseLine"
396 ;" e.g. "MyFn" or "MyFn^MyRoutine". Must take same params as ParseLine
397 ;" This will allow this code to be used on a variety of .csv files, with
398 ;" different data-formats--each one with its own parser funtion.
399 ;"Output: Data is put into database, if it is not there already.
400 ;"Result: 1=OK To continue; 0=abort or bad data
401
402 new XFn
403 new PtInfo,OneErrArray
404 new result set result=1
405 new AutoRegister set AutoRegister=1
406 set InputFn=$get(InputFn,"ParseLine")
407
408 set XFn="set result=$$"_InputFn_"(.OneLine,.PtInfo,.SSNArray)"
409 xecute XFn ;"old -- set result=$$ParseLine(.OneLine,.PtInfo,.SSNArray)
410 if result'>0 goto PPtDone
411 if $get(PtInfo("FACILITY"))="SAMPLE" goto PPtDone
412
413 if $$UpdateDB(.PtInfo,AutoRegister,.OneErrArray,.ChgLog)=0 do
414 . new count set count=+$get(ErrArray)+1
415 . set ErrArray=count
416 . set ErrArray(count)=OneLine
417 . merge ErrArray(count,"INFO")=OneErrArray
418 . ;"------
419 . do AlertError^TMGSEQL2(OneLine,.PtInfo,.OneErrArray,DUZ)
420
421PPtDone
422 quit result
423
424
425ParseLine(OneLine,Array,SSNArray)
426 ;"Purpose: To process one line from patient demographics file.
427 ;" Also gets data into an acceptible format.
428 ;"Input: OneLine -- One line from CVS demographics file. (Format as per ProcessPt)
429 ;" NOTE: if PASSED BY REFERENCE, then line may be altered such that SSN is
430 ;" added as a 3rd piece, using ^ as a delimiter. (2nd piece used elsewhere
431 ;" to store sex.
432 ;" When processing line, if SSNArray doesn't provide a SSN for patient, then
433 ;" this 3rd piece can provide the SSN
434 ;" Array -- PASS BY REFERENCE. And OUT parameter. Any prior data killed.
435 ;" Note: uses TMGInvalid (globally scoped var defined in this module)
436 ;" SSNArray: OPTIONAL -- PASS BY REFERENCE. An array with social security numbers,
437 ;" as created by XtractSSNum()
438 ;"Output: Array is filled with Format as follows (note not all data used):
439 ;" Array("FACILITY"), to hold 02- facility_short_name
440 ;" Array("LAST NAME"), to hold 03- pat_last_name,
441 ;" Array("FIRST NAME"), to hold 04- pat_first_name,
442 ;" Array("PMS ACCOUNT NUM"), to hold 05- pat_account_num,
443 ;" Array("ADDRESS1"), to hold 06- pat_address,
444 ;" Array("ADDRESS2"), to hold 06- pat_address,
445 ;" Array("ADDRESS3"), to hold 06- pat_address,
446 ;" Array("STATE"), to hold 07- state,
447 ;" Array("RESP LAST NAME"), to hold 08- resp_last_name,
448 ;" Array("RESP FIRST NAME"), to hold 09- resp_first_name,
449 ;" Array("CITY"), to hold 13- city,
450 ;" Array("PROVIDER"), to hold 14- provider_short_name,
451 ;" Array("ZIP CODE"), to hold 15- zipcode,
452 ;" Array("DOB"), to hold 17- pat_dob,
453 ;" Array("PHONE NUM"), to hold 19- pat_tel_num,
454 ;" Array("SEX"), to hold Patient sex, if provided.
455 ;" Array("SSNUM")=Social security number
456 ;" Array("FULL NAME")=FIRSTNAME LASTNAME (DOB)
457 ;" Array("FULL NAME2")=LASTNAME,FIRSTNAME (DOB)
458 ;" Array("FULL NAME3")=LASTNAME,FIRSTNAME
459 ;"Result: 1=OK To continue; 0=abort or bad data; -1 skip, but don't store as error
460
461 new temp
462 new result set result=1
463
464 set OneLine=$translate($get(OneLine),"""","'") ;" convert " to ' to avoid fileman error
465
466 kill Array
467 set Array("FACILITY")=$piece(OneLine,",",2)
468 set Array("LAST NAME")=$$Trim^TMGSTUTL($piece(OneLine,",",3))
469 set Array("FIRST NAME")=$$Trim^TMGSTUTL($piece(OneLine,",",4))
470 set Array("PMS ACCOUNT NUM")=$piece(OneLine,",",5)
471 set Array("ADDRESS1")=$piece(OneLine,",",6)
472 set Array("STATE")=$piece(OneLine,",",7)
473 set Array("RESP LAST NAME")=$piece(OneLine,",",8)
474 set Array("RESP FIRST NAME")=$piece(OneLine,",",9)
475 set Array("CITY")=$$Trim^TMGSTUTL($piece(OneLine,",",13),"""")
476 set Array("PROVIDER")=$piece(OneLine,",",14)
477 set Array("ZIP CODE")=$piece(OneLine,",",15)
478 new DOB set DOB=$piece(OneLine,",",17)
479 set DOB=$$Trim^TMGSTUTL(DOB)
480 set DOB=$piece(DOB," ",1) ;" '03/09/05 00:00' --> '03/09/05'
481 set Array("DOB")=DOB
482 set Array("PHONE NUM")=$piece(OneLine,",",19)
483 set Array("SEX")=$piece(OneLine,"^",2)
484
485 set Array("FULL NAME")=Array("FIRST NAME")_" "_Array("LAST NAME")_" ("_Array("DOB")_")"
486 set Array("FULL NAME2")=Array("LAST NAME")_","_Array("FIRST NAME")_" ("_Array("DOB")_")"
487 set Array("FULL NAME3")=Array("LAST NAME")_","_Array("FIRST NAME")
488
489 ;"do a lookup on abreviattion for ALL states, convert to external format
490 new DIC,X,Y
491 set DIC=5 ;"STATE file
492 set DIC(0)="M"
493 set X=Array("STATE")
494 do ^DIC
495 set Array("STATE")=$piece(Y,"^",2)
496
497 ;"convert Sequel format to VistA format
498 if Array("PROVIDER")'="" do
499 . set Array("PROVIDER")=$$ConvProvider(Array("PROVIDER"))
500 if Array("PROVIDER")="SKIP" set result=0 goto PLDone
501
502 ;" VistA address allows for:
503 ;" .111 -- address line 1
504 ;" .112 -- address line 2
505 ;" .113 -- address line 3
506 ;" BUT, each line must be 3-35 characters
507 ;" Sequel puts this all on one line.
508 ;" SO, I need to divide the Sequel line if not 3-35
509 new value set value=Array("ADDRESS1")
510 if $length(value)'<35 do
511 . new s1,s2
512 . do NiceSplit^TMGSTUTL(value,35,.s1,.s2,3)
513 . set Array("ADDRESS1")=s1
514 . if $length(s2)'<35 do
515 . . do NiceSplit^TMGSTUTL(s1,35,.s1,.s2,3)
516 . . set Array("ADDRESS2")=s1 ;"<-- is this correct?
517 . . if s2'="" set Array("ADDRESS3")=$extract(s2,1,35)
518 . else set Array("ADDRESS2")=s2
519
520 ;"Ensure proper length of city.
521 set Array("CITY")=$extract(Array("CITY"),1,15)
522 if $length(Array("CITY"))=1 set Array("CITY")=Array("CITY")_" "
523
524 ;"Ensure proper length of phone
525 if $length(Array("PHONE NUM"))<7 kill Array("PHONE NUM")
526
527 new AcctNum set AcctNum=$get(Array("PMS ACCOUNT NUM"))
528 new SSNum set SSNum=$get(SSNArray(AcctNum))
529 if SSNum=999999999 set SSNum=0
530 if +SSNum=0 do ;"see if 3rd ^ piece holds SSNum data
531 . set SSNum=$piece(OneLine,"^",3) ;"note this won't overwrite valid data from SSNArray()
532 if SSNum>0 do
533 . set Array("SSNUM")=SSNum
534 . set $piece(OneLine,"^",3)=SSNum
535
536 if result'=0 do
537 . if $$InvalPtName(Array("FIRST NAME"),Array("LAST NAME"))=1 set result=-1 quit
538 . if $$InactivePt(Array("PMS ACCOUNT NUM"),.SSNArray)=1 do
539xx . . set result=-1
540 . . ;"write !,"Skipping: ",Array("FULL NAME3"),! ;"temp
541
542PLDone
543 quit result
544
545
546ConvProvider(SequelProvider)
547 ;"Purpose: To convert Sequel provider shortname to VistA file 200 name.
548 ;"Input: SequelProvider
549 ;"Result: VistA provider name (string), or "" if not found, or "SKIP" if not to be used
550
551 new result set result=""
552
553 if $$InvalidProvider(SequelProvider) set result="SKIP" goto ConPrDone
554 if SequelProvider="SAMPLE" set result="SKIP" goto ConPrDone
555
556
557 new TMGARRAY,TMGMSG
558 do FIND^DIC(200,,".01",,SequelProvider,"*","TMG",,,"TMGARRAY","TMGMSG")
559 if +TMGARRAY("DILIST",0)>0 do
560 . set result=TMGARRAY("DILIST",1,1)
561 else do
562 . new DIC
563 . set DIC=200
564 . ;"try converting name and doing quiet lookup (KTOPPEN->TOPPEN,K)
565 . set X=$extract(SequelProvider,2,99)_","_$extract(SequelProvider,1)
566 . do ^DIC
567 . if (+Y=-1)&(1=0) do ;"<--- FEATURE TURNED OFF. If not found, don't ask (no longer needed)
568 . . if $data(TMGInvalid(SequelProvider))'=0 quit
569 . . write !,"Please help match the Sequel 'shortname' to a VistA provider name.",!
570 . . write "This should have to be done only once.",!
571 . . write "Enter ^ if the provider name is not valid.",!
572 . . write "Please enter VistA provider name for: '",SequelProvider,"'",!
573 . . set DIC(0)="AEQM"
574 . . do ^DIC
575 . . write !
576 . if +Y>-1 do
577 . . new DFN set DFN=+Y
578 . . new TMGFDA set TMGFDA(200,DFN_",",22702)=SequelProvider
579 . . kill TMGMSG
580 . . do FILE^DIE(,"TMGFDA","TMGMSG") ;"ignore errors
581 . . set result=$piece(Y,"^",2)
582 . else do
583 . . set TMGInvalid(SequelProvider)=""
584ConPrDone
585 quit result
586
587
588InvalPtName(FName,LName)
589 ;"Purpose: To determine if the Patient name is invalid (i.e. CAP TOPPENBERG, or INSURANCE INSURANCE etc.)
590 ;"Input: FName,LName -- the first and last names
591 ;"Result: 1 if name is invalid, 0 if OK name
592
593 new result set result=0
594
595 if FName="CAP" do ;"screen out 'CAP TOPPENBERG' etc ?? entries ??
596 . new DIC set DIC=200
597 . set DIC(0)="M"
598 . set X=LName
599 . do ^DIC
600 . if +Y>0 set result=1
601
602 if (FName="INSURANCE")&(LName="INSURANCE") set result=1
603
604 quit result
605
606
607InactivePt(PMSAcctNum,SSNArray)
608 ;"Purpose: to determine if patient is inactive, and should be skipped.
609 ;" This is determined by testing for existence of AccountNumber in SSNArray.
610 ;" SSNArray is created from the 2nd demographics file. This is a list of ACTIVE patients,
611 ;" which is different from the 1st demographics file--which holds ALL patients.
612 ;"Input: PMSAcctNum -- as stored in PtInfo("PMS ACCOUNT NUM")
613 ;" SSNArray: PASS BY REFERENCE. An array with social security numbers, as created by XtractSSNum()
614 ;"Result: 1 if patient is INACTIVE, and should be skipped.
615 ;" 0 if OK to use
616
617 new result
618 set result=+$get(SSNArray(PMSAcctNum))'>0
619 quit result
620
621
622InvalidProvider(SequelProvider)
623 ;"Purpose: To return if provider should not be used (i.e. cause data to be skipped)
624 ;"Input: SequelProvider
625 ;"Result: 0: OK to use provider
626 ;" 1: Don't use provider
627
628 new result set result=0
629
630 if SequelProvider="SAMPLE" set result=1
631 if SequelProvider="GREENEVILLE" set result=1
632 if SequelProvider="AFOSTER" set result=1
633 if SequelProvider="AFTON" set result=1
634 if SequelProvider="JWRIGHT" set result=1 ;"not an active provider
635 ;"These providers are leaving group, so don't import their data.
636 if SequelProvider="CPERRY" set result=1
637 if SequelProvider="OSWARNER" set result=1
638 if SequelProvider="SGILES" set result=1
639 if SequelProvider="SPENNY" set result=1
640 if SequelProvider="TFULLER" set result=1
641
642 quit result
643
644
645UpdateDB(PtInfo,AutoRegister,ErrArray,ChgLog)
646 ;"Purpose: To put that data from the PtInfo array into the database (if needed)
647 ;"Input: PtInfo -- array (PASS BY REFERENCE), with the following items being used:
648 ;" PtInfo("LAST NAME"), to hold 03- pat_last_name,
649 ;" PtInfo("FIRST NAME"), to hold 04- pat_first_name,
650 ;" PtInfo("PMS ACCOUNT NUM") ----> field 22701 (custom field)
651 ;" PtInfo("ADDRESS") ----> field .111
652 ;" PtInfo("STATE") ----> field .115
653 ;" PtInfo("CITY") ----> field .114
654 ;" PtInfo("ZIP CODE") ----> field .1112
655 ;" PtInfo("PHONE NUM") ----> field .131
656 ;" PtInfo("PROVIDER") ----> field .1041
657 ;" PtInfo("SSNUM") ----> field .09
658 ;" AutoRegister: if 1, then patient will be automatically added/registered
659 ;" ErrArray -- PASS BY REFERENCE. And OUT parameter to get back error info.
660 ;" ChgLog: PASS BY REFERENCE. An array to receive record of changes made to database
661 ;"Output: Data is put into database, if it is not there already.
662 ;"Result: 1 successful completion, 0=error
663
664 new Entry
665 new result set result=1
666 new Name,TMGDOB,DFN
667 new TMGARRAY,TMGMSG
668 new PriorErrorFound
669 new NewInfo
670 new IENS
671 new index
672 kill ErrArray
673 new TMGDEBUG set TMGDEBUG=-1 ;"//EXTRA QUIET mode --> shut down TMGDBAPI messages
674
675
676 ;"NOTE: I need to have some method such that IF a patient is positively matched
677 ;" (i.e. via SSNUM or PMS Account number), THEN changes in spelling of name, or
678 ;" DOB on Sequel side should be reflected in VistA. Currently, I don't this
679 ;" this happens.
680
681 new Fields
682 set Fields(22701)="PMS ACCOUNT NUM"
683 set Fields(.111)="ADDRESS1"
684 set Fields(.112)="ADDRESS2"
685 set Fields(.113)="ADDRESS3"
686 set Fields(.115)="STATE"
687 set Fields(.114)="CITY"
688 set Fields(.1112)="ZIP CODE"
689 set Fields(.131)="PHONE NUM"
690 set Fields(.1041)="PROVIDER"
691 set Fields(.02)="SEX"
692 set Fields(.09)="SSNUM"
693 set Fields="22701;.111;.112;.113;.115;.114;.1112;.131;.1041;.09"
694
695 set Name=$get(PtInfo("LAST NAME"))_","_$get(PtInfo("FIRST NAME"))
696 set Name=$$FormatName^TMGMISC(Name)
697 set TMGDOB=$get(PtInfo("DOB"))
698
699 set Entry(.01)=Name
700 set Entry(.03)=TMGDOB
701 if $get(PtInfo("SEX"))'="" set Entry(.02)=$get(PtInfo("SEX"))
702 set Entry(.09)=$get(PtInfo("SSNUM"))
703
704 set DFN=$$GetDFN(.PtInfo)
705
706 if (DFN=0)&($get(AutoRegister)=1) do
707 . set ErrArray=-1 ;"extra quiet mode.
708 . if $get(Entry(.02))="" do ;"autopick gender if missing
709 . . new AutoPick
710 . . set AutoPick=$$GET1^DIQ(22711,"1,","PICK GENDER FROM NAME?","I")
711 . . if AutoPick'=1 quit
712 . . set Entry(.02)=$$GetSex^TMGSEQL2($get(PtInfo("FIRST NAME")))
713 . ;"OK, can't find, so will add new patient.
714 . set DFN=+$$AddNewPt^TMGGDFN(.Entry,.ErrArray)
715 . if DFN'=0 set ChLog(Name_" "_TMGDOB,0)="ADDED PATIENT: "_Name_" "_TMGDOB
716 if DFN=0 do goto UDBDone ;"failure
717 . set result=0
718 . set ErrArray(0)=$$NameError^TMGSEQL2(.ErrArray) ;"get name if DIERR encountered.
719 . if ErrArray(0)["DOB" do
720 . . ;"write !,"DOB error found for: ",PtInfo("FULL NAME"),!
721 . if ErrArray(0)="" do
722 . . set ErrArray(0)="PATIENT NOT IN DATABASE:" ;"if changed, also change in TMGSEQL2.m
723 set IENS=DFN_","
724
725 ;"use DFN(IEN in file 2) to get data into database
726 do GETS^DIQ(2,IENS,Fields,"","TMGARRAY","TMGMSG")
727
728 ;"check for errors.
729 if $data(TMGMSG("DIERR"))'=0 do goto UDBDone
730 . set result=0
731 . merge ErrArray=TMGMSG("DIERR")
732 . ;"do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
733 kill TMGMSG
734
735 ;"If any data in data base differs from Array, setup NewInfo
736 new UpdateNeeded set UpdateNeeded=0
737 new abort set abort=0
738 set index=$order(Fields(""))
739 for do quit:(+index'>0)!(abort=1)
740 . new field set field=Fields(index)
741 . if $data(PtInfo(field)),$get(TMGARRAY(2,IENS,index))'=$get(PtInfo(field)) do
742 . . new value set value=$get(PtInfo(field))
743 . . if index=.1112 do
744 . . . if +value'=0 set NewInfo(index)=value
745 . . else if (index=.09)&(+value'=0)&(+TMGARRAY(2,IENS,index)'=0) do
746 . . . if TMGARRAY(2,IENS,index)["P" do quit
747 . . . . set NewInfo(index)=value
748 . . . ;"we have CONFLICTING SOCIAL SECURITY NUMBERS --> PROBLEM...
749 . . . set ErrArray(0)="CONFLICTING SS-NUMBERS: " ;"NOTE! if error message format is changed, also change in TMGSEQL2
750 . . . set ErrArray(0)=ErrArray(0)_"Sequel#="_PtInfo(field)_" vs. VistA#="_TMGARRAY(2,IENS,index)
751 . . . set abort=1,result=0
752 . . else set NewInfo(index)=value
753 . . set UpdateNeeded=1
754 . set index=$order(Fields(index))
755
756 if (UpdateNeeded=0)!(abort=1) goto UDBDone
757
758 ;"Setup FDA array for database update
759 new TMGFDA
760 set index=$order(NewInfo(""))
761 if index'="" do
762 . for do quit:(+index'>0)
763 . . set TMGFDA(2,IENS,index)=NewInfo(index)
764 . . set index=$order(NewInfo(index))
765 . ;
766 . do FILE^DIE("E","TMGFDA","TMGMSG")
767 . if $data(TMGMSG("DIERR"))'=0 do ;"goto UDBDone
768 . . set result=0
769 . . merge ErrArray=TMGMSG("DIERR")
770
771 merge ChLog($get(Name,"?")_" "_$get(TMGDOB,"?"),1)=NewInfo
772
773UDBDone
774 quit result
775
776
777GetDFN(PtInfo)
778 ;"Purpose: Serve as interface to ^TMGGDFN functions (using PtInfo as input)
779 ;"Input: PtInfo, Array of PtInfo, as defined in UpdateDB, and created by ParseLine
780 ;"Result: the IEN in file 2 (i.e. DFN) if found, otherwise 0 if not found.
781
782 new Entry,Name,DOB,DFN
783
784 set Name=$get(PtInfo("LAST NAME"))_","_$get(PtInfo("FIRST NAME"))
785 set Name=$$FormatName^TMGMISC(Name)
786 set DOB=$get(PtInfo("DOB"))
787
788 set Entry(.01)=Name
789 set Entry(.03)=DOB
790 set Entry(.02)=$get(PtInfo("SEX"))
791 set Entry(.09)=$get(PtInfo("SSNUM"))
792 set DFN=+$$LookupPatient^TMGGDFN(.Entry) ;"get IEN in file 2 of patient
793 ;"do an extended search with increasing intensity.
794 if +DFN=0 set DFN=$$ExtraLookup^TMGGDFN(.Entry,1)
795 if +DFN=0 set DFN=$$ExtraLookup^TMGGDFN(.Entry,2)
796 if +DFN=0 set DFN=$$ExtraLookup^TMGGDFN(.Entry,3)
797
798 quit DFN
799
800
801
802XtractSSNum(G2Ref,SSNArray)
803 ;"Purpose: To extract info from 2nd demographics file into an array of SSNums.
804 ;"Input: G2Ref - Name of global array holding 2nd demographics file
805 ;" Note: Format of each line is as follows:
806 ;" scratchNum,AccountNumber,LastName,FirstName,SSNUM ... (other data is redundant)
807 ;" i.e. SSNUM is the 5th piece
808 ;" SSNArray -- PASS BY REFERENCE. An OUT parameter. See format below
809 ;"Output: SSNArray will be filled as follows:
810 ;" SSNArray(SequelAccountNumber)=SSNum
811 ;"Result: None
812 ;"Note: 3/2/06 modification:
813 ;" An entry for every SequelAccountNumber will be created. If SSNum is invalid, it will
814 ;" be converted to 0, but an entry will still be created, i.e.
815 ;" SSNArray(SequelAccountNumber)=0
816
817
818 new i
819
820 set i=$order(@G2Ref@(""))
821 if i'="" for do quit:(i="")
822 . new OneLine,AcctNum,SSNum
823 . set OneLine=$get(@G2Ref@(i))
824 . set AcctNum=$piece(OneLine,",",2)
825 . set SSNum=$$Trim^TMGSTUTL($piece(OneLine,",",5))
826 . new value set value=0 ;"default value
827 . if +SSNum'<999999 do ;"force at least 6 digits --> allow 0000 11 1111
828 . . if $length(SSNum)'=9 do
829 . . . set SSNArray("ERRORS",AcctNum)=SSNum ;"leaves value="" --> not used
830 . . else do
831 . . . ;"set SSNArray(AcctNum)=SSNum
832 . . . set value=SSNum
833 . set SSNArray(AcctNum)=value
834 . set i=$order(@G2Ref@(i))
835
836 quit
837
838
Note: See TracBrowser for help on using the repository browser.