source: cprs/branches/tmg-cprs/m_files/TMGSEQL1B.m@ 1531

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

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