VistA-cprs/CPRS-Chart/fReminderDialog.pas

1864 lines
62 KiB
Plaintext
Raw Normal View History

unit fReminderDialog;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, ORFn, StdCtrls, ComCtrls, Buttons, ORCtrls, uReminders, uConst,
2010-07-07 16:51:54 -04:00
ORClasses, fRptBox, Menus, rPCE, uTemplates,fBase508Form,
VA508AccessibilityManager, fMHTest, fFrame;
type
2010-07-07 16:51:54 -04:00
TfrmRemDlg = class(TfrmBase508Form)
sb1: TScrollBox;
sb2: TScrollBox;
splTxtData: TSplitter;
pnlFrmBottom: TPanel;
pnlBottom: TPanel;
splText: TSplitter;
reData: TRichEdit;
reText: TRichEdit;
pnlButtons: TORAutoPanel;
btnClear: TButton;
btnBack: TButton;
btnCancel: TButton;
btnNext: TButton;
btnFinish: TButton;
btnClinMaint: TButton;
btnVisit: TButton;
2010-07-07 16:51:54 -04:00
lblFootnotes: TLabel;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure sbResize(Sender: TObject);
procedure btnClearClick(Sender: TObject);
procedure btnCancelClick(Sender: TObject);
procedure ProcessReminderFromNodeStr(value: string);
procedure btnNextClick(Sender: TObject);
procedure btnBackClick(Sender: TObject);
procedure btnFinishClick(Sender: TObject);
procedure btnClinMaintClick(Sender: TObject);
procedure btnVisitClick(Sender: TObject);
procedure KillDlg(ptr: Pointer; ID: string; KillObjects: boolean = FALSE);
procedure FormShow(Sender: TObject);
procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); //AGP Change 24.8
private
FSCCond: TSCConditions;
FSCPrompt: boolean;
FVitalsDate: TFMDateTime;
FSCRelated: integer;
FAORelated: integer;
FIRRelated: integer;
FECRelated: integer;
FMSTRelated: integer;
FHNCRelated: integer;
FCVRelated: integer;
2010-07-07 16:51:54 -04:00
FSHDRelated: integer;
FLastWidth: integer;
FUseBox2: boolean;
FExitOK: boolean;
FReminder: TReminderDialog;
CurReminderList: TORStringList;
FClinMainBox: TfrmReportBox;
FOldClinMaintOnDestroy: TNotifyEvent;
FProcessingTemplate: boolean;
FSilent: boolean;
protected
procedure RemindersChanged(Sender: TObject);
procedure ClearControls(All: boolean = FALSE);
procedure BuildControls;
function GetBox(Other: boolean = FALSE): TScrollBox;
function KillAll: boolean;
procedure ResetProcessing(Wipe: string = ''); //AGP CHANGE 24.8;
procedure BoxUpdateDone;
procedure ControlsChanged(Sender: TObject);
procedure UMResyncRem(var Message: TMessage); message UM_RESYNCREM;
procedure UpdateText(Sender: TObject);
function GetCurReminderList: integer;
function NextReminder: string;
function BackReminder: string;
procedure UpdateButtons;
procedure PositionTrees(NodeID: string);
procedure ClinMaintDestroyed(Sender: TObject);
procedure ProcessTemplate(Template: TTemplate);
procedure ClearMHTest(Rien: string);
public
procedure ProcessReminder(ARemData: string; NodeID: string);
procedure SetFontSize;
property Silent: boolean read FSilent write FSilent;
end;
procedure ViewReminderDialog(RemNode: TORTreeNode; InitDlg: boolean = TRUE);
procedure ViewReminderDialogTemplate(TempNode: TORTreeNode; InitDlg: boolean = TRUE);
procedure ViewRemDlgTemplateFromForm(OwningForm: TForm; Template: TTemplate;
InitDlg, IsTemplate: boolean);
procedure HideReminderDialog;
procedure UpdateReminderFinish;
procedure KillReminderDialog(frm: TForm);
procedure NotifyWhenProcessingReminderChanges(Proc: TNotifyEvent);
procedure RemoveNotifyWhenProcessingReminderChanges(Proc: TNotifyEvent);
function ReminderDialogActive: boolean;
function CurrentReminderInDialog: TReminderDialog;
var
frmRemDlg: TfrmRemDlg = nil;
RemDlgSpltr1: integer = 0;
RemDlgSpltr2: integer = 0;
RemDlgLeft: integer = 0;
RemDlgTop: integer = 0;
RemDlgWidth: integer = 0;
RemDlgHeight: integer = 0;
const
RemDlgName = 'frmRemDlg';
RemDlgSplitters = 'frmRemDlgSplitters';
implementation
uses fNotes, uPCE, uOrders, rOrders, uCore, rMisc, rReminders,
fReminderTree, uVitals, rVitals, RichEdit, fConsults, fTemplateDialog,
2010-07-07 16:51:54 -04:00
uTemplateFields, fRemVisitInfo, rCore, uVA508CPRSCompatibility,
VA508AccessibilityRouter, VAUtils;
{$R *.DFM}
var
PositionList: TORNotifyList = nil;
ClinRemTextLocation: integer = -77;
ClinRemTextStr: string = '';
const
REQ_TXT = 'The following required items must be entered:' + CRLF;
REQ_HDR = 'Required Items Missing';
function ClinRemText: string;
begin
if(ClinRemTextLocation <> Encounter.Location) then
begin
ClinRemTextLocation := Encounter.Location;
ClinRemTextStr := GetProgressNoteHeader;
end;
Result := ClinRemTextStr;
end;
procedure NotifyWhenProcessingReminderChanges(Proc: TNotifyEvent);
begin
if(not assigned(PositionList)) then
PositionList := TORNotifyList.Create;
PositionList.Add(Proc);
end;
procedure RemoveNotifyWhenProcessingReminderChanges(Proc: TNotifyEvent);
begin
if(assigned(PositionList)) then
PositionList.Remove(Proc);
end;
function ReminderDialogActive: boolean;
begin
Result := assigned(frmRemDlg);
end;
function CurrentReminderInDialog: TReminderDialog;
begin
Result := nil;
if(assigned(frmRemDlg)) then
Result := frmRemDlg.FReminder;
end;
2010-07-07 16:51:54 -04:00
var
uRemDlgStarting: boolean = False;
procedure ViewRemDlgFromForm(OwningForm: TForm; RemNode: TORTreeNode; Template: TTemplate;
InitDlg, IsTemplate: boolean);
var
Update: boolean;
Err: string;
begin
2010-07-07 16:51:54 -04:00
if uRemDlgStarting then exit; // CQ#16219 - double click started reminder creation twice
uRemDlgStarting := True;
try
Err := '';
if assigned(frmRemDlg) then
begin
2010-07-07 16:51:54 -04:00
if IsTemplate then
Err := 'Can not process template while another reminder dialog is being processed.'
else
2010-07-07 16:51:54 -04:00
if frmRemDlg.FProcessingTemplate then
Err := 'Can not process reminder while a reminder dialog template is being processed.'
end;
Update := FALSE;
if Err = '' then
begin
if(RemForm.Form <> OwningForm) then
begin
2010-07-07 16:51:54 -04:00
if(assigned(RemForm.Form)) then
Err := 'Reminders currently begin processed on another tab.'
else
2010-07-07 16:51:54 -04:00
begin
if(OwningForm = frmNotes) then
begin
frmNotes.AssignRemForm;
if FutureEncounter(RemForm.PCEObj) then Err := 'Can not process a reminder dialog for a future encounter date.';
end
2010-07-07 16:51:54 -04:00
else
if(OwningForm = frmConsults) then
frmConsults.AssignRemForm
else
Err := 'Can not process reminder dialogs on this tab.';
Update := TRUE;
end;
end;
end;
if (Err = '') and (FutureEncounter(RemForm.PCEObj)) then
Err := 'Can not process a reminder dialog for a future encounter date.';
2010-07-07 16:51:54 -04:00
if Err <> '' then
begin
InfoBox(Err, 'Reminders in Process', MB_OK or MB_ICONERROR);
exit;
end;
2010-07-07 16:51:54 -04:00
if(InitDlg and (not assigned(frmRemDlg))) then
begin
//(AGP add) Check for a bad encounter date
if RemForm.PCEObj.DateTime < 0 then
begin
InfoBox('The parent note has an invalid encounter date. Please contact IRM support for assistance.','Warning',MB_OK);
exit;
end;
frmRemDlg := TfrmRemDlg.Create(Application);
frmRemDlg.SetFontSize;
Update := TRUE;
end;
if(assigned(frmRemDlg)) then
begin
if Update then
begin
2010-07-07 16:51:54 -04:00
frmRemDlg.FSCRelated := RemForm.PCEObj.SCRelated;
frmRemDlg.FAORelated := RemForm.PCEObj.AORelated;
frmRemDlg.FIRRelated := RemForm.PCEObj.IRRelated;
frmRemDlg.FECRelated := RemForm.PCEObj.ECRelated;
frmRemDlg.FMSTRelated := RemForm.PCEObj.MSTRelated;
frmRemDlg.FHNCRelated := RemForm.PCEObj.HNCRelated;
frmRemDlg.FCVRelated := RemForm.PCEObj.CVRelated;
frmRemDlg.FSHDRelated := RemForm.PCEObj.SHADRelated;
end;
2010-07-07 16:51:54 -04:00
UpdateReminderFinish;
if IsTemplate then
frmRemDlg.ProcessTemplate(Template)
else if assigned(RemNode) then
frmRemDlg.ProcessReminder(RemNode.StringData, RemNode.TreeView.GetNodeID(RemNode, 1, IncludeParentID));
end;
2010-07-07 16:51:54 -04:00
finally
uRemDlgStarting := False;
end;
end;
procedure ViewRemDlg(RemNode: TORTreeNode; InitDlg, IsTemplate: boolean);
var
own: TComponent;
begin
if assigned(RemNode) then
begin
own := RemNode.TreeView.Owner.Owner; // Owner is the Drawers, Owner.Owner is the Tab
if(not (own is TForm)) then
InfoBox('ViewReminderDialog called from an unsupported location.',
'Reminders in Process', MB_OK or MB_ICONERROR)
else
ViewRemDlgFromForm(TForm(own), RemNode, TTemplate(RemNode.Data), InitDlg, IsTemplate);
end;
end;
procedure ViewReminderDialog(RemNode: TORTreeNode; InitDlg: boolean = TRUE);
begin
if(assigned(RemNode)) then
ViewRemDlg(RemNode, InitDlg, FALSE)
else
HideReminderDialog;
end;
procedure ViewReminderDialogTemplate(TempNode: TORTreeNode; InitDlg: boolean = TRUE);
begin
if(assigned(TempNode) and (assigned(TempNode.Data)) and
(TTemplate(TempNode.Data).IsReminderDialog)) then
ViewRemDlg(TempNode, InitDlg, TRUE)
else
KillReminderDialog(nil);
end;
procedure ViewRemDlgTemplateFromForm(OwningForm: TForm; Template: TTemplate; InitDlg, IsTemplate: boolean);
begin
if(assigned(OwningForm) and assigned(Template) and Template.IsReminderDialog) then
ViewRemDlgFromForm(OwningForm, nil, Template, InitDlg, IsTemplate)
else
KillReminderDialog(nil);
end;
procedure HideReminderDialog;
begin
if(assigned(frmRemDlg)) then
frmRemDlg.Hide;
end;
procedure UpdateReminderFinish;
begin
if(assigned(frmRemDlg)) and (assigned(RemForm.Form)) then
begin
frmRemDlg.btnFinish.Enabled := RemForm.CanFinishProc;
frmRemDlg.UpdateButtons;
end;
end;
procedure KillReminderDialog(frm: TForm);
begin
if(assigned(frm) and (assigned(RemForm.Form)) and
(frm <> RemForm.Form)) then exit;
if(assigned(frmRemDlg)) then
begin
frmRemDlg.FExitOK := TRUE;
frmRemDlg.ResetProcessing;
end;
KillObj(@frmRemDlg);
end;
{ TfrmRemDlg }
procedure TfrmRemDlg.ProcessReminder(ARemData: string; NodeID: string);
var
Rem: TReminder;
TmpList: TStringList;
Msg: string;
Flds, Abort: boolean;
begin
FProcessingTemplate := FALSE;
Rem := GetReminder(ARemData);
if(FReminder <> Rem) then
begin
if(assigned(FReminder)) then
begin
Abort := FALSE;
Flds := FALSE;
TmpList := TStringList.Create;
try
FReminder.FinishProblems(TmpList, Flds);
if(TmpList.Count > 0) or Flds then
begin
TmpList.Insert(0, ' Reminder: ' + FReminder.PrintName);
if Flds then
TmpList.Add(' ' + MissingFieldsTxt);
Msg := REQ_TXT + TmpList.Text + CRLF +
' Ignore required items and continue processing?';
Abort := (InfoBox(Msg, REQ_HDR, MB_YESNO or MB_DEFBUTTON2) = IDNO);
end;
finally
TmpList.Free;
end;
if(Abort) then exit;
end;
ClearControls(TRUE);
FReminder := Rem;
Rem.PCEDataObj := RemForm.PCEObj;
BuildControls;
UpdateText(nil);
end;
PositionTrees(NodeID);
UpdateButtons;
Show;
end;
procedure TfrmRemDlg.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caFree;
end;
procedure TfrmRemDlg.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
if(not FExitOK) then
CanClose := KillAll;
end;
procedure TfrmRemDlg.FormCreate(Sender: TObject);
begin
2010-07-07 16:51:54 -04:00
// reData.Color := ReadOnlyColor;
// reText.Color := ReadOnlyColor;
FSCCond := EligbleConditions;
(* FSCRelated := SCC_NA;
FAORelated := SCC_NA;
FIRRelated := SCC_NA; AGP Change 25.2
FECRelated := SCC_NA;
FMSTRelated := SCC_NA;
FHNCRelated := SCC_NA;
FCVRelated := SCC_NA;
with FSCCond do
FSCPrompt := (SCAllow or AOAllow or IRAllow or ECAllow or MSTAllow or HNCAllow or CVAllow); *)
NotifyWhenRemindersChange(RemindersChanged);
RemForm.Drawers.NotifyWhenRemTreeChanges(RemindersChanged);
KillReminderDialogProc := KillReminderDialog;
end;
procedure TfrmRemDlg.FormDestroy(Sender: TObject);
begin
if FProcessingTemplate then
KillObj(@FReminder);
KillObj(@FClinMainBox);
//Save the Position and Size of the Reminder Dialog
RemDlgLeft := Self.Left;
RemDlgTop := Self.Top;
RemDlgWidth := Self.Width;
RemDlgHeight := Self.Height;
RemDlgSpltr1 := pnlBottom.Height;
RemDlgSpltr2 := reData.Height;
// SaveDialogSplitterPos(Name + 'Splitters', pnlBottom.Height, reData.Height);
RemForm.Drawers.RemoveNotifyWhenRemTreeChanges(RemindersChanged);
RemoveNotifyRemindersChange(RemindersChanged);
KillReminderDialogProc := nil;
ClearControls(TRUE);
frmRemDlg := nil;
if(assigned(frmReminderTree)) then
frmReminderTree.EnableActions;
RemForm.Form := nil;
end;
procedure TfrmRemDlg.FormMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
var
box: TScrollBox;
begin
box := GetBox(TRUE);
If RectContains(box.BoundsRect, box.ScreenToClient(MousePos)) then
begin
ScrollControl(box, (WheelDelta > 0));
Handled := True;
end;
end;
procedure TfrmRemDlg.ClearControls(All: boolean = FALSE);
procedure WipeOutControls(const Ctrl: TWinControl);
var
i: integer;
begin
for i := Ctrl.ControlCount-1 downto 0 do
begin
if(Ctrl.Controls[i].Owner = Self) then
begin
if(Ctrl.Controls[i] is TWinControl) then
WipeOutControls(TWinControl(Ctrl.Controls[i]));
Ctrl.Controls[i].Free
end;
end;
end;
begin
if(All) then
begin
WipeOutControls(sb1);
WipeOutControls(sb2);
end
else
WipeOutControls(GetBox);
end;
procedure TfrmRemDlg.ClearMHTest(Rien: string);
var
MHKillArray: TStringList;
i,idx, j: integer;
TestName: string;
begin
MHKillArray := TStringList.Create;
idx := RemindersInProcess.IndexOf(RIEN);
//Find All MH Test in the current Reminders and stored them in a temp Array
if idx > -1 then
begin
if (TReminderDialog(TReminder(RemindersInProcess.Objects[idx])).MHTestArray <> nil) and
(TReminderDialog(TReminder(RemindersInProcess.Objects[idx])).MHTestArray.Count > 0) then
begin
for j := 0 to TReminderDialog(TReminder(RemindersInProcess.Objects[idx])).MHTestArray.Count - 1 do
begin
TestName := Piece(TReminderDialog(TReminder(RemindersInProcess.Objects[idx])).MHTestArray.Strings[j], U, 1);
//TReminderDialog(TReminder(RemindersInProcess.Objects[idx])).MHTestArray.Delete(j);
MHKillArray.Add(TestName);
end;
end;
if Assigned(TReminderDialog(TReminder(RemindersInProcess.Objects[idx])).MHTestArray) then
TReminderDialog(TReminder(RemindersInProcess.Objects[idx])).MHTestArray.Free;
(* if (TReminderDialog(TReminder(RemindersInProcess.Objects[idx])).MHTestArray <> nil) and
(TReminderDialog(TReminder(RemindersInProcess.Objects[idx])).MHTestArray.Count = 0) then
TReminderDialog(TReminder(RemindersInProcess.Objects[idx])).MHTestArray.Free; *)
end;
//Check to see if other reminders contains any of the MH test in the temp Array if so set entry to null
if (MHKillArray.Count > 0) and (RemindersInProcess.Count > 1) then
begin
for I := 0 to RemindersInProcess.Count - 1 do
begin
if (TReminderDialog(TReminder(RemindersInProcess.Objects[i])).IEN <> RIEN) and
(TReminderDialog(TReminder(RemindersInProcess.Objects[i])).MHTestArray <> nil) and
(TReminderDialog(TReminder(RemindersInProcess.Objects[i])).MHTestArray.Count > 0) then
begin
for j := 0 to TReminderDialog(TReminder(RemindersInProcess.Objects[i])).MHTestArray.Count - 1 do
begin
TestName := Piece(TReminderDialog(TReminder(RemindersInProcess.Objects[i])).MHTestArray.Strings[j], U, 1);
idx := MHKillArray.IndexOf(TestName);
if idx > -1 then MHKillArray.Strings[idx] := '';
end;
end;
end;
end;
//Delete the temp file stored in the MH dll for any MH tests names left in the temp array
if MHKillArray.Count > 0 then
begin
for I := 0 to MHKillArray.Count - 1 do
begin
if MHKillArray.Strings[i] <> '' then RemoveMHTest(MHKillArray.Strings[i]);
end;
end;
if Assigned(MHKillArray) then FreeandNil(MHKillArray);
end;
procedure TfrmRemDlg.BuildControls;
var
i, CtrlIdx, Y, ParentWidth: integer;
AutoCtrl, Active, Ctrl: TWinControl;
LastCB, LastObjCnt: integer;
Box: TScrollBox;
txt: string;
function IsOnBox(Component: TComponent): boolean;
var
Prnt: TWinControl;
begin
Result := FALSE;
if(Component is TWinControl) then
begin
Prnt := TWinControl(Component).Parent;
while(assigned(Prnt)) and (not Result) do
begin
Result := (Prnt = Box);
Prnt := Prnt.Parent;
end;
end;
end;
procedure SetActiveVars(ActCtrl: TWinControl);
var
i: integer;
begin
LastObjCnt := 0;
LastCB := 0;
Active := ActCtrl;
while(assigned(Active) and (Active.Owner <> Self)) do
begin
if(assigned(Active.Owner) and (Active.Owner is TWinControl)) then
Active := TWinControl(Active.Owner)
else
Active := nil;
end;
Ctrl := Active;
if(assigned(Ctrl) and IsOnBox(Ctrl)) then
begin
if(Active is TORCheckBox) then
LastCB := Active.Tag;
if(LastCB = 0) then
begin
CtrlIdx := -1;
for i := 0 to ComponentCount-1 do
begin
if(IsOnBox(Components[i])) then
begin
Ctrl := TWinControl(Components[i]);
if(Ctrl is TORCheckBox) and (Ctrl.Tag <> 0) then
CtrlIdx := i;
if(Ctrl = Active) and (CtrlIdx >= 0) then
begin
LastCB := Components[CtrlIdx].Tag;
LastObjCnt := (i - CtrlIdx);
break;
end;
end;
end;
end;
end;
end;
begin
if(assigned(FReminder)) then
begin
Box := GetBox(TRUE);
if Box.ControlCount > 0 then ClearControls; //AGP Change 26.1 this change should
//resolve the problem with Duplicate CheckBoxes
//appearing on some reminder dialogs CQ #2843
Y := Box.VertScrollBar.Position;
GetBox.VertScrollBar.Position := 0;
if FProcessingTemplate then
txt := 'Reminder Dialog Template'
else
txt := 'Reminder Resolution';
Caption := txt + ': ' + FReminder.PrintName;
FReminder.OnNeedRedraw := nil;
ParentWidth := Box.Width - ScrollBarWidth - 6;
SetActiveVars(ActiveControl);
AutoCtrl := FReminder.BuildControls(ParentWidth, GetBox, Self);
GetBox.VertScrollBar.Position := Y;
BoxUpdateDone;
if(LastCB <> 0) then
begin
Box := GetBox(TRUE);
if(assigned(AutoCtrl)) then
begin
AutoCtrl.SetFocus;
if(AutoCtrl is TORComboBox) then
TORComboBox(AutoCtrl).DroppedDown := TRUE;
end
else
for i := 0 to ComponentCount-1 do
begin
if(IsOnBox(Components[i])) then
begin
Ctrl := TWinControl(Components[i]);
if(Ctrl is TORCheckBox) and (Ctrl.Tag = LastCB) then
begin
if((i + LastObjCnt) < ComponentCount) and
(Components[i + LastObjCnt] is TWinControl) then
TWinControl(Components[i + LastObjCnt]).SetFocus;
break;
end;
end;
end;
end;
ClearControls;
2010-07-07 16:51:54 -04:00
FReminder.OnNeedRedraw := ControlsChanged;
FReminder.OnTextChanged := UpdateText;
end;
end;
function TfrmRemDlg.GetBox(Other: boolean = FALSE): TScrollBox;
begin
if(FUseBox2 xor Other) then
Result := sb2
else
Result := sb1;
end;
procedure TfrmRemDlg.BoxUpdateDone;
begin
sb2.Visible := FUseBox2;
sb1.Visible := not FUseBox2;
FUseBox2 := not FUseBox2;
2010-07-07 16:51:54 -04:00
ClearControls;
if ScreenReaderSystemActive then
amgrMain.RefreshComponents;
Application.ProcessMessages; // allows new ScrollBox to repaint
end;
procedure TfrmRemDlg.ControlsChanged(Sender: TObject);
begin
FLastWidth := GetBox(TRUE).ClientWidth;
{ This routine is fired as a result of clicking a checkbox. If we destroy
the checkbox here we get access violations because the checkbox code is
still processing the click event after calling this routine. By posting
a message we can guarantee that the checkbox is no longer processing the
click event when the message is handled, preventing access violations. }
PostMessage(Handle, UM_RESYNCREM, 0 ,0);
end;
procedure TfrmRemDlg.UMResyncRem(var Message: TMessage);
begin
BuildControls;
end;
procedure TfrmRemDlg.sbResize(Sender: TObject);
begin
{ If you remove this logic you will get an infinite loop in some cases }
if(FLastWidth <> GetBox(TRUE).ClientWidth) then
ControlsChanged(Sender);
end;
procedure TfrmRemDlg.UpdateText(Sender: TObject);
const
BadType = TPCEDataCat(-1);
var
TopIdx, i, LastPos, CurPos, TxtStart: integer;
Cat, LastCat: TPCEDataCat;
Rem: TReminderDialog;
TmpData: TORStringList;
Bold: boolean;
tmp: string;
begin
RedrawSuspend(reText.Handle);
try
TopIdx := SendMessage(reText.Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
reText.Clear;
LastPos := reText.SelStart;
reText.SelAttributes.Style := reText.SelAttributes.Style - [fsBold];
i := 0;
repeat
if FProcessingTemplate then
Rem := FReminder
else
Rem := TReminder(RemindersInProcess.Objects[i]);
Rem.AddText(reText.Lines);
reText.SelStart := MaxInt;
CurPos := reText.SelStart;
if(Rem = FReminder) then
begin
reText.SelStart := LastPos;
reText.SelLength := CurPos - LastPos;
reText.SelAttributes.Style := reText.SelAttributes.Style + [fsBold];
reText.SelLength := 0;
reText.SelStart := CurPos;
reText.SelAttributes.Style := reText.SelAttributes.Style - [fsBold];
end;
LastPos := CurPos;
inc(i);
until(FProcessingTemplate or (i >= RemindersInProcess.Count));
if((not FProcessingTemplate) and (reText.Lines.Count > 0)) then
begin
reText.Lines.Insert(0, ClinRemText);
reText.SelStart := 0;
reText.SelLength := length(ClinRemText);
reText.SelAttributes.Style := reText.SelAttributes.Style - [fsBold];
reText.SelLength := 0;
reText.SelStart := MaxInt;
end;
SendMessage(reText.Handle, EM_LINESCROLL, 0, TopIdx);
finally
RedrawActivate(reText.Handle);
end;
TmpData := TORStringList.Create;
try
reData.Clear;
LastCat := BadType;
tmp := RemForm.PCEObj.StrVisitType(FSCRelated, FAORelated, FIRRelated,
2010-07-07 16:51:54 -04:00
FECRelated, FMSTRelated, FHNCRelated, FCVRelated,FSHDRelated);
if FProcessingTemplate then
i := GetReminderData(FReminder, TmpData)
else
i := GetReminderData(TmpData);
if(tmp = '') and (i = 0) then
reData.Lines.insert(0,TX_NOPCE);
TmpData.Sort;
RedrawSuspend(reData.Handle);
try
TopIdx := SendMessage(reData.Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
reData.SelAttributes.Style := reData.SelAttributes.Style - [fsBold];
if tmp <> '' then
reData.SelText := tmp + CRLF;
i := 0;
while i < TmpData.Count do
begin
tmp := TmpData[i];
TxtStart := 2;
Bold := FALSE;
Cat := TPCEDataCat(ord(tmp[1]) - ord('A'));
if(LastCat <> Cat) or (Cat = pdcVital) then
begin
if(Cat = pdcVital) then
inc(TxtStart);
if(LastCat <> BadType) then
begin
reData.SelText := CRLF;
reData.SelStart := MaxInt;
end;
reData.SelText := PCEDataCatText[Cat];
reData.SelStart := MaxInt;
LastCat := Cat;
end
else
begin
reData.SelText := ', ';
reData.SelStart := MaxInt;
end;
repeat
if(TRemData(TmpData.Objects[i]).Parent.Reminder = FReminder) then
Bold := TRUE;
inc(i);
until (i >= TmpData.Count) or (TmpData[i] <> tmp);
if(Bold) then
reData.SelAttributes.Style := reData.SelAttributes.Style + [fsBold];
reData.SelText := copy(tmp, TxtStart, MaxInt);
reData.SelStart := MaxInt;
if(Bold) then
reData.SelAttributes.Style := reData.SelAttributes.Style - [fsBold];
end;
SendMessage(reData.Handle, EM_LINESCROLL, 0, TopIdx);
finally
RedrawActivate(reData.Handle);
end;
finally
TmpData.Free;
end;
end;
procedure TfrmRemDlg.btnClearClick(Sender: TObject);
var
Tmp, TmpNode: string;
i: integer;
OK: boolean;
begin
if(assigned(FReminder)) then
begin
2010-07-07 16:51:54 -04:00
try
self.btnClear.Enabled := false;
i := RemindersInProcess.IndexOf(FReminder.IEN);
if(i >= 0) then
begin
if(FReminder.Processing) then
OK := (InfoBox('Clear all reminder resolutions for ' + FReminder.PrintName,
'Clear Reminder Processing', MB_YESNO or MB_DEFBUTTON2) = ID_YES)
else
OK := TRUE;
if(OK) then
begin
ClearMHTest(Freminder.IEN);
RemindersInProcess.Delete(i);
Tmp := (FReminder as TReminder).RemData; // clear should never be active if template
TmpNode := (FReminder as TReminder).CurrentNodeID;
KillObj(@FReminder);
ProcessReminder(Tmp, TmpNode);
end;
end;
2010-07-07 16:51:54 -04:00
finally
self.btnClear.Enabled := true;
end;
end;
end;
procedure TfrmRemDlg.btnCancelClick(Sender: TObject);
begin
2010-07-07 16:51:54 -04:00
try
self.btnCancel.Enabled := false;
if(KillAll) then
begin
FExitOK := TRUE;
frmRemDlg.Release;
frmRemDlg := nil;
end;
2010-07-07 16:51:54 -04:00
finally
self.btnCancel.Enabled := true;
end;
end;
function TfrmRemDlg.KillAll: boolean;
var
i, cnt: integer;
msg, RemWipe: string;
//ClearMH: boolean;
begin
//AGP 25.11 Added RemWipe section to cancel button to
//flag the patient specific dialog to be destroy if not in process.
RemWipe := '';
//ClearMH := false;
if frmFrame.TimedOut = True then
begin
result := True;
Exit;
end;
if FProcessingTemplate or FSilent then
begin
Result := TRUE;
if FReminder.RemWipe = 1 then RemWipe := Piece(FReminder.DlgData,U,1);
if (FProcessingTemplate) and (FReminder.Processing) then
begin
msg := msg + ' ' + FReminder.PrintName + CRLF;
msg := 'The Following Reminders are being processed:' + CRLF + CRLF + msg;
msg := msg + CRLF + 'Canceling will cause all processing information to be lost.' + CRLF +
'Do you still want to cancel out of reminder processing?';
Result := (InfoBox(msg, 'Cancel Reminder Processing', MB_YESNO or MB_DEFBUTTON2) = ID_YES);
end;
end
else
begin
msg := '';
cnt := 0;
for i := 0 to RemindersInProcess.Count-1 do
begin
if TReminderDialog(TReminder(RemindersInProcess.Objects[i])).RemWipe = 1 then
begin
if RemWipe ='' then RemWipe := TReminder(RemindersInProcess.Objects[i]).IEN
else RemWipe := RemWipe + U + TReminder(RemindersInProcess.Objects[i]).IEN
end;
if(TReminder(RemindersInProcess.Objects[i]).Processing) then
begin
msg := msg + ' ' + TReminder(RemindersInProcess.Objects[i]).PrintName + CRLF;
inc(cnt);
end;
end;
if(msg <> '') then
begin
if(cnt > 1) then
msg := 'The Following Reminders are being processed:' + CRLF + CRLF + msg
else
msg := 'The Following Reminder is being processed: ' + CRLF + CRLF + msg;
msg := msg + CRLF + 'Canceling will cause all processing information to be lost.' + CRLF +
'Do you still want to cancel out of reminder processing?';
Result := (InfoBox(msg, 'Cancel Reminder Processing', MB_YESNO or MB_DEFBUTTON2) = ID_YES);
end
else
Result := TRUE;
end;
if(Result) then
2010-07-07 16:51:54 -04:00
begin
if FProcessingTemplate or FSilent then
2010-07-07 16:51:54 -04:00
begin
if (FReminder.MHTestArray <> nil) and (FReminder.MHTestArray.Count > 0) then
begin
(* if ClearMH = false then
begin
RemoveMHTest('');
ClearMH := true;
end; *)
RemoveMHTest('');
FReminder.MHTestArray.Free;
end;
end
else
begin
for i := 0 to RemindersInProcess.Count - 1 do
begin
if (TReminderDialog(TReminder(RemindersInProcess.Objects[i])).MHTestArray <> nil) and
(TReminderDialog(TReminder(RemindersInProcess.Objects[i])).MHTestArray.Count > 0) then
begin
(*if ClearMH = false then
begin
RemoveMHTest('');
ClearMH := true;
end; *)
RemoveMHTest('');
TReminderDialog(TReminder(RemindersInProcess.Objects[i])).MHTestArray.Free;
end;
end;
2010-07-07 16:51:54 -04:00
end;
ResetProcessing(RemWipe);
2010-07-07 16:51:54 -04:00
end;
end;
function TfrmRemDlg.GetCurReminderList: integer;
var
Sel, Node: TORTreeNode;
Data: string;
NodeCheck, Cur: boolean;
begin
Result := -1;
CurReminderList := TORStringList.Create;
Sel := TORTreeNode(RemForm.Drawers.tvReminders.Selected);
NodeCheck := (assigned(Sel) and assigned(FReminder) and
(Piece(Sel.StringData,U,1) = RemCode +FReminder.IEN));
Node := TORTreeNode(RemForm.Drawers.tvReminders.Items.GetFirstNode);
while assigned(Node) do
begin
Data := TORTreeNode(Node).StringData;
if(copy(Data, 1, 1) = RemCode) then
begin
delete(Data,1,1);
Data := Node.TreeView.GetNodeID(Node, 1, IncludeParentID) + U + Data;
if(NodeCheck) then
Cur := (Node = Sel)
else
Cur := (assigned(FReminder)) and (FReminder.IEN = Piece(Data,U,1));
if(Cur) then
Result := CurReminderList.Add(Data)
else
if(Piece(Data, U , 8) = '1') then
CurReminderList.Add(Data);
end;
Node := TORTreeNode(Node.GetNextVisible);
end;
end;
function TfrmRemDlg.NextReminder: string;
var
idx: integer;
begin
Result := '';
idx := GetCurReminderList;
try
inc(idx);
if(idx < CurReminderList.Count) then
Result := CurReminderList[idx];
finally
KillObj(@CurReminderList);
end;
end;
function TfrmRemDlg.BackReminder: string;
var
idx: integer;
begin
Result := '';
idx := GetCurReminderList;
try
dec(idx);
if(idx >= 0) then
Result := CurReminderList[idx];
finally
KillObj(@CurReminderList);
end;
end;
procedure TfrmRemDlg.ProcessReminderFromNodeStr(value: string);
var
NodeID: string;
Data: string;
i: integer;
begin
if(Value = '') then
begin
UpdateButtons;
exit;
end;
Data := Value;
i := pos(U, Data);
if(i = 0) then i := length(Data);
NodeID :=copy(Data,1,i-1);
delete(Data,1,i);
Data := RemCode + Data;
ProcessReminder(Data, NodeID);
end;
procedure TfrmRemDlg.btnNextClick(Sender: TObject);
begin
ProcessReminderFromNodeStr(NextReminder);
end;
procedure TfrmRemDlg.btnBackClick(Sender: TObject);
begin
ProcessReminderFromNodeStr(BackReminder);
end;
procedure TfrmRemDlg.UpdateButtons;
begin
if(assigned(frmRemDlg)) and (not FProcessingTemplate) then
begin
btnBack.Enabled := btnFinish.Enabled and (BackReminder <> '');
btnNext.Enabled := btnFinish.Enabled and (NextReminder <> '');
btnClinMaint.Enabled := (not assigned(FClinMainBox));
end;
end;
procedure TfrmRemDlg.PositionTrees(NodeID: string);
begin
if(assigned(PositionList)) and (not FProcessingTemplate) then
begin
if(assigned(FReminder)) then
(FReminder as TReminder).CurrentNodeID := NodeID;
PositionList.Notify(FReminder);
end;
end;
procedure TfrmRemDlg.btnFinishClick(Sender: TObject);
var
i, cnt, lcnt,OldRemCount, OldCount, T: integer;
CurDate, CurLoc: string;
LastDate, LastLoc: string;
Rem: TReminderDialog;
Reminder: TReminder;
// Prompt: TRemPrompt;
RData: TRemData;
TmpData: TORStringList;
OrderList: TStringList;
TmpText: TStringList;
TmpList: TStringList;
VitalList: TStringList;
MHList: TStringList;
WHList: TStringList;
MSTList: TStringList;
HistData, PCEObj: TPCEData;
Cat: TPCEDataCat;
VisitParent, Msg, tmp: string;
DelayEvent: TOrderDelayEvent;
Hist: boolean;
v: TVitalType;
UserStr: string;
BeforeLine, AfterTop: integer;
GAFScore: integer;
TestDate: TFMDateTime;
TestStaff: Int64;
DoOrders, Done, Kill, Flds: boolean;
TR: TEXTRANGE;
buf: array[0..3] of char;
AddLine: boolean;
Process, StoreVitals: boolean;
PCEType: TPCEType;
WHNode,WHPrint,WHResult,WHTmp, WHValue: String;
WHType: TStrings;
//Test: String;
2010-07-07 16:51:54 -04:00
MHLoc, WHCnt,x: Integer;
WHArray: TStringlist;
GecRemIen, GecRemStr, RemWipe: String;
procedure Add(PCEItemClass: TPCEItemClass);
var
itm: TPCEItem;
tmp: string;
begin
if(Cat in MSTDataTypes) then
begin
tmp := piece(TmpData[i],U,pnumMST);
if (tmp <> '') then
begin
MSTList.Add(tmp);
tmp := TmpData[i];
setpiece(tmp,U,pnumMST,'');
TmpData[i] := tmp;
end;
end;
itm := PCEItemClass.Create;
try
itm.SetFromString(copy(TmpData[i], 2, MaxInt));
TmpList.AddObject('',itm);
if Cat = pdcHF then itm.FGecRem := GecRemStr;
case Cat of
pdcDiag: PCEObj.SetDiagnoses(TmpList, FALSE);
pdcProc: PCEObj.SetProcedures(TmpList, FALSE);
pdcImm: PCEObj.SetImmunizations(TmpList, FALSE);
pdcSkin: PCEObj.SetSkinTests(TmpList, FALSE);
pdcPED: PCEObj.SetPatientEds(TmpList, FALSE);
pdcHF: PCEObj.SetHealthFactors(TmpList, FALSE);
pdcExam: PCEObj.SetExams(TmpList, FALSE);
end;
itm.Free;
TmpList.Clear;
except
itm.free;
end;
end;
procedure SaveMSTData(MSTVal: string);
var
vdate, s1, s2, prov, FType, FIEN: string;
begin
if MSTVal <> '' then
begin
s1 := piece(MSTVal, ';', 1);
vdate := piece(MSTVal, ';', 2);
prov := piece(MSTVal, ';', 3);
FIEN := piece(MSTVal, ';', 4);
if FIEN <> '' then
begin
s2 := s1;
s1 := '';
FType := RemDataCodes[dtExam];
end
else
begin
s2 := '';
FType := RemDataCodes[dtHealthFactor];
end;
SaveMSTDataFromReminder(vdate, s1, Prov, FType, FIEN, s2);
end;
end;
begin
Kill := FALSE;
GecRemIen := '0';
WHList := nil;
Rem := nil;
RemWipe := ''; //AGP CHANGE 24.8
try
2010-07-07 16:51:54 -04:00
self.btnFinish.Enabled := false;
OldRemCount := ProcessedReminders.Count;
if not FProcessingTemplate then
ProcessedReminders.Notifier.BeginUpdate;
try
TmpList := TStringList.Create;
try
i := 0;
repeat
//AGP Added RemWipe section this section will determine if the Dialog is a patient specific
if FProcessingTemplate or (i < RemindersInProcess.Count) then
begin
if FProcessingTemplate then
begin
Rem := FReminder;
if Rem.RemWipe = 1 then
RemWipe := Piece(Rem.DlgData,U,1);
end
else
begin
Rem := TReminder(RemindersInProcess.Objects[i]);
if TReminderDialog(TReminder(RemindersInProcess.Objects[i])).RemWipe = 1 then
begin
if RemWipe ='' then RemWipe := TReminder(RemindersInProcess.Objects[i]).IEN
else RemWipe := RemWipe + U + TReminder(RemindersInProcess.Objects[i]).IEN;
end;
end;
Flds := FALSE;
OldCount := TmpList.Count;
Rem.FinishProblems(TmpList, Flds);
if(OldCount <> TmpList.Count) or Flds then
begin
TmpList.Insert(OldCount, '');
if not FProcessingTemplate then
TmpList.Insert(OldCount+1, ' Reminder: ' + Rem.PrintName);
if Flds then
TmpList.Add(' ' + MissingFieldsTxt);
end;
inc(i);
end;
until(FProcessingTemplate or (i >= RemindersInProcess.Count));
if FProcessingTemplate then
PCEType := ptTemplate
else
PCEType := ptReminder;
Process := TRUE;
if(TmpList.Count > 0) then
begin
Msg := REQ_TXT + TmpList.Text;
InfoBox(Msg, REQ_HDR, MB_OK);
Process := FALSE;
end
else
begin
TmpText := TStringList.Create;
try
if (not FProcessingTemplate) and (not InsertRemTextAtCursor) then
RemForm.NewNoteRE.SelStart := MaxInt; // Move to bottom of note
AddLine := FALSE;
BeforeLine := SendMessage(RemForm.NewNoteRE.Handle, EM_EXLINEFROMCHAR, 0, RemForm.NewNoteRE.SelStart);
if (SendMessage(RemForm.NewNoteRE.Handle, EM_LINEINDEX, BeforeLine, 0) <> RemForm.NewNoteRE.SelStart) then
begin
RemForm.NewNoteRE.SelStart := SendMessage(RemForm.NewNoteRE.Handle, EM_LINEINDEX, BeforeLine+1, 0);
inc(BeforeLine);
end;
if(RemForm.NewNoteRE.SelStart > 0) then
begin
if(RemForm.NewNoteRE.SelStart = 1) then
AddLine := TRUE
else
begin
TR.chrg.cpMin := RemForm.NewNoteRE.SelStart-2;
TR.chrg.cpMax := TR.chrg.cpMin+2;
TR.lpstrText := @buf;
SendMessage(RemForm.NewNoteRE.Handle, EM_GETTEXTRANGE, 0, LPARAM(@TR));
if(buf[0] <> #13) or (buf[1] <> #10) then
AddLine := TRUE;
end;
end;
if FProcessingTemplate then
FReminder.AddText(TmpText)
else
begin
for i := 0 to RemindersInProcess.Count-1 do
TReminder(RemindersInProcess.Objects[i]).AddText(TmpText);
end;
if(TmpText.Count > 0) then
begin
if not FProcessingTemplate then
begin
tmp := ClinRemText;
if(tmp <> '') then
begin
i := RemForm.NewNoteRE.Lines.IndexOf(tmp);
if(i < 0) or (i > BeforeLine) then
begin
TmpText.Insert(0, tmp);
if(RemForm.NewNoteRE.SelStart > 0) then
TmpText.Insert(0, '');
if(BeforeLine < RemForm.NewNoteRE.Lines.Count) then
TmpText.Add('');
end;
end;
end;
if AddLine then
TmpText.Insert(0, '');
CheckBoilerplate4Fields(TmpText, 'Unresolved template fields from processed Reminder Dialog(s)');
if TmpText.Count = 0 then
Process := FALSE
else
begin
if RemForm.PCEObj.NeedProviderInfo and MissingProviderInfo(RemForm.PCEObj, PCEType) then
Process := FALSE
else
2010-07-07 16:51:54 -04:00
begin
RemForm.NewNoteRE.SelText := TmpText.Text;
2010-07-07 16:51:54 -04:00
SpeakTextInserted;
end;
end;
end;
if(Process) then
begin
SendMessage(RemForm.NewNoteRE.Handle, EM_SCROLLCARET, 0, 0);
AfterTop := SendMessage(RemForm.NewNoteRE.Handle, EM_GETFIRSTVISIBLELINE, 0, 0);
SendMessage(RemForm.NewNoteRE.Handle, EM_LINESCROLL, 0, -1 * (AfterTop - BeforeLine));
end;
finally
TmpText.Free;
end;
end;
if(Process) then
begin
PCEObj := RemForm.PCEObj;
(* AGP CHANGE 23.2 Remove this section base on the Clinical Workgroup decision
if FSCPrompt and (ndSC in PCEObj.NeededPCEData) then
btnVisitClick(nil);
PCEObj.SCRelated := FSCRelated;
PCEObj.AORelated := FAORelated;
PCEObj.IRRelated := FIRRelated;
PCEObj.ECRelated := FECRelated;
PCEObj.MSTRelated := FMSTRelated;
PCEObj.HNCRelated := FHNCRelated;
PCEObj.CVRelated := FCVRelated; *)
if not FProcessingTemplate then
begin
for i := 0 to RemindersInProcess.Count-1 do
begin
Reminder := TReminder(RemindersInProcess.Objects[i]);
if(Reminder.Processing) and (ProcessedReminders.IndexOf(Reminder.RemData) < 0) then
ProcessedReminders.Add(Copy(Reminder.RemData,2,MaxInt));
end;
end;
OrderList := TStringList.Create;
try
MHList := TStringList.Create;
try
StoreVitals := TRUE;
VitalList := TStringList.Create;
try
WHList := TStringList.Create;
try
MSTList := TStringList.Create;
try
TmpData := TORStringList.Create;
try
UserStr := '';
LastDate := U;
LastLoc := U;
VisitParent := '';
HistData := nil;
for Hist := FALSE to TRUE do
begin
TmpData.Clear;
if FProcessingTemplate then
i := GetReminderData(FReminder, TmpData, TRUE, Hist)
else
GetReminderData(TmpData, TRUE, Hist);
if(TmpData.Count > 0) then
begin
if Hist then
TmpData.SortByPieces([pnumVisitDate, pnumVisitLoc])
else
TmpData.Sort;
TmpData.RemoveDuplicates;
TmpList.Clear;
for i := 0 to TmpData.Count-1 do
begin
if(Hist) then
begin
CurDate := Piece(TmpData[i], U, pnumVisitDate);
CurLoc := Piece(TmpData[i], U, pnumVisitLoc);
if(CurDate = '') then CurDate := FloatToStr(Encounter.DateTime);
if(LastDate <> CurDate) or (LastLoc <> CurLoc) then
begin
if(assigned(HistData)) then
begin
HistData.Save;
HistData.Free;
end;
LastDate := CurDate;
LastLoc := CurLoc;
HistData := TPCEData.Create;
HistData.DateTime := MakeFMDateTime(CurDate);
HistData.VisitCategory := 'E';
if(VisitParent = '') then
VisitParent := GetVisitIEN(RemForm.NoteList.ItemIEN);
HistData.Parent := VisitParent;
if(StrToIntDef(CurLoc,0) = 0) then
CurLoc := '0' + U + CurLoc;
HistData.HistoricalLocation := CurLoc;
PCEObj := HistData;
end;
end;
Cat := TPCEDataCat(ord(TmpData[i][1]) - ord('A'));
//check this for multiple process
//RData := TRemData(TmpData.Objects[i]);
if Cat = pdcHF then
begin
if not FProcessingTemplate and
(GecRemIen <> TRemData(TmpData.Objects[i]).Parent.Reminder.IEN) then
begin
GecRemIen := TRemData(TmpData.Objects[i]).Parent.Reminder.IEN;
GecRemStr := CheckGECValue('R' + GecRemIen, PCEObj.NoteIEN);
//SetPiece(TmpData.Strings[i],U,11,GecRemStr);
end;
if FProcessingTemplate then
begin
if GecRemIen <> Rem.IEN then
begin
GecRemIen := Rem.IEN;
GecRemStr := CheckGECValue(Rem.IEN, PCEObj.NoteIEN)
end;
end;
end;
case Cat of
// pdcVisit:
pdcDiag: Add(TPCEDiag);
pdcProc: Add(TPCEProc);
pdcImm: Add(TPCEImm);
pdcSkin: Add(TPCESkin);
pdcPED: Add(TPCEPat);
pdcHF: Add(TPCEHealth);
pdcExam: Add(TPCEExams);
pdcVital:
if (StoreVitals) then
begin
Tmp := Piece(TmpData[i], U, 2);
for v := low(TValidVitalTypes) to high(TValidVitalTypes) do
begin
if(Tmp = VitalCodes[v]) then
begin
if(UserStr = '') then
UserStr := GetVitalUser;
if(FVitalsDate = 0) then
begin
FVitalsDate := TRemData(TmpData.Objects[i]).Parent.VitalDateTime;
StoreVitals := ValidVitalsDate(FVitalsDate, TRUE, FALSE); //AGP Change 26.1
if (not StoreVitals) then break;
end;
Tmp := GetVitalStr(v, Piece(TmpData[i], U, 3), '', UserStr, FloatToStr(FVitalsDate));
if(Tmp <> '') then
VitalList.Add(Tmp);
break;
end;
end;
end;
pdcOrder: OrderList.Add(TmpData[i]);
pdcMH: MHList.Add(TmpData[i]);
pdcWHR:
begin
WHNode := TmpData.Strings[i];
SetPiece(WHNode,U,11,TRemData(TmpData.Objects[i]).Parent.WHResultChk);
WHList.Add(WHNode);
end;
pdcWH:
begin
WHPrint := TRemData(TmpData.Objects[i]).Parent.WHPrintDevice;
WHNode := TmpData.Strings[i];
SetPiece(WHNode,U,11,TRemData(TmpData.Objects[i]).Parent.WHResultNot);
SetPiece(WHNode,U,12,Piece(WHPrint,U,1));
SetPiece(WHNode,U,13,TRemData(TmpData.Objects[i]).Parent.Reminder.WHReviewIEN); //AGP CHANGE 23.13
WHList.Add(WHNode);
end;
end;
end;
if(Hist) then
begin
if(assigned(HistData)) then
begin
HistData.Save;
HistData.Free;
HistData := nil;
end;
end
else
begin
while RemForm.PCEObj.NeedProviderInfo do
MissingProviderInfo(RemForm.PCEObj, PCEType);
RemForm.PCEObj.Save;
VisitParent := GetVisitIEN(RemForm.NoteList.ItemIEN);
end;
end;
end;
finally
TmpData.Free;
end;
for i := 0 to MSTList.Count-1 do
SaveMSTData(MSTList[i]);
finally
MSTList.Free;
end;
if(StoreVitals) and (VitalList.Count > 0) then
begin
VitalList.Insert(0, VitalDateStr + FloatToStr(FVitalsDate));
VitalList.Insert(1, VitalPatientStr + Patient.DFN);
if IntToStr(Encounter.Location) <> '0' then //AGP change 26.9
VitalList.Insert(2, VitalLocationStr + IntToStr(Encounter.Location))
else
VitalList.Insert(2, VitalLocationStr + IntToStr(RemForm.PCEObj.Location));;
Tmp := ValAndStoreVitals(VitalList);
if (Tmp <> 'True') then
2010-07-07 16:51:54 -04:00
ShowMsg(Tmp);
end;
finally
VitalList.Free;
end;
if(MHList.Count > 0) then
begin
TestDate := 0;
for i := 0 to MHList.Count-1 do
begin
try
TestDate := StrToFloat(Piece(MHList[i],U,4));
except
on EConvertError do
TestDate := 0
else
raise;
end;
if(TestDate > 0) then
begin
TestStaff := StrToInt64Def(Piece(MHList[i],U,5), 0);
if TestStaff <= 0 then
TestStaff := User.DUZ;
2010-07-07 16:51:54 -04:00
if (Piece(MHList[i],U,3) = '1') and (MHDLLFound = false) then
begin
GAFScore := StrToIntDef(Piece(MHList[i],U,6),0);
if(GAFScore > 0) then
SaveGAFScore(GAFScore, TestDate, TestStaff);
end
else
begin
2010-07-07 16:51:54 -04:00
if Piece(MHLIst[i],U,6) = 'New MH dll' then
begin
//The dll take date and time the original code took only date.
if Encounter.Location <> FReminder.PCEDataObj.Location then
MHLoc := FReminder.PCEDataObj.Location
else MHLoc := Encounter.Location;
saveMHTest(Piece(MHList[i],U,2), FloattoStr(FReminder.PCEDataObj.VisitDateTime), InttoStr(MHLoc));
end
else
SaveMentalHealthTest(Piece(MHList[i],U,2), TestDate, TestStaff,
Piece(MHList[i],U,6));
end;
end;
end;
end;
finally
MHList.Free;
2010-07-07 16:51:54 -04:00
if (FReminder.MHTestArray <> nil) and (FReminder.MHTestArray.Count > 0) then FReminder.MHTestArray.Free;
end;
if(WHList.Count > 0) then
begin
WHResult :='';
for i :=0 to WHList.Count-1 do
begin
WHNode := WHList.Strings[i];
if (Pos('N', Piece(WHNode,U,1)) <> 0) then
begin
SetPiece(WHResult,U,1,'WHIEN:'+Piece(WHNode,U,2));
SetPiece(WHResult,U,2,'DFN:'+Patient.DFN);
SetPiece(WHResult,U,3,'WHRES:'+Piece(WHNode,U,11));
SetPiece(WHResult,U,4,'Visit:'+Encounter.VisitStr);
if (not assigned(WHArray)) then WHArray := TStringList.Create;
WHArray.Add(WHResult);
end;
if (Pos('O', Piece(WHNode,U,1)) <> 0) then
begin
SetPiece(WHResult,U,1,'WHPur:'+Piece(WHNode,U,2));
SetPiece(WHResult,U,2,Piece(WHNode,U,11));
SetPiece(WHResult,U,3,Piece(WHNode,U,12));
SetPiece(WHResult,U,4,'DFN:'+Patient.DFN);
SetPiece(WHResult,U,5,Piece(WHNode,U,13)); //AGP CHANGE 23.13
if (not assigned(WHArray)) then WHArray := TStringList.Create;
WHArray.Add(WHResult);
end;
end;
end;
SaveWomenHealthData(WHArray);
finally
WHList.Free;
end;
ResetProcessing(RemWipe);
Hide;
Kill := TRUE;
RemForm.DisplayPCEProc;
// Process orders after PCE data saved in case of user input
if(OrderList.Count > 0) then
begin
DelayEvent.EventType := 'C';
DelayEvent.Specialty := 0;
DelayEvent.Effective := 0;
DelayEvent.PtEventIFN :=0;
DelayEvent.EventIFN := 0;
DoOrders := TRUE;
repeat
Done := TRUE;
if not ReadyForNewOrder(DelayEvent) then
begin
if(InfoBox('Unable to place orders.','Retry Orders?', MB_RETRYCANCEL or MB_ICONWARNING) = IDRETRY) then
Done := FALSE
else
begin
DoOrders := FALSE;
2010-07-07 16:51:54 -04:00
ShowMsg('No Orders Placed.');
end;
end;
until(Done);
if(DoOrders) then
begin
if(OrderList.Count = 1) then
begin
case CharAt(Piece(OrderList[0], U, 3), 1) of
'A': ActivateAction( Piece(OrderList[0], U, 2), RemForm.Form, 0);
'D', 'Q': ActivateOrderDialog(Piece(OrderList[0], U, 2), DelayEvent, RemForm.Form, 0);
'M': ActivateOrderMenu( Piece(OrderList[0], U, 2), DelayEvent, RemForm.Form, 0);
'O': ActivateOrderSet( Piece(OrderList[0], U, 2), DelayEvent, RemForm.Form, 0);
end;
end
else
begin
for i := 0 to OrderList.Count-1 do
begin
tmp := Pieces(OrderList[i], U, 2, 4);
OrderList[i] := tmp;
end;
ActivateOrderList(OrderList, DelayEvent, RemForm.Form, 0, '', '');
end;
end;
end;
finally
OrderList.Free;
end;
end;
finally
TmpList.Free;
end;
finally
if not FProcessingTemplate then
ProcessedReminders.Notifier.EndUpdate(ProcessedReminders.Count <> OldRemCount);
end;
finally
2010-07-07 16:51:54 -04:00
self.btnFinish.Enabled := true;
if(Kill) then
begin
FExitOK := TRUE;
Close;
end;
end;
end;
procedure TfrmRemDlg.ResetProcessing(Wipe: string = ''); //AGP CHANGE 24.8
var
i: integer;
RemWipeArray : TStringlist;
begin
if FProcessingTemplate then
KillObj(@FReminder)
else
begin
while(RemindersInProcess.Count > 0) do
begin
RemindersInProcess.Notifier.BeginUpdate;
try
RemindersInProcess.KillObjects;
RemindersInProcess.Clear;
finally
FReminder := nil;
RemindersInProcess.Notifier.EndUpdate(TRUE);
end;
end;
end;
ClearControls(TRUE);
PositionTrees('');
//AGP Change 24.8 Add wipe section for reminder wipe
If Wipe <> '' then
begin
RemWipeArray := TStringlist.Create;
if pos(U,Wipe)>0 then
begin
for i:=0 to ReminderDialogInfo.Count-1 do
begin
if pos(ReminderDialogInfo.Strings[i],Wipe)>0 then
begin
RemWipeArray.Add(ReminderDialogInfo.Strings[i]);
end;
end;
end
else
begin
RemWipeArray.Add(Wipe);
end;
if assigned(RemWipeArray) then
begin
for i:=0 to RemWipeArray.Count-1 do
KillDlg(@ReminderDialogInfo, RemWipeArray.Strings[i], True);
end;
if (assigned(RemWipeArray)) then
begin
RemWipeArray.Clear ;
RemWipeArray.Free;
end;
end;
end;
procedure TfrmRemDlg.RemindersChanged(Sender: TObject);
begin
UpdateButtons;
end;
procedure TfrmRemDlg.btnClinMaintClick(Sender: TObject);
begin
if(not assigned(FClinMainBox)) then
begin
FClinMainBox := ModelessReportBox(DetailReminder(StrToIntDef(FReminder.IEN,0)),
ClinMaintText + ': ' + FReminder.PrintName, TRUE);
FOldClinMaintOnDestroy := FClinMainBox.OnDestroy;
FClinMainBox.OnDestroy := ClinMaintDestroyed;
UpdateButtons;
end;
end;
procedure TfrmRemDlg.ClinMaintDestroyed(Sender: TObject);
begin
if(assigned(FOldClinMaintOnDestroy)) then
FOldClinMaintOnDestroy(Sender);
FClinMainBox := nil;
UpdateButtons;
end;
procedure TfrmRemDlg.btnVisitClick(Sender: TObject);
var
frmRemVisitInfo: TfrmRemVisitInfo;
VitalsDate: TFMDateTime;
begin
if FVitalsDate = 0 then
VitalsDate := FMNow //AGP Change 26.1
else
VitalsDate := FVitalsDate;
frmRemVisitInfo := TfrmRemVisitInfo.Create(Self);
try
frmRemVisitInfo.fraVisitRelated.InitAllow(FSCCond);
frmRemVisitInfo.fraVisitRelated.InitRelated(FSCRelated, FAORelated,
2010-07-07 16:51:54 -04:00
FIRRelated, FECRelated, FMSTRelated, FHNCRelated, FCVRelated, FSHDRelated);
frmRemVisitInfo.dteVitals.FMDateTime := VitalsDate;
frmRemVisitInfo.ShowModal;
if frmRemVisitInfo.ModalResult = mrOK then
begin
VitalsDate := frmRemVisitInfo.dteVitals.FMDateTime;
if VitalsDate <= FMNow then
FVitalsDate := VitalsDate;
frmRemVisitInfo.fraVisitRelated.GetRelated(FSCRelated, FAORelated,
2010-07-07 16:51:54 -04:00
FIRRelated, FECRelated, FMSTRelated, FHNCRelated, FCVRelated, FSHDRelated);
FSCPrompt := FALSE;
UpdateText(nil);
end;
finally
frmRemVisitInfo.Free;
end;
end;
procedure TfrmRemDlg.ProcessTemplate(Template: TTemplate);
begin
FProcessingTemplate := TRUE;
btnClear.Visible := FALSE;
btnClinMaint.Visible := FALSE;
btnBack.Visible := FALSE;
btnNext.Visible := FALSE;
FReminder := TReminderDialog.Create(Template.ReminderDialogIEN + U + Template.PrintName + U +
Template.ReminderWipe); //AGP CHANGE 24.8
ClearControls(TRUE);
FReminder.PCEDataObj := RemForm.PCEObj;
BuildControls;
UpdateText(nil);
UpdateButtons;
Show;
end;
procedure TfrmRemDlg.SetFontSize;
begin
ResizeAnchoredFormToFont(frmRemDlg);
if Assigned(FClinMainBox) then
ResizeAnchoredFormToFont(FClinMainBox);
BuildControls;
end;
{ AGP Change 24.8 You MUST pass an address to an object variable to get KillObj to work }
procedure TfrmRemDlg.KillDlg(ptr: Pointer; ID: string; KillObjects: boolean = FALSE);
var
Obj: TObject;
Lst: TList;
SLst: TStringList;
i: integer;
begin
Obj := TObject(ptr^);
if(assigned(Obj)) then
begin
if(KillObjects) then
begin
if(Obj is TList) then
begin
Lst := TList(Obj);
for i := Lst.count-1 downto 0 do
if assigned(Lst[i]) then
TObject(Lst[i]).Free;
end
else
if(Obj is TStringList) then
begin
SLst := TStringList(Obj);
//Check to see if the Reminder IEN is in the of IEN to be wipe out
for i := SLst.count-1 downto 0 do
if assigned(SLst.Objects[i]) and (pos(Slst.Strings[i],ID)>0) then
SLst.Objects[i].Free;
end;
end;
Obj.Free;
TObject(ptr^) := nil;
end;
end;
procedure TfrmRemDlg.FormShow(Sender: TObject);
begin
//Set The form to it's Saved Position
Left := RemDlgLeft;
Top := RemDlgTop;
Width := RemDlgWidth;
Height := RemDlgHeight;
pnlFrmBottom.Height := RemDlgSpltr1 + lblFootnotes.Height;
reData.Height := RemDlgSpltr2;
end;
initialization
finalization
KillReminderDialog(nil);
KillObj(@PositionList);
end.