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

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

Initial upload of TMG-CPRS 1.0.26.69

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