source: cprs/branches/tmg-cprs/m_files/TMGSEQL2.m

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

Initial upload
File size: 26.9 KB
Line 
1TMGSEQL2 ;TMG/kst/Interface with SequelSystems PMS (Error Hndlng) ;03/25/06
2 ;;1.0;TMG-LIB;**1**;01/09/06
3
4 ;"TMG SEQUEL IMPORT ERROR-HANDLING 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 ;"AlertError(OneLine,.PtInfo,.OneErrArray,DUZ)
14 ;"HANDLE
15
16
17 ;"=======================================================================
18 ;"PRIVATE API FUNCTIONS
19 ;"=======================================================================
20 ;"EditOneLine(LineIn,LineOut)
21 ;"MakeErrAlert(IEN,User,PtInfo)
22 ;"$$StoreError(OneLine,PtInfo,ErrArray)
23 ;"ErrRefile(OneLine,PtInfo,OneErrArray,DUZ)
24
25 ;"$$FixRegProblem(PtInfo,OneLine,DelError)
26 ;"$$FixGenProblem(PtInfo,ErrMsg,OneLine,ErrIEN,DelError)
27 ;"$$FixSSNProblem(PtInfo,ErrMsg,OneLine,DelError)
28 ;"$$FixDOBProblem(.PtInfo,ErrMsg,.OneLine,.DelError)
29
30 ;"$$GetSex(Name)
31 ;"$$SetSex(Name,Sex)
32 ;"$$NameError(OneErrArray)
33
34 ;"$$IsMissingSex(ErrArray)
35 ;"$$GetSexMissing(PtInfo)
36
37 ;"=======================================================================
38 ;"DEPENDENCIES
39 ;"TMGSEQL1
40 ;"TMGSTUTL
41 ;"TMGDEBUG
42 ;"=======================================================================
43 ;"=======================================================================
44
45
46EditOneLine(LineIn,LineOut)
47 ;"Purpose: To allow modification of a line to allow filing.
48 ;"Input: LineIn -- The CSV line to modify.
49 ;" LineOut -- PASS BY REFERENCE, the variable to receive changes
50 ;"Result: 1 if changes made, 0 if no changes made, -1 if abort
51
52 new tempArray
53 new done set done=0
54 new abort set abort=0
55 set LineOut=$get(LineIn)
56 new SavedInput set SavedInput=LineIn
57 new result set result=0
58 new temp
59
60 if $get(LineIn)="" do goto EOLDone
61 . write !,"?? No data supplied to edit!",!
62
63 for do quit:(done)!(abort)
64 . write !,"CSV Line Editor:",!
65 . write "------------------",!
66 . write "1. Show raw CSV line data.",!
67 . write "2. Show resulting parsed array from data.",!
68 . write "3. Modify a specified piece (part) of data.",!
69 . write "4. Display number of pieces, and current values.",!
70 . write "5. Quit.",!
71 . write "^. Abort changes.",!
72 . read !,"Enter Choice: ^// ",temp:$get(DTIME,3600),!
73 . if temp="" set temp="^"
74 . if temp=1 do
75 . . write OneLine,!
76 . else if temp=2 do
77 . . new Array,prsResult
78 . . set prsResult=$$ParseLine^TMGSEQL1(LineOut,.Array)
79 . . if prsResult'=0 do ArrayDump^TMGDEBUG("Array")
80 . . ;"else if prsResult=0 write "There was either a problem parsing this info",!
81 . . ;"else if prsResult-1 write "This patient is inactive, and should be ignored",!
82 . else if temp=3 do
83 . . new P,value
84 . . write "Which piece do you want to edit? (i.e. 1 for first CSV value, 2 for the second etc.)",!
85 . . read "Which piece?: ",P:$get(DTIME,3600),!
86 . . if P="^" set abort=1 quit
87 . . if +P=0 write "Please enter a numeric value.",! quit
88 . . write "The current value for this piece is: ",$piece(LineOut,",",P),!
89 . . read "Enter new value (^ to abort): ",value,!
90 . . if value="^" quit
91 . . set $piece(LineOut,",",P)=value
92 . . set result=1
93 . else if temp=4 do
94 . . new i for i=1:1:20 do
95 . . . write "Piece #",i," = ",$piece(LineOut,",",i),!
96 . else if temp=5 do
97 . . set done=1
98 . else if temp="^" do
99 . . set abort=1
100 . else do quit
101 . . write "Please enter a valid choice, or ^ to abort.",!
102
103
104EOLDone
105 if abort do
106 . set result=-1
107 . set LineOut=SavedInput
108
109 quit result
110
111
112AlertError(OneLine,PtInfo,OneErrArray,DUZ)
113 ;"Purpose: To put the error information info into TMG DEMOGRAPHICS IMPORT ERRORS (22706)
114 ;" and to create a corresponding alert
115 ;"Input: OneLine -- The original CVS format data line
116 ;" PtInfo -- PASS BY REFERENCE. an array containing patient info, as created by ParseLine()
117 ;" ErrArray -- PASS BY REFERENCE. The Array containing the error information,
118 ;" with following format:
119 ;" ErrArray(0)=local message (if any)
120 ;" ErrArray("DIERR")=Standard fileman DIERR array.
121 ;" User -- the IEN in file 200 (i.e. DUZ) of user to receive alert.
122 ;"Output: new record is created in file 22706
123 ;"Result: none
124
125 new IEN,Msg
126 set IEN=$$StoreError^TMGSEQL2(OneLine,.PtInfo,.OneErrArray)
127 set Msg=$get(OneErrArray(0),"Problem with upload of Sequel data for:")
128 set Msg=$piece(Msg,":",1)
129 set Msg=Msg_" "_$get(PtInfo("FULL NAME"))
130 do MakeErrAlert^TMGSEQL2(IEN,DUZ,Msg)
131
132 quit
133
134
135StoreError(OneLine,PtInfo,ErrArray)
136 ;"Purpose: To put the error information info into TMG DEMOGRAPHICS IMPORT ERRORS (22706)
137 ;"Input: OneLine -- The original CVS format data line
138 ;" PtInfo -- PASS BY REFERENCE. an array containing patient info, as created by ParseLine()
139 ;" ErrArray -- PASS BY REFERENCE. The Array containing the error information,
140 ;" with following format:
141 ;" ErrArray(0)=local message (if any)
142 ;" ErrArray("DIERR")=Standard fileman DIERR array.
143 ;"Output: new record is created in file 22706
144 ;"Result: IEN of newly created record (or 0 if error).
145
146 new result set result=0
147 new TMGFDA,Name
148 set Name=$get(PtInfo("FULL NAME3"))
149 set Msg=$get(ErrArray(0))
150
151 set TMGFDA(22706,"+1,",.01)=$get(PtInfo("SEQUEL ACCOUNT NUM")) ;".01=ACCOUNT NUMBER
152 set TMGFDA(22706,"+1,",.02)="NOW" ;".02=CREATION DATE
153 set TMGFDA(22706,"+1,",.03)=Name ;".03=PATIENT NAME
154 if Msg'="" set TMGFDA(22706,"+1,",1)=Msg ;"1=MESSAGE
155 new TMGIENA,TMGERR
156 do UPDATE^DIE("E","TMGFDA","TMGIENA","TMGERR")
157 new IEN set IEN=$get(TMGIENA(1))
158
159 new TMGWP
160 new TMGDIERR merge TMGDIERR("DIERR")=ErrArray("DIERR")
161 new ErrStr set ErrStr=$$GetErrStr^TMGDEBUG(.TMGDIERR)
162 if ErrStr'="" do
163 . do StrToWP^TMGSTUTL(ErrStr,"TMGWP",60," ")
164 . if +IEN>0 do
165 . . do WP^DIE(22706,IEN_",",3,,"TMGWP","TMGERR") ;"3=DIERR MESSAGE
166 . . new PriorErrorFound set PriorErrorFound=0
167 . . if $data(TMGERR("DIERR")) do ShowDIERR^TMGDEBUG(.TMGERR,.PriorErrorFound)
168
169 kill TMGWP
170 do StrToWP^TMGSTUTL(OneLine,"TMGWP",60,",")
171 if +IEN>0 do
172 . do WP^DIE(22706,IEN_",",2,,"TMGWP","TMGERR") ;"2=IMPORT DATA
173 . new PriorErrorFound set PriorErrorFound=0
174 . if $data(TMGERR("DIERR")) do ShowDIERR^TMGDEBUG(.TMGERR,.PriorErrorFound)
175
176 set result=IEN
177
178 quit result
179
180
181MakeErrAlert(IEN,User,Message)
182 ;"Purpose: To create an alert regarding upload error
183 ;"Input: IEN -- The IEN of the error, stored in file 22706
184 ;" User -- the IEN in file 200 (i.e. DUZ) of user to receive alert.
185 ;" Message -- the Message of the alert
186 ;"Output: An alert will be created in send to User
187 ;"Result: none
188
189 new XQA,XQAMSG,XQAID
190 new XQAOPT ;" ensure no residual menu option specified
191
192 set XQA(User)=""
193 set XQAMSG=Message
194 set XQAID="TMGSQLIMPORT"
195 set XQADATA=IEN
196 set XQAROU="HANDLE^TMGSEQL2"
197
198 do SETUP^XQALERT
199
200 quit
201
202ErrRefile(OneLine,PtInfo,OneErrArray,DUZ)
203 ;"Purpose: A common point to process errors encountering errors on refilling
204 ;"Input: OneLine -- the originial CSV data line.
205 ;" PtInfo -- PASS BY REFERENCE -- the Patient Info array, as created by ParseLine^TMGSEQL1
206 ;" OneErrArray -- PASS BY REFERENCE -- The error array encountered, returned from Fileman
207 ;" DUZ -- the user IEN (from file 2) to recieve alert
208 ;"Output: A new alert will be created, and messages written to screen
209 ;"Result : none
210
211 write "There is still an error:",!
212 zwr OneErrArray(*)
213 write "A new alert will be made to handle this new error.",!
214 set OneErrArray(0)=$$NameError(.OneErrArray)
215 write OneErrArray(0),!
216 do AlertError^TMGSEQL2(.OneLine,.PtInfo,.OneErrArray,DUZ)
217
218 quit
219
220HANDLE
221 ;"Purpose: This is called by the alert system to handle the error alert
222 ;"Input: All the inputs are via variables with global scope. Details below
223 ;" XQADATA-- the IEN in file 22706
224 ;" XQAKILL-- 1 --> kill when done. To alter behavior, this function can change
225 ;" (to prevent deletion when done, then KILL XQAKILL)
226 ;"Output: Allows user to edit data and reattempt filing of data
227 ;"Result: none.
228
229
230 new Fixed set Fixed=0
231
232 new OneLine,PtInfo
233 new TMGWP,TMGMSG
234 new tempResult
235 new ErrIEN
236 new DelError set DelError=0
237
238 if $get(XQADATA)'>0 do goto HndDone
239 . write !!,"No value in XQADATA, so quitting.",!
240 . write "(Deleting alert.)",!
241 . set Fixed=1,DelError=1
242 set ErrIEN=XQADATA
243
244 write !!,"Problem with upload of Sequel data. ",!
245
246 ;"temp
247 write "IEN in file# 22706=",ErrIEN,!
248
249 new x set x=$$GET1^DIQ(22706,ErrIEN_",",2,"","TMGWP","TMGMSG")
250 if $data(TMGMSG("DIERR"))'=0 do goto HndDone
251 . new PriorErrorFound
252 . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
253 . set Fixed=1,DelError=1
254 set OneLine=$$WPToStr^TMGSTUTL("TMGWP","")
255 if $$ParseLine^TMGSEQL1(OneLine,.PtInfo)=0 do goto HndDone
256 . write "Error parsing Alert data into patient data.",!
257 write $get(PtInfo("FULL NAME")),!
258
259 new ErrMsg set ErrMsg=$$GET1^DIQ(22706,ErrIEN_",",1)
260 write ErrMsg,!
261
262 kill TMGWP,TMGMSG
263 new x set x=$$GET1^DIQ(22706,ErrIEN_",",3,"","TMGWP","TMGMSG")
264 if $data(TMGMSG("DIERR"))'=0 do goto HndDone
265 . new PriorErrorFound
266 . do ShowDIERR^TMGDEBUG(.TMGMsg,.PriorErrorFound)
267 . set Fixed=1,DelError=1
268 if $data(TMGWP) do
269 . do WriteWP^TMGSTUTL("TMGWP")
270
271 if ErrMsg["PATIENT NOT IN DATABASE" do
272 . set Fixed=$$FixRegProblem(.PtInfo,.OneLine,.DelError)
273 else if ErrMsg["INVALID/MISSING GENDER" do
274 . set Fixed=$$FixRegProblem(.PtInfo,.OneLine,.DelError)
275 else if ErrMsg["CONFLICTING SS-NUMBERS" do
276 . set Fixed=$$FixSSNProblem(.PtInfo,ErrMsg,.OneLine,.DelError)
277 else if ErrMsg["INVALID DOB ERROR" do
278 . write "Date of birth (DOB) is incorrect for this patient.",!
279 . write "Note: The recommended method of correcting this problem is",!
280 . write " to fix the problem in Sequel, not here. Otherwise",!
281 . write " the same error will be encountered with each demographics",!
282 . write " upload.",!!
283 . set Fixed=$$FixGenProblem(.PtInfo,ErrMsg,.OneLine,.DelError)
284 else do
285 . set Fixed=$$FixGenProblem(.PtInfo,ErrMsg,.OneLine,.DelError,ErrIEN)
286
287 if DelError=1 do
288 . new temp,ErrArray
289 . set temp=$$DelIEN^TMGDBAPI(22706,ErrIEN,.ErrArray) ;"success, so kill error entry in 22706
290
291HndDone
292 ;"if Fixed=1 write !,"SUCCESS!"
293
294 if (Fixed=0)!(DelError=0) do ;"<------------- this logic may be off...
295 . kill XQAKILL ;"--> don't delete alert
296 . write "(Saving alert...)",!
297
298 quit
299
300
301FixRegProblem(PtInfo,OneLine,DelError)
302 ;"Purpose: To fix problems where patient couldn't be added to the database
303 ;"Input: PtInfo -- PASS BY REFERENCE -- the Patient Info array, as created by ParseLine^TMGSEQL1
304 ;" OneLine -- the originial CSV data line. Passed to this function in case a new Alert
305 ;" must be created, in which case it is stored in the new error message.
306 ;" DelError -- and OUT parameter. Set to 1 will signal the deletion of the error
307 ;" record in file 22706
308 ;"Output: Patient may be added to FILE 2, or file updated. If succesfull, record of error
309 ;" in file 22706 will deleted
310 ;"Result: 1=problem fixed, 0=not fixed.
311
312 new Fixed set Fixed=0
313 set DelError=0
314 new TMGRemSex,InitRemSex
315 set TMGRemSex=+$$GET1^DIQ(22711,"1,","PICK GENDER FROM NAME?","I")
316 set InitRemSex=TMGRemSex
317
318 new AutoRegister set AutoRegister=1 ;"automatically add patient to database if not found
319 new OneErrArray,ChgLog
320 new done set done=0
321 for do quit:(done=1)
322 . kill OneErrArray,ChgLog
323 . new tempResult
324 . set tempResult=$$UpdateDB^TMGSEQL1(.PtInfo,AutoRegister,.OneErrArray,.ChgLog) ;"0=error
325 . set DelError=1
326 . set Fixed=1
327 . set done=1
328 . if tempResult=0 do
329 . . if $$IsMissingSex(.OneErrArray)=1 do
330 . . . if $$GetSexMissing(.PtInfo,.TMGRemSex)=0 do
331 . . . . set done=1 ;"0=failed
332 . . . . set Fixed=0
333 . . else do
334 . . . write "There is still an error:",!
335 . . . ;"zwr OneErrArray(*)
336 . . . write "A new alert will be made to handle this new error.",!
337 . . . do ErrRefile(.OneLine,.PtInfo,.OneErrArray,DUZ)
338 . . . ;"set OneErrArray(0)=$$NameError(.OneErrArray)
339 . . . ;"write OneErrArray(0),!
340 . . . ;"do AlertError^TMGSEQL2(.OneLine,.PtInfo,.OneErrArray,DUZ)
341
342 if TMGRemSex'=InitRemSex do ;"if status of auto-pick gender was changed in GetSexMissing, store in settings.
343 . new TMGFDA,TMGMSG
344 . set TMGFDA(22711,"1,",6)=TMGRemSex ;"field# 6='PICK GENDER FROM NAME?'
345 . do FILE^DIE("E","TMGFDA","TMGMSG") ;"note TMGMSG is ignored here...
346
347 quit Fixed
348
349IsMissingSex(ErrArray)
350 ;"Purpose: To analyze a Fileman error array and see if field .02 (SEX) is missing, causing problem
351 ;"Input: ErrArray -- PASS BY REFERENCE, an error message, as created by Fileman while adding patient.
352 ;"Result: 1=missing sex (.02 field), other 0
353 ;"Note: this only reviews error #1 (ignores other errors, if present. So, if missing sex error
354 ;" was in position #2, this function WOULD RETURN AN ERRORONEOUS ANSWER.
355
356 new result set result=0
357
358 if $data(ErrArray("DIERR","E",311,1)) do ;"311=The record lacks some required identifiers.
359 . if $get(ErrArray("DIERR",1,"PARAM","FIELD"))'=.02 quit
360 . if $get(ErrArray("DIERR",1,"PARAM","FILE"))'=2 quit
361 . set result=1
362
363 quit result
364
365
366
367
368GetSexMissing(PtInfo,TMGRemSex)
369 ;"Purpose: To correct the PtInfo Array so that SEX is supplied answer.
370 ;"Input: PtInfo -- PASS BY REFERENCE -- the Patient Info array, as created by ParseLine^TMGSEQL1
371 ;" TMGRemSex --PASS BY REFERENCE -- 1 if OK to automatically pick sex based on gender of name
372 ;"Output: PtInfo should be filled with SEX of patient
373 ;"Result: 1=OK to continue, 0=failed to get SEX
374
375 new result set result=0 ;"default to failure
376 new temp set temp=""
377 new Abort set Abort=0
378
379 if $get(PtInfo("SEX"))'="" set result=1 goto GSMDone
380 if $get(PtInfo("FULL NAME"))="" goto GSMDone
381 new FName set FName=$get(PtInfo("FIRST NAME"))
382 if FName="" goto GSMDone
383
384 for do quit:(temp'="")!(Abort=1)
385 . new presumedSex,RemName
386 . set CurrentSex=""
387 . set TMGRemSex=$get(TMGRemSex,0)
388 . write "Trying to determine the SEX of: ",PtInfo("FULL NAME"),!!
389 . write "OPTIONS:",!
390 . write "-----------------",!
391 . write "M or MALE --> Name is MALE",!
392 . write "M! or MALE! --> ALWAYS consider this name as MALE",!
393 . write "F or FEMALE --> Name is FEMALE",!
394 . write "F! or FEMALE! --> ALWAYS consider this name as FEMALE",!
395 . write "AUTO --> Turn auto-pick-gender: ",$select(TMGRemSex=1:"OFF",1:"ON"),!
396 . write "^ Abort",!
397 . set presumedSex=$$GetSex(FName)
398 . write "Is ",FName," MALE or FEMALE? ",presumedSex,"//"
399 . if (TMGRemSex=1)&(presumedSex'="") set temp=presumedSex
400 . else read temp:$get(DTIME,3600)
401 . if temp="" set temp=presumedSex
402 . set RemName=(temp["!")
403 . set temp=$translate(temp,"!","")
404 . set temp=$$UP^XLFSTR(temp)
405 . if (temp="M")!(temp="MALE") set CurrentSex="MALE"
406 . else if (temp="F")!(temp="FEMALE") set CurrentSex="FEMALE"
407 . else if temp="^" do quit
408 . . write "aborting..",!
409 . . set Abort=1
410 . else if temp="AUTO" do
411 . . set TMGRemSex='(TMGRemSex)
412 . if CurrentSex'="" do quit
413 . . write " ",CurrentSex,!
414 . . set PtInfo("SEX")=CurrentSex
415 . . set result=1
416 . . if RemName do
417 . . . new temp set temp=$$SetSex(FName,CurrentSex)
418 . set temp="" ;" a signal to try again.
419
420GSMDone
421 quit result
422
423
424FixSSNProblem(PtInfo,ErrMsg,OneLine,DelError)
425 ;"Purpose: To fix problems of conflicting SS numbers
426 ;"Input: PtInfo -- PASS BY REFERENCE -- the Patient Info array, as created by ParseLine^TMGSEQL1
427 ;" ErrMsg -- the message that holds the conflicting SSNums
428 ;" OneLine -- the originial CSV data line. Passed to this function in case a new Alert
429 ;" must be created, in which case it is stored in the new error message.
430 ;" DelError -- and OUT parameter. Set to 1 will signal the deletion of the error
431 ;" record in file 22706
432 ;"Output: Patient may be added to FILE 2, or file updated. If succesfull, record of error
433 ;" in file 22706 will deleted
434 ;"Result: 1=problem fixed, 0=not fixed.
435
436 new sqSSNum,vSSNum
437 new Fixed set Fixed=0
438 new done set done=0
439 set DelError=0
440
441 if $get(ErrMsg)="" goto FSNPDone
442
443 if ErrMsg["(Sequel#)" do ;"old format
444 . set sqSSN=$piece(ErrMsg,"SS-NUMBERS: ",2)
445 . set sqSSN=$piece(sqSSN," ",1)
446 . set vSSN=$piece(ErrMsg,"vs. ",2)
447 . set vSSN=$piece(vSSN," ",1)
448 else do
449 . set sqSSN=$piece(ErrMsg,"Sequel#=",2)
450 . set sqSSN=$piece(sqSSN," ",1)
451 . set vSSN=$piece(ErrMsg,"VistA#=",2)
452 . set vSSN=$piece(vSSN," ",1)
453
454 new vFullName
455 do ;"get actual full name & DOB for VistA SSN
456 . new vName,vDOB
457 . new tempDFN set tempDFN=$$SSNumLookup^TMGGDFN(vSSN)
458 . new TMGMSG,TMGERR,IENS
459 . set IENS=+tempDFN_","
460 . do GETS^DIQ(2,IENS,".01;.03","E","TMGMSG","TMGERR")
461 . if $data(TMGERR("DIERR")) do
462 . . new PriorErrorFound
463 . . do ShowDIERR^TMGDEBUG(.TMGMSG,.PriorErrorFound)
464 . set vName=$get(TMGMSG(2,IENS,.01,"E"))
465 . set vDOB=$get(TMGMSG(2,IENS,.03,"E"))
466 . set vFullName=vName_" ("_vDOB_")"
467
468 write !
469
470 for do quit:(done=1)
471 . write "There is a conflict between Social Security Numbers (SSN):",!
472 . write "1. ",sqSSN," is the Sequel SSN for: ",$get(PtInfo("FULL NAME2")),!
473 . write "2. ",vSSN," is the VistA SSN for: ",$get(vFullName),!
474 . write "3. (Don't change either one, but remove alert)",!
475 . write !,"Which SSN is correct? (1, 2, 3, or ^ to abort)? // "
476 . new temp read temp:$get(DTIME,3600),!
477 . if temp="^" set done=1 quit ;"quit, error unfixed.
478 . if temp=3 do quit ;"keep both
479 . . write "OK, no data changes made. Will delete alert.",!
480 . . set Fixed=1,done=1
481 . if temp=2 do quit ;"keep VistA, advice manual fix in Sequel database, delete alert.
482 . . write "OK. Please manually alter the SSN in the Sequel Database. This should then be",!
483 . . write "reflected in the next demographic data upload cycle.",!
484 . . set Fixed=1 ;"This will signal the deletion of the alert
485 . . set done=1
486 . if temp=1 do ;"keep Sequel, delete VistA SSN
487 . . set done=1
488 . . set Fixed=1
489 . . set DelError=1
490 . . new DFN set DFN=$$GetDFN^TMGSEQL1(.PtInfo)
491 . . new TMGFDA,TMGMSG,tempResult
492 . . set TMGFDA(2,DFN_",",.09)="@" ;"delete .09 field (SSN)
493 . . set tempResult=$$dbWrite^TMGDBAPI(.TMGFDA,1,,,.TMGMSG)
494 . . if tempResult=0 quit ;"error found, so quit
495 . . ;"Now try filing again.
496 . . new OneErrErray,ChgLog
497 . . new AutoRegister set AutoRegister=0 ;"should need to add patient, as must exist to confilict in first place!
498 . . set tempResult=$$UpdateDB^TMGSEQL1(.PtInfo,AutoRegister,.OneErrArray,.ChgLog) ;"0=error
499 . . if tempResult=0 do
500 . . . do ErrRefile(.OneLine,.PtInfo,.OneErrArray,DUZ)
501 . . . ;"write "There is still an error:",!
502 . . . ;"zwr OneErrArray(*)
503 . . . ;"write "A new alert will be made to handle this new error.",!
504 . . . ;"set OneErrArray(0)=$$NameError(.OneErrArray)
505 . . . ;"write OneErrArray(0),!
506 . . . ;"do AlertError^TMGSEQL2(.OneLine,.PtInfo,.OneErrArray,DUZ)
507
508FSNPDone
509 quit Fixed
510
511
512
513GetSex(Name)
514 ;"Purpose: To return gender of Name, as stored in file 22707
515 ;"Input: Name - a FIRST name
516 ;"Result: Returns MALE, FEMALE, or "" if not found
517
518 new result set result=""
519 if $get(Name)="" goto GSDone
520 new DIC,X,Y
521 set DIC=22707
522 set DIC(0)="M"
523 set X=Name
524 do ^DIC
525 if +Y'>0 goto GSDone
526 set result=$$GET1^DIQ(22707,+Y_",",1)
527
528GSDone
529 quit result
530
531
532
533SetSex(Name,Sex)
534 ;"Purpose: To create a new record in file 22707 to store gender of name
535 ;"Input: Name -- a FIRST name to store gender for
536 ;" Sex -- should be "MALE", or "FEMALE"
537 ;"Note: Will not do anything if a record for name already exists
538 ;"Result: 1=OK to continue 0=some error
539
540 new result set result=1
541 if '$data(Name)!'$data(Sex) goto SSxDone
542 if $$GetSex(Name)'="" goto SSxDone
543 new TMGFDA
544 set TMGFDA(22707,"+1,",.01)=Name
545 set TMGFDA(22707,"+1,",1)=Sex
546 set result=$$dbWrite^TMGDBAPI(.TMGFDA,0)
547
548SSxDone
549 quit result
550
551
552NameError(OneErrArray)
553 ;"Purpose: to review a fileman "DIERR" array and pick out common problems
554 ;"Input: OneErrArray -- a fileman array containing "DIERR" message
555 ;"Result: return a name for error
556
557 new result set result=""
558
559 new Array
560 if $data(OneErrArray("DIERR"))>1 do
561 . merge Array=OneErrArray("DIERR")
562 else do
563 . merge Array=OneErrArray
564
565 new field set field=$get(Array(1,"PARAM","FIELD"))
566
567 if $data(Array)>0 do
568 . new FileNum set FileNum=+$get(Array(1,"PARAM","FILE"))
569 . if (FileNum>0)&(FileNum'=2) quit
570 . if field>0 set result="FILEMAN ERROR:"
571 . if field=.03 do
572 . . set result="INVALID DOB ERROR:"
573 . if field=.02 do
574 . . set result="INVALID/MISSING GENDER:"
575 . if $data(Array(1,"TEXT")) do
576 . . new s set s=$get(Array(1,"TEXT",1))
577 . . set result=result_$extract(s,1,80)_"..."
578 . if result["CONFLICTING SS-NUMBERS" do
579 . . set result="CONFLICTING SS-NUMBERS: "
580
581 if result="" set result=$get(Array(0),"Sequel Import Error:")
582
583 quit result
584
585
586FixGenProblem(PtInfo,ErrMsg,OneLine,DelError,ErrIEN)
587 ;"Purpose: To fix a generic (no specified) error
588 ;"Input: PtInfo -- PASS BY REFERENCE -- the Patient Info array, as created by ParseLine^TMGSEQL1
589 ;" ErrMsg -- the message that holds the conflicting SSNums
590 ;" OneLine -- the originial CSV data line. Passed to this function in case a new Alert
591 ;" must be created, in which case it is stored in the new error message.
592 ;" DelError -- and OUT parameter. Set to 1 will signal the deletion of the error
593 ;" record in file 22706
594 ;" ErrIEN -- the IEN in file 22706 containing full error info.
595 ;"Output: Patient may be added to FILE 2, or file updated. If succesfull, record of error
596 ;" in file 22706 will deleted
597 ;"Result: 1=problem fixed, 0=not fixed.
598
599 new Fixed set Fixed=0
600 new done set done=0
601 set DelError=0
602 new done set done=0
603 new AutoRegister set AutoRegister=1 ;"automatically add patient to database if not found
604
605 new temp
606 set temp="?"
607 for do quit:(done=1)
608 . if temp="?" do quit
609 . . write "Options:",!
610 . . write "-----------------",!
611 . . write "D Show the data line from the other computer (Sequel)",!
612 . . write "E Edit data line.",!
613 . . write "R Retry filing data into database to get more information.",!
614 . . write "S Show parsed patient information.",!
615 . . write "X Delete this Alert.",!
616 . . write "Q Query the database to see existing entries.",!
617 . . write "^ Abort.",!
618 . . set temp=""
619 . else if temp="Q" do quit
620 . . new DIC set DIC=2
621 . . set DIC(0)="AEQM"
622 . . do ^DIC
623 . . set temp=""
624 . else if temp="D" do quit
625 . . write !,OneLine,!
626 . . set temp=""
627 . else if temp="S" do quit
628 . . zwr PtInfo(*)
629 . . set temp=""
630 . else if temp="E" do quit
631 . . new r,NewLine
632 . . set r=$$EditOneLine(OneLine,.NewLine)
633 . . if r=1 set OneLine=NewLine ;"NOTE: later I will save old line to keep from having to process each update cycle
634 . . kill PtInfo
635 . . if $$ParseLine^TMGSEQL1(OneLine,.PtInfo)=0 do quit
636 . . . write "There was a problem processing this line after your edit. Sorry!",!
637 . . write "OK, now try refilling data into database.",!
638 . . set temp="?"
639 . else if temp="^" do quit
640 . . write "aborting..",!
641 . . set done=1
642 . else if temp="X" do quit
643 . . write "OK, will delete this alert.",!
644 . . ;"Note: do something to delete alert.
645 . . set done=1,DelError=1,Fixed=1
646 . else if temp="R" do quit
647 . . new OneErrErray,ChgLog
648 . . set tempResult=$$UpdateDB^TMGSEQL1(.PtInfo,AutoRegister,.OneErrArray,.ChgLog) ;"0=error
649 . . set DelError=1
650 . . set Fixed=1 ;"consider 'fixed' so alert will be deleted
651 . . set done=1
652 . . if tempResult=0 do
653 . . . do ErrRefile(.OneLine,.PtInfo,.OneErrArray,DUZ)
654 . . . ;"write "There is still an error:",!
655 . . . ;"zwr OneErrArray(*)
656 . . . ;"write "A new alert will be made to handle this new error.",!
657 . . . ;"set OneErrArray(0)=$$NameError(.OneErrArray)
658 . . . ;"write OneErrArray(0),!
659 . . . ;"do AlertError^TMGSEQL2(.OneLine,.PtInfo,.OneErrArray,DUZ)
660 . read !,"Enter Option: ?//",temp:$get(DTIME,3600),!
661 . if temp="" set temp="?"
662 . set temp=$$UP^XLFSTR(temp)
663 . quit
664
665FGPDone
666 quit Fixed
667
668
669
Note: See TracBrowser for help on using the repository browser.