Module

uReminders

Path

C:\CPRS\CPRS30\uReminders.pas

Last Modified

10/8/2014 2:49:30 PM

Initialization Code

initialization
  InitReminderObjects;

Finalization Code

finalization
  FreeReminderObjects;

end.

Units Used in Interface

Name Comments
fDeviceSelect -
fDrawers -
uPCE -
uVitals -

Units Used in Implementation

Name Comments
dShared -
fBase508Form -
fIconLegend -
fMHTest -
fNotes -
fReminderDialog -
fReminderTree -
fRptBox -
rCore -
rMisc -
rPCE -
rReminders -
rTemplates -
uConst -
uCore -
uDlgComponents -
uInit -
uTemplateFields -

Classes

Name Comments
EForcedPromptConflict -
TAccessCheckBox -
TExposedComponent -
TORExposedWinControl -
TRemData -
TRemDlgElement -
TReminder -
TReminderDialog -
TRemPCERoot -
TRemPrompt -
TWHCheckBox -

Procedures

Name Owner Declaration Scope Comments
Add - procedure Add(Str: string; Root: TRemPCERoot); Local -
AddEducationTopics - procedure AddEducationTopics(Item: TMenuItem; EduStr: string); Local -
AddNewTxt - procedure AddNewTxt; Local -
AddPrompt - procedure AddPrompt(Prompt: TRemPrompt; dt: TRemDataType; var x: string); Local -
AddPrompts - procedure AddPrompts(Shared: boolean; AParent: TWinControl; PWidth: integer; var Y: integer); Local -
AddText TRemDlgElement procedure AddText(Lst: TStrings); Public -
AddText TReminderDialog procedure AddText(Lst: TStrings); Public -
AddWebPages - procedure AddWebPages(Item: TMenuItem; WebStr: string); Local -
BeginNeedRedraw TReminderDialog procedure BeginNeedRedraw; Protected -
BeginReminderUpdate - procedure BeginReminderUpdate; Global -
BeginTextChanged TReminderDialog procedure BeginTextChanged; Protected -
Build - procedure Build(AList :TORStringList; PNum: integer); Local -
BuildReminderTree - procedure BuildReminderTree(Tree: TORTreeView); Interfaced
StringData of the TORTreeNodes will be in the format:
  1          2          3             4                        5        6   7
  TYPE + IEN^PRINT NAME^DUE DATE/TIME^LAST OCCURENCE DATE/TIME^PRIORITY^DUE^DIALOG
         8                 9                            10
         Formated Due Date^Formated Last Occurence Date^InitialAbsoluteIdx

  where TYPE     C=Category, R=Reminder
        PRIORITY 1=High, 2=Normal, 3=Low
        DUE      0=Applicable, 1=Due, 2=Not Applicable
        DIALOG   1=Active Dialog Exists
cbClicked TRemDlgElement procedure cbClicked(Sender: TObject); Protected -
cbEntered TRemDlgElement procedure cbEntered(Sender: TObject); Protected -
Check4ChildrenSharedPrompts TRemDlgElement procedure Check4ChildrenSharedPrompts; Protected -
CheckReminders - procedure CheckReminders; Global
Procedure CheckReminders; forward;

procedure IdleCallEvaluateReminder(Msg: string);
var
  i:integer;
  Code: string;

begin
  Code := Piece(Msg,U,1);
  repeat
    i := ReminderCallList.IndexOfPiece(Code);
    if(i >= 0) then
      ReminderCallList.Delete(i);
  until(i < 0);
  ReminderEvaluated(EvaluateReminder(Msg), (ReminderCallList.Count = 0));
  CheckReminders;
end;

procedure CheckReminders;
var
  i:integer;

begin
  for i := ReminderCallList.Count-1 downto 0 do
    if(EvaluatedReminders.IndexOfPiece(Piece(ReminderCallList[i], U, 1)) >= 0) then
      ReminderCallList.Delete(i);
  if(ReminderCallList.Count > 0) then
    CallRPCWhenIdle(IdleCallEvaluateReminder,ReminderCallList[0])
end;
ClearReminderData - procedure ClearReminderData; Interfaced -
ComboBoxCheckedText TReminderDialog procedure ComboBoxCheckedText(Sender: TObject; NumChecked: integer; var Text: string); Protected -
ComboBoxKeyDown TRemPrompt procedure ComboBoxKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Protected -
ComboBoxResized TReminderDialog procedure ComboBoxResized(Sender: TObject); Protected -
DoMHTest TRemPrompt procedure DoMHTest(Sender: TObject); Protected -
Done TRemPCERoot procedure Done(Data: TRemData); Protected -
DoWHReport TRemPrompt procedure DoWHReport(Sender: TObject); Protected -
EditKeyPress TRemPrompt procedure EditKeyPress(Sender: TObject; var Key: Char); Protected -
EndNeedRedraw TReminderDialog procedure EndNeedRedraw(Sender: TObject); Protected -
EndReminderUpdate - procedure EndReminderUpdate(Force: boolean = FALSE); Global -
EndTextChanged TReminderDialog procedure EndTextChanged(Sender: TObject); Protected -
EvalProcessed - procedure EvalProcessed; Interfaced -
EvalReminder - procedure EvalReminder(ien: integer); Interfaced -
EvaluateCategoryClicked - procedure EvaluateCategoryClicked(AData: pointer; Sender: TObject); Interfaced -
ExpandTIUObjects - procedure ExpandTIUObjects(var Txt: string; msg: string = ''); Global -
FieldPanelChange TRemDlgElement procedure FieldPanelChange(Sender: TObject); Protected -
FieldPanelEntered TRemDlgElement procedure FieldPanelEntered(Sender: TObject); Protected Cause the paint event to be called and draw a focus rectangle on the TFieldPanel
FieldPanelExited TRemDlgElement procedure FieldPanelExited(Sender: TObject); Protected Cause the paint event to be called and draw the TFieldPanel without the focus rect.
FieldPanelKeyPress TRemDlgElement procedure FieldPanelKeyPress(Sender: TObject; var Key: Char); Protected Check the associated checkbox when spacebar is pressed
FieldPanelLabelOnClick TRemDlgElement procedure FieldPanelLabelOnClick(Sender: TObject); Protected Call the FieldPanelOnClick so labels on the panels will also click the checkbox
FieldPanelOnClick TRemDlgElement procedure FieldPanelOnClick(Sender: TObject); Protected So the FieldPanel will check the associated checkbox
FinishProblems TRemDlgElement procedure FinishProblems(List: TStrings); Protected -
FinishProblems TReminderDialog procedure FinishProblems(List: TStrings; var MissingTemplateFields: boolean); Public -
FreeReminderObjects - procedure FreeReminderObjects; Global -
GAFHelp TRemPrompt procedure GAFHelp(Sender: TObject); Protected -
GetData TRemDlgElement procedure GetData; Protected -
GetFieldValues TRemDlgElement procedure GetFieldValues(FldData: TStrings); Protected -
GetImageIndex - procedure GetImageIndex(AData: Pointer; Sender: TObject; Node: TTreeNode); Global Supporting events for Reminder TreeViews
InitReminderList - procedure InitReminderList(var List: TORStringList); Local -
InitReminderObjects - procedure InitReminderObjects; Global -
InitValue TRemPrompt procedure InitValue; Protected -
LoadReminderData - procedure LoadReminderData(ProcessingInBackground: boolean = FALSE); Interfaced -
LocationChanged - procedure LocationChanged(Sender: TObject); Global -
NextLine - procedure NextLine(var Y: integer); Local -
NotifyWhenRemindersChange - procedure NotifyWhenRemindersChange(Proc: TNotifyEvent); Interfaced -
ParentCBEnter TRemDlgElement procedure ParentCBEnter(Sender: TObject); Protected -
ParentCBExit TRemDlgElement procedure ParentCBExit(Sender: TObject); Protected -
PrepText4NextLine - procedure PrepText4NextLine(var txt: string); Global -
ProcessLabel - procedure ProcessLabel(Required, AEnabled: boolean; AParent: TWinControl; Control: TControl); begin Local -
PromptChange TRemPrompt procedure PromptChange(Sender: TObject); Protected Printoption: TORCheckBox;
RemContextPopup - procedure RemContextPopup(AData: Pointer; Sender: TObject; MousePos: TPoint; var Handled: Boolean); Global -
ReminderClinMaintClicked - procedure ReminderClinMaintClicked(AData: pointer; Sender: TObject); Global -
ReminderEduClicked - procedure ReminderEduClicked(AData: pointer; Sender: TObject); Global -
ReminderEvalClicked - procedure ReminderEvalClicked(AData: pointer; Sender: TObject); Global -
ReminderIconLegendClicked - procedure ReminderIconLegendClicked(AData: pointer; Sender: TObject); Global -
ReminderInqClicked - procedure ReminderInqClicked(AData: pointer; Sender: TObject); Global -
ReminderMenuBuilder - procedure ReminderMenuBuilder(MI: TMenuItem; RemStr: string; IncludeActions, IncludeEval, ViewFolders: boolean); Global -
ReminderMenuItemSelect - procedure ReminderMenuItemSelect(AData: pointer; Sender: TObject); Global -
RemindersEvaluated - procedure RemindersEvaluated(List: TStringList); Interfaced -
RemindersInProcessChanged - procedure RemindersInProcessChanged(Data: Pointer; Sender: TObject; var CanNotify: boolean); Global -
ReminderTreePopup - procedure ReminderTreePopup(AData: pointer; Sender: TObject); Global -
ReminderTreePopupCover - procedure ReminderTreePopupCover(AData: pointer; Sender: TObject); Global -
ReminderTreePopupDlg - procedure ReminderTreePopupDlg(AData: pointer; Sender: TObject); Global -
ReminderViewFolderClicked - procedure ReminderViewFolderClicked(AData: pointer; Sender: TObject); Global -
ReminderWebClicked - procedure ReminderWebClicked(AData: pointer; Sender: TObject); Global -
RemoveNotifyRemindersChange - procedure RemoveNotifyRemindersChange(Proc: TNotifyEvent); Interfaced -
Reset - procedure Reset(AList: TORStringList; PNum, DlgPNum: integer); Local -
ResetReminderLoad - procedure ResetReminderLoad; Interfaced -
ScreenReaderSupport - procedure ScreenReaderSupport(Control: TWinControl); Local -
setActiveDates TRemDlgElement procedure setActiveDates(Choices: TORStringList; ChoicesActiveDates: TList; ActiveDates: TStringList); Protected -
SetChecked TRemDlgElement procedure SetChecked(const Value: boolean); Protected -
SetRemFolders - procedure SetRemFolders(const Value: TRemFolders); Global -
SetReminderFormBounds - procedure SetReminderFormBounds(Frm: TForm; DefX, DefY, DefW, DefH, ALeft, ATop, AWidth, AHeight: integer); Interfaced -
SetReminderMenuSelectRoutine - procedure SetReminderMenuSelectRoutine(Menu: TMenuItem); Interfaced -
SetReminderPopupCoverRoutine - procedure SetReminderPopupCoverRoutine(Menu: TPopupMenu); Interfaced -
SetReminderPopupDlgRoutine - procedure SetReminderPopupDlgRoutine(Menu: TPopupMenu); Global -
SetReminderPopupRoutine - procedure SetReminderPopupRoutine(Menu: TPopupMenu); Interfaced -
SetValue TRemPrompt procedure SetValue(Value: string); Protected -
SetValueFromParent TRemPrompt procedure SetValueFromParent(Value: string); Protected -
StartupReminders - procedure StartupReminders; Interfaced -
SubCommentChange TRemDlgElement procedure SubCommentChange(Sender: TObject); Protected -
Sync TRemPCERoot procedure Sync(Prompt: TRemPrompt); Protected -
UnSync TRemPCERoot procedure UnSync(Prompt: TRemPrompt); Protected -
UpdateData TRemDlgElement procedure UpdateData; Protected -
UpdateForcedValues - procedure UpdateForcedValues(Elem: TRemDlgElement); Local -
UpdatePrompts - procedure UpdatePrompts(EnablePanel: boolean; ClearCB: boolean); Local -
UpdateReminderDialogStatus - procedure UpdateReminderDialogStatus; Interfaced -
ViewWHText TRemPrompt procedure ViewWHText(Sender: TObject); Protected -
VitalVerify TRemPrompt procedure VitalVerify(Sender: TObject); Protected -
WordWrap - procedure WordWrap(AText: string; Output: TStrings; LineLength: integer; AutoIndent: integer = 4; MHTest: boolean = false); Interfaced -

Functions

Name Owner Declaration Scope Comments
Add - function Add(Text: string; Parent: TMenuItem; Tag: integer; Typ: TRemMenuCmd): TORMenuItem; Local -
Add2PN TRemData function Add2PN: boolean; Public TRemData
Add2PN TRemDlgElement function Add2PN: boolean; Public -
Add2PN TRemPrompt function Add2PN: boolean; Public TRemPrompt
Add2Tree - function Add2Tree(Folder: TRemFolder; CatID: string; Node: TORTreeNode = nil): TORTreeNode; Local -
AddData TRemData function AddData(List: TStrings; Finishing: boolean): integer; Protected -
AddData TRemDlgElement function AddData(Lst: TStrings; Finishing: boolean; AHistorical: boolean = FALSE): integer; Protected -
AddData TReminderDialog function AddData(Lst: TStrings; Finishing: boolean = FALSE; Historical: boolean = FALSE): integer; Protected -
Box TRemDlgElement function Box: boolean; Public -
BoxCaption TRemDlgElement function BoxCaption: string; Public -
BuildControls TRemDlgElement function BuildControls(var Y: integer; ParentWidth: integer; BaseParent, AOwner: TWinControl): TWinControl; Protected -
BuildControls TReminderDialog function BuildControls(ParentWidth: integer; AParent, AOwner: TWinControl): TWinControl; Public -
CanShare TRemPrompt function CanShare(Prompt: TRemPrompt): boolean; Protected -
Caption TRemPrompt function Caption: string; Public -
Category TRemData function Category: string; Public -
CheckItem - function CheckItem(Item: TRemDlgElement): boolean; Local -
ChildrenChecked - function ChildrenChecked(Prnt: TRemDlgElement): boolean; forward; Local -
ChildrenIndent TRemDlgElement function ChildrenIndent: integer; Public -
ChildrenRequired TRemDlgElement function ChildrenRequired: TRDChildReq; Public -
ChildrenSharePrompts TRemDlgElement function ChildrenSharePrompts: boolean; Public -
Code2DataType - function Code2DataType(Code: string): TRemDataType; Global TRemDlgElement
Code2PromptType - function Code2PromptType(Code: string): TRemPromptType; Global -
Code2VitalType - function Code2VitalType(Code: string): TVitalType; Global -
CompareActiveDate TRemPrompt function CompareActiveDate(ActiveDates: TStringList; EncDt: TFMDateTime):Boolean; Protected Agp ICD-10 code was imported from RemDataActive
CRLFText - function CRLFText(const InStr: string): string; Global -
DataType TRemData function DataType: TRemDataType; Public -
DisplayWHResults TRemData function DisplayWHResults: boolean; Public -
ElemType TRemDlgElement function ElemType: TRDElemType; Public -
EnableChildren TRemDlgElement function EnableChildren: boolean; Protected -
Enabled TRemDlgElement function Enabled: boolean; Protected -
EntryID TRemDlgElement function EntryID: string; Protected -
EntryID TRemPrompt function EntryID: string; Protected -
ExternalValue TRemData function ExternalValue: string; Public -
FindingType TRemDlgElement function FindingType: string; Public -
Forced TRemPrompt function Forced: boolean; Public -
ForcedCaption TRemPrompt function ForcedCaption: string; Public -
GetDlgSL TReminderDialog function GetDlgSL: TORStringList; Protected -
GetDueDateStr TReminder function GetDueDateStr: string; Protected -
GetEducationTopics - function GetEducationTopics(EIEN: string): string; Global -
GetIEN TReminderDialog function GetIEN: string; virtual; Protected -
GetIEN TReminder function GetIEN: string; override; Protected -
GetLastDateStr TReminder function GetLastDateStr: string; Protected -
GetPanel - function GetPanel(const EID, AText: string; const PnlWidth: integer; OwningCheckBox: TCPRSDialogParentCheckBox): TDlgFieldPanel; Local -
GetPrintName TReminderDialog function GetPrintName: string; virtual; Protected -
GetPrintName TReminder function GetPrintName: string; override; Protected -
GetPriority TReminder function GetPriority: integer; Protected -
GetRemFolders - function GetRemFolders: TRemFolders; Global -
GetReminder - function GetReminder(ARemData: string): TReminder; Interfaced -
GetReminderData - function GetReminderData(Lst: TStrings; Finishing: boolean = FALSE; Historical: boolean = FALSE): integer; overload; Interfaced -
GetReminderData - function GetReminderData(Rem: TReminderDialog; Lst: TStrings; Finishing: boolean = FALSE; Historical: boolean = FALSE): integer; overload; Interfaced -
GetReminderStatus - function GetReminderStatus: TReminderStatus; Interfaced -
GetRoot TRemPCERoot class function GetRoot(Data: TRemData; Rec3: string; Historical: boolean): TRemPCERoot; Protected -
GetStatus TReminder function GetStatus: string; Protected -
GetTemplateFieldValues TRemDlgElement function GetTemplateFieldValues(const Text: string; FldValues: TORStringList = nil): string; Public
This is used to get the template field values if this reminder is not the
current reminder in dialog, in which case no uEntries will exist so we have
to get the template field values that were saved in the element.
GetValue TRemPCERoot function GetValue(PromptType: TRemPromptType; var NewValue: string): boolean; Protected -
GetValue TRemPrompt function GetValue: string; Protected
Returns TRemPrompt.FValue if this TRemPrompt is not a ptPrimaryDiag
Returns 0-False or 1-True if this TRemPrompt is a ptPrimaryDiag
GetWebPageAddress - function GetWebPageAddress(idx: integer): string; Global -
GetWebPageName - function GetWebPageName(idx :integer): string; Global -
GetWebPages - function GetWebPages(EIEN: string): string; overload; Global -
HideChildren TRemDlgElement function HideChildren: boolean; Public -
Historical TRemDlgElement function Historical: boolean; Public -
IncludeMHTestInPN TRemDlgElement function IncludeMHTestInPN: boolean; Public -
Indent TRemDlgElement function Indent: integer; Public -
IndentChildrenInPN TRemDlgElement function IndentChildrenInPN: boolean; Public -
IndentPNLevel TRemDlgElement function IndentPNLevel: integer; Public -
InitText - function InitText(const InStr: string): string; Global -
InteractiveRemindersActive - function InteractiveRemindersActive: boolean; Interfaced -
InternalValue TRemData function InternalValue: string; Public -
InternalValue TRemPrompt function InternalValue: string; Public -
IsChecked TRemDlgElement function IsChecked: boolean; Protected -
IsSyncPrompt - function IsSyncPrompt(pt: TRemPromptType): boolean; Global -
Narrative TRemData function Narrative: string; Public -
NoteText TRemPrompt function NoteText: string; Public -
OneValidCode TRemDlgElement function OneValidCode(Choices: TORStringList; ChoicesActiveDates: TList; encDt: TFMDateTime): string; Protected Agp ICD-10 add this function to scan for valid codes against encounter date.
Processing TReminderDialog function Processing: boolean; Public -
ProcessingChangeString - function ProcessingChangeString: string; Global -
PromptOK TRemPrompt function PromptOK: boolean; Public -
PromptType TRemPrompt function PromptType: TRemPromptType; Public -
RemDataActive TRemPrompt function RemDataActive(RData: TRemData; EncDt: TFMDateTime):Boolean; Protected
Var
  ActDt, InActDt: Double;
  j: integer;
RemDataChoiceActive TRemPrompt function RemDataChoiceActive(RData: TRemData; j: integer; EncDt: TFMDateTime):Boolean; Protected -
ReminderEvaluated - function ReminderEvaluated(Data: string; ForceUpdate: boolean = FALSE): boolean; Interfaced -
ReminderMenu - function ReminderMenu(Sender: TComponent): TORPopupMenu; Global -
ReminderName - function ReminderName(IEN: integer): string; Global -
ReminderNode - function ReminderNode(Node: TTreeNode): TORTreeNode; Interfaced -
RemindersEvaluatingInBackground - function RemindersEvaluatingInBackground: boolean; Interfaced -
Required TRemPrompt function Required: boolean; Public -
ResultDlgID TRemDlgElement function ResultDlgID: string; Public -
SameLine TRemPrompt function SameLine: boolean; Public -
ShowChildren TRemDlgElement function ShowChildren: boolean; Protected -
TrueIndent TRemDlgElement function TrueIndent: integer; Protected -
Visible TReminderDialog function Visible: boolean; Protected -
VitalType TRemPrompt function VitalType: TVitalType; Public -
VitalUnitValue TRemPrompt function VitalUnitValue: string; Public -
VitalValue TRemPrompt function VitalValue: string; Public -

