unit uReminders;

interface

uses
  Windows, Messages, Classes, Controls, StdCtrls, SysUtils, ComCtrls, Menus,
  Graphics, Forms, ORClasses, ORCtrls, ORDtTm, ORFn, ORNet, Dialogs, uPCE, uVitals,
  ExtCtrls, fDrawers, fDeviceSelect;

type
  TReminderDialog = class(TObject)
  private
    FDlgData: string;
    FElements: TStringList; // list of TRemDlgElement objects
    FOnNeedRedraw: TNotifyEvent;
    FNeedRedrawCount: integer;
    FOnTextChanged: TNotifyEvent;
    FTextChangedCount: integer;
    FPCEDataObj: TPCEData;
    FNoResolve: boolean;
    FWHReviewIEN: string;  // AGP CHANGE 23.13 Allow for multiple processing of WH Review of Result Reminders
  protected
    function GetIEN: string; virtual;
    function GetPrintName: string; virtual;
    procedure BeginNeedRedraw;
    procedure EndNeedRedraw(Sender: TObject);
    procedure BeginTextChanged;
    procedure EndTextChanged(Sender: TObject);
    function GetDlgSL: TORStringList;
    procedure ComboBoxResized(Sender: TObject);
    procedure ComboBoxCheckedText(Sender: TObject; NumChecked: integer; var Text: string);
    function AddData(Lst: TStrings; Finishing: boolean = FALSE; Historical: boolean = FALSE): integer;
    function Visible: boolean;
  public
    constructor BaseCreate;
    constructor Create(ADlgData: string);
    destructor Destroy; override;
    procedure FinishProblems(List: TStrings; var MissingTemplateFields: boolean);
    function BuildControls(ParentWidth: integer; AParent, AOwner: TWinControl): TWinControl;
    function Processing: boolean;
    procedure AddText(Lst: TStrings);
    property PrintName: string read GetPrintName;
    property IEN: string read GetIEN;
    property Elements: TStringList read FElements;
    property OnNeedRedraw: TNotifyEvent read FOnNeedRedraw write FOnNeedRedraw;
    property OnTextChanged: TNotifyEvent read FOnTextChanged write FOnTextChanged;
    property PCEDataObj: TPCEData read FPCEDataObj write FPCEDataObj;
    property DlgData: string read FDlgData; //AGP Change 24.8
    property WHReviewIEN: string read FWHReviewIEN write FWHReviewIEN;  //AGP CHANGE 23.13
  end;

  TReminder = class(TReminderDialog)
  private
    FRemData: string;
    FCurNodeID: string;
  protected
    function GetDueDateStr: string;
    function GetLastDateStr: string;
    function GetIEN: string; override;
    function GetPrintName: string; override;
    function GetPriority: integer;
    function GetStatus: string;
  public
    constructor Create(ARemData: string);
    property DueDateStr: string read GetDueDateStr;
    property LastDateStr: string read GetLastDateStr;
    property Priority: integer read GetPriority;
    property Status: string read GetStatus;
    property RemData: string read FRemData;
    property CurrentNodeID: string read FCurNodeID write FCurNodeID;
  end;

  TRDChildReq = (crNone, crOne, crAtLeastOne, crNoneOrOne);
  TRDElemType = (etCheckBox, etTaxonomy, etDisplayOnly);

  TRemPrompt = class;

  TRemDlgElement = class(TObject)
  private
    FReminder: TReminderDialog;
    FParent: TRemDlgElement;
    FChildren: TList; // Points to other TRemDlgElement objects
    FData: TList; // List of TRemData objects
    FPrompts: TList; // list of TRemPrompts objects
    FText: string;
    FPNText: string;
    FRec1: string;
    FID: string;
    FDlgID: string;
    FHaveData: boolean;
    FTaxID: string;
    FChecked: boolean;
    FChildrenShareChecked: boolean;
    FHasSharedPrompts: boolean;
    FHasComment: boolean;
    FHasSubComments: boolean;
    FCommentPrompt: TRemPrompt;
    FFieldValues: TORStringList;
    FMSTPrompt: TRemPrompt;
    FWHPrintDevice, FWHResultChk, FWHResultNot: String;
    //FRemWHNotPurpose: TStrings;
  protected
    procedure Check4ChildrenSharedPrompts;
    function ShowChildren: boolean;
    function EnableChildren: boolean;
    function Enabled: boolean;
    procedure SetChecked(const Value: boolean);
    procedure UpdateData;
    procedure GetData;
    function TrueIndent: integer;
    procedure cbClicked(Sender: TObject);
    procedure FieldPanelEntered(Sender: TObject);
    procedure FieldPanelExited(Sender: TObject);
    procedure FieldPanelKeyPress(Sender: TObject; var Key: Char);
    procedure FieldPanelOnClick(Sender: TObject);
    procedure FieldPanelLabelOnClick(Sender: TObject);

    function BuildControls(var Y: integer; ParentWidth: integer;
                                BaseParent, AOwner: TWinControl): TWinControl;
    function AddData(Lst: TStrings; Finishing: boolean; AHistorical: boolean = FALSE): integer;
    procedure FinishProblems(List: TStrings);
    function IsChecked: boolean;
    procedure SubCommentChange(Sender: TObject);
    function EntryID: string;
    procedure FieldPanelChange(Sender: TObject);
    procedure GetFieldValues(FldData: TStrings);
    procedure ParentCBEnter(Sender: TObject);
    procedure ParentCBExit(Sender: TObject);
  public
    constructor Create;
    destructor Destroy; override;
    function ElemType: TRDElemType;
    function Add2PN: boolean;
    function Indent: integer;
    function FindingType: string;
    function Historical: boolean;
    function ResultDlgID: integer;
    function IncludeMHTestInPN: boolean;
    function HideChildren: boolean;
    function ChildrenIndent: integer;
    function ChildrenSharePrompts: boolean;
    function ChildrenRequired: TRDChildReq;
    function Box: boolean;
    function BoxCaption: string;
    function IndentChildrenInPN: boolean;
    function IndentPNLevel: integer;
    function GetTemplateFieldValues(const Text: string; FldValues: TORStringList =  nil): string;
    procedure AddText(Lst: TStrings);
    property Text: string read FText;
    property ID: string read FID;
    property DlgID: string read FDlgID;
    property Checked: boolean read FChecked write SetChecked;
    property Reminder: TReminderDialog read FReminder;
    property HasComment: boolean read FHasComment;
    property WHPrintDevice: String read FWHPrintDevice write FWHPrintDevice;
    property WHResultChk: String read FWHResultChk write FWHResultChk;
    property WHResultNot: String read FWHResultNot write FWHResultNot;
    //property RemWHNotPurpose: TStrings read FRemWHNotPurpose write FRemWHNotPurpose;
  end;

  TRemDataType = (dtDiagnosis, dtProcedure, dtPatientEducation,
                  dtExam, dtHealthFactor, dtImmunization, dtSkinTest,
                  dtVitals, dtOrder, dtMentalHealthTest, dtWHPapResult,
                  dtWhNotPurp);

  TRemPCERoot = class;

  TRemData = class(TObject)
  private
    FPCERoot: TRemPCERoot;
    FParent: TRemDlgElement;
    FRec3: string;  
    FActiveDates: TStringList; //Active dates for finding items. (rectype 3)
//    FRoot: string;
    FChoices: TORStringList;
    FChoicesActiveDates: TList; //Active date ranges for taxonomies. (rectype 5)
                                //List of TStringList objects that contain active date
                                //ranges for each FChoices object of the same index
    FChoicePrompt: TRemPrompt;  //rectype 4
    FChoicesMin: integer;
    FChoicesMax: integer;
    FChoicesFont: THandle;
    FSyncCount: integer;
  protected
    function AddData(List: TStrings; Finishing: boolean): integer;
  public
    destructor Destroy; override;
    function Add2PN: boolean;
    function DisplayWHResults: boolean;
    function InternalValue: string;
    function ExternalValue: string;
    function Narrative: string;
    function Category: string;
    function DataType: TRemDataType;
    property Parent: TRemDlgElement read FParent;
  end;

  TRemPromptType = (ptComment, ptVisitLocation, ptVisitDate, ptQuantity,
                    ptPrimaryDiag, ptAdd2PL, ptExamResults, ptSkinResults,
                    ptSkinReading, ptLevelSeverity, ptSeries, ptReaction,
                    ptContraindicated, ptLevelUnderstanding, ptWHPapResult,
                    ptWHNotPurp);

  TRemPrompt = class(TObject)
  private
    FFromControl: boolean;
    FParent: TRemDlgElement;
    FRec4: string;
    FCaptionAssigned: boolean;
    FData: TRemData;
    FValue: string;
    FOverrideType: TRemPromptType;
    FIsShared: boolean;
    FSharedChildren: TList;
    FCurrentControl: TControl;
    FFromParent: boolean;
    FInitializing: boolean;
    FMiscText: string;
    FMonthReq: boolean;
    FPrintNow: String;
  protected
    function RemDataActive(RData: TRemData; EncDt: TFMDateTime):Boolean;
    function RemDataChoiceActive(RData: TRemData; j: integer; EncDt: TFMDateTime):Boolean;
    function GetValue: string;
    procedure SetValueFromParent(Value: string);
    procedure SetValue(Value: string);
    procedure PromptChange(Sender: TObject);
    procedure VitalVerify(Sender: TObject);
    procedure ComboBoxKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    function CanShare(Prompt: TRemPrompt): boolean;
    procedure InitValue;
    procedure DoMHTest(Sender: TObject);
    procedure DoWHReport(Sender: TObject);
    procedure ViewWHText(Sender: TObject);
    procedure GAFHelp(Sender: TObject);
    function EntryID: string;
    procedure EditKeyPress(Sender: TObject; var Key: Char);
  public
    constructor Create;
    destructor Destroy; override;
    function PromptOK: boolean;
    function PromptType: TRemPromptType;
    function Add2PN: boolean;
    function InternalValue: string;
    function Forced: boolean;
    function Caption: string;
    function ForcedCaption: string;
    function SameLine: boolean;
    function Required: boolean;
    function NoteText: string;
    function VitalType: TVitalType;
    function VitalValue: string;
    function VitalUnitValue: string;
    property Value: string read GetValue write SetValue;
  end;

  TRemPCERoot = class(TObject)
  private
    FData: TList;
    FID: string;
    FForcedPrompts: TStringList;
    FValue: string;
    FValueSet: string;
  protected
    class function GetRoot(Data: TRemData; Rec3: string; Historical: boolean): TRemPCERoot;
    procedure Done(Data: TRemData);
    procedure Sync(Prompt: TRemPrompt);
    procedure UnSync(Prompt: TRemPrompt);
    function GetValue(PromptType: TRemPromptType; var NewValue: string): boolean;
  public
    destructor Destroy; override;
  end;

  TReminderStatus = (rsDue, rsApplicable, rsNotApplicable, rsNone, rsUnknown);

  TRemCanFinishProc = function: boolean of object;
  TRemDisplayPCEProc = procedure of object;

  TRemForm = record
    Form: TForm;
    PCEObj: TPCEData;
    RightPanel: TPanel;
    CanFinishProc: TRemCanFinishProc;
    DisplayPCEProc: TRemDisplayPCEProc;
    Drawers: TFrmDrawers;
    NewNoteRE: TRichEdit;
    NoteList: TORListBox;
  end;

var
  RemForm: TRemForm;
  NotPurposeValue: string;
  WHRemPrint: string;

const
  HAVE_REMINDERS = 0;
  NO_REMINDERS = 1;
  RemPriorityText: array[1..3] of string = ('High','','Low');
  ClinMaintText = 'Clinical Maintenance';
  InitialRemindersLoaded: boolean = FALSE;

  dtUnknown = TRemDataType(-1);
  dtAll = TRemDataType(-2);
  dtHistorical = TRemDataType(-3);

  ptUnknown = TRemPromptType(-1);
  ptSubComment = TRemPromptType(-2);
  ptDataList = TRemPromptType(-3);
  ptVitalEntry = TRemPromptType(-4);
  ptMHTest = TRemPromptType(-5);
  ptGAF = TRemPromptType(-6);
  ptMST = TRemPromptType(-7);

  MSTCode = 'MST';
  MSTDataTypes = [pdcHF, pdcExam];
  pnumMST = ord(pnumComment)+4;

procedure NotifyWhenRemindersChange(Proc: TNotifyEvent);
procedure RemoveNotifyRemindersChange(Proc: TNotifyEvent);
procedure StartupReminders;
function GetReminderStatus: TReminderStatus;
function RemindersEvaluatingInBackground: boolean;
procedure ResetReminderLoad;
procedure LoadReminderData(ProcessingInBackground: boolean = FALSE);
function ReminderEvaluated(Data: string; ForceUpdate: boolean = FALSE): boolean;
procedure RemindersEvaluated(List: TStringList);
procedure EvalReminder(ien: integer);
procedure EvalProcessed;
procedure EvaluateCategoryClicked(AData: pointer; Sender: TObject);

procedure SetReminderPopupRoutine(Menu: TPopupMenu);
procedure SetReminderPopupCoverRoutine(Menu: TPopupMenu);
procedure SetReminderMenuSelectRoutine(Menu: TMenuItem);
procedure BuildReminderTree(Tree: TORTreeView);
function ReminderNode(Node: TTreeNode): TORTreeNode;
procedure ClearReminderData;
function GetReminder(ARemData: string): TReminder;
procedure WordWrap(const AText: string; Output: TStrings; LineLength: integer;
                                                   AutoIndent: integer = 4);
function InteractiveRemindersActive: boolean;
function GetReminderData(Rem: TReminderDialog; Lst: TStrings; Finishing: boolean = FALSE;
                                         Historical: boolean = FALSE): integer; overload;
function GetReminderData(Lst: TStrings; Finishing: boolean = FALSE;
                                         Historical: boolean = FALSE): integer; overload;
procedure SetReminderFormBounds(Frm: TForm; DefX, DefY, DefW, DefH, ALeft, ATop, AWidth, AHeight: integer);

procedure UpdateReminderDialogStatus;

//const
//  InteractiveRemindersActive = FALSE;
type
  TWHCheckBox = class(TORCheckBox)
  private
  FPrintNow: TORCheckBox;
  FViewLetter: TORCheckBox;
  FCheck1: TORCheckBox;
  FCheck2: TORCheckBox;
  FCheck3: TORCheckBox;
  FEdit: TEdit;
  FButton: TButton;
  FOnDestroy: TNotifyEvent;
  Flbl, Flbl2: TLabel;
  FPrintVis: String;
  //FPrintDevice: String;
  FPntNow: String;
  FPntBatch: String;
  FButtonText: String;
  FCheckNum: String;
  protected  
  public
  property lbl: TLabel read Flbl write Flbl;
  property lbl2: TLabel read Flbl2 write Flbl2;
  property PntNow: String read FPntNow write FPntNow;
  property PntBatch: String read FPntBatch write FPntBatch;
  property CheckNum: String read FCheckNum write FCheckNum;
  property ButtonText: String read FButtonText write FButtonText;
  property PrintNow: TORCheckBox read FPrintNow write FPrintNow;
  property Check1: TORCheckBox read FCheck1 write FCheck1;
  property Check2: TORCheckBox read FCheck2 write FCheck2;
  property Check3: TORCheckBox read FCheck3 write FCheck3;
  property ViewLetter: TORCheckBox read FViewLetter write FViewLetter;
  property Button: TButton read FButton write FButton;
  property Edit: TEdit read FEdit write FEdit;
  property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
  property PrintVis: String read FPrintVis write FPrintVis;
  end;

var
{ 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  }
  ActiveReminders: TORStringList = nil;

{ OtherReminder string format:
  IDENTIFIER^TYPE^NAME^PARENT IDENTIFIER^REMINDER IEN^DIALOG
  where TYPE C=Category, R=Reminder }
  OtherReminders: TORStringList = nil;

  RemindersInProcess: TORStringList = nil;
  CoverSheetRemindersInBackground: boolean = FALSE;
  KillReminderDialogProc: procedure(frm: TForm) = nil;
  RemindersStarted: boolean = FALSE;
  ProcessedReminders: TORStringList = nil;
  ReminderDialogInfo: TStringList = nil;

const
  CatCode = 'C';
  RemCode = 'R';
  EduCode = 'E';
  pnumVisitLoc  = pnumComment + 1;
  pnumVisitDate = pnumComment + 2;
  RemTreeDateIdx = 8;
  IncludeParentID = ';';
  OtherCatID = CatCode + '-6';

  RemDataCodes: array[TRemDataType] of string =
                  { dtDiagnosis        } ('POV',
                  { dtProcedure        }  'CPT',
                  { dtPatientEducation }  'PED',
                  { dtExam             }  'XAM',
                  { dtHealthFactor     }  'HF',
                  { dtImmunization     }  'IMM',
                  { dtSkinTest         }  'SK',
                  { dtVitals           }  'VIT',
                  { dtOrder            }  'Q',
                  { dtMentalHealthTest }  'MH',
                  { dtWHPapResult      }  'WHR',
                  { dtWHNotPurp        }  'WH');

implementation

uses rCore, uCore, rReminders, fRptBox, uConst, fReminderDialog, fNotes, rMisc,
     fMHTest, rPCE, rTemplates, dShared, uTemplateFields, fIconLegend, fReminderTree;

type
  TRemFolder = (rfUnknown, rfDue, rfApplicable, rfNotApplicable, rfEvaluated, rfOther);
  TRemFolders = set of TRemFolder;
  TValidRemFolders = succ(low(TRemFolder)) .. high(TRemFolder);

var
  LastReminderLocation: integer = -2;
  EvaluatedReminders: TORStringList = nil;
  ReminderTreeMenu: TORPopupMenu = nil;
  ReminderTreeMenuDlg: TORPopupMenu = nil;
  ReminderCatMenu: TPopupMenu = nil;
  EducationTopics: TORStringList = nil;
  WebPages: TORStringList = nil;
  ReminderCallList: TORStringList = nil;
  LastProcessingList: string = '';
  InteractiveRemindersActiveChecked: boolean = FALSE;
  InteractiveRemindersActiveStatus: boolean = FALSE;
  PCERootList: TStringList;
  PrimaryDiagRoot: TRemPCERoot = nil;
  ElementChecked: TRemDlgElement = nil;
  HistRootCount: longint = 0;
  uRemFolders: TRemFolders = [rfUnknown];

const
  DueText = 'Due';
  ApplicableText = 'Applicable';
  NotApplicableText = 'Not Applicable';
  EvaluatedText = 'All Evaluated';
  OtherText = 'Other Categories';

  DueCatID = CatCode + '-2';
  DueCatString = DueCatID + U + DueText;

  ApplCatID = CatCode + '-3';
  ApplCatString = ApplCatID + U + ApplicableText;

  NotApplCatID = CatCode + '-4';
  NotApplCatString = NotApplCatID + U + NotApplicableText;

  EvaluatedCatID = CatCode + '-5';
  EvaluatedCatString = EvaluatedCatID + U + EvaluatedText;

//  OtherCatID = CatCode + '-6';
  OtherCatString = OtherCatID + U + OtherText;

  LostCatID = CatCode + '-7';
  LostCatString = LostCatID + U + 'In Process';

  ReminderDateFormat = 'mm/dd/yyyy';

  RemData2PCECat: array[TRemDataType] of TPCEDataCat =
                  { dtDiagnosis        } (pdcDiag,
                  { dtProcedure        }  pdcProc,
                  { dtPatientEducation }  pdcPED,
                  { dtExam             }  pdcExam,
                  { dtHealthFactor     }  pdcHF,
                  { dtImmunization     }  pdcImm,
                  { dtSkinTest         }  pdcSkin,
                  { dtVitals           }  pdcVital,
                  { dtOrder            }  pdcOrder,
                  { dtMentalHealthTest }  pdcMH,
                  { dtWHPapResult      }  pdcWHR,
                  { dtWHNotPurp        }  pdcWH);

  RemPromptCodes: array[TRemPromptType] of string =
                  { ptComment             } ('COM',
                  { ptVisitLocation       }  'VST_LOC',
                  { ptVisitDate           }  'VST_DATE',
                  { ptQuantity            }  'CPT_QTY',
                  { ptPrimaryDiag         }  'POV_PRIM',
                  { ptAdd2PL              }  'POV_ADD',
                  { ptExamResults         }  'XAM_RES',
                  { ptSkinResults         }  'SK_RES',
                  { ptSkinReading         }  'SK_READ',
                  { ptLevelSeverity       }  'HF_LVL',
                  { ptSeries              }  'IMM_SER',
                  { ptReaction            }  'IMM_RCTN',
                  { ptContraindicated     }  'IMM_CNTR',
                  { ptLevelUnderstanding  }  'PED_LVL',
                  { ptWHPapResult         }  'WH_PAP_RESULT',
                  { ptWHNotPurp           }  'WH_NOT_PURP');

  RemPromptTypes: array[TRemPromptType] of TRemDataType =
                  { ptComment             } (dtAll,
                  { ptVisitLocation       }  dtHistorical,
                  { ptVisitDate           }  dtHistorical,
                  { ptQuantity            }  dtProcedure,
                  { ptPrimaryDiag         }  dtDiagnosis,
                  { ptAdd2PL              }  dtDiagnosis,
                  { ptExamResults         }  dtExam,
                  { ptSkinResults         }  dtSkinTest,
                  { ptSkinReading         }  dtSkinTest,
                  { ptLevelSeverity       }  dtHealthFactor,
                  { ptSeries              }  dtImmunization,
                  { ptReaction            }  dtImmunization,
                  { ptContraindicated     }  dtImmunization,
                  { ptLevelUnderstanding  }  dtPatientEducation,
                  { ptWHPapResult         }  dtWHPapResult,
                  { ptWHNotPurp           }  dtWHNotPurp);

  FinishPromptPieceNum: array[TRemPromptType] of integer =
                  { ptComment             } (pnumComment,
                  { ptVisitLocation       }  pnumVisitLoc,
                  { ptVisitDate           }  pnumVisitDate,
                  { ptQuantity            }  pnumProcQty,
                  { ptPrimaryDiag         }  pnumDiagPrimary,
                  { ptAdd2PL              }  pnumDiagAdd2PL,
                  { ptExamResults         }  pnumExamResults,
                  { ptSkinResults         }  pnumSkinResults,
                  { ptSkinReading         }  pnumSkinReading,
                  { ptLevelSeverity       }  pnumHFLevel,
                  { ptSeries              }  pnumImmSeries,
                  { ptReaction            }  pnumImmReaction,
                  { ptContraindicated     }  pnumImmContra,
                  { ptLevelUnderstanding  }  pnumPEDLevel,
                  { ptWHPapResult         }  pnumWHPapResult,
                  { ptWHNotPurp           }  pnumWHNotPurp);

  ComboPromptTags: array[TRemPromptType] of integer =
                  { ptComment             } (0,
                  { ptVisitLocation       }  TAG_HISTLOC,
                  { ptVisitDate           }  0,
                  { ptQuantity            }  0,
                  { ptPrimaryDiag         }  0,
                  { ptAdd2PL              }  0,
                  { ptExamResults         }  TAG_XAMRESULTS,
                  { ptSkinResults         }  TAG_SKRESULTS,
                  { ptSkinReading         }  0,
                  { ptLevelSeverity       }  TAG_HFLEVEL,
                  { ptSeries              }  TAG_IMMSERIES,
                  { ptReaction            }  TAG_IMMREACTION,
                  { ptContraindicated     }  0,
                  { ptLevelUnderstanding  }  TAG_PEDLEVEL,
                  { ptWHPapResult         }  0,
                  { ptWHNotPurp           }  0);

  PromptDescriptions: array [TRemPromptType] of string =
                  { ptComment             } ('Comment',
                  { ptVisitLocation       }  'Visit Location',
                  { ptVisitDate           }  'Visit Date',
                  { ptQuantity            }  'Quantity',
                  { ptPrimaryDiag         }  'Primary Diagnosis',
                  { ptAdd2PL              }  'Add to Problem List',
                  { ptExamResults         }  'Exam Results',
                  { ptSkinResults         }  'Skin Test Results',
                  { ptSkinReading         }  'Skin Test Reading',
                  { ptLevelSeverity       }  'Level of Severity',
                  { ptSeries              }  'Series',
                  { ptReaction            }  'Reaction',
                  { ptContraindicated     }  'Repeat Contraindicated',
                  { ptLevelUnderstanding  }  'Level of Understanding',
                  { ptWHPapResult         }  'Women''s Health Procedure',
                  { ptWHNotPurp           }  'Women Health Notification Purpose');

  RemFolderCodes: array[TValidRemFolders] of char =
     { rfDue           } ('D',
     { rfApplicable    }  'A',
     { rfNotApplicable }  'N',
     { rfEvaluated     }  'E',
     { rfOther         }  'O');

  MSTDescTxt: array[0..4,0..1] of string = (('Yes','Y'),('No','N'),('Declined','D'),
                                            ('Normal','N'),('Abnormal','A'));

  SyncPrompts = [ptComment, ptQuantity, ptAdd2PL, ptExamResults,
                 ptSkinResults, ptSkinReading, ptLevelSeverity, ptSeries,
                 ptReaction, ptContraindicated, ptLevelUnderstanding];

  Gap = 2;
  LblGap = 4;
  IndentGap = 18;
  PromptGap = 10;
  NewLinePromptGap = 18;
  IndentMult = 9;
  PromptIndent = 30;
  gbLeftIndent = 2;
  gbTopIndent = 9;
  gbTopIndent2 = 16;
  DisabledFontColor = clBtnShadow;
  r3Type = 4;
  r3Code2 = 6;
  r3Code = 7;
  r3Cat  = 9;
  r3Nar = 8;
  r3GAF = 12;

  RemTreeCode = 999;

  CRCode = '<br>';
  CRCodeLen = length(CRCode);
  REMEntryCode = 'REM';

  MonthReqCode = 'M';

type
  TVitalComboBox = class;

  TVitalEdit = class(TEdit)
  private
    FLinkedCombo: TVitalComboBox;
  end;

  TVitalComboBox = class(TComboBox)
  private
    FLinkedEdit: TVitalEdit;
  public
    procedure SelectByID(Value: string);
  end;

function InitText(const InStr: string): string;
var
  i: integer;

begin
  Result := InStr;
  if(copy(Result, 1, CRCodeLen) = CRCode) then
  begin
    i := pos(CRCode, copy(Result, CRCodeLen+1, MaxInt));
    if(i > 0) and ((i = (CRCodeLen + 1)) or
      (Trim(copy(Result, CrCodeLen+1, i - 1)) = '')) then
      delete(Result,1,CRCodeLen + i - 1);
  end;
end;

function CRLFText(const InStr: string): string;
var
  i: integer;

begin
  Result := InitText(InStr);
  repeat
    i := pos(CRCode, Result);
    if(i > 0) then
      Result := copy(Result,1,i-1) + CRLF + copy(REsult,i + CRCodeLen, MaxInt);
  until(i = 0);
end;

function Code2VitalType(Code: string): TVitalType;
var
  v: TVitalType;

begin
  Result := vtUnknown;
  for v := low(TValidVitalTypes) to high(TValidVitalTypes) do
  begin
    if(Code = VitalPCECodes[v]) then
    begin
      Result := v;
      break;
    end;
  end;
end;


procedure TVitalComboBox.SelectByID(Value: string);
var
  i: integer;

begin
  for i := 0 to Items.Count-1 do
    if(Value = Items[i]) then
    begin
      ItemIndex := i;
      break;
    end;
end;

type
  TMultiClassObj = record
    case integer of
      0: (edt:  TEdit);
      1: (cb:   TORCheckBox);
      2: (cbo:  TORComboBox);
      3: (dt:   TORDateCombo);
      4: (ctrl: TORExposedControl);
      5: (vedt: TVitalEdit);
      6: (vcbo: TVitalComboBox);
      7: (btn:  TButton);
      8: (pNow: TORCheckBox);
      9: (pBat: TORCheckBox);
     10: (lbl: TLabel);
     11: (WHChk: TWHCheckBox);
  end;

  EForcedPromptConflict = class(EAbort);

function IsSyncPrompt(pt: TRemPromptType): boolean;
begin
  if(pt in SyncPrompts) then
    Result := TRUE
  else
    Result := (pt = ptVitalEntry);
end;

