source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/fReminderDialog.pas@ 1737

Last change on this file since 1737 was 1693, checked in by healthsevak, 10 years ago

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