Global Variables

Name Type Declaration Comments
ActiveReminders TORStringList ActiveReminders: TORStringList = nil;
ActiveReminder string format:
  IEN^PRINT NAME^DUE DATE/TIME^LAST OCCURENCE DATE/TIME^PRIORITY^DUE^DIALOG
  where PRIORITY 1=High, 2=Normal, 3=Low
        DUE      0=Applicable, 1=Due, 2=Not Applicable
CoverSheetRemindersInBackground Boolean CoverSheetRemindersInBackground: boolean = FALSE; -
EducationTopics TORStringList EducationTopics: TORStringList = nil; -
ElementChecked TRemDlgElement ElementChecked: TRemDlgElement = nil; -
EvaluatedReminders TORStringList EvaluatedReminders: TORStringList = nil; -
HistRootCount LongInt HistRootCount: longint = 0; -
InitialRemindersLoaded Boolean InitialRemindersLoaded: boolean = FALSE; -
InteractiveRemindersActiveChecked Boolean InteractiveRemindersActiveChecked: boolean = FALSE; -
InteractiveRemindersActiveStatus Boolean InteractiveRemindersActiveStatus: boolean = FALSE; -
KillReminderDialogProc Procedure Type KillReminderDialogProc: procedure(frm: TForm) = nil; -
LastProcessingList UnicodeString LastProcessingList: string = ''; -
LastReminderLocation Integer LastReminderLocation: integer = -2; -
NotPurposeValue UnicodeString NotPurposeValue: string; -
OtherReminders TORStringList OtherReminders: TORStringList = nil;
OtherReminder string format:
  IDENTIFIER^TYPE^NAME^PARENT IDENTIFIER^REMINDER IEN^DIALOG
  where TYPE C=Category, R=Reminder
PCERootList TStringList PCERootList: TStringList; -
PrimaryDiagRoot TRemPCERoot PrimaryDiagRoot: TRemPCERoot = nil; -
ProcessedReminders TORStringList ProcessedReminders: TORStringList = nil; -
RemForm RemForm: TRemForm; -
ReminderCallList TORStringList ReminderCallList: TORStringList = nil; -
ReminderCatMenu TPopupMenu ReminderCatMenu: TPopupMenu = nil; -
ReminderDialogInfo TStringList ReminderDialogInfo: TStringList = nil; -
RemindersInProcess TORStringList RemindersInProcess: TORStringList = nil; -
RemindersStarted Boolean RemindersStarted: boolean = FALSE; -
ReminderTreeMenu Simple (unknown) ReminderTreeMenu: TORPopupMenu = nil; -
ReminderTreeMenuDlg Simple (unknown) ReminderTreeMenuDlg: TORPopupMenu = nil; -
ScootOver Integer ScootOver: integer = 0; -
TmpActive TStringList TmpActive: TStringList = nil; -
TmpOther TStringList TmpOther: TStringList = nil; -
uRemFolders uRemFolders: TRemFolders = [rfUnknown]; -
WebPages TORStringList WebPages: TORStringList = nil; -
WHRemPrint UnicodeString WHRemPrint: string; -

Constants

