source: cprs/trunk/CPRS-Chart/fReminderDialog.pas@ 1245

Last change on this file since 1245 was 830, checked in by Kevin Toppenberg, 14 years ago

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