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

Last change on this file since 1085 was 541, checked in by Kevin Toppenberg, 15 years ago

TMG Ver 1.1 Added HTML Support, better demographics editing
File size: 60.3 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 HTMLEditing : boolean; //kt 8/09
994
995 procedure Add(PCEItemClass: TPCEItemClass);
996 var
997 itm: TPCEItem;
998 tmp: string;
999
1000 begin
1001 if(Cat in MSTDataTypes) then
1002 begin
1003 tmp := piece(TmpData[i],U,pnumMST);
1004 if (tmp <> '') then
1005 begin
1006 MSTList.Add(tmp);
1007 tmp := TmpData[i];
1008 setpiece(tmp,U,pnumMST,'');
1009 TmpData[i] := tmp;
1010 end;
1011 end;
1012 itm := PCEItemClass.Create;
1013 try
1014 itm.SetFromString(copy(TmpData[i], 2, MaxInt));
1015 TmpList.AddObject('',itm);
1016 if Cat = pdcHF then itm.FGecRem := GecRemStr;
1017 case Cat of
1018 pdcDiag: PCEObj.SetDiagnoses(TmpList, FALSE);
1019 pdcProc: PCEObj.SetProcedures(TmpList, FALSE);
1020 pdcImm: PCEObj.SetImmunizations(TmpList, FALSE);
1021 pdcSkin: PCEObj.SetSkinTests(TmpList, FALSE);
1022 pdcPED: PCEObj.SetPatientEds(TmpList, FALSE);
1023 pdcHF: PCEObj.SetHealthFactors(TmpList, FALSE);
1024 pdcExam: PCEObj.SetExams(TmpList, FALSE);
1025 end;
1026 itm.Free;
1027 TmpList.Clear;
1028 except
1029 itm.free;
1030 end;
1031 end;
1032
1033 procedure SaveMSTData(MSTVal: string);
1034 var
1035 vdate, s1, s2, prov, FType, FIEN: string;
1036
1037 begin
1038 if MSTVal <> '' then
1039 begin
1040 s1 := piece(MSTVal, ';', 1);
1041 vdate := piece(MSTVal, ';', 2);
1042 prov := piece(MSTVal, ';', 3);
1043 FIEN := piece(MSTVal, ';', 4);
1044 if FIEN <> '' then
1045 begin
1046 s2 := s1;
1047 s1 := '';
1048 FType := RemDataCodes[dtExam];
1049 end
1050 else
1051 begin
1052 s2 := '';
1053 FType := RemDataCodes[dtHealthFactor];
1054 end;
1055 SaveMSTDataFromReminder(vdate, s1, Prov, FType, FIEN, s2);
1056 end;
1057 end;
1058
1059begin
1060 SetupVars; //kt
1061 Kill := FALSE;
1062 GecRemIen := '0';
1063 WHList := nil;
1064 Rem := nil;
1065 RemWipe := ''; //AGP CHANGE 24.8
1066 try
1067 OldRemCount := ProcessedReminders.Count;
1068 if not FProcessingTemplate then
1069 ProcessedReminders.Notifier.BeginUpdate;
1070 try
1071 TmpList := TStringList.Create;
1072 try
1073 i := 0;
1074 repeat
1075 //AGP Added RemWipe section this section will determine if the Dialog is a patient specific
1076 if FProcessingTemplate or (i < RemindersInProcess.Count) then begin
1077 if FProcessingTemplate then begin
1078 Rem := FReminder;
1079 if Rem.RemWipe = 1 then
1080 RemWipe := Piece(Rem.DlgData,U,1);
1081 end else begin
1082 Rem := TReminder(RemindersInProcess.Objects[i]);
1083 if TReminderDialog(TReminder(RemindersInProcess.Objects[i])).RemWipe = 1 then begin
1084 if RemWipe ='' then RemWipe := TReminder(RemindersInProcess.Objects[i]).IEN
1085 else RemWipe := RemWipe + U + TReminder(RemindersInProcess.Objects[i]).IEN;
1086 end;
1087 end;
1088
1089 Flds := FALSE;
1090 OldCount := TmpList.Count;
1091 Rem.FinishProblems(TmpList, Flds);
1092 if(OldCount <> TmpList.Count) or Flds then begin
1093 TmpList.Insert(OldCount, '');
1094 if not FProcessingTemplate then
1095// TmpList.Insert(OldCount+1, ' Reminder: ' + Rem.PrintName); <-- original line. //kt 8/21/2007
1096 TmpList.Insert(OldCount+1, DKLangConstW('fReminderDialog_Reminderx') + Rem.PrintName); //kt added 8/21/2007
1097 if Flds then
1098 TmpList.Add(' ' + MissingFieldsTxt);
1099 end;
1100 inc(i);
1101 end;
1102 until(FProcessingTemplate or (i >= RemindersInProcess.Count));
1103
1104 if FProcessingTemplate then
1105 PCEType := ptTemplate
1106 else
1107 PCEType := ptReminder;
1108
1109 Process := TRUE;
1110 if(TmpList.Count > 0) then begin
1111 Msg := REQ_TXT + TmpList.Text;
1112 InfoBox(Msg, REQ_HDR, MB_OK);
1113 Process := FALSE;
1114 end else begin
1115 TmpText := TStringList.Create;
1116 try
1117 if (RemForm.Form is TfrmNotes) and Assigned(RemForm.NewNoteHTMLE) then begin //kt
1118 HTMLEditing := (vmHTML in TfrmNotes(RemForm.Form).ViewMode); //kt
1119 end else HTMLEditing := false; //kt
1120 if HTMLEditing then begin //kt added this entire block //kt
1121 if (not FProcessingTemplate) and (not InsertRemTextAtCursor) then begin //kt
1122 RemForm.NewNoteHTMLE.MoveCaretToEnd; //kt
1123 end; //kt
1124 AddLine := TRUE; //kt
1125 end else begin //kt (original code below)
1126 if (not FProcessingTemplate) and (not InsertRemTextAtCursor) then
1127 RemForm.NewNoteRE.SelStart := MaxInt; // Move to bottom of note
1128 AddLine := FALSE;
1129 BeforeLine := SendMessage(RemForm.NewNoteRE.Handle, EM_EXLINEFROMCHAR, 0, RemForm.NewNoteRE.SelStart);
1130 if (SendMessage(RemForm.NewNoteRE.Handle, EM_LINEINDEX, BeforeLine, 0) <> RemForm.NewNoteRE.SelStart) then 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 begin
1135 if(RemForm.NewNoteRE.SelStart = 1) then
1136 AddLine := TRUE
1137 else begin
1138 TR.chrg.cpMin := RemForm.NewNoteRE.SelStart-2;
1139 TR.chrg.cpMax := TR.chrg.cpMin+2;
1140 TR.lpstrText := @buf;
1141 SendMessage(RemForm.NewNoteRE.Handle, EM_GETTEXTRANGE, 0, LPARAM(@TR));
1142 if(buf[0] <> #13) or (buf[1] <> #10) then
1143 AddLine := TRUE;
1144 end;
1145 end;
1146 end; //kt 8/09
1147 if FProcessingTemplate then
1148 FReminder.AddText(TmpText)
1149 else begin
1150 for i := 0 to RemindersInProcess.Count-1 do
1151 TReminder(RemindersInProcess.Objects[i]).AddText(TmpText);
1152 end;
1153 if(TmpText.Count > 0) then begin
1154 if not FProcessingTemplate then begin
1155 tmp := ClinRemText;
1156 //kt if(tmp <> '') then begin
1157 if(tmp <> '') and (not HTMLEditing) then begin //kt 8/09
1158 i := RemForm.NewNoteRE.Lines.IndexOf(tmp);
1159 if(i < 0) or (i > BeforeLine) then begin
1160 TmpText.Insert(0, tmp);
1161 if(RemForm.NewNoteRE.SelStart > 0) then
1162 TmpText.Insert(0, '');
1163 if(BeforeLine < RemForm.NewNoteRE.Lines.Count) then
1164 TmpText.Add('');
1165 end;
1166 end;
1167 end;
1168 if AddLine then
1169 TmpText.Insert(0, '');
1170// CheckBoilerplate4Fields(TmpText, 'Unresolved template fields from processed Reminder Dialog(s)'); <-- original line. //kt 8/21/2007
1171 CheckBoilerplate4Fields(TmpText, DKLangConstW('fReminderDialog_Unresolved_template_fields_from_processed_Reminder_Dialogxsx')); //kt added 8/21/2007
1172 if TmpText.Count = 0 then
1173 Process := FALSE
1174 else begin
1175 if RemForm.PCEObj.NeedProviderInfo and MissingProviderInfo(RemForm.PCEObj, PCEType) then
1176 Process := FALSE
1177 else begin
1178 If HTMLEditing then begin //kt 8/09
1179 for i := 0 to TmpText.count-1 do begin //kt 8/09
1180 RemForm.NewNoteHTMLE.InsertTextAtCaret(TmpText.Strings[i]+'<BR>'); //kt 8/09
1181 end; //kt 8/09
1182 end else begin //kt 8/09
1183 RemForm.NewNoteRE.SelText := TmpText.Text;
1184 end; //kt 8/09
1185 end;
1186 end;
1187 end;
1188 //kt if(Process) then begin
1189 if(Process) and (not HTMLEditing) then begin //kt
1190 SendMessage(RemForm.NewNoteRE.Handle, EM_SCROLLCARET, 0, 0);
1191 AfterTop := SendMessage(RemForm.NewNoteRE.Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
1192 SendMessage(RemForm.NewNoteRE.Handle, EM_LINESCROLL, 0, -1 * (AfterTop - BeforeLine));
1193 end;
1194 finally
1195 TmpText.Free;
1196 end;
1197 end;
1198 if(Process) then
1199 begin
1200 PCEObj := RemForm.PCEObj;
1201 (* AGP CHANGE 23.2 Remove this section base on the Clinical Workgroup decision
1202 if FSCPrompt and (ndSC in PCEObj.NeededPCEData) then
1203 btnVisitClick(nil);
1204 PCEObj.SCRelated := FSCRelated;
1205 PCEObj.AORelated := FAORelated;
1206 PCEObj.IRRelated := FIRRelated;
1207 PCEObj.ECRelated := FECRelated;
1208 PCEObj.MSTRelated := FMSTRelated;
1209 PCEObj.HNCRelated := FHNCRelated;
1210 PCEObj.CVRelated := FCVRelated; *)
1211 if not FProcessingTemplate then
1212 begin
1213 for i := 0 to RemindersInProcess.Count-1 do
1214 begin
1215 Reminder := TReminder(RemindersInProcess.Objects[i]);
1216 if(Reminder.Processing) and (ProcessedReminders.IndexOf(Reminder.RemData) < 0) then
1217 ProcessedReminders.Add(Copy(Reminder.RemData,2,MaxInt));
1218 end;
1219 end;
1220 OrderList := TStringList.Create;
1221 try
1222 MHList := TStringList.Create;
1223 try
1224 StoreVitals := TRUE;
1225 VitalList := TStringList.Create;
1226 try
1227 WHList := TStringList.Create;
1228 try
1229 MSTList := TStringList.Create;
1230 try
1231 TmpData := TORStringList.Create;
1232 try
1233 UserStr := '';
1234 LastDate := U;
1235 LastLoc := U;
1236 VisitParent := '';
1237 HistData := nil;
1238 for Hist := FALSE to TRUE do
1239 begin
1240 TmpData.Clear;
1241 if FProcessingTemplate then
1242 i := GetReminderData(FReminder, TmpData, TRUE, Hist)
1243 else
1244 GetReminderData(TmpData, TRUE, Hist);
1245 if(TmpData.Count > 0) then
1246 begin
1247 if Hist then
1248 TmpData.SortByPieces([pnumVisitDate, pnumVisitLoc])
1249 else
1250 TmpData.Sort;
1251 TmpData.RemoveDuplicates;
1252 TmpList.Clear;
1253 for i := 0 to TmpData.Count-1 do
1254 begin
1255 if(Hist) then
1256 begin
1257 CurDate := Piece(TmpData[i], U, pnumVisitDate);
1258 CurLoc := Piece(TmpData[i], U, pnumVisitLoc);
1259 if(CurDate = '') then CurDate := FloatToStr(Encounter.DateTime);
1260 if(LastDate <> CurDate) or (LastLoc <> CurLoc) then
1261 begin
1262 if(assigned(HistData)) then
1263 begin
1264 HistData.Save;
1265 HistData.Free;
1266 end;
1267 LastDate := CurDate;
1268 LastLoc := CurLoc;
1269 HistData := TPCEData.Create;
1270 HistData.DateTime := MakeFMDateTime(CurDate);
1271 HistData.VisitCategory := 'E';
1272 if(VisitParent = '') then
1273 VisitParent := GetVisitIEN(RemForm.NoteList.ItemIEN);
1274 HistData.Parent := VisitParent;
1275 if(StrToIntDef(CurLoc,0) = 0) then
1276 CurLoc := '0' + U + CurLoc;
1277 HistData.HistoricalLocation := CurLoc;
1278 PCEObj := HistData;
1279 end;
1280 end;
1281 Cat := TPCEDataCat(ord(TmpData[i][1]) - ord('A'));
1282 //check this for multiple process
1283 //RData := TRemData(TmpData.Objects[i]);
1284 if Cat = pdcHF then
1285 begin
1286 if not FProcessingTemplate and
1287 (GecRemIen <> TRemData(TmpData.Objects[i]).Parent.Reminder.IEN) then
1288 begin
1289 GecRemIen := TRemData(TmpData.Objects[i]).Parent.Reminder.IEN;
1290 GecRemStr := CheckGECValue('R' + GecRemIen, PCEObj.NoteIEN);
1291 //SetPiece(TmpData.Strings[i],U,11,GecRemStr);
1292 end;
1293 if FProcessingTemplate then
1294 begin
1295 if GecRemIen <> Rem.IEN then
1296 begin
1297 GecRemIen := Rem.IEN;
1298 GecRemStr := CheckGECValue(Rem.IEN, PCEObj.NoteIEN)
1299 end;
1300 end;
1301 end;
1302 case Cat of
1303 // pdcVisit:
1304 pdcDiag: Add(TPCEDiag);
1305 pdcProc: Add(TPCEProc);
1306 pdcImm: Add(TPCEImm);
1307 pdcSkin: Add(TPCESkin);
1308 pdcPED: Add(TPCEPat);
1309 pdcHF: Add(TPCEHealth);
1310 pdcExam: Add(TPCEExams);
1311
1312
1313 pdcVital:
1314 if (StoreVitals) then
1315 begin
1316 Tmp := Piece(TmpData[i], U, 2);
1317 for v := low(TValidVitalTypes) to high(TValidVitalTypes) do
1318 begin
1319 if(Tmp = VitalCodes[v]) then
1320 begin
1321 if(UserStr = '') then
1322 UserStr := GetVitalUser;
1323
1324 if(FVitalsDate = 0) then
1325 begin
1326 FVitalsDate := TRemData(TmpData.Objects[i]).Parent.VitalDateTime;
1327 StoreVitals := ValidVitalsDate(FVitalsDate, TRUE, FALSE); //AGP Change 26.1
1328 if (not StoreVitals) then break;
1329 end;
1330
1331 Tmp := GetVitalStr(v, Piece(TmpData[i], U, 3), '', UserStr, FloatToStr(FVitalsDate));
1332 if(Tmp <> '') then
1333 VitalList.Add(Tmp);
1334 break;
1335 end;
1336 end;
1337 end;
1338
1339 pdcOrder: OrderList.Add(TmpData[i]);
1340 pdcMH: MHList.Add(TmpData[i]);
1341 pdcWHR:
1342 begin
1343 WHNode := TmpData.Strings[i];
1344 SetPiece(WHNode,U,11,TRemData(TmpData.Objects[i]).Parent.WHResultChk);
1345 WHList.Add(WHNode);
1346 end;
1347
1348 pdcWH:
1349 begin
1350 WHPrint := TRemData(TmpData.Objects[i]).Parent.WHPrintDevice;
1351 WHNode := TmpData.Strings[i];
1352 SetPiece(WHNode,U,11,TRemData(TmpData.Objects[i]).Parent.WHResultNot);
1353 SetPiece(WHNode,U,12,Piece(WHPrint,U,1));
1354 SetPiece(WHNode,U,13,TRemData(TmpData.Objects[i]).Parent.Reminder.WHReviewIEN); //AGP CHANGE 23.13
1355 WHList.Add(WHNode);
1356 end;
1357 end;
1358 end;
1359 if(Hist) then
1360 begin
1361 if(assigned(HistData)) then
1362 begin
1363 HistData.Save;
1364 HistData.Free;
1365 HistData := nil;
1366 end;
1367 end
1368 else
1369 begin
1370 while RemForm.PCEObj.NeedProviderInfo do
1371 MissingProviderInfo(RemForm.PCEObj, PCEType);
1372 RemForm.PCEObj.Save;
1373 VisitParent := GetVisitIEN(RemForm.NoteList.ItemIEN);
1374 end;
1375 end;
1376 end;
1377
1378 finally
1379 TmpData.Free;
1380 end;
1381
1382 for i := 0 to MSTList.Count-1 do
1383 SaveMSTData(MSTList[i]);
1384
1385 finally
1386 MSTList.Free;
1387 end;
1388
1389 if(StoreVitals) and (VitalList.Count > 0) then
1390 begin
1391 VitalList.Insert(0, VitalDateStr + FloatToStr(FVitalsDate));
1392 VitalList.Insert(1, VitalPatientStr + Patient.DFN);
1393 if IntToStr(Encounter.Location) <> '0' then //AGP change 26.9
1394 VitalList.Insert(2, VitalLocationStr + IntToStr(Encounter.Location))
1395 else
1396 VitalList.Insert(2, VitalLocationStr + IntToStr(RemForm.PCEObj.Location));;
1397 Tmp := ValAndStoreVitals(VitalList);
1398// if (Tmp <> 'True') then <-- original line. //kt 8/21/2007
1399 if (Tmp <> DKLangConstW('fReminderDialog_True')) then //kt added 8/21/2007
1400 showmessage(Tmp);
1401 end;
1402
1403 finally
1404 VitalList.Free;
1405 end;
1406
1407 if(MHList.Count > 0) then
1408 begin
1409 TestDate := 0;
1410 for i := 0 to MHList.Count-1 do
1411 begin
1412 try
1413 TestDate := StrToFloat(Piece(MHList[i],U,4));
1414 except
1415 on EConvertError do
1416 TestDate := 0
1417 else
1418 raise;
1419 end;
1420 if(TestDate > 0) then
1421 begin
1422 TestStaff := StrToInt64Def(Piece(MHList[i],U,5), 0);
1423 if TestStaff <= 0 then
1424 TestStaff := User.DUZ;
1425 if(Piece(MHList[i],U,3) = '1') then
1426 begin
1427 GAFScore := StrToIntDef(Piece(MHList[i],U,6),0);
1428 if(GAFScore > 0) then
1429 SaveGAFScore(GAFScore, TestDate, TestStaff);
1430 end
1431 else
1432 begin
1433 SaveMentalHealthTest(Piece(MHList[i],U,2), TestDate, TestStaff,
1434 Piece(MHList[i],U,6));
1435 end;
1436 end;
1437 end;
1438 end;
1439
1440 finally
1441 MHList.Free;
1442 end;
1443
1444 if(WHList.Count > 0) then
1445 begin
1446 WHResult :='';
1447 for i :=0 to WHList.Count-1 do
1448 begin
1449 WHNode := WHList.Strings[i];
1450 if (Pos('N', Piece(WHNode,U,1)) <> 0) then
1451 begin
1452 SetPiece(WHResult,U,1,'WHIEN:'+Piece(WHNode,U,2));
1453 SetPiece(WHResult,U,2,'DFN:'+Patient.DFN);
1454 SetPiece(WHResult,U,3,'WHRES:'+Piece(WHNode,U,11));
1455 SetPiece(WHResult,U,4,'Visit:'+Encounter.VisitStr);
1456 if (not assigned(WHArray)) then WHArray := TStringList.Create;
1457 WHArray.Add(WHResult);
1458 end;
1459 if (Pos('O', Piece(WHNode,U,1)) <> 0) then
1460 begin
1461 SetPiece(WHResult,U,1,'WHPur:'+Piece(WHNode,U,2));
1462 SetPiece(WHResult,U,2,Piece(WHNode,U,11));
1463 SetPiece(WHResult,U,3,Piece(WHNode,U,12));
1464 SetPiece(WHResult,U,4,'DFN:'+Patient.DFN);
1465 SetPiece(WHResult,U,5,Piece(WHNode,U,13)); //AGP CHANGE 23.13
1466 if (not assigned(WHArray)) then WHArray := TStringList.Create;
1467 WHArray.Add(WHResult);
1468 end;
1469 end;
1470 end;
1471 SaveWomenHealthData(WHArray);
1472 finally
1473 WHList.Free;
1474 end;
1475
1476 ResetProcessing(RemWipe);
1477 Hide;
1478 Kill := TRUE;
1479 RemForm.DisplayPCEProc;
1480
1481 // Process orders after PCE data saved in case of user input
1482 if(OrderList.Count > 0) then
1483 begin
1484 DelayEvent.EventType := 'C';
1485 DelayEvent.Specialty := 0;
1486 DelayEvent.Effective := 0;
1487 DelayEvent.PtEventIFN :=0;
1488 DelayEvent.EventIFN := 0;
1489 DoOrders := TRUE;
1490 repeat
1491 Done := TRUE;
1492 if not ReadyForNewOrder(DelayEvent) then
1493 begin
1494// if(InfoBox('Unable to place orders.','Retry Orders?', MB_RETRYCANCEL or MB_ICONWARNING) = IDRETRY) then <-- original line. //kt 8/21/2007
1495 if(InfoBox(DKLangConstW('fReminderDialog_Unable_to_place_ordersx'),DKLangConstW('fReminderDialog_Retry_Ordersx'), MB_RETRYCANCEL or MB_ICONWARNING) = IDRETRY) then //kt added 8/21/2007
1496 Done := FALSE
1497 else
1498 begin
1499 DoOrders := FALSE;
1500// ShowMessage('No Orders Placed.'); <-- original line. //kt 8/21/2007
1501 ShowMessage(DKLangConstW('fReminderDialog_No_Orders_Placedx')); //kt added 8/21/2007
1502 end;
1503 end;
1504 until(Done);
1505 if(DoOrders) then
1506 begin
1507 if(OrderList.Count = 1) then
1508 begin
1509 case CharAt(Piece(OrderList[0], U, 3), 1) of
1510 'A': ActivateAction( Piece(OrderList[0], U, 2), RemForm.Form, 0);
1511 'D', 'Q': ActivateOrderDialog(Piece(OrderList[0], U, 2), DelayEvent, RemForm.Form, 0);
1512 'M': ActivateOrderMenu( Piece(OrderList[0], U, 2), DelayEvent, RemForm.Form, 0);
1513 'O': ActivateOrderSet( Piece(OrderList[0], U, 2), DelayEvent, RemForm.Form, 0);
1514 end;
1515 end
1516 else
1517 begin
1518 for i := 0 to OrderList.Count-1 do
1519 begin
1520 tmp := Pieces(OrderList[i], U, 2, 4);
1521 OrderList[i] := tmp;
1522 end;
1523 ActivateOrderList(OrderList, DelayEvent, RemForm.Form, 0, '', '');
1524 end;
1525 end;
1526 end;
1527 finally
1528 OrderList.Free;
1529 end;
1530 end;
1531 finally
1532 TmpList.Free;
1533 end;
1534 finally
1535 if not FProcessingTemplate then
1536 ProcessedReminders.Notifier.EndUpdate(ProcessedReminders.Count <> OldRemCount);
1537 end;
1538 finally
1539 if(Kill) then
1540 begin
1541 FExitOK := TRUE;
1542 Close;
1543 end;
1544 end;
1545end;
1546
1547procedure TfrmRemDlg.ResetProcessing(Wipe: string = ''); //AGP CHANGE 24.8
1548var
1549 i: integer;
1550 RemWipeArray : TStringlist;
1551
1552begin
1553 if FProcessingTemplate then
1554 KillObj(@FReminder)
1555 else
1556 begin
1557 while(RemindersInProcess.Count > 0) do
1558 begin
1559 RemindersInProcess.Notifier.BeginUpdate;
1560 try
1561 RemindersInProcess.KillObjects;
1562 RemindersInProcess.Clear;
1563 finally
1564 FReminder := nil;
1565 RemindersInProcess.Notifier.EndUpdate(TRUE);
1566 end;
1567 end;
1568 end;
1569 ClearControls(TRUE);
1570 PositionTrees('');
1571 //AGP Change 24.8 Add wipe section for reminder wipe
1572 If Wipe <> '' then
1573 begin
1574 RemWipeArray := TStringlist.Create;
1575 if pos(U,Wipe)>0 then
1576 begin
1577 for i:=0 to ReminderDialogInfo.Count-1 do
1578 begin
1579 if pos(ReminderDialogInfo.Strings[i],Wipe)>0 then
1580 begin
1581 RemWipeArray.Add(ReminderDialogInfo.Strings[i]);
1582 end;
1583 end;
1584 end
1585 else
1586 begin
1587 RemWipeArray.Add(Wipe);
1588 end;
1589
1590 if assigned(RemWipeArray) then
1591 begin
1592 for i:=0 to RemWipeArray.Count-1 do
1593 KillDlg(@ReminderDialogInfo, RemWipeArray.Strings[i], True);
1594 end;
1595 if (assigned(RemWipeArray)) then
1596 begin
1597 RemWipeArray.Clear ;
1598 RemWipeArray.Free;
1599 end;
1600 end;
1601end;
1602
1603
1604procedure TfrmRemDlg.RemindersChanged(Sender: TObject);
1605begin
1606 UpdateButtons;
1607end;
1608
1609procedure TfrmRemDlg.btnClinMaintClick(Sender: TObject);
1610begin
1611 if(not assigned(FClinMainBox)) then
1612 begin
1613 FClinMainBox := ModelessReportBox(DetailReminder(StrToIntDef(FReminder.IEN,0)),
1614 ClinMaintText + ': ' + FReminder.PrintName, TRUE);
1615 FOldClinMaintOnDestroy := FClinMainBox.OnDestroy;
1616 FClinMainBox.OnDestroy := ClinMaintDestroyed;
1617 UpdateButtons;
1618 end;
1619end;
1620
1621procedure TfrmRemDlg.ClinMaintDestroyed(Sender: TObject);
1622begin
1623 if(assigned(FOldClinMaintOnDestroy)) then
1624 FOldClinMaintOnDestroy(Sender);
1625 FClinMainBox := nil;
1626 UpdateButtons;
1627end;
1628
1629procedure TfrmRemDlg.btnVisitClick(Sender: TObject);
1630var
1631 frmRemVisitInfo: TfrmRemVisitInfo;
1632 VitalsDate: TFMDateTime;
1633
1634begin
1635 if FVitalsDate = 0 then
1636 VitalsDate := FMNow //AGP Change 26.1
1637 else
1638 VitalsDate := FVitalsDate;
1639 frmRemVisitInfo := TfrmRemVisitInfo.Create(Self);
1640 try
1641 frmRemVisitInfo.fraVisitRelated.InitAllow(FSCCond);
1642 frmRemVisitInfo.fraVisitRelated.InitRelated(FSCRelated, FAORelated,
1643 FIRRelated, FECRelated, FMSTRelated, FHNCRelated, FCVRelated);
1644 frmRemVisitInfo.dteVitals.FMDateTime := VitalsDate;
1645 frmRemVisitInfo.ShowModal;
1646 if frmRemVisitInfo.ModalResult = mrOK then
1647 begin
1648 VitalsDate := frmRemVisitInfo.dteVitals.FMDateTime;
1649 if VitalsDate <= FMNow then
1650 FVitalsDate := VitalsDate;
1651 frmRemVisitInfo.fraVisitRelated.GetRelated(FSCRelated, FAORelated,
1652 FIRRelated, FECRelated, FMSTRelated, FHNCRelated, FCVRelated);
1653 FSCPrompt := FALSE;
1654 UpdateText(nil);
1655 end;
1656 finally
1657 frmRemVisitInfo.Free;
1658 end;
1659end;
1660
1661procedure TfrmRemDlg.ProcessTemplate(Template: TTemplate);
1662begin
1663 FProcessingTemplate := TRUE;
1664 btnClear.Visible := FALSE;
1665 btnClinMaint.Visible := FALSE;
1666 btnBack.Visible := FALSE;
1667 btnNext.Visible := FALSE;
1668 FReminder := TReminderDialog.Create(Template.ReminderDialogIEN + U + Template.PrintName + U +
1669 Template.ReminderWipe); //AGP CHANGE 24.8
1670 ClearControls(TRUE);
1671 FReminder.PCEDataObj := RemForm.PCEObj;
1672 BuildControls;
1673 UpdateText(nil);
1674 UpdateButtons;
1675 Show;
1676end;
1677
1678procedure TfrmRemDlg.SetFontSize;
1679begin
1680 ResizeAnchoredFormToFont(frmRemDlg);
1681 if Assigned(FClinMainBox) then
1682 ResizeAnchoredFormToFont(FClinMainBox);
1683 BuildControls;
1684end;
1685
1686
1687{ AGP Change 24.8 You MUST pass an address to an object variable to get KillObj to work }
1688procedure TfrmRemDlg.KillDlg(ptr: Pointer; ID: string; KillObjects: boolean = FALSE);
1689var
1690 Obj: TObject;
1691 Lst: TList;
1692 SLst: TStringList;
1693 i: integer;
1694
1695begin
1696 Obj := TObject(ptr^);
1697 if(assigned(Obj)) then
1698 begin
1699 if(KillObjects) then
1700 begin
1701 if(Obj is TList) then
1702 begin
1703 Lst := TList(Obj);
1704 for i := Lst.count-1 downto 0 do
1705 if assigned(Lst[i]) then
1706 TObject(Lst[i]).Free;
1707 end
1708 else
1709 if(Obj is TStringList) then
1710 begin
1711 SLst := TStringList(Obj);
1712 //Check to see if the Reminder IEN is in the of IEN to be wipe out
1713 for i := SLst.count-1 downto 0 do
1714 if assigned(SLst.Objects[i]) and (pos(Slst.Strings[i],ID)>0) then
1715 SLst.Objects[i].Free;
1716 end;
1717 end;
1718 Obj.Free;
1719 TObject(ptr^) := nil;
1720 end;
1721end;
1722
1723procedure TfrmRemDlg.FormShow(Sender: TObject);
1724begin
1725 //Set The form to it's Saved Position
1726 Left := RemDlgLeft;
1727 Top := RemDlgTop;
1728 Width := RemDlgWidth;
1729 Height := RemDlgHeight;
1730end;
1731
1732initialization
1733
1734finalization
1735 KillReminderDialog(nil);
1736 KillObj(@PositionList);
1737
1738end.
Note: See TracBrowser for help on using the repository browser.