procedure NotifyWhenRemindersChange(Proc: TNotifyEvent);
begin
  ActiveReminders.Notifier.NotifyWhenChanged(Proc);
  OtherReminders.Notifier.NotifyWhenChanged(Proc);
  RemindersInProcess.Notifier.NotifyWhenChanged(Proc);
  Proc(nil);
end;

procedure RemoveNotifyRemindersChange(Proc: TNotifyEvent);
begin
  ActiveReminders.Notifier.RemoveNotify(Proc);
  OtherReminders.Notifier.RemoveNotify(Proc);
  RemindersInProcess.Notifier.RemoveNotify(Proc);
end;

function ProcessingChangeString: string;
var
  i: integer;
  TmpSL: TStringList;

begin
  Result := U;
  if(RemindersInProcess.Count > 0) then
  begin
    TmpSL := TStringList.Create;
    try
      TmpSL.Assign(RemindersInProcess);
      TmpSL.Sort;
      for i := 0 to TmpSL.Count-1 do
      begin
        if(TReminder(TmpSL.Objects[i]).Processing) then
          Result := Result + TmpSL[i] + U;
      end;
    finally
      TmpSL.Free;
    end;
  end;
end;

procedure StartupReminders;
begin
  if(not InitialRemindersLoaded) then
  begin
    RemindersStarted := TRUE;
    InitialRemindersLoaded := TRUE;
    LoadReminderData;
  end;
end;

function GetReminderStatus: TReminderStatus;
begin
       if(EvaluatedReminders.IndexOfPiece('1',U,6) >= 0) then Result := rsDue
  else if(EvaluatedReminders.IndexOfPiece('0',U,6) >= 0) then Result := rsApplicable
  else if(EvaluatedReminders.IndexOfPiece('2',U,6) >= 0) then Result := rsNotApplicable
  else                                                        Result := rsUnknown;
//  else if(EvaluatedReminders.Count > 0) or (OtherReminders.Count > 0) or
//         (not InitialRemindersLoaded) or
//         (ProcessingChangeString <> U) then Result := rsUnknown
//  else Result := rsNone;
end;

function RemindersEvaluatingInBackground: boolean;
begin
  Result := CoverSheetRemindersInBackground;
  if(not Result) then
    Result := (ReminderCallList.Count > 0)
end;

var
  TmpActive: TStringList = nil;
  TmpOther: TStringList = nil;

procedure BeginReminderUpdate;
begin
  ActiveReminders.Notifier.BeginUpdate;
  OtherReminders.Notifier.BeginUpdate;
  TmpActive := TStringList.Create;
  TmpActive.Assign(ActiveReminders);
  TmpOther := TStringList.Create;
  TmpOther.Assign(OtherReminders);
end;

procedure EndReminderUpdate(Force: boolean = FALSE);
var
  DoNotify: boolean;

begin
  DoNotify := Force;
  if(not DoNotify) then
    DoNotify := (not ActiveReminders.Equals(TmpActive));
  KillObj(@TmpActive);
  if(not DoNotify) then
    DoNotify := (not OtherReminders.Equals(TmpOther));
  KillObj(@TmpOther);
  OtherReminders.Notifier.EndUpdate;
  ActiveReminders.Notifier.EndUpdate(DoNotify);
end;

function GetRemFolders: TRemFolders;
var
  i: TRemFolder;
  tmp: string;

begin
  if rfUnknown in uRemFolders then
  begin
    tmp := GetReminderFolders;
    uRemFolders := [];
    for i := low(TValidRemFolders) to high(TValidRemFolders) do
      if(pos(RemFolderCodes[i], tmp) > 0) then
        include(uRemFolders, i);
  end;
  Result := uRemFolders;
end;

procedure SetRemFolders(const Value: TRemFolders);
var
  i: TRemFolder;
  tmp: string;

begin
  if(Value <> uRemFolders) then
  begin
    BeginReminderUpdate;
    try
      uRemFolders := Value;
      tmp := '';
      for i := low(TValidRemFolders) to high(TValidRemFolders) do
        if(i in Value) then
          tmp := tmp + RemFolderCodes[i];
      SetReminderFolders(tmp);
    finally
      EndReminderUpdate(TRUE);
    end;
  end;
end;

function ReminderEvaluated(Data: string; ForceUpdate: boolean = FALSE): boolean;
var
  idx: integer;
  Code, Sts, Before: string;

begin
  Result := ForceUpdate;
  if(Data <> '') then
  begin
    Code := Piece(Data, U, 1);
    if StrToIntDef(Code,0) > 0 then
    begin
      ActiveReminders.Notifier.BeginUpdate;
      try
        idx := EvaluatedReminders.IndexOfPiece(Code);
        if(idx < 0) then
        begin
          EvaluatedReminders.Add(Data);
          Result := TRUE;
        end
        else
        begin
          Before := Piece(EvaluatedReminders[idx], U, 6);
          EvaluatedReminders[idx] := Data;
          if(not Result) then
            Result := (Before <> Piece(Data, U, 6));
        end;
        idx := ActiveReminders.IndexOfPiece(Code);
        if(idx < 0) then
        begin
          Sts := Piece(Data, U, 6);
          if(Sts = '0') or (Sts = '1') then
          begin
            Result := TRUE;
            ActiveReminders.Add(Data);
          end;
        end
        else
        begin
          if(not Result) then
            Result := (ActiveReminders[idx] <> Data);
          ActiveReminders[idx] := Data;
        end;
        idx := ProcessedReminders.IndexOfPiece(Code);
        if(idx >= 0) then
          ProcessedReminders.Delete(idx);
      finally
        ActiveReminders.Notifier.EndUpdate(Result);
      end;
    end
    else
      Result := TRUE; // If Code = 0 then it's 0^No Reminders Due, indicating a status change.
  end;
end;

procedure RemindersEvaluated(List: TStringList);
var
  i: integer;
  DoUpdate, RemChanged: boolean;

begin
  DoUpdate := FALSE;
  ActiveReminders.Notifier.BeginUpdate;
  try
    for i := 0 to List.Count-1 do
    begin
      RemChanged := ReminderEvaluated(List[i]);
      if(RemChanged) then DoUpdate := TRUE;
    end;
  finally
    ActiveReminders.Notifier.EndUpdate(DoUpdate);
  end;
end;

(*
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;
*)

procedure CheckReminders;
var
  RemList: TStringList;
  i: integer;
  Code: string;

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
  begin
    RemList := TStringList.Create;
    try
      while (ReminderCallList.Count > 0) do
      begin
        Code := Piece(ReminderCallList[0],U,1);
        ReminderCallList.Delete(0);
        repeat
          i := ReminderCallList.IndexOfPiece(Code);
          if(i >= 0) then
            ReminderCallList.Delete(i);
        until(i < 0);
        RemList.Add(Code);
      end;
      if(RemList.Count > 0) then
      begin
        EvaluateReminders(RemList);
        RemList.Assign(RPCBrokerV.Results);
        for i := 0 to RemList.Count-1 do
          ReminderEvaluated(RemList[i], (i = (RemList.Count-1)));
      end;
    finally
      RemList.Free;
    end;
  end;
end;

procedure ResetReminderLoad;
begin
  LastReminderLocation := -2;
  LoadReminderData;
end;

procedure LoadReminderData(ProcessingInBackground: boolean = FALSE);
var
  i, idx: integer;
  RemID: string;
  TempList: TORStringList;

begin
  if(RemindersStarted and (LastReminderLocation <> Encounter.Location)) then
  begin
    LastReminderLocation := Encounter.Location;
    BeginReminderUpdate;
    try
      GetCurrentReminders;
      TempList := TORStringList.Create;
      try
        if(RPCBrokerV.Results.Count > 0) then
        begin
          for i := 0 to RPCBrokerV.Results.Count-1 do
          begin
            RemID := RPCBrokerV.Results[i];
            idx := EvaluatedReminders.IndexOfPiece(RemID);
            if(idx < 0) then
            begin
              TempList.Add(RemID);
              if(not ProcessingInBackground) then
                ReminderCallList.Add(RemID);
            end
            else
              TempList.Add(EvaluatedReminders[idx]);
          end;
        end;
        // ActiveReminders.Assign(TempList);
        for i := 0 to TempList.Count-1 do
        begin
          RemID := Piece(TempList[i],U,1);
          if(ActiveReminders.indexOfPiece(RemID) < 0) then
            ActiveReminders.Add(TempList[i]);
        end;
      finally
        TempList.Free;
      end;
      CheckReminders;
      GetOtherReminders(OtherReminders);
    finally
      EndReminderUpdate;
    end;
  end;
end;

{ Supporting events for Reminder TreeViews }

procedure GetImageIndex(AData: Pointer; Sender: TObject; Node: TTreeNode);
var
  iidx, oidx: integer;
  Data, Tmp: string;

begin
  if(Assigned(Node)) then
  begin
    oidx := -1;
    Data := (Node as TORTreeNode).StringData;
    if(copy(Piece(Data, U, 1),1,1) = CatCode) then
    begin
      if(Node.Expanded) then
        iidx := 1
      else
        iidx := 0;
    end
    else
    begin
      Tmp := Piece(Data, U, 6);
      if(Tmp = '1') then iidx := 2
      else if(Tmp = '0') then iidx := 3
      else
      begin
        if(EvaluatedReminders.IndexOfPiece(copy(Piece(Data, U, 1),2,MaxInt),U,1) < 0) then
          iidx := 5
        else
          iidx := 4;
      end;

      if(Piece(Data,U,7) = '1') then
      begin
        Tmp := copy(Piece(Data, U, 1),2,99);
        if(ProcessedReminders.IndexOfPiece(Tmp,U,1) >=0) then
          oidx := 1
        else
          oidx:= 0;
      end;
    end;
    Node.ImageIndex := iidx;
    Node.SelectedIndex := iidx;
    if(Node.OverlayIndex <> oidx) then
    begin
      Node.OverlayIndex := oidx;
      Node.TreeView.Invalidate;
    end;
  end;
end;

type
  TRemMenuCmd = (rmClinMaint, rmEdu, rmInq, rmWeb, rmDash, rmEval,
                 rmDue, rmApplicable, rmNotApplicable, rmEvaluated, rmOther,
                 rmLegend);
  TRemViewCmds = rmDue..rmOther;

const
  RemMenuFolder: array[TRemViewCmds] of TRemFolder =
                           { rmDue           } (rfDue,
                           { rmApplicable    }  rfApplicable,
                           { rmNotApplicable }  rfNotApplicable,
                           { rmEvaluated     }  rfEvaluated,
                           { rmOther         }  rfOther);

  RemMenuNames: array[TRemMenuCmd] of string = (
                           { rmClinMaint     }  ClinMaintText,
                           { rmEdu           }  'Education Topic Definition',
                           { rmInq           }  'Reminder Inquiry',
                           { rmWeb           }  'Reference Information',
                           { rmDash          }  '-',
                           { rmEval          }  'Evaluate Reminder',
                           { rmDue           }  DueText,
                           { rmApplicable    }  ApplicableText,
                           { rmNotApplicable }  NotApplicableText,
                           { rmEvaluated     }  EvaluatedText,
                           { rmOther         }  OtherText,
                           { rmLegend        }  'Reminder Icon Legend');


  EvalCatName = 'Evaluate Category Reminders';

function GetEducationTopics(EIEN: string): string;
var
  i, idx: integer;
  Tmp, Data: string;

begin
  if(not assigned(EducationTopics)) then
    EducationTopics := TORStringList.Create;
  idx := EducationTopics.IndexOfPiece(EIEN);
  if(idx < 0) then
  begin
    Tmp := copy(EIEN,1,1);
    idx := StrToIntDef(copy(EIEN,2,MaxInt),0);
    if(Tmp = RemCode) then
      GetEducationTopicsForReminder(idx)
    else
    if(Tmp = EduCode) then
      GetEducationSubtopics(idx)
    else
      RPCBrokerV.Results.Clear;
    Tmp := EIEN;
    if(RPCBrokerV.Results.Count > 0) then
    begin
      for i := 0 to RPCBrokerV.Results.Count-1 do
      begin
        Data := RPCBrokerV.Results[i];
        Tmp := Tmp + U + Piece(Data, U, 1) + ';';
        if(Piece(Data, U, 3) = '') then
          Tmp := Tmp + Piece(Data, U, 2)
        else
          Tmp := Tmp + Piece(Data, U, 3);
      end;
    end;
    idx := EducationTopics.Add(Tmp);
  end;
  Result := EducationTopics[idx];
  idx := pos(U, Result);
  if(idx > 0) then
    Result := copy(Result,Idx+1,MaxInt)
  else
    Result := '';
end;

function GetWebPageName(idx :integer): string;
begin
  Result := Piece(WebPages[idx],U,2);
end;

function GetWebPageAddress(idx: integer): string;
begin
  Result := Piece(WebPages[idx],U,3);
end;

function GetWebPages(EIEN: string): string; overload;
var
  i, idx: integer;
  Tmp, Data, Title: string;
  RIEN: string;

begin
  RIEN := RemCode + EIEN;
  if(not assigned(WebPages)) then
    WebPages := TORStringList.Create;
  idx := WebPages.IndexOfPiece(RIEN);
  if(idx < 0) then
  begin
    GetReminderWebPages(EIEN);
    Tmp := RIEN;
    if(RPCBrokerV.Results.Count > 0) then
    begin
      for i := 0 to RPCBrokerV.Results.Count-1 do
      begin
        Data := RPCBrokerV.Results[i];
        if(Piece(Data,U,1) = '1') and (Piece(Data,U,3) <> '') then
        begin
          Data := U + Piece(Data,U,4) + U + Piece(Data,U,3);
          if(Piece(Data,U,2) = '') then
          begin
            Title := Piece(data,U,3);
            if(length(Title) > 60) then
              Title := copy(Title,1,57) + '...';
            SetPiece(Data,U,2,Title);
          end;
          //if(copy(UpperCase(Piece(Data, U, 3)),1,7) <> 'HTTP://') then
          //  SetPiece(Data, U, 3,'http://'+Piece(Data,U,3));
          idx := WebPages.IndexOf(Data);
          if(idx < 0) then
            idx := WebPages.Add(Data);
          Tmp := Tmp + U + IntToStr(idx);
        end;
      end;
    end;
    idx := WebPages.Add(Tmp);
  end;
  Result := WebPages[idx];
  idx := pos(U, Result);
  if(idx > 0) then
    Result := copy(Result,Idx+1,MaxInt)
  else
    Result := '';
end;

function ReminderName(IEN: integer): string;
var
  idx: integer;
  SIEN: string;

begin
  SIEN := IntToStr(IEN);
  Result := '';
  idx := EvaluatedReminders.IndexOfPiece(SIEN);
  if(idx >= 0) then
    Result := piece(EvaluatedReminders[idx],U,2);
  if(Result = '') then
  begin
    idx := ActiveReminders.IndexOfPiece(SIEN);
    if(idx >= 0) then
      Result := piece(ActiveReminders[idx],U,2);
  end;
  if(Result = '') then
  begin
    idx := OtherReminders.IndexOfPiece(SIEN, U, 5);
    if(idx >= 0) then
      Result := piece(OtherReminders[idx],U,3);
  end;
  if(Result = '') then
  begin
    idx := RemindersInProcess.IndexOfPiece(SIEN);
    if(idx >= 0) then
      Result := TReminder(RemindersInProcess.Objects[idx]).PrintName;
  end;
end;

procedure ReminderClinMaintClicked(AData: pointer; Sender: TObject);
var
  ien: integer;

begin
  ien := (Sender as TMenuItem).Tag;
  if(ien > 0) then
    ReportBox(DetailReminder(ien), RemMenuNames[rmClinMaint] + ': '+ ReminderName(ien), TRUE);
end;

procedure ReminderEduClicked(AData: pointer; Sender: TObject);
var
  ien: integer;

begin
  ien := (Sender as TMenuItem).Tag;
  if(ien > 0) then
    ReportBox(EducationTopicDetail(ien), 'Education Topic: ' + (Sender as TMenuItem).Caption, TRUE);
end;

procedure ReminderInqClicked(AData: pointer; Sender: TObject);
var
  ien: integer;

begin
  ien := (Sender as TMenuItem).Tag;
  if(ien > 0) then
    ReportBox(ReminderInquiry(ien), 'Reminder Inquiry: '+ ReminderName(ien), TRUE);
end;

procedure ReminderWebClicked(AData: pointer; Sender: TObject);
var
  idx: integer;

begin
  idx := (Sender as TMenuItem).Tag-1;
  if(idx >= 0) then
    GotoWebPage(GetWebPageAddress(idx));
end;

procedure EvalReminder(ien: integer);
var
  Msg, RName: string;
  NewStatus: string;

begin
  if(ien > 0) then
  begin
    NewStatus := EvaluateReminder(IntToStr(ien));
    ReminderEvaluated(NewStatus);
    NewStatus := piece(NewStatus,U,6);
    RName := ReminderName(ien);
    if(RName = '') then RName := 'Reminder';
         if(NewStatus = '1') then Msg := 'Due'
    else if(NewStatus = '0') then Msg := 'Applicable'
    else                          Msg := 'Not Applicable';
    Msg := RName + ' is ' + Msg + '.';
    InfoBox(Msg, RName + ' Evaluation', MB_OK);
  end;
end;

procedure EvalProcessed;
var
  i: integer;

begin
  if(ProcessedReminders.Count > 0) then
  begin
    BeginReminderUpdate;
    try
      while(ProcessedReminders.Count > 0) do
      begin
        if(ReminderCallList.IndexOf(ProcessedReminders[0]) < 0) then
          ReminderCallList.Add(ProcessedReminders[0]);
        repeat
          i := EvaluatedReminders.IndexOfPiece(Piece(ProcessedReminders[0],U,1));
          if(i >= 0) then
            EvaluatedReminders.Delete(i);
        until(i < 0);
        ProcessedReminders.Delete(0);
      end;
      CheckReminders;
    finally
      EndReminderUpdate(TRUE);
    end;
  end;
end;

procedure ReminderEvalClicked(AData: pointer; Sender: TObject);
begin
  EvalReminder((Sender as TMenuItem).Tag);
end;

procedure ReminderViewFolderClicked(AData: pointer; Sender: TObject);
var
  rfldrs: TRemFolders;
  rfldr: TRemFolder;

begin
  rfldrs := GetRemFolders;
  rfldr := TRemFolder((Sender as TMenuItem).Tag);
  if rfldr in rfldrs then
    exclude(rfldrs, rfldr)
  else
    include(rfldrs, rfldr);
  SetRemFolders(rfldrs);
end;

procedure EvaluateCategoryClicked(AData: pointer; Sender: TObject);
var
  Node: TORTreeNode;
  Code: string;
  i: integer;

begin
  if(Sender is TMenuItem) then
  begin
    BeginReminderUpdate;
    try
      Node := TORTreeNode(TORTreeNode(TMenuItem(Sender).Tag).GetFirstChild);
      while assigned(Node) do
      begin
        Code := Piece(Node.StringData,U,1);
        if(copy(Code,1,1) = RemCode) then
        begin
          Code := copy(Code,2,MaxInt);
          if(ReminderCallList.IndexOf(Code) < 0) then
            ReminderCallList.Add(copy(Node.StringData,2,MaxInt));
          repeat
            i := EvaluatedReminders.IndexOfPiece(Code);
            if(i >= 0) then
              EvaluatedReminders.Delete(i);
          until(i < 0);
        end;
        Node := TORTreeNode(Node.GetNextSibling);
      end;
      CheckReminders;
    finally
      EndReminderUpdate(TRUE);
    end;
  end;
end;

procedure ReminderIconLegendClicked(AData: pointer; Sender: TObject);
begin
  ShowIconLegend(ilReminders);
end;

procedure ReminderMenuBuilder(MI: TMenuItem; RemStr: string;
                              IncludeActions, IncludeEval, ViewFolders: boolean);
var
  M: TMethod;
  Tmp: string;
  Cnt: integer;
  RemID: integer;
  cmd: TRemMenuCmd;

  function Add(Text: string; Parent: TMenuItem; Tag: integer; Typ: TRemMenuCmd): TORMenuItem;
  var
    InsertMenu: boolean;
    idx: integer;

  begin
    Result := nil;
    InsertMenu := TRUE;
    if(Parent = MI) then
    begin
      if(MI.Count > Cnt) then
      begin
        Result := TORMenuItem(MI.Items[Cnt]);
        Result.Enabled := TRUE;
        Result.Visible := TRUE;
        Result.ImageIndex := -1;
        while Result.Count > 0 do
          Result.Delete(Result.Count-1);
        InsertMenu := FALSE;
      end;
      inc(Cnt);
    end;
    if(not assigned(Result)) then
      Result := TORMenuItem.Create(MI);
    if(Text = '') then
      Result.Caption := RemMenuNames[Typ]
    else
      Result.Caption := Text;
    Result.Tag := Tag;
    Result.Data := RemStr;
    if(Tag <> 0) then
    begin
      case Typ of
        rmClinMaint:  M.Code := @ReminderClinMaintClicked;
        rmEdu:        M.Code := @ReminderEduClicked;
        rmInq:        M.Code := @ReminderInqClicked;
        rmWeb:        M.Code := @ReminderWebClicked;
        rmEval:       M.Code := @ReminderEvalClicked;
        rmDue..rmOther:
          begin
            M.Code := @ReminderViewFolderClicked;
            case Typ of
              rmDue:           idx := 0;
              rmApplicable:    idx := 2;
              rmNotApplicable: idx := 4;
              rmEvaluated:     idx := 6;
              rmOther:         idx := 8;
              else             idx := -1;
            end;
            if(idx >= 0) and (RemMenuFolder[Typ] in GetRemFolders) then
              inc(idx);
            Result.ImageIndex := idx;
          end;
        rmLegend:     M.Code := @ReminderIconLegendClicked;
        else
          M.Code := nil;
      end;
      if(assigned(M.Code)) then
        Result.OnClick := TNotifyEvent(M)
      else
        Result.OnClick := nil;
    end;
    if(InsertMenu) then
      Parent.Add(Result);
  end;

  procedure AddEducationTopics(Item: TMenuItem; EduStr: string);
  var
    i, j: integer;
    Code: String;
    NewEduStr: string;
    itm: TMenuItem;

  begin
    if(EduStr <> '') then
    begin
      repeat
        i := pos(';', EduStr);
        j := pos(U, EduStr);
        if(j = 0) then j := length(EduStr)+1;
        Code := copy(EduStr,1,i-1);
        //AddEducationTopics(Add(copy(EduStr,i+1,j-i-1), Item, StrToIntDef(Code, 0), rmEdu),
        //                   GetEducationTopics(EduCode + Code));

        NewEduStr := GetEducationTopics(EduCode + Code);
        if(NewEduStr = '') then
          Add(copy(EduStr,i+1,j-i-1), Item, StrToIntDef(Code, 0), rmEdu)
        else
        begin
          itm := Add(copy(EduStr,i+1,j-i-1), Item, 0, rmEdu);
          Add(copy(EduStr,i+1,j-i-1), itm, StrToIntDef(Code, 0), rmEdu);
          Add('', Itm, 0, rmDash);
          AddEducationTopics(itm, NewEduStr);
        end;

        delete(EduStr,1,j);
      until(EduStr = '');
    end;
  end;

  procedure AddWebPages(Item: TMenuItem; WebStr: string);
  var
    i, idx: integer;

  begin
    if(WebStr <> '') then
    begin
      repeat
        i := pos(U, WebStr);
        if(i = 0) then i := length(WebStr)+1;
        idx := StrToIntDef(copy(WebStr,1,i-1),-1);
        if(idx >= 0) then
          Add(GetWebPageName(idx), Item, idx+1, rmWeb);
        delete(WebStr,1,i);
      until(WebStr = '');
    end;
  end;


begin
  RemID := StrToIntDef(copy(Piece(RemStr,U,1),2,MaxInt),0);
  Cnt := 0;
  M.Data := nil;

  if(RemID > 0) then
  begin
    Add('', MI, RemID, rmClinMaint);
    Tmp := GetEducationTopics(RemCode + IntToStr(RemID));
    if(Tmp <> '') then
      AddEducationTopics(Add('', MI, 0, rmEdu), Tmp)
    else
      Add('', MI, 0, rmEdu).Enabled := FALSE;
    Add('', MI, RemID, rmInq);
    Tmp := GetWebPages(IntToStr(RemID));
    if(Tmp <> '') then
      AddWebPages(Add('', MI, 0, rmWeb), Tmp)
    else
      Add('', MI, 0, rmWeb).Enabled := FALSE;

    if(IncludeActions or IncludeEval) then
    begin
      Add('', MI, 0, rmDash);
      Add('', MI, RemID, rmEval);
    end;
  end;

  if(ViewFolders) then
  begin
    Add('', MI, 0, rmDash);
    for cmd := low(TRemViewCmds) to high(TRemViewCmds) do
      Add('', MI, ord(RemMenuFolder[cmd]), cmd);
  end;

  Add('', MI, 0, rmDash);
  Add('', MI, 1, rmLegend);

  while MI.Count > Cnt do
    MI.Delete(MI.Count-1);
end;

procedure ReminderTreePopup(AData: pointer; Sender: TObject);
begin
  ReminderMenuBuilder((Sender as TPopupMenu).Items, (Sender as TORPopupMenu).Data, TRUE, FALSE, FALSE);
end;

procedure ReminderTreePopupCover(AData: pointer; Sender: TObject);
begin
  ReminderMenuBuilder((Sender as TPopupMenu).Items, (Sender as TORPopupMenu).Data, FALSE, FALSE, FALSE);
end;

procedure ReminderTreePopupDlg(AData: pointer; Sender: TObject);
begin
  ReminderMenuBuilder((Sender as TPopupMenu).Items, (Sender as TORPopupMenu).Data, FALSE, TRUE, FALSE);
end;

procedure ReminderMenuItemSelect(AData: pointer; Sender: TObject);
begin
  ReminderMenuBuilder((Sender as TMenuItem), (Sender as TORMenuItem).Data, FALSE, FALSE, TRUE);
end;

procedure SetReminderPopupRoutine(Menu: TPopupMenu);
var
  M: TMethod;

begin
  M.Code := @ReminderTreePopup;
  M.Data := nil;
  Menu.OnPopup := TNotifyEvent(M);
end;

procedure SetReminderPopupCoverRoutine(Menu: TPopupMenu);
var
  M: TMethod;

begin
  M.Code := @ReminderTreePopupCover;
  M.Data := nil;
  Menu.OnPopup := TNotifyEvent(M);
end;

procedure SetReminderPopupDlgRoutine(Menu: TPopupMenu);
var
  M: TMethod;

begin
  M.Code := @ReminderTreePopupDlg;
  M.Data := nil;
  Menu.OnPopup := TNotifyEvent(M);
end;

procedure SetReminderMenuSelectRoutine(Menu: TMenuItem);
var
  M: TMethod;

begin
  M.Code := @ReminderMenuItemSelect;
  M.Data := nil;
  Menu.OnClick := TNotifyEvent(M);
end;

function ReminderMenu(Sender: TComponent): TORPopupMenu;
begin
  if(Sender.Tag = RemTreeCode) then
  begin
    if(not assigned(ReminderTreeMenuDlg)) then
    begin
      ReminderTreeMenuDlg := TORPopupMenu.Create(nil);
      SetReminderPopupDlgRoutine(ReminderTreeMenuDlg)
    end;
    Result := ReminderTreeMenuDlg;
  end
  else
  begin
    if(not assigned(ReminderTreeMenu)) then
    begin
      ReminderTreeMenu := TORPopupMenu.Create(nil);
      SetReminderPopupRoutine(ReminderTreeMenu);
    end;
    Result := ReminderTreeMenu;
  end;
end;

procedure RemContextPopup(AData: Pointer; Sender: TObject; MousePos: TPoint;
                          var Handled: Boolean);
var
  Menu: TORPopupMenu;
  MItem: TMenuItem;
  M: TMethod;
  p1: string;
  UpdateMenu: boolean;

