source: cprs/branches/foia-cprs/CPRS-Chart/fReminderDialog.pas@ 459

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

Adding foia-cprs branch

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