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

Last change on this file since 1595 was 460, checked in by Kevin Toppenberg, 17 years ago

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