begin
  UpdateMenu := TRUE;
  Menu := nil;
  with (Sender as TORTreeView) do
  begin
    if((htOnItem in GetHitTestInfoAt(MousePos.X, MousePos.Y)) and (assigned(Selected))) then
    begin
      p1 := Piece((Selected as TORTreeNode).StringData, U, 1);
      if(Copy(p1,1,1) = RemCode) then
      begin
        Menu := ReminderMenu(TComponent(Sender));
        Menu.Data := TORTreeNode(Selected).StringData;
      end
      else
      if(Copy(p1,1,1) = CatCode) and (p1 <> OtherCatID) and (Selected.HasChildren) then
      begin
        if(not assigned(ReminderCatMenu)) then
        begin
          ReminderCatMenu := TPopupMenu.Create(nil);
          MItem := TMenuItem.Create(ReminderCatMenu);
          MItem.Caption := EvalCatName;
          M.Data := nil;
          M.Code := @EvaluateCategoryClicked;
          MItem.OnClick := TNotifyEvent(M);
          ReminderCatMenu.Items.Add(MItem);
        end
        else
          MItem := ReminderCatMenu.Items[0];
        PopupMenu := ReminderCatMenu;
        MItem.Tag := Integer(TORTreeNode(Selected));
        UpdateMenu := FALSE;
      end;
    end;
    if UpdateMenu then
      PopupMenu := Menu;
    Selected := Selected; // This strange line Keeps item selected after a right click
    if(not assigned(PopupMenu)) then
      Handled := TRUE;
  end;
end;

{ 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
}
procedure BuildReminderTree(Tree: TORTreeView);
var
  ExpandedStr: string;
  TopID1, TopID2: string;
  SelID1, SelID2: string;
  i, j: integer;
  NeedLost: boolean;
  Tmp, Data, LostCat, Code: string;
  Node: TORTreeNode;
  M: TMethod;
  Rem: TReminder;
  OpenDue, Found: boolean;

  function Add2Tree(Folder: TRemFolder; CatID: string; Node: TORTreeNode = nil): TORTreeNode;
  begin
    if (Folder = rfUnknown) or (Folder in GetRemFolders) then
    begin
      if(CatID = LostCatID) then
      begin
        if(NeedLost) then
        begin
          (Tree.Items.AddFirst(nil,'') as TORTreeNode).StringData := LostCatString;
          NeedLost := FALSE;
        end;
      end;

      if(not assigned(Node)) then
        Node := Tree.FindPieceNode(CatID, 1);
      if(assigned(Node)) then
      begin
        Result := (Tree.Items.AddChild(Node,'') as TORTreeNode);
        Result.StringData := Data;
      end
      else
        Result := nil;
    end
    else
      Result := nil;
  end;