Name Declaration Scope Comments
ApplCatID CatCode + '-3' Global -
ApplCatString ApplCatID + U + ApplicableText Global -
ApplicableText 'Applicable' Global -
CatCode 'C' Interfaced -
ClinMaintText 'Clinical Maintenance' Interfaced -
ComboPromptTags array[TRemPromptType] of integer = Global -
crAll TRDChildReq Interfaced -
crAtLeastOne TRDChildReq Interfaced -
CRCode '<br>' Global -
CRCodeLen length(CRCode) Global -
crNone TRDChildReq Interfaced -
crNoneOrOne TRDChildReq Interfaced -
crOne TRDChildReq Interfaced -
DisabledFontColor clBtnShadow Global -
DlgCalled RPCCalled + U + 'DLG' Global -
dtAll TRemDataType(-2) Interfaced -
dtDiagnosis TRemDataType Interfaced -
dtExam TRemDataType Interfaced -
dtHealthFactor TRemDataType Interfaced -
dtHistorical TRemDataType(-3) Interfaced -
dtImmunization TRemDataType Interfaced -
dtMentalHealthTest TRemDataType Interfaced -
dtOrder TRemDataType Interfaced -
dtPatientEducation TRemDataType Interfaced -
dtProcedure TRemDataType Interfaced -
dtSkinTest TRemDataType Interfaced -
dtUnknown TRemDataType(-1) Interfaced -
dtVitals TRemDataType Interfaced -
dtWhNotPurp TRemDataType Interfaced -
dtWHPapResult TRemDataType Interfaced -
DueCatID CatCode + '-2' Global -
DueCatString DueCatID + U + DueText Global -
DueText 'Due' Global -
EduCode 'E' Interfaced -
etCheckBox TRDElemType Interfaced -
etDisplayOnly TRDElemType Interfaced -
etTaxonomy TRDElemType Interfaced -
EvalCatName 'Evaluate Category Reminders' Global -
EvaluatedCatID CatCode + '-5' Global -
EvaluatedCatString EvaluatedCatID + U + EvaluatedText Global -
EvaluatedText 'All Evaluated' Global -
FinishPromptPieceNum array[TRemPromptType] of integer = Global -
Gap 3 Global -
gbLeftIndent 2 Global -
gbTopIndent 9 Global -
gbTopIndent2 16 Global -
HAVE_REMINDERS 0 Interfaced -
IncludeParentID ';' Interfaced -
IndentGap 18 Global -
IndentMult 9 Global -
LblGap 4 Global -
LostCatID CatCode + '-7' Global -
LostCatString LostCatID + U + 'In Process' Global -
MonthReqCode 'M' Global -
MSTCode 'MST' Interfaced -
MSTDataTypes [pdcHF, pdcExam] Interfaced -
MSTDescTxt array[0..4,0..1] of string = (('Yes','Y'),('No','N'),('Declined','D'), Global -
NewLinePromptGap 18 Global -
NO_REMINDERS 1 Interfaced -
NotApplCatID CatCode + '-4' Global -
NotApplCatString NotApplCatID + U + NotApplicableText Global -
NotApplicableText 'Not Applicable' Global -
OtherCatID CatCode + '-6' Interfaced -
OtherCatString OtherCatID + U + OtherText Global OtherCatID = CatCode + '-6';
OtherText 'Other Categories' Global -
pnumMST ord(pnumComment)+4 Interfaced -
pnumVisitDate pnumComment + 2 Interfaced -
pnumVisitLoc pnumComment + 1 Interfaced -
PromptDescriptions array [TRemPromptType] of string = Global -
PromptGap 10 Global -
PromptIndent 30 Global -
ptAdd2PL TRemPromptType Interfaced -
ptComment TRemPromptType Interfaced -
ptContraindicated TRemPromptType Interfaced -
ptDataList TRemPromptType(-3) Interfaced -
ptExamResults TRemPromptType Interfaced -
ptGAF TRemPromptType(-6) Interfaced -
ptLevelSeverity TRemPromptType Interfaced -
ptLevelUnderstanding TRemPromptType Interfaced -
ptMHTest TRemPromptType(-5) Interfaced -
ptMST TRemPromptType(-7) Interfaced -
ptPrimaryDiag TRemPromptType Interfaced -
ptQuantity TRemPromptType Interfaced -
ptReaction TRemPromptType Interfaced -
ptSeries TRemPromptType Interfaced -
ptSkinReading TRemPromptType Interfaced -
ptSkinResults TRemPromptType Interfaced -
ptSubComment TRemPromptType(-2) Interfaced -
ptUnknown TRemPromptType(-1) Interfaced -
ptVisitDate TRemPromptType Interfaced -
ptVisitLocation TRemPromptType Interfaced -
ptVitalEntry TRemPromptType(-4) Interfaced -
ptWHNotPurp TRemPromptType Interfaced -
ptWHPapResult TRemPromptType Interfaced -
r3Cat 9 Global -
r3Code 7 Global -
r3Code2 6 Global -
r3GAF 12 Global -
r3Nar 8 Global -
r3Type 4 Global -
RemCode 'R' Interfaced -
RemData2PCECat array[TRemDataType] of TPCEDataCat = Global -
RemDataCodes array[TRemDataType] of string = Interfaced -
REMEntryCode 'REM' Global -
RemFolderCodes array[TValidRemFolders] of char = Global -
ReminderDateFormat 'mm/dd/yyyy' Global -
RemMenuFolder array[TRemViewCmds] of TRemFolder = Global -
RemMenuNames array[TRemMenuCmd] of string = ( Global -
RemPriorityText array[1..3] of string = ('High','','Low') Interfaced -
RemPromptCodes array[TRemPromptType] of string = Global -
RemPromptTypes array[TRemPromptType] of TRemDataType = Global -
RemTreeCode 999 Global -
RemTreeDateIdx 8 Interfaced -
rfApplicable TRemFolder Global -
rfDue TRemFolder Global -
rfEvaluated TRemFolder Global -
rfNotApplicable TRemFolder Global -
rfOther TRemFolder Global -
rfUnknown TRemFolder Global -
rmApplicable TRemMenuCmd Global -
rmClinMaint TRemMenuCmd Global -
rmDash TRemMenuCmd Global -
rmDue TRemMenuCmd Global -
rmEdu TRemMenuCmd Global -
rmEval TRemMenuCmd Global -
rmEvaluated TRemMenuCmd Global -
rmInq TRemMenuCmd Global -
rmLegend TRemMenuCmd Global -
rmNotApplicable TRemMenuCmd Global -
rmOther TRemMenuCmd Global -
rmWeb TRemMenuCmd Global -
RPCCalled '99' Global -
rsApplicable TReminderStatus Interfaced -
rsDue TReminderStatus Interfaced -
rsNone TReminderStatus Interfaced -
rsNotApplicable TReminderStatus Interfaced -
rsUnknown TReminderStatus Interfaced -
SyncPrompts [ptComment, ptQuantity, ptAdd2PL, ptExamResults, Global -


Module Source

1     unit uReminders;
2     
3     interface
4     
5     uses
6       Windows, Messages, Classes, Controls, StdCtrls, SysUtils, ComCtrls, Menus,
7       Graphics, Forms, ORClasses, ORCtrls, ORDtTm, ORFn, ORNet, Dialogs, uPCE, uVitals,
8       ExtCtrls, fDrawers, fDeviceSelect, TypInfo;
9     
10    type
11      TReminderDialog = class(TObject)
12      private
13        FDlgData: string;
14        FElements: TStringList; // list of TRemDlgElement objects
15        FOnNeedRedraw: TNotifyEvent;
16        FNeedRedrawCount: integer;
17        FOnTextChanged: TNotifyEvent;
18        FTextChangedCount: integer;
19        FPCEDataObj: TPCEData;
20        FNoResolve: boolean;
21        FWHReviewIEN: string;  // AGP CHANGE 23.13 Allow for multiple processing of WH Review of Result Reminders
22        FRemWipe: integer;
23        FMHTestArray: TORStringList;
24      protected
25        function GetIEN: string; virtual;
26        function GetPrintName: string; virtual;
27        procedure BeginNeedRedraw;
28        procedure EndNeedRedraw(Sender: TObject);
29        procedure BeginTextChanged;
30        procedure EndTextChanged(Sender: TObject);
31        function GetDlgSL: TORStringList;
32        procedure ComboBoxResized(Sender: TObject);
33        procedure ComboBoxCheckedText(Sender: TObject; NumChecked: integer; var Text: string);
34        function AddData(Lst: TStrings; Finishing: boolean = FALSE; Historical: boolean = FALSE): integer;
35        function Visible: boolean;
36      public
37        constructor BaseCreate;
38        constructor Create(ADlgData: string);
39        destructor Destroy; override;
40        procedure FinishProblems(List: TStrings; var MissingTemplateFields: boolean);
41        function BuildControls(ParentWidth: integer; AParent, AOwner: TWinControl): TWinControl;
42        function Processing: boolean;
43        procedure AddText(Lst: TStrings);
44        property PrintName: string read GetPrintName;
45        property IEN: string read GetIEN;
46        property Elements: TStringList read FElements;
47        property OnNeedRedraw: TNotifyEvent read FOnNeedRedraw write FOnNeedRedraw;
48        property OnTextChanged: TNotifyEvent read FOnTextChanged write FOnTextChanged;
49        property PCEDataObj: TPCEData read FPCEDataObj write FPCEDataObj;
50        property DlgData: string read FDlgData; //AGP Change 24.8
51        property WHReviewIEN: string read FWHReviewIEN write FWHReviewIEN;  //AGP CHANGE 23.13
52        property RemWipe: integer read FRemWipe write FRemWipe;
53        property MHTestArray: TORStringList read FMHTestArray write FMHTestArray;
54      end;
55    
56      TReminder = class(TReminderDialog)
57      private
58        FRemData: string;
59        FCurNodeID: string;
60      protected
61        function GetDueDateStr: string;
62        function GetLastDateStr: string;
63        function GetIEN: string; override;
64        function GetPrintName: string; override;
65        function GetPriority: integer;
66        function GetStatus: string;
67      public
68        constructor Create(ARemData: string);
69        property DueDateStr: string read GetDueDateStr;
70        property LastDateStr: string read GetLastDateStr;
71        property Priority: integer read GetPriority;
72        property Status: string read GetStatus;
73        property RemData: string read FRemData;
74        property CurrentNodeID: string read FCurNodeID write FCurNodeID;
75      end;
76    
77      TRDChildReq = (crNone, crOne, crAtLeastOne, crNoneOrOne, crAll);
78      TRDElemType = (etCheckBox, etTaxonomy, etDisplayOnly);
79    
80      TRemPrompt = class;
81    
82      TRemDlgElement = class(TObject)
83      private
84        FReminder: TReminderDialog;
85        FParent: TRemDlgElement;
86        FChildren: TList; // Points to other TRemDlgElement objects
87        FData: TList; // List of TRemData objects
88        FPrompts: TList; // list of TRemPrompts objects
89        FText: string;
90        FPNText: string;
91        FRec1: string;
92        FID: string;
93        FDlgID: string;
94        FHaveData: boolean;
95        FTaxID: string;
96        FChecked: boolean;
97        FChildrenShareChecked: boolean;
98        FHasSharedPrompts: boolean;
99        FHasComment: boolean;
100       FHasSubComments: boolean;
101       FCommentPrompt: TRemPrompt;
102       FFieldValues: TORStringList;
103       FMSTPrompt: TRemPrompt;
104       FWHPrintDevice, FWHResultChk, FWHResultNot: String;
105       FVitalDateTime: TFMDateTime;  //AGP Changes 26.1
106     protected
107       procedure Check4ChildrenSharedPrompts;
108       function ShowChildren: boolean;
109       function EnableChildren: boolean;
110       function Enabled: boolean;
111       procedure SetChecked(const Value: boolean);
112       procedure UpdateData;
113       function OneValidCode(Choices: TORStringList; ChoicesActiveDates: TList; encDt: TFMDateTime): string;
114       procedure setActiveDates(Choices: TORStringList; ChoicesActiveDates: TList; ActiveDates: TStringList);
115       procedure GetData;
116       function TrueIndent: integer;
117       procedure cbClicked(Sender: TObject);
118       procedure cbEntered(Sender: TObject);
119       procedure FieldPanelEntered(Sender: TObject);
120       procedure FieldPanelExited(Sender: TObject);
121       procedure FieldPanelKeyPress(Sender: TObject; var Key: Char);
122       procedure FieldPanelOnClick(Sender: TObject);
123       procedure FieldPanelLabelOnClick(Sender: TObject);
124   
125       function BuildControls(var Y: integer; ParentWidth: integer;
126                                   BaseParent, AOwner: TWinControl): TWinControl;
127       function AddData(Lst: TStrings; Finishing: boolean; AHistorical: boolean = FALSE): integer;
128       procedure FinishProblems(List: TStrings);
129       function IsChecked: boolean;
130       procedure SubCommentChange(Sender: TObject);
131       function EntryID: string;
132       procedure FieldPanelChange(Sender: TObject);
133       procedure GetFieldValues(FldData: TStrings);
134       procedure ParentCBEnter(Sender: TObject);
135       procedure ParentCBExit(Sender: TObject);
136     public
137       constructor Create;
138       destructor Destroy; override;
139       function ElemType: TRDElemType;
140       function Add2PN: boolean;
141       function Indent: integer;
142       function FindingType: string;
143       function Historical: boolean;
144       function ResultDlgID: string;
145       function IncludeMHTestInPN: boolean;
146       function HideChildren: boolean;
147       function ChildrenIndent: integer;
148       function ChildrenSharePrompts: boolean;
149       function ChildrenRequired: TRDChildReq;
150       function Box: boolean;
151       function BoxCaption: string;
152       function IndentChildrenInPN: boolean;
153       function IndentPNLevel: integer;
154       function GetTemplateFieldValues(const Text: string; FldValues: TORStringList =  nil): string;
155       procedure AddText(Lst: TStrings);
156       property Text: string read FText;
157       property ID: string read FID;
158       property DlgID: string read FDlgID;
159       property Checked: boolean read FChecked write SetChecked;
160       property Reminder: TReminderDialog read FReminder;
161       property HasComment: boolean read FHasComment;
162       property WHPrintDevice: String read FWHPrintDevice write FWHPrintDevice;
163       property WHResultChk: String read FWHResultChk write FWHResultChk;
164       property WHResultNot: String read FWHResultNot write FWHResultNot;
165       property VitalDateTime: TFMDateTime read FVitalDateTime write FVitalDateTime;
166     end;
167   
168     TRemDataType = (dtDiagnosis, dtProcedure, dtPatientEducation,
169                     dtExam, dtHealthFactor, dtImmunization, dtSkinTest,
170                     dtVitals, dtOrder, dtMentalHealthTest, dtWHPapResult,
171                     dtWhNotPurp);
172   
173     TRemPCERoot = class;
174   
175     TRemData = class(TObject)
176     private
177       FPCERoot: TRemPCERoot;
178       FParent: TRemDlgElement;
179       FRec3: string;
180       FActiveDates: TStringList; //Active dates for finding items. (rectype 3)
181   //    FRoot: string;
182       FChoices: TORStringList;
183       FChoicesActiveDates: TList; //Active date ranges for taxonomies. (rectype 5)
184                                   //List of TStringList objects that contain active date
185                                   //ranges for each FChoices object of the same index
186       FChoicePrompt: TRemPrompt;  //rectype 4
187       FChoicesMin: integer;
188       FChoicesMax: integer;
189       FChoicesFont: THandle;
190       FSyncCount: integer;
191     protected
192       function AddData(List: TStrings; Finishing: boolean): integer;
193     public
194       destructor Destroy; override;
195       function Add2PN: boolean;
196       function DisplayWHResults: boolean;
197       function InternalValue: string;
198       function ExternalValue: string;
199       function Narrative: string;
200       function Category: string;
201       function DataType: TRemDataType;
202       property Parent: TRemDlgElement read FParent;
203     end;
204   
205     TRemPromptType = (ptComment, ptVisitLocation, ptVisitDate, ptQuantity,
206                       ptPrimaryDiag, ptAdd2PL, ptExamResults, ptSkinResults,
207                       ptSkinReading, ptLevelSeverity, ptSeries, ptReaction,
208                       ptContraindicated, ptLevelUnderstanding, ptWHPapResult,
209                       ptWHNotPurp);
210   
211     TRemPrompt = class(TObject)
212     private
213       FFromControl: boolean;
214       FParent: TRemDlgElement;
215       FRec4: string;
216       FCaptionAssigned: boolean;
217       FData: TRemData;
218       FValue: string;
219       FOverrideType: TRemPromptType;
220       FIsShared: boolean;
221       FSharedChildren: TList;
222       FCurrentControl: TControl;
223       FFromParent: boolean;
224       FInitializing: boolean;
225       FMiscText: string;
226       FMonthReq: boolean;
227       FPrintNow: String;
228       FMHTestComplete: integer;
229     protected
230       function RemDataActive(RData: TRemData; EncDt: TFMDateTime):Boolean;
231       function CompareActiveDate(ActiveDates: TStringList; EncDt: TFMDateTime):Boolean;
232       function RemDataChoiceActive(RData: TRemData; j: integer; EncDt: TFMDateTime):Boolean;
233       function GetValue: string;
234       procedure SetValueFromParent(Value: string);
235       procedure SetValue(Value: string);
236       procedure PromptChange(Sender: TObject);
237       procedure VitalVerify(Sender: TObject);
238       procedure ComboBoxKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
239       function CanShare(Prompt: TRemPrompt): boolean;
240       procedure InitValue;
241       procedure DoMHTest(Sender: TObject);
242       procedure DoWHReport(Sender: TObject);
243       procedure ViewWHText(Sender: TObject);
244       procedure GAFHelp(Sender: TObject);
245       function EntryID: string;
246       procedure EditKeyPress(Sender: TObject; var Key: Char);
247     public
248       constructor Create;
249       destructor Destroy; override;
250       function PromptOK: boolean;
251       function PromptType: TRemPromptType;
252       function Add2PN: boolean;
253       function InternalValue: string;
254       function Forced: boolean;
255       function Caption: string;
256       function ForcedCaption: string;
257       function SameLine: boolean;
258       function Required: boolean;
259       function NoteText: string;
260       function VitalType: TVitalType;
261       function VitalValue: string;
262       function VitalUnitValue: string;
263       property Value: string read GetValue write SetValue;
264     end;
265   
266     TRemPCERoot = class(TObject)
267     private
268       FData: TList;
269       FID: string;
270       FForcedPrompts: TStringList;
271       FValue: string;
272       FValueSet: string;
273     protected
274       class function GetRoot(Data: TRemData; Rec3: string; Historical: boolean): TRemPCERoot;
275       procedure Done(Data: TRemData);
276       procedure Sync(Prompt: TRemPrompt);
277       procedure UnSync(Prompt: TRemPrompt);
278       function GetValue(PromptType: TRemPromptType; var NewValue: string): boolean;
279     public
280       destructor Destroy; override;
281     end;
282   
283     TReminderStatus = (rsDue, rsApplicable, rsNotApplicable, rsNone, rsUnknown);
284   
285     TRemCanFinishProc = function: boolean of object;
286     TRemDisplayPCEProc = procedure of object;
287   
288     TRemForm = record
289       Form: TForm;
290       PCEObj: TPCEData;
291       RightPanel: TPanel;
292       CanFinishProc: TRemCanFinishProc;
293       DisplayPCEProc: TRemDisplayPCEProc;
294       Drawers: TfrmDrawers;
295       NewNoteRE: TRichEdit;
296       NoteList: TORListBox;
297     end;
298   
299   var
300     RemForm: TRemForm;
301     NotPurposeValue: string;
302     WHRemPrint: string;
303     InitialRemindersLoaded: boolean = FALSE;
304   
305   const
306     HAVE_REMINDERS = 0;
307     NO_REMINDERS = 1;
308     RemPriorityText: array[1..3] of string = ('High','','Low');
309     ClinMaintText = 'Clinical Maintenance';
310   
311     dtUnknown = TRemDataType(-1);
312     dtAll = TRemDataType(-2);
313     dtHistorical = TRemDataType(-3);
314   
315     ptUnknown = TRemPromptType(-1);
316     ptSubComment = TRemPromptType(-2);
317     ptDataList = TRemPromptType(-3);
318     ptVitalEntry = TRemPromptType(-4);
319     ptMHTest = TRemPromptType(-5);
320     ptGAF = TRemPromptType(-6);
321     ptMST = TRemPromptType(-7);
322   
323     MSTCode = 'MST';
324     MSTDataTypes = [pdcHF, pdcExam];
325     pnumMST = ord(pnumComment)+4;
326   
327   procedure NotifyWhenRemindersChange(Proc: TNotifyEvent);
328   procedure RemoveNotifyRemindersChange(Proc: TNotifyEvent);
329   procedure StartupReminders;
330   function GetReminderStatus: TReminderStatus;
331   function RemindersEvaluatingInBackground: boolean;
332   procedure ResetReminderLoad;
333   procedure LoadReminderData(ProcessingInBackground: boolean = FALSE);
334   function ReminderEvaluated(Data: string; ForceUpdate: boolean = FALSE): boolean;
335   procedure RemindersEvaluated(List: TStringList);
336   procedure EvalReminder(ien: integer);
337   procedure EvalProcessed;
338   procedure EvaluateCategoryClicked(AData: pointer; Sender: TObject);
339   
340   procedure SetReminderPopupRoutine(Menu: TPopupMenu);
341   procedure SetReminderPopupCoverRoutine(Menu: TPopupMenu);
342   procedure SetReminderMenuSelectRoutine(Menu: TMenuItem);
343   procedure BuildReminderTree(Tree: TORTreeView);
344   function ReminderNode(Node: TTreeNode): TORTreeNode;
345   procedure ClearReminderData;
346   function GetReminder(ARemData: string): TReminder;
347   procedure WordWrap(AText: string; Output: TStrings; LineLength: integer;
348                                                      AutoIndent: integer = 4; MHTest: boolean = false);
349   function InteractiveRemindersActive: boolean;
350   function GetReminderData(Rem: TReminderDialog; Lst: TStrings; Finishing: boolean = FALSE;
351                                            Historical: boolean = FALSE): integer; overload;
352   function GetReminderData(Lst: TStrings; Finishing: boolean = FALSE;
353                                            Historical: boolean = FALSE): integer; overload;
354   procedure SetReminderFormBounds(Frm: TForm; DefX, DefY, DefW, DefH, ALeft, ATop, AWidth, AHeight: integer);
355   
356   procedure UpdateReminderDialogStatus;
357   
358   //const
359   //  InteractiveRemindersActive = FALSE;
360   
361   var
362   { ActiveReminder string format:
363     IEN^PRINT NAME^DUE DATE/TIME^LAST OCCURENCE DATE/TIME^PRIORITY^DUE^DIALOG
364     where PRIORITY 1=High, 2=Normal, 3=Low
365           DUE      0=Applicable, 1=Due, 2=Not Applicable  }
366     ActiveReminders: TORStringList = nil;
367   
368   { OtherReminder string format:
369     IDENTIFIER^TYPE^NAME^PARENT IDENTIFIER^REMINDER IEN^DIALOG
370     where TYPE C=Category, R=Reminder }
371     OtherReminders: TORStringList = nil;
372   
373     RemindersInProcess: TORStringList = nil;
374     CoverSheetRemindersInBackground: boolean = FALSE;
375     KillReminderDialogProc: procedure(frm: TForm) = nil;
376     RemindersStarted: boolean = FALSE;
377     ProcessedReminders: TORStringList = nil;
378     ReminderDialogInfo: TStringList = nil;
379   
380   const
381     CatCode = 'C';
382     RemCode = 'R';
383     EduCode = 'E';
384     pnumVisitLoc  = pnumComment + 1;
385     pnumVisitDate = pnumComment + 2;
386     RemTreeDateIdx = 8;
387     IncludeParentID = ';';
388     OtherCatID = CatCode + '-6';
389   
390     RemDataCodes: array[TRemDataType] of string =
391                     { dtDiagnosis        } ('POV',
392                     { dtProcedure        }  'CPT',
393                     { dtPatientEducation }  'PED',
394                     { dtExam             }  'XAM',
395                     { dtHealthFactor     }  'HF',
396                     { dtImmunization     }  'IMM',
397                     { dtSkinTest         }  'SK',
398                     { dtVitals           }  'VIT',
399                     { dtOrder            }  'Q',
400                     { dtMentalHealthTest }  'MH',
401                     { dtWHPapResult      }  'WHR',
402                     { dtWHNotPurp        }  'WH');
403   
404   implementation
405   
406   uses rCore, uCore, rReminders, fRptBox, uConst, fReminderDialog, fNotes, rMisc,
407        fMHTest, rPCE, rTemplates, dShared, uTemplateFields, fIconLegend, fReminderTree, uInit,
408        VAUtils, VA508AccessibilityRouter, VA508AccessibilityManager, uDlgComponents,
409     fBase508Form;
410   
411   type
412     TRemFolder = (rfUnknown, rfDue, rfApplicable, rfNotApplicable, rfEvaluated, rfOther);
413     TRemFolders = set of TRemFolder;
414     TValidRemFolders = succ(low(TRemFolder)) .. high(TRemFolder);
415     TExposedComponent = class(TControl);
416   
417     TWHCheckBox = class(TCPRSDialogCheckBox)
418     private
419       FPrintNow: TCPRSDialogCheckBox;
420       FViewLetter: TCPRSDialogCheckBox;
421       FCheck1: TWHCheckBox;
422       FCheck2: TWHCheckBox;
423       FCheck3: TWHCheckBox;
424       FEdit: TEdit;
425       FButton: TButton;
426       FOnDestroy: TNotifyEvent;
427       Flbl, Flbl2: TControl;
428       FPrintVis: String;
429       //FPrintDevice: String;
430       FPntNow: String;
431       FPntBatch: String;
432       FButtonText: String;
433       FCheckNum: String;
434     protected  
435     public
436       property lbl: TControl read Flbl write Flbl;
437       property lbl2: TControl read Flbl2 write Flbl2;
438       property PntNow: String read FPntNow write FPntNow;
439       property PntBatch: String read FPntBatch write FPntBatch;
440       property CheckNum: String read FCheckNum write FCheckNum;
441       property ButtonText: String read FButtonText write FButtonText;
442       property PrintNow: TCPRSDialogCheckBox read FPrintNow write FPrintNow;
443       property Check1: TWHCheckBox read FCheck1 write FCheck1;
444       property Check2: TWHCheckBox read FCheck2 write FCheck2;
445       property Check3: TWHCheckBox read FCheck3 write FCheck3;
446       property ViewLetter: TCPRSDialogCheckBox read FViewLetter write FViewLetter;
447       property Button: TButton read FButton write FButton;
448       property Edit: TEdit read FEdit write FEdit;
449       property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
450       property PrintVis: String read FPrintVis write FPrintVis;
451     end;
452   
453   var
454     LastReminderLocation: integer = -2;
455     EvaluatedReminders: TORStringList = nil;
456     ReminderTreeMenu: TORPopupMenu = nil;
457     ReminderTreeMenuDlg: TORPopupMenu = nil;
458     ReminderCatMenu: TPopupMenu = nil;
459     EducationTopics: TORStringList = nil;
460     WebPages: TORStringList = nil;
461     ReminderCallList: TORStringList = nil;
462     LastProcessingList: string = '';
463     InteractiveRemindersActiveChecked: boolean = FALSE;
464     InteractiveRemindersActiveStatus: boolean = FALSE;
465     PCERootList: TStringList;
466     PrimaryDiagRoot: TRemPCERoot = nil;
467     ElementChecked: TRemDlgElement = nil;
468     HistRootCount: longint = 0;
469     uRemFolders: TRemFolders = [rfUnknown];
470     
471   const
472     DueText = 'Due';
473     ApplicableText = 'Applicable';
474     NotApplicableText = 'Not Applicable';
475     EvaluatedText = 'All Evaluated';
476     OtherText = 'Other Categories';
477   
478     DueCatID = CatCode + '-2';
479     DueCatString = DueCatID + U + DueText;
480   
481     ApplCatID = CatCode + '-3';
482     ApplCatString = ApplCatID + U + ApplicableText;
483   
484     NotApplCatID = CatCode + '-4';
485     NotApplCatString = NotApplCatID + U + NotApplicableText;
486   
487     EvaluatedCatID = CatCode + '-5';
488     EvaluatedCatString = EvaluatedCatID + U + EvaluatedText;
489   
490   //  OtherCatID = CatCode + '-6';
491     OtherCatString = OtherCatID + U + OtherText;
492   
493     LostCatID = CatCode + '-7';
494     LostCatString = LostCatID + U + 'In Process';
495   
496     ReminderDateFormat = 'mm/dd/yyyy';
497   
498     RemData2PCECat: array[TRemDataType] of TPCEDataCat =
499                     { dtDiagnosis        } (pdcDiag,
500                     { dtProcedure        }  pdcProc,
501                     { dtPatientEducation }  pdcPED,
502                     { dtExam             }  pdcExam,
503                     { dtHealthFactor     }  pdcHF,
504                     { dtImmunization     }  pdcImm,
505                     { dtSkinTest         }  pdcSkin,
506                     { dtVitals           }  pdcVital,
507                     { dtOrder            }  pdcOrder,
508                     { dtMentalHealthTest }  pdcMH,
509                     { dtWHPapResult      }  pdcWHR,
510                     { dtWHNotPurp        }  pdcWH);
511   
512     RemPromptCodes: array[TRemPromptType] of string =
513                     { ptComment             } ('COM',
514                     { ptVisitLocation       }  'VST_LOC',
515                     { ptVisitDate           }  'VST_DATE',
516                     { ptQuantity            }  'CPT_QTY',
517                     { ptPrimaryDiag         }  'POV_PRIM',
518                     { ptAdd2PL              }  'POV_ADD',
519                     { ptExamResults         }  'XAM_RES',
520                     { ptSkinResults         }  'SK_RES',
521                     { ptSkinReading         }  'SK_READ',
522                     { ptLevelSeverity       }  'HF_LVL',
523                     { ptSeries              }  'IMM_SER',
524                     { ptReaction            }  'IMM_RCTN',
525                     { ptContraindicated     }  'IMM_CNTR',
526                     { ptLevelUnderstanding  }  'PED_LVL',
527                     { ptWHPapResult         }  'WH_PAP_RESULT',
528                     { ptWHNotPurp           }  'WH_NOT_PURP');
529   
530     RemPromptTypes: array[TRemPromptType] of TRemDataType =
531                     { ptComment             } (dtAll,
532                     { ptVisitLocation       }  dtHistorical,
533                     { ptVisitDate           }  dtHistorical,
534                     { ptQuantity            }  dtProcedure,
535                     { ptPrimaryDiag         }  dtDiagnosis,
536                     { ptAdd2PL              }  dtDiagnosis,
537                     { ptExamResults         }  dtExam,
538                     { ptSkinResults         }  dtSkinTest,
539                     { ptSkinReading         }  dtSkinTest,
540                     { ptLevelSeverity       }  dtHealthFactor,
541                     { ptSeries              }  dtImmunization,
542                     { ptReaction            }  dtImmunization,
543                     { ptContraindicated     }  dtImmunization,
544                     { ptLevelUnderstanding  }  dtPatientEducation,
545                     { ptWHPapResult         }  dtWHPapResult,
546                     { ptWHNotPurp           }  dtWHNotPurp);
547   
548     FinishPromptPieceNum: array[TRemPromptType] of integer =
549                     { ptComment             } (pnumComment,
550                     { ptVisitLocation       }  pnumVisitLoc,
551                     { ptVisitDate           }  pnumVisitDate,
552                     { ptQuantity            }  pnumProcQty,
553                     { ptPrimaryDiag         }  pnumDiagPrimary,
554                     { ptAdd2PL              }  pnumDiagAdd2PL,
555                     { ptExamResults         }  pnumExamResults,
556                     { ptSkinResults         }  pnumSkinResults,
557                     { ptSkinReading         }  pnumSkinReading,
558                     { ptLevelSeverity       }  pnumHFLevel,
559                     { ptSeries              }  pnumImmSeries,
560                     { ptReaction            }  pnumImmReaction,
561                     { ptContraindicated     }  pnumImmContra,
562                     { ptLevelUnderstanding  }  pnumPEDLevel,
563                     { ptWHPapResult         }  pnumWHPapResult,
564                     { ptWHNotPurp           }  pnumWHNotPurp);
565   
566     ComboPromptTags: array[TRemPromptType] of integer =
567                     { ptComment             } (0,
568                     { ptVisitLocation       }  TAG_HISTLOC,
569                     { ptVisitDate           }  0,
570                     { ptQuantity            }  0,
571                     { ptPrimaryDiag         }  0,
572                     { ptAdd2PL              }  0,
573                     { ptExamResults         }  TAG_XAMRESULTS,
574                     { ptSkinResults         }  TAG_SKRESULTS,
575                     { ptSkinReading         }  0,
576                     { ptLevelSeverity       }  TAG_HFLEVEL,
577                     { ptSeries              }  TAG_IMMSERIES,
578                     { ptReaction            }  TAG_IMMREACTION,
579                     { ptContraindicated     }  0,
580                     { ptLevelUnderstanding  }  TAG_PEDLEVEL,
581                     { ptWHPapResult         }  0,
582                     { ptWHNotPurp           }  0);
583   
584     PromptDescriptions: array [TRemPromptType] of string =
585                     { ptComment             } ('Comment',
586                     { ptVisitLocation       }  'Visit Location',
587                     { ptVisitDate           }  'Visit Date',
588                     { ptQuantity            }  'Quantity',
589                     { ptPrimaryDiag         }  'Primary Diagnosis',
590                     { ptAdd2PL              }  'Add to Problem List',
591                     { ptExamResults         }  'Exam Results',
592                     { ptSkinResults         }  'Skin Test Results',
593                     { ptSkinReading         }  'Skin Test Reading',
594                     { ptLevelSeverity       }  'Level of Severity',
595                     { ptSeries              }  'Series',
596                     { ptReaction            }  'Reaction',
597                     { ptContraindicated     }  'Repeat Contraindicated',
598                     { ptLevelUnderstanding  }  'Level of Understanding',
599                     { ptWHPapResult         }  'Women''s Health Procedure',
600                     { ptWHNotPurp           }  'Women Health Notification Purpose');
601   
602     RemFolderCodes: array[TValidRemFolders] of char =
603        { rfDue           } ('D',
604        { rfApplicable    }  'A',
605        { rfNotApplicable }  'N',
606        { rfEvaluated     }  'E',
607        { rfOther         }  'O');
608   
609     MSTDescTxt: array[0..4,0..1] of string = (('Yes','Y'),('No','N'),('Declined','D'),
610                                               ('Normal','N'),('Abnormal','A'));
611   
612     SyncPrompts = [ptComment, ptQuantity, ptAdd2PL, ptExamResults,
613                    ptSkinResults, ptSkinReading, ptLevelSeverity, ptSeries,
614                    ptReaction, ptContraindicated, ptLevelUnderstanding];
615   
616     Gap = 3;
617     LblGap = 4;
618     IndentGap = 18;
619     PromptGap = 10;
620     NewLinePromptGap = 18;
621     IndentMult = 9;
622     PromptIndent = 30;
623     gbLeftIndent = 2;
624     gbTopIndent = 9;
625     gbTopIndent2 = 16;
626     DisabledFontColor = clBtnShadow;
627     r3Type = 4;
628     r3Code2 = 6;
629     r3Code = 7;
630     r3Cat  = 9;
631     r3Nar = 8;
632     r3GAF = 12;
633   
634     RemTreeCode = 999;
635   
636     CRCode = '<br>';
637     CRCodeLen = length(CRCode);
638     REMEntryCode = 'REM';
639   
640     MonthReqCode = 'M';
641   
642   function InitText(const InStr: string): string;
643   var
644     i: integer;
645   
646   begin
647     Result := InStr;
648     if(copy(Result, 1, CRCodeLen) = CRCode) then
649     begin
650       i := pos(CRCode, copy(Result, CRCodeLen+1, MaxInt));
651       if(i > 0) and ((i = (CRCodeLen + 1)) or
652         (Trim(copy(Result, CrCodeLen+1, i - 1)) = '')) then
653         delete(Result,1,CRCodeLen + i - 1);
654     end;
655   end;
656   
657   function CRLFText(const InStr: string): string;
658   var
659     i: integer;
660   
661   begin
662     Result := InitText(InStr);
663     repeat
664       i := pos(CRCode, Result);
665       if(i > 0) then
666         Result := copy(Result,1,i-1) + CRLF + copy(REsult,i + CRCodeLen, MaxInt);
667     until(i = 0);
668   end;
669   
670   function Code2VitalType(Code: string): TVitalType;
671   var
672     v: TVitalType;
673   
674   begin
675     Result := vtUnknown;
676     for v := low(TValidVitalTypes) to high(TValidVitalTypes) do
677     begin
678       if(Code = VitalPCECodes[v]) then
679       begin
680         Result := v;
681         break;
682       end;
683     end;
684   end;
685   
686   type
687     TMultiClassObj = record
688       case integer of
689         0: (edt:  TCPRSDialogFieldEdit);
690         1: (cb:   TCPRSDialogCheckBox);
691         2: (cbo:  TCPRSDialogComboBox);
692         3: (dt:   TCPRSDialogDateCombo);
693         4: (ctrl: TORExposedControl);
694         5: (vedt: TVitalEdit);
695         6: (vcbo: TVitalComboBox);
696         7: (btn:  TCPRSDialogButton);
697         8: (pNow: TORCheckBox);
698         9: (pBat: TORCheckBox);
699        10: (lbl: TLabel);
700        11: (WHChk: TWHCheckBox);
701     end;
702   
703     EForcedPromptConflict = class(EAbort);
704   
705   function IsSyncPrompt(pt: TRemPromptType): boolean;
706   begin
707     if(pt in SyncPrompts) then
708       Result := TRUE
709     else
710       Result := (pt = ptVitalEntry);
711   end;
712   
713   procedure NotifyWhenRemindersChange(Proc: TNotifyEvent);
714   begin
715     ActiveReminders.Notifier.NotifyWhenChanged(Proc);
716     OtherReminders.Notifier.NotifyWhenChanged(Proc);
717     RemindersInProcess.Notifier.NotifyWhenChanged(Proc);
718     Proc(nil);
719   end;
720   
721   procedure RemoveNotifyRemindersChange(Proc: TNotifyEvent);
722   begin
723     ActiveReminders.Notifier.RemoveNotify(Proc);
724     OtherReminders.Notifier.RemoveNotify(Proc);
725     RemindersInProcess.Notifier.RemoveNotify(Proc);
726   end;
727   
728   function ProcessingChangeString: string;
729   var
730     i: integer;
731     TmpSL: TStringList;
732   
733   begin
734     Result := U;
735     if(RemindersInProcess.Count > 0) then
736     begin
737       TmpSL := TStringList.Create;
738       try
739         FastAssign(RemindersInProcess, TmpSL);
740         TmpSL.Sort;
741         for i := 0 to TmpSL.Count-1 do
742         begin
743           if(TReminder(TmpSL.Objects[i]).Processing) then
744             Result := Result + TmpSL[i] + U;
745         end;
746       finally
747         TmpSL.Free;
748       end;
749     end;
750   end;
751   
752   procedure StartupReminders;
753   begin
754     if(not InitialRemindersLoaded) then
755     begin
756       RemindersStarted := TRUE;
757       InitialRemindersLoaded := TRUE;
758       LoadReminderData;
759     end;
760   end;
761   
762   function GetReminderStatus: TReminderStatus;
763   begin
764          if(EvaluatedReminders.IndexOfPiece('1',U,6) >= 0) then Result := rsDue
765     else if(EvaluatedReminders.IndexOfPiece('0',U,6) >= 0) then Result := rsApplicable
766     else if(EvaluatedReminders.IndexOfPiece('2',U,6) >= 0) then Result := rsNotApplicable
767     else                                                        Result := rsUnknown;
768   //  else if(EvaluatedReminders.Count > 0) or (OtherReminders.Count > 0) or
769   //         (not InitialRemindersLoaded) or
770   //         (ProcessingChangeString <> U) then Result := rsUnknown
771   //  else Result := rsNone;
772   end;
773   
774   function RemindersEvaluatingInBackground: boolean;
775   begin
776     Result := CoverSheetRemindersInBackground;
777     if(not Result) then
778       Result := (ReminderCallList.Count > 0)
779   end;
780   
781   var
782     TmpActive: TStringList = nil;
783     TmpOther: TStringList = nil;
784   
785   procedure BeginReminderUpdate;
786   begin
787     ActiveReminders.Notifier.BeginUpdate;
788     OtherReminders.Notifier.BeginUpdate;
789     TmpActive := TStringList.Create;
790     FastAssign(ActiveReminders, TmpActive);
791     TmpOther := TStringList.Create;
792     FastAssign(OtherReminders, TmpOther);
793   end;
794   
795   procedure EndReminderUpdate(Force: boolean = FALSE);
796   var
797     DoNotify: boolean;
798   
799   begin
800     DoNotify := Force;
801     if(not DoNotify) then
802       DoNotify := (not ActiveReminders.Equals(TmpActive));
803     KillObj(@TmpActive);
804     if(not DoNotify) then
805       DoNotify := (not OtherReminders.Equals(TmpOther));
806     KillObj(@TmpOther);
807     OtherReminders.Notifier.EndUpdate;
808     ActiveReminders.Notifier.EndUpdate(DoNotify);
809   end;
810   
811   function GetRemFolders: TRemFolders;
812   var
813     i: TRemFolder;
814     tmp: string;
815   
816   begin
817     if rfUnknown in uRemFolders then
818     begin
819       tmp := GetReminderFolders;
820       uRemFolders := [];
821       for i := low(TValidRemFolders) to high(TValidRemFolders) do
822         if(pos(RemFolderCodes[i], tmp) > 0) then
823           include(uRemFolders, i);
824     end;
825     Result := uRemFolders;
826   end;
827   
828   procedure SetRemFolders(const Value: TRemFolders);
829   var
830     i: TRemFolder;
831     tmp: string;
832   
833   begin
834     if(Value <> uRemFolders) then
835     begin
836       BeginReminderUpdate;
837       try
838         uRemFolders := Value;
839         tmp := '';
840         for i := low(TValidRemFolders) to high(TValidRemFolders) do
841           if(i in Value) then
842             tmp := tmp + RemFolderCodes[i];
843         SetReminderFolders(tmp);
844       finally
845         EndReminderUpdate(TRUE);
846       end;
847     end;
848   end;
849   
850   function ReminderEvaluated(Data: string; ForceUpdate: boolean = FALSE): boolean;
851   var
852     idx: integer;
853     Code, Sts, Before: string;
854   
855   begin
856     Result := ForceUpdate;
857     if(Data <> '') then
858     begin
859       Code := Piece(Data, U, 1);
860       if StrToIntDef(Code,0) > 0 then
861       begin
862         ActiveReminders.Notifier.BeginUpdate;
863         try
864           idx := EvaluatedReminders.IndexOfPiece(Code);
865           if(idx < 0) then
866           begin
867             EvaluatedReminders.Add(Data);
868             Result := TRUE;
869           end
870           else
871           begin
872             Before := Piece(EvaluatedReminders[idx], U, 6);
873             EvaluatedReminders[idx] := Data;
874             if(not Result) then
875               Result := (Before <> Piece(Data, U, 6));
876           end;
877           idx := ActiveReminders.IndexOfPiece(Code);
878           if(idx < 0) then
879           begin
880             Sts := Piece(Data, U, 6);
881             //if(Sts = '0') or (Sts = '1') then
882             if(Sts = '0') or (Sts = '1') or (Sts = '3') or (Sts = '4') then     //AGP Error change 26.8
883             begin
884               Result := TRUE;
885               ActiveReminders.Add(Data);
886             end;
887           end
888           else
889           begin
890             if(not Result) then
891               Result := (ActiveReminders[idx] <> Data);
892             ActiveReminders[idx] := Data;
893           end;
894           idx := ProcessedReminders.IndexOfPiece(Code);
895           if(idx >= 0) then
896             ProcessedReminders.Delete(idx);
897         finally
898           ActiveReminders.Notifier.EndUpdate(Result);
899         end;
900       end
901       else
902         Result := TRUE; // If Code = 0 then it's 0^No Reminders Due, indicating a status change.
903     end;
904   end;
905   
906   procedure RemindersEvaluated(List: TStringList);
907   var
908     i: integer;
909     DoUpdate, RemChanged: boolean;
910   
911   begin
912     DoUpdate := FALSE;
913     ActiveReminders.Notifier.BeginUpdate;
914     try
915       for i := 0 to List.Count-1 do
916       begin
917         RemChanged := ReminderEvaluated(List[i]);
918         if(RemChanged) then DoUpdate := TRUE;
919       end;
920     finally
921       ActiveReminders.Notifier.EndUpdate(DoUpdate);
922     end;
923   end;
924   
925   (*
926   procedure CheckReminders; forward;
927   
928   procedure IdleCallEvaluateReminder(Msg: string);
929   var
930     i:integer;
931     Code: string;
932   
933   begin
934     Code := Piece(Msg,U,1);
935     repeat
936       i := ReminderCallList.IndexOfPiece(Code);
937       if(i >= 0) then
938         ReminderCallList.Delete(i);
939     until(i < 0);
940     ReminderEvaluated(EvaluateReminder(Msg), (ReminderCallList.Count = 0));
941     CheckReminders;
942   end;
943   
944   procedure CheckReminders;
945   var
946     i:integer;
947   
948   begin
949     for i := ReminderCallList.Count-1 downto 0 do
950       if(EvaluatedReminders.IndexOfPiece(Piece(ReminderCallList[i], U, 1)) >= 0) then
951         ReminderCallList.Delete(i);
952     if(ReminderCallList.Count > 0) then
953       CallRPCWhenIdle(IdleCallEvaluateReminder,ReminderCallList[0])
954   end;
955   *)
956   
957   procedure CheckReminders;
958   var
959     RemList: TStringList;
960     i: integer;
961     Code: string;
962   
963   begin
964     for i := ReminderCallList.Count-1 downto 0 do
965       if(EvaluatedReminders.IndexOfPiece(Piece(ReminderCallList[i],U,1)) >= 0) then
966         ReminderCallList.Delete(i);
967     if(ReminderCallList.Count > 0) then
968     begin
969       RemList := TStringList.Create;
970       try
971         while (ReminderCallList.Count > 0) do
972         begin
973           Code := Piece(ReminderCallList[0],U,1);
974           ReminderCallList.Delete(0);
975           repeat
976             i := ReminderCallList.IndexOfPiece(Code);
977             if(i >= 0) then
978               ReminderCallList.Delete(i);
979           until(i < 0);
980           RemList.Add(Code);
981         end;
982         if(RemList.Count > 0) then
983         begin
984           EvaluateReminders(RemList);
985           FastAssign(RPCBrokerV.Results, RemList);
986           for i := 0 to RemList.Count-1 do
987             ReminderEvaluated(RemList[i], (i = (RemList.Count-1)));
988         end;
989       finally
990         RemList.Free;
991       end;
992     end;
993   end;
994   
995   procedure ResetReminderLoad;
996   begin
997     LastReminderLocation := -2;
998     LoadReminderData;
999   end;
1000  
1001  procedure LoadReminderData(ProcessingInBackground: boolean = FALSE);
1002  var
1003    i, idx: integer;
1004    RemID: string;
1005    TempList: TORStringList;
1006  
1007  begin
1008    if(RemindersStarted and (LastReminderLocation <> Encounter.Location)) then
1009    begin
1010      LastReminderLocation := Encounter.Location;
1011      BeginReminderUpdate;
1012      try
1013        GetCurrentReminders;
1014        TempList := TORStringList.Create;
1015        try
1016          if(RPCBrokerV.Results.Count > 0) then
1017          begin
1018            for i := 0 to RPCBrokerV.Results.Count-1 do
1019            begin
1020              RemID := RPCBrokerV.Results[i];
1021              idx := EvaluatedReminders.IndexOfPiece(RemID);
1022              if(idx < 0) then
1023              begin
1024                TempList.Add(RemID);
1025                if(not ProcessingInBackground) then
1026                  ReminderCallList.Add(RemID);
1027              end
1028              else
1029                TempList.Add(EvaluatedReminders[idx]);
1030            end;
1031          end;
1032          // FastAssign(TempList,ActiveReminders);
1033          for i := 0 to TempList.Count-1 do
1034          begin
1035            RemID := Piece(TempList[i],U,1);
1036            if(ActiveReminders.indexOfPiece(RemID) < 0) then
1037              ActiveReminders.Add(TempList[i]);
1038          end;
1039        finally
1040          TempList.Free;
1041        end;
1042        CheckReminders;
1043        GetOtherReminders(OtherReminders);
1044      finally
1045        EndReminderUpdate;
1046      end;
1047    end;
1048  end;
1049  
1050  { Supporting events for Reminder TreeViews }
1051  
1052  procedure GetImageIndex(AData: Pointer; Sender: TObject; Node: TTreeNode);
1053  var
1054    iidx, oidx: integer;
1055    Data, Tmp: string;
1056  
1057  begin
1058    if(Assigned(Node)) then
1059    begin
1060      oidx := -1;
1061      Data := (Node as TORTreeNode).StringData;
1062      if(copy(Piece(Data, U, 1),1,1) = CatCode) then
1063      begin
1064        if(Node.Expanded) then
1065          iidx := 1
1066        else
1067          iidx := 0;
1068      end
1069      else
1070      begin
1071        Tmp := Piece(Data, U, 6);
1072        //if(Tmp = '1') then iidx := 2
1073        if (Tmp = '3') or (Tmp = '4') or (Tmp = '1') then iidx :=2     //AGP ERROR CHANGE 26.8
1074        else if(Tmp = '0') then iidx := 3
1075        else
1076        begin
1077          if(EvaluatedReminders.IndexOfPiece(copy(Piece(Data, U, 1),2,MaxInt),U,1) < 0) then
1078            iidx := 5
1079          else
1080            iidx := 4;
1081        end;
1082  
1083        if(Piece(Data,U,7) = '1') then
1084        begin
1085          Tmp := copy(Piece(Data, U, 1),2,99);
1086          if(ProcessedReminders.IndexOfPiece(Tmp,U,1) >=0) then
1087            oidx := 1
1088          else
1089            oidx:= 0;
1090        end;
1091      end;
1092      Node.ImageIndex := iidx;
1093      Node.SelectedIndex := iidx;
1094      if(Node.OverlayIndex <> oidx) then
1095      begin
1096        Node.OverlayIndex := oidx;
1097        Node.TreeView.Invalidate;
1098      end;
1099    end;
1100  end;
1101  
1102  type
1103    TRemMenuCmd = (rmClinMaint, rmEdu, rmInq, rmWeb, rmDash, rmEval,
1104                   rmDue, rmApplicable, rmNotApplicable, rmEvaluated, rmOther,
1105                   rmLegend);
1106    TRemViewCmds = rmDue..rmOther;
1107  
1108  const
1109    RemMenuFolder: array[TRemViewCmds] of TRemFolder =
1110                             { rmDue           } (rfDue,
1111                             { rmApplicable    }  rfApplicable,
1112                             { rmNotApplicable }  rfNotApplicable,
1113                             { rmEvaluated     }  rfEvaluated,
1114                             { rmOther         }  rfOther);
1115  
1116    RemMenuNames: array[TRemMenuCmd] of string = (
1117                             { rmClinMaint     }  ClinMaintText,
1118                             { rmEdu           }  'Education Topic Definition',
1119                             { rmInq           }  'Reminder Inquiry',
1120                             { rmWeb           }  'Reference Information',
1121                             { rmDash          }  '-',
1122                             { rmEval          }  'Evaluate Reminder',
1123                             { rmDue           }  DueText,
1124                             { rmApplicable    }  ApplicableText,
1125                             { rmNotApplicable }  NotApplicableText,
1126                             { rmEvaluated     }  EvaluatedText,
1127                             { rmOther         }  OtherText,
1128                             { rmLegend        }  'Reminder Icon Legend');
1129  
1130  
1131    EvalCatName = 'Evaluate Category Reminders';
1132  
1133  function GetEducationTopics(EIEN: string): string;
1134  var
1135    i, idx: integer;
1136    Tmp, Data: string;
1137  
1138  begin
1139    if(not assigned(EducationTopics)) then
1140      EducationTopics := TORStringList.Create;
1141    idx := EducationTopics.IndexOfPiece(EIEN);
1142    if(idx < 0) then
1143    begin
1144      Tmp := copy(EIEN,1,1);
1145      idx := StrToIntDef(copy(EIEN,2,MaxInt),0);
1146      if(Tmp = RemCode) then
1147        GetEducationTopicsForReminder(idx)
1148      else
1149      if(Tmp = EduCode) then
1150        GetEducationSubtopics(idx)
1151      else
1152        RPCBrokerV.Results.Clear;
1153      Tmp := EIEN;
1154      if(RPCBrokerV.Results.Count > 0) then
1155      begin
1156        for i := 0 to RPCBrokerV.Results.Count-1 do
1157        begin
1158          Data := RPCBrokerV.Results[i];
1159          Tmp := Tmp + U + Piece(Data, U, 1) + ';';
1160          if(Piece(Data, U, 3) = '') then
1161            Tmp := Tmp + Piece(Data, U, 2)
1162          else
1163            Tmp := Tmp + Piece(Data, U, 3);
1164        end;
1165      end;
1166      idx := EducationTopics.Add(Tmp);
1167    end;
1168    Result := EducationTopics[idx];
1169    idx := pos(U, Result);
1170    if(idx > 0) then
1171      Result := copy(Result,Idx+1,MaxInt)
1172    else
1173      Result := '';
1174  end;
1175  
1176  function GetWebPageName(idx :integer): string;
1177  begin
1178    Result := Piece(WebPages[idx],U,2);
1179  end;
1180  
1181  function GetWebPageAddress(idx: integer): string;
1182  begin
1183    Result := Piece(WebPages[idx],U,3);
1184  end;
1185  
1186  function GetWebPages(EIEN: string): string; overload;
1187  var
1188    i, idx: integer;
1189    Tmp, Data, Title: string;
1190    RIEN: string;
1191  
1192  begin
1193    RIEN := RemCode + EIEN;
1194    if(not assigned(WebPages)) then
1195      WebPages := TORStringList.Create;
1196    idx := WebPages.IndexOfPiece(RIEN);
1197    if(idx < 0) then
1198    begin
1199      GetReminderWebPages(EIEN);
1200      Tmp := RIEN;
1201      if(RPCBrokerV.Results.Count > 0) then
1202      begin
1203        for i := 0 to RPCBrokerV.Results.Count-1 do
1204        begin
1205          Data := RPCBrokerV.Results[i];
1206          if(Piece(Data,U,1) = '1') and (Piece(Data,U,3) <> '') then
1207          begin
1208            Data := U + Piece(Data,U,4) + U + Piece(Data,U,3);
1209            if(Piece(Data,U,2) = '') then
1210            begin
1211              Title := Piece(data,U,3);
1212              if(length(Title) > 60) then
1213                Title := copy(Title,1,57) + '...';
1214              SetPiece(Data,U,2,Title);
1215            end;
1216            //if(copy(UpperCase(Piece(Data, U, 3)),1,7) <> 'HTTP://') then
1217            //  SetPiece(Data, U, 3,'http://'+Piece(Data,U,3));
1218            idx := WebPages.IndexOf(Data);
1219            if(idx < 0) then
1220              idx := WebPages.Add(Data);
1221            Tmp := Tmp + U + IntToStr(idx);
1222          end;
1223        end;
1224      end;
1225      idx := WebPages.Add(Tmp);
1226    end;
1227    Result := WebPages[idx];
1228    idx := pos(U, Result);
1229    if(idx > 0) then
1230      Result := copy(Result,Idx+1,MaxInt)
1231    else
1232      Result := '';
1233  end;
1234  
1235  function ReminderName(IEN: integer): string;
1236  var
1237    idx: integer;
1238    SIEN: string;
1239  
1240  begin
1241    SIEN := IntToStr(IEN);
1242    Result := '';
1243    idx := EvaluatedReminders.IndexOfPiece(SIEN);
1244    if(idx >= 0) then
1245      Result := piece(EvaluatedReminders[idx],U,2);
1246    if(Result = '') then
1247    begin
1248      idx := ActiveReminders.IndexOfPiece(SIEN);
1249      if(idx >= 0) then
1250        Result := piece(ActiveReminders[idx],U,2);
1251    end;
1252    if(Result = '') then
1253    begin
1254      idx := OtherReminders.IndexOfPiece(SIEN, U, 5);
1255      if(idx >= 0) then
1256        Result := piece(OtherReminders[idx],U,3);
1257    end;
1258    if(Result = '') then
1259    begin
1260      idx := RemindersInProcess.IndexOfPiece(SIEN);
1261      if(idx >= 0) then
1262        Result := TReminder(RemindersInProcess.Objects[idx]).PrintName;
1263    end;
1264  end;
1265  
1266  procedure ReminderClinMaintClicked(AData: pointer; Sender: TObject);
1267  var
1268    ien: integer;
1269  
1270  begin
1271    ien := (Sender as TMenuItem).Tag;
1272    if(ien > 0) then
1273      ReportBox(DetailReminder(ien), RemMenuNames[rmClinMaint] + ': '+ ReminderName(ien), TRUE);
1274  end;
1275  
1276  procedure ReminderEduClicked(AData: pointer; Sender: TObject);
1277  var
1278    ien: integer;
1279  
1280  begin
1281    ien := (Sender as TMenuItem).Tag;
1282    if(ien > 0) then
1283      ReportBox(EducationTopicDetail(ien), 'Education Topic: ' + (Sender as TMenuItem).Caption, TRUE);
1284  end;
1285  
1286  procedure ReminderInqClicked(AData: pointer; Sender: TObject);
1287  var
1288    ien: integer;
1289  
1290  begin
1291    ien := (Sender as TMenuItem).Tag;
1292    if(ien > 0) then
1293      ReportBox(ReminderInquiry(ien), 'Reminder Inquiry: '+ ReminderName(ien), TRUE);
1294  end;
1295  
1296  procedure ReminderWebClicked(AData: pointer; Sender: TObject);
1297  var
1298    idx: integer;
1299  
1300  begin
1301    idx := (Sender as TMenuItem).Tag-1;
1302    if(idx >= 0) then
1303      GotoWebPage(GetWebPageAddress(idx));
1304  end;
1305  
1306  procedure EvalReminder(ien: integer);
1307  var
1308    Msg, RName: string;
1309    NewStatus: string;
1310  
1311  begin
1312    if(ien > 0) then
1313    begin
1314      NewStatus := EvaluateReminder(IntToStr(ien));
1315      ReminderEvaluated(NewStatus);
1316      NewStatus := piece(NewStatus,U,6);
1317      RName := ReminderName(ien);
1318      if(RName = '') then RName := 'Reminder';
1319           if(NewStatus = '1') then Msg := 'Due'
1320      else if(NewStatus = '0') then Msg := 'Applicable'
1321      else if(NewStatus = '3') then Msg := 'Error'    //AGP Error code change 26.8
1322      else if (NewStatus = '4') then Msg := 'CNBD'    //AGP Error code change 26.8
1323      else                          Msg := 'Not Applicable';
1324      Msg := RName + ' is ' + Msg + '.';
1325      InfoBox(Msg, RName + ' Evaluation', MB_OK);
1326    end;
1327  end;
1328  
1329  procedure EvalProcessed;
1330  var
1331    i: integer;
1332  
1333  begin
1334    if(ProcessedReminders.Count > 0) then
1335    begin
1336      BeginReminderUpdate;
1337      try
1338        while(ProcessedReminders.Count > 0) do
1339        begin
1340          if(ReminderCallList.IndexOf(ProcessedReminders[0]) < 0) then
1341            ReminderCallList.Add(ProcessedReminders[0]);
1342          repeat
1343            i := EvaluatedReminders.IndexOfPiece(Piece(ProcessedReminders[0],U,1));
1344            if(i >= 0) then
1345              EvaluatedReminders.Delete(i);
1346          until(i < 0);
1347          ProcessedReminders.Delete(0);
1348        end;
1349        CheckReminders;
1350      finally
1351        EndReminderUpdate(TRUE);
1352      end;
1353    end;
1354  end;
1355  
1356  procedure ReminderEvalClicked(AData: pointer; Sender: TObject);
1357  begin
1358    EvalReminder((Sender as TMenuItem).Tag);
1359  end;
1360  
1361  procedure ReminderViewFolderClicked(AData: pointer; Sender: TObject);
1362  var
1363    rfldrs: TRemFolders;
1364    rfldr: TRemFolder;
1365  
1366  begin
1367    rfldrs := GetRemFolders;
1368    rfldr := TRemFolder((Sender as TMenuItem).Tag);
1369    if rfldr in rfldrs then
1370      exclude(rfldrs, rfldr)
1371    else
1372      include(rfldrs, rfldr);
1373    SetRemFolders(rfldrs);
1374  end;
1375  
1376  procedure EvaluateCategoryClicked(AData: pointer; Sender: TObject);
1377  var
1378    Node: TORTreeNode;
1379    Code: string;
1380    i: integer;
1381  
1382  begin
1383    if(Sender is TMenuItem) then
1384    begin
1385      BeginReminderUpdate;
1386      try
1387        Node := TORTreeNode(TORTreeNode(TMenuItem(Sender).Tag).GetFirstChild);
1388        while assigned(Node) do
1389        begin
1390          Code := Piece(Node.StringData,U,1);
1391          if(copy(Code,1,1) = RemCode) then
1392          begin
1393            Code := copy(Code,2,MaxInt);
1394            if(ReminderCallList.IndexOf(Code) < 0) then
1395              ReminderCallList.Add(copy(Node.StringData,2,MaxInt));
1396            repeat
1397              i := EvaluatedReminders.IndexOfPiece(Code);
1398              if(i >= 0) then
1399                EvaluatedReminders.Delete(i);
1400            until(i < 0);
1401          end;
1402          Node := TORTreeNode(Node.GetNextSibling);
1403        end;
1404        CheckReminders;
1405      finally
1406        EndReminderUpdate(TRUE);
1407      end;
1408    end;
1409  end;
1410  
1411  procedure ReminderIconLegendClicked(AData: pointer; Sender: TObject);
1412  begin
1413    ShowIconLegend(ilReminders);
1414  end;
1415  
1416  procedure ReminderMenuBuilder(MI: TMenuItem; RemStr: string;
1417                                IncludeActions, IncludeEval, ViewFolders: boolean);
1418  var
1419    M: TMethod;
1420    Tmp: string;
1421    Cnt: integer;
1422    RemID: integer;
1423    cmd: TRemMenuCmd;
1424  
1425    function Add(Text: string; Parent: TMenuItem; Tag: integer; Typ: TRemMenuCmd): TORMenuItem;
1426    var
1427      InsertMenu: boolean;
1428      idx: integer;
1429  
1430    begin
1431      Result := nil;
1432      InsertMenu := TRUE;
1433      if(Parent = MI) then
1434      begin
1435        if(MI.Count > Cnt) then
1436        begin
1437          Result := TORMenuItem(MI.Items[Cnt]);
1438          Result.Enabled := TRUE;
1439          Result.Visible := TRUE;
1440          Result.ImageIndex := -1;
1441          while Result.Count > 0 do
1442            Result.Delete(Result.Count-1);
1443          InsertMenu := FALSE;
1444        end;
1445        inc(Cnt);
1446      end;
1447      if(not assigned(Result)) then
1448        Result := TORMenuItem.Create(MI);
1449      if(Text = '') then
1450        Result.Caption := RemMenuNames[Typ]
1451      else
1452        Result.Caption := Text;
1453      Result.Tag := Tag;
1454      Result.Data := RemStr;
1455      if(Tag <> 0) then
1456      begin
1457        case Typ of
1458          rmClinMaint:  M.Code := @ReminderClinMaintClicked;
1459          rmEdu:        M.Code := @ReminderEduClicked;
1460          rmInq:        M.Code := @ReminderInqClicked;
1461          rmWeb:        M.Code := @ReminderWebClicked;
1462          rmEval:       M.Code := @ReminderEvalClicked;
1463          rmDue..rmOther:
1464            begin
1465              M.Code := @ReminderViewFolderClicked;
1466              case Typ of
1467                rmDue:           idx := 0;
1468                rmApplicable:    idx := 2;
1469                rmNotApplicable: idx := 4;
1470                rmEvaluated:     idx := 6;
1471                rmOther:         idx := 8;
1472                else             idx := -1;
1473              end;
1474              if(idx >= 0) and (RemMenuFolder[Typ] in GetRemFolders) then
1475                inc(idx);
1476              Result.ImageIndex := idx;
1477            end;
1478          rmLegend:     M.Code := @ReminderIconLegendClicked;
1479          else
1480            M.Code := nil;
1481        end;
1482        if(assigned(M.Code)) then
1483          Result.OnClick := TNotifyEvent(M)
1484        else
1485          Result.OnClick := nil;
1486      end;
1487      if(InsertMenu) then
1488        Parent.Add(Result);
1489    end;
1490  
1491    procedure AddEducationTopics(Item: TMenuItem; EduStr: string);
1492    var
1493      i, j: integer;
1494      Code: String;
1495      NewEduStr: string;
1496      itm: TMenuItem;
1497  
1498    begin
1499      if(EduStr <> '') then
1500      begin
1501        repeat
1502          i := pos(';', EduStr);
1503          j := pos(U, EduStr);
1504          if(j = 0) then j := length(EduStr)+1;
1505          Code := copy(EduStr,1,i-1);
1506          //AddEducationTopics(Add(copy(EduStr,i+1,j-i-1), Item, StrToIntDef(Code, 0), rmEdu),
1507          //                   GetEducationTopics(EduCode + Code));
1508  
1509          NewEduStr := GetEducationTopics(EduCode + Code);
1510          if(NewEduStr = '') then
1511            Add(copy(EduStr,i+1,j-i-1), Item, StrToIntDef(Code, 0), rmEdu)
1512          else
1513          begin
1514            itm := Add(copy(EduStr,i+1,j-i-1), Item, 0, rmEdu);
1515            Add(copy(EduStr,i+1,j-i-1), itm, StrToIntDef(Code, 0), rmEdu);
1516            Add('', Itm, 0, rmDash);
1517            AddEducationTopics(itm, NewEduStr);
1518          end;
1519  
1520          delete(EduStr,1,j);
1521        until(EduStr = '');
1522      end;
1523    end;
1524  
1525    procedure AddWebPages(Item: TMenuItem; WebStr: string);
1526    var
1527      i, idx: integer;
1528  
1529    begin
1530      if(WebStr <> '') then
1531      begin
1532        repeat
1533          i := pos(U, WebStr);
1534          if(i = 0) then i := length(WebStr)+1;
1535          idx := StrToIntDef(copy(WebStr,1,i-1),-1);
1536          if(idx >= 0) then
1537            Add(GetWebPageName(idx), Item, idx+1, rmWeb);
1538          delete(WebStr,1,i);
1539        until(WebStr = '');
1540      end;
1541    end;
1542  
1543  
1544  begin
1545    RemID := StrToIntDef(copy(Piece(RemStr,U,1),2,MaxInt),0);
1546    Cnt := 0;
1547    M.Data := nil;
1548  
1549    if(RemID > 0) then
1550    begin
1551      Add('', MI, RemID, rmClinMaint);
1552      Tmp := GetEducationTopics(RemCode + IntToStr(RemID));
1553      if(Tmp <> '') then
1554        AddEducationTopics(Add('', MI, 0, rmEdu), Tmp)
1555      else
1556        Add('', MI, 0, rmEdu).Enabled := FALSE;
1557      Add('', MI, RemID, rmInq);
1558      Tmp := GetWebPages(IntToStr(RemID));
1559      if(Tmp <> '') then
1560        AddWebPages(Add('', MI, 0, rmWeb), Tmp)
1561      else
1562        Add('', MI, 0, rmWeb).Enabled := FALSE;
1563  
1564      if(IncludeActions or IncludeEval) then
1565      begin
1566        Add('', MI, 0, rmDash);
1567        Add('', MI, RemID, rmEval);
1568      end;
1569    end;
1570  
1571    if(ViewFolders) then
1572    begin
1573      Add('', MI, 0, rmDash);
1574      for cmd := low(TRemViewCmds) to high(TRemViewCmds) do
1575        Add('', MI, ord(RemMenuFolder[cmd]), cmd);
1576    end;
1577  
1578    Add('', MI, 0, rmDash);
1579    Add('', MI, 1, rmLegend);
1580  
1581    while MI.Count > Cnt do
1582      MI.Delete(MI.Count-1);
1583  end;
1584  
1585  procedure ReminderTreePopup(AData: pointer; Sender: TObject);
1586  begin
1587    ReminderMenuBuilder((Sender as TPopupMenu).Items, (Sender as TORPopupMenu).Data, TRUE, FALSE, FALSE);
1588  end;
1589  
1590  procedure ReminderTreePopupCover(AData: pointer; Sender: TObject);
1591  begin
1592    ReminderMenuBuilder((Sender as TPopupMenu).Items, (Sender as TORPopupMenu).Data, FALSE, FALSE, FALSE);
1593  end;
1594  
1595  procedure ReminderTreePopupDlg(AData: pointer; Sender: TObject);
1596  begin
1597    ReminderMenuBuilder((Sender as TPopupMenu).Items, (Sender as TORPopupMenu).Data, FALSE, TRUE, FALSE);
1598  end;
1599  
1600  procedure ReminderMenuItemSelect(AData: pointer; Sender: TObject);
1601  begin
1602    ReminderMenuBuilder((Sender as TMenuItem), (Sender as TORMenuItem).Data, FALSE, FALSE, TRUE);
1603  end;
1604  
1605  procedure SetReminderPopupRoutine(Menu: TPopupMenu);
1606  var
1607    M: TMethod;
1608  
1609  begin
1610    M.Code := @ReminderTreePopup;
1611    M.Data := nil;
1612    Menu.OnPopup := TNotifyEvent(M);
1613  end;
1614  
1615  procedure SetReminderPopupCoverRoutine(Menu: TPopupMenu);
1616  var
1617    M: TMethod;
1618  
1619  begin
1620    M.Code := @ReminderTreePopupCover;
1621    M.Data := nil;
1622    Menu.OnPopup := TNotifyEvent(M);
1623  end;
1624  
1625  procedure SetReminderPopupDlgRoutine(Menu: TPopupMenu);
1626  var
1627    M: TMethod;
1628  
1629  begin
1630    M.Code := @ReminderTreePopupDlg;
1631    M.Data := nil;
1632    Menu.OnPopup := TNotifyEvent(M);
1633  end;
1634  
1635  procedure SetReminderMenuSelectRoutine(Menu: TMenuItem);
1636  var
1637    M: TMethod;
1638  
1639  begin
1640    M.Code := @ReminderMenuItemSelect;
1641    M.Data := nil;
1642    Menu.OnClick := TNotifyEvent(M);
1643  end;
1644  
1645  function ReminderMenu(Sender: TComponent): TORPopupMenu;
1646  begin
1647    if(Sender.Tag = RemTreeCode) then
1648    begin
1649      if(not assigned(ReminderTreeMenuDlg)) then
1650      begin
1651        ReminderTreeMenuDlg := TORPopupMenu.Create(nil);
1652        SetReminderPopupDlgRoutine(ReminderTreeMenuDlg)
1653      end;
1654      Result := ReminderTreeMenuDlg;
1655    end
1656    else
1657    begin
1658      if(not assigned(ReminderTreeMenu)) then
1659      begin
1660        ReminderTreeMenu := TORPopupMenu.Create(nil);
1661        SetReminderPopupRoutine(ReminderTreeMenu);
1662      end;
1663      Result := ReminderTreeMenu;
1664    end;
1665  end;
1666  
1667  procedure RemContextPopup(AData: Pointer; Sender: TObject; MousePos: TPoint;
1668                            var Handled: Boolean);
1669  var
1670    Menu: TORPopupMenu;
1671    MItem: TMenuItem;
1672    M: TMethod;
1673    p1: string;
1674    UpdateMenu: boolean;
1675  
1676  begin
1677    UpdateMenu := TRUE;
1678    Menu := nil;
1679    with (Sender as TORTreeView) do
1680    begin
1681      if((htOnItem in GetHitTestInfoAt(MousePos.X, MousePos.Y)) and (assigned(Selected))) then
1682      begin
1683        p1 := Piece((Selected as TORTreeNode).StringData, U, 1);
1684        if(Copy(p1,1,1) = RemCode) then
1685        begin
1686          Menu := ReminderMenu(TComponent(Sender));
1687          Menu.Data := TORTreeNode(Selected).StringData;
1688        end
1689        else
1690        if(Copy(p1,1,1) = CatCode) and (p1 <> OtherCatID) and (Selected.HasChildren) then
1691        begin
1692          if(not assigned(ReminderCatMenu)) then
1693          begin
1694            ReminderCatMenu := TPopupMenu.Create(nil);
1695            MItem := TMenuItem.Create(ReminderCatMenu);
1696            MItem.Caption := EvalCatName;
1697            M.Data := nil;
1698            M.Code := @EvaluateCategoryClicked;
1699            MItem.OnClick := TNotifyEvent(M);
1700            ReminderCatMenu.Items.Add(MItem);
1701          end
1702          else
1703            MItem := ReminderCatMenu.Items[0];
1704          PopupMenu := ReminderCatMenu;
1705          MItem.Tag := Integer(TORTreeNode(Selected));
1706          UpdateMenu := FALSE;
1707        end;
1708      end;
1709      if UpdateMenu then
1710        PopupMenu := Menu;
1711      Selected := Selected; // This strange line Keeps item selected after a right click
1712      if(not assigned(PopupMenu)) then
1713        Handled := TRUE;
1714    end;
1715  end;
1716  
1717  { StringData of the TORTreeNodes will be in the format:
1718    1          2          3             4                        5        6   7
1719    TYPE + IEN^PRINT NAME^DUE DATE/TIME^LAST OCCURENCE DATE/TIME^PRIORITY^DUE^DIALOG
1720           8                 9                            10
1721           Formated Due Date^Formated Last Occurence Date^InitialAbsoluteIdx
1722  
1723    where TYPE     C=Category, R=Reminder
1724          PRIORITY 1=High, 2=Normal, 3=Low
1725          DUE      0=Applicable, 1=Due, 2=Not Applicable
1726          DIALOG   1=Active Dialog Exists
1727  }
1728  procedure BuildReminderTree(Tree: TORTreeView);
1729  var
1730    ExpandedStr: string;
1731    TopID1, TopID2: string;
1732    SelID1, SelID2: string;
1733    i, j: integer;
1734    NeedLost: boolean;
1735    Tmp, Data, LostCat, Code: string;
1736    Node: TORTreeNode;
1737    M: TMethod;
1738    Rem: TReminder;
1739    OpenDue, Found: boolean;
1740  
1741    function Add2Tree(Folder: TRemFolder; CatID: string; Node: TORTreeNode = nil): TORTreeNode;
1742    begin
1743      if (Folder = rfUnknown) or (Folder in GetRemFolders) then
1744      begin
1745        if(CatID = LostCatID) then
1746        begin
1747          if(NeedLost) then
1748          begin
1749            (Tree.Items.AddFirst(nil,'') as TORTreeNode).StringData := LostCatString;
1750            NeedLost := FALSE;
1751          end;
1752        end;
1753  
1754        if(not assigned(Node)) then
1755          Node := Tree.FindPieceNode(CatID, 1);
1756        if(assigned(Node)) then
1757        begin
1758          Result := (Tree.Items.AddChild(Node,'') as TORTreeNode);
1759          Result.StringData := Data;
1760        end
1761        else
1762          Result := nil;
1763      end
1764      else
1765        Result := nil;
1766    end;
1767  
1768  begin
1769    if(not assigned(Tree)) then exit;
1770    Tree.Items.BeginUpdate;
1771    try
1772      Tree.NodeDelim := U;
1773      Tree.NodePiece := 2;
1774      M.Code := @GetImageIndex;
1775      M.Data := nil;
1776      Tree.OnGetImageIndex := TTVExpandedEvent(M);
1777      Tree.OnGetSelectedIndex := TTVExpandedEvent(M);
1778      M.Code := @RemContextPopup;
1779      Tree.OnContextPopup := TContextPopupEvent(M);
1780  
1781      if(assigned(Tree.TopItem)) then
1782      begin
1783        TopID1 := Tree.GetNodeID(TORTreeNode(Tree.TopItem), 1, IncludeParentID);
1784        TopID2 := Tree.GetNodeID(TORTreeNode(Tree.TopItem), 1);
1785      end
1786      else
1787        TopID1 := U;
1788  
1789      if(assigned(Tree.Selected)) then
1790      begin
1791        SelID1 := Tree.GetNodeID(TORTreeNode(Tree.Selected), 1, IncludeParentID);
1792        SelID2 := Tree.GetNodeID(TORTreeNode(Tree.Selected), 1);
1793      end
1794      else
1795        SelID1 := U;
1796  
1797      ExpandedStr := Tree.GetExpandedIDStr(1, IncludeParentID);
1798      OpenDue := (ExpandedStr = '');
1799  
1800      Tree.Items.Clear;
1801      NeedLost := TRUE;
1802  
1803      if(rfDue in GetRemFolders) then
1804        (Tree.Items.Add(nil,'') as TORTreeNode).StringData := DueCatString;
1805      if(rfApplicable in GetRemFolders) then
1806        (Tree.Items.Add(nil,'') as TORTreeNode).StringData := ApplCatString;
1807      if(rfNotApplicable in GetRemFolders) then
1808        (Tree.Items.Add(nil,'') as TORTreeNode).StringData := NotApplCatString;
1809      if(rfEvaluated in GetRemFolders) then
1810        (Tree.Items.Add(nil,'') as TORTreeNode).StringData := EvaluatedCatString;
1811      if(rfOther in GetRemFolders) then
1812        (Tree.Items.Add(nil,'') as TORTreeNode).StringData := OtherCatString;
1813  
1814      for i := 0 to EvaluatedReminders.Count-1 do
1815      begin
1816        Data := RemCode + EvaluatedReminders[i];
1817        Tmp := Piece(Data,U,6);
1818        //     if(Tmp = '1') then Add2Tree(rfDue, DueCatID)
1819        if(Tmp = '1') or (Tmp = '3') or (Tmp = '4') then Add2Tree(rfDue, DueCatID) //AGP Error code change 26.8
1820        else if(Tmp = '0') then Add2Tree(rfApplicable, ApplCatID)
1821        else                    Add2Tree(rfNotApplicable, NotApplCatID);
1822        Add2Tree(rfEvaluated, EvaluatedCatID);
1823      end;
1824  
1825      if(rfOther in GetRemFolders) and (OtherReminders.Count > 0) then
1826      begin
1827        for i := 0 to OtherReminders.Count-1 do
1828        begin
1829          Tmp := OtherReminders[i];
1830          if(Piece(Tmp, U, 2) = CatCode) then
1831            Data := CatCode + Piece(Tmp, U, 1)
1832          else
1833          begin
1834            Code := Piece(Tmp, U, 5);
1835            Data := RemCode + Code;
1836            Node := Tree.FindPieceNode(Data, 1);
1837            if(assigned(Node)) then
1838              Data := Node.StringData
1839            else
1840            begin
1841              j := EvaluatedReminders.IndexOfPiece(Code);
1842              if(j >= 0) then
1843                SetPiece(Data, U, 6, Piece(EvaluatedReminders[j], U, 6));
1844            end;
1845          end;
1846          SetPiece(Data, U, 2, Piece(Tmp, U ,3));
1847          SetPiece(Data, U, 7, Piece(Tmp, U, 6));
1848          Tmp := CatCode + Piece(Tmp, U, 4);
1849          Add2Tree(rfOther, OtherCatID, Tree.FindPieceNode(Tmp, 1));
1850        end;
1851      end;
1852  
1853    { The Lost category is for reminders being processed that are no longer in the
1854      reminder tree view.  This can happen with reminders that were Due or Applicable,
1855      but due to user action are no longer applicable, or due to location changes.
1856      The Lost category will not be used if a lost reminder is in the other list. }
1857  
1858      if(RemindersInProcess.Count > 0) then
1859      begin
1860        for i := 0 to RemindersInProcess.Count-1 do
1861        begin
1862          Rem := TReminder(RemindersInProcess.Objects[i]);
1863          Tmp := RemCode + Rem.IEN;
1864          Found := FALSE;
1865          Node := nil;
1866          repeat
1867            Node := Tree.FindPieceNode(Tmp, 1, #0, Node); // look in the tree first
1868            if((not Found) and (not assigned(Node))) then
1869            begin
1870              Data := Tmp + U + Rem.PrintName + U + Rem.DueDateStr + U + Rem.LastDateStr + U +
1871                      IntToStr(Rem.Priority) + U + Rem.Status;
1872                   if(Rem.Status = '1') then LostCat := DueCatID
1873              else if(Rem.Status = '0') then LostCat := ApplCatID
1874              else                           LostCat := LostCatID;
1875              Node := Add2Tree(rfUnknown, LostCat);
1876            end;
1877            if(assigned(Node)) then
1878            begin
1879              Node.Bold := Rem.Processing;
1880              Found := TRUE;
1881            end;
1882          until(Found and (not assigned(Node)));
1883        end;
1884      end;
1885  
1886      for i := 0 to Tree.Items.Count-1 do
1887      begin
1888        Node := TORTreeNode(Tree.Items[i]);
1889        for j := 3 to 4 do
1890        begin
1891          Tmp := Piece(Node.StringData, U, j);
1892          if(Tmp = '') then
1893            Data := ''
1894          else
1895            Data := FormatFMDateTimeStr(ReminderDateFormat, Tmp);
1896          Node.SetPiece(j + (RemTreeDateIdx - 3), Data);
1897        end;
1898        Node.SetPiece(RemTreeDateIdx + 2, IntToStr(Node.AbsoluteIndex));
1899        Tmp := Piece(Node.StringData, U, 5);
1900        if(Tmp <> '1') and (Tmp <> '3') then
1901          Node.SetPiece(5, '2');
1902      end;
1903  
1904    finally
1905      Tree.Items.EndUpdate;
1906    end;
1907  
1908    if(SelID1 = U) then
1909      Node := nil
1910    else
1911    begin
1912      Node := Tree.FindPieceNode(SelID1, 1, IncludeParentID);
1913      if(not assigned(Node)) then
1914        Node := Tree.FindPieceNode(SelID2, 1);
1915      if(assigned(Node)) then
1916        Node.EnsureVisible;
1917    end;
1918    Tree.Selected := Node;
1919  
1920    Tree.SetExpandedIDStr(1, IncludeParentID, ExpandedStr);
1921    if(OpenDue) then
1922    begin
1923      Node := Tree.FindPieceNode(DueCatID, 1);
1924      if(assigned(Node)) then
1925        Node.Expand(FALSE);
1926    end;
1927  
1928    if(TopID1 = U) then
1929      Tree.TopItem := Tree.Items.GetFirstNode
1930    else
1931    begin
1932      Tree.TopItem := Tree.FindPieceNode(TopID1, 1, IncludeParentID);
1933      if(not assigned(Tree.TopItem)) then
1934        Tree.TopItem := Tree.FindPieceNode(TopID2, 1);
1935    end;
1936  end;
1937  
1938  function ReminderNode(Node: TTreeNode): TORTreeNode;
1939  var
1940    p1: string;
1941  
1942  begin
1943    Result := nil;
1944    if(assigned(Node)) then
1945    begin
1946      p1 := Piece((Node as TORTreeNode).StringData, U, 1);
1947      if(Copy(p1,1,1) = RemCode) then
1948        Result := (Node as TORTreeNode)
1949    end;
1950  end;
1951  
1952  procedure LocationChanged(Sender: TObject);
1953  begin
1954    LoadReminderData;
1955  end;
1956  
1957  procedure ClearReminderData;
1958  var
1959    Changed: boolean;
1960  
1961  begin
1962    if(assigned(frmReminderTree)) then
1963      frmReminderTree.Free;
1964    Changed := ((ActiveReminders.Count > 0) or (OtherReminders.Count > 0) or
1965                (ProcessingChangeString <> U));
1966    ActiveReminders.Notifier.BeginUpdate;
1967    OtherReminders.Notifier.BeginUpdate;
1968    RemindersInProcess.Notifier.BeginUpdate;
1969    try
1970      ProcessedReminders.Clear;
1971      if(assigned(KillReminderDialogProc)) then
1972        KillReminderDialogProc(nil);
1973      ActiveReminders.Clear;
1974      OtherReminders.Clear;
1975      EvaluatedReminders.Clear;
1976      ReminderCallList.Clear;
1977      RemindersInProcess.KillObjects;
1978      RemindersInProcess.Clear;
1979      LastProcessingList := '';
1980      InitialRemindersLoaded := FALSE;
1981      CoverSheetRemindersInBackground := FALSE;
1982    finally
1983      RemindersInProcess.Notifier.EndUpdate;
1984      OtherReminders.Notifier.EndUpdate;
1985      ActiveReminders.Notifier.EndUpdate(Changed);
1986      RemindersStarted := FALSE;
1987      LastReminderLocation := -2;
1988      RemForm.Form := nil;
1989    end;
1990  end;
1991  
1992  procedure RemindersInProcessChanged(Data: Pointer; Sender: TObject; var CanNotify: boolean);
1993  var
1994    CurProcessing: string;
1995  begin
1996    CurProcessing := ProcessingChangeString;
1997    CanNotify := (LastProcessingList <> CurProcessing);
1998    if(CanNotify) then
1999      LastProcessingList := CurProcessing;
2000  end;
2001  
2002  procedure InitReminderObjects;
2003  var
2004    M: TMethod;
2005  
2006    procedure InitReminderList(var List: TORStringList);
2007    begin
2008      if(not assigned(List)) then
2009        List := TORStringList.Create;
2010    end;
2011  
2012  begin
2013    InitReminderList(ActiveReminders);
2014    InitReminderList(OtherReminders);
2015    InitReminderList(EvaluatedReminders);
2016    InitReminderList(ReminderCallList);
2017    InitReminderList(RemindersInProcess);
2018    InitReminderList(ProcessedReminders);
2019  
2020    M.Code := @RemindersInProcessChanged;
2021    M.Data := nil;
2022    RemindersInProcess.Notifier.OnNotify :=  TCanNotifyEvent(M);
2023  
2024    AddToNotifyWhenCreated(LocationChanged, TEncounter);
2025  
2026    RemForm.Form := nil;
2027  end;
2028  
2029  procedure FreeReminderObjects;
2030  begin
2031    KillObj(@ActiveReminders);
2032    KillObj(@OtherReminders);
2033    KillObj(@EvaluatedReminders);
2034    KillObj(@ReminderTreeMenuDlg);
2035    KillObj(@ReminderTreeMenu);
2036    KillObj(@ReminderCatMenu);
2037    KillObj(@EducationTopics);
2038    KillObj(@WebPages);
2039    KillObj(@ReminderCallList);
2040    KillObj(@TmpActive);
2041    KillObj(@TmpOther);
2042    KillObj(@RemindersInProcess, TRUE);
2043    KillObj(@ReminderDialogInfo, TRUE);
2044    KillObj(@PCERootList, TRUE);
2045    KillObj(@ProcessedReminders);
2046  end;
2047  
2048  function GetReminder(ARemData: string): TReminder;
2049  var
2050    idx: integer;
2051    SIEN: string;
2052  
2053  begin
2054    Result := nil;
2055    SIEN := Piece(ARemData, U, 1);
2056    if(Copy(SIEN,1,1) = RemCode) then
2057    begin
2058      SIEN := copy(Sien, 2, MaxInt);
2059      idx := RemindersInProcess.IndexOf(SIEN);
2060      if(idx < 0) then
2061      begin
2062        RemindersInProcess.Notifier.BeginUpdate;
2063        try
2064          idx := RemindersInProcess.AddObject(SIEN, TReminder.Create(ARemData));
2065        finally
2066          RemindersInProcess.Notifier.EndUpdate;
2067        end;
2068      end;
2069      Result := TReminder(RemindersInProcess.Objects[idx]);
2070    end;
2071  end;
2072  
2073  var
2074    ScootOver: integer = 0;
2075    
2076  procedure WordWrap(AText: string; Output: TStrings; LineLength: integer;
2077                                                     AutoIndent: integer = 4; MHTest: boolean = false);
2078  var
2079    i, j, l, max, FCount, MHLoop: integer;
2080    First, MHRes: boolean;
2081    OrgText, Text, Prefix, tmpText: string;
2082  
2083  begin
2084    StripScreenReaderCodes(AText);
2085    inc(LineLength, ScootOver);
2086    dec(AutoIndent, ScootOver);
2087    FCount := Output.Count;
2088    First := TRUE;
2089    MHLoop := 1;
2090    MHRes := False;
2091    tmpText := '';
2092    if (MHTest = True) and (Pos('~', AText)>0) then MHLoop := 2;
2093    for j := 1 to MHLoop do
2094    begin
2095    if (j = 1) and (MHLoop = 2) then
2096      begin
2097        tmpText := Piece(AText, '~', 1);
2098        MHRes := True;
2099      end
2100    else if (j = 2) then
2101      begin
2102        tmpText := Piece(AText, '~', 2);
2103        First := False;
2104        MHRes := False;
2105      end
2106    else if (j = 1) and (MHLoop = 1) then
2107      begin
2108        tmpText := AText;
2109        First := False;
2110        MHRes := False;
2111      end;
2112    if tmpText <> '' then OrgText := tmpText
2113    else OrgText := InitText(AText);
2114    Prefix := StringOfChar(' ',74-LineLength);
2115    repeat
2116      i := pos(CRCode, OrgText);
2117      if(i = 0) then
2118      begin
2119        Text := OrgText;
2120        OrgText := '';
2121      end
2122      else
2123      begin
2124        Text := copy(OrgText, 1, i - 1);
2125        delete(OrgText, 1, i + CRCodeLen - 1);
2126      end;
2127      if(Text = '') and (OrgText <> '') then
2128      begin
2129        Output.Add('');
2130        inc(FCount);
2131      end;
2132      while(Text <> '') do
2133      begin
2134        max := length(Text);
2135        if(max > LineLength) then
2136        begin
2137          l := LineLength + 1;
2138          while(l > 0) and (Text[l] <> ' ') do dec(l);
2139          if(l < 1) then
2140          begin
2141            Output.Add(Prefix+copy(Text,1,LineLength));
2142            delete(Text,1,LineLength);
2143          end
2144          else
2145          begin
2146            Output.Add(Prefix+copy(Text,1,l-1));
2147            while(l <= max) and (Text[l] = ' ') do inc(l);
2148            delete(Text,1,l-1);
2149          end;
2150          if(First) then
2151          begin
2152            dec(LineLength, AutoIndent);
2153            Prefix := Prefix + StringOfChar(' ', AutoIndent);
2154            First := FALSE;
2155          end;
2156        end
2157        else
2158        begin
2159          Output.Add(Prefix+Text);
2160          Text := '';
2161        end;
2162      end;
2163      if ((First) and (FCount <> Output.Count)) and (MHRes = False) then
2164      begin
2165        dec(LineLength, AutoIndent);
2166        Prefix := Prefix + StringOfChar(' ', AutoIndent);
2167        First := FALSE;
2168      end;
2169    until(OrgText = '');
2170    end;
2171  end;
2172  
2173  function InteractiveRemindersActive: boolean;
2174  begin
2175    if(not InteractiveRemindersActiveChecked) then
2176    begin
2177      InteractiveRemindersActiveStatus := GetRemindersActive;
2178      InteractiveRemindersActiveChecked := TRUE;
2179    end;
2180    Result := InteractiveRemindersActiveStatus;
2181  end;
2182  
2183  function GetReminderData(Rem: TReminderDialog; Lst: TStrings; Finishing: boolean = FALSE;
2184                                                          Historical: boolean = FALSE): integer;
2185  begin
2186    Result := Rem.AddData(Lst, Finishing, Historical);
2187  end;
2188  
2189  function GetReminderData(Lst: TStrings; Finishing: boolean = FALSE;
2190                                           Historical: boolean = FALSE): integer;
2191  var
2192    i: integer;
2193  begin
2194    Result := 0;
2195    for i := 0 to RemindersInProcess.Count-1 do
2196      inc(Result, TReminder(RemindersInProcess.Objects[i]).AddData(Lst, Finishing, Historical));
2197  end;
2198  
2199  procedure SetReminderFormBounds(Frm: TForm; DefX, DefY, DefW, DefH, ALeft, ATop, AWidth, AHeight: integer);
2200  var
2201    Rect: TRect;
2202    ScreenW, ScreenH: integer;
2203  
2204  begin
2205    SystemParametersInfo(SPI_GETWORKAREA, 0, @Rect, 0);
2206    ScreenW := Rect.Right - Rect.Left + 1;
2207    ScreenH := Rect.Bottom - Rect.Top + 1;
2208    if(AWidth = 0) then
2209      AWidth := DefW
2210    else
2211      DefW := AWidth;
2212    if(AHeight = 0) then
2213      AHeight := DefH
2214    else
2215      DefH := AHeight;
2216    if(DefX = 0) and (DefY = 0) then
2217    begin
2218      DefX := (ScreenW - DefW) div 2;
2219      DefY := (ScreenH - DefH) div 2;
2220    end
2221    else
2222      dec(DefY, DefH);
2223    if((ALeft <= 0) or (ATop <= 0) or
2224      ((ALeft + AWidth) > ScreenW) or
2225      ((ATop + AHeight) > ScreenH)) then
2226    begin
2227      if(DefX < 0) then
2228        DefX := 0
2229      else
2230      if((DefX + DefW) > ScreenW) then
2231        DefX := ScreenW-DefW;
2232      if(DefY < 0) then
2233        DefY := 0
2234      else
2235      if((DefY + DefH) > ScreenH) then
2236        DefY := ScreenH-DefH;
2237      Frm.SetBounds(Rect.Left + DefX, Rect.Top + DefY, DefW, DefH);
2238    end
2239    else
2240      Frm.SetBounds(Rect.Left + ALeft, Rect.Top + ATop, AWidth, AHeight);
2241  end;
2242  
2243  procedure UpdateReminderDialogStatus;
2244  var
2245    TmpSL: TStringList;
2246    Changed: boolean;
2247  
2248    procedure Build(AList :TORStringList; PNum: integer);
2249    var
2250      i: integer;
2251      Code: string;
2252  
2253    begin
2254      for i := 0 to AList.Count-1 do
2255      begin
2256        Code := Piece(AList[i],U,PNum);
2257        if((Code <> '') and (TmpSL.IndexOf(Code) < 0)) then
2258          TmpSL.Add(Code);
2259      end;
2260    end;
2261  
2262    procedure Reset(AList: TORStringList; PNum, DlgPNum: integer);
2263    var
2264      i, j: integer;
2265      Tmp, Code, Dlg: string;
2266  
2267    begin
2268      for i := 0 to TmpSL.Count-1 do
2269      begin
2270        Code := Piece(TmpSL[i],U,1);
2271        j := -1;
2272        repeat
2273          j := AList.IndexOfPiece(Code, U, PNum, j);
2274          if(j >= 0) then
2275          begin
2276            Dlg := Piece(TmpSL[i],U,2);
2277            if(Dlg <> Piece(AList[j], U, DlgPNum)) then
2278            begin
2279              Tmp := AList[j];
2280              SetPiece(Tmp, U, DlgPNum, Dlg);
2281              AList[j] := Tmp;
2282              Changed := TRUE;
2283            end;
2284          end;
2285        until (j < 0);
2286      end;
2287    end;
2288  
2289  begin
2290    Changed := FALSE;
2291    BeginReminderUpdate;
2292    try
2293      TmpSL := TStringList.Create;
2294      try
2295        Build(ActiveReminders, 1);
2296        Build(OtherReminders, 5);
2297        Build(EvaluatedReminders, 1);
2298        GetDialogStatus(TmpSL);
2299        Reset(ActiveReminders, 1, 7);
2300        Reset(OtherReminders, 5, 6);
2301        Reset(EvaluatedReminders, 1, 7);
2302      finally
2303        TmpSL.Free;
2304      end;
2305    finally
2306      EndReminderUpdate(Changed);
2307    end;
2308  end;
2309  
2310  procedure PrepText4NextLine(var txt: string);
2311  var
2312    tlen: integer;
2313  
2314  begin
2315    if(txt <> '') then
2316    begin
2317      tlen := length(txt);
2318      if(copy(txt, tlen - CRCodeLen + 1, CRCodeLen) = CRCode) then
2319        exit;
2320      if(copy(txt, tlen, 1) = '.') then
2321        txt := txt + ' ';
2322      txt := txt + ' ';
2323    end;
2324  end;
2325  
2326  procedure ExpandTIUObjects(var Txt: string; msg: string = '');
2327  var
2328    ObjList: TStringList;
2329    Err: TStringList;
2330    i, j, k, oLen: integer;
2331    obj, ObjTxt: string;
2332  
2333  begin
2334    ObjList := TStringList.Create;
2335    try
2336      Err := nil;
2337      if(not dmodShared.BoilerplateOK(Txt, CRCode, ObjList, Err)) and (assigned(Err)) then
2338      begin
2339        try
2340          Err.Add(CRLF + 'Contact IRM and inform them about this error.' + CRLF +
2341                         'Make sure you give them the name of the reminder that you are processing,' + CRLF +
2342                         'and which dialog elements were selected to produce this error.');
2343          InfoBox(Err.Text,'Reminder Boilerplate Object Error', MB_OK + MB_ICONERROR);
2344        finally
2345          Err.Free;
2346        end;
2347      end;
2348      if(ObjList.Count > 0) then
2349      begin
2350        GetTemplateText(ObjList);
2351        i := 0;
2352        while (i < ObjList.Count) do
2353        begin
2354          if(pos(ObjMarker, ObjList[i]) = 1) then
2355          begin
2356            obj := copy(ObjList[i], ObjMarkerLen+1, MaxInt);
2357            if(obj = '') then break;
2358            j := i + 1;
2359            while (j < ObjList.Count) and (pos(ObjMarker, ObjList[j]) = 0) do
2360              inc(j);
2361            if((j - i) > 2) then
2362            begin
2363              ObjTxt := '';
2364              for k := i+1 to j-1 do
2365                ObjTxt := ObjTxt + CRCode + ObjList[k];
2366            end
2367            else
2368              ObjTxt := ObjList[i+1];
2369            i := j;
2370            obj := '|' + obj + '|';
2371            oLen := length(obj);
2372            repeat
2373              j := pos(obj, Txt);
2374              if(j > 0) then
2375              begin
2376                delete(Txt, j, OLen);
2377                insert(ObjTxt, Txt, j);
2378              end;
2379            until(j = 0);
2380          end
2381          else
2382            inc(i);
2383        end
2384      end;
2385    finally
2386      ObjList.Free;
2387    end;
2388  end;
2389  
2390  { TReminderDialog }
2391  
2392  const
2393    RPCCalled = '99';
2394    DlgCalled = RPCCalled + U + 'DLG';
2395  
2396  constructor TReminderDialog.BaseCreate;
2397  var
2398    idx, eidx, i: integer;
2399    TempSL: TORStringList;
2400    ParentID: string;
2401  //  Line: string;
2402    Element: TRemDlgElement;
2403  
2404  begin
2405    TempSL := GetDlgSL;
2406    if Piece(TempSL[0],U,2)='1' then
2407      begin
2408        Self.RemWipe := 1;
2409      end;
2410    idx := -1;
2411    repeat
2412      idx := TempSL.IndexOfPiece('1', U, 1, idx);
2413      if(idx >= 0) then
2414      begin
2415        if(not assigned(FElements)) then
2416          FElements := TStringList.Create;
2417        eidx := FElements.AddObject('',TRemDlgElement.Create);
2418        Element := TRemDlgElement(FElements.Objects[eidx]);
2419        with Element do
2420        begin
2421          FReminder := Self;
2422          FRec1 := TempSL[idx];
2423          FID := Piece(FRec1, U, 2);
2424          FDlgID := Piece(FRec1, U, 3);
2425          FElements[eidx] := FDlgID;
2426          if(ElemType = etTaxonomy) then
2427            FTaxID := BOOLCHAR[Historical] + FindingType
2428          else
2429            FTaxID := '';
2430  
2431          FText := '';
2432          i := -1;
2433         // if Piece(FRec1,U,5) <> '1' then
2434          repeat
2435            i := TempSL.IndexOfPieces(['2',FID,FDlgID],i);
2436            if(i >= 0) then
2437            begin
2438              PrepText4NextLine(FText);
2439              FText := FText + Trim(Piece(TempSL[i], U, 4));
2440            end;
2441          until(i < 0);
2442          ExpandTIUObjects(FText);
2443          AssignFieldIDs(FText);
2444  
2445          if(pos('.',FDlgID)>0) then
2446          begin
2447            ParentID := FDlgID;
2448            i := length(ParentID);
2449            while((i > 0) and (ParentID[i] <> '.')) do
2450              dec(i);
2451            if(i > 0) then
2452            begin
2453              ParentID := copy(ParentID,1,i-1);
2454              i := FElements.IndexOf(ParentID);
2455              if(i >= 0) then
2456              begin
2457                FParent := TRemDlgElement(FElements.Objects[i]);
2458                if(not assigned(FParent.FChildren)) then
2459                  FParent.FChildren := TList.Create;
2460                FParent.FChildren.Add(Element);
2461              end;
2462            end;
2463          end;
2464          if(ElemType = etDisplayOnly) then
2465            SetChecked(TRUE);
2466          UpdateData;
2467        end;
2468      end;
2469    until(idx < 0);
2470  end;
2471  
2472  constructor TReminderDialog.Create(ADlgData: string);
2473  begin
2474    FDlgData := ADlgData;
2475    BaseCreate;
2476  end;
2477  
2478  destructor TReminderDialog.Destroy;
2479  begin
2480    KillObj(@FElements, TRUE);
2481    inherited;
2482  end;
2483  
2484  function TReminderDialog.Processing: boolean;
2485  var
2486    i,j: integer;
2487    Elem: TRemDlgElement;
2488    RData: TRemData;
2489  
2490    function ChildrenChecked(Prnt: TRemDlgElement): boolean; forward;
2491  
2492    function CheckItem(Item: TRemDlgElement): boolean;
2493    begin
2494      if(Item.ElemType = etDisplayOnly) then
2495      begin
2496        Result := ChildrenChecked(Item);
2497        if(not Result) then
2498          Result := Item.Add2PN;
2499      end
2500      else
2501        Result := Item.FChecked;
2502    end;
2503  
2504    function ChildrenChecked(Prnt: TRemDlgElement): boolean;
2505    var
2506      i: integer;
2507  
2508    begin
2509      Result := FALSE;
2510      if(assigned(Prnt.FChildren)) then
2511      begin
2512        for i := 0 to Prnt.FChildren.Count-1 do
2513        begin
2514          Result := CheckItem(TRemDlgElement(Prnt.FChildren[i]));
2515          if(Result) then break;
2516        end;
2517      end;
2518    end;
2519  
2520  begin
2521    Result := FALSE;
2522    if(assigned(FElements)) then
2523    begin
2524      for i := 0 to FElements.Count-1 do
2525      begin
2526        Elem := TRemDlgElement(FElements.Objects[i]);
2527        if(not assigned(Elem.FParent)) then
2528        begin
2529          Result := CheckItem(Elem);
2530          if (Result = false) then  //(AGP CHANGE 24.9 add check to have the finish problem check for MH test)
2531            begin
2532            if (assigned(Elem.FData)) then
2533              begin
2534                 for j := 0 to Elem.FData.Count-1 do
2535                    begin
2536                       RData := TRemData(Elem.FData[j]);
2537                       if piece(RData.FRec3,U,4)='MH' then
2538                          Result := True;
2539                       if (Result) then break;
2540                    end;
2541              end;
2542            end;
2543          if(Result) then break;
2544        end;
2545      end;
2546    end;
2547  end;
2548  
2549  function TReminderDialog.GetDlgSL: TORStringList;
2550  var
2551    idx: integer;
2552  
2553  begin
2554    if(not assigned(ReminderDialogInfo)) then
2555      ReminderDialogInfo := TStringList.Create;
2556    idx := ReminderDialogInfo.IndexOf(GetIEN);
2557    if(idx < 0) then
2558      idx := ReminderDialogInfo.AddObject(GetIEN, TORStringList.Create);
2559    Result := TORStringList(ReminderDialogInfo.Objects[idx]);
2560    if(Result.Count = 0) then
2561    begin
2562      FastAssign(GetDialogInfo(GetIEN, (Self is TReminder)), Result);
2563      Result.Add(DlgCalled); // Used to prevent repeated calling of RPC if dialog is empty
2564    end;
2565  end;
2566  
2567  function TReminderDialog.BuildControls(ParentWidth: integer; AParent, AOwner: TWinControl): TWinControl;
2568  var
2569    Y, i: integer;
2570    Elem: TRemDlgElement;
2571    ERes: TWinControl;
2572  
2573  begin
2574    Result := nil;
2575    if(assigned(FElements)) then
2576    begin
2577      Y := 0;
2578      for i := 0 to FElements.Count-1 do
2579      begin
2580        Elem := TRemDlgElement(FElements.Objects[i]);
2581        if (not assigned(Elem.FParent)) then
2582        begin
2583          ERes := Elem.BuildControls(Y, ParentWidth, AParent, AOwner);
2584          if(not assigned(Result)) then
2585            Result := ERes;
2586        end;
2587      end;
2588    end;
2589    if(AParent.ControlCount = 0) then
2590    begin
2591      with TVA508StaticText.Create(AOwner) do
2592      begin
2593        Parent := AParent;
2594        Caption := 'No Dialog found for ' + Trim(GetPrintName) + ' Reminder.';
2595        Left := Gap;
2596        Top := Gap;
2597      end;
2598    end;
2599    ElementChecked := nil;
2600  end;
2601  
2602  procedure TReminderDialog.AddText(Lst: TStrings);
2603  var
2604    i, idx: integer;
2605    Elem: TRemDlgElement;
2606    temp: string;
2607  
2608  begin
2609    if(assigned(FElements)) then
2610    begin
2611      idx := Lst.Count;
2612      for i := 0 to FElements.Count-1 do
2613      begin
2614        Elem := TRemDlgElement(FElements.Objects[i]);
2615        if (not assigned(Elem.FParent)) then
2616          Elem.AddText(Lst);
2617      end;
2618      if (Self is TReminder) and (PrintName <> '') and (idx <> Lst.Count) then
2619      begin
2620        temp := PrintName;
2621        StripScreenReaderCodes(temp);
2622        Lst.Insert(idx, '  ' + temp + ':')
2623      end;
2624    end;
2625  end;
2626  
2627  function TReminderDialog.AddData(Lst: TStrings; Finishing: boolean = FALSE;
2628                             Historical: boolean = FALSE): integer;
2629  var
2630    i: integer;
2631    Elem: TRemDlgElement;
2632  
2633  begin
2634    Result := 0;
2635    if(assigned(FElements)) then
2636    begin
2637      for i := 0 to FElements.Count-1 do
2638      begin
2639        Elem := TRemDlgElement(FElements.Objects[i]);
2640        if (not assigned(Elem.FParent)) then
2641          inc(Result, Elem.AddData(Lst, Finishing, Historical));
2642      end;
2643    end;
2644  end;
2645  
2646  procedure TReminderDialog.ComboBoxCheckedText(Sender: TObject; NumChecked: integer; var Text: string);
2647  var
2648    i, Done: integer;
2649    DotLen, ComLen, TxtW, TotalW, NewLen: integer;
2650    tmp: string;
2651    Fnt: THandle;
2652    lb: TORListBox;
2653  
2654  begin
2655    if(NumChecked = 0) then
2656      Text := '(None Selected)'
2657    else
2658    if(NumChecked > 1) then
2659    begin
2660      Text := '';
2661      lb := (Sender as TORListBox);
2662      Fnt := lb.Font.Handle;
2663      DotLen := TextWidthByFont(Fnt, '...');
2664      TotalW := (lb.Owner as TControl).ClientWidth - 15;
2665      ComLen := TextWidthByFont(fnt, ', ');
2666      dec(TotalW,(NumChecked-1) * ComLen);
2667      Done := 0;
2668      for i := 0 to lb.Items.Count-1 do
2669      begin
2670        if(lb.Checked[i]) then
2671        begin
2672          inc(Done);
2673          if(Text <> '') then
2674          begin
2675            Text := Text + ', ';
2676            dec(TotalW, ComLen);
2677          end;
2678          Tmp := lb.DisplayText[i];
2679          if(Done = NumChecked) then
2680            TxtW := TotalW
2681          else
2682            TxtW := TotalW div (NumChecked - Done + 1);
2683          NewLen := NumCharsFitInWidth(fnt, Tmp, TxtW);
2684          if(NewLen < length(Tmp)) then
2685            Tmp := copy(Tmp,1,NumCharsFitInWidth(fnt, Tmp, (TxtW - DotLen))) + '...';
2686          dec(TotalW, TextWidthByFont(fnt, Tmp));
2687          Text := Text + Tmp;
2688        end;
2689      end;
2690    end;
2691  end;
2692  
2693  procedure TReminderDialog.BeginTextChanged;
2694  begin
2695    inc(FTextChangedCount);
2696  end;
2697  
2698  procedure TReminderDialog.EndTextChanged(Sender: TObject);
2699  begin
2700    if(FTextChangedCount > 0) then
2701    begin
2702      dec(FTextChangedCount);
2703      if(FTextChangedCount = 0) and assigned(FOnTextChanged) then
2704        FOnTextChanged(Sender);
2705    end;
2706  end;
2707  
2708  function TReminderDialog.GetIEN: string;
2709  begin
2710    Result := Piece(FDlgData, U, 1);
2711  end;
2712  
2713  function TReminderDialog.GetPrintName: string;
2714  begin
2715    Result := Piece(FDlgData, U, 2);
2716  end;
2717  
2718  procedure TReminderDialog.BeginNeedRedraw;
2719  begin
2720    inc(FNeedRedrawCount);
2721  end;
2722  
2723  procedure TReminderDialog.EndNeedRedraw(Sender: TObject);
2724  begin
2725    if(FNeedRedrawCount > 0) then
2726    begin
2727      dec(FNeedRedrawCount);
2728      if(FNeedRedrawCount = 0) and (assigned(FOnNeedRedraw)) then
2729        FOnNeedRedraw(Sender);
2730    end;
2731  end;
2732  
2733  procedure TReminderDialog.FinishProblems(List: TStrings; var MissingTemplateFields: boolean);
2734  var
2735    i: integer;
2736    Elem: TRemDlgElement;
2737    TmpSL: TStringList;
2738    FldData: TORStringList;
2739  
2740  begin
2741    if(Processing and assigned(FElements)) then
2742    begin
2743      TmpSL := TStringList.Create;
2744      try
2745        FldData := TORStringList.Create;
2746        try
2747          for i := 0 to FElements.Count-1 do
2748          begin
2749            Elem := TRemDlgElement(FElements.Objects[i]);
2750            if (not assigned(Elem.FParent)) then
2751            begin
2752              Elem.FinishProblems(List);
2753              Elem.GetFieldValues(FldData);
2754            end;
2755          end;
2756          FNoResolve := TRUE;
2757          try
2758            AddText(TmpSL);
2759          finally
2760            FNoResolve := FALSE;
2761          end;
2762          MissingTemplateFields := AreTemplateFieldsRequired(TmpSL.Text, FldData);
2763        finally
2764          FldData.Free;
2765        end;
2766      finally
2767        TmpSL.Free;
2768      end;
2769    end;
2770  end;
2771  
2772  procedure TReminderDialog.ComboBoxResized(Sender: TObject);
2773  begin
2774  // This causes the ONCheckedText event to re-fire and re-update the text,
2775  // based on the new size of the combo box.
2776    if(Sender is TORComboBox) then
2777      with (Sender as TORComboBox) do
2778        OnCheckedText := OnCheckedText;
2779  end;
2780  
2781  function TReminderDialog.Visible: boolean;
2782  begin
2783    Result := (CurrentReminderInDialog = Self);
2784  end;
2785  
2786  { TReminder }
2787  
2788  constructor TReminder.Create(ARemData: string);
2789  begin
2790    FRemData := ARemData;
2791    BaseCreate;
2792  end;
2793  
2794  function TReminder.GetDueDateStr: string;
2795  begin
2796    Result := Piece(FRemData, U ,3);
2797  end;
2798  
2799  function TReminder.GetIEN: string;
2800  begin
2801    Result := copy(Piece(FRemData, U, 1), 2, MaxInt);
2802  end;
2803  
2804  function TReminder.GetLastDateStr: string;
2805  begin
2806    Result := Piece(FRemData, U ,4);
2807  end;
2808  
2809  function TReminder.GetPrintName: string;
2810  begin
2811    Result := Piece(FRemData, U ,2);
2812  end;
2813  
2814  function TReminder.GetPriority: integer;
2815  begin
2816    Result := StrToIntDef(Piece(FRemData, U ,5), 2);
2817  end;
2818  
2819  function TReminder.GetStatus: string;
2820  begin
2821    Result := Piece(FRemData, U ,6);
2822  end;
2823  
2824  { TRemDlgElement }
2825  
2826  function Code2DataType(Code: string): TRemDataType;
2827  var
2828    idx: TRemDataType;
2829  
2830  begin
2831    Result := dtUnknown;
2832    for idx := low(TRemDataType) to high(TRemDataType) do
2833    begin
2834      if(Code = RemDataCodes[idx]) then
2835      begin
2836        Result := idx;
2837        break;
2838      end;
2839    end;
2840  end;
2841  
2842  function Code2PromptType(Code: string): TRemPromptType;
2843  var
2844    idx: TRemPromptType;
2845  
2846  begin
2847    if(Code = '') then
2848      Result := ptSubComment
2849    else
2850    if(Code = MSTCode) then
2851      Result := ptMST
2852    else
2853    begin
2854      Result := ptUnknown;
2855      for idx := low(TRemPromptType) to high(TRemPromptType) do
2856      begin
2857        if(Code = RemPromptCodes[idx]) then
2858        begin
2859          Result := idx;
2860          break;
2861        end;
2862      end;
2863    end;
2864  end;
2865  
2866  function TRemDlgElement.Add2PN: boolean;
2867  var
2868    Lst: TStringList;
2869  
2870  begin
2871    if (FChecked) then
2872    begin
2873      Result := (Piece(FRec1, U, 5) <> '1');
2874      //Suppress := (Piece(FRec1,U,1)='1');
2875      if(Result and (ElemType = etDisplayOnly)) then
2876      begin
2877        //Result := FALSE;
2878        if(assigned(FPrompts) and (FPrompts.Count > 0)) or
2879          (assigned(FData) and (FData.Count > 0)) or Result then
2880        begin
2881          Lst := TStringList.Create;
2882          try
2883            AddData(Lst, FALSE);
2884            Result := (Lst.Count > 0);
2885            if not assigned(FData) then Result := True;
2886          finally
2887            Lst.Free;
2888          end;
2889        end;
2890      end;
2891    end
2892    else
2893      Result := FALSE;
2894  end;
2895  
2896  function TRemDlgElement.Box: boolean;
2897  begin
2898    Result := (Piece(FRec1, U, 19) = '1');
2899  end;
2900  
2901  function TRemDlgElement.BoxCaption: string;
2902  begin
2903    if(Box) then
2904      Result := Piece(FRec1, U, 20)
2905    else
2906      Result := '';
2907  end;
2908  
2909  function TRemDlgElement.ChildrenIndent: integer;
2910  begin
2911    Result := StrToIntDef(Piece(FRec1, U, 16), 0);
2912  end;
2913  
2914  function TRemDlgElement.ChildrenRequired: TRDChildReq;
2915  var
2916    Tmp: string;
2917  begin
2918    Tmp := Piece(FRec1, U, 18);
2919    if Tmp = '1' then Result := crOne
2920    else if Tmp = '2' then Result := crAtLeastOne
2921    else if Tmp = '3' then Result := crNoneOrOne
2922    else if Tmp = '4' then result := crAll
2923    else Result := crNone;
2924  end;
2925  
2926  function TRemDlgElement.ChildrenSharePrompts: boolean;
2927  begin
2928    Result := (Piece(FRec1, U, 17) = '1');
2929  end;
2930  
2931  destructor TRemDlgElement.Destroy;
2932  begin
2933    KillObj(@FFieldValues);
2934    KillObj(@FData, TRUE);
2935    KillObj(@FPrompts, TRUE);
2936    KillObj(@FChildren);
2937    inherited;
2938  end;
2939  
2940  function TRemDlgElement.ElemType: TRDElemType;
2941  var
2942    Tmp: string;
2943  
2944  begin
2945        Tmp := Piece(FRec1, U, 4);
2946        if(Tmp = 'D') then Result := etDisplayOnly
2947        else if(Tmp = 'T') then Result := etTaxonomy
2948        else Result := etCheckBox;
2949  end;
2950  
2951  function TRemDlgElement.FindingType: string;
2952  begin
2953    if(ElemType = etTaxonomy) then
2954      Result := Piece(FRec1, U, 7)
2955    else
2956      Result := '';
2957  end;
2958  
2959  function TRemDlgElement.HideChildren: boolean;
2960  begin
2961    Result := (Piece(FRec1, U, 15) <> '0');
2962  end;
2963  
2964  function TRemDlgElement.Historical: boolean;
2965  begin
2966    Result := (Piece(FRec1, U, 8) = '1');
2967  end;
2968  
2969  function TRemDlgElement.Indent: integer;
2970  begin
2971    Result := StrToIntDef(Piece(FRec1, U, 6), 0);
2972  end;
2973  
2974  procedure TRemDlgElement.GetData;
2975  var
2976    TempSL: TStrings;
2977    i: integer;
2978    Tmp: string;
2979  
2980  begin
2981    if FHaveData then exit;
2982    if(FReminder.GetDlgSL.IndexOfPieces([RPCCalled, FID, FTaxID]) < 0) then
2983    begin
2984      TempSL := GetDialogPrompts(FID, Historical, FindingType);
2985      TempSL.Add(RPCCalled);
2986      for i := 0 to TempSL.Count-1 do
2987      begin
2988        Tmp := TempSL[i];
2989        SetPiece(Tmp,U,2,FID);
2990        SetPiece(Tmp,U,3,FTaxID);
2991        TempSL[i] := Tmp;
2992      end;
2993      FastAddStrings(TempSL, FReminder.GetDlgSL);
2994    end;
2995    UpdateData;
2996  end;
2997  
2998  procedure TRemDlgElement.UpdateData;
2999  var
3000    Ary: array of integer;
3001    idx, i,cnt: integer;
3002    TempSL: TORStringList;
3003    RData: TRemData;
3004    RPrompt: TRemPrompt;
3005    Tmp, Tmp2, ChoiceTmp: string;
3006    NewLine: boolean;
3007    dt: TRemDataType;
3008    pt: TRemPromptType;
3009    DateRange: string;
3010    ChoicesActiveDates:   TStringList;
3011    ChoiceIdx: integer;
3012    Piece7: string;
3013    EncDt: TFMDateTime;
3014  
3015  begin
3016    if FHaveData then exit;
3017    TempSL := FReminder.GetDlgSL;
3018    if(TempSL.IndexOfPieces([RPCCalled, FID, FTaxID]) >= 0) then
3019    begin
3020      FHaveData := TRUE;
3021      RData := nil;
3022      idx := -1;
3023      repeat
3024        idx := TempSL.IndexOfPieces(['3', FID, FTaxID], idx);
3025        if (idx >= 0) and (Pieces(TempSL[idx-1],U,1,6) = Pieces(TempSL[idx],u,1,6)) then
3026          if pos(':', Piece(TempSL[idx],U,7)) > 0 then  //if has date ranges
3027            begin
3028              if RData <> nil then
3029                begin
3030                  if (not assigned(RData.FActiveDates)) then
3031                    RData.FActiveDates := TStringList.Create;
3032                  DateRange := Pieces(Piece(TempSL[idx],U,7),':',2,3);
3033                  RData.FActiveDates.Add(DateRange);
3034                  with RData do
3035                    begin
3036                      FParent := Self;
3037                      Piece7 := Piece(Piece(TempSL[idx],U,7),':',1);
3038                      FRec3 := TempSL[idx];
3039                      SetPiece(FRec3,U,7,Piece7);
3040                    end;
3041                end;
3042            end;
3043        if(idx >= 0) and (Pieces(TempSL[idx-1],U,1,6) <> Pieces(TempSL[idx],u,1,6)) then
3044        begin
3045          dt := Code2DataType(piece(TempSL[idx], U, r3Type));
3046          if(dt <> dtUnknown) and ((dt <> dtOrder) or
3047            CharInSet(CharAt(piece(TempSL[idx], U, 11),1), ['D', 'Q', 'M', 'O', 'A'])) and   //AGP change 26.10 for allergy orders
3048            ((dt <> dtMentalHealthTest) or MHTestsOK) then
3049          begin
3050            if(not assigned(FData)) then
3051              FData := TList.Create;
3052            RData := TRemData(FData[FData.Add(TRemData.Create)]);
3053            if pos(':',Piece(TempSL[idx],U,7)) > 0 then
3054              begin
3055                RData.FActiveDates := TStringList.Create;
3056                RData.FActiveDates.Add(Pieces(Piece(TempSL[idx],U,7),':',2,3));
3057              end;
3058            with RData do
3059            begin
3060              FParent := Self;
3061              Piece7 := Piece(Piece(TempSL[idx],U,7),':',1);
3062              FRec3 := TempSL[idx];
3063              SetPiece(FRec3,U,7,Piece7);
3064  //            FRoot := FRec3;
3065              i := idx + 1;
3066              ChoiceIdx := 0;
3067              while (i < TempSL.Count) and (TempSL.PiecesEqual(i, ['5', FID, FTaxID])) do
3068              begin
3069                if (Pieces(TempSL[i-1],U,1,6) = Pieces(TempSL[i],U,1,6)) then
3070                  begin
3071                   if pos(':', Piece(TempSL[i],U,7)) > 0 then
3072                     begin
3073                      if (not assigned(FChoicesActiveDates)) then
3074                        begin
3075                          FChoicesActiveDates := TList.Create;
3076                          ChoicesActiveDates := TStringList.Create;
3077                          FChoicesActiveDates.Insert(ChoiceIdx, ChoicesActiveDates);
3078                        end;
3079                      TStringList(FChoicesActiveDates[ChoiceIdx]).Add(Pieces(Piece(TempSL[i],U,7),':',2,3));
3080                     end;
3081                   inc(i);
3082                  end
3083                else
3084                  begin
3085                    if(not assigned(FChoices)) then
3086                    begin
3087                      FChoices := TORStringList.Create;
3088                      if(not assigned(FPrompts)) then
3089                        FPrompts := TList.Create;
3090                      FChoicePrompt := TRemPrompt(FPrompts[FPrompts.Add(TRemPrompt.Create)]);
3091                      with FChoicePrompt do
3092                      begin
3093                        FParent := Self;
3094                        Tmp := Piece(FRec3,U,10);
3095                        NewLine := (Tmp <> '');
3096                        FRec4 := '4' + U + FID + U + FTaxID + U + U + BOOLCHAR[not RData.Add2PN] + U + U +
3097                                 'P' + U + Tmp + U + BOOLCHAR[NewLine] + U + '1';
3098                        FData := RData;
3099                        FOverrideType := ptDataList;
3100                        InitValue;
3101                      end;
3102                    end;
3103                    Tmp := TempSL[i];
3104                    Piece7 := Piece(Piece(TempSL[i],U,7),':',1);
3105                    SetPiece(Tmp,U,7,Piece7);
3106                    Tmp2 := Piece(Piece(Tmp,U,r3Code),':',1);
3107                    if(Tmp2 <> '') then Tmp2 := ' (' + Tmp2 + ')';
3108                    Tmp2 := MixedCase(Piece(Tmp,U,r3Nar)) + Tmp2;
3109                    SetPiece(Tmp,U,12,Tmp2);
3110                    ChoiceIdx := FChoices.Add(Tmp);
3111                    if pos(':',Piece(TempSL[i],U,7)) > 0 then
3112                     begin
3113                      if (not assigned(FChoicesActiveDates)) then
3114                        FChoicesActiveDates := TList.Create;
3115                      ChoicesActiveDates := TStringList.Create;
3116                      ChoicesActiveDates.Add(Pieces(Piece(TempSL[i],U,7),':',2,3));
3117                      FChoicesActiveDates.Insert(ChoiceIdx, ChoicesActiveDates);
3118                     end
3119                    else
3120                      if assigned(FChoicesActiveDates) then
3121                         FChoicesActiveDates.Insert(ChoiceIdx, TStringList.Create);
3122                    inc(i);
3123                  end;
3124              end;
3125              choiceTmp := '';
3126              // agp ICD-10 modify this code to handle one valid code against encounter date if combobox contains more than one code.
3127              if(assigned(FChoices)) and ((FChoices.Count = 1) or (FChoicesActiveDates.Count = 1)) then // If only one choice just pick it
3128              begin
3129                choiceTmp := FChoices[0];
3130              end;
3131              if (assigned(FChoices)) and (assigned(FChoicesActiveDates)) and (choiceTmp = '') then
3132                begin
3133                  if (assigned(FParent.FReminder.FPCEDataObj)) then encDT := FParent.FReminder.FPCEDataObj.DateTime
3134                  else encDT := RemForm.PCEObj.VisitDateTime;
3135                  choiceTmp := OneValidCode(FChoices, FChoicesActiveDates, encDT);
3136                end;
3137              //            if(assigned(FChoices)) and (((FChoices.Count = 1) or (FChoicesActiveDates.Count = 1)) or
3138  //            (oneValidCode(FChoices, FChoicesActiveDates, FParent.FReminder.FPCEDataObj.DateTime) = true)) then // If only one choice just pick it
3139              if (choiceTmp <> '') then
3140  
3141              begin
3142                if (not assigned(RData.FActiveDates)) then
3143                begin
3144                  RData.FActiveDates := TStringList.Create;
3145                  setActiveDates(FChoices, FChoicesActiveDates, RData.FActiveDates);
3146                end;
3147  
3148                FPrompts.Remove(FChoicePrompt);
3149                KillObj(@FChoicePrompt);
3150                Tmp := choiceTmp;
3151                KillObj(@FChoices);
3152                cnt := 5;
3153                if(Piece(FRec3,U,9) = '') then inc(cnt);
3154                SetLength(Ary,cnt);
3155                for i := 0 to cnt-1 do
3156                  Ary[i] := i+4;
3157                SetPieces(FRec3, U, Ary, Tmp);
3158                if (not assigned(RData.FActiveDates)) then
3159                begin
3160                  RData.FActiveDates := TStringList.Create;
3161                end;
3162  
3163              end;
3164              if(assigned(FChoices)) then
3165              begin
3166                for i := 0 to FChoices.Count-1 do
3167                  FChoices.Objects[i] := TRemPCERoot.GetRoot(RData, FChoices[i], Historical);
3168              end
3169              else
3170                FPCERoot := TRemPCERoot.GetRoot(RData, RData.FRec3, Historical);
3171              if(dt = dtVitals) then
3172              begin
3173                if(Code2VitalType(Piece(FRec3,U,6)) <> vtUnknown) then
3174                begin
3175                  if(not assigned(FPrompts)) then
3176                    FPrompts := TList.Create;
3177                  FChoicePrompt := TRemPrompt(FPrompts[FPrompts.Add(TRemPrompt.Create)]);
3178                  with FChoicePrompt do
3179                  begin
3180                    FParent := Self;
3181                    Tmp := Piece(FRec3,U,10);
3182                    NewLine := FALSE;
3183    //                FRec4 := '4' + U + FID + U + FTaxID + U + U + BOOLCHAR[not RData.Add2PN] + U +
3184    //                         RData.InternalValue + U + 'P' + U + Tmp + U + BOOLCHAR[SameL] + U + '1';
3185                    FRec4 := '4' + U + FID + U + FTaxID + U + U + BOOLCHAR[not RData.Add2PN] + U +
3186                             U + 'P' + U + Tmp + U + BOOLCHAR[NewLine] + U + '0';
3187                    FData := RData;
3188                    FOverrideType := ptVitalEntry;
3189                    InitValue;
3190                  end;
3191                end;
3192              end;
3193              if(dt = dtMentalHealthTest) then
3194              begin
3195                if(not assigned(FPrompts)) then
3196                  FPrompts := TList.Create;
3197                FChoicePrompt := TRemPrompt(FPrompts[FPrompts.Add(TRemPrompt.Create)]);
3198                with FChoicePrompt do
3199                begin
3200                  FParent := Self;
3201                  Tmp := Piece(FRec3,U,10);
3202                  NewLine := FALSE;
3203  //                FRec4 := '4' + U + FID + U + FTaxID + U + U + BOOLCHAR[not RData.Add2PN] + U +
3204  //                         RData.InternalValue + U + 'P' + U + Tmp + U + BOOLCHAR[SameL] + U + '1';
3205                  FRec4 := '4' + U + FID + U + FTaxID + U + U + BOOLCHAR[not RData.Add2PN] + U +
3206                           U + 'P' + U + Tmp + U + BOOLCHAR[NewLine] + U + '0';
3207                  FData := RData;
3208                  if ((Piece(FRec3, U, r3GAF) = '1')) and (MHDLLFound = false) then
3209                  begin
3210                    FOverrideType := ptGAF;
3211                    SetPiece(FRec4, U, 8, ForcedCaption + ':');
3212                  end
3213                  else
3214                    FOverrideType := ptMHTest;
3215                end;
3216              end;
3217            end;
3218          end;
3219        end;
3220      until(idx < 0);
3221  
3222      idx := -1;
3223      repeat
3224        idx := TempSL.IndexOfPieces(['4', FID, FTaxID], idx);
3225        if(idx >= 0) then
3226        begin
3227          pt := Code2PromptType(piece(TempSL[idx], U, 4));
3228          if(pt <> ptUnknown) and ((pt <> ptComment) or (not FHasComment)) then
3229          begin
3230            if(not assigned(FPrompts)) then
3231              FPrompts := TList.Create;
3232            RPrompt := TRemPrompt(FPrompts[FPrompts.Add(TRemPrompt.Create)]);
3233            with RPrompt do
3234            begin
3235              FParent := Self;
3236              FRec4 := TempSL[idx];
3237              InitValue;
3238            end;
3239            if(pt = ptComment) then
3240            begin
3241              FHasComment := TRUE;
3242              FCommentPrompt := RPrompt;
3243            end;
3244            if(pt = ptSubComment) then
3245              FHasSubComments := TRUE;
3246            if(pt = ptMST) then
3247              FMSTPrompt := RPrompt;
3248          end;
3249        end;
3250      until(idx < 0);
3251  
3252      idx := -1;
3253      repeat
3254        idx := TempSL.IndexOfPieces(['6', FID, FTaxID], idx);
3255        if(idx >= 0) then
3256        begin
3257          PrepText4NextLine(FPNText);
3258          FPNText := FPNText + Trim(Piece(TempSL[idx], U, 4));
3259        end;
3260      until(idx < 0);
3261      ExpandTIUObjects(FPNText);
3262    end;
3263  end;
3264  
3265  procedure TRemDlgElement.SetChecked(const Value: boolean);
3266  var
3267    i, j, k: integer;
3268    Kid: TRemDlgElement;
3269    Prompt: TRemPrompt;
3270    RData: TRemData;
3271  
3272    procedure UpdateForcedValues(Elem: TRemDlgElement);
3273    var
3274      i: integer;
3275  
3276    begin
3277      if(Elem.IsChecked) then
3278      begin
3279        if(assigned(Elem.FPrompts)) then
3280        begin
3281          for i := 0 to Elem.FPrompts.Count-1 do
3282          begin
3283            Prompt := TRemPrompt(Elem.FPrompts[i]);
3284            if Prompt.Forced then
3285            begin
3286              try
3287                Prompt.SetValueFromParent(Prompt.FValue);
3288              except
3289                on E: EForcedPromptConflict do
3290                begin
3291                  Elem.FChecked := FALSE;
3292                  InfoBox(E.Message, 'Error', MB_OK or MB_ICONERROR);
3293                  break;
3294                end
3295                else
3296                  raise;
3297              end;
3298            end;
3299          end;
3300        end;
3301        if(Elem.FChecked) and (assigned(Elem.FChildren)) then
3302          for i := 0 to Elem.FChildren.Count-1 do
3303            UpdateForcedValues(TRemDlgElement(Elem.FChildren[i]));
3304      end;
3305    end;
3306  
3307  begin
3308    if(FChecked <> Value) then
3309    begin
3310      FChecked := Value;
3311      if(Value) then
3312      begin
3313        GetData;
3314        if(FChecked and assigned(FParent)) then
3315        begin
3316          FParent.Check4ChildrenSharedPrompts;
3317          if(FParent.ChildrenRequired in [crOne, crNoneOrOne]) then
3318          begin
3319            for i := 0 to FParent.FChildren.Count-1 do
3320            begin
3321              Kid := TRemDlgElement(FParent.FChildren[i]);
3322              if(Kid <> Self) and (Kid.FChecked) then
3323                Kid.SetChecked(FALSE);
3324            end;
3325          end;
3326        end;
3327        UpdateForcedValues(Self);
3328      end
3329      else
3330      if(assigned(FPrompts) and assigned(FData)) then
3331      begin
3332        for i := 0 to FPrompts.Count-1 do
3333        begin
3334          Prompt := TRemPrompt(FPrompts[i]);
3335          if Prompt.Forced and (IsSyncPrompt(Prompt.PromptType)) then
3336          begin
3337            for j := 0 to FData.Count-1 do
3338            begin
3339              RData := TRemData(FData[j]);
3340              if(assigned(RData.FPCERoot)) then
3341                RData.FPCERoot.UnSync(Prompt);
3342              if(assigned(RData.FChoices)) then
3343              begin
3344                for k := 0 to RData.FChoices.Count-1 do
3345                begin
3346                  if(assigned(RData.FChoices.Objects[k])) then
3347                    TRemPCERoot(RData.FChoices.Objects[k]).UnSync(Prompt);
3348                end;
3349              end;
3350            end;
3351          end;
3352        end;
3353      end;
3354    end;
3355  end;
3356  
3357  function TRemDlgElement.TrueIndent: integer;
3358  var
3359    Prnt: TRemDlgElement;
3360    Nudge: integer;
3361  
3362  begin
3363    Result := Indent;
3364    Nudge := Gap;
3365    Prnt := FParent;
3366    while assigned(Prnt) do
3367    begin
3368      if(Prnt.Box) then
3369      begin
3370        Prnt := nil;
3371        inc(Nudge, Gap);
3372      end
3373      else
3374      begin
3375        Result := Result + Prnt.ChildrenIndent;
3376        Prnt := Prnt.FParent;
3377      end;
3378    end;
3379    Result := (Result * IndentMult) + Nudge;
3380  end;
3381  
3382  procedure TRemDlgElement.cbClicked(Sender: TObject);
3383  begin
3384    FReminder.BeginTextChanged;
3385    try
3386      FReminder.BeginNeedRedraw;
3387      try
3388        if(assigned(Sender)) then
3389        begin
3390          SetChecked((Sender as TORCheckBox).Checked);
3391          ElementChecked := Self;
3392        end;
3393      finally
3394        FReminder.EndNeedRedraw(Sender);
3395      end;
3396    finally
3397      FReminder.EndTextChanged(Sender);
3398    end;
3399    RemindersInProcess.Notifier.Notify;
3400    if assigned(TORCheckBox(Sender).Associate) and (not ScreenReaderSystemActive) then
3401      TDlgFieldPanel(TORCheckBox(Sender).Associate).SetFocus;
3402  end;
3403  
3404  function TRemDlgElement.EnableChildren: boolean;
3405  var
3406    Chk: boolean;
3407  
3408  begin
3409    if(assigned(FParent)) then
3410      Chk := FParent.EnableChildren
3411    else
3412      Chk := TRUE;
3413    if(Chk) then
3414    begin
3415      if(ElemType = etDisplayOnly) then
3416        Result := TRUE
3417      else
3418        Result := FChecked;
3419    end
3420    else
3421      Result := FALSE;
3422  end;
3423  
3424  function TRemDlgElement.Enabled: boolean;
3425  begin
3426    if(assigned(FParent)) then
3427      Result := FParent.EnableChildren
3428    else
3429      Result := TRUE;
3430  end;
3431  
3432  function TRemDlgElement.ShowChildren: boolean;
3433  begin
3434    if(assigned(FChildren) and (FChildren.Count > 0)) then
3435    begin
3436      if((ElemType = etDisplayOnly) or FChecked) then
3437        Result := TRUE
3438      else
3439        Result := (not HideChildren);
3440    end
3441    else
3442      Result := FALSE;
3443  end;
3444  
3445  type
3446    TAccessCheckBox = class(TORCheckBox);
3447  
3448  procedure TRemDlgElement.cbEntered(Sender: TObject);
3449  begin
3450  // changing focus because of a mouse click sets ClicksDisabled to false during the
3451  // call to SetFocus - this is how we allow the cbClicked code to execute on a mouse
3452  // click, which will set the focus after the mouse click.  All other cases and the
3453  // ClicksDisabled will be FALSE and the focus is reset here.  If we don't make this
3454  // check, you can't click on the check box..
3455    if (Last508KeyCode = VK_UP) or (Last508KeyCode = VK_LEFT) then