source: cprs/branches/tmg-cprs/CPRS-Chart/fReminderDialog.pas@ 499

Last change on this file since 499 was 496, checked in by Kevin Toppenberg, 16 years ago

Fixed missing TDKLang. Class, Added email demographic, Fixed field error in demographis
File size: 58.9 KB
Line 
1//kt -- Modified with SourceScanner on 8/21/2007
2unit fReminderDialog;
3
4interface
5
6uses
7 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
8 ExtCtrls, ORFn, StdCtrls, ComCtrls, Buttons, ORCtrls, uReminders, uConst,
9 ORClasses, fRptBox, Menus, rPCE, uTemplates, DKLang;
10
11type
12 TfrmRemDlg = class(TForm)
13 sb1: TScrollBox;
14 sb2: TScrollBox;
15 splTxtData: TSplitter;
16 Label1: TLabel;
17 pnlFrmBottom: TPanel;
18 pnlBottom: TPanel;
19 splText: TSplitter;
20 reData: TRichEdit;
21 reText: TRichEdit;
22 pnlButtons: TORAutoPanel;
23 btnClear: TButton;
24 btnBack: TButton;
25 btnCancel: TButton;
26 btnNext: TButton;
27 btnFinish: TButton;
28 btnClinMaint: TButton;
29 btnVisit: TButton;
30 lblFootnotes: TStaticText;
31 DKLanguageController1: TDKLanguageController;
32 procedure FormClose(Sender: TObject; var Action: TCloseAction);
33 procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
34 procedure FormCreate(Sender: TObject);
35 procedure FormDestroy(Sender: TObject);
36 procedure sbResize(Sender: TObject);
37 procedure btnClearClick(Sender: TObject);
38 procedure btnCancelClick(Sender: TObject);
39 procedure ProcessReminderFromNodeStr(value: string);
40 procedure btnNextClick(Sender: TObject);
41 procedure btnBackClick(Sender: TObject);
42 procedure btnFinishClick(Sender: TObject);
43 procedure btnClinMaintClick(Sender: TObject);
44 procedure btnVisitClick(Sender: TObject);
45 procedure KillDlg(ptr: Pointer; ID: string; KillObjects: boolean = FALSE);
46 procedure FormShow(Sender: TObject); //AGP Change 24.8
47 private
48 FSCCond: TSCConditions;
49 FSCPrompt: boolean;
50 FVitalsDate: TFMDateTime;
51 FSCRelated: integer;
52 FAORelated: integer;
53 FIRRelated: integer;
54 FECRelated: integer;
55 FMSTRelated: integer;
56 FHNCRelated: integer;
57 FCVRelated: integer;
58 FLastWidth: integer;
59 FUseBox2: boolean;
60 FExitOK: boolean;
61 FReminder: TReminderDialog;
62 CurReminderList: TORStringList;
63 FClinMainBox: TfrmReportBox;
64 FOldClinMaintOnDestroy: TNotifyEvent;
65 FProcessingTemplate: boolean;
66 FSilent: boolean;
67 protected
68 procedure RemindersChanged(Sender: TObject);
69 procedure ClearControls(All: boolean = FALSE);
70 procedure BuildControls;
71 function GetBox(Other: boolean = FALSE): TScrollBox;
72 function KillAll: boolean;
73 procedure ResetProcessing(Wipe: string = ''); //AGP CHANGE 24.8;
74 procedure BoxUpdateDone;
75 procedure ControlsChanged(Sender: TObject);
76 procedure UMResyncRem(var Message: TMessage); message UM_RESYNCREM;
77 procedure UpdateText(Sender: TObject);
78 function GetCurReminderList: integer;
79 function NextReminder: string;
80 function BackReminder: string;
81 procedure UpdateButtons;
82 procedure PositionTrees(NodeID: string);
83 procedure ClinMaintDestroyed(Sender: TObject);
84 procedure ProcessTemplate(Template: TTemplate);
85 public
86 procedure ProcessReminder(ARemData: string; NodeID: string);
87 procedure SetFontSize;
88 property Silent: boolean read FSilent write FSilent;
89 end;
90
91procedure ViewReminderDialog(RemNode: TORTreeNode; InitDlg: boolean = TRUE);
92procedure ViewReminderDialogTemplate(TempNode: TORTreeNode; InitDlg: boolean = TRUE);
93procedure ViewRemDlgTemplateFromForm(OwningForm: TForm; Template: TTemplate;
94 InitDlg, IsTemplate: boolean);
95procedure HideReminderDialog;
96procedure UpdateReminderFinish;
97procedure KillReminderDialog(frm: TForm);
98procedure NotifyWhenProcessingReminderChanges(Proc: TNotifyEvent);
99procedure RemoveNotifyWhenProcessingReminderChanges(Proc: TNotifyEvent);
100function ReminderDialogActive: boolean;
101function CurrentReminderInDialog: TReminderDialog;
102
103var
104 frmRemDlg: TfrmRemDlg = nil;
105 RemDlgSpltr1: integer = 0;
106 RemDlgSpltr2: integer = 0;
107 RemDlgLeft: integer = 0;
108 RemDlgTop: integer = 0;
109 RemDlgWidth: integer = 0;
110 RemDlgHeight: integer = 0;
111
112const
113 RemDlgName = 'frmRemDlg';
114 RemDlgSplitters = 'frmRemDlgSplitters';
115
116implementation
117
118uses fNotes, uPCE, uOrders, rOrders, uCore, rMisc, rReminders,
119 fReminderTree, uVitals, rVitals, RichEdit, fConsults, fTemplateDialog,
120 uTemplateFields, fRemVisitInfo, rCore;
121
122{$R *.DFM}
123
124var
125 PositionList: TORNotifyList = nil;
126 ClinRemTextLocation: integer = -77;
127 ClinRemTextStr: string = '';
128
129//const
130//REQ_TXT = 'The following required items must be entered:' + CRLF; <-- original line. //kt 8/21/2007
131//REQ_HDR = 'Required Items Missing'; <-- original line. //kt 8/21/2007
132
133var
134 REQ_TXT : string; //kt
135 REQ_HDR : string; //kt
136
137procedure SetupVars;
138//kt Added entire function to replace constant declarations 8/21/2007
139begin
140 REQ_TXT := DKLangConstW('fReminderDialog_The_following_required_items_must_be_enteredx') + CRLF; //kt added 8/21/2007
141 REQ_HDR := DKLangConstW('fReminderDialog_Required_Items_Missing'); //kt added 8/21/2007
142end;
143
144function ClinRemText: string;
145begin
146 if(ClinRemTextLocation <> Encounter.Location) then
147 begin
148 ClinRemTextLocation := Encounter.Location;
149 ClinRemTextStr := GetProgressNoteHeader;
150 end;
151 Result := ClinRemTextStr;
152end;
153
154
155procedure NotifyWhenProcessingReminderChanges(Proc: TNotifyEvent);
156begin
157 if(not assigned(PositionList)) then
158 PositionList := TORNotifyList.Create;
159 PositionList.Add(Proc);
160end;
161
162procedure RemoveNotifyWhenProcessingReminderChanges(Proc: TNotifyEvent);
163begin
164 if(assigned(PositionList)) then
165 PositionList.Remove(Proc);
166end;
167
168function ReminderDialogActive: boolean;
169begin
170 Result := assigned(frmRemDlg);
171end;
172
173function CurrentReminderInDialog: TReminderDialog;
174begin
175 Result := nil;
176 if(assigned(frmRemDlg)) then
177 Result := frmRemDlg.FReminder;
178end;
179
180procedure ViewRemDlgFromForm(OwningForm: TForm; RemNode: TORTreeNode; Template: TTemplate;
181 InitDlg, IsTemplate: boolean);
182var
183 Update: boolean;
184 Err: string;
185
186begin
187 Err := '';
188 if assigned(frmRemDlg) then
189 begin
190 if IsTemplate then
191// Err := 'Can not process template while another reminder dialog is being processed.' <-- original line. //kt 8/21/2007
192 Err := DKLangConstW('fReminderDialog_Can_not_process_template_while_another_reminder_dialog_is_being_processedx') //kt added 8/21/2007
193 else
194 if frmRemDlg.FProcessingTemplate then
195// Err := 'Can not process reminder while a reminder dialog template is being processed.' <-- original line. //kt 8/21/2007
196 Err := DKLangConstW('fReminderDialog_Can_not_process_reminder_while_a_reminder_dialog_template_is_being_processedx') //kt added 8/21/2007
197 end;
198 Update := FALSE;
199 if Err = '' then
200 begin
201 if(RemForm.Form <> OwningForm) then
202 begin
203 if(assigned(RemForm.Form)) then
204// Err := 'Reminders currently begin processed on another tab.' <-- original line. //kt 8/21/2007
205 Err := DKLangConstW('fReminderDialog_Reminders_currently_begin_processed_on_another_tabx') //kt added 8/21/2007
206 else
207 begin
208 if(OwningForm = frmNotes) then
209 frmNotes.AssignRemForm
210 else
211 if(OwningForm = frmConsults) then
212 frmConsults.AssignRemForm
213 else
214// Err := 'Can not process reminder dialogs on this tab.'; <-- original line. //kt 8/21/2007
215 Err := DKLangConstW('fReminderDialog_Can_not_process_reminder_dialogs_on_this_tabx'); //kt added 8/21/2007
216 Update := TRUE;
217 end;
218 end;
219 end;
220 if Err <> '' then
221 begin
222// InfoBox(Err, 'Reminders in Process', MB_OK or MB_ICONERROR); <-- original line. //kt 8/21/2007
223 InfoBox(Err, DKLangConstW('fReminderDialog_Reminders_in_Process'), MB_OK or MB_ICONERROR); //kt added 8/21/2007
224 exit;
225 end;
226
227 if(InitDlg and (not assigned(frmRemDlg))) then
228 begin
229 //(AGP add) Check for a bad encounter date
230 if RemForm.PCEObj.DateTime < 0 then
231 begin
232// InfoBox('The parent note has an invalid encounter date. Please contact IRM support for assistance.','Warning',MB_OK); <-- original line. //kt 8/21/2007
233 InfoBox(DKLangConstW('fReminderDialog_The_parent_note_has_an_invalid_encounter_datex_Please_contact_IRM_support_for_assistancex'),DKLangConstW('fReminderDialog_Warning'),MB_OK); //kt added 8/21/2007
234 exit;
235 end;
236 frmRemDlg := TfrmRemDlg.Create(Application);
237 frmRemDlg.SetFontSize;
238 Update := TRUE;
239 end;
240 if(assigned(frmRemDlg)) then
241 begin
242 if Update then
243 begin
244 frmRemDlg.FSCRelated := RemForm.PCEObj.SCRelated;
245 frmRemDlg.FAORelated := RemForm.PCEObj.AORelated;
246 frmRemDlg.FIRRelated := RemForm.PCEObj.IRRelated;
247 frmRemDlg.FECRelated := RemForm.PCEObj.ECRelated;
248 frmRemDlg.FMSTRelated := RemForm.PCEObj.MSTRelated;
249 frmRemDlg.FHNCRelated := RemForm.PCEObj.HNCRelated;
250 frmRemDlg.FCVRelated := RemForm.PCEObj.CVRelated;
251 end;
252 UpdateReminderFinish;
253 if IsTemplate then
254 frmRemDlg.ProcessTemplate(Template)
255 else if assigned(RemNode) then
256 frmRemDlg.ProcessReminder(RemNode.StringData, RemNode.TreeView.GetNodeID(RemNode, 1, IncludeParentID));
257 end;
258end;
259
260procedure ViewRemDlg(RemNode: TORTreeNode; InitDlg, IsTemplate: boolean);
261var
262 own: TComponent;
263
264begin
265 if assigned(RemNode) then
266 begin
267 own := RemNode.TreeView.Owner.Owner; // Owner is the Drawers, Owner.Owner is the Tab
268 if(not (own is TForm)) then
269// InfoBox('ViewReminderDialog called from an unsupported location.', <-- original line. //kt 8/21/2007
270 InfoBox(DKLangConstW('fReminderDialog_ViewReminderDialog_called_from_an_unsupported_locationx'), //kt added 8/21/2007
271// 'Reminders in Process', MB_OK or MB_ICONERROR) <-- original line. //kt 8/21/2007
272 DKLangConstW('fReminderDialog_Reminders_in_Process'), MB_OK or MB_ICONERROR) //kt added 8/21/2007
273 else
274 ViewRemDlgFromForm(TForm(own), RemNode, TTemplate(RemNode.Data), InitDlg, IsTemplate);
275 end;
276end;
277
278procedure ViewReminderDialog(RemNode: TORTreeNode; InitDlg: boolean = TRUE);
279begin
280 if(assigned(RemNode)) then
281 ViewRemDlg(RemNode, InitDlg, FALSE)
282 else
283 HideReminderDialog;
284end;
285
286procedure ViewReminderDialogTemplate(TempNode: TORTreeNode; InitDlg: boolean = TRUE);
287begin
288 if(assigned(TempNode) and (assigned(TempNode.Data)) and
289 (TTemplate(TempNode.Data).IsReminderDialog)) then
290 ViewRemDlg(TempNode, InitDlg, TRUE)
291 else
292 KillReminderDialog(nil);
293end;
294
295procedure ViewRemDlgTemplateFromForm(OwningForm: TForm; Template: TTemplate; InitDlg, IsTemplate: boolean);
296begin
297 if(assigned(OwningForm) and assigned(Template) and Template.IsReminderDialog) then
298 ViewRemDlgFromForm(OwningForm, nil, Template, InitDlg, IsTemplate)
299 else
300 KillReminderDialog(nil);
301end;
302
303procedure HideReminderDialog;
304begin
305 if(assigned(frmRemDlg)) then
306 frmRemDlg.Hide;
307end;
308
309procedure UpdateReminderFinish;
310begin
311 if(assigned(frmRemDlg)) and (assigned(RemForm.Form)) then
312 begin
313 frmRemDlg.btnFinish.Enabled := RemForm.CanFinishProc;
314 frmRemDlg.UpdateButtons;
315 end;
316end;
317
318procedure KillReminderDialog(frm: TForm);
319begin
320 if(assigned(frm) and (assigned(RemForm.Form)) and
321 (frm <> RemForm.Form)) then exit;
322 if(assigned(frmRemDlg)) then
323 begin
324 frmRemDlg.FExitOK := TRUE;
325 frmRemDlg.ResetProcessing;
326 end;
327 KillObj(@frmRemDlg);
328end;
329
330{ TfrmRemDlg }
331
332procedure TfrmRemDlg.ProcessReminder(ARemData: string; NodeID: string);
333var
334 Rem: TReminder;
335 TmpList: TStringList;
336 Msg: string;
337 Flds, Abort: boolean;
338
339begin
340 SetupVars; //kt
341 FProcessingTemplate := FALSE;
342 Rem := GetReminder(ARemData);
343 if(FReminder <> Rem) then
344 begin
345 if(assigned(FReminder)) then
346 begin
347 Abort := FALSE;
348 Flds := FALSE;
349 TmpList := TStringList.Create;
350 try
351 FReminder.FinishProblems(TmpList, Flds);
352 if(TmpList.Count > 0) or Flds then
353 begin
354// TmpList.Insert(0, ' Reminder: ' + FReminder.PrintName); <-- original line. //kt 8/21/2007
355 TmpList.Insert(0, DKLangConstW('fReminderDialog_Reminderx') + FReminder.PrintName); //kt added 8/21/2007
356 if Flds then
357 TmpList.Add(' ' + MissingFieldsTxt);
358 Msg := REQ_TXT + TmpList.Text + CRLF +
359// ' Ignore required items and continue processing?'; <-- original line. //kt 8/21/2007
360 DKLangConstW('fReminderDialog_Ignore_required_items_and_continue_processingx'); //kt added 8/21/2007
361 Abort := (InfoBox(Msg, REQ_HDR, MB_YESNO or MB_DEFBUTTON2) = IDNO);
362 end;
363 finally
364 TmpList.Free;
365 end;
366 if(Abort) then exit;
367 end;
368 ClearControls(TRUE);
369 FReminder := Rem;
370 Rem.PCEDataObj := RemForm.PCEObj;
371 BuildControls;
372 UpdateText(nil);
373 end;
374 PositionTrees(NodeID);
375 UpdateButtons;
376 Show;
377end;
378
379procedure TfrmRemDlg.FormClose(Sender: TObject; var Action: TCloseAction);
380begin
381 Action := caFree;
382end;
383
384procedure TfrmRemDlg.FormCloseQuery(Sender: TObject;
385 var CanClose: Boolean);
386begin
387 if(not FExitOK) then
388 CanClose := KillAll;
389end;
390
391procedure TfrmRemDlg.FormCreate(Sender: TObject);
392begin
393 reData.Color := ReadOnlyColor;
394 reText.Color := ReadOnlyColor;
395 FSCCond := EligbleConditions;
396 (* FSCRelated := SCC_NA;
397 FAORelated := SCC_NA;
398 FIRRelated := SCC_NA; AGP Change 25.2
399 FECRelated := SCC_NA;
400 FMSTRelated := SCC_NA;
401 FHNCRelated := SCC_NA;
402 FCVRelated := SCC_NA;
403 with FSCCond do
404 FSCPrompt := (SCAllow or AOAllow or IRAllow or ECAllow or MSTAllow or HNCAllow or CVAllow); *)
405 NotifyWhenRemindersChange(RemindersChanged);
406 RemForm.Drawers.NotifyWhenRemTreeChanges(RemindersChanged);
407 KillReminderDialogProc := KillReminderDialog;
408end;
409
410procedure TfrmRemDlg.FormDestroy(Sender: TObject);
411begin
412 if FProcessingTemplate then
413 KillObj(@FReminder);
414 KillObj(@FClinMainBox);
415 //Save the Position and Size of the Reminder Dialog
416 RemDlgLeft := Self.Left;
417 RemDlgTop := Self.Top;
418 RemDlgWidth := Self.Width;
419 RemDlgHeight := Self.Height;
420 RemDlgSpltr1 := pnlBottom.Height;
421 RemDlgSpltr2 := reData.Height;
422// SaveDialogSplitterPos(Name + 'Splitters', pnlBottom.Height, reData.Height);
423 RemForm.Drawers.RemoveNotifyWhenRemTreeChanges(RemindersChanged);
424 RemoveNotifyRemindersChange(RemindersChanged);
425 KillReminderDialogProc := nil;
426 ClearControls(TRUE);
427 frmRemDlg := nil;
428 if(assigned(frmReminderTree)) then
429 frmReminderTree.EnableActions;
430 RemForm.Form := nil;
431end;
432
433procedure TfrmRemDlg.ClearControls(All: boolean = FALSE);
434
435 procedure WipeOutControls(const Ctrl: TWinControl);
436 var
437 i: integer;
438
439 begin
440 for i := Ctrl.ControlCount-1 downto 0 do
441 begin
442 if(Ctrl.Controls[i].Owner = Self) then
443 begin
444 if(Ctrl.Controls[i] is TWinControl) then
445 WipeOutControls(TWinControl(Ctrl.Controls[i]));
446 Ctrl.Controls[i].Free
447 end;
448 end;
449 end;
450
451begin
452 if(All) then
453 begin
454 WipeOutControls(sb1);
455 WipeOutControls(sb2);
456 end
457 else
458 WipeOutControls(GetBox);
459end;
460
461procedure TfrmRemDlg.BuildControls;
462var
463 i, CtrlIdx, Y, ParentWidth: integer;
464 AutoCtrl, Active, Ctrl: TWinControl;
465 LastCB, LastObjCnt: integer;
466 Box: TScrollBox;
467 txt: string;
468
469 function IsOnBox(Component: TComponent): boolean;
470 var
471 Prnt: TWinControl;
472 begin
473 Result := FALSE;
474 if(Component is TWinControl) then
475 begin
476 Prnt := TWinControl(Component).Parent;
477 while(assigned(Prnt)) and (not Result) do
478 begin
479 Result := (Prnt = Box);
480 Prnt := Prnt.Parent;
481 end;
482 end;
483 end;
484
485 procedure SetActiveVars(ActCtrl: TWinControl);
486 var
487 i: integer;
488
489 begin
490 LastObjCnt := 0;
491 LastCB := 0;
492 Active := ActCtrl;
493 while(assigned(Active) and (Active.Owner <> Self)) do
494 begin
495 if(assigned(Active.Owner) and (Active.Owner is TWinControl)) then
496 Active := TWinControl(Active.Owner)
497 else
498 Active := nil;
499 end;
500 Ctrl := Active;
501 if(assigned(Ctrl) and IsOnBox(Ctrl)) then
502 begin
503 if(Active is TORCheckBox) then
504 LastCB := Active.Tag;
505 if(LastCB = 0) then
506 begin
507 CtrlIdx := -1;
508 for i := 0 to ComponentCount-1 do
509 begin
510 if(IsOnBox(Components[i])) then
511 begin
512 Ctrl := TWinControl(Components[i]);
513 if(Ctrl is TORCheckBox) and (Ctrl.Tag <> 0) then
514 CtrlIdx := i;
515 if(Ctrl = Active) and (CtrlIdx >= 0) then
516 begin
517 LastCB := Components[CtrlIdx].Tag;
518 LastObjCnt := (i - CtrlIdx);
519 break;
520 end;
521 end;
522 end;
523 end;
524 end;
525 end;
526
527begin
528 if(assigned(FReminder)) then
529 begin
530 Box := GetBox(TRUE);
531 if Box.ControlCount > 0 then ClearControls; //AGP Change 26.1 this change should
532 //resolve the problem with Duplicate CheckBoxes
533 //appearing on some reminder dialogs CQ #2843
534 Y := Box.VertScrollBar.Position;
535 GetBox.VertScrollBar.Position := 0;
536 if FProcessingTemplate then
537// txt := 'Reminder Dialog Template' <-- original line. //kt 8/21/2007
538 txt := DKLangConstW('fReminderDialog_Reminder_Dialog_Template') //kt added 8/21/2007
539 else
540// txt := 'Reminder Resolution'; <-- original line. //kt 8/21/2007
541 txt := DKLangConstW('fReminderDialog_Reminder_Resolution'); //kt added 8/21/2007
542 Caption := txt + ': ' + FReminder.PrintName;
543 FReminder.OnNeedRedraw := nil;
544 ParentWidth := Box.Width - ScrollBarWidth - 6;
545 SetActiveVars(ActiveControl);
546 AutoCtrl := FReminder.BuildControls(ParentWidth, GetBox, Self);
547 GetBox.VertScrollBar.Position := Y;
548 BoxUpdateDone;
549 if(LastCB <> 0) then
550 begin
551 Box := GetBox(TRUE);
552 if(assigned(AutoCtrl)) then
553 begin
554 AutoCtrl.SetFocus;
555 if(AutoCtrl is TORComboBox) then
556 TORComboBox(AutoCtrl).DroppedDown := TRUE;
557 end
558 else
559 for i := 0 to ComponentCount-1 do
560 begin
561 if(IsOnBox(Components[i])) then
562 begin
563 Ctrl := TWinControl(Components[i]);
564 if(Ctrl is TORCheckBox) and (Ctrl.Tag = LastCB) then
565 begin
566 if((i + LastObjCnt) < ComponentCount) and
567 (Components[i + LastObjCnt] is TWinControl) then
568 TWinControl(Components[i + LastObjCnt]).SetFocus;
569 break;
570 end;
571 end;
572 end;
573 end;
574
575 ClearControls;
576 FReminder.OnNeedRedraw := ControlsChanged;
577 FReminder.OnTextChanged := UpdateText;
578 end;
579end;
580
581function TfrmRemDlg.GetBox(Other: boolean = FALSE): TScrollBox;
582begin
583 if(FUseBox2 xor Other) then
584 Result := sb2
585 else
586 Result := sb1;
587end;
588
589procedure TfrmRemDlg.BoxUpdateDone;
590begin
591 sb2.Visible := FUseBox2;
592 sb1.Visible := not FUseBox2;
593 FUseBox2 := not FUseBox2;
594 Application.ProcessMessages; // allows new ScrollBox to repaint
595end;
596
597procedure TfrmRemDlg.ControlsChanged(Sender: TObject);
598begin
599 FLastWidth := GetBox(TRUE).ClientWidth;
600{ This routine is fired as a result of clicking a checkbox. If we destroy
601 the checkbox here we get access violations because the checkbox code is
602 still processing the click event after calling this routine. By posting
603 a message we can guarantee that the checkbox is no longer processing the
604 click event when the message is handled, preventing access violations. }
605 PostMessage(Handle, UM_RESYNCREM, 0 ,0);
606end;
607
608procedure TfrmRemDlg.UMResyncRem(var Message: TMessage);
609begin
610 BuildControls;
611end;
612
613procedure TfrmRemDlg.sbResize(Sender: TObject);
614begin
615{ If you remove this logic you will get an infinite loop in some cases }
616 if(FLastWidth <> GetBox(TRUE).ClientWidth) then
617 ControlsChanged(Sender);
618end;
619
620procedure TfrmRemDlg.UpdateText(Sender: TObject);
621const
622 BadType = TPCEDataCat(-1);
623
624var
625 TopIdx, i, LastPos, CurPos, TxtStart: integer;
626 Cat, LastCat: TPCEDataCat;
627 Rem: TReminderDialog;
628 TmpData: TORStringList;
629 Bold: boolean;
630 tmp: string;
631
632begin
633 RedrawSuspend(reText.Handle);
634 try
635 TopIdx := SendMessage(reText.Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
636 reText.Clear;
637 LastPos := reText.SelStart;
638 reText.SelAttributes.Style := reText.SelAttributes.Style - [fsBold];
639 i := 0;
640 repeat
641 if FProcessingTemplate then
642 Rem := FReminder
643 else
644 Rem := TReminder(RemindersInProcess.Objects[i]);
645 Rem.AddText(reText.Lines);
646 reText.SelStart := MaxInt;
647 CurPos := reText.SelStart;
648 if(Rem = FReminder) then
649 begin
650 reText.SelStart := LastPos;
651 reText.SelLength := CurPos - LastPos;
652 reText.SelAttributes.Style := reText.SelAttributes.Style + [fsBold];
653 reText.SelLength := 0;
654 reText.SelStart := CurPos;
655 reText.SelAttributes.Style := reText.SelAttributes.Style - [fsBold];
656 end;
657 LastPos := CurPos;
658 inc(i);
659 until(FProcessingTemplate or (i >= RemindersInProcess.Count));
660 if((not FProcessingTemplate) and (reText.Lines.Count > 0)) then
661 begin
662 reText.Lines.Insert(0, ClinRemText);
663 reText.SelStart := 0;
664 reText.SelLength := length(ClinRemText);
665 reText.SelAttributes.Style := reText.SelAttributes.Style - [fsBold];
666 reText.SelLength := 0;
667 reText.SelStart := MaxInt;
668 end;
669 SendMessage(reText.Handle, EM_LINESCROLL, 0, TopIdx);
670 finally
671 RedrawActivate(reText.Handle);
672 end;
673
674 TmpData := TORStringList.Create;
675 try
676 reData.Clear;
677 LastCat := BadType;
678 tmp := RemForm.PCEObj.StrVisitType(FSCRelated, FAORelated, FIRRelated,
679 FECRelated, FMSTRelated, FHNCRelated, FCVRelated);
680 if FProcessingTemplate then
681 i := GetReminderData(FReminder, TmpData)
682 else
683 i := GetReminderData(TmpData);
684 if(tmp = '') and (i = 0) then
685 reData.Lines.insert(0,TX_NOPCE);
686 TmpData.Sort;
687 RedrawSuspend(reData.Handle);
688 try
689 TopIdx := SendMessage(reData.Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
690 reData.SelAttributes.Style := reData.SelAttributes.Style - [fsBold];
691 if tmp <> '' then
692 reData.SelText := tmp + CRLF;
693 i := 0;
694 while i < TmpData.Count do
695 begin
696 tmp := TmpData[i];
697 TxtStart := 2;
698 Bold := FALSE;
699 Cat := TPCEDataCat(ord(tmp[1]) - ord('A'));
700 if(LastCat <> Cat) or (Cat = pdcVital) then
701 begin
702 if(Cat = pdcVital) then
703 inc(TxtStart);
704 if(LastCat <> BadType) then
705 begin
706 reData.SelText := CRLF;
707 reData.SelStart := MaxInt;
708 end;
709 //reData.SelText := PCEDataCatText[Cat];
710 reData.SelText := PCEDataCatText(Cat); //kt
711 reData.SelStart := MaxInt;
712 LastCat := Cat;
713 end
714 else
715 begin
716 reData.SelText := ', ';
717 reData.SelStart := MaxInt;
718 end;
719 repeat
720 if(TRemData(TmpData.Objects[i]).Parent.Reminder = FReminder) then
721 Bold := TRUE;
722 inc(i);
723 until (i >= TmpData.Count) or (TmpData[i] <> tmp);
724 if(Bold) then
725 reData.SelAttributes.Style := reData.SelAttributes.Style + [fsBold];
726 reData.SelText := copy(tmp, TxtStart, MaxInt);
727 reData.SelStart := MaxInt;
728 if(Bold) then
729 reData.SelAttributes.Style := reData.SelAttributes.Style - [fsBold];
730 end;
731 SendMessage(reData.Handle, EM_LINESCROLL, 0, TopIdx);
732 finally
733 RedrawActivate(reData.Handle);
734 end;
735 finally
736 TmpData.Free;
737 end;
738end;
739
740procedure TfrmRemDlg.btnClearClick(Sender: TObject);
741var
742 Tmp, TmpNode: string;
743 i: integer;
744 OK: boolean;
745
746begin
747 if(assigned(FReminder)) then
748 begin
749 i := RemindersInProcess.IndexOf(FReminder.IEN);
750 if(i >= 0) then
751 begin
752 if(FReminder.Processing) then
753// OK := (InfoBox('Clear all reminder resolutions for ' + FReminder.PrintName, <-- original line. //kt 8/21/2007
754 OK := (InfoBox(DKLangConstW('fReminderDialog_Clear_all_reminder_resolutions_for') + FReminder.PrintName, //kt added 8/21/2007
755// 'Clear Reminder Processing', MB_YESNO or MB_DEFBUTTON2) = ID_YES) <-- original line. //kt 8/21/2007
756 DKLangConstW('fReminderDialog_Clear_Reminder_Processing'), MB_YESNO or MB_DEFBUTTON2) = ID_YES) //kt added 8/21/2007
757 else
758 OK := TRUE;
759 if(OK) then
760 begin
761 RemindersInProcess.Delete(i);
762 Tmp := (FReminder as TReminder).RemData; // clear should never be active if template
763 TmpNode := (FReminder as TReminder).CurrentNodeID;
764 KillObj(@FReminder);
765 ProcessReminder(Tmp, TmpNode);
766 end;
767 end;
768 end;
769end;
770
771procedure TfrmRemDlg.btnCancelClick(Sender: TObject);
772begin
773 if(KillAll) then
774 begin
775 FExitOK := TRUE;
776 frmRemDlg.Release;
777 frmRemDlg := nil;
778 end;
779end;
780
781function TfrmRemDlg.KillAll: boolean;
782var
783 i, cnt: integer;
784 msg, RemWipe: string;
785
786
787begin
788 //AGP 25.11 Added RemWipe section to cancel button to
789 //flag the patient specific dialog to be destroy if not in process.
790 RemWipe := '';
791 if FProcessingTemplate or FSilent then
792 begin
793 Result := TRUE;
794 if FReminder.RemWipe = 1 then RemWipe := Piece(FReminder.DlgData,U,1);
795 end
796 else
797 begin
798 msg := '';
799 cnt := 0;
800 for i := 0 to RemindersInProcess.Count-1 do
801 begin
802 //if Piece(TReminder(RemindersInProcess.Objects[i]).RemData,U,11)='1' then
803 if TReminderDialog(TReminder(RemindersInProcess.Objects[i])).RemWipe = 1 then
804 begin
805 if RemWipe ='' then RemWipe := TReminder(RemindersInProcess.Objects[i]).IEN
806 else RemWipe := RemWipe + U + TReminder(RemindersInProcess.Objects[i]).IEN
807 end;
808 if(TReminder(RemindersInProcess.Objects[i]).Processing) then
809 begin
810 msg := msg + ' ' + TReminder(RemindersInProcess.Objects[i]).PrintName + CRLF;
811 inc(cnt);
812 end;
813 end;
814 if(msg <> '') then
815 begin
816 if(cnt > 1) then
817// msg := 'The Following Reminders are being processed:' + CRLF + CRLF + msg <-- original line. //kt 8/21/2007
818 msg := DKLangConstW('fReminderDialog_The_Following_Reminders_are_being_processedx') + CRLF + CRLF + msg //kt added 8/21/2007
819 else
820// msg := 'The Following Reminder is being processed: ' + CRLF + CRLF + msg; <-- original line. //kt 8/21/2007
821 msg := DKLangConstW('fReminderDialog_The_Following_Reminder_is_being_processedx') + CRLF + CRLF + msg; //kt added 8/21/2007
822// msg := msg + CRLF + 'Canceling will cause all processing information to be lost.' + CRLF + <-- original line. //kt 8/21/2007
823 msg := msg + CRLF + DKLangConstW('fReminderDialog_Canceling_will_cause_all_processing_information_to_be_lostx') + CRLF + //kt added 8/21/2007
824// 'Do you still want to cancel out of reminder processing?'; <-- original line. //kt 8/21/2007
825 DKLangConstW('fReminderDialog_Do_you_still_want_to_cancel_out_of_reminder_processingx'); //kt added 8/21/2007
826// Result := (InfoBox(msg, 'Cancel Reminder Processing', MB_YESNO or MB_DEFBUTTON2) = ID_YES); <-- original line. //kt 8/21/2007
827 Result := (InfoBox(msg, DKLangConstW('fReminderDialog_Cancel_Reminder_Processing'), MB_YESNO or MB_DEFBUTTON2) = ID_YES); //kt added 8/21/2007
828 end
829 else
830 Result := TRUE;
831 end;
832 if(Result) then
833 ResetProcessing(RemWipe);
834end;
835
836function TfrmRemDlg.GetCurReminderList: integer;
837var
838 Sel, Node: TORTreeNode;
839 Data: string;
840 NodeCheck, Cur: boolean;
841
842begin
843 Result := -1;
844 CurReminderList := TORStringList.Create;
845 Sel := TORTreeNode(RemForm.Drawers.tvReminders.Selected);
846 NodeCheck := (assigned(Sel) and assigned(FReminder) and
847 (Piece(Sel.StringData,U,1) = RemCode +FReminder.IEN));
848 Node := TORTreeNode(RemForm.Drawers.tvReminders.Items.GetFirstNode);
849 while assigned(Node) do
850 begin
851 Data := TORTreeNode(Node).StringData;
852 if(copy(Data, 1, 1) = RemCode) then
853 begin
854 delete(Data,1,1);
855 Data := Node.TreeView.GetNodeID(Node, 1, IncludeParentID) + U + Data;
856 if(NodeCheck) then
857 Cur := (Node = Sel)
858 else
859 Cur := (assigned(FReminder)) and (FReminder.IEN = Piece(Data,U,1));
860 if(Cur) then
861 Result := CurReminderList.Add(Data)
862 else
863 if(Piece(Data, U , 8) = '1') then
864 CurReminderList.Add(Data);
865 end;
866 Node := TORTreeNode(Node.GetNextVisible);
867 end;
868end;
869
870function TfrmRemDlg.NextReminder: string;
871var
872 idx: integer;
873
874begin
875 Result := '';
876 idx := GetCurReminderList;
877 try
878 inc(idx);
879 if(idx < CurReminderList.Count) then
880 Result := CurReminderList[idx];
881 finally
882 KillObj(@CurReminderList);
883 end;
884end;
885
886function TfrmRemDlg.BackReminder: string;
887var
888 idx: integer;
889
890begin
891 Result := '';
892 idx := GetCurReminderList;
893 try
894 dec(idx);
895 if(idx >= 0) then
896 Result := CurReminderList[idx];
897 finally
898 KillObj(@CurReminderList);
899 end;
900end;
901
902procedure TfrmRemDlg.ProcessReminderFromNodeStr(value: string);
903var
904 NodeID: string;
905 Data: string;
906 i: integer;
907
908begin
909 if(Value = '') then
910 begin
911 UpdateButtons;
912 exit;
913 end;
914 Data := Value;
915 i := pos(U, Data);
916 if(i = 0) then i := length(Data);
917 NodeID :=copy(Data,1,i-1);
918 delete(Data,1,i);
919 Data := RemCode + Data;
920 ProcessReminder(Data, NodeID);
921end;
922
923procedure TfrmRemDlg.btnNextClick(Sender: TObject);
924begin
925 ProcessReminderFromNodeStr(NextReminder);
926end;
927
928procedure TfrmRemDlg.btnBackClick(Sender: TObject);
929begin
930 ProcessReminderFromNodeStr(BackReminder);
931end;
932
933procedure TfrmRemDlg.UpdateButtons;
934begin
935 if(assigned(frmRemDlg)) and (not FProcessingTemplate) then
936 begin
937 btnBack.Enabled := btnFinish.Enabled and (BackReminder <> '');
938 btnNext.Enabled := btnFinish.Enabled and (NextReminder <> '');
939 btnClinMaint.Enabled := (not assigned(FClinMainBox));
940 end;
941end;
942
943procedure TfrmRemDlg.PositionTrees(NodeID: string);
944begin
945 if(assigned(PositionList)) and (not FProcessingTemplate) then
946 begin
947 if(assigned(FReminder)) then
948 (FReminder as TReminder).CurrentNodeID := NodeID;
949 PositionList.Notify(FReminder);
950 end;
951end;
952
953procedure TfrmRemDlg.btnFinishClick(Sender: TObject);
954var
955 i, cnt, lcnt,OldRemCount, OldCount, T: integer;
956 CurDate, CurLoc: string;
957 LastDate, LastLoc: string;
958 Rem: TReminderDialog;
959 Reminder: TReminder;
960 // Prompt: TRemPrompt;
961 RData: TRemData;
962 TmpData: TORStringList;
963 OrderList: TStringList;
964 TmpText: TStringList;
965 TmpList: TStringList;
966 VitalList: TStringList;
967 MHList: TStringList;
968 WHList: TStringList;
969 MSTList: TStringList;
970 HistData, PCEObj: TPCEData;
971 Cat: TPCEDataCat;
972 VisitParent, Msg, tmp: string;
973 DelayEvent: TOrderDelayEvent;
974 Hist: boolean;
975 v: TVitalType;
976 UserStr: string;
977 BeforeLine, AfterTop: integer;
978 GAFScore: integer;
979 TestDate: TFMDateTime;
980 TestStaff: Int64;
981 DoOrders, Done, Kill, Flds: boolean;
982 TR: TEXTRANGE;
983 buf: array[0..3] of char;
984 AddLine: boolean;
985 Process, StoreVitals: boolean;
986 PCEType: TPCEType;
987 WHNode,WHPrint,WHResult,WHTmp, WHValue: String;
988 WHType: TStrings;
989 //Test: String;
990 WHCnt,x: Integer;
991 WHArray: TStringlist;
992 GecRemIen, GecRemStr, RemWipe: String;
993
994 procedure Add(PCEItemClass: TPCEItemClass);
995 var
996 itm: TPCEItem;
997 tmp: string;
998
999 begin
1000 if(Cat in MSTDataTypes) then
1001 begin
1002 tmp := piece(TmpData[i],U,pnumMST);
1003 if (tmp <> '') then
1004 begin
1005 MSTList.Add(tmp);
1006 tmp := TmpData[i];
1007 setpiece(tmp,U,pnumMST,'');
1008 TmpData[i] := tmp;
1009 end;
1010 end;
1011 itm := PCEItemClass.Create;
1012 try
1013 itm.SetFromString(copy(TmpData[i], 2, MaxInt));
1014 TmpList.AddObject('',itm);
1015 if Cat = pdcHF then itm.FGecRem := GecRemStr;
1016 case Cat of
1017 pdcDiag: PCEObj.SetDiagnoses(TmpList, FALSE);
1018 pdcProc: PCEObj.SetProcedures(TmpList, FALSE);
1019 pdcImm: PCEObj.SetImmunizations(TmpList, FALSE);
1020 pdcSkin: PCEObj.SetSkinTests(TmpList, FALSE);
1021 pdcPED: PCEObj.SetPatientEds(TmpList, FALSE);
1022 pdcHF: PCEObj.SetHealthFactors(TmpList, FALSE);
1023 pdcExam: PCEObj.SetExams(TmpList, FALSE);
1024 end;
1025 itm.Free;
1026 TmpList.Clear;
1027 except
1028 itm.free;
1029 end;
1030 end;
1031
1032 procedure SaveMSTData(MSTVal: string);
1033 var
1034 vdate, s1, s2, prov, FType, FIEN: string;
1035
1036 begin
1037 if MSTVal <> '' then
1038 begin
1039 s1 := piece(MSTVal, ';', 1);
1040 vdate := piece(MSTVal, ';', 2);
1041 prov := piece(MSTVal, ';', 3);
1042 FIEN := piece(MSTVal, ';', 4);
1043 if FIEN <> '' then
1044 begin
1045 s2 := s1;
1046 s1 := '';
1047 FType := RemDataCodes[dtExam];
1048 end
1049 else
1050 begin
1051 s2 := '';
1052 FType := RemDataCodes[dtHealthFactor];
1053 end;
1054 SaveMSTDataFromReminder(vdate, s1, Prov, FType, FIEN, s2);
1055 end;
1056 end;
1057
1058begin
1059 SetupVars; //kt
1060 Kill := FALSE;
1061 GecRemIen := '0';
1062 WHList := nil;
1063 Rem := nil;
1064 RemWipe := ''; //AGP CHANGE 24.8
1065 try
1066 OldRemCount := ProcessedReminders.Count;
1067 if not FProcessingTemplate then
1068 ProcessedReminders.Notifier.BeginUpdate;
1069 try
1070 TmpList := TStringList.Create;
1071 try
1072 i := 0;
1073 repeat
1074 //AGP Added RemWipe section this section will determine if the Dialog is a patient specific
1075 if FProcessingTemplate or (i < RemindersInProcess.Count) then
1076 begin
1077 if FProcessingTemplate then
1078 begin
1079 Rem := FReminder;
1080 if Rem.RemWipe = 1 then
1081 RemWipe := Piece(Rem.DlgData,U,1);
1082 end
1083 else
1084 begin
1085 Rem := TReminder(RemindersInProcess.Objects[i]);
1086 if TReminderDialog(TReminder(RemindersInProcess.Objects[i])).RemWipe = 1 then
1087 begin
1088 if RemWipe ='' then RemWipe := TReminder(RemindersInProcess.Objects[i]).IEN
1089 else RemWipe := RemWipe + U + TReminder(RemindersInProcess.Objects[i]).IEN;
1090 end;
1091 end;
1092
1093 Flds := FALSE;
1094 OldCount := TmpList.Count;
1095 Rem.FinishProblems(TmpList, Flds);
1096 if(OldCount <> TmpList.Count) or Flds then
1097 begin
1098 TmpList.Insert(OldCount, '');
1099 if not FProcessingTemplate then
1100// TmpList.Insert(OldCount+1, ' Reminder: ' + Rem.PrintName); <-- original line. //kt 8/21/2007
1101 TmpList.Insert(OldCount+1, DKLangConstW('fReminderDialog_Reminderx') + Rem.PrintName); //kt added 8/21/2007
1102 if Flds then
1103 TmpList.Add(' ' + MissingFieldsTxt);
1104 end;
1105 inc(i);
1106 end;
1107 until(FProcessingTemplate or (i >= RemindersInProcess.Count));
1108
1109 if FProcessingTemplate then
1110 PCEType := ptTemplate
1111 else
1112 PCEType := ptReminder;
1113
1114 Process := TRUE;
1115 if(TmpList.Count > 0) then
1116 begin
1117 Msg := REQ_TXT + TmpList.Text;
1118 InfoBox(Msg, REQ_HDR, MB_OK);
1119 Process := FALSE;
1120 end
1121 else
1122 begin
1123 TmpText := TStringList.Create;
1124 try
1125 if (not FProcessingTemplate) and (not InsertRemTextAtCursor) then
1126 RemForm.NewNoteRE.SelStart := MaxInt; // Move to bottom of note
1127 AddLine := FALSE;
1128 BeforeLine := SendMessage(RemForm.NewNoteRE.Handle, EM_EXLINEFROMCHAR, 0, RemForm.NewNoteRE.SelStart);
1129 if (SendMessage(RemForm.NewNoteRE.Handle, EM_LINEINDEX, BeforeLine, 0) <> RemForm.NewNoteRE.SelStart) then
1130 begin
1131 RemForm.NewNoteRE.SelStart := SendMessage(RemForm.NewNoteRE.Handle, EM_LINEINDEX, BeforeLine+1, 0);
1132 inc(BeforeLine);
1133 end;
1134 if(RemForm.NewNoteRE.SelStart > 0) then
1135 begin
1136 if(RemForm.NewNoteRE.SelStart = 1) then
1137 AddLine := TRUE
1138 else
1139 begin
1140 TR.chrg.cpMin := RemForm.NewNoteRE.SelStart-2;
1141 TR.chrg.cpMax := TR.chrg.cpMin+2;
1142 TR.lpstrText := @buf;
1143 SendMessage(RemForm.NewNoteRE.Handle, EM_GETTEXTRANGE, 0, LPARAM(@TR));
1144 if(buf[0] <> #13) or (buf[1] <> #10) then
1145 AddLine := TRUE;
1146 end;
1147 end;
1148 if FProcessingTemplate then
1149 FReminder.AddText(TmpText)
1150 else
1151 begin
1152 for i := 0 to RemindersInProcess.Count-1 do
1153 TReminder(RemindersInProcess.Objects[i]).AddText(TmpText);
1154 end;
1155 if(TmpText.Count > 0) then
1156 begin
1157 if not FProcessingTemplate then
1158 begin
1159 tmp := ClinRemText;
1160 if(tmp <> '') then
1161 begin
1162 i := RemForm.NewNoteRE.Lines.IndexOf(tmp);
1163 if(i < 0) or (i > BeforeLine) then
1164 begin
1165 TmpText.Insert(0, tmp);
1166 if(RemForm.NewNoteRE.SelStart > 0) then
1167 TmpText.Insert(0, '');
1168 if(BeforeLine < RemForm.NewNoteRE.Lines.Count) then
1169 TmpText.Add('');
1170 end;
1171 end;
1172 end;
1173 if AddLine then
1174 TmpText.Insert(0, '');
1175// CheckBoilerplate4Fields(TmpText, 'Unresolved template fields from processed Reminder Dialog(s)'); <-- original line. //kt 8/21/2007
1176 CheckBoilerplate4Fields(TmpText, DKLangConstW('fReminderDialog_Unresolved_template_fields_from_processed_Reminder_Dialogxsx')); //kt added 8/21/2007
1177 if TmpText.Count = 0 then
1178 Process := FALSE
1179 else
1180 begin
1181 if RemForm.PCEObj.NeedProviderInfo and MissingProviderInfo(RemForm.PCEObj, PCEType) then
1182 Process := FALSE
1183 else
1184 RemForm.NewNoteRE.SelText := TmpText.Text;
1185 end;
1186 end;
1187 if(Process) then
1188 begin
1189 SendMessage(RemForm.NewNoteRE.Handle, EM_SCROLLCARET, 0, 0);
1190 AfterTop := SendMessage(RemForm.NewNoteRE.Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
1191 SendMessage(RemForm.NewNoteRE.Handle, EM_LINESCROLL, 0, -1 * (AfterTop - BeforeLine));
1192 end;
1193 finally
1194 TmpText.Free;
1195 end;
1196 end;
1197 if(Process) then
1198 begin
1199 PCEObj := RemForm.PCEObj;
1200 (* AGP CHANGE 23.2 Remove this section base on the Clinical Workgroup decision
1201 if FSCPrompt and (ndSC in PCEObj.NeededPCEData) then
1202 btnVisitClick(nil);
1203 PCEObj.SCRelated := FSCRelated;
1204 PCEObj.AORelated := FAORelated;
1205 PCEObj.IRRelated := FIRRelated;
1206 PCEObj.ECRelated := FECRelated;
1207 PCEObj.MSTRelated := FMSTRelated;
1208 PCEObj.HNCRelated := FHNCRelated;
1209 PCEObj.CVRelated := FCVRelated; *)
1210 if not FProcessingTemplate then
1211 begin
1212 for i := 0 to RemindersInProcess.Count-1 do
1213 begin
1214 Reminder := TReminder(RemindersInProcess.Objects[i]);
1215 if(Reminder.Processing) and (ProcessedReminders.IndexOf(Reminder.RemData) < 0) then
1216 ProcessedReminders.Add(Copy(Reminder.RemData,2,MaxInt));
1217 end;
1218 end;
1219 OrderList := TStringList.Create;
1220 try
1221 MHList := TStringList.Create;
1222 try
1223 StoreVitals := TRUE;
1224 VitalList := TStringList.Create;
1225 try
1226 WHList := TStringList.Create;
1227 try
1228 MSTList := TStringList.Create;
1229 try
1230 TmpData := TORStringList.Create;
1231 try
1232 UserStr := '';
1233 LastDate := U;
1234 LastLoc := U;
1235 VisitParent := '';
1236 HistData := nil;
1237 for Hist := FALSE to TRUE do
1238 begin
1239 TmpData.Clear;
1240 if FProcessingTemplate then
1241 i := GetReminderData(FReminder, TmpData, TRUE, Hist)
1242 else
1243 GetReminderData(TmpData, TRUE, Hist);
1244 if(TmpData.Count > 0) then
1245 begin
1246 if Hist then
1247 TmpData.SortByPieces([pnumVisitDate, pnumVisitLoc])
1248 else
1249 TmpData.Sort;
1250 TmpData.RemoveDuplicates;
1251 TmpList.Clear;
1252 for i := 0 to TmpData.Count-1 do
1253 begin
1254 if(Hist) then
1255 begin
1256 CurDate := Piece(TmpData[i], U, pnumVisitDate);
1257 CurLoc := Piece(TmpData[i], U, pnumVisitLoc);
1258 if(CurDate = '') then CurDate := FloatToStr(Encounter.DateTime);
1259 if(LastDate <> CurDate) or (LastLoc <> CurLoc) then
1260 begin
1261 if(assigned(HistData)) then
1262 begin
1263 HistData.Save;
1264 HistData.Free;
1265 end;
1266 LastDate := CurDate;
1267 LastLoc := CurLoc;
1268 HistData := TPCEData.Create;
1269 HistData.DateTime := MakeFMDateTime(CurDate);
1270 HistData.VisitCategory := 'E';
1271 if(VisitParent = '') then
1272 VisitParent := GetVisitIEN(RemForm.NoteList.ItemIEN);
1273 HistData.Parent := VisitParent;
1274 if(StrToIntDef(CurLoc,0) = 0) then
1275 CurLoc := '0' + U + CurLoc;
1276 HistData.HistoricalLocation := CurLoc;
1277 PCEObj := HistData;
1278 end;
1279 end;
1280 Cat := TPCEDataCat(ord(TmpData[i][1]) - ord('A'));
1281 //check this for multiple process
1282 //RData := TRemData(TmpData.Objects[i]);
1283 if Cat = pdcHF then
1284 begin
1285 if not FProcessingTemplate and
1286 (GecRemIen <> TRemData(TmpData.Objects[i]).Parent.Reminder.IEN) then
1287 begin
1288 GecRemIen := TRemData(TmpData.Objects[i]).Parent.Reminder.IEN;
1289 GecRemStr := CheckGECValue('R' + GecRemIen, PCEObj.NoteIEN);
1290 //SetPiece(TmpData.Strings[i],U,11,GecRemStr);
1291 end;
1292 if FProcessingTemplate then
1293 begin
1294 if GecRemIen <> Rem.IEN then
1295 begin
1296 GecRemIen := Rem.IEN;
1297 GecRemStr := CheckGECValue(Rem.IEN, PCEObj.NoteIEN)
1298 end;
1299 end;
1300 end;
1301 case Cat of
1302 // pdcVisit:
1303 pdcDiag: Add(TPCEDiag);
1304 pdcProc: Add(TPCEProc);
1305 pdcImm: Add(TPCEImm);
1306 pdcSkin: Add(TPCESkin);
1307 pdcPED: Add(TPCEPat);
1308 pdcHF: Add(TPCEHealth);
1309 pdcExam: Add(TPCEExams);
1310
1311
1312 pdcVital:
1313 if (StoreVitals) then
1314 begin
1315 Tmp := Piece(TmpData[i], U, 2);
1316 for v := low(TValidVitalTypes) to high(TValidVitalTypes) do
1317 begin
1318 if(Tmp = VitalCodes[v]) then
1319 begin
1320 if(UserStr = '') then
1321 UserStr := GetVitalUser;
1322
1323 if(FVitalsDate = 0) then
1324 begin
1325 FVitalsDate := TRemData(TmpData.Objects[i]).Parent.VitalDateTime;
1326 StoreVitals := ValidVitalsDate(FVitalsDate, TRUE, FALSE); //AGP Change 26.1
1327 if (not StoreVitals) then break;
1328 end;
1329
1330 Tmp := GetVitalStr(v, Piece(TmpData[i], U, 3), '', UserStr, FloatToStr(FVitalsDate));
1331 if(Tmp <> '') then
1332 VitalList.Add(Tmp);
1333 break;
1334 end;
1335 end;
1336 end;
1337
1338 pdcOrder: OrderList.Add(TmpData[i]);
1339 pdcMH: MHList.Add(TmpData[i]);
1340 pdcWHR:
1341 begin
1342 WHNode := TmpData.Strings[i];
1343 SetPiece(WHNode,U,11,TRemData(TmpData.Objects[i]).Parent.WHResultChk);
1344 WHList.Add(WHNode);
1345 end;
1346
1347 pdcWH:
1348 begin
1349 WHPrint := TRemData(TmpData.Objects[i]).Parent.WHPrintDevice;
1350 WHNode := TmpData.Strings[i];
1351 SetPiece(WHNode,U,11,TRemData(TmpData.Objects[i]).Parent.WHResultNot);
1352 SetPiece(WHNode,U,12,Piece(WHPrint,U,1));
1353 SetPiece(WHNode,U,13,TRemData(TmpData.Objects[i]).Parent.Reminder.WHReviewIEN); //AGP CHANGE 23.13
1354 WHList.Add(WHNode);
1355 end;
1356 end;
1357 end;
1358 if(Hist) then
1359 begin
1360 if(assigned(HistData)) then
1361 begin
1362 HistData.Save;
1363 HistData.Free;
1364 HistData := nil;
1365 end;
1366 end
1367 else
1368 begin
1369 while RemForm.PCEObj.NeedProviderInfo do
1370 MissingProviderInfo(RemForm.PCEObj, PCEType);
1371 RemForm.PCEObj.Save;
1372 VisitParent := GetVisitIEN(RemForm.NoteList.ItemIEN);
1373 end;
1374 end;
1375 end;
1376
1377 finally
1378 TmpData.Free;
1379 end;
1380
1381 for i := 0 to MSTList.Count-1 do
1382 SaveMSTData(MSTList[i]);
1383
1384 finally
1385 MSTList.Free;
1386 end;
1387
1388 if(StoreVitals) and (VitalList.Count > 0) then
1389 begin
1390 VitalList.Insert(0, VitalDateStr + FloatToStr(FVitalsDate));
1391 VitalList.Insert(1, VitalPatientStr + Patient.DFN);
1392 if IntToStr(Encounter.Location) <> '0' then //AGP change 26.9
1393 VitalList.Insert(2, VitalLocationStr + IntToStr(Encounter.Location))
1394 else
1395 VitalList.Insert(2, VitalLocationStr + IntToStr(RemForm.PCEObj.Location));;
1396 Tmp := ValAndStoreVitals(VitalList);
1397// if (Tmp <> 'True') then <-- original line. //kt 8/21/2007
1398 if (Tmp <> DKLangConstW('fReminderDialog_True')) then //kt added 8/21/2007
1399 showmessage(Tmp);
1400 end;
1401
1402 finally
1403 VitalList.Free;
1404 end;
1405
1406 if(MHList.Count > 0) then
1407 begin
1408 TestDate := 0;
1409 for i := 0 to MHList.Count-1 do
1410 begin
1411 try
1412 TestDate := StrToFloat(Piece(MHList[i],U,4));
1413 except
1414 on EConvertError do
1415 TestDate := 0
1416 else
1417 raise;
1418 end;
1419 if(TestDate > 0) then
1420 begin
1421 TestStaff := StrToInt64Def(Piece(MHList[i],U,5), 0);
1422 if TestStaff <= 0 then
1423 TestStaff := User.DUZ;
1424 if(Piece(MHList[i],U,3) = '1') then
1425 begin
1426 GAFScore := StrToIntDef(Piece(MHList[i],U,6),0);
1427 if(GAFScore > 0) then
1428 SaveGAFScore(GAFScore, TestDate, TestStaff);
1429 end
1430 else
1431 begin
1432 SaveMentalHealthTest(Piece(MHList[i],U,2), TestDate, TestStaff,
1433 Piece(MHList[i],U,6));
1434 end;
1435 end;
1436 end;
1437 end;
1438
1439 finally
1440 MHList.Free;
1441 end;
1442
1443 if(WHList.Count > 0) then
1444 begin
1445 WHResult :='';
1446 for i :=0 to WHList.Count-1 do
1447 begin
1448 WHNode := WHList.Strings[i];
1449 if (Pos('N', Piece(WHNode,U,1)) <> 0) then
1450 begin
1451 SetPiece(WHResult,U,1,'WHIEN:'+Piece(WHNode,U,2));
1452 SetPiece(WHResult,U,2,'DFN:'+Patient.DFN);
1453 SetPiece(WHResult,U,3,'WHRES:'+Piece(WHNode,U,11));
1454 SetPiece(WHResult,U,4,'Visit:'+Encounter.VisitStr);
1455 if (not assigned(WHArray)) then WHArray := TStringList.Create;
1456 WHArray.Add(WHResult);
1457 end;
1458 if (Pos('O', Piece(WHNode,U,1)) <> 0) then
1459 begin
1460 SetPiece(WHResult,U,1,'WHPur:'+Piece(WHNode,U,2));
1461 SetPiece(WHResult,U,2,Piece(WHNode,U,11));
1462 SetPiece(WHResult,U,3,Piece(WHNode,U,12));
1463 SetPiece(WHResult,U,4,'DFN:'+Patient.DFN);
1464 SetPiece(WHResult,U,5,Piece(WHNode,U,13)); //AGP CHANGE 23.13
1465 if (not assigned(WHArray)) then WHArray := TStringList.Create;
1466 WHArray.Add(WHResult);
1467 end;
1468 end;
1469 end;
1470 SaveWomenHealthData(WHArray);
1471 finally
1472 WHList.Free;
1473 end;
1474
1475 ResetProcessing(RemWipe);
1476 Hide;
1477 Kill := TRUE;
1478 RemForm.DisplayPCEProc;
1479
1480 // Process orders after PCE data saved in case of user input
1481 if(OrderList.Count > 0) then
1482 begin
1483 DelayEvent.EventType := 'C';
1484 DelayEvent.Specialty := 0;
1485 DelayEvent.Effective := 0;
1486 DelayEvent.PtEventIFN :=0;
1487 DelayEvent.EventIFN := 0;
1488 DoOrders := TRUE;
1489 repeat
1490 Done := TRUE;
1491 if not ReadyForNewOrder(DelayEvent) then
1492 begin
1493// if(InfoBox('Unable to place orders.','Retry Orders?', MB_RETRYCANCEL or MB_ICONWARNING) = IDRETRY) then <-- original line. //kt 8/21/2007
1494 if(InfoBox(DKLangConstW('fReminderDialog_Unable_to_place_ordersx'),DKLangConstW('fReminderDialog_Retry_Ordersx'), MB_RETRYCANCEL or MB_ICONWARNING) = IDRETRY) then //kt added 8/21/2007
1495 Done := FALSE
1496 else
1497 begin
1498 DoOrders := FALSE;
1499// ShowMessage('No Orders Placed.'); <-- original line. //kt 8/21/2007
1500 ShowMessage(DKLangConstW('fReminderDialog_No_Orders_Placedx')); //kt added 8/21/2007
1501 end;
1502 end;
1503 until(Done);
1504 if(DoOrders) then
1505 begin
1506 if(OrderList.Count = 1) then
1507 begin
1508 case CharAt(Piece(OrderList[0], U, 3), 1) of
1509 'A': ActivateAction( Piece(OrderList[0], U, 2), RemForm.Form, 0);
1510 'D', 'Q': ActivateOrderDialog(Piece(OrderList[0], U, 2), DelayEvent, RemForm.Form, 0);
1511 'M': ActivateOrderMenu( Piece(OrderList[0], U, 2), DelayEvent, RemForm.Form, 0);
1512 'O': ActivateOrderSet( Piece(OrderList[0], U, 2), DelayEvent, RemForm.Form, 0);
1513 end;
1514 end
1515 else
1516 begin
1517 for i := 0 to OrderList.Count-1 do
1518 begin
1519 tmp := Pieces(OrderList[i], U, 2, 4);
1520 OrderList[i] := tmp;
1521 end;
1522 ActivateOrderList(OrderList, DelayEvent, RemForm.Form, 0, '', '');
1523 end;
1524 end;
1525 end;
1526 finally
1527 OrderList.Free;
1528 end;
1529 end;
1530 finally
1531 TmpList.Free;
1532 end;
1533 finally
1534 if not FProcessingTemplate then
1535 ProcessedReminders.Notifier.EndUpdate(ProcessedReminders.Count <> OldRemCount);
1536 end;
1537 finally
1538 if(Kill) then
1539 begin
1540 FExitOK := TRUE;
1541 Close;
1542 end;
1543 end;
1544end;
1545
1546procedure TfrmRemDlg.ResetProcessing(Wipe: string = ''); //AGP CHANGE 24.8
1547var
1548 i: integer;
1549 RemWipeArray : TStringlist;
1550
1551begin
1552 if FProcessingTemplate then
1553 KillObj(@FReminder)
1554 else
1555 begin
1556 while(RemindersInProcess.Count > 0) do
1557 begin
1558 RemindersInProcess.Notifier.BeginUpdate;
1559 try
1560 RemindersInProcess.KillObjects;
1561 RemindersInProcess.Clear;
1562 finally
1563 FReminder := nil;
1564 RemindersInProcess.Notifier.EndUpdate(TRUE);
1565 end;
1566 end;
1567 end;
1568 ClearControls(TRUE);
1569 PositionTrees('');
1570 //AGP Change 24.8 Add wipe section for reminder wipe
1571 If Wipe <> '' then
1572 begin
1573 RemWipeArray := TStringlist.Create;
1574 if pos(U,Wipe)>0 then
1575 begin
1576 for i:=0 to ReminderDialogInfo.Count-1 do
1577 begin
1578 if pos(ReminderDialogInfo.Strings[i],Wipe)>0 then
1579 begin
1580 RemWipeArray.Add(ReminderDialogInfo.Strings[i]);
1581 end;
1582 end;
1583 end
1584 else
1585 begin
1586 RemWipeArray.Add(Wipe);
1587 end;
1588
1589 if assigned(RemWipeArray) then
1590 begin
1591 for i:=0 to RemWipeArray.Count-1 do
1592 KillDlg(@ReminderDialogInfo, RemWipeArray.Strings[i], True);
1593 end;
1594 if (assigned(RemWipeArray)) then
1595 begin
1596 RemWipeArray.Clear ;
1597 RemWipeArray.Free;
1598 end;
1599 end;
1600end;
1601
1602
1603procedure TfrmRemDlg.RemindersChanged(Sender: TObject);
1604begin
1605 UpdateButtons;
1606end;
1607
1608procedure TfrmRemDlg.btnClinMaintClick(Sender: TObject);
1609begin
1610 if(not assigned(FClinMainBox)) then
1611 begin
1612 FClinMainBox := ModelessReportBox(DetailReminder(StrToIntDef(FReminder.IEN,0)),
1613 ClinMaintText + ': ' + FReminder.PrintName, TRUE);
1614 FOldClinMaintOnDestroy := FClinMainBox.OnDestroy;
1615 FClinMainBox.OnDestroy := ClinMaintDestroyed;
1616 UpdateButtons;
1617 end;
1618end;
1619
1620procedure TfrmRemDlg.ClinMaintDestroyed(Sender: TObject);
1621begin
1622 if(assigned(FOldClinMaintOnDestroy)) then
1623 FOldClinMaintOnDestroy(Sender);
1624 FClinMainBox := nil;
1625 UpdateButtons;
1626end;
1627
1628procedure TfrmRemDlg.btnVisitClick(Sender: TObject);
1629var
1630 frmRemVisitInfo: TfrmRemVisitInfo;
1631 VitalsDate: TFMDateTime;
1632
1633begin
1634 if FVitalsDate = 0 then
1635 VitalsDate := FMNow //AGP Change 26.1
1636 else
1637 VitalsDate := FVitalsDate;
1638 frmRemVisitInfo := TfrmRemVisitInfo.Create(Self);
1639 try
1640 frmRemVisitInfo.fraVisitRelated.InitAllow(FSCCond);
1641 frmRemVisitInfo.fraVisitRelated.InitRelated(FSCRelated, FAORelated,
1642 FIRRelated, FECRelated, FMSTRelated, FHNCRelated, FCVRelated);
1643 frmRemVisitInfo.dteVitals.FMDateTime := VitalsDate;
1644 frmRemVisitInfo.ShowModal;
1645 if frmRemVisitInfo.ModalResult = mrOK then
1646 begin
1647 VitalsDate := frmRemVisitInfo.dteVitals.FMDateTime;
1648 if VitalsDate <= FMNow then
1649 FVitalsDate := VitalsDate;
1650 frmRemVisitInfo.fraVisitRelated.GetRelated(FSCRelated, FAORelated,
1651 FIRRelated, FECRelated, FMSTRelated, FHNCRelated, FCVRelated);
1652 FSCPrompt := FALSE;
1653 UpdateText(nil);
1654 end;
1655 finally
1656 frmRemVisitInfo.Free;
1657 end;
1658end;
1659
1660procedure TfrmRemDlg.ProcessTemplate(Template: TTemplate);
1661begin
1662 FProcessingTemplate := TRUE;
1663 btnClear.Visible := FALSE;
1664 btnClinMaint.Visible := FALSE;
1665 btnBack.Visible := FALSE;
1666 btnNext.Visible := FALSE;
1667 FReminder := TReminderDialog.Create(Template.ReminderDialogIEN + U + Template.PrintName + U +
1668 Template.ReminderWipe); //AGP CHANGE 24.8
1669 ClearControls(TRUE);
1670 FReminder.PCEDataObj := RemForm.PCEObj;
1671 BuildControls;
1672 UpdateText(nil);
1673 UpdateButtons;
1674 Show;
1675end;
1676
1677procedure TfrmRemDlg.SetFontSize;
1678begin
1679 ResizeAnchoredFormToFont(frmRemDlg);
1680 if Assigned(FClinMainBox) then
1681 ResizeAnchoredFormToFont(FClinMainBox);
1682 BuildControls;
1683end;
1684
1685
1686{ AGP Change 24.8 You MUST pass an address to an object variable to get KillObj to work }
1687procedure TfrmRemDlg.KillDlg(ptr: Pointer; ID: string; KillObjects: boolean = FALSE);
1688var
1689 Obj: TObject;
1690 Lst: TList;
1691 SLst: TStringList;
1692 i: integer;
1693
1694begin
1695 Obj := TObject(ptr^);
1696 if(assigned(Obj)) then
1697 begin
1698 if(KillObjects) then
1699 begin
1700 if(Obj is TList) then
1701 begin
1702 Lst := TList(Obj);
1703 for i := Lst.count-1 downto 0 do
1704 if assigned(Lst[i]) then
1705 TObject(Lst[i]).Free;
1706 end
1707 else
1708 if(Obj is TStringList) then
1709 begin
1710 SLst := TStringList(Obj);
1711 //Check to see if the Reminder IEN is in the of IEN to be wipe out
1712 for i := SLst.count-1 downto 0 do
1713 if assigned(SLst.Objects[i]) and (pos(Slst.Strings[i],ID)>0) then
1714 SLst.Objects[i].Free;
1715 end;
1716 end;
1717 Obj.Free;
1718 TObject(ptr^) := nil;
1719 end;
1720end;
1721
1722procedure TfrmRemDlg.FormShow(Sender: TObject);
1723begin
1724 //Set The form to it's Saved Position
1725 Left := RemDlgLeft;
1726 Top := RemDlgTop;
1727 Width := RemDlgWidth;
1728 Height := RemDlgHeight;
1729end;
1730
1731initialization
1732
1733finalization
1734 KillReminderDialog(nil);
1735 KillObj(@PositionList);
1736
1737end.
Note: See TracBrowser for help on using the repository browser.