begin
  if(not assigned(Tree)) then exit;
  Tree.Items.BeginUpdate;
  try
    Tree.NodeDelim := U;
    Tree.NodePiece := 2;
    M.Code := @GetImageIndex;
    M.Data := nil;
    Tree.OnGetImageIndex := TTVExpandedEvent(M);
    Tree.OnGetSelectedIndex := TTVExpandedEvent(M);
    M.Code := @RemContextPopup;
    Tree.OnContextPopup := TContextPopupEvent(M);

    if(assigned(Tree.TopItem)) then
    begin
      TopID1 := Tree.GetNodeID(TORTreeNode(Tree.TopItem), 1, IncludeParentID);
      TopID2 := Tree.GetNodeID(TORTreeNode(Tree.TopItem), 1);
    end
    else
      TopID1 := U;

    if(assigned(Tree.Selected)) then
    begin
      SelID1 := Tree.GetNodeID(TORTreeNode(Tree.Selected), 1, IncludeParentID);
      SelID2 := Tree.GetNodeID(TORTreeNode(Tree.Selected), 1);
    end
    else
      SelID1 := U;

    ExpandedStr := Tree.GetExpandedIDStr(1, IncludeParentID);
    OpenDue := (ExpandedStr = '');

    Tree.Items.Clear;
    NeedLost := TRUE;

    if(rfDue in GetRemFolders) then
      (Tree.Items.Add(nil,'') as TORTreeNode).StringData := DueCatString;
    if(rfApplicable in GetRemFolders) then
      (Tree.Items.Add(nil,'') as TORTreeNode).StringData := ApplCatString;
    if(rfNotApplicable in GetRemFolders) then
      (Tree.Items.Add(nil,'') as TORTreeNode).StringData := NotApplCatString;
    if(rfEvaluated in GetRemFolders) then
      (Tree.Items.Add(nil,'') as TORTreeNode).StringData := EvaluatedCatString;
    if(rfOther in GetRemFolders) then
      (Tree.Items.Add(nil,'') as TORTreeNode).StringData := OtherCatString;

    for i := 0 to EvaluatedReminders.Count-1 do
    begin
      Data := RemCode + EvaluatedReminders[i];
      Tmp := Piece(Data,U,6);
           if(Tmp = '1') then Add2Tree(rfDue, DueCatID)
      else if(Tmp = '0') then Add2Tree(rfApplicable, ApplCatID)
      else                    Add2Tree(rfNotApplicable, NotApplCatID);
      Add2Tree(rfEvaluated, EvaluatedCatID);
    end;

    if(rfOther in GetRemFolders) and (OtherReminders.Count > 0) then
    begin
      for i := 0 to OtherReminders.Count-1 do
      begin
        Tmp := OtherReminders[i];
        if(Piece(Tmp, U, 2) = CatCode) then
          Data := CatCode + Piece(Tmp, U, 1)
        else
        begin
          Code := Piece(Tmp, U, 5);
          Data := RemCode + Code;
          Node := Tree.FindPieceNode(Data, 1);
          if(assigned(Node)) then
            Data := Node.StringData
          else
          begin
            j := EvaluatedReminders.IndexOfPiece(Code);
            if(j >= 0) then
              SetPiece(Data, U, 6, Piece(EvaluatedReminders[j], U, 6));
          end;
        end;
        SetPiece(Data, U, 2, Piece(Tmp, U ,3));
        SetPiece(Data, U, 7, Piece(Tmp, U, 6));
        Tmp := CatCode + Piece(Tmp, U, 4);
        Add2Tree(rfOther, OtherCatID, Tree.FindPieceNode(Tmp, 1));
      end;
    end;

  { The Lost category is for reminders being processed that are no longer in the
    reminder tree view.  This can happen with reminders that were Due or Applicable,
    but due to user action are no longer applicable, or due to location changes.
    The Lost category will not be used if a lost reminder is in the other list. }

    if(RemindersInProcess.Count > 0) then
    begin
      for i := 0 to RemindersInProcess.Count-1 do
      begin
        Rem := TReminder(RemindersInProcess.Objects[i]);
        Tmp := RemCode + Rem.IEN;
        Found := FALSE;
        Node := nil;
        repeat
          Node := Tree.FindPieceNode(Tmp, 1, #0, Node); // look in the tree first
          if((not Found) and (not assigned(Node))) then
          begin
            Data := Tmp + U + Rem.PrintName + U + Rem.DueDateStr + U + Rem.LastDateStr + U +
                    IntToStr(Rem.Priority) + U + Rem.Status;
                 if(Rem.Status = '1') then LostCat := DueCatID
            else if(Rem.Status = '0') then LostCat := ApplCatID
            else                           LostCat := LostCatID;
            Node := Add2Tree(rfUnknown, LostCat);
          end;
          if(assigned(Node)) then
          begin
            Node.Bold := Rem.Processing;
            Found := TRUE;
          end;
        until(Found and (not assigned(Node)));
      end;
    end;

    for i := 0 to Tree.Items.Count-1 do
    begin
      Node := TORTreeNode(Tree.Items[i]);
      for j := 3 to 4 do
      begin
        Tmp := Piece(Node.StringData, U, j);
        if(Tmp = '') then
          Data := ''
        else
          Data := FormatFMDateTimeStr(ReminderDateFormat, Tmp);
        Node.SetPiece(j + (RemTreeDateIdx - 3), Data);
      end;
      Node.SetPiece(RemTreeDateIdx + 2, IntToStr(Node.AbsoluteIndex));
      Tmp := Piece(Node.StringData, U, 5);
      if(Tmp <> '1') and (Tmp <> '3') then
        Node.SetPiece(5, '2');
    end;

  finally
    Tree.Items.EndUpdate;
  end;

  if(SelID1 = U) then
    Node := nil
  else
  begin
    Node := Tree.FindPieceNode(SelID1, 1, IncludeParentID);
    if(not assigned(Node)) then
      Node := Tree.FindPieceNode(SelID2, 1);
    if(assigned(Node)) then
      Node.EnsureVisible;
  end;
  Tree.Selected := Node;

  Tree.SetExpandedIDStr(1, IncludeParentID, ExpandedStr);
  if(OpenDue) then
  begin
    Node := Tree.FindPieceNode(DueCatID, 1);
    if(assigned(Node)) then
      Node.Expand(FALSE);
  end;

  if(TopID1 = U) then
    Tree.TopItem := Tree.Items.GetFirstNode
  else
  begin
    Tree.TopItem := Tree.FindPieceNode(TopID1, 1, IncludeParentID);
    if(not assigned(Tree.TopItem)) then
      Tree.TopItem := Tree.FindPieceNode(TopID2, 1);
  end;
end;

function ReminderNode(Node: TTreeNode): TORTreeNode;
var
  p1: string;

begin
  Result := nil;
  if(assigned(Node)) then
  begin
    p1 := Piece((Node as TORTreeNode).StringData, U, 1);
    if(Copy(p1,1,1) = RemCode) then
      Result := (Node as TORTreeNode)
  end;
end;

procedure LocationChanged(Sender: TObject);
begin
  LoadReminderData;
end;

procedure ClearReminderData;
var
  Changed: boolean;

begin
  if(assigned(frmReminderTree)) then
    frmReminderTree.Free;
  Changed := ((ActiveReminders.Count > 0) or (OtherReminders.Count > 0) or
              (ProcessingChangeString <> U));
  ActiveReminders.Notifier.BeginUpdate;
  OtherReminders.Notifier.BeginUpdate;
  RemindersInProcess.Notifier.BeginUpdate;
  try
    ProcessedReminders.Clear;
    if(assigned(KillReminderDialogProc)) then
      KillReminderDialogProc(nil);
    ActiveReminders.Clear;
    OtherReminders.Clear;
    EvaluatedReminders.Clear;
    ReminderCallList.Clear;
    RemindersInProcess.KillObjects;
    RemindersInProcess.Clear;
    LastProcessingList := '';
    InitialRemindersLoaded := FALSE;
    CoverSheetRemindersInBackground := FALSE;
  finally
    RemindersInProcess.Notifier.EndUpdate;
    OtherReminders.Notifier.EndUpdate;
    ActiveReminders.Notifier.EndUpdate(Changed);
    RemindersStarted := FALSE;
    LastReminderLocation := -2;
    RemForm.Form := nil;
  end;
end;

procedure RemindersInProcessChanged(Data: Pointer; Sender: TObject; var CanNotify: boolean);
var
  CurProcessing: string;
begin
  CurProcessing := ProcessingChangeString;
  CanNotify := (LastProcessingList <> CurProcessing);
  if(CanNotify) then
    LastProcessingList := CurProcessing;
end;

procedure InitReminderObjects;
var
  M: TMethod;

  procedure InitReminderList(var List: TORStringList);
  begin
    if(not assigned(List)) then
      List := TORStringList.Create;
  end;

begin
  InitReminderList(ActiveReminders);
  InitReminderList(OtherReminders);
  InitReminderList(EvaluatedReminders);
  InitReminderList(ReminderCallList);
  InitReminderList(RemindersInProcess);
  InitReminderList(ProcessedReminders);

  M.Code := @RemindersInProcessChanged;
  M.Data := nil;
  RemindersInProcess.Notifier.OnNotify :=  TCanNotifyEvent(M);

  AddToNotifyWhenCreated(LocationChanged, TEncounter);

  RemForm.Form := nil;
end;

procedure FreeReminderObjects;
begin
  KillObj(@ActiveReminders);
  KillObj(@OtherReminders);
  KillObj(@EvaluatedReminders);
  KillObj(@ReminderTreeMenuDlg);
  KillObj(@ReminderTreeMenu);
  KillObj(@ReminderCatMenu);
  KillObj(@EducationTopics);
  KillObj(@WebPages);
  KillObj(@ReminderCallList);
  KillObj(@TmpActive);
  KillObj(@TmpOther);
  KillObj(@RemindersInProcess, TRUE);
  KillObj(@ReminderDialogInfo, TRUE);
  KillObj(@PCERootList, TRUE);
  KillObj(@ProcessedReminders);
end;

function GetReminder(ARemData: string): TReminder;
var
  idx: integer;
  SIEN: string;

begin
  Result := nil;
  SIEN := Piece(ARemData, U, 1);
  if(Copy(SIEN,1,1) = RemCode) then
  begin
    SIEN := copy(Sien, 2, MaxInt);
    idx := RemindersInProcess.IndexOf(SIEN);
    if(idx < 0) then
    begin
      RemindersInProcess.Notifier.BeginUpdate;
      try
        idx := RemindersInProcess.AddObject(SIEN, TReminder.Create(ARemData));
      finally
        RemindersInProcess.Notifier.EndUpdate;
      end;
    end;
    Result := TReminder(RemindersInProcess.Objects[idx]);
  end;
end;

var
  ScootOver: integer = 0;
  
procedure WordWrap(const AText: string; Output: TStrings; LineLength: integer;
                                                   AutoIndent: integer = 4);
var
  i, l, max, FCount: integer;
  First: boolean;
  OrgText, Text, Prefix: string;

begin
  inc(LineLength, ScootOver);
  dec(AutoIndent, ScootOver);
  FCount := Output.Count;
  First := TRUE;
  OrgText := InitText(AText);
  Prefix := StringOfChar(' ',74-LineLength);
  repeat
    i := pos(CRCode, OrgText);
    if(i = 0) then
    begin
      Text := OrgText;
      OrgText := '';
    end
    else
    begin
      Text := copy(OrgText, 1, i - 1);
      delete(OrgText, 1, i + CRCodeLen - 1);
    end;
    if(Text = '') and (OrgText <> '') then
    begin
      Output.Add('');
      inc(FCount);
    end;
    while(Text <> '') do
    begin
      max := length(Text);
      if(max > LineLength) then
      begin
        l := LineLength + 1;
        while(l > 0) and (Text[l] <> ' ') do dec(l);
        if(l < 1) then
        begin
          Output.Add(Prefix+copy(Text,1,LineLength));
          delete(Text,1,LineLength);
        end
        else
        begin
          Output.Add(Prefix+copy(Text,1,l-1));
          while(l <= max) and (Text[l] = ' ') do inc(l);
          delete(Text,1,l-1);
        end;
        if(First) then
        begin
          dec(LineLength, AutoIndent);
          Prefix := Prefix + StringOfChar(' ', AutoIndent);
          First := FALSE;
        end;
      end
      else
      begin
        Output.Add(Prefix+Text);
        Text := '';
      end;
    end;
    if(First) and (FCount <> Output.Count) then
    begin
      dec(LineLength, AutoIndent);
      Prefix := Prefix + StringOfChar(' ', AutoIndent);
      First := FALSE;
    end;
  until(OrgText = '');
end;

function InteractiveRemindersActive: boolean;
begin
  if(not InteractiveRemindersActiveChecked) then
  begin
    InteractiveRemindersActiveStatus := GetRemindersActive;
    InteractiveRemindersActiveChecked := TRUE;
  end;
  Result := InteractiveRemindersActiveStatus;
end;

function GetReminderData(Rem: TReminderDialog; Lst: TStrings; Finishing: boolean = FALSE;
                                                        Historical: boolean = FALSE): integer;
begin
  Result := Rem.AddData(Lst, Finishing, Historical);
end;

function GetReminderData(Lst: TStrings; Finishing: boolean = FALSE;
                                         Historical: boolean = FALSE): integer;
var
  i: integer;
begin
  Result := 0;
  for i := 0 to RemindersInProcess.Count-1 do
    inc(Result, TReminder(RemindersInProcess.Objects[i]).AddData(Lst, Finishing, Historical));
end;

procedure SetReminderFormBounds(Frm: TForm; DefX, DefY, DefW, DefH, ALeft, ATop, AWidth, AHeight: integer);
var
  Rect: TRect;
  ScreenW, ScreenH: integer;

begin
  SystemParametersInfo(SPI_GETWORKAREA, 0, @Rect, 0);
  ScreenW := Rect.Right - Rect.Left + 1;
  ScreenH := Rect.Bottom - Rect.Top + 1;
  if(AWidth = 0) then
    AWidth := DefW
  else
    DefW := AWidth;
  if(AHeight = 0) then
    AHeight := DefH
  else
    DefH := AHeight;
  if(DefX = 0) and (DefY = 0) then
  begin
    DefX := (ScreenW - DefW) div 2;
    DefY := (ScreenH - DefH) div 2;
  end
  else
    dec(DefY, DefH);
  if((ALeft <= 0) or (ATop <= 0) or
    ((ALeft + AWidth) > ScreenW) or
    ((ATop + AHeight) > ScreenH)) then
  begin
    if(DefX < 0) then
      DefX := 0
    else
    if((DefX + DefW) > ScreenW) then
      DefX := ScreenW-DefW;
    if(DefY < 0) then
      DefY := 0
    else
    if((DefY + DefH) > ScreenH) then
      DefY := ScreenH-DefH;
    Frm.SetBounds(Rect.Left + DefX, Rect.Top + DefY, DefW, DefH);
  end
  else
    Frm.SetBounds(Rect.Left + ALeft, Rect.Top + ATop, AWidth, AHeight);
end;

procedure UpdateReminderDialogStatus;
var
  TmpSL: TStringList;
  Changed: boolean;

  procedure Build(AList :TORStringList; PNum: integer);
  var
    i: integer;
    Code: string;

  begin
    for i := 0 to AList.Count-1 do
    begin
      Code := Piece(AList[i],U,PNum);
      if((Code <> '') and (TmpSL.IndexOf(Code) < 0)) then
        TmpSL.Add(Code);
    end;
  end;

  procedure Reset(AList: TORStringList; PNum, DlgPNum: integer);
  var
    i, j: integer;
    Tmp, Code, Dlg: string;

  begin
    for i := 0 to TmpSL.Count-1 do
    begin
      Code := Piece(TmpSL[i],U,1);
      j := -1;
      repeat
        j := AList.IndexOfPiece(Code, U, PNum, j);
        if(j >= 0) then
        begin
          Dlg := Piece(TmpSL[i],U,2);
          if(Dlg <> Piece(AList[j], U, DlgPNum)) then
          begin
            Tmp := AList[j];
            SetPiece(Tmp, U, DlgPNum, Dlg);
            AList[j] := Tmp;
            Changed := TRUE;
          end;
        end;
      until (j < 0);
    end;
  end;

begin
  Changed := FALSE;
  BeginReminderUpdate;
  try
    TmpSL := TStringList.Create;
    try
      Build(ActiveReminders, 1);
      Build(OtherReminders, 5);
      Build(EvaluatedReminders, 1);
      GetDialogStatus(TmpSL);
      Reset(ActiveReminders, 1, 7);
      Reset(OtherReminders, 5, 6);
      Reset(EvaluatedReminders, 1, 7);
    finally
      TmpSL.Free;
    end;
  finally
    EndReminderUpdate(Changed);
  end;
end;

procedure PrepText4NextLine(var txt: string);
var
  tlen: integer;

begin
  if(txt <> '') then
  begin
    tlen := length(txt);
    if(copy(txt, tlen - CRCodeLen + 1, CRCodeLen) = CRCode) then
      exit;
    if(copy(txt, tlen, 1) = '.') then
      txt := txt + ' ';
    txt := txt + ' ';
  end;
end;

procedure ExpandTIUObjects(var Txt: string; msg: string = '');
var
  ObjList: TStringList;
  Err: TStringList;
  i, j, k, oLen: integer;
  obj, ObjTxt: string;

begin
  ObjList := TStringList.Create;
  try
    Err := nil;
    if(not dmodShared.BoilerplateOK(Txt, CRCode, ObjList, Err)) and (assigned(Err)) then
    begin
      try
        Err.Add(CRLF + 'Contact IRM and inform them about this error.' + CRLF +
                       'Make sure you give them the name of the reminder that you are processing,' + CRLF +
                       'and which dialog elements were selected to produce this error.');
        InfoBox(Err.Text,'Reminder Boilerplate Object Error', MB_OK + MB_ICONERROR);
      finally
        Err.Free;
      end;
    end;
    if(ObjList.Count > 0) then
    begin
      GetTemplateText(ObjList);
      i := 0;
      while (i < ObjList.Count) do
      begin
        if(pos(ObjMarker, ObjList[i]) = 1) then
        begin
          obj := copy(ObjList[i], ObjMarkerLen+1, MaxInt);
          if(obj = '') then break;
          j := i + 1;
          while (j < ObjList.Count) and (pos(ObjMarker, ObjList[j]) = 0) do
            inc(j);
          if((j - i) > 2) then
          begin
            ObjTxt := '';
            for k := i+1 to j-1 do
              ObjTxt := ObjTxt + CRCode + ObjList[k];
          end
          else
            ObjTxt := ObjList[i+1];
          i := j;
          obj := '|' + obj + '|';
          oLen := length(obj);
          repeat
            j := pos(obj, Txt);
            if(j > 0) then
            begin
              delete(Txt, j, OLen);
              insert(ObjTxt, Txt, j);
            end;
          until(j = 0);
        end
        else
          inc(i);
      end
    end;
  finally
    ObjList.Free;
  end;
end;

{ TReminderDialog }

const
  RPCCalled = '99';
  DlgCalled = RPCCalled + U + 'DLG';

constructor TReminderDialog.BaseCreate;
var
  idx, eidx, i: integer;
  TempSL: TORStringList;
  ParentID: string;
//  Line: string;
  Element: TRemDlgElement;

begin
  TempSL := GetDlgSL;
  idx := -1;
  repeat
    idx := TempSL.IndexOfPiece('1', U, 1, idx);
    if(idx >= 0) then
    begin
      if(not assigned(FElements)) then
        FElements := TStringList.Create;
      eidx := FElements.AddObject('',TRemDlgElement.Create);
      Element := TRemDlgElement(FElements.Objects[eidx]);
      with Element do
      begin
        FReminder := Self;
        FRec1 := TempSL[idx];
        FID := Piece(FRec1, U, 2);
        FDlgID := Piece(FRec1, U, 3);
        FElements[eidx] := FDlgID;
        if(ElemType = etTaxonomy) then
          FTaxID := BOOLCHAR[Historical] + FindingType
        else
          FTaxID := '';

        FText := '';
        i := -1;
       // if Piece(FRec1,U,5) <> '1' then
        repeat
          i := TempSL.IndexOfPieces(['2',FID,FDlgID],i);
          if(i >= 0) then
          begin
            PrepText4NextLine(FText);
            FText := FText + Trim(Piece(TempSL[i], U, 4));
          end;
        until(i < 0);
        ExpandTIUObjects(FText);
        AssignFieldIDs(FText);

        if(pos('.',FDlgID)>0) then
        begin
          ParentID := FDlgID;
          i := length(ParentID);
          while((i > 0) and (ParentID[i] <> '.')) do
            dec(i);
          if(i > 0) then
          begin
            ParentID := copy(ParentID,1,i-1);
            i := FElements.IndexOf(ParentID);
            if(i >= 0) then
            begin
              FParent := TRemDlgElement(FElements.Objects[i]);
              if(not assigned(FParent.FChildren)) then
                FParent.FChildren := TList.Create;
              FParent.FChildren.Add(Element);
            end;
          end;
        end;
        if(ElemType = etDisplayOnly) then
          SetChecked(TRUE);
        UpdateData;
      end;
    end;
  until(idx < 0);
end;

constructor TReminderDialog.Create(ADlgData: string);
begin
  FDlgData := ADlgData;
  BaseCreate;
end;

destructor TReminderDialog.Destroy;
begin
  KillObj(@FElements, TRUE);
  inherited;
end;

function TReminderDialog.Processing: boolean;
var
  i,j: integer;
  Elem: TRemDlgElement;
  RData: TRemData;

  function ChildrenChecked(Prnt: TRemDlgElement): boolean; forward;

  function CheckItem(Item: TRemDlgElement): boolean;
  begin
    if(Item.ElemType = etDisplayOnly) then
    begin
      Result := ChildrenChecked(Item);
      if(not Result) then
        Result := Item.Add2PN;
    end
    else
      Result := Item.FChecked;
  end;

  function ChildrenChecked(Prnt: TRemDlgElement): boolean;
  var
    i: integer;

  begin
    Result := FALSE;
    if(assigned(Prnt.FChildren)) then
    begin
      for i := 0 to Prnt.FChildren.Count-1 do
      begin
        Result := CheckItem(TRemDlgElement(Prnt.FChildren[i]));
        if(Result) then break;
      end;
    end;
  end;

begin
  Result := FALSE;
  if(assigned(FElements)) then
  begin
    for i := 0 to FElements.Count-1 do
    begin
      Elem := TRemDlgElement(FElements.Objects[i]);
      if(not assigned(Elem.FParent)) then
      begin
        Result := CheckItem(Elem);
        if (Result = false) then  //(AGP CHANGE 24.9 add check to have the finish problem check for MH test)
          begin
          if (assigned(Elem.FData)) then
            begin
               for j := 0 to Elem.FData.Count-1 do
                  begin
                     RData := TRemData(Elem.FData[j]);
                     if piece(RData.FRec3,U,4)='MH' then
                        Result := True;
                     if (Result) then break;
                  end;
            end;
          end;
        if(Result) then break;
      end;
    end;
  end;
end;

function TReminderDialog.GetDlgSL: TORStringList;
var
  idx: integer;

begin
  if(not assigned(ReminderDialogInfo)) then
    ReminderDialogInfo := TStringList.Create;
  idx := ReminderDialogInfo.IndexOf(GetIEN);
  if(idx < 0) then
    idx := ReminderDialogInfo.AddObject(GetIEN, TORStringList.Create);
  Result := TORStringList(ReminderDialogInfo.Objects[idx]);
  if(Result.Count = 0) then
  begin
    Result.Assign(GetDialogInfo(GetIEN, (Self is TReminder)));
    Result.Add(DlgCalled); // Used to prevent repeated calling of RPC if dialog is empty
  end;
end;

function TReminderDialog.BuildControls(ParentWidth: integer; AParent, AOwner: TWinControl): TWinControl;
var
  Y, i: integer;
  Elem: TRemDlgElement;
  ERes: TWinControl;

begin
  Result := nil;
  if(assigned(FElements)) then
  begin
    Y := 0;
    for i := 0 to FElements.Count-1 do
    begin
      Elem := TRemDlgElement(FElements.Objects[i]);
      if (not assigned(Elem.FParent)) then
      begin
        ERes := Elem.BuildControls(Y, ParentWidth, AParent, AOwner);
        if(not assigned(Result)) then
          Result := ERes;
      end;
    end;
  end;
  if(AParent.ControlCount = 0) then
  begin
    with TLabel.Create(AOwner) do
    begin
      Parent := AParent;
      Caption := 'No Dialog found for ' + Trim(GetPrintName) + ' Reminder.';
      Left := Gap;
      Top := Gap;
    end;
  end;
  ElementChecked := nil;
end;

procedure TReminderDialog.AddText(Lst: TStrings);
var
  i, idx: integer;
  Elem: TRemDlgElement;

begin
  if(assigned(FElements)) then
  begin
    idx := Lst.Count;
    for i := 0 to FElements.Count-1 do
    begin
      Elem := TRemDlgElement(FElements.Objects[i]);
      if (not assigned(Elem.FParent)) then
        Elem.AddText(Lst);
    end;
    if (Self is TReminder) and (PrintName <> '') and (idx <> Lst.Count) then
      Lst.Insert(idx, '  ' + PrintName + ':')
  end;
end;

function TReminderDialog.AddData(Lst: TStrings; Finishing: boolean = FALSE;
                           Historical: boolean = FALSE): integer;
var
  i: integer;
  Elem: TRemDlgElement;

begin
  Result := 0;
  if(assigned(FElements)) then
  begin
    for i := 0 to FElements.Count-1 do
    begin
      Elem := TRemDlgElement(FElements.Objects[i]);
      if (not assigned(Elem.FParent)) then
        inc(Result, Elem.AddData(Lst, Finishing, Historical));
    end;
  end;
end;

procedure TReminderDialog.ComboBoxCheckedText(Sender: TObject; NumChecked: integer; var Text: string);
var
  i, Done: integer;
  DotLen, ComLen, TxtW, TotalW, NewLen: integer;
  tmp: string;
  Fnt: THandle;
  lb: TORListBox;

begin
  if(NumChecked = 0) then
    Text := '(None Selected)'
  else
  if(NumChecked > 1) then
  begin
    Text := '';
    lb := (Sender as TORListBox);
    Fnt := lb.Font.Handle;
    DotLen := TextWidthByFont(Fnt, '...');
    TotalW := (lb.Owner as TControl).ClientWidth - 15;
    ComLen := TextWidthByFont(fnt, ', ');
    dec(TotalW,(NumChecked-1) * ComLen);
    Done := 0;
    for i := 0 to lb.Items.Count-1 do
    begin
      if(lb.Checked[i]) then
      begin
        inc(Done);
        if(Text <> '') then
        begin
          Text := Text + ', ';
          dec(TotalW, ComLen);
        end;
        Tmp := lb.DisplayText[i];
        if(Done = NumChecked) then
          TxtW := TotalW
        else
          TxtW := TotalW div (NumChecked - Done + 1);
        NewLen := NumCharsFitInWidth(fnt, Tmp, TxtW);
        if(NewLen < length(Tmp)) then
          Tmp := copy(Tmp,1,NumCharsFitInWidth(fnt, Tmp, (TxtW - DotLen))) + '...';
        dec(TotalW, TextWidthByFont(fnt, Tmp));
        Text := Text + Tmp;
      end;
    end;
  end;
end;

procedure TReminderDialog.BeginTextChanged;
begin
  inc(FTextChangedCount);
end;

procedure TReminderDialog.EndTextChanged(Sender: TObject);
begin
  if(FTextChangedCount > 0) then
  begin
    dec(FTextChangedCount);
    if(FTextChangedCount = 0) and assigned(FOnTextChanged) then
      FOnTextChanged(Sender);
  end;
end;

function TReminderDialog.GetIEN: string;
begin
  Result := Piece(FDlgData, U, 1);
end;

function TReminderDialog.GetPrintName: string;
begin
  Result := Piece(FDlgData, U, 2);
end;

procedure TReminderDialog.BeginNeedRedraw;
begin
  inc(FNeedRedrawCount);
end;

procedure TReminderDialog.EndNeedRedraw(Sender: TObject);
begin
  if(FNeedRedrawCount > 0) then
  begin
    dec(FNeedRedrawCount);
    if(FNeedRedrawCount = 0) and (assigned(FOnNeedRedraw)) then
      FOnNeedRedraw(Sender);
  end;
end;

procedure TReminderDialog.FinishProblems(List: TStrings; var MissingTemplateFields: boolean);
var
  i: integer;
  Elem: TRemDlgElement;
  TmpSL: TStringList;
  FldData: TORStringList;

begin
  if(Processing and assigned(FElements)) then
  begin
    TmpSL := TStringList.Create;
    try
      FldData := TORStringList.Create;
      try
        for i := 0 to FElements.Count-1 do
        begin
          Elem := TRemDlgElement(FElements.Objects[i]);
          if (not assigned(Elem.FParent)) then
          begin
            Elem.FinishProblems(List);
            Elem.GetFieldValues(FldData);
          end;
        end;
        FNoResolve := TRUE;
        try
          AddText(TmpSL);
        finally
          FNoResolve := FALSE;
        end;
        MissingTemplateFields := AreTemplateFieldsRequired(TmpSL.Text, FldData);
      finally
        FldData.Free;
      end;
    finally
      TmpSL.Free;
    end;
  end;
end;

procedure TReminderDialog.ComboBoxResized(Sender: TObject);
begin
// This causes the ONCheckedText event to re-fire and re-update the text,
// based on the new size of the combo box.
  if(Sender is TORComboBox) then
    with (Sender as TORComboBox) do
      OnCheckedText := OnCheckedText;
end;

function TReminderDialog.Visible: boolean;
begin
  Result := (CurrentReminderInDialog = Self);
end;

{ TReminder }

constructor TReminder.Create(ARemData: string);
begin
  FRemData := ARemData;
  BaseCreate;
end;

function TReminder.GetDueDateStr: string;
begin
  Result := Piece(FRemData, U ,3);
end;

function TReminder.GetIEN: string;
begin
  Result := copy(Piece(FRemData, U, 1), 2, MaxInt);
end;

function TReminder.GetLastDateStr: string;
begin
  Result := Piece(FRemData, U ,4);
end;

function TReminder.GetPrintName: string;
begin
  Result := Piece(FRemData, U ,2);
end;

function TReminder.GetPriority: integer;
begin
  Result := StrToIntDef(Piece(FRemData, U ,5), 2);
end;

function TReminder.GetStatus: string;
begin
  Result := Piece(FRemData, U ,6);
end;

{ TRemDlgElement }

function Code2DataType(Code: string): TRemDataType;
var
  idx: TRemDataType;

begin
  Result := dtUnknown;
  for idx := low(TRemDataType) to high(TRemDataType) do
  begin
    if(Code = RemDataCodes[idx]) then
    begin
      Result := idx;
      break;
    end;
  end;
end;

function Code2PromptType(Code: string): TRemPromptType;
var
  idx: TRemPromptType;

begin
  if(Code = '') then
    Result := ptSubComment
  else
  if(Code = MSTCode) then
    Result := ptMST
  else
  begin
    Result := ptUnknown;
    for idx := low(TRemPromptType) to high(TRemPromptType) do
    begin
      if(Code = RemPromptCodes[idx]) then
      begin
        Result := idx;
        break;
      end;
    end;
  end;
end;

function TRemDlgElement.Add2PN: boolean;
var
  Lst: TStringList;

begin
  if (FChecked) then
  begin
    Result := (Piece(FRec1, U, 5) <> '1');
    //Suppress := (Piece(FRec1,U,1)='1');
    if(Result and (ElemType = etDisplayOnly)) then
    begin
      //Result := FALSE;
      if(assigned(FPrompts) and (FPrompts.Count > 0)) or
        (assigned(FData) and (FData.Count > 0)) or Result then
      begin
        Lst := TStringList.Create;
        try
          AddData(Lst, FALSE);
          Result := (Lst.Count > 0);
          if not assigned(FData) then Result := True;
        finally
          Lst.Free;
        end;
      end;
    end;
  end
  else
    Result := FALSE;
end;

function TRemDlgElement.Box: boolean;
begin
  Result := (Piece(FRec1, U, 19) = '1');
end;

function TRemDlgElement.BoxCaption: string;
begin
  if(Box) then
    Result := Piece(FRec1, U, 20)
  else
    Result := '';
end;

function TRemDlgElement.ChildrenIndent: integer;
begin
  Result := StrToIntDef(Piece(FRec1, U, 16), 0);
end;

function TRemDlgElement.ChildrenRequired: TRDChildReq;
var
  Tmp: string;
begin
  Tmp := Piece(FRec1, U, 18);
  if Tmp = '1' then Result := crOne
  else if Tmp = '2' then Result := crAtLeastOne
  else if Tmp = '3' then Result := crNoneOrOne
  else Result := crNone;
end;

function TRemDlgElement.ChildrenSharePrompts: boolean;
begin
  Result := (Piece(FRec1, U, 17) = '1');
end;

destructor TRemDlgElement.Destroy;
begin
  KillObj(@FFieldValues);
  KillObj(@FData, TRUE);
  KillObj(@FPrompts, TRUE);
  KillObj(@FChildren);
  inherited;
end;

function TRemDlgElement.ElemType: TRDElemType;
var
  Tmp: string;

begin
  Tmp := Piece(FRec1, U, 4);
  if(Tmp = 'D') then Result := etDisplayOnly
  else if(Tmp = 'T') then Result := etTaxonomy
  else Result := etCheckBox;
end;

function TRemDlgElement.FindingType: string;
begin
  if(ElemType = etTaxonomy) then
    Result := Piece(FRec1, U, 7)
  else
    Result := '';
end;

function TRemDlgElement.HideChildren: boolean;
begin
  Result := (Piece(FRec1, U, 15) <> '0');
end;

function TRemDlgElement.Historical: boolean;
begin
  Result := (Piece(FRec1, U, 8) = '1');
end;

function TRemDlgElement.Indent: integer;
begin
  Result := StrToIntDef(Piece(FRec1, U, 6), 0);
end;

procedure TRemDlgElement.GetData;
var
  TempSL: TStrings;
  i: integer;
  Tmp: string;

begin
  if FHaveData then exit;
  if(FReminder.GetDlgSL.IndexOfPieces([RPCCalled, FID, FTaxID]) < 0) then
  begin
    TempSL := GetDialogPrompts(FID, Historical, FindingType);
    TempSL.Add(RPCCalled);
    for i := 0 to TempSL.Count-1 do
    begin
      Tmp := TempSL[i];
      SetPiece(Tmp,U,2,FID);
      SetPiece(Tmp,U,3,FTaxID);
      TempSL[i] := Tmp;
    end;
    FReminder.GetDlgSL.AddStrings(TempSL);
  end;
  UpdateData;
end;

procedure TRemDlgElement.UpdateData;
var
  Ary: array of integer;
  idx, i,cnt: integer;
  TempSL: TORStringList;
  RData: TRemData;
  RPrompt: TRemPrompt;
  Tmp, Tmp2: string;
  NewLine: boolean;
  dt: TRemDataType;
  pt: TRemPromptType;
  DateRange: string;
  ChoicesActiveDates:   TStringList;
  ChoiceIdx: integer;
  Piece7: string;

begin
  if FHaveData then exit;
  TempSL := FReminder.GetDlgSL;
  if(TempSL.IndexOfPieces([RPCCalled, FID, FTaxID]) >= 0) then
  begin
    FHaveData := TRUE;
    RData := nil;
    idx := -1;
    repeat
      idx := TempSL.IndexOfPieces(['3', FID, FTaxID], idx);
      if (idx >= 0) and (Pieces(TempSL[idx-1],U,1,6) = Pieces(TempSL[idx],u,1,6)) then
        if pos(':', Piece(TempSL[idx],U,7)) > 0 then  //if has date ranges
          begin
            if RData <> nil then
              begin
                if (not assigned(RData.FActiveDates)) then
                  RData.FActiveDates := TStringList.Create;
                DateRange := Pieces(Piece(TempSL[idx],U,7),':',2,3);
                RData.FActiveDates.Add(DateRange);
              end;
          end;
      if(idx >= 0) and (Pieces(TempSL[idx-1],U,1,6) <> Pieces(TempSL[idx],u,1,6)) then
      begin
        dt := Code2DataType(piece(TempSL[idx], U, r3Type));
        if(dt <> dtUnknown) and ((dt <> dtOrder) or
          (CharAt(piece(TempSL[idx], U, 11),1) in ['D', 'Q', 'M', 'O'])) and
          ((dt <> dtMentalHealthTest) or MHTestsOK) then
        begin
          if(not assigned(FData)) then
            FData := TList.Create;
          RData := TRemData(FData[FData.Add(TRemData.Create)]);
          if pos(':',Piece(TempSL[idx],U,7)) > 0 then
            begin
              RData.FActiveDates := TStringList.Create;
              RData.FActiveDates.Add(Pieces(Piece(TempSL[idx],U,7),':',2,3));
            end;
          with RData do
          begin
            FParent := Self;
            Piece7 := Piece(Piece(TempSL[idx],U,7),':',1);
            FRec3 := TempSL[idx];
            SetPiece(FRec3,U,7,Piece7);
//            FRoot := FRec3;
            i := idx + 1;
            ChoiceIdx := 0;
            while((i < TempSL.Count) and (TempSL.PiecesEqual(i, ['5', FID, FTaxID]))) do
            begin
              if (Pieces(TempSL[i-1],U,1,6) = Pieces(TempSL[i],U,1,6)) then
                begin
                 if pos(':', Piece(TempSL[i],U,7)) > 0 then
                   begin
                    if (not assigned(FChoicesActiveDates)) then
                      begin
                        FChoicesActiveDates := TList.Create;
                        ChoicesActiveDates := TStringList.Create;
                        FChoicesActiveDates.Insert(ChoiceIdx, ChoicesActiveDates);
                      end;
                    TStringList(FChoicesActiveDates[ChoiceIdx]).Add(Pieces(Piece(TempSL[i],U,7),':',2,3));
                   end;
                 inc(i);
                end
              else
                begin
                  if(not assigned(FChoices)) then
                  begin
                    FChoices := TORStringList.Create;
                    if(not assigned(FPrompts)) then
                      FPrompts := TList.Create;
                    FChoicePrompt := TRemPrompt(FPrompts[FPrompts.Add(TRemPrompt.Create)]);
                    with FChoicePrompt do
                    begin
                      FParent := Self;
                      Tmp := Piece(FRec3,U,10);
                      NewLine := (Tmp <> '');
                      FRec4 := '4' + U + FID + U + FTaxID + U + U + BOOLCHAR[not RData.Add2PN] + U + U +
                               'P' + U + Tmp + U + BOOLCHAR[NewLine] + U + '1';
                      FData := RData;
                      FOverrideType := ptDataList;
                      InitValue;
                    end;
                  end;
                  Tmp := TempSL[i];
                  Piece7 := Piece(Piece(TempSL[i],U,7),':',1);
                  SetPiece(Tmp,U,7,Piece7);
                  Tmp2 := Piece(Piece(Tmp,U,r3Code),':',1);
                  if(Tmp2 <> '') then Tmp2 := ' (' + Tmp2 + ')';
                  Tmp2 := MixedCase(Piece(Tmp,U,r3Nar)) + Tmp2;
                  SetPiece(Tmp,U,12,Tmp2);
                  ChoiceIdx := FChoices.Add(Tmp);
                  if pos(':',Piece(TempSL[i],U,7)) > 0 then
                   begin
                    if (not assigned(FChoicesActiveDates)) then
                      FChoicesActiveDates := TList.Create;
                    ChoicesActiveDates := TStringList.Create;
                    ChoicesActiveDates.Add(Pieces(Piece(TempSL[i],U,7),':',2,3));
                    FChoicesActiveDates.Insert(ChoiceIdx, ChoicesActiveDates);
                   end
                  else
                    if assigned(FChoicesActiveDates) then
                       FChoicesActiveDates.Insert(ChoiceIdx, TStringList.Create);
                  inc(i);
                end;
            end;
            if(assigned(FChoices)) and (FChoices.Count = 1) then // If only one choice just pick it
            begin
              FPrompts.Remove(FChoicePrompt);
              KillObj(@FChoicePrompt);
              Tmp := FChoices[0];
              KillObj(@FChoices);
              cnt := 5;
              if(Piece(FRec3,U,9) = '') then inc(cnt);
              SetLength(Ary,cnt);
              for i := 0 to cnt-1 do
                Ary[i] := i+4;
              SetPieces(FRec3, U, Ary, Tmp);
            end;
            if(assigned(FChoices)) then
            begin
              for i := 0 to FChoices.Count-1 do
                FChoices.Objects[i] := TRemPCERoot.GetRoot(RData, FChoices[i], Historical);
            end
            else
              FPCERoot := TRemPCERoot.GetRoot(RData, RData.FRec3, Historical);
            if(dt = dtVitals) then
            begin
              if(Code2VitalType(Piece(FRec3,U,6)) <> vtUnknown) then
              begin
                if(not assigned(FPrompts)) then
                  FPrompts := TList.Create;
                FChoicePrompt := TRemPrompt(FPrompts[FPrompts.Add(TRemPrompt.Create)]);
                with FChoicePrompt do
                begin
                  FParent := Self;
                  Tmp := Piece(FRec3,U,10);
                  NewLine := FALSE;
  //                FRec4 := '4' + U + FID + U + FTaxID + U + U + BOOLCHAR[not RData.Add2PN] + U +
  //                         RData.InternalValue + U + 'P' + U + Tmp + U + BOOLCHAR[SameL] + U + '1';
                  FRec4 := '4' + U + FID + U + FTaxID + U + U + BOOLCHAR[not RData.Add2PN] + U +
                           U + 'P' + U + Tmp + U + BOOLCHAR[NewLine] + U + '0';
                  FData := RData;
                  FOverrideType := ptVitalEntry;
                  InitValue;
                end;
              end;
            end;
            if(dt = dtMentalHealthTest) then
            begin
              if(not assigned(FPrompts)) then
                FPrompts := TList.Create;
              FChoicePrompt := TRemPrompt(FPrompts[FPrompts.Add(TRemPrompt.Create)]);
              with FChoicePrompt do
              begin
                FParent := Self;
                Tmp := Piece(FRec3,U,10);
                NewLine := FALSE;
//                FRec4 := '4' + U + FID + U + FTaxID + U + U + BOOLCHAR[not RData.Add2PN] + U +
//                         RData.InternalValue + U + 'P' + U + Tmp + U + BOOLCHAR[SameL] + U + '1';
                FRec4 := '4' + U + FID + U + FTaxID + U + U + BOOLCHAR[not RData.Add2PN] + U +
                         U + 'P' + U + Tmp + U + BOOLCHAR[NewLine] + U + '0';
                FData := RData;
                if(Piece(FRec3, U, r3GAF) = '1') then
                begin
                  FOverrideType := ptGAF;
                  SetPiece(FRec4, U, 8, ForcedCaption + ':');
                end
                else
                  FOverrideType := ptMHTest;
              end;
            end;
          end;
        end;
      end;
    until(idx < 0);

    idx := -1;
    repeat
      idx := TempSL.IndexOfPieces(['4', FID, FTaxID], idx);
      if(idx >= 0) then
      begin
        pt := Code2PromptType(piece(TempSL[idx], U, 4));
        if(pt <> ptUnknown) and ((pt <> ptComment) or (not FHasComment)) then
        begin
          if(not assigned(FPrompts)) then
            FPrompts := TList.Create;
          RPrompt := TRemPrompt(FPrompts[FPrompts.Add(TRemPrompt.Create)]);
          with RPrompt do
          begin
            FParent := Self;
            FRec4 := TempSL[idx];
            InitValue;
          end;
          if(pt = ptComment) then
          begin
            FHasComment := TRUE;
            FCommentPrompt := RPrompt;
          end;
          if(pt = ptSubComment) then
            FHasSubComments := TRUE;
          if(pt = ptMST) then
            FMSTPrompt := RPrompt;
        end;
      end;
    until(idx < 0);

    idx := -1;
    repeat
      idx := TempSL.IndexOfPieces(['6', FID, FTaxID], idx);
      if(idx >= 0) then
      begin
        PrepText4NextLine(FPNText);
        FPNText := FPNText + Trim(Piece(TempSL[idx], U, 4));
      end;
    until(idx < 0);
    ExpandTIUObjects(FPNText);
  end;
end;

procedure TRemDlgElement.SetChecked(const Value: boolean);
var
  i, j, k: integer;
  Kid: TRemDlgElement;
  Prompt: TRemPrompt;
  RData: TRemData;

  procedure UpdateForcedValues(Elem: TRemDlgElement);
  var
    i: integer;

  begin
    if(Elem.IsChecked) then
    begin
      if(assigned(Elem.FPrompts)) then
      begin
        for i := 0 to Elem.FPrompts.Count-1 do
        begin
          Prompt := TRemPrompt(Elem.FPrompts[i]);
          if Prompt.Forced then
          begin
            try
              Prompt.SetValueFromParent(Prompt.FValue);
            except
              on E: EForcedPromptConflict do
              begin
                Elem.FChecked := FALSE;
                InfoBox(E.Message, 'Error', MB_OK or MB_ICONERROR);
                break;
              end
              else
                raise;
            end;
          end;
        end;
      end;
      if(Elem.FChecked) and (assigned(Elem.FChildren)) then
        for i := 0 to Elem.FChildren.Count-1 do
          UpdateForcedValues(TRemDlgElement(Elem.FChildren[i]));
    end;
  end;

begin
  if(FChecked <> Value) then
  begin
    FChecked := Value;
    if(Value) then
    begin
      GetData;
      if(FChecked and assigned(FParent)) then
      begin
        FParent.Check4ChildrenSharedPrompts;
        if(FParent.ChildrenRequired in [crOne, crNoneOrOne]) then
        begin
          for i := 0 to FParent.FChildren.Count-1 do
          begin
            Kid := TRemDlgElement(FParent.FChildren[i]);
            if(Kid <> Self) and (Kid.FChecked) then
              Kid.SetChecked(FALSE);
          end;
        end;
      end;
      UpdateForcedValues(Self);
    end
    else
    if(assigned(FPrompts) and assigned(FData)) then
    begin
      for i := 0 to FPrompts.Count-1 do
      begin
        Prompt := TRemPrompt(FPrompts[i]);
        if Prompt.Forced and (IsSyncPrompt(Prompt.PromptType)) then
        begin
          for j := 0 to FData.Count-1 do
          begin
            RData := TRemData(FData[j]);
            if(assigned(RData.FPCERoot)) then
              RData.FPCERoot.UnSync(Prompt);
            if(assigned(RData.FChoices)) then
            begin
              for k := 0 to RData.FChoices.Count-1 do
              begin
                if(assigned(RData.FChoices.Objects[k])) then
                  TRemPCERoot(RData.FChoices.Objects[k]).UnSync(Prompt);
              end;
            end;
          end;
        end;
      end;
    end;
  end;
end;

function TRemDlgElement.TrueIndent: integer;
var
  Prnt: TRemDlgElement;
  Nudge: integer;

begin
  Result := Indent;
  Nudge := Gap;
  Prnt := FParent;
  while assigned(Prnt) do
  begin
    if(Prnt.Box) then
    begin
      Prnt := nil;
      inc(Nudge, Gap);
    end
    else
    begin
      Result := Result + Prnt.ChildrenIndent;
      Prnt := Prnt.FParent;
    end;
  end;
  Result := (Result * IndentMult) + Nudge;
end;

procedure TRemDlgElement.cbClicked(Sender: TObject);
begin
  FReminder.BeginTextChanged;
  try
    FReminder.BeginNeedRedraw;
    try
      if(assigned(Sender)) then
      begin
        SetChecked((Sender as TORCheckBox).Checked);
        ElementChecked := Self;
      end;
    finally
      FReminder.EndNeedRedraw(Sender);
    end;
  finally
    FReminder.EndTextChanged(Sender);
  end;
  RemindersInProcess.Notifier.Notify;
  TFieldPanel(TORCheckBox(Sender).Associate).SetFocus;
end;

function TRemDlgElement.EnableChildren: boolean;
var
  Chk: boolean;

begin
  if(assigned(FParent)) then
    Chk := FParent.EnableChildren
  else
    Chk := TRUE;
  if(Chk) then
  begin
    if(ElemType = etDisplayOnly) then
      Result := TRUE
    else
      Result := FChecked;
  end
  else
    Result := FALSE;
end;

function TRemDlgElement.Enabled: boolean;
begin
  if(assigned(FParent)) then
    Result := FParent.EnableChildren
  else
    Result := TRUE;
end;

function TRemDlgElement.ShowChildren: boolean;
begin
  if(assigned(FChildren) and (FChildren.Count > 0)) then
  begin
    if((ElemType = etDisplayOnly) or FChecked) then
      Result := TRUE
    else
      Result := (not HideChildren);
  end
  else
    Result := FALSE;
end;
   
procedure TRemDlgElement.ParentCBEnter(Sender: TObject);
begin
  (Sender as TORCheckbox).FocusOnBox := true;
end;

procedure TRemDlgElement.ParentCBExit(Sender: TObject);
begin
  (Sender as TORCheckbox).FocusOnBox := false;
end;


function TRemDlgElement.BuildControls(var Y: integer; ParentWidth: integer;
                                           BaseParent, AOwner: TWinControl): TWinControl;
var
  lbl: TLabel;
  pnl: TPanel;
  AutoFocusControl: TWinControl;
  cb: TORCheckBox;
  gb: TGroupBox;
  ERes, prnt: TWinControl;
  PrntWidth: integer;
  i, X, Y1: integer;
  LastX, MinX, MaxX: integer;
  Prompt: TRemPrompt;
  Ctrl: TMultiClassObj;
  OK, DoLbl, HasVCombo, cbSingleLine: boolean;
  ud: TUpDown;
  HelpBtn: TButton;
  vCombo: TComboBox;
  pt: TRemPromptType;
  SameLineCtrl: TList;
  Kid: TRemDlgElement;
  vt: TVitalType;
  DefaultDate: TFMDateTime;

  function GetPanel(const EID, AText: string; const PnlWidth: integer): TPanel;
  var
    idx, p: integer;
    Entry: TTemplateDialogEntry;

  begin
    // This call creates a new TTemplateDialogEntry if necessary and creates the
    // necessary template field controls with their default values stored in the
    // TTemplateField object.
    Entry := GetDialogEntry(BaseParent, EID + IntToStr(Integer(BaseParent)), AText);
    Entry.InternalID := EID;
    // This call looks for the Entry's values in TRemDlgElement.FFieldValues
    idx := FFieldValues.IndexOfPiece(EID);
    // If the Entry's values were found in the previous step then they will be
    // restored to the TTemplateDialogEntry.FieldValues in the next step.
    if(idx >= 0) then
    begin
      p := pos(U, FFieldValues[idx]); // Can't use Piece because 2nd piece may contain ^ characters
      if(p > 0) then
        Entry.FieldValues := copy(FFieldValues[idx],p+1,MaxInt);
    end;
    Entry.AutoDestroyOnPanelFree := TRUE;
    // The FieldPanelChange event handler is where the Entry.FieldValues are saved to the
    // Element.FFieldValues.
    Entry.OnChange := FieldPanelChange;
    // Calls TTemplateDialogEntry.SetFieldValues which calls
    // TTemplateDialogEntry.SetControlText to reset the template field default
    // values to the values that were restored to the Entry from the Element if
    // they exist, otherwise the default values will remain.
    Result := Entry.GetPanel(PnlWidth, BaseParent);
  end;

  procedure NextLine(var Y: integer);
  var
    i: integer;
    MaxY: integer;
    C: TControl;


  begin
    MaxY := 0;
    for i := 0 to SameLineCtrl.Count-1 do
    begin
      C := TControl(SameLineCtrl[i]);
      if(MaxY < C.Height) then
        MaxY := C.Height;
    end;
    for i := 0 to SameLineCtrl.Count-1 do
    begin
      C := TControl(SameLineCtrl[i]);
      if(MaxY > C.Height) then
        C.Top := Y + ((MaxY - C.Height) div 2);
    end;
    inc(Y, MaxY);
    if assigned(cb) and assigned(pnl) then
      cb.Top := pnl.Top;
    SameLineCtrl.Clear;
  end;

  procedure AddPrompts(Shared: boolean; AParent: TWinControl; PWidth: integer; var Y: integer);
  var
    i, j, k, idx: integer;
    DefLoc: TStrings;
    LocText: string;
    LocFound: boolean;
    m, n: integer;
    ActDt, InActDt: Double;
    EncDt: TFMDateTime;
    ActChoicesSL: TORStringList;
    Piece12, WHReportStr: String;
    WrapLeft, LineWidth: integer;

  begin
    SameLineCtrl := TList.Create;
    try
      if(assigned(cb)) then
      begin
        if(not Shared) then
        begin
          SameLineCtrl.Add(cb);
          SameLineCtrl.Add(pnl);
        end;
        if(cbSingleLine and (not Shared)) then
          LastX := cb.Left + pnl.Width + PromptGap + IndentGap
        else
          LastX := PWidth;
      end
      else
      begin
        if(not Shared) then SameLineCtrl.Add(pnl);
        LastX := PWidth;
      end;
      for i := 0 to FPrompts.Count-1 do
      begin
        Prompt := TRemPrompt(FPrompts[i]);
        OK := ((Prompt.FIsShared = Shared) and Prompt.PromptOK and (not Prompt.Forced));
        if(OK and Shared) then
        begin
          OK := FALSE;
          for j := 0 to Prompt.FSharedChildren.Count-1 do
          begin
            Kid := TRemDlgElement(Prompt.FSharedChildren[j]);
//            if(Kid.ElemType <> etDisplayOnly) and (Kid.FChecked) then
            if(Kid.FChecked) then
            begin
              OK := TRUE;
              break;
            end;
          end;
        end;
        Ctrl.Ctrl := nil;
        ud := nil;
        HelpBtn := nil;
        vCombo := nil;
        HasVCombo := FALSE;
        if(OK) then
        begin
          pt := Prompt.PromptType;
          MinX := 0;
          MaxX := 0;
          lbl := nil;
          DoLbl := Prompt.Required;
          case pt of
            ptComment, ptQuantity, ptSkinReading:
              begin
                Ctrl.edt := TEdit.Create(AOwner);
                Ctrl.ctrl.Parent := AParent;
                Ctrl.edt.Text := Prompt.Value;
                if(pt = ptComment) then
                begin
                  Ctrl.edt.MaxLength := 245;
                  MinX := TextWidthByFont(Ctrl.edt.Font.Handle, 'AbCdEfGhIjKlMnOpQrStUvWxYz 1234');
                  MaxX := PWidth;
                end
                else
                begin
                  ud := TUpDown.Create(AOwner);
                  ud.Parent := AParent;
                  ud.Associate := Ctrl.edt;
                  if(pt = ptQuantity) then
                  begin
                    ud.Min := 1;
                    ud.Max := 100;
                  end
                  else
                  begin
                    ud.Min := 0;
                    ud.Max := 40;
                  end;
                  MinX := TextWidthByFont(Ctrl.edt.Font.Handle, IntToStr(ud.Max)) + 24;
                  ud.Position := StrToIntDef(Prompt.Value, ud.Min);
                end;
                Ctrl.edt.OnKeyPress := Prompt.EditKeyPress;
                Ctrl.edt.OnChange := Prompt.PromptChange;
                DoLbl := TRUE;
              end;

            ptVisitLocation, ptLevelUnderstanding,
            ptSeries, ptReaction, ptExamResults,
            ptLevelSeverity, ptSkinResults:
              begin
                Ctrl.cbo := TORComboBox.Create(AOwner);
                Ctrl.ctrl.Parent := AParent;
                Ctrl.cbo.OnKeyDown := Prompt.ComboBoxKeyDown;
                Ctrl.cbo.Style := orcsDropDown;
                Ctrl.cbo.Pieces := '2';
                Ctrl.cbo.Tag := ComboPromptTags[pt];
                PCELoadORCombo(Ctrl.cbo, MinX, MaxX);
                if pt = ptVisitLocation then
                begin
                  DefLoc := GetDefLocations;
                  if DefLoc.Count > 0 then
                  begin
                    idx := 1;
                    for j := 0 to DefLoc.Count-1 do
                    begin
                      LocText := piece(DefLoc[j],U,2);
                      if LocText <> '' then
                      begin
                        if (LocText <> '0') and (IntToStr(StrToIntDef(LocText,0)) = LocText) then
                        begin
                          LocFound := FALSE;
                          for k := 0 to Ctrl.cbo.Items.Count-1 do
                          begin
                            if(piece(Ctrl.cbo.Items[k],U,1) = LocText) then
                            begin
                              LocText := Ctrl.cbo.Items[k];
                              LocFound := TRUE;
                              break;
                            end;
                          end;
                          if not LocFound then
                            LocText := '';
                        end
                        else
                          LocText := '0^'+LocText;
                        if LocText <> '' then
                        begin
                          Ctrl.cbo.Items.Insert(idx, LocText);
                          inc(idx);
                        end;
                      end;
                    end;

                    if idx > 1 then
                    begin
                      Ctrl.cbo.Items.Insert(idx, '-1' + LLS_LINE);
                      Ctrl.cbo.Items.Insert(idx+1, '-1' + LLS_SPACE);
                    end;
                  end;
                end;

                MinX := MaxX;
                Ctrl.cbo.SelectByID(Prompt.Value);
                if(Ctrl.cbo.ItemIndex < 0) then
                begin
                  Ctrl.cbo.Text := Prompt.Value;
                  if(pt = ptVisitLocation) then
                    Ctrl.cbo.Items[0] := '0' + U + Prompt.Value;
                end;
                if(Ctrl.cbo.ItemIndex < 0) then
                  Ctrl.cbo.ItemIndex := 0;
                Ctrl.cbo.OnChange := Prompt.PromptChange;
                DoLbl := TRUE;
                Ctrl.cbo.ListItemsOnly := (pt <> ptVisitLocation);
              end;

              ptWHPapResult:
              begin
              if FData<>nil then
                begin
                if (TRemData(FData[i]).DisplayWHResults)=true then
                begin
                NextLine(Y);
                Ctrl.btn := TButton.Create(AOwner);
                Ctrl.ctrl.Parent := AParent;
                Ctrl.btn.Left := NewLInePromptGap+15;
                Ctrl.btn.Top := Y+7;
                Ctrl.btn.OnClick := Prompt.DoWHReport;
                Ctrl.btn.Caption := 'Review complete report';
                Ctrl.btn.Width := TextWidthByFont(Ctrl.btn.Font.Handle, Ctrl.btn.Caption) + 13;
                Ctrl.btn.Height := TextHeightByFont(Ctrl.btn.Font.Handle, Ctrl.btn.Caption) + 13;
                Ctrl.btn.Height := TextHeightByFont(Ctrl.btn.Handle, Ctrl.btn.Caption) + 8;
                Y := ctrl.btn.Top + Ctrl.btn.Height;
                NextLine(Y);
                Ctrl.WHChk := TWHCheckBox.Create(AOwner);
                Ctrl.ctrl.Parent := AParent;
                Ctrl.WHChk.Flbl := TLabel.Create(AOwner);
                Ctrl.WHChk.Flbl.Parent := Ctrl.WHChk.Parent;
                Ctrl.WHChk.Flbl.Caption := Prompt.Caption;
                Ctrl.WHChk.Flbl.Top := Y + 5;
                Ctrl.WHChk.Flbl.Left := NewLInePromptGap+15;
                WrapLeft := Ctrl.WHChk.Flbl.Left;
                Ctrl.WHChk.Flbl.Width := TextWidthByFont(Ctrl.WHChk.Flbl.Font.Handle, Ctrl.WHChk.Flbl.Caption)+25;
                Ctrl.WHChk.Flbl.Height := TextHeightByFont(Ctrl.WHChk.Flbl.Font.Handle, Ctrl.WHChk.Flbl.Caption);
                //LineWidth := WrapLeft + Ctrl.WHChk.Flbl.Width+10;
                if Prompt.Required then
                  Ctrl.WHChk.Flbl.Caption := '* '+Ctrl.WHChk.Flbl.Caption;
                Y := Ctrl.WHChk.Flbl.Top + Ctrl.WHChk.Flbl.Height;
                NextLine(Y);
                Ctrl.WHChk.RadioStyle:=true;
                Ctrl.WHChk.GroupIndex:=1;
                Ctrl.WHChk.Check2 := TWHCheckBox.Create(AOwner);
                Ctrl.WHChk.Check2.Parent := Ctrl.WHChk.Parent;
                Ctrl.WHChk.Check2.RadioStyle:=true;
                Ctrl.WHChk.Check2.GroupIndex:=1;
                Ctrl.WHChk.Check3 := TWHCheckBox.Create(AOwner);
                Ctrl.WHChk.Check3.Parent := Ctrl.WHChk.Parent;
                Ctrl.WHChk.Check3.RadioStyle:=true;
                Ctrl.WHChk.Check3.GroupIndex:=1;
                Ctrl.WHChk.Caption := 'NEM (No Evidence of Malignancy)';
                Ctrl.WHChk.ShowHint := true;
                Ctrl.WHChk.Hint := 'No Evidence of Malignancy';
                Ctrl.WHChk.Width := TextWidthByFont(Ctrl.WHChk.Font.Handle, Ctrl.WHChk.Caption)+20;
                Ctrl.WHChk.Height := TextHeightByFont(Ctrl.WHChk.Font.Handle, Ctrl.WHChk.Caption)+4;
                Ctrl.WHChk.Top := Y + 5;
                Ctrl.WHChk.Left := WrapLeft;
                Ctrl.WHChk.OnClick := Prompt.PromptChange;
                Ctrl.WHChk.Checked := (WHResultChk = 'N');
                LineWidth := WrapLeft + Ctrl.WHChk.Width+5;
                Ctrl.WHChk.Check2.Caption := 'Abnormal';
                Ctrl.WHChk.Check2.Width := TextWidthByFont(Ctrl.WHChk.Check2.Font.Handle, Ctrl.WHChk.Check2.Caption) + 20;
                Ctrl.WHChk.Check2.Height := TextHeightByFont(Ctrl.WHChk.check2.Font.Handle, Ctrl.WHChk.check2.Caption)+4;
                if (LineWidth + Ctrl.WHChk.Check2.Width) > PWidth - 10 then
                        begin
                        LineWidth := WrapLeft;
                        Y := Ctrl.WHChk.Top + Ctrl.WHChk.Height;
                        Nextline(Y);
                        end;
                Ctrl.WHChk.Check2.Top := Y + 5;
                Ctrl.WHChk.Check2.Left := LineWidth;
                Ctrl.WHChk.Check2.OnClick := Prompt.PromptChange;
                Ctrl.WHChk.Check2.Checked := (WHResultChk = 'A');
                LineWidth := LineWidth + Ctrl.WHChk.Check2.Width+5;
                Ctrl.WHChk.Check3.Caption := 'Unsatisfactory for Diagnosis';
                Ctrl.WHChk.Check3.Width := TextWidthByFont(Ctrl.WHChk.Check3.Font.Handle, Ctrl.WHChk.Check3.Caption)+20;
                Ctrl.WHChk.Check3.Height := TextHeightByFont(Ctrl.WHChk.check3.Font.Handle, Ctrl.WHChk.check3.Caption)+4;
                if (LineWidth + Ctrl.WHChk.Check3.Width) > PWidth - 10 then
                        begin
                        LineWidth := WrapLeft;
                        Y := Ctrl.WHChk.Check2.Top + Ctrl.WHChk.Check2.Height;
                        Nextline(Y);
                        end;
                Ctrl.WHChk.Check3.Top := Y + 5;
                Ctrl.WHChk.Check3.OnClick := Prompt.PromptChange;
                Ctrl.WHChk.Check3.Checked := (WHResultChk = 'U');
                Ctrl.WHChk.Check3.Left := LineWidth;
                Y := Ctrl.WHChk.Check3.Top + Ctrl.WHChk.Check3.Height;
                Nextline(Y);
                end
                else DoLbl := FALSE;
                end
                else DoLbl :=FALSE;
              end;

              ptWHNotPurp:
              begin
              NextLine(Y);
                Ctrl.WHChk := TWHCheckBox.Create(AOwner);
                Ctrl.ctrl.Parent := AParent;
                Ctrl.WHChk.Flbl := TLabel.Create(AOwner);
                Ctrl.WHChk.Flbl.Parent := Ctrl.WHChk.Parent;
                Ctrl.WHChk.Flbl.Caption := Prompt.Caption;
                Ctrl.WHChk.Flbl.Top := Y + 7;
                Ctrl.WHChk.Flbl.Left := NewLInePromptGap+30;
                WrapLeft := Ctrl.WHChk.Flbl.Left;
                Ctrl.WHChk.Flbl.Width := TextWidthByFont(Ctrl.WHChk.Flbl.Font.Handle, Ctrl.WHChk.Flbl.Caption)+25;
                Ctrl.WHChk.Flbl.Height := TextHeightByFont(Ctrl.WHChk.Flbl.Font.Handle, Ctrl.WHChk.Flbl.Caption)+4;
                LineWidth := WrapLeft + Ctrl.WHChk.Flbl.Width+10;
                if Prompt.Required then
                  Ctrl.WHChk.Flbl.Caption := '* '+Ctrl.WHChk.Flbl.Caption;
                Ctrl.WHChk.Check2 := TWHCheckBox.Create(AOwner);
                Ctrl.WHChk.Check2.Parent := Ctrl.WHChk.Parent;
                Ctrl.WHChk.Check3 := TWHCheckBox.Create(AOwner);
                Ctrl.WHChk.Check3.Parent := Ctrl.WHChk.Parent;
                Ctrl.WHChk.ShowHint := true;
                Ctrl.WHChk.Hint := 'Letter will print with next WH batch run';
                Ctrl.WHChk.Caption := 'Letter';
                Ctrl.WHChk.Width := TextWidthByFont(Ctrl.WHChk.Font.Handle, Ctrl.WHChk.Caption)+25;
                Ctrl.WHChk.Height := TextHeightByFont(Ctrl.WHChk.Font.Handle, Ctrl.WHChk.Caption)+4;
                if (LineWidth + Ctrl.WHChk.Width) > PWidth - 10 then
                        begin
                        LineWidth := WrapLeft;
                        Y := Ctrl.WHChk.Flbl.Top + Ctrl.WHChk.Flbl.Height;
                        Nextline(Y);
                        end;
                Ctrl.WHChk.Top := Y + 7;
                Ctrl.WHChk.Left := LineWidth;
                Ctrl.WHChk.OnClick := Prompt.PromptChange;
                Ctrl.WHChk.Checked := (Pos('L',WHResultNot)>0);
                LineWidth := LineWidth + Ctrl.WHChk.Width+10;
                Ctrl.WHChk.Check2.Caption := 'In-Person';
                Ctrl.WHChk.Check2.Width := TextWidthByFont(Ctrl.WHChk.Check2.Font.Handle, Ctrl.WHChk.Check2.Caption) + 25;
                Ctrl.WHChk.Check2.Height := TextHeightByFont(Ctrl.WHChk.check2.Font.Handle, Ctrl.WHChk.check2.Caption)+4;
                if (LineWidth + Ctrl.WHChk.Check2.Width) > PWidth - 10 then
                        begin
                        LineWidth := WrapLeft;
                        Y := Ctrl.WHChk.Top + Ctrl.WHChk.Height;
                        Nextline(Y);
                        end;
                Ctrl.WHChk.Check2.Top := Y + 7;
                Ctrl.WHChk.Check2.Left := LineWidth;
                Ctrl.WHChk.Check2.OnClick := Prompt.PromptChange;
                Ctrl.WHChk.Check2.Checked := (Pos('I',WHResultNot)>0);
                LineWidth := LineWidth + Ctrl.WHChk.Check2.Width+10;
                Ctrl.WHChk.Check3.Caption := 'Phone Call';
                Ctrl.WHChk.Check3.Width := TextWidthByFont(Ctrl.WHChk.Check3.Font.Handle, Ctrl.WHChk.Check3.Caption)+20;
                Ctrl.WHChk.Check3.Height := TextHeightByFont(Ctrl.WHChk.check3.Font.Handle, Ctrl.WHChk.check3.Caption)+4;
                if (LineWidth + Ctrl.WHChk.Check3.Width) > PWidth - 10 then
                        begin
                        LineWidth := WrapLeft;
                        Y := Ctrl.WHChk.Check2.Top + Ctrl.WHChk.Check2.Height;
                        Nextline(Y);
                        end;
                Ctrl.WHChk.Check3.Top := Y + 7;
                Ctrl.WHChk.Check3.OnClick := Prompt.PromptChange;
                Ctrl.WHChk.Check3.Checked := (Pos('P',WHResultNot)>0);
                Ctrl.WHChk.Check3.Left := LineWidth;
                Y := Ctrl.WHChk.Check3.Top + Ctrl.WHChk.Check3.Height;
                Nextline(Y);
                Ctrl.WHChk.Fbutton := TButton.Create(AOwner);
                Ctrl.WHChk.FButton.Parent := Ctrl.WHChk.Parent;
                Ctrl.WHChk.FButton.Enabled:=(Pos('L',WHResultNot)>0);
                Ctrl.WHChk.FButton.Left := Ctrl.WHChk.Flbl.Left;
                Ctrl.WHChk.FButton.Top := Y+7;
                Ctrl.WHChk.FButton.OnClick := Prompt.ViewWHText;
                Ctrl.WHChk.FButton.Caption := 'View WH Notification Letter';
                Ctrl.WHChk.FButton.Width := TextWidthByFont(Ctrl.WHChk.FButton.Font.Handle, Ctrl.WHChk.FButton.Caption) + 13;
                Ctrl.WHChk.FButton.Height := TextHeightByFont(Ctrl.WHChk.FButton.Font.Handle, Ctrl.WHChk.FButton.Caption) + 13;
                LineWidth := Ctrl.WHChk.FButton.Left + Ctrl.WHChk.FButton.Width;
                if piece(Prompt.FRec4,u,12)='1' then
                  begin
                     Ctrl.WHChk.FPrintNow :=TORCheckBox.Create(AOwner);
                     Ctrl.WHChk.FPrintNow.Parent := Ctrl.WHChk.Parent;
                     Ctrl.WHChk.FPrintNow.ShowHint := true;
                     Ctrl.WHChk.FPrintNow.Hint := 'Letter will print after "Finish" button is clicked';
                     Ctrl.WHChk.FPrintNow.Caption:='Print Now';
                     Ctrl.WHChk.FPrintNow.Width := TextWidthByFont(Ctrl.WHChk.FPrintNow.Font.Handle, Ctrl.WHChk.FPrintNow.Caption)+20;
                     Ctrl.WHChk.FPrintNow.Height := TextHeightByFont(Ctrl.WHChk.FPrintNow.Font.Handle, Ctrl.WHChk.FPrintNow.Caption)+4;
                     if (LineWidth + Ctrl.WHChk.FPrintNow.Width) > PWidth - 10 then
                        begin
                          LineWidth := WrapLeft;
                          Y := Ctrl.WHChk.FButton.Top + Ctrl.WHChk.FButton.Height;
                          Nextline(Y);
                        end;
                     Ctrl.WHChk.FPrintNow.Left := LineWidth + 15;
                     Ctrl.WHChk.FPrintNow.Top := Y + 7;
                     Ctrl.WHChk.FPrintNow.Enabled := (Pos('L',WHResultNot)>0);
                     Ctrl.WHChk.FPrintNow.Checked :=(WHPrintDevice<>'');
                     Ctrl.WHChk.FPrintNow.OnClick := Prompt.PromptChange;
                     MinX :=PWidth;
                     if (Ctrl.WHChk.FButton.Top + Ctrl.WHChk.FButton.Height) > (Ctrl.WHChk.FPrintNow.Top + Ctrl.WHChk.FPrintNow.Height) then
                        Y := Ctrl.WHChk.FButton.Top + Ctrl.WHChk.FButton.Height + 7
                     else
                        Y := Ctrl.WHChk.FPrintNow.Top + Ctrl.WHChk.FPrintNow.Height + 7;
                  end
                else
                  Y := Ctrl.WHChk.FButton.Top + Ctrl.WHChk.FButton.Height + 7;
                NextLine(Y);
                end;

            ptVisitDate:
              begin
                Ctrl.dt := TORDateCombo.Create(AOwner);
                Ctrl.ctrl.Parent := AParent;
                Ctrl.dt.LongMonths := TRUE;
                try
                  DefaultDate := Ctrl.dt.FMDate;
                  Ctrl.dt.FMDate := StrToFloat(Prompt.Value);
                except
                  on EConvertError do
                    Ctrl.dt.FMDate := DefaultDate;
                  else
                    raise;
                end;
                Ctrl.dt.OnChange := Prompt.PromptChange;
                DoLbl := TRUE;
                MinX := Ctrl.dt.Width;
                //TextWidthByFont(Ctrl.dt.Font.Handle, 'May 22, 2000') + 26;
              end;

            ptPrimaryDiag, ptAdd2PL, ptContraindicated:
              begin
                Ctrl.cb := TORCheckBox.Create(AOwner);
                Ctrl.ctrl.Parent := AParent;
                Ctrl.cb.Checked := (Prompt.Value = '1');
                Ctrl.cb.Caption := Prompt.Caption;
                if prompt.Required=false then DoLbl := true;
                Ctrl.cb.AutoSize := False;
                Ctrl.cb.OnEnter := ParentCBEnter;
                Ctrl.cb.OnExit := ParentCBExit;
                Ctrl.cb.Height := TORCheckBox(Ctrl.cb).Height + 5;
                Ctrl.cb.Width := 17;
                Ctrl.cb.OnClick := Prompt.PromptChange;
                MinX := Ctrl.cb.Width;
              end;

            else
            begin
              if(pt = ptSubComment) then
              begin
                Ctrl.cb := TORCheckBox.Create(AOwner);
                Ctrl.ctrl.Parent := AParent;
                Ctrl.cb.Checked := (Prompt.Value = '1');
                Ctrl.cb.Caption := Prompt.Caption;
                Ctrl.cb.AutoSize := TRUE;
                Ctrl.cb.OnClick := SubCommentChange;
                Ctrl.cb.Tag := Integer(Prompt);
                MinX := Ctrl.cb.Width;
              end
              else
              if pt = ptVitalEntry then
              begin
                vt := Prompt.VitalType;
                if(vt = vtPain) then
                begin
                  Ctrl.cbo := TORComboBox.Create(AOwner);
                  Ctrl.ctrl.Parent := AParent;
                  Ctrl.cbo.Style := orcsDropDown;
                  Ctrl.cbo.Pieces := '1,2';
                  Ctrl.cbo.OnKeyDown := Prompt.ComboBoxKeyDown;
                  InitPainCombo(Ctrl.cbo);
                  Ctrl.cbo.ListItemsOnly := TRUE;
                  Ctrl.cbo.SelectByID(Prompt.VitalValue);
                  Ctrl.cbo.OnChange := Prompt.PromptChange;
                  Ctrl.cbo.SelLength := 0;
                  MinX := TextWidthByFont(Ctrl.cbo.Font.Handle, Ctrl.cbo.DisplayText[0]) + 24;
                  MaxX := TextWidthByFont(Ctrl.cbo.Font.Handle, Ctrl.cbo.DisplayText[1]) + 24;
                  if(ElementChecked = Self) then
                  begin
                    AutoFocusControl := Ctrl.cbo;
                    ElementChecked := nil;
                  end;
                end
                else
                begin
                  Ctrl.vedt := TVitalEdit.Create(AOwner);
                  Ctrl.ctrl.Parent := AParent;
                  MinX := TextWidthByFont(Ctrl.vedt.Font.Handle, '12345.67');
                  Ctrl.edt.OnKeyPress := Prompt.EditKeyPress;
                  Ctrl.edt.OnChange := Prompt.PromptChange;
                  Ctrl.edt.OnExit := Prompt.VitalVerify;
                  if(vt in [vtTemp, vtHeight, vtWeight]) then
                  begin
                    HasVCombo := TRUE;
                    Ctrl.vedt.FLinkedCombo := TVitalComboBox.Create(AOwner);
                    Ctrl.vedt.FLinkedCombo.Parent := AParent;
                    Ctrl.vedt.FLinkedCombo.OnChange := Prompt.PromptChange;
                    Ctrl.vedt.FLinkedCombo.Tag := VitalControlTag(vt, TRUE);
                    Ctrl.vedt.FLinkedCombo.OnExit := Prompt.VitalVerify;
                    Ctrl.vedt.FLinkedCombo.FLinkedEdit := Ctrl.vedt;
                    case vt of
                      vtTemp:
                        begin
                          Ctrl.vedt.FLinkedCombo.Items.Add('F');
                          Ctrl.vedt.FLinkedCombo.Items.Add('C');
                        end;

                      vtHeight:
                        begin
                          Ctrl.vedt.FLinkedCombo.Items.Add('IN');
                          Ctrl.vedt.FLinkedCombo.Items.Add('CM');
                        end;

                      vtWeight:
                        begin
                          Ctrl.vedt.FLinkedCombo.Items.Add('LB');
                          Ctrl.vedt.FLinkedCombo.Items.Add('KG');
                        end;

                    end;
                    Ctrl.vedt.FLinkedCombo.SelectByID(Prompt.VitalUnitValue);
                    if(Ctrl.vedt.FLinkedCombo.ItemIndex < 0) then
                      Ctrl.vedt.FLinkedCombo.ItemIndex := 0;
                    Ctrl.vedt.FLinkedCombo.Width := TextWidthByFont(Ctrl.vedt.Font.Handle,
                                                                    Ctrl.vedt.FLinkedCombo.Items[1]) + 30;
                    Ctrl.vedt.FLinkedCombo.SelLength := 0;
                    inc(MinX, Ctrl.vedt.FLinkedCombo.Width);
                  end;
                  if(ElementChecked = Self) then
                  begin
                    AutoFocusControl := Ctrl.edt;
                    ElementChecked := nil;
                  end;
                end;
                Ctrl.ctrl.Text := Prompt.VitalValue;
                Ctrl.ctrl.Tag := VitalControlTag(vt);
                DoLbl := TRUE;
              end
              else
              if pt = ptDataList then
              begin
                Ctrl.cbo := TORComboBox.Create(AOwner);
                Ctrl.ctrl.Parent := AParent;
                Ctrl.cbo.Style := orcsDropDown;
                Ctrl.cbo.Pieces := '12';
                if ActChoicesSL = nil then
                   ActChoicesSL := TORStringList.Create;
                if Self.Historical then
                  EncDt := DateTimeToFMDateTime(Date)
                else
                  EncDt := RemForm.PCEObj.VisitDateTime;
                if assigned(Prompt.FData.FChoicesActiveDates) then {csv active/inactive dates}
                 for m := 0 to (Prompt.FData.FChoices.Count - 1) do
                  begin
                    for n := 0 to (TStringList(Prompt.FData.FChoicesActiveDates[m]).Count - 1) do
                     begin
                       ActDt := StrToIntDef((Piece(TStringList(Prompt.FData.FChoicesActiveDates[m]).Strings[n], ':', 1)),0);
                       InActDt := StrToIntDef((Piece(TStringList(Prompt.FData.FChoicesActiveDates[m]).Strings[n], ':', 2)),9999999);
                       Piece12 := Piece(Piece(Prompt.FData.FChoices.Strings[m],U,12),':',1);
                       Prompt.FData.FChoices.SetStrPiece(m,12,Piece12);
                       if (EncDt >= ActDt) and (EncDt <= InActDt) then
                          ActChoicesSL.AddObject(Prompt.FData.FChoices[m], Prompt.FData.FChoices.Objects[m]);
                     end; {loop through the TStringList object in FChoicesActiveDates[m] object property}
                  end  {loop through FChoices/FChoicesActiveDates}
                else
                  ActChoicesSL.Assign(Prompt.FData.FChoices);
                Ctrl.cbo.Items.Assign(ActChoicesSL);
                Ctrl.cbo.CheckBoxes := TRUE;
                Ctrl.cbo.SelectByID(Prompt.Value);
                Ctrl.cbo.OnCheckedText := FReminder.ComboBoxCheckedText;
                Ctrl.cbo.OnResize := FReminder.ComboBoxResized;
                Ctrl.cbo.CheckedString := Prompt.Value;
                Ctrl.cbo.OnChange := Prompt.PromptChange;
                Ctrl.cbo.ListItemsOnly := TRUE;
                if(ElementChecked = Self) then
                begin
                  AutoFocusControl := Ctrl.cbo;
                  ElementChecked := nil;
                end;
                DoLbl := TRUE;
                if(Prompt.FData.FChoicesFont = Ctrl.cbo.Font.Handle) then
                begin
                  MinX := Prompt.FData.FChoicesMin;
                  MaxX := Prompt.FData.FChoicesMax;
                end
                else
                begin
                  GetComboBoxMinMax(Ctrl.cbo, MinX, MaxX);
                  inc(MaxX,18); // Adjust for checkboxes
                  MinX := MaxX;
                  Prompt.FData.FChoicesFont := Ctrl.cbo.Font.Handle;
                  Prompt.FData.FChoicesMin := MinX;
                  Prompt.FData.FChoicesMax := MaxX;
                end;
              end
              else
              if(pt = ptMHTest) then
              begin
                Ctrl.btn := TButton.Create(AOwner);
                Ctrl.ctrl.Parent := AParent;
                Ctrl.btn.OnClick := Prompt.DoMHTest;
                Ctrl.btn.Caption := Prompt.ForcedCaption;
                if Piece(Prompt.FData.FRec3,U,13)='1' then
                      Ctrl.btn.Caption := Ctrl.btn.Caption + ' *';
                MinX := TextWidthByFont(Ctrl.btn.Font.Handle, Ctrl.btn.Caption) + 13;
                Ctrl.btn.Height := TextHeightByFont(Ctrl.btn.Font.Handle, Ctrl.btn.Caption) + 8;
                DoLbl := TRUE;
              end
              else
              if(pt = ptGAF) then
              begin
                Ctrl.edt := TEdit.Create(AOwner);
                Ctrl.ctrl.Parent := AParent;
                Ctrl.edt.Text := Prompt.Value;
                ud := TUpDown.Create(AOwner);
                ud.Parent := AParent;
                ud.Associate := Ctrl.edt;
                ud.Min := 0;
                ud.Max := 100;
                MinX := TextWidthByFont(Ctrl.edt.Font.Handle, IntToStr(ud.Max)) + 24 + Gap;
                ud.Position := StrToIntDef(Prompt.Value, ud.Min);
                Ctrl.edt.OnKeyPress := Prompt.EditKeyPress;
                Ctrl.edt.OnChange := Prompt.PromptChange;
                if(User.WebAccess and (GAFURL <> '')) then
                begin
                  HelpBtn := TButton.Create(AOwner);
                  HelpBtn.Parent := AParent;
                  HelpBtn.Caption := 'Reference Info';
                  HelpBtn.OnClick := Prompt.GAFHelp;
                  HelpBtn.Width := TextWidthByFont(HelpBtn.Font.Handle, HelpBtn.Caption) + 13;
                  HelpBtn.Height := Ctrl.edt.Height;
                  inc(MinX, HelpBtn.Width);
                end;
                DoLbl := TRUE;
              end
              else
                Ctrl.ctrl := nil;
            end;
          end;

           if(DoLbl) and ((pt <> ptWHNotPurp) and (pt <> ptWHPapResult)) then
          //if(DoLbl) then
          begin
            if(Prompt.Caption = '') and (not Prompt.Required) then
              DoLbl := FALSE
            else
            begin
              lbl := TLabel.Create(AOwner);
              lbl.Parent := AParent;
              lbl.Caption := Prompt.Caption;
             if Prompt.Required then
                lbl.Caption :=  lbl.Caption+' *';
              if pt = ptGaf then
                begin
                  if Piece(Prompt.FData.FRec3,U,13)='1' then
                      lbl.Caption := lbl.Caption + ' *';
                end;
              lbl.Enabled := Prompt.FParent.Enabled;
              inc(MinX, lbl.Width + LblGap);
              inc(MaxX, lbl.Width + LblGap);
            end;
          end;

          if(MaxX < MinX) then
            MaxX := MinX;

          if((Prompt.SameLine) and ((LastX + MinX + Gap) < PWidth)) and
          ((pt <> ptWHNotPurp) and (pt <> ptWHPapResult)) then
          //if((Prompt.SameLine) and ((LastX + MinX + Gap) < PWidth)) then
          begin
            X := LastX;
          end
          else
          begin
            if(Shared) and (assigned(FChildren)) and (FChildren.Count > 0) then
              X := TRemDlgElement(FChildren[0]).TrueIndent
            else
            begin
              if(assigned(cb)) then
                X := cb.Left + NewLinePromptGap
              else
                X := pnl.Left + NewLinePromptGap;
            end;
            NextLine(Y);
          end;
          if(MaxX > (PWidth - X - Gap)) then
            MaxX := PWidth - X - Gap;
          if((DoLbl) or (assigned(Ctrl.Ctrl)))  and
          ((pt <> ptWHNotPurp) and (pt <> ptWHPapResult)) then
          //if((DoLbl) or (assigned(Ctrl.Ctrl))) then
          begin
          if DoLbl then
          begin
            lbl.Left := X;
            lbl.Top := Y;
            inc(X, lbl.Width + LblGap);
            dec(MinX, lbl.Width + LblGap);
            dec(MaxX, lbl.Width + LblGap);
            SameLineCtrl.Add(lbl);
          end;
          if(assigned(Ctrl.Ctrl)) then
          begin
            Ctrl.Ctrl.Enabled := Prompt.FParent.Enabled;
            if not Ctrl.Ctrl.Enabled then
              Ctrl.Ctrl.Font.Color := DisabledFontColor;
            Ctrl.Ctrl.Left := X;
            Ctrl.Ctrl.Top := Y;
            SameLineCtrl.Add(Ctrl.Ctrl);
            if(assigned(ud)) then
            begin
              SameLineCtrl.Add(ud);
              if(assigned(HelpBtn)) then
              begin
                SameLineCtrl.Add(HelpBtn);
                Ctrl.Ctrl.Width := MinX - HelpBtn.Width - ud.Width;
                HelpBtn.Left := X + Ctrl.Ctrl.Width + ud.Width + Gap;
                HelpBtn.Top := Y;
                HelpBtn.Enabled := Prompt.FParent.Enabled;
              end
              else
                Ctrl.Ctrl.Width := MinX - ud.Width;
              ud.Left := X + Ctrl.Ctrl.Width;
              ud.Top := Y;
              LastX := X + MinX + PromptGap;
              ud.Enabled := Prompt.FParent.Enabled;
            end
            else
            if(HasVCombo) then
            begin
              SameLineCtrl.Add(Ctrl.vedt.FLinkedCombo);
              Ctrl.Ctrl.Width := MinX - Ctrl.vedt.FLinkedCombo.Width;
              Ctrl.vedt.FLinkedCombo.Left := X + Ctrl.Ctrl.Width;
              Ctrl.vedt.FLinkedCombo.Top := Y;
              LastX := X + MinX + PromptGap;
              Ctrl.vedt.FLinkedCombo.Enabled := Prompt.FParent.Enabled;
            end
            else
            begin
              Ctrl.Ctrl.Width := MaxX;
              LastX := X + MaxX + PromptGap;
            end;
          end;
        end;
        end;
        if(assigned(ud)) then
          Prompt.FCurrentControl := ud
        else
          Prompt.FCurrentControl := Ctrl.Ctrl;
      end;
      NextLine(Y);
    finally
      SameLineCtrl.Free;
    end;
  end;

begin
  Result := nil;
  AutoFocusControl := nil;
  X := TrueIndent;
  if(assigned(FPrompts)) then
  begin
    for i := 0 to FPrompts.Count-1 do
      TRemPrompt(FPrompts[i]).FCurrentControl := nil;
  end;
  if(ElemType = etDisplayOnly) then
  begin
    if(FText <> '') then
    begin
      inc(Y,Gap);
      pnl := GetPanel(EntryID, CRLFText(FText), ParentWidth - X - (Gap * 2));
      pnl.Left := X;
      pnl.Top := Y;
      if (FChecked and assigned(FPrompts) and (FPrompts.Count > 0)) then
      begin
        cb := nil;
        AddPrompts(FALSE, BaseParent, ParentWidth, Y);
      end
      else
        inc(Y,pnl.Height);
    end;
  end
  else
  begin
    inc(Y,Gap);
    cb := TORCheckBox.Create(AOwner);
    cb.Parent := BaseParent;
    cb.Left := X;
    cb.Top := Y;
    cb.Tag := Integer(Self);
    cb.WordWrap := TRUE;
    cb.AutoSize := TRUE;
    cb.Checked := FChecked;
    cb.Width := ParentWidth - X - Gap;
    cb.Caption := CRLFText(FText);
    cb.AutoAdjustSize;
    cbSingleLine := cb.SingleLine;
    cb.AutoSize := FALSE;
    cb.WordWrap := FALSE;
    cb.Caption := '';
    cb.Width := 13;
    cb.Height := 17;
    cb.TabStop := False;  {take checkboxes out of the tab order}
    pnl := GetPanel(EntryID, CRLFText(FText), ParentWidth - X - (Gap * 2) - IndentGap);
    pnl.Left := X + IndentGap;
    pnl.Top := Y;
    cb.Associate := pnl;
    pnl.Tag := Integer(cb);   {So the panel can check the checkbox}
    pnl.TabStop := TRUE;     {tab through the panels instead of the checkboxes}

    cb.OnClick := cbClicked;
    pnl.OnEnter := FieldPanelEntered;
    pnl.OnExit := FieldPanelExited;
    TFieldPanel(pnl).OnKeyPress := FieldPanelKeyPress;
    pnl.OnClick := FieldPanelOnClick;
    for i := 0 to pnl.ControlCount - 1 do
      if (pnl.Controls[i] is TLabel) and
         not (fsUnderline in TLabel(pnl.Controls[i]).Font.Style) then //If this isn't a hyperlink change then event handler
         TLabel(pnl.Controls[i]).OnClick := FieldPanelLabelOnClick;

    //cb.Enabled := Enabled;
    if(assigned(FParent) and (FParent.ChildrenRequired in [crOne, crNoneOrOne])) then
      cb.RadioStyle := TRUE;

    if (FChecked and assigned(FPrompts) and (FPrompts.Count > 0)) then
      AddPrompts(FALSE, BaseParent, ParentWidth, Y)
    else
      inc(Y, pnl.Height);
  end;

  if(ShowChildren) then
  begin
    gb := nil;
    if(Box) then
    begin
      gb := TGroupBox.Create(AOwner);
      gb.Parent := BaseParent;
      gb.Left := TrueIndent + (ChildrenIndent * IndentMult);
      gb.Top := Y;
      gb.Width := ParentWidth - gb.Left - Gap;
      PrntWidth := gb.Width - (Gap * 2);
      gb.Caption := BoxCaption;
      gb.Enabled := EnableChildren;
      if(not EnableChildren) then
        gb.Font.Color := DisabledFontColor;
      prnt := gb;
      if(gb.Caption = '') then
        Y1 := gbTopIndent
      else
        Y1 := gbTopIndent2;
    end
    else
    begin
      prnt := BaseParent;
      Y1 := Y;
      PrntWidth := ParentWidth;
    end;

    for i := 0 to FChildren.Count-1 do
    begin
      ERes := TRemDlgElement(FChildren[i]).BuildControls(Y1, PrntWidth, prnt, AOwner);
      if(not assigned(Result)) then
        Result := ERes;
    end;

    if(FHasSharedPrompts) then
      AddPrompts(TRUE, prnt, PrntWidth, Y1);

    if(Box) then
    begin
      gb.Height := Y1 + (Gap * 3);
      inc(Y, Y1 + (Gap * 4));
    end
    else
      Y := Y1;
  end;

  SubCommentChange(nil);

  if(assigned(AutoFocusControl)) then
  begin
    if(AutoFocusControl is TORComboBox) and
      (TORComboBox(AutoFocusControl).CheckBoxes) and
      (pos('1',TORComboBox(AutoFocusControl).CheckedString) = 0) then
      Result := AutoFocusControl
    else
    if(TORExposedControl(AutoFocusControl).Text = '') then
      Result := AutoFocusControl
  end;
end;

//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.
function TRemDlgElement.GetTemplateFieldValues(const Text: string; FldValues: TORStringList =  nil): string;
var
  flen, CtrlID, i, j: integer;
  Fld: TTemplateField;
  Temp, FldName, NewTxt: string;

const
  TemplateFieldBeginSignature = '{FLD:';
  TemplateFieldEndSignature = '}';
  TemplateFieldSignatureLen = length(TemplateFieldBeginSignature);
  TemplateFieldSignatureEndLen = length(TemplateFieldEndSignature);
  FieldIDDelim = '`';
  FieldIDLen = 6;

  procedure AddNewTxt;
  begin
    if(NewTxt <> '') then
    begin
      insert(StringOfChar('x',length(NewTxt)), Temp, i);
      insert(NewTxt, Result, i);
      inc(i, length(NewTxt));
    end;
  end;

begin
  Result := Text;
  Temp := Text;
  repeat
    i := pos(TemplateFieldBeginSignature, Temp);
    if(i > 0) then
    begin
      CtrlID := 0;
      if(copy(Temp, i + TemplateFieldSignatureLen, 1) = FieldIDDelim) then
      begin
        CtrlID := StrToIntDef(copy(Temp, i + TemplateFieldSignatureLen + 1, FieldIDLen-1), 0);
        delete(Temp,i + TemplateFieldSignatureLen, FieldIDLen);
        delete(Result,i + TemplateFieldSignatureLen, FieldIDLen);
      end;
      j := pos(TemplateFieldEndSignature, copy(Temp, i + TemplateFieldSignatureLen, MaxInt));
      if(j > 0) then
      begin
        inc(j, i + TemplateFieldSignatureLen - 1);
        flen := j - i - TemplateFieldSignatureLen;
        FldName := copy(Temp, i + TemplateFieldSignatureLen, flen);
        Fld := GetTemplateField(FldName, FALSE);
        delete(Temp,i,flen + TemplateFieldSignatureLen + 1);
        delete(Result,i,flen + TemplateFieldSignatureLen + 1);
      end
      else
      begin
        delete(Temp,i,TemplateFieldSignatureLen);
        delete(Result,i,TemplateFieldSignatureLen);
        Fld := nil;
      end;
      // Get the value that was entered if there is one
      if assigned(FldValues) and (CtrlID > 0) then
      begin
        j := FldValues.IndexOfPiece(IntToStr(CtrlID));
        if not(j<0) then
          if Fld.DateType in DateComboTypes then
             NewTxt := Piece(Piece(FldValues[j],U,2),':',1)
          else
             NewTxt := Piece(FldValues[j],U,2);
      end;
      // If nothing has been entered, use the default
      if (NewTxt = '') and assigned(Fld) and
         //If this template field is a dftHyperlink or dftText that is
         //excluded (FSepLines = True) then don't get the default text
         not ((Fld.FldType in [dftHyperlink, dftText]) and Fld.SepLines) then
        NewTxt := Fld.TemplateFieldDefault;
      AddNewTxt;
    end;
  until not (i > 0);
end;

{ TODO -oLori -cNext : TRemDlgElement.AddText }
procedure TRemDlgElement.AddText(Lst: TStrings);
var
  i, ilvl: integer;
  Prompt: TRemPrompt;
  txt: string;
  FldData: TORStringList;

begin
  if (not (FReminder is TReminder)) then
    ScootOver := 4;
  try
    if Add2PN then
    begin
      ilvl := IndentPNLevel;
      if(FPNText <> '') then
        txt := FPNText
      else
      begin
        txt := FText;
        if not FReminder.FNoResolve then
          //If this is the CurrentReminderInDialog then we get the template field
          //values from the visual control in the dialog window.
          if FReminder = CurrentReminderInDialog then
             txt := ResolveTemplateFields(txt, TRUE)
          else
          //If this is not the CurrentReminderInDialog (i.e.: Next or Back button
          //has been pressed), then we have to get the template field values
          //that were saved in the element.
            begin
             FldData := TORStringList.Create;
             GetFieldValues(FldData);
             txt := GetTemplateFieldValues(txt, FldData);
            end;
      end;
      if FReminder.FNoResolve then
        Lst.Add(txt)
      else
        WordWrap(txt, Lst, ilvl);
      dec(ilvl,2);
      if(assigned(FPrompts)) then
      begin
        for i := 0 to FPrompts.Count-1 do
        begin
          Prompt := TRemPrompt(FPrompts[i]);
          if(not Prompt.FIsShared) then
            WordWrap(Prompt.NoteText, Lst, ilvl);
        end;
      end;
      if(assigned(FParent) and FParent.FHasSharedPrompts) then
      begin
        for i := 0 to FParent.FPrompts.Count-1 do
        begin
          Prompt := TRemPrompt(FParent.FPrompts[i]);
          if(Prompt.FIsShared) and (Prompt.FSharedChildren.IndexOf(Self) >= 0) then
            WordWrap(Prompt.NoteText, Lst, ilvl);
        end;
      end;
    end;
    if (assigned(FChildren)) and (FChecked or (ElemType = etDisplayOnly)) then
    begin
      for i := 0 to FChildren.Count-1 do
        TRemDlgElement(FChildren[i]).AddText(Lst);
    end;
  finally
    if (not (FReminder is TReminder)) then
      ScootOver := 0;
  end;
end;

function TRemDlgElement.AddData(Lst: TStrings; Finishing: boolean;
                                AHistorical: boolean = FALSE): integer;
var
  i, j: integer;
  OK: boolean;
  ActDt, InActDt, EncDt: double;
  RData: TRemData;

begin
  Result := 0;
//  OK := ((ElemType <> etDisplayOnly) and FChecked);
  OK := FChecked;
  if(OK and Finishing) then
    OK := (Historical = AHistorical);
  if OK then
  begin
    if(assigned(FData)) then
    begin
      if Self.Historical then
        EncDt := DateTimeToFMDateTime(Date)
      else
        EncDt := RemForm.PCEObj.VisitDateTime;
      for i := 0 to FData.Count-1 do
        begin
          RData := TRemData(FData[i]);
          if assigned(RData.FActiveDates) then
            for j := 0 to (TRemData(FData[i]).FActiveDates.Count - 1) do
              begin
                ActDt := StrToIntDef(Piece(TRemData(FData[i]).FActiveDates[j],':',1), 0);
                InActDt := StrToIntDef(Piece(TRemData(FData[i]).FActiveDates[j], ':', 2), 9999999);
                if (EncDt >= ActDt) and (EncDt <= InActDt) then
                  begin
                    inc(Result, TRemData(FData[i]).AddData(Lst, Finishing));
                    Break;
                  end;
              end
          else
            inc(Result, TRemData(FData[i]).AddData(Lst, Finishing));
        end;
    end;
  end;
  if (assigned(FChildren)) and (FChecked or (ElemType = etDisplayOnly)) then
  begin
    for i := 0 to FChildren.Count-1 do
      inc(Result, TRemDlgElement(FChildren[i]).AddData(Lst, Finishing, AHistorical));
  end;
end;

procedure TRemDlgElement.Check4ChildrenSharedPrompts;
var
  i, j: integer;
  Kid: TRemDlgElement;
  PList, EList: TList;
  FirstMatch: boolean;
  Prompt: TRemPrompt;

begin
  if(not FChildrenShareChecked) then
  begin
    FChildrenShareChecked := TRUE;
    if(ChildrenSharePrompts and assigned(FChildren)) then
    begin
      for i := 0 to FChildren.Count-1 do
        TRemDlgElement(FChildren[i]).GetData;
      PList := TList.Create;
      try
        EList := TList.Create;
        try
          for i := 0 to FChildren.Count-1 do
          begin
            Kid := TRemDlgElement(FChildren[i]);
//            if(Kid.ElemType <> etDisplayOnly) and (assigned(Kid.FPrompts)) then
            if(assigned(Kid.FPrompts)) then
            begin
              for j:= 0 to Kid.FPrompts.Count-1 do
              begin
                PList.Add(Kid.FPrompts[j]);
                EList.Add(Kid);
              end;
            end;
          end;
          if(PList.Count > 1) then
          begin
            for i := 0 to PList.Count-2 do
            begin
              if(assigned(EList[i])) then
              begin
                FirstMatch := TRUE;
                Prompt := TRemPrompt(PList[i]);
                for j := i+1 to PList.Count-1 do
                begin
                  if(assigned(EList[j]) and
                    (Prompt.CanShare(TRemPrompt(PList[j])))) then
                  begin
                    if(FirstMatch) then
                    begin
                      FirstMatch := FALSE;
                      if(not assigned(FPrompts)) then
                        FPrompts := TList.Create;
                      FHasSharedPrompts := TRUE;
                      Prompt.FIsShared := TRUE;
                      if(not assigned(Prompt.FSharedChildren)) then
                        Prompt.FSharedChildren := TList.Create;
                      Prompt.FSharedChildren.Add(EList[i]);
                      FPrompts.Add(PList[i]);
                      TRemDlgElement(EList[i]).FPrompts.Remove(PList[i]);
                      EList[i] := nil;
                    end;
                    Prompt.FSharedChildren.Add(EList[j]);
                    Kid := TRemDlgElement(EList[j]);
                    Kid.FPrompts.Remove(PList[j]);
                    if(Kid.FHasComment) and (Kid.FCommentPrompt = PList[j]) then
                    begin
                      Kid.FHasComment := FALSE;
                      Kid.FCommentPrompt := nil;
                    end;
                    TRemPrompt(PList[j]).Free;
                    EList[j] := nil;
                  end;
                end;
              end;
            end;
          end;
        finally
          EList.Free;
        end;
      finally
        PList.Free;
      end;
      for i := 0 to FChildren.Count-1 do
      begin
        Kid := TRemDlgElement(FChildren[i]);
        if(assigned(Kid.FPrompts) and (Kid.FPrompts.Count = 0)) then
        begin
          Kid.FPrompts.Free;
          Kid.FPrompts := nil;
        end;
      end;
    end;
  end;
end;

procedure TRemDlgElement.FinishProblems(List: TStrings);
var
  i,cnt: integer;
  cReq: TRDChildReq;
  Kid: TRemDlgElement;
  Prompt: TRemPrompt;
  txt, msg, Value: string;
  pt: TRemPromptType;

begin
//  if(ElemType <> etDisplayOnly) and (FChecked) and (assigned(FPrompts)) then
  if(FChecked and (assigned(FPrompts))) then
  begin
    for i := 0 to FPrompts.Count-1 do
    begin
      Prompt := TRemPrompt(FPrompts[i]);
      Value := Prompt.GetValue;
      pt := Prompt.PromptType;
      if(Prompt.PromptOK and (not Prompt.Forced) and Prompt.Required and
         (((pt<>ptWHNotPurp)and(pt<>ptWHPapResult))and
         ((Value = '') or (Value = '@')) or
         ((pt = ptVisitDate) and Prompt.FMonthReq and (StrToIntDef(copy(Value,4,2),0) = 0)) or
         ((pt in [ptVisitDate, ptVisitLocation]) and (Value = '0')))) then
      begin
        WordWrap('Element: ' + FText, List, 68, 6);
        txt := Prompt.ForcedCaption;
        if(pt = ptVisitDate) and Prompt.FMonthReq then
          txt := txt + ' (Month Required)';
        WordWrap('Item: ' + txt, List, 65, 6);
      end;
     if (Prompt.PromptOK and (not Prompt.Forced) and Prompt.Required and
          ((WHResultChk='') and (Value='')) and ((pt=ptWHPapResult) and (FData<>nil))) then
          begin
             WordWrap('Prompt: ' + Prompt.ForcedCaption, List, 65,6);
          end;
     if (Prompt.PromptOK and (not Prompt.Forced) and Prompt.Required
     and (pt=ptWHNotPurp)) and ((WHResultNot = '') and (Value = '')) then
          begin
               WordWrap('Element: ' + FText, List, 68, 6);
               WordWrap('Prompt: ' + Prompt.ForcedCaption, List, 65,6);
          end;
      //(AGP Change 24.9 add check to see if MH tests are required)
     if ((Pt = ptMHTest) or (Pt = ptGAF)) and (Piece(Prompt.FData.FRec3,U,13) = '1') and
                (not Prompt.Forced) then
        begin
          if (Pt = ptMHTest) and ((Prompt.FValue = '') or (pos('X',Prompt.FValue)>0)) then
            begin
               if Prompt.FValue = '' then
                  WordWrap('MH test '+ Piece(Prompt.FData.FRec3,U,8) + ' not done',List,65,6);
               if pos('X',Prompt.FValue)>0 then
                  WordWrap('You are missing one or more responses in the MH test '+
                           Piece(Prompt.FData.FRec3,U,8),List,65,6);
               WordWrap(' ',List,65,6);
            end;
          if (Pt = ptGAF) and ((Prompt.FValue = '0') or (Prompt.FValue = '')) then
            begin
               WordWrap('GAF test must have a score greater then zero',List,65,6);
               WordWrap(' ',List,65,6);
            end;
        end;
    end;
  end;
  if (assigned(FChildren)) and (FChecked or (ElemType = etDisplayOnly)) then
  begin
    cReq := ChildrenRequired;
    if(cReq in [crOne, crAtLeastOne]) then
    begin
      cnt := 0;
      for i := 0 to FChildren.Count-1 do
      begin
        Kid := TRemDlgElement(FChildren[i]);
//        if(Kid.FChecked and (Kid.ElemType <> etDisplayOnly)) then
        if(Kid.FChecked) then
          inc(cnt);
      end;
      if(cReq = crOne) and (cnt <> 1) then
        msg := 'One selection required'
      else
      if(cReq = crAtLeastOne) and (cnt < 1) then
        msg := 'One or more selections required'
      else
        msg := '';
      if(msg <> '') then
      begin
        txt := BoxCaption;
        if(txt = '') then
          txt := FText;
        WordWrap('Group: ' + txt, List, 68, 6);
        WordWrap(Msg, List, 65, 0);
        WordWrap(' ',List,68,6);    // (AGP change 24.9 added blank line for display spacing)
      end;
    end;
    for i := 0 to FChildren.Count-1 do
      TRemDlgElement(FChildren[i]).FinishProblems(List);
  end;
end;

function TRemDlgElement.IsChecked: boolean;
var
  Prnt: TRemDlgElement;

begin
  Result := TRUE;
  Prnt := Self;
  while Result and assigned(Prnt) do
  begin
    Result := ((Prnt.ElemType = etDisplayOnly) or Prnt.FChecked);
    Prnt := Prnt.FParent;
  end;
end;

function TRemDlgElement.IndentChildrenInPN: boolean;
begin
  //if(Box) then
    Result := (Piece(FRec1, U, 21) = '1');
  //else
  //  Result := FALSE;
end;

function TRemDlgElement.IndentPNLevel: integer;
begin
  if(assigned(FParent)) then
  begin
    Result := FParent.IndentPNLevel;
    if(FParent.IndentChildrenInPN) then
      dec(Result,2);
  end
  else
    Result := 70;
end;

function TRemDlgElement.IncludeMHTestInPN: boolean;
begin
  Result := (Piece(FRec1, U, 9) = '0');
end;

function TRemDlgElement.ResultDlgID: integer;
begin
  Result := StrToIntDef(Piece(FRec1, U, 10), 0);
end;

procedure TRemDlgElement.SubCommentChange(Sender: TObject);
var
  i: integer;
  txt: string;
  ok: boolean;

begin
  if(FHasSubComments and FHasComment and assigned(FCommentPrompt)) then
  begin
    ok := FALSE;
    if(assigned(Sender)) then
    begin
      with (Sender as TORCheckBox) do
        TRemPrompt(Tag).FValue := BOOLCHAR[Checked];
      ok := TRUE;
    end;
    if(not ok) then
      ok := (FCommentPrompt.GetValue = '');
    if(ok) then
    begin
      txt := '';
      for i := 0 to FPrompts.Count-1 do
      begin
        with TRemPrompt(FPrompts[i]) do
        begin
          if(PromptType = ptSubComment) and (FValue = BOOLCHAR[TRUE]) then
          begin
            if(txt <> '') then
              txt := txt + ', ';
            txt := txt + Caption;
          end;
        end;
      end;
      if(txt <> '') then
        txt[1] := UpCase(txt[1]);
      FCommentPrompt.SetValue(txt);
    end;
  end;
end;

constructor TRemDlgElement.Create;
begin
  FFieldValues := TORStringList.Create;
end;

function TRemDlgElement.EntryID: string;
begin
  Result := REMEntryCode + FReminder.GetIEN + '/' + IntToStr(integer(Self));
end;

procedure TRemDlgElement.FieldPanelChange(Sender: TObject);
var
  idx: integer;
  Entry: TTemplateDialogEntry;
  fval: string;

begin
  FReminder.BeginTextChanged;
  try
    Entry := TTemplateDialogEntry(Sender);
    idx := FFieldValues.IndexOfPiece(Entry.InternalID);
    fval := Entry.InternalID + U + Entry.FieldValues;
    if(idx < 0) then
      FFieldValues.Add(fval)
    else
      FFieldValues[idx] := fval;
  finally
    FReminder.EndTextChanged(Sender);
  end;
end;

procedure TRemDlgElement.GetFieldValues(FldData: TStrings);
var
  i, p: integer;
  TmpSL: TStringList;

begin
  TmpSL := TStringList.Create;
  try
    for i := 0 to FFieldValues.Count-1 do
    begin
      p := pos(U, FFieldValues[i]); // Can't use Piece because 2nd piece may contain ^ characters
      if(p > 0) then
      begin
        TmpSL.CommaText := copy(FFieldValues[i],p+1,MaxInt);
        FldData.AddStrings(TmpSL);
        TmpSL.Clear;
      end;
    end;
  finally
    TmpSL.Free;
  end;
  if (assigned(FChildren)) and (FChecked or (ElemType = etDisplayOnly)) then
    for i := 0 to FChildren.Count-1 do
      TRemDlgElement(FChildren[i]).GetFieldValues(FldData);
end;

{cause the paint event to be called and draw a focus rectangle on the TFieldPanel}
procedure TRemDlgElement.FieldPanelEntered(Sender: TObject);
begin
  with TFieldPanel(Sender) do
  begin
    Focus := TRUE;
    Invalidate;
    if Parent is TFieldPanel then
    begin
      TFieldPanel(Parent).Focus := FALSE;
      TFieldPanel(Parent).Invalidate;
    end;
  end;
end;
{cause the paint event to be called and draw the TFieldPanel without the focus rect.}
procedure TRemDlgElement.FieldPanelExited(Sender: TObject);
begin
  with TFieldPanel(Sender) do
  begin
    Focus := FALSE;
    Invalidate;
    if Parent is TFieldPanel then
    begin
      TFieldPanel(Parent).Focus := TRUE;
      TFieldPanel(Parent).Invalidate;
    end;
  end;
end;

{Check the associated checkbox when spacebar is pressed}
procedure TRemDlgElement.FieldPanelKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = ' ' then
  begin
    FieldPanelOnClick(Sender);
    Key := #0;
  end;
end;

{So the FieldPanel will check the associated checkbox}
procedure TRemDlgElement.FieldPanelOnClick(Sender: TObject);
begin
//  if TFieldPanel(Sender).Focus then
    TORCheckBox(TFieldPanel(Sender).Tag).Checked := not FChecked;
end;

{call the FieldPanelOnClick so labels on the panels will also click the checkbox}
procedure TRemDlgElement.FieldPanelLabelOnClick(Sender: TObject);
begin
  FieldPanelOnClick(TLabel(Sender).Parent); {use the parent/fieldpanel as the Sender}
end;

{ TRemData }

function TRemData.Add2PN: boolean;
begin
  Result := (Piece(FRec3, U, 5) <> '1');
end;

function TRemData.AddData(List: TStrings; Finishing: boolean): integer;
var
  i, j, k: integer;
  PCECat: TPCEDataCat;
  Primary: boolean;
  ActDt, InActDt: Double;
  EncDt: TFMDateTime;

  procedure AddPrompt(Prompt: TRemPrompt; dt: TRemDataType; var x: string);
  var
    pt: TRemPromptType;
    pnum: integer;
    Pdt: TRemDataType;
    v: TVitalType;
    rte, unt, txt: string;
    UIEN: Int64;

  begin
    pnum := -1;
    pt := Prompt.PromptType;
    if(pt = ptSubComment) or (pt = ptUnknown) then exit;
    if(pt = ptMST) then
    begin
      if (PCECat in MSTDataTypes) then
      begin
        UIEN := FParent.FReminder.PCEDataObj.Providers.PCEProvider;
        if UIEN <= 0 then
          UIEN := User.DUZ;
        SetPiece(x, U, pnumMST, Prompt.GetValue + ';' + // MST Code
                                  FloatToStr(RemForm.PCEObj.VisitDateTime) + ';' +
                                  IntToStr(UIEN) + ';' + //
                                  Prompt.FMiscText); // IEN of Exam, if any
      end;
    end
    else
    if(PCECat = pdcVital) then
    begin
      if(pt = ptVitalEntry) then
      begin
        rte := Prompt.VitalValue;
        if(rte <> '') then
        begin
          v := Prompt.VitalType;
          unt := Prompt.VitalUnitValue;
          ConvertVital(v, rte, unt);
          txt := U + VitalCodes[v] + U + rte + U + FloatToStr(RemForm.PCEObj.VisitDateTime);
          if(not Finishing) then
            txt := Char(ord('A')+ord(v)) + FormatVitalForNote(txt);  // Add vital sort char
          List.AddObject(Char(ord('A')+ord(PCECat)) + txt, Self);
        end;
      end
      else
        exit;
    end
    else
    if(PCECat = pdcMH) then
    begin
      if(pt = ptMHTest) or (pt = ptGAF) then
        x := x + U + Prompt.GetValue
      else
        exit;
    end
    else
    if(pt <> ptDataList) and (ord(pt) >= ord(low(TRemPromptType))) then
    begin
      Pdt := RemPromptTypes[pt];
      if (Pdt = dt) or (Pdt = dtAll) or
         ((Pdt = dtHistorical) and assigned(Prompt.FParent) and
           Prompt.FParent.Historical) then
        pnum := FinishPromptPieceNum[pt];
      if(pnum > 0) then
      begin
        if(pt = ptPrimaryDiag) then
          SetPiece(x, U, pnum, BoolChar[Primary])
        else
          SetPiece(x, U, pnum, Prompt.GetValue);
      end;
    end;
  end;

  procedure Add(Str: string; Root: TRemPCERoot);
  var
    i, Qty: integer;
    Value, IsGAF, txt, x, Code, Nar, Cat: string;
    Skip: boolean;
    Prompt: TRemPrompt;
    dt: TRemDataType;
    TestDate: TFMDateTime;
    i1,i2: integer;

  begin
    x := '';
    dt := Code2DataType(Piece(Str, U, r3Type));
    PCECat := RemData2PCECat[dt];
    Code := Piece(Str, U, r3Code);
    if(Code = '') then
      Code := Piece(Str, U, r3Code2);
    Nar := Piece(Str, U, r3Nar);
    Cat := Piece(Str, U, r3Cat);

    Primary := FALSE;
    if(assigned(FParent) and assigned(FParent.FPrompts) and (PCECat = pdcDiag)) then
    begin
      if(FParent.Historical) then
      begin
        for i := 0 to FParent.FPrompts.Count-1 do
        begin
          Prompt := TRemPrompt(FParent.FPrompts[i]);
          if(Prompt.PromptType = ptPrimaryDiag) then
          begin
            Primary := (Prompt.GetValue = BOOLCHAR[TRUE]);
            break;
          end;
        end;
      end
      else
        Primary := (Root = PrimaryDiagRoot);
    end;

    Skip := FALSE;
    if (PCECat = pdcMH) then
    begin
      IsGAF := Piece(FRec3, U, r3GAF);
      Value := FChoicePrompt.GetValue;
      if(Value = '') or ((IsGAF = '1') and (Value = '0')) then
        Skip := TRUE;
    end;

    if Finishing or (PCECat = pdcVital) then
    begin
      if(dt = dtOrder) then
        x := U + Piece(Str,U,6) + U + Piece(Str,U,11) + U + Nar
      else
      begin
        if (PCECat = pdcMH) then
        begin
          if(Skip) then
            x := ''
          else
          begin
            TestDate := Trunc(FParent.FReminder.PCEDataObj.VisitDateTime);
            if(IsGAF = '1') then
              ValidateGAFDate(TestDate);
            x := U + Nar + U + IsGAF + U + FloatToStr(TestDate) + U +
                 IntToSTr(FParent.FReminder.PCEDataObj.Providers.PCEProvider);
          end;
        end
        else
        if (PCECat <> pdcVital) then
        begin
          x := Piece(Str, U, 6);
          SetPiece(x, U, pnumCode, Code);
          SetPiece(x, U, pnumCategory, Cat);
          SetPiece(x, U, pnumNarrative, Nar);
        end;
        if(assigned(FParent)) then
        begin
          if(assigned(FParent.FPrompts)) then
          begin
            for i := 0 to FParent.FPrompts.Count-1 do
            begin
              Prompt := TRemPrompt(FParent.FPrompts[i]);
              if(not Prompt.FIsShared) then
                AddPrompt(Prompt, dt, x);
            end;
          end;
          if(assigned(FParent.FParent) and FParent.FParent.FHasSharedPrompts) then
          begin
            for i := 0 to FParent.FParent.FPrompts.Count-1 do
            begin
              Prompt := TRemPrompt(FParent.FParent.FPrompts[i]);
              if(Prompt.FIsShared) and (Prompt.FSharedChildren.IndexOf(FParent) >= 0) then
                AddPrompt(Prompt, dt, x);
            end;
          end;
        end;
      end;
      if(x <> '') then
        List.AddObject(Char(ord('A')+ord(PCECat)) + x, Self);
    end
    else
    begin
      Qty := 1;
      if(assigned(FParent) and assigned(FParent.FPrompts)) then
      begin
        if(PCECat = pdcProc) then
        begin
          for i := 0 to FParent.FPrompts.Count-1 do
          begin
            Prompt := TRemPrompt(FParent.FPrompts[i]);
            if(Prompt.PromptType = ptQuantity) then
            begin
              Qty := StrToIntDef(Prompt.GetValue, 1);
              if(Qty < 1) then Qty := 1;
              break;
            end;
          end;
        end;
      end;
      if (not Skip) then
      begin
        txt := Char(ord('A')+ord(PCECat)) +
                       GetPCEDataText(PCECat, Code, Cat, Nar, Primary, Qty);
        if(assigned(FParent) and FParent.Historical) then
          txt := txt + ' (Historical)';
        List.AddObject(txt, Self);
        inc(Result);
      end;
      if assigned(FParent) and assigned(FParent.FMSTPrompt) then
      begin
        txt := FParent.FMSTPrompt.Value;
        if txt <> '' then
        begin
          if FParent.FMSTPrompt.FMiscText = '' then
          begin
            i1 := 0;
            i2 := 2;
          end
          else
          begin
            i1 := 3;
            i2 := 4;
          end;
          for i := i1 to i2 do
            if txt = MSTDescTxt[i,1] then
            begin
              List.AddObject(Char( ord('A') + ord(pdcMST)) + MSTDescTxt[i,0], Self);
              break;
            end;
        end;
      end;
    end;
  end;

begin
  Result := 0;
  if(assigned(FChoicePrompt)) and (assigned(FChoices)) then
  begin
    If not assigned(FChoicesActiveDates) then
      begin
        for i := 0 to FChoices.Count - 1 do
        begin
          if (copy(FChoicePrompt.GetValue, i+1, 1) = '1') then
            Add(FChoices[i], TRemPCERoot(FChoices.Objects[i]))
        end
      end
    else  {if there are active dates for each choice then check them}
      begin
        If Self.FParent.Historical then
          EncDt := DateTimeToFMDateTime(Date)
        else
          EncDt := RemForm.PCEObj.VisitDateTime;
        k := 0;
        for i := 0 to FChoices.Count - 1 do
        begin
          for j := 0 to (TStringList(Self.FChoicesActiveDates[i]).Count - 1) do
          begin
            ActDt := StrToIntDef((Piece(TStringList(Self.FChoicesActiveDates[i]).Strings[j], ':', 1)),0);
            InActDt := StrToIntDef((Piece(TStringList(Self.FChoicesActiveDates[i]).Strings[j], ':', 2)),9999999);
            if (EncDt >= ActDt) and (EncDt <= InActDt) then
            begin
              if(copy(FChoicePrompt.GetValue, k+1,1) = '1') then
                Add(FChoices[i], TRemPCERoot(FChoices.Objects[i]));
              inc(k);
            end; {Active date check}
          end; {FChoicesActiveDates.Items[i] loop}
        end; {FChoices loop}
      end {FChoicesActiveDates check}
  end {FChoicePrompt and FChoices check}
  else
    Add(FRec3, FPCERoot); {Active dates for this are checked in TRemDlgElement.AddData}
end;

function TRemData.Category: string;
begin
  Result := Piece(FRec3, U, r3Cat);
end;

function TRemData.DataType: TRemDataType;
begin
  Result := Code2DataType(Piece(FRec3, U, r3Type));
end;

destructor TRemData.Destroy;
var
  i: integer;

begin
  if(assigned(FPCERoot)) then
    FPCERoot.Done(Self);
  if(assigned(FChoices)) then
  begin
    for i := 0 to FChoices.Count-1 do
    begin
      if(assigned(FChoices.Objects[i])) then
        TRemPCERoot(FChoices.Objects[i]).Done(Self);
    end;
  end;
  KillObj(@FChoices);
  inherited;
end;

function TRemData.DisplayWHResults: boolean;
begin
 Result :=False;
 if FRec3<>'' then
 Result := (Piece(FRec3, U, 6) <> '0');
end;

function TRemData.ExternalValue: string;
begin
  Result := Piece(FRec3, U, r3Code);
end;

function TRemData.InternalValue: string;
begin
  Result := Piece(FRec3, U, 6);
end;

function TRemData.Narrative: string;
begin
  Result := Piece(FRec3, U, r3Nar);
end;

{ TRemPrompt }

function TRemPrompt.Add2PN: boolean;
begin
  Result := FALSE;
  if (not Forced) and (PromptOK) then
    //if PromptOK then
    Result := (Piece(FRec4, U, 5) <> '1');
  if (Result=false) and (Piece(FRec4,U,4)='WH_NOT_PURP') then
    Result := True;
end;

function TRemPrompt.Caption: string;
begin
  Result := Piece(FRec4, U, 8);
  if(not FCaptionAssigned) then
  begin
    AssignFieldIDs(Result);
    SetPiece(FRec4, U, 8, Result);
    FCaptionAssigned := TRUE;
  end;
end;

constructor TRemPrompt.Create;
begin
  FOverrideType := ptUnknown;
end;

function TRemPrompt.Forced: boolean;
begin
  Result := (Piece(FRec4, U, 7) = 'F');
end;

function TRemPrompt.InternalValue: string;
var
  m, d, y: word;
  Code: string;

begin
  Result := Piece(FRec4, U, 6);
  Code := Piece(FRec4, U, 4);
  if(Code = RemPromptCodes[ptVisitDate]) then
  begin
    if(copy(Result,1,1) = MonthReqCode) then
    begin
      FMonthReq := TRUE;
      delete(Result,1,1);
    end;
    if(Result = '') then
    begin
      DecodeDate(Now, y, m, d);
      Result := inttostr(y-1700)+'0000';
      SetPiece(FRec4, U, 6, Result);
    end;
  end;
end;

procedure TRemPrompt.PromptChange(Sender: TObject);
var
  cbo: TORComboBox;
  pt: TRemPromptType;
  TmpValue, OrgValue: string;
  idx, i: integer;
  NeedRedraw: boolean;
  dte: TFMDateTime;
  whCKB: TWHCheckBox;
  //printoption: TORCheckBox;
  WHValue, WHValue1: String;
begin
  FParent.FReminder.BeginTextChanged;
  try
    FFromControl := TRUE;
    try
      TmpValue := GetValue;
      OrgValue := TmpValue;
      pt := PromptType;
      NeedRedraw := FALSE;
      case pt of
        ptComment, ptQuantity, ptSkinReading:
          TmpValue := (Sender as TEdit).Text;

        ptVisitDate:
          begin
            dte := (Sender as TORDateCombo).FMDate;
            while (dte > 2000000) and (dte > FMToday) do
            begin
              dte := dte - 10000;
              NeedRedraw := TRUE;
            end;
            TmpValue := FloatToStr(dte);
            if(TmpValue = '1000000') then
              TmpValue := '0';
          end;

        ptPrimaryDiag, ptAdd2PL, ptContraindicated:
          begin
            TmpValue := BOOLCHAR[(Sender as TORCheckBox).Checked];
            NeedRedraw := (pt = ptPrimaryDiag);
          end;

        ptVisitLocation:
          begin
            cbo := (Sender as TORComboBox);
            if(cbo.ItemIEN < 0) then
              NeedRedraw := (not cbo.DroppedDown)
            else
            begin
              if(cbo.ItemIndex <= 0) then
                cbo.Items[0] := '0' + U + cbo.text;
              TmpValue := cbo.ItemID;
              if(StrToIntDef(TmpValue,0) = 0) then
                TmpValue := cbo.Text;
            end;
          end;

        ptWHPapResult:
          begin
            if (Sender is TWHCheckBox) then
              begin
                whCKB := (Sender as TWHCheckBox);
                if whCKB.Checked = true then
                   begin
                   if whCKB.Caption ='NEM (No Evidence of Malignancy)' then FParent.WHResultChk := 'N';
                   if whCKB.Caption ='Abnormal' then FParent.WHResultChk := 'A';
                   if whCKB.Caption ='Unsatisfactory for Diagnosis' then FParent.WHResultChk := 'U';
                   //AGP Change 23.13 WH multiple processing
		   for i := 0 to FParent.FData.Count-1 do
                     begin
                        if Piece(TRemData(FParent.FData[i]).FRec3,U,4)='WHR' then
                           begin
                           FParent.FReminder.WHReviewIEN := Piece(TRemData(FParent.FData[i]).FRec3,U,6)
                           end;
                     end;
                   end
                else
                  begin
                    FParent.WHResultChk := '';
                    FParent.FReminder.WHReviewIEN := ''; //AGP CHANGE 23.13
                  end;
              end;
          end;


            ptWHNotPurp:
            begin
            if (Sender is TWHCheckBox) then
              begin
                whCKB := (Sender as TWHCheckBox);
                if whCKB.Checked = true then
                  begin
                    if whCKB.Caption ='Letter' then
                      begin
                        if FParent.WHResultNot='' then FParent.WHResultNot := 'L'
                        else
                          if Pos('L',FParent.WHResultNot)=0 then FParent.WHResultNot := FParent.WHResultNot +':L';
                        if whCKB.FButton <> nil then whCKB.FButton.Enabled := true;
                        if whCKB.FPrintNow <> nil then
                           begin
                             whCKB.FPrintVis :='1';
                             whCKB.FPrintNow.Enabled := true;
                           end;
                      end;
                    if whCKB.Caption ='In-Person' then
                       begin
                         if FParent.WHResultNot='' then FParent.WHResultNot := 'I'
                         else
                            if Pos('I',FParent.WHResultNot)=0 then FParent.WHResultNot := FParent.WHResultNot+':I';
                       end;
                    if whCKB.Caption ='Phone Call' then
                       begin
                         if FParent.WHResultNot='' then FParent.WHResultNot := 'P'
                         else
                           if Pos('P',FParent.WHResultNot)=0 then FParent.WHResultNot := FParent.WHResultNot+':P';
                        end;
                end
                else
                   begin
                     // this section is to handle unchecking of boxes and disabling print now and view button
                     WHValue := FParent.WHResultNot;
                       if whCKB.Caption ='Letter' then
                         begin
                           for i:=1 to Length(WHValue) do
                             begin
                              if WHValue1='' then
                                begin
                                  if (WHValue[i]<>'L') and (WHValue[i]<>':') then WHValue1 := WHValue[i];
                                end
                              else
                                if (WHValue[i]<>'L') and (WHValue[i]<>':') then WHValue1 := WHValue1+':'+WHValue[i];
                             end;
                         if (whCKB.FButton <> nil) and (whCKB.FButton.Enabled = true) then whCKB.FButton.Enabled := false;
                         if (whCKB.FPrintNow <> nil) and (whCKB.FPrintNow.Enabled = true) then
                            begin
                              whCKB.FPrintVis := '0';
                              if whCKB.FPrintNow.Checked = true then whCKB.FPrintNow.Checked := false;
                              whCKB.FPrintNow.Enabled := false;
                              FParent.WHPrintDevice := '';
                            end;
                         end;
                       if whCKB.Caption ='In-Person' then
                         begin
                           for i:=1 to Length(WHValue) do
                             begin
                               if WHValue1='' then
                                 begin
                                   if (WHValue[i]<>'I') and (WHValue[i]<>':') then WHValue1 := WHValue[i];
                                 end
                               else
                                 if (WHValue[i]<>'I') and (WHValue[i]<>':') then WHValue1 := WHValue1+':'+WHValue[i];
                             end;
                         end;
                       if whCKB.Caption ='Phone Call' then
                          begin
                            for i:=1 to Length(WHValue) do
                              begin
                                if WHValue1='' then
                                  begin
                                    if (WHValue[i]<>'P') and (WHValue[i]<>':') then WHValue1 := WHValue[i];
                                  end
                                else
                                  if (WHValue[i]<>'P') and (WHValue[i]<>':') then WHValue1 := WHValue1+':'+WHValue[i];
                              end;
                          end;
                     FParent.WHResultNot := WHValue1;
                   end;
                end
                else
                    if ((Sender as TORCheckBox)<>nil) and (Piece(FRec4,U,12)='1') then
                       begin
                          if (((Sender as TORCheckBox).Caption = 'Print Now') and
                             ((Sender as TORCheckBox).Enabled =true)) and ((Sender as TORCheckBox).Checked = true) and
                             (FParent.WHPrintDevice ='') then
                                begin
                                  FParent.WHPrintDevice := SelectDevice(Self, Encounter.Location, false, 'Women Health Print Device Selection');
                                  FPrintNow :='1';
                                  if FParent.WHPrintDevice ='' then
                                    begin
                                      FPrintNow :='0';
                                      (Sender as TORCheckBox).Checked := false;
                                    end;
                                end;
                          if (((Sender as TORCheckBox).Caption = 'Print Now') and
                             ((Sender as TORCheckBox).Enabled =true)) and ((Sender as TORCheckBox).Checked = false) then
                                begin
                                   FParent.WHPrintDevice := '';
                                   FPrintNow :='0';
                                end;
                       end;
        end;
        
        ptExamResults, ptSkinResults, ptLevelSeverity,
        ptSeries, ptReaction, ptLevelUnderstanding:
          TmpValue := (Sender as TORComboBox).ItemID;
        else
          if pt = ptVitalEntry then
          begin
            case (Sender as TControl).Tag of
              TAG_VITTEMPUNIT, TAG_VITHTUNIT, TAG_VITWTUNIT: idx := 2;
              TAG_VITPAIN: begin
                             idx := -1;
                             TmpValue := (Sender as TORComboBox).ItemID;
                           end;
              else
                idx := 1;
            end;
            if(idx > 0) then
              SetPiece(TmpValue, ';', idx, TORExposedControl(Sender).Text);
          end
          else
          if pt = ptDataList then
          begin
            TmpValue := (Sender as TORComboBox).CheckedString;
            NeedRedraw := TRUE;
          end
          else
          if pt = ptGAF then
            TmpValue := (Sender as TEdit).Text;
      end;
      if(TmpValue <> OrgValue) then
      begin
        if NeedRedraw then
          FParent.FReminder.BeginNeedRedraw;
        try
          SetValue(TmpValue);
        finally
          if NeedRedraw then
            FParent.FReminder.EndNeedRedraw(Self);
        end;
      end
      else
      if NeedRedraw then
      begin
        FParent.FReminder.BeginNeedRedraw;
        FParent.FReminder.EndNeedRedraw(Self);
      end;
    finally
      FFromControl := FALSE;
    end;
  finally
    FParent.FReminder.EndTextChanged(Sender);
  end;
  if(FParent.ElemType = etDisplayOnly) and (not assigned(FParent.FParent)) then
    RemindersInProcess.Notifier.Notify;
end;


procedure TRemPrompt.ComboBoxKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if(Key = VK_RETURN) and (Sender is TORComboBox) and
    ((Sender as TORComboBox).DroppedDown) then
    (Sender as TORComboBox).DroppedDown := FALSE;
end;

function TRemPrompt.PromptOK: boolean;
var
  pt: TRemPromptType;
  dt: TRemDataType;
  i: integer;

begin
  pt := PromptType;
  if(pt = ptUnknown) or (pt = ptMST) then
    Result := FALSE
  else
  if(pt = ptDataList) or (pt = ptVitalEntry) or (pt = ptMHTest) or (pt = ptGAF) or
  (pt = ptWHPapResult) then
    Result := TRUE
  else
  if(pt = ptSubComment) then
    Result := FParent.FHasComment
  else
  begin
    dt := RemPromptTypes[PromptType];
         if(dt = dtAll)        then Result := TRUE
    else if(dt = dtUnknown)    then Result := FALSE
    else if(dt = dtHistorical) then Result := FParent.Historical
    else
    begin
      Result := FALSE;
      if(assigned(FParent.FData)) then
      begin
        for i := 0 to FParent.FData.Count-1 do
        begin
          if(TRemData(FParent.FData[i]).DataType = dt) then
          begin
            Result := TRUE;
            break;
          end;
        end;
      end;
    end;
  end;
end;

function TRemPrompt.PromptType: TRemPromptType;
begin
  if(assigned(FData)) then
    Result := FOverrideType
  else
    Result := Code2PromptType(Piece(FRec4, U, 4));
end;


function TRemPrompt.Required: boolean;
var
  pt: TRemPromptType;

begin
  pt := PromptType;
  if(pt = ptVisitDate) then
    Result := TRUE
  else
  if(pt = ptSubComment) then
    Result := FALSE
  else
    Result := (Piece(FRec4, U, 10) = '1');
end;

function TRemPrompt.SameLine: boolean;
begin
  Result := (Piece(FRec4, U, 9) <> '1');
end;

function TRemPrompt.NoteText: string;
var
  pt: TRemPromptType;
  fmt, tmp, WHValue: string;
  cnt, i, j, k: integer;
  ActDt, InActDt: Double;
  EncDt: TFMDateTime;

begin
  Result := '';
  if Add2PN then
  begin
    pt := PromptType;
    tmp := GetValue;
    case pt of
      ptComment: Result := tmp;

      ptQuantity: if(StrToIntDef(tmp,1) <> 1) then
                    Result := tmp;

      ptSkinReading: if(StrToIntDef(tmp,0) <> 0) then
                       Result := tmp;

      ptVisitDate:
        begin
          try
            if(tmp <> '') and (tmp <> '0') and (length(Tmp) = 7) then
            begin
              if FMonthReq and (copy(tmp,4,2) = '00') then
                Result := ''
              else
              begin
                if(copy(tmp,4,4) = '0000') then
                  fmt := 'YYYY'
                else
                if(copy(tmp,6,2) = '00') then
                  fmt := 'MMMM, YYYY'
                else
                  fmt := 'MMMM D, YYYY';
                Result := FormatFMDateTimeStr(fmt, tmp);
              end;
            end;
          except
            on EConvertError do
              Result := tmp
            else
              raise;
          end;
        end;

      ptPrimaryDiag, ptAdd2PL, ptContraindicated:
        if(tmp = '1') then
          Result := ' ';

      ptVisitLocation:
        if(StrToIntDef(tmp, 0) = 0) then
        begin
          if(tmp <> '0') then
            Result := tmp;
        end
        else
          begin
          Result := GetPCEDisplayText(tmp, ComboPromptTags[pt]);
        end;

      ptWHPapResult:
        begin
         if Fparent.WHResultChk='N' then Result := 'NEM (No Evidence of Malignancy)';
         if Fparent.WHResultChk='A' then Result := 'Abnormal';
         if Fparent.WHResultChk='U' then Result := 'Unsatisfactory for Diagnosis';
         if FParent.WHResultChk='' then Result := '';
        end;

      ptWHNotPurp:
      begin
      if FParent.WHResultNot <> '' then
      begin
      WHValue := FParent.WHResultNot;
      //IF Forced = false then
      //begin
      if WHValue <> 'CPRS' then
      begin
      for cnt := 1 to Length(WHValue) do
          begin
          if Result ='' then
             begin
              if WHValue[cnt]='L' then Result := 'Letter';
              if WHValue[cnt]='I' then Result := 'In-Person';
              if WHValue[cnt]='P' then Result := 'Phone Call';
              end
          else
              begin
              if (WHValue[cnt]='L')and(Pos('Letter',Result)=0) then Result := Result+'; Letter';
              if (WHValue[cnt]='I')and(Pos('In-Person',Result)=0) then Result := Result+'; In-Person';
              if (WHValue[cnt]='P')and(Pos('Phone Call',Result)=0) then Result := Result+'; Phone Call';
              end;
          end;
       end;
      end
      else
      if Forced = true then
         begin
         if pos(':',Piece(FRec4,U,6))=0 then
           begin
           if Piece(FRec4,U,6)='L' then
             begin
             Result := 'Letter';
             FParent.WHResultNot :='L';
             end;
           if Piece(FRec4,U,6)='I' then
              begin
              Result := 'In-Person';
              FParent.WHResultNot := 'I';
              end;
           if Piece(FRec4,U,6)='P' then
              begin
              Result := 'Phone Call';
              FParent.WHResultNot := 'P';
              end;
           if Piece(FRec4,U,6)='CPRS' then
              begin
              Result := '';
              FParent.WHResultNot := 'CPRS';
              end;
           end
           else
           begin
           WHValue := Piece(FRec4,U,6);
           for cnt := 0 to Length(WHValue) do
          begin
          if Result ='' then
             begin
              if WHValue[cnt]='L' then
                begin
                Result := 'Letter';
                FParent.WHResultNot := WHValue[cnt];
                end;
              if WHValue[cnt]='I' then
                begin
                Result := 'In-Person';
                FParent.WHResultNot := WHValue[cnt];
                end;
              if WHValue[cnt]='P' then
                begin
                Result := 'Phone Call';
                FParent.WHResultNot := WHValue[cnt];
                end;
              end
          else
              begin
              if (WHValue[cnt]='L')and(Pos('Letter',Result)=0) then
                 begin
                 Result := Result +'; Letter';
                 FParent.WHResultNot := FParent.WHResultNot + ':' + WHValue[cnt];
                 end;
              if (WHValue[cnt]='I')and(Pos('In-Person',Result)=0) then
                 begin
                 Result := Result +'; In-Person';
                 FParent.WHResultNot := FParent.WHResultNot + ':' + WHValue[cnt];
                 end;
              if (WHValue[cnt]='P')and(Pos('Phone Call',Result)=0) then
                 begin
                 Result := Result +'; Phone Call';
                 FParent.WHResultNot := FParent.WHResultNot + ':' + WHValue[cnt];
                 end;
              end;
          end;

         end;
      end
      else
      Result := '';
    end;

      ptExamResults, ptSkinResults, ptLevelSeverity,
      ptSeries, ptReaction, ptLevelUnderstanding:
        begin
          Result := tmp;
          if(Piece(Result,U,1) = '@') then
            Result := ''
          else
            Result := GetPCEDisplayText(tmp, ComboPromptTags[pt]);
        end;

      else
      begin
        if pt = ptDataList then
        begin
          if(assigned(FData) and assigned(FData.FChoices)) then
          begin
            if not(assigned(FData.FChoicesActiveDates)) then
              for i := 0 to FData.FChoices.Count - 1 do
                begin
                  if(copy(tmp,i+1,1) = '1') then
                    begin
                      if (Result <> '') then
                        Result := Result + ', ';
                      Result := Result + Piece(FData.FChoices[i],U,12);
                    end;
                end
            else   {if there are active dates for each choice then check them}
              begin
                if Self.FParent.Historical then
                  EncDt := DateTimeToFMDateTime(Date)
                else
                  EncDt := RemForm.PCEObj.VisitDateTime;
                k := 0;
                for i := 0 to FData.FChoices.Count - 1 do
                begin
                  for j := 0 to (TStringList(FData.FChoicesActiveDates[i]).Count - 1) do
                  begin
                    ActDt := StrToIntDef((Piece(TStringList(FData.FChoicesActiveDates[i]).Strings[j], ':', 1)),0);
                    InActDt := StrToIntDef((Piece(TStringList(FData.FChoicesActiveDates[i]).Strings[j], ':', 2)),9999999);
                    if (EncDt >= ActDt) and (EncDt <= InActDt) then
                    begin
                      if(copy(tmp,k+1,1) = '1') then
                      begin
                        if(Result <> '') then
                          Result := Result + ', ';
                        Result := Result + Piece(FData.FChoices[i],U,12);
                      end;
                      inc(k);
                    end;  {ActiveDate check}
                  end;  {FChoicesActiveDates.Items[i] loop}
                end;  {FChoices loop}
            end;
          end;
        end
        else
        if pt = ptVitalEntry then
        begin
          Result := VitalValue;
          if(Result <> '') then
            Result := ConvertVitalData(Result, VitalType, VitalUnitValue);
        end
        else
        if pt = ptMHTest then
          Result := FMiscText
        else
        if pt = ptGAF then
        begin
          if(StrToIntDef(Piece(tmp, U, 1),0) <> 0) then
          begin
            Result := tmp;
            (*
            GafDate := Trunc(FParent.FReminder.PCEDataObj.VisitDateTime);
            ValidateGAFDate(GafDate);
            Result := tmp + CRCode + 'Date Determined: ' + FormatFMDateTime('mm/dd/yyyy', GafDate) +
                            CRCode + 'Determined By: ' + FParent.FReminder.PCEDataObj.Providers.PCEProviderName;
            *)
          end;
        end;
      end;

    end;
    if(Result <> '') and (Caption <> '') then
      Result := Trim(Caption + ' ' + Trim(Result));
  end;
end;

function TRemPrompt.CanShare(Prompt: TRemPrompt): boolean;
var
  pt: TRemPromptType;

begin
  if(Forced or Prompt.Forced or Prompt.FIsShared or Required or Prompt.Required) then
    Result := FALSE
  else
  begin
    pt := PromptType;
    Result := (pt = Prompt.PromptType);
    if(Result) then
    begin
      if(pt in [ptAdd2PL, ptLevelUnderstanding]) or
        ((pt = ptComment) and (not FParent.FHasSubComments)) then
        Result := ((Add2PN = Prompt.Add2PN) and
                   (Caption = Prompt.Caption))
      else
        Result := FALSE;
    end;
  end;
end;

destructor TRemPrompt.Destroy;
begin
  KillObj(@FSharedChildren);
  inherited;
end;

function TRemPrompt.RemDataActive(RData: TRemData; EncDt: TFMDateTime):Boolean;
var
  ActDt, InActDt: Double;
  j: integer;

begin
  Result := FALSE;
  if assigned(RData.FActiveDates) then
    for j := 0 to (RData.FActiveDates.Count - 1) do
      begin
        ActDt := StrToIntDef(Piece(RData.FActiveDates[j],':',1), 0);
        InActDt := StrToIntDef(Piece(RData.FActiveDates[j], ':', 2), 9999999);
        if (EncDt >= ActDt) and (EncDt <= InActDt) then
          begin
            Result := TRUE;
            Break;
          end;
      end
  else
    Result := TRUE;
end;

function TRemPrompt.RemDataChoiceActive(RData: TRemData; j: integer; EncDt: TFMDateTime):Boolean;
var
  ActDt, InActDt: Double;
  i: integer;
begin
  Result := FALSE;
  If not assigned(RData.FChoicesActiveDates) then //if no active dates were sent
    Result := TRUE                               //from the server then don't check dates
  else  {if there are active dates for each choice then check them}
    begin
      for i := 0 to (TStringList(RData.FChoicesActiveDates[j]).Count - 1) do
        begin
          ActDt := StrToIntDef((Piece(TStringList(RData.FChoicesActiveDates[j]).Strings[i], ':', 1)),0);
          InActDt := StrToIntDef((Piece(TStringList(RData.FChoicesActiveDates[j]).Strings[i], ':', 2)),9999999);
          if (EncDt >= ActDt) and (EncDt <= InActDt) then
          begin
            Result := True;
          end; {Active date check}
        end; {FChoicesActiveDates.Items[i] loop}
    end {FChoicesActiveDates check}
end;

function TRemPrompt.GetValue: string;
//Returns TRemPrompt.FValue if this TRemPrompt is not a ptPrimaryDiag
//Returns 0-False or 1-True if this TRemPrompt is a ptPrimaryDiag
var
  i, j, k: integer;
  RData: TRemData;
  Ok: boolean;
  EncDt:  TFMDateTime;

begin
  OK := (Piece(FRec4, U, 4) = RemPromptCodes[ptPrimaryDiag]);
  if(OK) and (assigned(FParent)) then
    OK := (not FParent.Historical);
  if OK then
  begin
    Ok := FALSE;
    if(assigned(FParent) and assigned(FParent.FData)) then {If there's FData, see if}
    begin                                                  {there's a primary diagnosis}
      for i := 0 to FParent.FData.Count-1 do               {if there is return True}
      begin
        EncDt := RemForm.PCEObj.VisitDateTime;     
        RData := TRemData(FParent.FData[i]);
        if(RData.DataType = dtDiagnosis) then
        begin
          if(assigned(RData.FPCERoot)) and (RemDataActive(RData, EncDt)) then
            Ok := (RData.FPCERoot = PrimaryDiagRoot)
          else
          if(assigned(RData.FChoices)) and (assigned(RData.FChoicePrompt)) then
          begin
            k := 0;
            for j := 0 to RData.FChoices.Count-1 do
            begin
             if RemDataChoiceActive(RData, j, EncDt) then
             begin                                             
              if(assigned(RData.FChoices.Objects[j])) and
                (copy(RData.FChoicePrompt.FValue,k+1,1)='1') then
              begin
                if(TRemPCERoot(RData.FChoices.Objects[j]) = PrimaryDiagRoot) then
                begin
                  Ok := TRUE;
                  break;
                end;
              end; //if FChoices.Objects (which is the RemPCERoot object) is assigned
              inc(k);
             end; //if FChoices[j] is active                       
            end; //loop through FChoices
          end; //If there are FChoices and an FChoicePrompt (i.e.: is this a ptDataList}
        end;
        if Ok then break;
      end;
    end;
    Result := BOOLCHAR[Ok];
  end
  else
    Result := FValue;
end;



procedure TRemPrompt.SetValue(Value: string);
var
  pt: TRemPromptType;
  i, j, k : integer;
  RData: TRemData;
  Primary, Done: boolean;
  Tmp: string;
  OK, NeedRefresh: boolean;
  EncDt:  TFMDateTime;

begin
  NeedRefresh := (not FFromControl);
  if(Forced and (not FFromParent)) then exit;
  pt := PromptType;
  if(pt = ptVisitDate) then
  begin
    if(Value = '') then
      Value := '0'
    else
    begin
      try
        if(StrToFloat(Value) > FMToday) then
        begin
          Value := '0';
          InfoBox('Can not enter a future date for a historical event.',
                  'Invalid Future Date', MB_OK + MB_ICONERROR);
        end;
      except
        on EConvertError do
          Value := '0'
        else
          raise;
      end;
      if(Value = '0') then
        NeedRefresh := TRUE;
    end;
  end;
  if(GetValue <> Value) or (FFromParent) then
  begin
    FValue := Value;
    EncDt := RemForm.PCEObj.VisitDateTime;
    if((pt = ptExamResults) and assigned(FParent) and assigned(FParent.FData) and
       (FParent.FData.Count > 0) and assigned(FParent.FMSTPrompt)) then
    begin
      FParent.FMSTPrompt.SetValueFromParent(Value);
      if (FParent.FMSTPrompt.FMiscText = '') then
      // Assumes first finding item is MST finding
        FParent.FMSTPrompt.FMiscText := TRemData(FParent.FData[0]).InternalValue;
    end;

    OK := (assigned(FParent) and assigned(FParent.FData) and
          (Piece(FRec4, U, 4) = RemPromptCodes[ptPrimaryDiag]));
    if OK then
      OK := (not FParent.Historical);
    if OK then
    begin
      Done := FALSE;
      Primary := (Value = BOOLCHAR[TRUE]);
      for i := 0 to FParent.FData.Count-1 do
      begin
        RData := TRemData(FParent.FData[i]);
        if(RData.DataType = dtDiagnosis) then
        begin
          if(assigned(RData.FPCERoot)) and (RemDataActive(RData, EncDt)) then
          begin
            if(Primary) then
            begin
              PrimaryDiagRoot := RData.FPCERoot;
              Done := TRUE;
            end
            else
            begin
              if(PrimaryDiagRoot = RData.FPCERoot) then
              begin
                PrimaryDiagRoot := nil;
                Done := TRUE;
              end;
            end;
          end
          else
          if(assigned(RData.FChoices)) and (assigned(RData.FChoicePrompt)) then
          begin
            k := 0;                                                
            for j := 0 to RData.FChoices.Count-1 do
            begin
             if RemDataChoiceActive(RData, j, EncDt) then
             begin                                             
              if(Primary) then
              begin
                if(assigned(RData.FChoices.Objects[j])) and  
                  (copy(RData.FChoicePrompt.FValue,k+1,1)='1') then
                begin
                  PrimaryDiagRoot := TRemPCERoot(RData.FChoices.Objects[j]);
                  Done := TRUE;
                  break;
                end;
              end
              else
              begin
                if(assigned(RData.FChoices.Objects[j])) and
                  (PrimaryDiagRoot = TRemPCERoot(RData.FChoices.Objects[j])) then
                begin
                  PrimaryDiagRoot := nil;
                  Done := TRUE;
                  break;
                end;
              end;
              inc(k);
             end;                                       
            end;
          end;
        end;
        if Done then break;
      end;
    end;
    if(assigned(FParent) and assigned(FParent.FData) and IsSyncPrompt(pt)) then
    begin
      for i := 0 to FParent.FData.Count-1 do    
      begin
        RData := TRemData(FParent.FData[i]); 
        if(assigned(RData.FPCERoot)) and (RemDataActive(RData, EncDt)) then 
          RData.FPCERoot.Sync(Self);
        if(assigned(RData.FChoices)) then
        begin
          for j := 0 to RData.FChoices.Count-1 do
          begin
            if(assigned(RData.FChoices.Objects[j])) and
                      RemDataChoiceActive(RData, j, EncDt) then
              TRemPCERoot(RData.FChoices.Objects[j]).Sync(Self);
          end;
        end;
      end;
    end;
  end;
  if(not NeedRefresh) then
    NeedRefresh := (GetValue <> Value);
  if(NeedRefresh and assigned(FCurrentControl) and FParent.FReminder.Visible) then
  begin
    case pt of
      ptComment:
        (FCurrentControl as TEdit).Text := GetValue;

      ptQuantity:
        (FCurrentControl as TUpDown).Position := StrToIntDef(GetValue,1);

      ptSkinReading:
        (FCurrentControl as TUpDown).Position := StrToIntDef(GetValue,0);

      ptVisitDate:
        begin
          try
            (FCurrentControl as TORDateCombo).FMDate := StrToFloat(GetValue);
          except
            on EConvertError do
              (FCurrentControl as TORDateCombo).FMDate := 0;
            else
              raise;
          end;
        end;

      ptPrimaryDiag, ptAdd2PL, ptContraindicated:
        (FCurrentControl as TORCheckBox).Checked := (GetValue = BOOLCHAR[TRUE]);

      ptVisitLocation:
        begin
          Tmp := GetValue;
          with (FCurrentControl as TORComboBox) do
          begin
            if(piece(Tmp,U,1)= '0') then
            begin
              Items[0] := Tmp;
              SelectByID('0');
            end
            else
              SelectByID(Tmp);
          end;
        end;

      ptWHPapResult:
        (FCurrentControl as TORCheckBox).Checked := (GetValue = BOOLCHAR[TRUE]);

       ptWHNotPurp:
        (FCurrentControl as TORCheckBox).Checked := (GetValue = BOOLCHAR[TRUE]);

      ptExamResults, ptSkinResults, ptLevelSeverity,
      ptSeries, ptReaction, ptLevelUnderstanding:
        (FCurrentControl as TORComboBox).SelectByID(GetValue);

      else
        if(pt = ptVitalEntry) then
        begin
          if(FCurrentControl is TORComboBox) then
            (FCurrentControl as TORComboBox).SelectByID(VitalValue)
          else
          if(FCurrentControl is TVitalEdit) then
          begin
            with (FCurrentControl as TVitalEdit) do
            begin
              Text := VitalValue;
              if(assigned(FLinkedCombo)) then
              begin
                Tmp := VitalUnitValue;
                if(Tmp <> '') then
                  FLinkedCombo.Text := VitalUnitValue
                else
                  FLinkedCombo.ItemIndex := 0;
              end;
            end;
          end;
        end;
    end;
  end;
end;


procedure TRemPrompt.SetValueFromParent(Value: string);
begin
  FFromParent := TRUE;
  try
    SetValue(Value);
  finally
    FFromParent := FALSE;
  end;
end;

procedure TRemPrompt.InitValue;
var
  Value: string;
  pt: TRemPromptType;
  idx, i, j: integer;
  TempSL: TORStringList;
  Found: boolean;
  RData: TRemData;

begin
  Value := InternalValue;
  pt := PromptType;
  if(ord(pt) >= ord(low(TRemPromptType))) and (ComboPromptTags[pt] <> 0) then
  begin
    TempSL := TORStringList.Create;
    try
      GetPCECodes(TempSL, ComboPromptTags[pt]);
      idx := TempSL.CaseInsensitiveIndexOfPiece(Value, U, 1);
      if(idx < 0) then
        idx := TempSL.CaseInsensitiveIndexOfPiece(Value, U, 2);
      if(idx >= 0) then
        Value := Piece(TempSL[idx],U,1);
    finally
      TempSL.Free;
    end;
  end;
  if((not Forced) and assigned(FParent) and assigned(FParent.FData) and IsSyncPrompt(pt)) then
  begin
    Found := FALSE;
    for i := 0 to FParent.FData.Count-1 do
    begin
      RData := TRemData(FParent.FData[i]);
      if(assigned(RData.FPCERoot)) then
        Found := RData.FPCERoot.GetValue(pt, Value);
      if(not Found) and (assigned(RData.FChoices)) then
      begin
        for j := 0 to RData.FChoices.Count-1 do
        begin
          if(assigned(RData.FChoices.Objects[j])) then
          begin
            Found := TRemPCERoot(RData.FChoices.Objects[j]).GetValue(pt, Value);
            if(Found) then break;
          end;
        end;
      end;
      if(Found) then break;
    end;
  end;
  FInitializing := TRUE;
  try
    SetValueFromParent(Value);
  finally
    FInitializing := FALSE;
  end;
end;

function TRemPrompt.ForcedCaption: string;
var
  pt: TRemPromptType;

begin
  Result := Caption;
  if(Result = '') then
  begin
    pt := PromptType;
    if(pt = ptDataList) then
    begin
      if(assigned(FData)) then
      begin
        if(FData.DataType = dtDiagnosis) then
          Result := 'Diagnosis'
        else
        if(FData.DataType = dtProcedure) then
          Result := 'Procedure';
      end;
    end
    else
    if(pt = ptVitalEntry) then
      Result := VitalDesc[VitalType] + ':'
    else
    if(pt = ptMHTest) then
      Result := 'Perform ' + FData.Narrative
    else
    if(pt = ptGAF) then
      Result := 'GAF Score'
    else
      Result := PromptDescriptions[pt];
    if(Result = '') then Result := 'Prompt';
  end;
  if(copy(Result,length(Result),1) = ':') then
    delete(Result,length(Result),1);
end;

function TRemPrompt.VitalType: TVitalType;
begin
  Result := vtUnknown;
  if(assigned(FData)) then
    Result := Code2VitalType(FData.InternalValue);
end;

procedure TRemPrompt.VitalVerify(Sender: TObject);
var
  vEdt: TVitalEdit;
  vCbo: TVitalComboBox;
  AObj: TWinControl;

begin
  if(Sender is TVitalEdit) then
  begin
    vEdt := TVitalEdit(Sender);
    vCbo := vEdt.FLinkedCombo;
  end
  else
  if(Sender is TVitalComboBox) then
  begin
    vCbo := TVitalComboBox(Sender);
    vEdt := vCbo.FLinkedEdit;
  end
  else
  begin
    vCbo := nil;
    vEdt := nil;
  end;
  AObj := Screen.ActiveControl;
  if((not assigned(AObj)) or ((AObj <> vEdt) and (AObj <> vCbo))) then
  begin
    if(vEdt.Tag = TAG_VITHEIGHT) then
      vEdt.Text := ConvertHeight2Inches(vEdt.Text);
    if VitalInvalid(vEdt, vCbo) then
      vEdt.SetFocus;
  end;
end;

function TRemPrompt.VitalUnitValue: string;
var
  vt: TVitalType;

begin
  vt := VitalType;
  if (vt in [vtTemp, vtHeight, vtWeight]) then
  begin
    Result := Piece(GetValue,';',2);
    if(Result = '') then
    begin
      case vt of
        vtTemp:   Result := 'F';
        vtHeight: Result := 'IN';
        vtWeight: Result := 'LB';
      end;
      SetPiece(FValue, ';', 2, Result);
    end;
  end
  else
    Result := '';
end;

function TRemPrompt.VitalValue: string;
begin
  Result := Piece(GetValue,';',1);
end;

procedure TRemPrompt.DoWHReport(Sender: TObject);
Var
comp, ien: string;
i: integer;
begin
   for i := 0 to FParent.FData.Count-1 do
      begin
        comp:= Piece(TRemData(FParent.FData[i]).FRec3,U,4);
        ien:= Piece(TRemData(FParent.FData[i]).FRec3,U,6);
      end;
    CallV('ORQQPXRM GET WH REPORT TEXT', [ien]);
    ReportBox(RPCBrokerV.Results,'Procedure Report Results',True);
end;

procedure TRemPrompt.ViewWHText(Sender: TObject);
var
WHRecNum, WHTitle: string;
i: integer;
begin
  for i := 0 to FParent.FData.Count-1 do
     begin
     if Piece(TRemData(FParent.FData[i]).FRec3,U,4)='WH' then
        begin
        WHRecNum:=(Piece(TRemData(FParent.FData[i]).FRec3,U,6));
        WHTitle :=(Piece(TRemData(FParent.FData[i]).FRec3,U,8));
        end;
     end;
  CallV('ORQQPXRM GET WH LETTER TEXT', [WHRecNum]);
  ReportBox(RPCBrokerV.Results,'Women Health Notification Purpose: '+WHTitle,false);
end;

procedure TRemPrompt.DoMHTest(Sender: TObject);
var
  TmpSL: TStringList;
  i: integer;
  Before, After: string;

begin
  if(MHTestAuthorized(FData.Narrative)) then
  begin
    FParent.FReminder.BeginTextChanged;
    try
      if(FParent.IncludeMHTestInPN) then
        TmpSL := TStringList.Create
      else
        TmpSL := nil;
      Before := GetValue;
      After := PerformMHTest(Before, FData.Narrative, TmpSL);
      if(Before <> After) then
      begin
        if(After = '') or (FParent.ResultDlgID = 0) then
          FMiscText := ''
        else
        begin
          MentalHealthTestResults(FMiscText, FParent.ResultDlgID, FData.Narrative,
                                  FParent.FReminder.FPCEDataObj.Providers.PCEProvider, After);
          if(assigned(TmpSL) and (TmpSL.Count > 0)) then
          begin
            if(FMiscText <> '') then
              FMiscText := FMiscText + CRCode + CRCode;
            for i := 0 to TmpSL.Count-1 do
            begin
              if(i > 0) then
                FMiscText := FMiscText + CRCode + CRCode;
              FMiscText := FMiscText + TmpSL[i];
            end;
          end;
          ExpandTIUObjects(FMiscText);
        end;
        SetValue(After);
      end;
    finally
      FParent.FReminder.EndTextChanged(Sender);
    end;
    if(FParent.ElemType = etDisplayOnly) and (not assigned(FParent.FParent)) then
      RemindersInProcess.Notifier.Notify;
  end
  else
    InfoBox('Not Authorized to score the ' + FData.Narrative + ' test.',
            'Insufficient Authorization', MB_OK + MB_ICONERROR);
end;

procedure TRemPrompt.GAFHelp(Sender: TObject);
begin
  inherited;
  GotoWebPage(GAFURL);
end;

function TRemPrompt.EntryID: string;
begin
  Result := FParent.EntryID + '/' + IntToStr(integer(Self));
end;

procedure TRemPrompt.EditKeyPress(Sender: TObject; var Key: Char);
begin
  if (Key = '?') and (Sender is TCustomEdit) and
    ((TCustomEdit(Sender).Text = '') or (TCustomEdit(Sender).SelStart = 0)) then
    Key := #0;
end;

{ TRemPCERoot }

destructor TRemPCERoot.Destroy;
begin
  KillObj(@FData);
  KillObj(@FForcedPrompts);
  inherited;
end;

procedure TRemPCERoot.Done(Data: TRemData);
var
  i, idx: integer;

begin
  if(assigned(FForcedPrompts) and assigned(Data.FParent) and
     assigned(Data.FParent.FPrompts)) then
  begin
    for i := 0 to Data.FParent.FPrompts.Count-1 do
      UnSync(TRemPrompt(Data.FParent.FPrompts[i]));
  end;
  FData.Remove(Data);
  if(FData.Count <= 0) then
  begin
    idx := PCERootList.IndexOfObject(Self);
//    if(idx < 0) then
  //    idx := PCERootList.IndexOf(FID);
    if(idx >= 0) then
      PCERootList.Delete(idx);
    if PrimaryDiagRoot = Self then
      PrimaryDiagRoot := nil;
    Free;
  end;
end;

class function TRemPCERoot.GetRoot(Data: TRemData; Rec3: string;
                                   Historical: boolean): TRemPCERoot;
var
  DID: string;
  Idx: integer;
  obj: TRemPCERoot;

begin
  if(Data.DataType = dtVitals) then
    DID := 'V' + Piece(Rec3, U, 6)
  else
  begin
    if(Historical) then
    begin
      inc(HistRootCount);
      DID := IntToStr(HistRootCount);
    end
    else
      DID := '0';
    DID := DID + U +
           Piece(Rec3, U, r3Type) + U +
           Piece(Rec3, U, r3Code) + U +
           Piece(Rec3, U, r3Cat)  + U +
           Piece(Rec3, U, r3Nar);
  end;
  idx := -1;
  if(not assigned(PCERootList)) then
    PCERootList := TStringList.Create
  else
  if(PCERootList.Count > 0) then
    idx := PCERootList.IndexOf(DID);
  if(idx < 0) then
  begin
    obj := TRemPCERoot.Create;
    try
      obj.FData := TList.Create;
      obj.FID := DID;
      idx := PCERootList.AddObject(DID, obj);
    except
      obj.Free;
      raise;
    end;
  end;
  Result := TRemPCERoot(PCERootList.Objects[idx]);
  Result.FData.Add(Data);
end;

function TRemPCERoot.GetValue(PromptType: TRemPromptType; var NewValue: string): boolean;
var
  ptS: string;
  i: integer;

begin
  ptS := char(ord('D') + ord(PromptType));
  i := pos(ptS, FValueSet);
  if(i = 0) then
    Result := FALSE
  else
  begin
    NewValue := Piece(FValue, U, i);
    Result := TRUE;
  end;
end;

procedure TRemPCERoot.Sync(Prompt: TRemPrompt);
var
  i, j: integer;
  RData: TRemData;
  Prm: TRemPrompt;
  pt: TRemPromptType;
  ptS, Value: string;

begin
//  if(assigned(Prompt.FParent) and ((not Prompt.FParent.FChecked) or
//    (Prompt.FParent.ElemType = etDisplayOnly))) then exit;
  if(assigned(Prompt.FParent) and (not Prompt.FParent.FChecked)) then exit;
  pt := Prompt.PromptType;
  Value := Prompt.GetValue;
  if(Prompt.Forced) then
  begin
    if(not Prompt.FInitializing) then
    begin
      if(not assigned(FForcedPrompts)) then
        FForcedPrompts := TStringList.Create;
      if(FForcedPrompts.IndexOfObject(Prompt) < 0) then
      begin
        for i := 0 to FForcedPrompts.Count-1 do
        begin
          Prm := TRemPrompt(FForcedPrompts.Objects[i]);
          if(pt = Prm.PromptType) and (FForcedPrompts[i] <> Value) and (Prm.FParent.IsChecked) then
            raise EForcedPromptConflict.Create('Forced Value Error:' + CRLF + CRLF +
                  Prompt.ForcedCaption + ' is already being forced to another value.');
        end;
        FForcedPrompts.AddObject(Value, Prompt);
      end;
    end;
  end
  else
  begin
    if(assigned(FForcedPrompts)) then
    begin
      for i := 0 to FForcedPrompts.Count-1 do
      begin
        Prm := TRemPrompt(FForcedPrompts.Objects[i]);
        if(pt = Prm.PromptType) and (FForcedPrompts[i] <> Value) and (Prm.FParent.IsChecked) then
        begin
          Prompt.SetValue(FForcedPrompts[i]);
          if(assigned(Prompt.FParent)) then
            Prompt.FParent.cbClicked(nil); // Forces redraw
          exit;
        end;
      end;
    end;
  end;
  if(Prompt.FInitializing) then exit;
  for i := 0 to FData.Count-1 do
    inc(TRemData(FData[i]).FSyncCount);
  ptS := char(ord('D') + ord(pt));
  i := pos(ptS, FValueSet);
  if(i = 0) then
  begin
    FValueSet := FValueSet + ptS;
    i := length(FValueSet);
  end;
  SetPiece(FValue, U, i, Value);
  for i := 0 to FData.Count-1 do
  begin
    RData := TRemData(FData[i]);
    if(RData.FSyncCount = 1) and (assigned(RData.FParent)) and
      (assigned(RData.FParent.FPrompts)) then
    begin
      for j := 0 to RData.FParent.FPrompts.Count-1 do
      begin
        Prm := TRemPrompt(RData.FParent.FPrompts[j]);
        if(Prm <> Prompt) and (pt = Prm.PromptType) and (not Prm.Forced) then
          Prm.SetValue(Prompt.GetValue);
      end;
    end;
  end;
  for i := 0 to FData.Count-1 do
  begin
    RData := TRemData(FData[i]);
    if(RData.FSyncCount > 0) then
      dec(RData.FSyncCount);
  end;
end;

procedure TRemPCERoot.UnSync(Prompt: TRemPrompt);
var
  idx: integer;

begin
  if(assigned(FForcedPrompts) and Prompt.Forced) then
  begin
    idx := FForcedPrompts.IndexOfObject(Prompt);
    if(idx >= 0) then
      FForcedPrompts.Delete(Idx);
  end;
end;

initialization
  InitReminderObjects;

finalization
  FreeReminderObjects;

end.
