Context Navigation

uReminders.pas@ 1115

Last change on this file since 1115 was 460, checked in by Kevin Toppenberg, 17 years ago
Uploading from OR_30_258
File size: 211.5 KB

Rev	Line
[459]	1	unit uReminders;
	2
	3	interface
	4
	5	uses
	6	Windows, Messages, Classes, Controls, StdCtrls, SysUtils, ComCtrls, Menus,
	7	Graphics, Forms, ORClasses, ORCtrls, ORDtTm, ORFn, ORNet, Dialogs, uPCE, uVitals,
	8	ExtCtrls, fDrawers, fDeviceSelect;
	9
	10	type
	11	TReminderDialog = class(TObject)
	12	private
	13	FDlgData: string;
	14	FElements: TStringList; // list of TRemDlgElement objects
	15	FOnNeedRedraw: TNotifyEvent;
	16	FNeedRedrawCount: integer;
	17	FOnTextChanged: TNotifyEvent;
	18	FTextChangedCount: integer;
	19	FPCEDataObj: TPCEData;
	20	FNoResolve: boolean;
	21	FWHReviewIEN: string; // AGP CHANGE 23.13 Allow for multiple processing of WH Review of Result Reminders
[460]	22	FRemWipe: integer;
[459]	23	protected
	24	function GetIEN: string; virtual;
	25	function GetPrintName: string; virtual;
	26	procedure BeginNeedRedraw;
	27	procedure EndNeedRedraw(Sender: TObject);
	28	procedure BeginTextChanged;
	29	procedure EndTextChanged(Sender: TObject);
	30	function GetDlgSL: TORStringList;
	31	procedure ComboBoxResized(Sender: TObject);
	32	procedure ComboBoxCheckedText(Sender: TObject; NumChecked: integer; var Text: string);
	33	function AddData(Lst: TStrings; Finishing: boolean = FALSE; Historical: boolean = FALSE): integer;
	34	function Visible: boolean;
	35	public
	36	constructor BaseCreate;
	37	constructor Create(ADlgData: string);
	38	destructor Destroy; override;
	39	procedure FinishProblems(List: TStrings; var MissingTemplateFields: boolean);
	40	function BuildControls(ParentWidth: integer; AParent, AOwner: TWinControl): TWinControl;
	41	function Processing: boolean;
	42	procedure AddText(Lst: TStrings);
	43	property PrintName: string read GetPrintName;
	44	property IEN: string read GetIEN;
	45	property Elements: TStringList read FElements;
	46	property OnNeedRedraw: TNotifyEvent read FOnNeedRedraw write FOnNeedRedraw;
	47	property OnTextChanged: TNotifyEvent read FOnTextChanged write FOnTextChanged;
	48	property PCEDataObj: TPCEData read FPCEDataObj write FPCEDataObj;
	49	property DlgData: string read FDlgData; //AGP Change 24.8
	50	property WHReviewIEN: string read FWHReviewIEN write FWHReviewIEN; //AGP CHANGE 23.13
[460]	51	property RemWipe: integer read FRemWipe write FRemWipe;
[459]	52	end;
	53
	54	TReminder = class(TReminderDialog)
	55	private
	56	FRemData: string;
	57	FCurNodeID: string;
	58	protected
	59	function GetDueDateStr: string;
	60	function GetLastDateStr: string;
	61	function GetIEN: string; override;
	62	function GetPrintName: string; override;
	63	function GetPriority: integer;
	64	function GetStatus: string;
	65	public
	66	constructor Create(ARemData: string);
	67	property DueDateStr: string read GetDueDateStr;
	68	property LastDateStr: string read GetLastDateStr;
	69	property Priority: integer read GetPriority;
	70	property Status: string read GetStatus;
	71	property RemData: string read FRemData;
	72	property CurrentNodeID: string read FCurNodeID write FCurNodeID;
	73	end;
	74
	75	TRDChildReq = (crNone, crOne, crAtLeastOne, crNoneOrOne);
	76	TRDElemType = (etCheckBox, etTaxonomy, etDisplayOnly);
	77
	78	TRemPrompt = class;
	79
	80	TRemDlgElement = class(TObject)
	81	private
	82	FReminder: TReminderDialog;
	83	FParent: TRemDlgElement;
	84	FChildren: TList; // Points to other TRemDlgElement objects
	85	FData: TList; // List of TRemData objects
	86	FPrompts: TList; // list of TRemPrompts objects
	87	FText: string;
	88	FPNText: string;
	89	FRec1: string;
	90	FID: string;
	91	FDlgID: string;
	92	FHaveData: boolean;
	93	FTaxID: string;
	94	FChecked: boolean;
	95	FChildrenShareChecked: boolean;
	96	FHasSharedPrompts: boolean;
	97	FHasComment: boolean;
	98	FHasSubComments: boolean;
	99	FCommentPrompt: TRemPrompt;
	100	FFieldValues: TORStringList;
	101	FMSTPrompt: TRemPrompt;
	102	FWHPrintDevice, FWHResultChk, FWHResultNot: String;
[460]	103	FVitalDateTime: TFMDateTime; //AGP Changes 26.1
[459]	104	protected
	105	procedure Check4ChildrenSharedPrompts;
	106	function ShowChildren: boolean;
	107	function EnableChildren: boolean;
	108	function Enabled: boolean;
	109	procedure SetChecked(const Value: boolean);
	110	procedure UpdateData;
	111	procedure GetData;
	112	function TrueIndent: integer;
	113	procedure cbClicked(Sender: TObject);
	114	procedure FieldPanelEntered(Sender: TObject);
	115	procedure FieldPanelExited(Sender: TObject);
	116	procedure FieldPanelKeyPress(Sender: TObject; var Key: Char);
	117	procedure FieldPanelOnClick(Sender: TObject);
	118	procedure FieldPanelLabelOnClick(Sender: TObject);
	119
	120	function BuildControls(var Y: integer; ParentWidth: integer;
	121	BaseParent, AOwner: TWinControl): TWinControl;
	122	function AddData(Lst: TStrings; Finishing: boolean; AHistorical: boolean = FALSE): integer;
	123	procedure FinishProblems(List: TStrings);
	124	function IsChecked: boolean;
	125	procedure SubCommentChange(Sender: TObject);
	126	function EntryID: string;
	127	procedure FieldPanelChange(Sender: TObject);
	128	procedure GetFieldValues(FldData: TStrings);
	129	procedure ParentCBEnter(Sender: TObject);
	130	procedure ParentCBExit(Sender: TObject);
	131	public
	132	constructor Create;
	133	destructor Destroy; override;
	134	function ElemType: TRDElemType;
	135	function Add2PN: boolean;
	136	function Indent: integer;
	137	function FindingType: string;
	138	function Historical: boolean;
	139	function ResultDlgID: integer;
	140	function IncludeMHTestInPN: boolean;
	141	function HideChildren: boolean;
	142	function ChildrenIndent: integer;
	143	function ChildrenSharePrompts: boolean;
	144	function ChildrenRequired: TRDChildReq;
	145	function Box: boolean;
	146	function BoxCaption: string;
	147	function IndentChildrenInPN: boolean;
	148	function IndentPNLevel: integer;
	149	function GetTemplateFieldValues(const Text: string; FldValues: TORStringList = nil): string;
	150	procedure AddText(Lst: TStrings);
	151	property Text: string read FText;
	152	property ID: string read FID;
	153	property DlgID: string read FDlgID;
	154	property Checked: boolean read FChecked write SetChecked;
	155	property Reminder: TReminderDialog read FReminder;
	156	property HasComment: boolean read FHasComment;
	157	property WHPrintDevice: String read FWHPrintDevice write FWHPrintDevice;
	158	property WHResultChk: String read FWHResultChk write FWHResultChk;
	159	property WHResultNot: String read FWHResultNot write FWHResultNot;
[460]	160	property VitalDateTime: TFMDateTime read FVitalDateTime write FVitalDateTime;
[459]	161	end;
	162
	163	TRemDataType = (dtDiagnosis, dtProcedure, dtPatientEducation,
	164	dtExam, dtHealthFactor, dtImmunization, dtSkinTest,
	165	dtVitals, dtOrder, dtMentalHealthTest, dtWHPapResult,
	166	dtWhNotPurp);
	167
	168	TRemPCERoot = class;
	169
	170	TRemData = class(TObject)
	171	private
	172	FPCERoot: TRemPCERoot;
	173	FParent: TRemDlgElement;
[460]	174	FRec3: string;
[459]	175	FActiveDates: TStringList; //Active dates for finding items. (rectype 3)
	176	// FRoot: string;
	177	FChoices: TORStringList;
	178	FChoicesActiveDates: TList; //Active date ranges for taxonomies. (rectype 5)
	179	//List of TStringList objects that contain active date
	180	//ranges for each FChoices object of the same index
	181	FChoicePrompt: TRemPrompt; //rectype 4
	182	FChoicesMin: integer;
	183	FChoicesMax: integer;
	184	FChoicesFont: THandle;
	185	FSyncCount: integer;
	186	protected
	187	function AddData(List: TStrings; Finishing: boolean): integer;
	188	public
	189	destructor Destroy; override;
	190	function Add2PN: boolean;
	191	function DisplayWHResults: boolean;
	192	function InternalValue: string;
	193	function ExternalValue: string;
	194	function Narrative: string;
	195	function Category: string;
	196	function DataType: TRemDataType;
	197	property Parent: TRemDlgElement read FParent;
	198	end;
	199
	200	TRemPromptType = (ptComment, ptVisitLocation, ptVisitDate, ptQuantity,
	201	ptPrimaryDiag, ptAdd2PL, ptExamResults, ptSkinResults,
	202	ptSkinReading, ptLevelSeverity, ptSeries, ptReaction,
	203	ptContraindicated, ptLevelUnderstanding, ptWHPapResult,
	204	ptWHNotPurp);
	205
	206	TRemPrompt = class(TObject)
	207	private
	208	FFromControl: boolean;
	209	FParent: TRemDlgElement;
	210	FRec4: string;
	211	FCaptionAssigned: boolean;
	212	FData: TRemData;
	213	FValue: string;
	214	FOverrideType: TRemPromptType;
	215	FIsShared: boolean;
	216	FSharedChildren: TList;
	217	FCurrentControl: TControl;
	218	FFromParent: boolean;
	219	FInitializing: boolean;
	220	FMiscText: string;
	221	FMonthReq: boolean;
	222	FPrintNow: String;
[460]	223	FMHTestComplete: integer;
[459]	224	protected
	225	function RemDataActive(RData: TRemData; EncDt: TFMDateTime):Boolean;
	226	function RemDataChoiceActive(RData: TRemData; j: integer; EncDt: TFMDateTime):Boolean;
	227	function GetValue: string;
	228	procedure SetValueFromParent(Value: string);
	229	procedure SetValue(Value: string);
	230	procedure PromptChange(Sender: TObject);
	231	procedure VitalVerify(Sender: TObject);
	232	procedure ComboBoxKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
	233	function CanShare(Prompt: TRemPrompt): boolean;
	234	procedure InitValue;
	235	procedure DoMHTest(Sender: TObject);
	236	procedure DoWHReport(Sender: TObject);
	237	procedure ViewWHText(Sender: TObject);
	238	procedure GAFHelp(Sender: TObject);
	239	function EntryID: string;
	240	procedure EditKeyPress(Sender: TObject; var Key: Char);
	241	public
	242	constructor Create;
	243	destructor Destroy; override;
	244	function PromptOK: boolean;
	245	function PromptType: TRemPromptType;
	246	function Add2PN: boolean;
	247	function InternalValue: string;
	248	function Forced: boolean;
	249	function Caption: string;
	250	function ForcedCaption: string;
	251	function SameLine: boolean;
	252	function Required: boolean;
	253	function NoteText: string;
	254	function VitalType: TVitalType;
	255	function VitalValue: string;
	256	function VitalUnitValue: string;
	257	property Value: string read GetValue write SetValue;
	258	end;
	259
	260	TRemPCERoot = class(TObject)
	261	private
	262	FData: TList;
	263	FID: string;
	264	FForcedPrompts: TStringList;
	265	FValue: string;
	266	FValueSet: string;
	267	protected
	268	class function GetRoot(Data: TRemData; Rec3: string; Historical: boolean): TRemPCERoot;
	269	procedure Done(Data: TRemData);
	270	procedure Sync(Prompt: TRemPrompt);
	271	procedure UnSync(Prompt: TRemPrompt);
	272	function GetValue(PromptType: TRemPromptType; var NewValue: string): boolean;
	273	public
	274	destructor Destroy; override;
	275	end;
	276
	277	TReminderStatus = (rsDue, rsApplicable, rsNotApplicable, rsNone, rsUnknown);
	278
	279	TRemCanFinishProc = function: boolean of object;
	280	TRemDisplayPCEProc = procedure of object;
	281
	282	TRemForm = record
	283	Form: TForm;
	284	PCEObj: TPCEData;
	285	RightPanel: TPanel;
	286	CanFinishProc: TRemCanFinishProc;
	287	DisplayPCEProc: TRemDisplayPCEProc;
	288	Drawers: TFrmDrawers;
	289	NewNoteRE: TRichEdit;
	290	NoteList: TORListBox;
	291	end;
	292
	293	var
	294	RemForm: TRemForm;
	295	NotPurposeValue: string;
	296	WHRemPrint: string;
[460]	297	InitialRemindersLoaded: boolean = FALSE;
[459]	298
	299	const
	300	HAVE_REMINDERS = 0;
	301	NO_REMINDERS = 1;
	302	RemPriorityText: array[1..3] of string = ('High','','Low');
	303	ClinMaintText = 'Clinical Maintenance';
	304
	305	dtUnknown = TRemDataType(-1);
	306	dtAll = TRemDataType(-2);
	307	dtHistorical = TRemDataType(-3);
	308
	309	ptUnknown = TRemPromptType(-1);
	310	ptSubComment = TRemPromptType(-2);
	311	ptDataList = TRemPromptType(-3);
	312	ptVitalEntry = TRemPromptType(-4);
	313	ptMHTest = TRemPromptType(-5);
	314	ptGAF = TRemPromptType(-6);
	315	ptMST = TRemPromptType(-7);
	316
	317	MSTCode = 'MST';
	318	MSTDataTypes = [pdcHF, pdcExam];
	319	pnumMST = ord(pnumComment)+4;
	320
	321	procedure NotifyWhenRemindersChange(Proc: TNotifyEvent);
	322	procedure RemoveNotifyRemindersChange(Proc: TNotifyEvent);
	323	procedure StartupReminders;
	324	function GetReminderStatus: TReminderStatus;
	325	function RemindersEvaluatingInBackground: boolean;
	326	procedure ResetReminderLoad;
	327	procedure LoadReminderData(ProcessingInBackground: boolean = FALSE);
	328	function ReminderEvaluated(Data: string; ForceUpdate: boolean = FALSE): boolean;
	329	procedure RemindersEvaluated(List: TStringList);
	330	procedure EvalReminder(ien: integer);
	331	procedure EvalProcessed;
	332	procedure EvaluateCategoryClicked(AData: pointer; Sender: TObject);
	333
	334	procedure SetReminderPopupRoutine(Menu: TPopupMenu);
	335	procedure SetReminderPopupCoverRoutine(Menu: TPopupMenu);
	336	procedure SetReminderMenuSelectRoutine(Menu: TMenuItem);
	337	procedure BuildReminderTree(Tree: TORTreeView);
	338	function ReminderNode(Node: TTreeNode): TORTreeNode;
	339	procedure ClearReminderData;
	340	function GetReminder(ARemData: string): TReminder;
	341	procedure WordWrap(const AText: string; Output: TStrings; LineLength: integer;
	342	AutoIndent: integer = 4);
	343	function InteractiveRemindersActive: boolean;
	344	function GetReminderData(Rem: TReminderDialog; Lst: TStrings; Finishing: boolean = FALSE;
	345	Historical: boolean = FALSE): integer; overload;
	346	function GetReminderData(Lst: TStrings; Finishing: boolean = FALSE;
	347	Historical: boolean = FALSE): integer; overload;
	348	procedure SetReminderFormBounds(Frm: TForm; DefX, DefY, DefW, DefH, ALeft, ATop, AWidth, AHeight: integer);
	349
	350	procedure UpdateReminderDialogStatus;
	351
	352	//const
	353	// InteractiveRemindersActive = FALSE;
	354	type
	355	TWHCheckBox = class(TORCheckBox)
	356	private
	357	FPrintNow: TORCheckBox;
	358	FViewLetter: TORCheckBox;
	359	FCheck1: TORCheckBox;
	360	FCheck2: TORCheckBox;
	361	FCheck3: TORCheckBox;
	362	FEdit: TEdit;
	363	FButton: TButton;
	364	FOnDestroy: TNotifyEvent;
	365	Flbl, Flbl2: TLabel;
	366	FPrintVis: String;
	367	//FPrintDevice: String;
	368	FPntNow: String;
	369	FPntBatch: String;
	370	FButtonText: String;
	371	FCheckNum: String;
	372	protected
	373	public
	374	property lbl: TLabel read Flbl write Flbl;
	375	property lbl2: TLabel read Flbl2 write Flbl2;
	376	property PntNow: String read FPntNow write FPntNow;
	377	property PntBatch: String read FPntBatch write FPntBatch;
	378	property CheckNum: String read FCheckNum write FCheckNum;
	379	property ButtonText: String read FButtonText write FButtonText;
	380	property PrintNow: TORCheckBox read FPrintNow write FPrintNow;
	381	property Check1: TORCheckBox read FCheck1 write FCheck1;
	382	property Check2: TORCheckBox read FCheck2 write FCheck2;
	383	property Check3: TORCheckBox read FCheck3 write FCheck3;
	384	property ViewLetter: TORCheckBox read FViewLetter write FViewLetter;
	385	property Button: TButton read FButton write FButton;
	386	property Edit: TEdit read FEdit write FEdit;
	387	property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
	388	property PrintVis: String read FPrintVis write FPrintVis;
	389	end;
	390
	391	var
	392	{ ActiveReminder string format:
	393	IEN^PRINT NAME^DUE DATE/TIME^LAST OCCURENCE DATE/TIME^PRIORITY^DUE^DIALOG
	394	where PRIORITY 1=High, 2=Normal, 3=Low
	395	DUE 0=Applicable, 1=Due, 2=Not Applicable }
	396	ActiveReminders: TORStringList = nil;
	397
	398	{ OtherReminder string format:
	399	IDENTIFIER^TYPE^NAME^PARENT IDENTIFIER^REMINDER IEN^DIALOG
	400	where TYPE C=Category, R=Reminder }
	401	OtherReminders: TORStringList = nil;
	402
	403	RemindersInProcess: TORStringList = nil;
	404	CoverSheetRemindersInBackground: boolean = FALSE;
	405	KillReminderDialogProc: procedure(frm: TForm) = nil;
	406	RemindersStarted: boolean = FALSE;
	407	ProcessedReminders: TORStringList = nil;
	408	ReminderDialogInfo: TStringList = nil;
	409
	410	const
	411	CatCode = 'C';
	412	RemCode = 'R';
	413	EduCode = 'E';
	414	pnumVisitLoc = pnumComment + 1;
	415	pnumVisitDate = pnumComment + 2;
	416	RemTreeDateIdx = 8;
	417	IncludeParentID = ';';
	418	OtherCatID = CatCode + '-6';
	419
	420	RemDataCodes: array[TRemDataType] of string =
	421	{ dtDiagnosis } ('POV',
	422	{ dtProcedure } 'CPT',
	423	{ dtPatientEducation } 'PED',
	424	{ dtExam } 'XAM',
	425	{ dtHealthFactor } 'HF',
	426	{ dtImmunization } 'IMM',
	427	{ dtSkinTest } 'SK',
	428	{ dtVitals } 'VIT',
	429	{ dtOrder } 'Q',
	430	{ dtMentalHealthTest } 'MH',
	431	{ dtWHPapResult } 'WHR',
	432	{ dtWHNotPurp } 'WH');
	433
	434	implementation
	435
	436	uses rCore, uCore, rReminders, fRptBox, uConst, fReminderDialog, fNotes, rMisc,
[460]	437	fMHTest, rPCE, rTemplates, dShared, uTemplateFields, fIconLegend, fReminderTree, uInit;
[459]	438
	439	type
	440	TRemFolder = (rfUnknown, rfDue, rfApplicable, rfNotApplicable, rfEvaluated, rfOther);
	441	TRemFolders = set of TRemFolder;
	442	TValidRemFolders = succ(low(TRemFolder)) .. high(TRemFolder);
	443
	444	var
	445	LastReminderLocation: integer = -2;
	446	EvaluatedReminders: TORStringList = nil;
	447	ReminderTreeMenu: TORPopupMenu = nil;
	448	ReminderTreeMenuDlg: TORPopupMenu = nil;
	449	ReminderCatMenu: TPopupMenu = nil;
	450	EducationTopics: TORStringList = nil;
	451	WebPages: TORStringList = nil;
	452	ReminderCallList: TORStringList = nil;
	453	LastProcessingList: string = '';
	454	InteractiveRemindersActiveChecked: boolean = FALSE;
	455	InteractiveRemindersActiveStatus: boolean = FALSE;
	456	PCERootList: TStringList;
	457	PrimaryDiagRoot: TRemPCERoot = nil;
	458	ElementChecked: TRemDlgElement = nil;
	459	HistRootCount: longint = 0;
	460	uRemFolders: TRemFolders = [rfUnknown];
	461
	462	const
	463	DueText = 'Due';
	464	ApplicableText = 'Applicable';
	465	NotApplicableText = 'Not Applicable';
	466	EvaluatedText = 'All Evaluated';
	467	OtherText = 'Other Categories';
	468
	469	DueCatID = CatCode + '-2';
	470	DueCatString = DueCatID + U + DueText;
	471
	472	ApplCatID = CatCode + '-3';
	473	ApplCatString = ApplCatID + U + ApplicableText;
	474
	475	NotApplCatID = CatCode + '-4';
	476	NotApplCatString = NotApplCatID + U + NotApplicableText;
	477
	478	EvaluatedCatID = CatCode + '-5';
	479	EvaluatedCatString = EvaluatedCatID + U + EvaluatedText;
	480
	481	// OtherCatID = CatCode + '-6';
	482	OtherCatString = OtherCatID + U + OtherText;
	483
	484	LostCatID = CatCode + '-7';
	485	LostCatString = LostCatID + U + 'In Process';
	486
	487	ReminderDateFormat = 'mm/dd/yyyy';
	488
	489	RemData2PCECat: array[TRemDataType] of TPCEDataCat =
	490	{ dtDiagnosis } (pdcDiag,
	491	{ dtProcedure } pdcProc,
	492	{ dtPatientEducation } pdcPED,
	493	{ dtExam } pdcExam,
	494	{ dtHealthFactor } pdcHF,
	495	{ dtImmunization } pdcImm,
	496	{ dtSkinTest } pdcSkin,
	497	{ dtVitals } pdcVital,
	498	{ dtOrder } pdcOrder,
	499	{ dtMentalHealthTest } pdcMH,
	500	{ dtWHPapResult } pdcWHR,
	501	{ dtWHNotPurp } pdcWH);
	502
	503	RemPromptCodes: array[TRemPromptType] of string =
	504	{ ptComment } ('COM',
	505	{ ptVisitLocation } 'VST_LOC',
	506	{ ptVisitDate } 'VST_DATE',
	507	{ ptQuantity } 'CPT_QTY',
	508	{ ptPrimaryDiag } 'POV_PRIM',
	509	{ ptAdd2PL } 'POV_ADD',
	510	{ ptExamResults } 'XAM_RES',
	511	{ ptSkinResults } 'SK_RES',
	512	{ ptSkinReading } 'SK_READ',
	513	{ ptLevelSeverity } 'HF_LVL',
	514	{ ptSeries } 'IMM_SER',
	515	{ ptReaction } 'IMM_RCTN',
	516	{ ptContraindicated } 'IMM_CNTR',
	517	{ ptLevelUnderstanding } 'PED_LVL',
	518	{ ptWHPapResult } 'WH_PAP_RESULT',
	519	{ ptWHNotPurp } 'WH_NOT_PURP');
	520
	521	RemPromptTypes: array[TRemPromptType] of TRemDataType =
	522	{ ptComment } (dtAll,
	523	{ ptVisitLocation } dtHistorical,
	524	{ ptVisitDate } dtHistorical,
	525	{ ptQuantity } dtProcedure,
	526	{ ptPrimaryDiag } dtDiagnosis,
	527	{ ptAdd2PL } dtDiagnosis,
	528	{ ptExamResults } dtExam,
	529	{ ptSkinResults } dtSkinTest,
	530	{ ptSkinReading } dtSkinTest,
	531	{ ptLevelSeverity } dtHealthFactor,
	532	{ ptSeries } dtImmunization,
	533	{ ptReaction } dtImmunization,
	534	{ ptContraindicated } dtImmunization,
	535	{ ptLevelUnderstanding } dtPatientEducation,
	536	{ ptWHPapResult } dtWHPapResult,
	537	{ ptWHNotPurp } dtWHNotPurp);
	538
	539	FinishPromptPieceNum: array[TRemPromptType] of integer =
	540	{ ptComment } (pnumComment,
	541	{ ptVisitLocation } pnumVisitLoc,
	542	{ ptVisitDate } pnumVisitDate,
	543	{ ptQuantity } pnumProcQty,
	544	{ ptPrimaryDiag } pnumDiagPrimary,
	545	{ ptAdd2PL } pnumDiagAdd2PL,
	546	{ ptExamResults } pnumExamResults,
	547	{ ptSkinResults } pnumSkinResults,
	548	{ ptSkinReading } pnumSkinReading,
	549	{ ptLevelSeverity } pnumHFLevel,
	550	{ ptSeries } pnumImmSeries,
	551	{ ptReaction } pnumImmReaction,
	552	{ ptContraindicated } pnumImmContra,
	553	{ ptLevelUnderstanding } pnumPEDLevel,
	554	{ ptWHPapResult } pnumWHPapResult,
	555	{ ptWHNotPurp } pnumWHNotPurp);
	556
	557	ComboPromptTags: array[TRemPromptType] of integer =
	558	{ ptComment } (0,
	559	{ ptVisitLocation } TAG_HISTLOC,
	560	{ ptVisitDate } 0,
	561	{ ptQuantity } 0,
	562	{ ptPrimaryDiag } 0,
	563	{ ptAdd2PL } 0,
	564	{ ptExamResults } TAG_XAMRESULTS,
	565	{ ptSkinResults } TAG_SKRESULTS,
	566	{ ptSkinReading } 0,
	567	{ ptLevelSeverity } TAG_HFLEVEL,
	568	{ ptSeries } TAG_IMMSERIES,
	569	{ ptReaction } TAG_IMMREACTION,
	570	{ ptContraindicated } 0,
	571	{ ptLevelUnderstanding } TAG_PEDLEVEL,
	572	{ ptWHPapResult } 0,
	573	{ ptWHNotPurp } 0);
	574
	575	PromptDescriptions: array [TRemPromptType] of string =
	576	{ ptComment } ('Comment',
	577	{ ptVisitLocation } 'Visit Location',
	578	{ ptVisitDate } 'Visit Date',
	579	{ ptQuantity } 'Quantity',
	580	{ ptPrimaryDiag } 'Primary Diagnosis',
	581	{ ptAdd2PL } 'Add to Problem List',
	582	{ ptExamResults } 'Exam Results',
	583	{ ptSkinResults } 'Skin Test Results',
	584	{ ptSkinReading } 'Skin Test Reading',
	585	{ ptLevelSeverity } 'Level of Severity',
	586	{ ptSeries } 'Series',
	587	{ ptReaction } 'Reaction',
	588	{ ptContraindicated } 'Repeat Contraindicated',
	589	{ ptLevelUnderstanding } 'Level of Understanding',
	590	{ ptWHPapResult } 'Women''s Health Procedure',
	591	{ ptWHNotPurp } 'Women Health Notification Purpose');
	592
	593	RemFolderCodes: array[TValidRemFolders] of char =
	594	{ rfDue } ('D',
	595	{ rfApplicable } 'A',
	596	{ rfNotApplicable } 'N',
	597	{ rfEvaluated } 'E',
	598	{ rfOther } 'O');
	599
	600	MSTDescTxt: array[0..4,0..1] of string = (('Yes','Y'),('No','N'),('Declined','D'),
	601	('Normal','N'),('Abnormal','A'));
	602
	603	SyncPrompts = [ptComment, ptQuantity, ptAdd2PL, ptExamResults,
	604	ptSkinResults, ptSkinReading, ptLevelSeverity, ptSeries,
	605	ptReaction, ptContraindicated, ptLevelUnderstanding];
	606
	607	Gap = 2;
	608	LblGap = 4;
	609	IndentGap = 18;
	610	PromptGap = 10;
	611	NewLinePromptGap = 18;
	612	IndentMult = 9;
	613	PromptIndent = 30;
	614	gbLeftIndent = 2;
	615	gbTopIndent = 9;
	616	gbTopIndent2 = 16;
	617	DisabledFontColor = clBtnShadow;
	618	r3Type = 4;
	619	r3Code2 = 6;
	620	r3Code = 7;
	621	r3Cat = 9;
	622	r3Nar = 8;
	623	r3GAF = 12;
	624
	625	RemTreeCode = 999;
	626
	627	CRCode = '<br>';
	628	CRCodeLen = length(CRCode);
	629	REMEntryCode = 'REM';
	630
	631	MonthReqCode = 'M';
	632
	633	type
	634	TVitalComboBox = class;
	635
	636	TVitalEdit = class(TEdit)
	637	private
	638	FLinkedCombo: TVitalComboBox;
	639	end;
	640
	641	TVitalComboBox = class(TComboBox)
	642	private
	643	FLinkedEdit: TVitalEdit;
	644	public
	645	procedure SelectByID(Value: string);
	646	end;
	647
	648	function InitText(const InStr: string): string;
	649	var
	650	i: integer;
	651
	652	begin
	653	Result := InStr;
	654	if(copy(Result, 1, CRCodeLen) = CRCode) then
	655	begin
	656	i := pos(CRCode, copy(Result, CRCodeLen+1, MaxInt));
	657	if(i > 0) and ((i = (CRCodeLen + 1)) or
	658	(Trim(copy(Result, CrCodeLen+1, i - 1)) = '')) then
	659	delete(Result,1,CRCodeLen + i - 1);
	660	end;
	661	end;
	662
	663	function CRLFText(const InStr: string): string;
	664	var
	665	i: integer;
	666
	667	begin
	668	Result := InitText(InStr);
	669	repeat
	670	i := pos(CRCode, Result);
	671	if(i > 0) then
	672	Result := copy(Result,1,i-1) + CRLF + copy(REsult,i + CRCodeLen, MaxInt);
	673	until(i = 0);
	674	end;
	675
	676	function Code2VitalType(Code: string): TVitalType;
	677	var
	678	v: TVitalType;
	679
	680	begin
	681	Result := vtUnknown;
	682	for v := low(TValidVitalTypes) to high(TValidVitalTypes) do
	683	begin
	684	if(Code = VitalPCECodes[v]) then
	685	begin
	686	Result := v;
	687	break;
	688	end;
	689	end;
	690	end;
	691
	692
	693	procedure TVitalComboBox.SelectByID(Value: string);
	694	var
	695	i: integer;
	696
	697	begin
	698	for i := 0 to Items.Count-1 do
	699	if(Value = Items[i]) then
	700	begin
	701	ItemIndex := i;
	702	break;
	703	end;
	704	end;
	705
	706	type
	707	TMultiClassObj = record
	708	case integer of
	709	0: (edt: TEdit);
	710	1: (cb: TORCheckBox);
	711	2: (cbo: TORComboBox);
	712	3: (dt: TORDateCombo);
	713	4: (ctrl: TORExposedControl);
	714	5: (vedt: TVitalEdit);
	715	6: (vcbo: TVitalComboBox);
	716	7: (btn: TButton);
	717	8: (pNow: TORCheckBox);
	718	9: (pBat: TORCheckBox);
	719	10: (lbl: TLabel);
	720	11: (WHChk: TWHCheckBox);
	721	end;
	722
	723	EForcedPromptConflict = class(EAbort);
	724
	725	function IsSyncPrompt(pt: TRemPromptType): boolean;
	726	begin
	727	if(pt in SyncPrompts) then
	728	Result := TRUE
	729	else
	730	Result := (pt = ptVitalEntry);
	731	end;
	732
	733	procedure NotifyWhenRemindersChange(Proc: TNotifyEvent);
	734	begin
	735	ActiveReminders.Notifier.NotifyWhenChanged(Proc);
	736	OtherReminders.Notifier.NotifyWhenChanged(Proc);
	737	RemindersInProcess.Notifier.NotifyWhenChanged(Proc);
	738	Proc(nil);
	739	end;
	740
	741	procedure RemoveNotifyRemindersChange(Proc: TNotifyEvent);
	742	begin
	743	ActiveReminders.Notifier.RemoveNotify(Proc);
	744	OtherReminders.Notifier.RemoveNotify(Proc);
	745	RemindersInProcess.Notifier.RemoveNotify(Proc);
	746	end;
	747
	748	function ProcessingChangeString: string;
	749	var
	750	i: integer;
	751	TmpSL: TStringList;
	752
	753	begin
	754	Result := U;
	755	if(RemindersInProcess.Count > 0) then
	756	begin
	757	TmpSL := TStringList.Create;
	758	try
	759	TmpSL.Assign(RemindersInProcess);
	760	TmpSL.Sort;
	761	for i := 0 to TmpSL.Count-1 do
	762	begin
	763	if(TReminder(TmpSL.Objects[i]).Processing) then
	764	Result := Result + TmpSL[i] + U;
	765	end;
	766	finally
	767	TmpSL.Free;
	768	end;
	769	end;
	770	end;
	771
	772	procedure StartupReminders;
	773	begin
	774	if(not InitialRemindersLoaded) then
	775	begin
	776	RemindersStarted := TRUE;
	777	InitialRemindersLoaded := TRUE;
	778	LoadReminderData;
	779	end;
	780	end;
	781
	782	function GetReminderStatus: TReminderStatus;
	783	begin
	784	if(EvaluatedReminders.IndexOfPiece('1',U,6) >= 0) then Result := rsDue
	785	else if(EvaluatedReminders.IndexOfPiece('0',U,6) >= 0) then Result := rsApplicable
	786	else if(EvaluatedReminders.IndexOfPiece('2',U,6) >= 0) then Result := rsNotApplicable
	787	else Result := rsUnknown;
	788	// else if(EvaluatedReminders.Count > 0) or (OtherReminders.Count > 0) or
	789	// (not InitialRemindersLoaded) or
	790	// (ProcessingChangeString <> U) then Result := rsUnknown
	791	// else Result := rsNone;
	792	end;
	793
	794	function RemindersEvaluatingInBackground: boolean;
	795	begin
	796	Result := CoverSheetRemindersInBackground;
	797	if(not Result) then
	798	Result := (ReminderCallList.Count > 0)
	799	end;
	800
	801	var
	802	TmpActive: TStringList = nil;
	803	TmpOther: TStringList = nil;
	804
	805	procedure BeginReminderUpdate;
	806	begin
	807	ActiveReminders.Notifier.BeginUpdate;
	808	OtherReminders.Notifier.BeginUpdate;
	809	TmpActive := TStringList.Create;
	810	TmpActive.Assign(ActiveReminders);
	811	TmpOther := TStringList.Create;
	812	TmpOther.Assign(OtherReminders);
	813	end;
	814
	815	procedure EndReminderUpdate(Force: boolean = FALSE);
	816	var
	817	DoNotify: boolean;
	818
	819	begin
	820	DoNotify := Force;
	821	if(not DoNotify) then
	822	DoNotify := (not ActiveReminders.Equals(TmpActive));
	823	KillObj(@TmpActive);
	824	if(not DoNotify) then
	825	DoNotify := (not OtherReminders.Equals(TmpOther));
	826	KillObj(@TmpOther);
	827	OtherReminders.Notifier.EndUpdate;
	828	ActiveReminders.Notifier.EndUpdate(DoNotify);
	829	end;
	830
	831	function GetRemFolders: TRemFolders;
	832	var
	833	i: TRemFolder;
	834	tmp: string;
	835
	836	begin
	837	if rfUnknown in uRemFolders then
	838	begin
	839	tmp := GetReminderFolders;
	840	uRemFolders := [];
	841	for i := low(TValidRemFolders) to high(TValidRemFolders) do
	842	if(pos(RemFolderCodes[i], tmp) > 0) then
	843	include(uRemFolders, i);
	844	end;
	845	Result := uRemFolders;
	846	end;
	847
	848	procedure SetRemFolders(const Value: TRemFolders);
	849	var
	850	i: TRemFolder;
	851	tmp: string;
	852
	853	begin
	854	if(Value <> uRemFolders) then
	855	begin
	856	BeginReminderUpdate;
	857	try
	858	uRemFolders := Value;
	859	tmp := '';
	860	for i := low(TValidRemFolders) to high(TValidRemFolders) do
	861	if(i in Value) then
	862	tmp := tmp + RemFolderCodes[i];
	863	SetReminderFolders(tmp);
	864	finally
	865	EndReminderUpdate(TRUE);
	866	end;
	867	end;
	868	end;
	869
	870	function ReminderEvaluated(Data: string; ForceUpdate: boolean = FALSE): boolean;
	871	var
	872	idx: integer;
	873	Code, Sts, Before: string;
	874
	875	begin
	876	Result := ForceUpdate;
	877	if(Data <> '') then
	878	begin
	879	Code := Piece(Data, U, 1);
	880	if StrToIntDef(Code,0) > 0 then
	881	begin
	882	ActiveReminders.Notifier.BeginUpdate;
	883	try
	884	idx := EvaluatedReminders.IndexOfPiece(Code);
	885	if(idx < 0) then
	886	begin
	887	EvaluatedReminders.Add(Data);
	888	Result := TRUE;
	889	end
	890	else
	891	begin
	892	Before := Piece(EvaluatedReminders[idx], U, 6);
	893	EvaluatedReminders[idx] := Data;
	894	if(not Result) then
	895	Result := (Before <> Piece(Data, U, 6));
	896	end;
	897	idx := ActiveReminders.IndexOfPiece(Code);
	898	if(idx < 0) then
	899	begin
	900	Sts := Piece(Data, U, 6);
[460]	901	//if(Sts = '0') or (Sts = '1') then
	902	if(Sts = '0') or (Sts = '1') or (Sts = '3') or (Sts = '4') then //AGP Error change 26.8
[459]	903	begin
	904	Result := TRUE;
	905	ActiveReminders.Add(Data);
	906	end;
	907	end
	908	else
	909	begin
	910	if(not Result) then
	911	Result := (ActiveReminders[idx] <> Data);
	912	ActiveReminders[idx] := Data;
	913	end;
	914	idx := ProcessedReminders.IndexOfPiece(Code);
	915	if(idx >= 0) then
	916	ProcessedReminders.Delete(idx);
	917	finally
	918	ActiveReminders.Notifier.EndUpdate(Result);
	919	end;
	920	end
	921	else
	922	Result := TRUE; // If Code = 0 then it's 0^No Reminders Due, indicating a status change.
	923	end;
	924	end;
	925
	926	procedure RemindersEvaluated(List: TStringList);
	927	var
	928	i: integer;
	929	DoUpdate, RemChanged: boolean;
	930
	931	begin
	932	DoUpdate := FALSE;
	933	ActiveReminders.Notifier.BeginUpdate;
	934	try
	935	for i := 0 to List.Count-1 do
	936	begin
	937	RemChanged := ReminderEvaluated(List[i]);
	938	if(RemChanged) then DoUpdate := TRUE;
	939	end;
	940	finally
	941	ActiveReminders.Notifier.EndUpdate(DoUpdate);
	942	end;
	943	end;
	944
	945	(*
	946	procedure CheckReminders; forward;
	947
	948	procedure IdleCallEvaluateReminder(Msg: string);
	949	var
	950	i:integer;
	951	Code: string;
	952
	953	begin
	954	Code := Piece(Msg,U,1);
	955	repeat
	956	i := ReminderCallList.IndexOfPiece(Code);
	957	if(i >= 0) then
	958	ReminderCallList.Delete(i);
	959	until(i < 0);
	960	ReminderEvaluated(EvaluateReminder(Msg), (ReminderCallList.Count = 0));
	961	CheckReminders;
	962	end;
	963
	964	procedure CheckReminders;
	965	var
	966	i:integer;
	967
	968	begin
	969	for i := ReminderCallList.Count-1 downto 0 do
	970	if(EvaluatedReminders.IndexOfPiece(Piece(ReminderCallList[i], U, 1)) >= 0) then
	971	ReminderCallList.Delete(i);
	972	if(ReminderCallList.Count > 0) then
	973	CallRPCWhenIdle(IdleCallEvaluateReminder,ReminderCallList[0])
	974	end;
	975	*)
	976
	977	procedure CheckReminders;
	978	var
	979	RemList: TStringList;
	980	i: integer;
	981	Code: string;
	982
	983	begin
	984	for i := ReminderCallList.Count-1 downto 0 do
	985	if(EvaluatedReminders.IndexOfPiece(Piece(ReminderCallList[i],U,1)) >= 0) then
	986	ReminderCallList.Delete(i);
	987	if(ReminderCallList.Count > 0) then
	988	begin
	989	RemList := TStringList.Create;
	990	try
	991	while (ReminderCallList.Count > 0) do
	992	begin
	993	Code := Piece(ReminderCallList[0],U,1);
	994	ReminderCallList.Delete(0);
	995	repeat
	996	i := ReminderCallList.IndexOfPiece(Code);
	997	if(i >= 0) then
	998	ReminderCallList.Delete(i);
	999	until(i < 0);
	1000	RemList.Add(Code);
	1001	end;
	1002	if(RemList.Count > 0) then
	1003	begin
	1004	EvaluateReminders(RemList);
	1005	RemList.Assign(RPCBrokerV.Results);
	1006	for i := 0 to RemList.Count-1 do
	1007	ReminderEvaluated(RemList[i], (i = (RemList.Count-1)));
	1008	end;
	1009	finally
	1010	RemList.Free;
	1011	end;
	1012	end;
	1013	end;
	1014
	1015	procedure ResetReminderLoad;
	1016	begin
	1017	LastReminderLocation := -2;
	1018	LoadReminderData;
	1019	end;
	1020
	1021	procedure LoadReminderData(ProcessingInBackground: boolean = FALSE);
	1022	var
	1023	i, idx: integer;
	1024	RemID: string;
	1025	TempList: TORStringList;
	1026
	1027	begin
	1028	if(RemindersStarted and (LastReminderLocation <> Encounter.Location)) then
	1029	begin
	1030	LastReminderLocation := Encounter.Location;
	1031	BeginReminderUpdate;
	1032	try
	1033	GetCurrentReminders;
	1034	TempList := TORStringList.Create;
	1035	try
	1036	if(RPCBrokerV.Results.Count > 0) then
	1037	begin
	1038	for i := 0 to RPCBrokerV.Results.Count-1 do
	1039	begin
	1040	RemID := RPCBrokerV.Results[i];
	1041	idx := EvaluatedReminders.IndexOfPiece(RemID);
	1042	if(idx < 0) then
	1043	begin
	1044	TempList.Add(RemID);
	1045	if(not ProcessingInBackground) then
	1046	ReminderCallList.Add(RemID);
	1047	end
	1048	else
	1049	TempList.Add(EvaluatedReminders[idx]);
	1050	end;
	1051	end;
	1052	// ActiveReminders.Assign(TempList);
	1053	for i := 0 to TempList.Count-1 do
	1054	begin
	1055	RemID := Piece(TempList[i],U,1);
	1056	if(ActiveReminders.indexOfPiece(RemID) < 0) then
	1057	ActiveReminders.Add(TempList[i]);
	1058	end;
	1059	finally
	1060	TempList.Free;
	1061	end;
	1062	CheckReminders;
	1063	GetOtherReminders(OtherReminders);
	1064	finally
	1065	EndReminderUpdate;
	1066	end;
	1067	end;
	1068	end;
	1069
	1070	{ Supporting events for Reminder TreeViews }
	1071
	1072	procedure GetImageIndex(AData: Pointer; Sender: TObject; Node: TTreeNode);
	1073	var
	1074	iidx, oidx: integer;
	1075	Data, Tmp: string;
	1076
	1077	begin
	1078	if(Assigned(Node)) then
	1079	begin
	1080	oidx := -1;
	1081	Data := (Node as TORTreeNode).StringData;
	1082	if(copy(Piece(Data, U, 1),1,1) = CatCode) then
	1083	begin
	1084	if(Node.Expanded) then
	1085	iidx := 1
	1086	else
	1087	iidx := 0;
	1088	end
	1089	else
	1090	begin
	1091	Tmp := Piece(Data, U, 6);
[460]	1092	//if(Tmp = '1') then iidx := 2
	1093	if (Tmp = '3') or (Tmp = '4') or (Tmp = '1') then iidx :=2 //AGP ERROR CHANGE 26.8
[459]	1094	else if(Tmp = '0') then iidx := 3
	1095	else
	1096	begin
	1097	if(EvaluatedReminders.IndexOfPiece(copy(Piece(Data, U, 1),2,MaxInt),U,1) < 0) then
	1098	iidx := 5
	1099	else
	1100	iidx := 4;
	1101	end;
	1102
	1103	if(Piece(Data,U,7) = '1') then
	1104	begin
	1105	Tmp := copy(Piece(Data, U, 1),2,99);
	1106	if(ProcessedReminders.IndexOfPiece(Tmp,U,1) >=0) then
	1107	oidx := 1
	1108	else
	1109	oidx:= 0;
	1110	end;
	1111	end;
	1112	Node.ImageIndex := iidx;
	1113	Node.SelectedIndex := iidx;
	1114	if(Node.OverlayIndex <> oidx) then
	1115	begin
	1116	Node.OverlayIndex := oidx;
	1117	Node.TreeView.Invalidate;
	1118	end;
	1119	end;
	1120	end;
	1121
	1122	type
	1123	TRemMenuCmd = (rmClinMaint, rmEdu, rmInq, rmWeb, rmDash, rmEval,
	1124	rmDue, rmApplicable, rmNotApplicable, rmEvaluated, rmOther,
	1125	rmLegend);
	1126	TRemViewCmds = rmDue..rmOther;
	1127
	1128	const
	1129	RemMenuFolder: array[TRemViewCmds] of TRemFolder =
	1130	{ rmDue } (rfDue,
	1131	{ rmApplicable } rfApplicable,
	1132	{ rmNotApplicable } rfNotApplicable,
	1133	{ rmEvaluated } rfEvaluated,
	1134	{ rmOther } rfOther);
	1135
	1136	RemMenuNames: array[TRemMenuCmd] of string = (
	1137	{ rmClinMaint } ClinMaintText,
	1138	{ rmEdu } 'Education Topic Definition',
	1139	{ rmInq } 'Reminder Inquiry',
	1140	{ rmWeb } 'Reference Information',
	1141	{ rmDash } '-',
	1142	{ rmEval } 'Evaluate Reminder',
	1143	{ rmDue } DueText,
	1144	{ rmApplicable } ApplicableText,
	1145	{ rmNotApplicable } NotApplicableText,
	1146	{ rmEvaluated } EvaluatedText,
	1147	{ rmOther } OtherText,
	1148	{ rmLegend } 'Reminder Icon Legend');
	1149
	1150
	1151	EvalCatName = 'Evaluate Category Reminders';
	1152
	1153	function GetEducationTopics(EIEN: string): string;
	1154	var
	1155	i, idx: integer;
	1156	Tmp, Data: string;
	1157
	1158	begin
	1159	if(not assigned(EducationTopics)) then
	1160	EducationTopics := TORStringList.Create;
	1161	idx := EducationTopics.IndexOfPiece(EIEN);
	1162	if(idx < 0) then
	1163	begin
	1164	Tmp := copy(EIEN,1,1);
	1165	idx := StrToIntDef(copy(EIEN,2,MaxInt),0);
	1166	if(Tmp = RemCode) then
	1167	GetEducationTopicsForReminder(idx)
	1168	else
	1169	if(Tmp = EduCode) then
	1170	GetEducationSubtopics(idx)
	1171	else
	1172	RPCBrokerV.Results.Clear;
	1173	Tmp := EIEN;
	1174	if(RPCBrokerV.Results.Count > 0) then
	1175	begin
	1176	for i := 0 to RPCBrokerV.Results.Count-1 do
	1177	begin
	1178	Data := RPCBrokerV.Results[i];
	1179	Tmp := Tmp + U + Piece(Data, U, 1) + ';';
	1180	if(Piece(Data, U, 3) = '') then
	1181	Tmp := Tmp + Piece(Data, U, 2)
	1182	else
	1183	Tmp := Tmp + Piece(Data, U, 3);
	1184	end;
	1185	end;
	1186	idx := EducationTopics.Add(Tmp);
	1187	end;
	1188	Result := EducationTopics[idx];
	1189	idx := pos(U, Result);
	1190	if(idx > 0) then
	1191	Result := copy(Result,Idx+1,MaxInt)
	1192	else
	1193	Result := '';
	1194	end;
	1195
	1196	function GetWebPageName(idx :integer): string;
	1197	begin
	1198	Result := Piece(WebPages[idx],U,2);
	1199	end;
	1200
	1201	function GetWebPageAddress(idx: integer): string;
	1202	begin
	1203	Result := Piece(WebPages[idx],U,3);
	1204	end;
	1205
	1206	function GetWebPages(EIEN: string): string; overload;
	1207	var
	1208	i, idx: integer;
	1209	Tmp, Data, Title: string;
	1210	RIEN: string;
	1211
	1212	begin
	1213	RIEN := RemCode + EIEN;
	1214	if(not assigned(WebPages)) then
	1215	WebPages := TORStringList.Create;
	1216	idx := WebPages.IndexOfPiece(RIEN);
	1217	if(idx < 0) then
	1218	begin
	1219	GetReminderWebPages(EIEN);
	1220	Tmp := RIEN;
	1221	if(RPCBrokerV.Results.Count > 0) then
	1222	begin
	1223	for i := 0 to RPCBrokerV.Results.Count-1 do
	1224	begin
	1225	Data := RPCBrokerV.Results[i];
	1226	if(Piece(Data,U,1) = '1') and (Piece(Data,U,3) <> '') then
	1227	begin
	1228	Data := U + Piece(Data,U,4) + U + Piece(Data,U,3);
	1229	if(Piece(Data,U,2) = '') then
	1230	begin
	1231	Title := Piece(data,U,3);
	1232	if(length(Title) > 60) then
	1233	Title := copy(Title,1,57) + '...';
	1234	SetPiece(Data,U,2,Title);
	1235	end;
	1236	//if(copy(UpperCase(Piece(Data, U, 3)),1,7) <> 'HTTP://') then
	1237	// SetPiece(Data, U, 3,'http://'+Piece(Data,U,3));
	1238	idx := WebPages.IndexOf(Data);
	1239	if(idx < 0) then
	1240	idx := WebPages.Add(Data);
	1241	Tmp := Tmp + U + IntToStr(idx);
	1242	end;
	1243	end;
	1244	end;
	1245	idx := WebPages.Add(Tmp);
	1246	end;
	1247	Result := WebPages[idx];
	1248	idx := pos(U, Result);
	1249	if(idx > 0) then
	1250	Result := copy(Result,Idx+1,MaxInt)
	1251	else
	1252	Result := '';
	1253	end;
	1254
	1255	function ReminderName(IEN: integer): string;
	1256	var
	1257	idx: integer;
	1258	SIEN: string;
	1259
	1260	begin
	1261	SIEN := IntToStr(IEN);
	1262	Result := '';
	1263	idx := EvaluatedReminders.IndexOfPiece(SIEN);
	1264	if(idx >= 0) then
	1265	Result := piece(EvaluatedReminders[idx],U,2);
	1266	if(Result = '') then
	1267	begin
	1268	idx := ActiveReminders.IndexOfPiece(SIEN);
	1269	if(idx >= 0) then
	1270	Result := piece(ActiveReminders[idx],U,2);
	1271	end;
	1272	if(Result = '') then
	1273	begin
	1274	idx := OtherReminders.IndexOfPiece(SIEN, U, 5);
	1275	if(idx >= 0) then
	1276	Result := piece(OtherReminders[idx],U,3);
	1277	end;
	1278	if(Result = '') then
	1279	begin
	1280	idx := RemindersInProcess.IndexOfPiece(SIEN);
	1281	if(idx >= 0) then
	1282	Result := TReminder(RemindersInProcess.Objects[idx]).PrintName;
	1283	end;
	1284	end;
	1285
	1286	procedure ReminderClinMaintClicked(AData: pointer; Sender: TObject);
	1287	var
	1288	ien: integer;
	1289
	1290	begin
	1291	ien := (Sender as TMenuItem).Tag;
	1292	if(ien > 0) then
	1293	ReportBox(DetailReminder(ien), RemMenuNames[rmClinMaint] + ': '+ ReminderName(ien), TRUE);
	1294	end;
	1295
	1296	procedure ReminderEduClicked(AData: pointer; Sender: TObject);
	1297	var
	1298	ien: integer;
	1299
	1300	begin
	1301	ien := (Sender as TMenuItem).Tag;
	1302	if(ien > 0) then
	1303	ReportBox(EducationTopicDetail(ien), 'Education Topic: ' + (Sender as TMenuItem).Caption, TRUE);
	1304	end;
	1305
	1306	procedure ReminderInqClicked(AData: pointer; Sender: TObject);
	1307	var
	1308	ien: integer;
	1309
	1310	begin
	1311	ien := (Sender as TMenuItem).Tag;
	1312	if(ien > 0) then
	1313	ReportBox(ReminderInquiry(ien), 'Reminder Inquiry: '+ ReminderName(ien), TRUE);
	1314	end;
	1315
	1316	procedure ReminderWebClicked(AData: pointer; Sender: TObject);
	1317	var
	1318	idx: integer;
	1319
	1320	begin
	1321	idx := (Sender as TMenuItem).Tag-1;
	1322	if(idx >= 0) then
	1323	GotoWebPage(GetWebPageAddress(idx));
	1324	end;
	1325
	1326	procedure EvalReminder(ien: integer);
	1327	var
	1328	Msg, RName: string;
	1329	NewStatus: string;
	1330
	1331	begin
	1332	if(ien > 0) then
	1333	begin
	1334	NewStatus := EvaluateReminder(IntToStr(ien));
	1335	ReminderEvaluated(NewStatus);
	1336	NewStatus := piece(NewStatus,U,6);
	1337	RName := ReminderName(ien);
	1338	if(RName = '') then RName := 'Reminder';
	1339	if(NewStatus = '1') then Msg := 'Due'
	1340	else if(NewStatus = '0') then Msg := 'Applicable'
[460]	1341	else if(NewStatus = '3') then Msg := 'Error' //AGP Error code change 26.8
	1342	else if (NewStatus = '4') then Msg := 'CNBD' //AGP Error code change 26.8
[459]	1343	else Msg := 'Not Applicable';
	1344	Msg := RName + ' is ' + Msg + '.';
	1345	InfoBox(Msg, RName + ' Evaluation', MB_OK);
	1346	end;
	1347	end;
	1348
	1349	procedure EvalProcessed;
	1350	var
	1351	i: integer;
	1352
	1353	begin
	1354	if(ProcessedReminders.Count > 0) then
	1355	begin
	1356	BeginReminderUpdate;
	1357	try
	1358	while(ProcessedReminders.Count > 0) do
	1359	begin
	1360	if(ReminderCallList.IndexOf(ProcessedReminders[0]) < 0) then
	1361	ReminderCallList.Add(ProcessedReminders[0]);
	1362	repeat
	1363	i := EvaluatedReminders.IndexOfPiece(Piece(ProcessedReminders[0],U,1));
	1364	if(i >= 0) then
	1365	EvaluatedReminders.Delete(i);
	1366	until(i < 0);
	1367	ProcessedReminders.Delete(0);
	1368	end;
	1369	CheckReminders;
	1370	finally
	1371	EndReminderUpdate(TRUE);
	1372	end;
	1373	end;
	1374	end;
	1375
	1376	procedure ReminderEvalClicked(AData: pointer; Sender: TObject);
	1377	begin
	1378	EvalReminder((Sender as TMenuItem).Tag);
	1379	end;
	1380
	1381	procedure ReminderViewFolderClicked(AData: pointer; Sender: TObject);
	1382	var
	1383	rfldrs: TRemFolders;
	1384	rfldr: TRemFolder;
	1385
	1386	begin
	1387	rfldrs := GetRemFolders;
	1388	rfldr := TRemFolder((Sender as TMenuItem).Tag);
	1389	if rfldr in rfldrs then
	1390	exclude(rfldrs, rfldr)
	1391	else
	1392	include(rfldrs, rfldr);
	1393	SetRemFolders(rfldrs);
	1394	end;
	1395
	1396	procedure EvaluateCategoryClicked(AData: pointer; Sender: TObject);
	1397	var
	1398	Node: TORTreeNode;
	1399	Code: string;
	1400	i: integer;
	1401
	1402	begin
	1403	if(Sender is TMenuItem) then
	1404	begin
	1405	BeginReminderUpdate;
	1406	try
	1407	Node := TORTreeNode(TORTreeNode(TMenuItem(Sender).Tag).GetFirstChild);
	1408	while assigned(Node) do
	1409	begin
	1410	Code := Piece(Node.StringData,U,1);
	1411	if(copy(Code,1,1) = RemCode) then
	1412	begin
	1413	Code := copy(Code,2,MaxInt);
	1414	if(ReminderCallList.IndexOf(Code) < 0) then
	1415	ReminderCallList.Add(copy(Node.StringData,2,MaxInt));
	1416	repeat
	1417	i := EvaluatedReminders.IndexOfPiece(Code);
	1418	if(i >= 0) then
	1419	EvaluatedReminders.Delete(i);
	1420	until(i < 0);
	1421	end;
	1422	Node := TORTreeNode(Node.GetNextSibling);
	1423	end;
	1424	CheckReminders;
	1425	finally
	1426	EndReminderUpdate(TRUE);
	1427	end;
	1428	end;
	1429	end;
	1430
	1431	procedure ReminderIconLegendClicked(AData: pointer; Sender: TObject);
	1432	begin
	1433	ShowIconLegend(ilReminders);
	1434	end;
	1435
	1436	procedure ReminderMenuBuilder(MI: TMenuItem; RemStr: string;
	1437	IncludeActions, IncludeEval, ViewFolders: boolean);
	1438	var
	1439	M: TMethod;
	1440	Tmp: string;
	1441	Cnt: integer;
	1442	RemID: integer;
	1443	cmd: TRemMenuCmd;
	1444
	1445	function Add(Text: string; Parent: TMenuItem; Tag: integer; Typ: TRemMenuCmd): TORMenuItem;
	1446	var
	1447	InsertMenu: boolean;
	1448	idx: integer;
	1449
	1450	begin
	1451	Result := nil;
	1452	InsertMenu := TRUE;
	1453	if(Parent = MI) then
	1454	begin
	1455	if(MI.Count > Cnt) then
	1456	begin
	1457	Result := TORMenuItem(MI.Items[Cnt]);
	1458	Result.Enabled := TRUE;
	1459	Result.Visible := TRUE;
	1460	Result.ImageIndex := -1;
	1461	while Result.Count > 0 do
	1462	Result.Delete(Result.Count-1);
	1463	InsertMenu := FALSE;
	1464	end;
	1465	inc(Cnt);
	1466	end;
	1467	if(not assigned(Result)) then
	1468	Result := TORMenuItem.Create(MI);
	1469	if(Text = '') then
	1470	Result.Caption := RemMenuNames[Typ]
	1471	else
	1472	Result.Caption := Text;
	1473	Result.Tag := Tag;
	1474	Result.Data := RemStr;
	1475	if(Tag <> 0) then
	1476	begin
	1477	case Typ of
	1478	rmClinMaint: M.Code := @ReminderClinMaintClicked;
	1479	rmEdu: M.Code := @ReminderEduClicked;
	1480	rmInq: M.Code := @ReminderInqClicked;
	1481	rmWeb: M.Code := @ReminderWebClicked;
	1482	rmEval: M.Code := @ReminderEvalClicked;
	1483	rmDue..rmOther:
	1484	begin
	1485	M.Code := @ReminderViewFolderClicked;
	1486	case Typ of
	1487	rmDue: idx := 0;
	1488	rmApplicable: idx := 2;
	1489	rmNotApplicable: idx := 4;
	1490	rmEvaluated: idx := 6;
	1491	rmOther: idx := 8;
	1492	else idx := -1;
	1493	end;
	1494	if(idx >= 0) and (RemMenuFolder[Typ] in GetRemFolders) then
	1495	inc(idx);
	1496	Result.ImageIndex := idx;
	1497	end;
	1498	rmLegend: M.Code := @ReminderIconLegendClicked;
	1499	else
	1500	M.Code := nil;
	1501	end;
	1502	if(assigned(M.Code)) then
	1503	Result.OnClick := TNotifyEvent(M)
	1504	else
	1505	Result.OnClick := nil;
	1506	end;
	1507	if(InsertMenu) then
	1508	Parent.Add(Result);
	1509	end;
	1510
	1511	procedure AddEducationTopics(Item: TMenuItem; EduStr: string);
	1512	var
	1513	i, j: integer;
	1514	Code: String;
	1515	NewEduStr: string;
	1516	itm: TMenuItem;
	1517
	1518	begin
	1519	if(EduStr <> '') then
	1520	begin
	1521	repeat
	1522	i := pos(';', EduStr);
	1523	j := pos(U, EduStr);
	1524	if(j = 0) then j := length(EduStr)+1;
	1525	Code := copy(EduStr,1,i-1);
	1526	//AddEducationTopics(Add(copy(EduStr,i+1,j-i-1), Item, StrToIntDef(Code, 0), rmEdu),
	1527	// GetEducationTopics(EduCode + Code));
	1528
	1529	NewEduStr := GetEducationTopics(EduCode + Code);
	1530	if(NewEduStr = '') then
	1531	Add(copy(EduStr,i+1,j-i-1), Item, StrToIntDef(Code, 0), rmEdu)
	1532	else
	1533	begin
	1534	itm := Add(copy(EduStr,i+1,j-i-1), Item, 0, rmEdu);
	1535	Add(copy(EduStr,i+1,j-i-1), itm, StrToIntDef(Code, 0), rmEdu);
	1536	Add('', Itm, 0, rmDash);
	1537	AddEducationTopics(itm, NewEduStr);
	1538	end;
	1539
	1540	delete(EduStr,1,j);
	1541	until(EduStr = '');
	1542	end;
	1543	end;
	1544
	1545	procedure AddWebPages(Item: TMenuItem; WebStr: string);
	1546	var
	1547	i, idx: integer;
	1548
	1549	begin
	1550	if(WebStr <> '') then
	1551	begin
	1552	repeat
	1553	i := pos(U, WebStr);
	1554	if(i = 0) then i := length(WebStr)+1;
	1555	idx := StrToIntDef(copy(WebStr,1,i-1),-1);
	1556	if(idx >= 0) then
	1557	Add(GetWebPageName(idx), Item, idx+1, rmWeb);
	1558	delete(WebStr,1,i);
	1559	until(WebStr = '');
	1560	end;
	1561	end;
	1562
	1563
	1564	begin
	1565	RemID := StrToIntDef(copy(Piece(RemStr,U,1),2,MaxInt),0);
	1566	Cnt := 0;
	1567	M.Data := nil;
	1568
	1569	if(RemID > 0) then
	1570	begin
	1571	Add('', MI, RemID, rmClinMaint);
	1572	Tmp := GetEducationTopics(RemCode + IntToStr(RemID));
	1573	if(Tmp <> '') then
	1574	AddEducationTopics(Add('', MI, 0, rmEdu), Tmp)
	1575	else
	1576	Add('', MI, 0, rmEdu).Enabled := FALSE;
	1577	Add('', MI, RemID, rmInq);
	1578	Tmp := GetWebPages(IntToStr(RemID));
	1579	if(Tmp <> '') then
	1580	AddWebPages(Add('', MI, 0, rmWeb), Tmp)
	1581	else
	1582	Add('', MI, 0, rmWeb).Enabled := FALSE;
	1583
	1584	if(IncludeActions or IncludeEval) then
	1585	begin
	1586	Add('', MI, 0, rmDash);
	1587	Add('', MI, RemID, rmEval);
	1588	end;
	1589	end;
	1590
	1591	if(ViewFolders) then
	1592	begin
	1593	Add('', MI, 0, rmDash);
	1594	for cmd := low(TRemViewCmds) to high(TRemViewCmds) do
	1595	Add('', MI, ord(RemMenuFolder[cmd]), cmd);
	1596	end;
	1597
	1598	Add('', MI, 0, rmDash);
	1599	Add('', MI, 1, rmLegend);
	1600
	1601	while MI.Count > Cnt do
	1602	MI.Delete(MI.Count-1);
	1603	end;
	1604
	1605	procedure ReminderTreePopup(AData: pointer; Sender: TObject);
	1606	begin
	1607	ReminderMenuBuilder((Sender as TPopupMenu).Items, (Sender as TORPopupMenu).Data, TRUE, FALSE, FALSE);
	1608	end;
	1609
	1610	procedure ReminderTreePopupCover(AData: pointer; Sender: TObject);
	1611	begin
	1612	ReminderMenuBuilder((Sender as TPopupMenu).Items, (Sender as TORPopupMenu).Data, FALSE, FALSE, FALSE);
	1613	end;
	1614
	1615	procedure ReminderTreePopupDlg(AData: pointer; Sender: TObject);
	1616	begin
	1617	ReminderMenuBuilder((Sender as TPopupMenu).Items, (Sender as TORPopupMenu).Data, FALSE, TRUE, FALSE);
	1618	end;
	1619
	1620	procedure ReminderMenuItemSelect(AData: pointer; Sender: TObject);
	1621	begin
	1622	ReminderMenuBuilder((Sender as TMenuItem), (Sender as TORMenuItem).Data, FALSE, FALSE, TRUE);
	1623	end;
	1624
	1625	procedure SetReminderPopupRoutine(Menu: TPopupMenu);
	1626	var
	1627	M: TMethod;
	1628
	1629	begin
	1630	M.Code := @ReminderTreePopup;
	1631	M.Data := nil;
	1632	Menu.OnPopup := TNotifyEvent(M);
	1633	end;
	1634
	1635	procedure SetReminderPopupCoverRoutine(Menu: TPopupMenu);
	1636	var
	1637	M: TMethod;
	1638
	1639	begin
	1640	M.Code := @ReminderTreePopupCover;
	1641	M.Data := nil;
	1642	Menu.OnPopup := TNotifyEvent(M);
	1643	end;
	1644
	1645	procedure SetReminderPopupDlgRoutine(Menu: TPopupMenu);
	1646	var
	1647	M: TMethod;
	1648
	1649	begin
	1650	M.Code := @ReminderTreePopupDlg;
	1651	M.Data := nil;
	1652	Menu.OnPopup := TNotifyEvent(M);
	1653	end;
	1654
	1655	procedure SetReminderMenuSelectRoutine(Menu: TMenuItem);
	1656	var
	1657	M: TMethod;
	1658
	1659	begin
	1660	M.Code := @ReminderMenuItemSelect;
	1661	M.Data := nil;
	1662	Menu.OnClick := TNotifyEvent(M);
	1663	end;
	1664
	1665	function ReminderMenu(Sender: TComponent): TORPopupMenu;
	1666	begin
	1667	if(Sender.Tag = RemTreeCode) then
	1668	begin
	1669	if(not assigned(ReminderTreeMenuDlg)) then
	1670	begin
	1671	ReminderTreeMenuDlg := TORPopupMenu.Create(nil);
	1672	SetReminderPopupDlgRoutine(ReminderTreeMenuDlg)
	1673	end;
	1674	Result := ReminderTreeMenuDlg;
	1675	end
	1676	else
	1677	begin
	1678	if(not assigned(ReminderTreeMenu)) then
	1679	begin
	1680	ReminderTreeMenu := TORPopupMenu.Create(nil);
	1681	SetReminderPopupRoutine(ReminderTreeMenu);
	1682	end;
	1683	Result := ReminderTreeMenu;
	1684	end;
	1685	end;
	1686
	1687	procedure RemContextPopup(AData: Pointer; Sender: TObject; MousePos: TPoint;
	1688	var Handled: Boolean);
	1689	var
	1690	Menu: TORPopupMenu;
	1691	MItem: TMenuItem;
	1692	M: TMethod;
	1693	p1: string;
	1694	UpdateMenu: boolean;
	1695
	1696	begin
	1697	UpdateMenu := TRUE;
	1698	Menu := nil;
	1699	with (Sender as TORTreeView) do
	1700	begin
	1701	if((htOnItem in GetHitTestInfoAt(MousePos.X, MousePos.Y)) and (assigned(Selected))) then
	1702	begin
	1703	p1 := Piece((Selected as TORTreeNode).StringData, U, 1);
	1704	if(Copy(p1,1,1) = RemCode) then
	1705	begin
	1706	Menu := ReminderMenu(TComponent(Sender));
	1707	Menu.Data := TORTreeNode(Selected).StringData;
	1708	end
	1709	else
	1710	if(Copy(p1,1,1) = CatCode) and (p1 <> OtherCatID) and (Selected.HasChildren) then
	1711	begin
	1712	if(not assigned(ReminderCatMenu)) then
	1713	begin
	1714	ReminderCatMenu := TPopupMenu.Create(nil);
	1715	MItem := TMenuItem.Create(ReminderCatMenu);
	1716	MItem.Caption := EvalCatName;
	1717	M.Data := nil;
	1718	M.Code := @EvaluateCategoryClicked;
	1719	MItem.OnClick := TNotifyEvent(M);
	1720	ReminderCatMenu.Items.Add(MItem);
	1721	end
	1722	else
	1723	MItem := ReminderCatMenu.Items[0];
	1724	PopupMenu := ReminderCatMenu;
	1725	MItem.Tag := Integer(TORTreeNode(Selected));
	1726	UpdateMenu := FALSE;
	1727	end;
	1728	end;
	1729	if UpdateMenu then
	1730	PopupMenu := Menu;
	1731	Selected := Selected; // This strange line Keeps item selected after a right click
	1732	if(not assigned(PopupMenu)) then
	1733	Handled := TRUE;
	1734	end;
	1735	end;
	1736
	1737	{ StringData of the TORTreeNodes will be in the format:
	1738	1 2 3 4 5 6 7
	1739	TYPE + IEN^PRINT NAME^DUE DATE/TIME^LAST OCCURENCE DATE/TIME^PRIORITY^DUE^DIALOG
	1740	8 9 10
	1741	Formated Due Date^Formated Last Occurence Date^InitialAbsoluteIdx
	1742
	1743	where TYPE C=Category, R=Reminder
	1744	PRIORITY 1=High, 2=Normal, 3=Low
	1745	DUE 0=Applicable, 1=Due, 2=Not Applicable
	1746	DIALOG 1=Active Dialog Exists
	1747	}
	1748	procedure BuildReminderTree(Tree: TORTreeView);
	1749	var
	1750	ExpandedStr: string;
	1751	TopID1, TopID2: string;
	1752	SelID1, SelID2: string;
	1753	i, j: integer;
	1754	NeedLost: boolean;
	1755	Tmp, Data, LostCat, Code: string;
	1756	Node: TORTreeNode;
	1757	M: TMethod;
	1758	Rem: TReminder;
	1759	OpenDue, Found: boolean;
	1760
	1761	function Add2Tree(Folder: TRemFolder; CatID: string; Node: TORTreeNode = nil): TORTreeNode;
	1762	begin
	1763	if (Folder = rfUnknown) or (Folder in GetRemFolders) then
	1764	begin
	1765	if(CatID = LostCatID) then
	1766	begin
	1767	if(NeedLost) then
	1768	begin
	1769	(Tree.Items.AddFirst(nil,'') as TORTreeNode).StringData := LostCatString;
	1770	NeedLost := FALSE;
	1771	end;
	1772	end;
	1773
	1774	if(not assigned(Node)) then
	1775	Node := Tree.FindPieceNode(CatID, 1);
	1776	if(assigned(Node)) then
	1777	begin
	1778	Result := (Tree.Items.AddChild(Node,'') as TORTreeNode);
	1779	Result.StringData := Data;
	1780	end
	1781	else
	1782	Result := nil;
	1783	end
	1784	else
	1785	Result := nil;
	1786	end;
	1787
	1788	begin
	1789	if(not assigned(Tree)) then exit;
	1790	Tree.Items.BeginUpdate;
	1791	try
	1792	Tree.NodeDelim := U;
	1793	Tree.NodePiece := 2;
	1794	M.Code := @GetImageIndex;
	1795	M.Data := nil;
	1796	Tree.OnGetImageIndex := TTVExpandedEvent(M);
	1797	Tree.OnGetSelectedIndex := TTVExpandedEvent(M);
	1798	M.Code := @RemContextPopup;
	1799	Tree.OnContextPopup := TContextPopupEvent(M);
	1800
	1801	if(assigned(Tree.TopItem)) then
	1802	begin
	1803	TopID1 := Tree.GetNodeID(TORTreeNode(Tree.TopItem), 1, IncludeParentID);
	1804	TopID2 := Tree.GetNodeID(TORTreeNode(Tree.TopItem), 1);
	1805	end
	1806	else
	1807	TopID1 := U;
	1808
	1809	if(assigned(Tree.Selected)) then
	1810	begin
	1811	SelID1 := Tree.GetNodeID(TORTreeNode(Tree.Selected), 1, IncludeParentID);
	1812	SelID2 := Tree.GetNodeID(TORTreeNode(Tree.Selected), 1);
	1813	end
	1814	else
	1815	SelID1 := U;
	1816
	1817	ExpandedStr := Tree.GetExpandedIDStr(1, IncludeParentID);
	1818	OpenDue := (ExpandedStr = '');
	1819
	1820	Tree.Items.Clear;
	1821	NeedLost := TRUE;
	1822
	1823	if(rfDue in GetRemFolders) then
	1824	(Tree.Items.Add(nil,'') as TORTreeNode).StringData := DueCatString;
	1825	if(rfApplicable in GetRemFolders) then
	1826	(Tree.Items.Add(nil,'') as TORTreeNode).StringData := ApplCatString;
	1827	if(rfNotApplicable in GetRemFolders) then
	1828	(Tree.Items.Add(nil,'') as TORTreeNode).StringData := NotApplCatString;
	1829	if(rfEvaluated in GetRemFolders) then
	1830	(Tree.Items.Add(nil,'') as TORTreeNode).StringData := EvaluatedCatString;
	1831	if(rfOther in GetRemFolders) then
	1832	(Tree.Items.Add(nil,'') as TORTreeNode).StringData := OtherCatString;
	1833
	1834	for i := 0 to EvaluatedReminders.Count-1 do
	1835	begin
	1836	Data := RemCode + EvaluatedReminders[i];
	1837	Tmp := Piece(Data,U,6);
[460]	1838	// if(Tmp = '1') then Add2Tree(rfDue, DueCatID)
	1839	if(Tmp = '1') or (Tmp = '3') or (Tmp = '4') then Add2Tree(rfDue, DueCatID) //AGP Error code change 26.8
[459]	1840	else if(Tmp = '0') then Add2Tree(rfApplicable, ApplCatID)
	1841	else Add2Tree(rfNotApplicable, NotApplCatID);
	1842	Add2Tree(rfEvaluated, EvaluatedCatID);
	1843	end;
	1844
	1845	if(rfOther in GetRemFolders) and (OtherReminders.Count > 0) then
	1846	begin
	1847	for i := 0 to OtherReminders.Count-1 do
	1848	begin
	1849	Tmp := OtherReminders[i];
	1850	if(Piece(Tmp, U, 2) = CatCode) then
	1851	Data := CatCode + Piece(Tmp, U, 1)
	1852	else
	1853	begin
	1854	Code := Piece(Tmp, U, 5);
	1855	Data := RemCode + Code;
	1856	Node := Tree.FindPieceNode(Data, 1);
	1857	if(assigned(Node)) then
	1858	Data := Node.StringData
	1859	else
	1860	begin
	1861	j := EvaluatedReminders.IndexOfPiece(Code);
	1862	if(j >= 0) then
	1863	SetPiece(Data, U, 6, Piece(EvaluatedReminders[j], U, 6));
	1864	end;
	1865	end;
	1866	SetPiece(Data, U, 2, Piece(Tmp, U ,3));
	1867	SetPiece(Data, U, 7, Piece(Tmp, U, 6));
	1868	Tmp := CatCode + Piece(Tmp, U, 4);
	1869	Add2Tree(rfOther, OtherCatID, Tree.FindPieceNode(Tmp, 1));
	1870	end;
	1871	end;
	1872
	1873	{ The Lost category is for reminders being processed that are no longer in the
	1874	reminder tree view. This can happen with reminders that were Due or Applicable,
	1875	but due to user action are no longer applicable, or due to location changes.
	1876	The Lost category will not be used if a lost reminder is in the other list. }
	1877
	1878	if(RemindersInProcess.Count > 0) then
	1879	begin
	1880	for i := 0 to RemindersInProcess.Count-1 do
	1881	begin
	1882	Rem := TReminder(RemindersInProcess.Objects[i]);
	1883	Tmp := RemCode + Rem.IEN;
	1884	Found := FALSE;
	1885	Node := nil;
	1886	repeat
	1887	Node := Tree.FindPieceNode(Tmp, 1, #0, Node); // look in the tree first
	1888	if((not Found) and (not assigned(Node))) then
	1889	begin
	1890	Data := Tmp + U + Rem.PrintName + U + Rem.DueDateStr + U + Rem.LastDateStr + U +
	1891	IntToStr(Rem.Priority) + U + Rem.Status;
	1892	if(Rem.Status = '1') then LostCat := DueCatID
	1893	else if(Rem.Status = '0') then LostCat := ApplCatID
	1894	else LostCat := LostCatID;
	1895	Node := Add2Tree(rfUnknown, LostCat);
	1896	end;
	1897	if(assigned(Node)) then
	1898	begin
	1899	Node.Bold := Rem.Processing;
	1900	Found := TRUE;
	1901	end;
	1902	until(Found and (not assigned(Node)));
	1903	end;
	1904	end;
	1905
	1906	for i := 0 to Tree.Items.Count-1 do
	1907	begin
	1908	Node := TORTreeNode(Tree.Items[i]);
	1909	for j := 3 to 4 do
	1910	begin
	1911	Tmp := Piece(Node.StringData, U, j);
	1912	if(Tmp = '') then
	1913	Data := ''
	1914	else
	1915	Data := FormatFMDateTimeStr(ReminderDateFormat, Tmp);
	1916	Node.SetPiece(j + (RemTreeDateIdx - 3), Data);
	1917	end;
	1918	Node.SetPiece(RemTreeDateIdx + 2, IntToStr(Node.AbsoluteIndex));
	1919	Tmp := Piece(Node.StringData, U, 5);
	1920	if(Tmp <> '1') and (Tmp <> '3') then
	1921	Node.SetPiece(5, '2');
	1922	end;
	1923
	1924	finally
	1925	Tree.Items.EndUpdate;
	1926	end;
	1927
	1928	if(SelID1 = U) then
	1929	Node := nil
	1930	else
	1931	begin
	1932	Node := Tree.FindPieceNode(SelID1, 1, IncludeParentID);
	1933	if(not assigned(Node)) then
	1934	Node := Tree.FindPieceNode(SelID2, 1);
	1935	if(assigned(Node)) then
	1936	Node.EnsureVisible;
	1937	end;
	1938	Tree.Selected := Node;
	1939
	1940	Tree.SetExpandedIDStr(1, IncludeParentID, ExpandedStr);
	1941	if(OpenDue) then
	1942	begin
	1943	Node := Tree.FindPieceNode(DueCatID, 1);
	1944	if(assigned(Node)) then
	1945	Node.Expand(FALSE);
	1946	end;
	1947
	1948	if(TopID1 = U) then
	1949	Tree.TopItem := Tree.Items.GetFirstNode
	1950	else
	1951	begin
	1952	Tree.TopItem := Tree.FindPieceNode(TopID1, 1, IncludeParentID);
	1953	if(not assigned(Tree.TopItem)) then
	1954	Tree.TopItem := Tree.FindPieceNode(TopID2, 1);
	1955	end;
	1956	end;
	1957
	1958	function ReminderNode(Node: TTreeNode): TORTreeNode;
	1959	var
	1960	p1: string;
	1961
	1962	begin
	1963	Result := nil;
	1964	if(assigned(Node)) then
	1965	begin
	1966	p1 := Piece((Node as TORTreeNode).StringData, U, 1);
	1967	if(Copy(p1,1,1) = RemCode) then
	1968	Result := (Node as TORTreeNode)
	1969	end;
	1970	end;
	1971
	1972	procedure LocationChanged(Sender: TObject);
	1973	begin
	1974	LoadReminderData;
	1975	end;
	1976
	1977	procedure ClearReminderData;
	1978	var
	1979	Changed: boolean;
	1980
	1981	begin
	1982	if(assigned(frmReminderTree)) then
	1983	frmReminderTree.Free;
	1984	Changed := ((ActiveReminders.Count > 0) or (OtherReminders.Count > 0) or
	1985	(ProcessingChangeString <> U));
	1986	ActiveReminders.Notifier.BeginUpdate;
	1987	OtherReminders.Notifier.BeginUpdate;
	1988	RemindersInProcess.Notifier.BeginUpdate;
	1989	try
	1990	ProcessedReminders.Clear;
	1991	if(assigned(KillReminderDialogProc)) then
	1992	KillReminderDialogProc(nil);
	1993	ActiveReminders.Clear;
	1994	OtherReminders.Clear;
	1995	EvaluatedReminders.Clear;
	1996	ReminderCallList.Clear;
	1997	RemindersInProcess.KillObjects;
	1998	RemindersInProcess.Clear;
	1999	LastProcessingList := '';
	2000	InitialRemindersLoaded := FALSE;
	2001	CoverSheetRemindersInBackground := FALSE;
	2002	finally
	2003	RemindersInProcess.Notifier.EndUpdate;
	2004	OtherReminders.Notifier.EndUpdate;
	2005	ActiveReminders.Notifier.EndUpdate(Changed);
	2006	RemindersStarted := FALSE;
	2007	LastReminderLocation := -2;
	2008	RemForm.Form := nil;
	2009	end;
	2010	end;
	2011
	2012	procedure RemindersInProcessChanged(Data: Pointer; Sender: TObject; var CanNotify: boolean);
	2013	var
	2014	CurProcessing: string;
	2015	begin
	2016	CurProcessing := ProcessingChangeString;
	2017	CanNotify := (LastProcessingList <> CurProcessing);
	2018	if(CanNotify) then
	2019	LastProcessingList := CurProcessing;
	2020	end;
	2021
	2022	procedure InitReminderObjects;
	2023	var
	2024	M: TMethod;
	2025
	2026	procedure InitReminderList(var List: TORStringList);
	2027	begin
	2028	if(not assigned(List)) then
	2029	List := TORStringList.Create;
	2030	end;
	2031
	2032	begin
	2033	InitReminderList(ActiveReminders);
	2034	InitReminderList(OtherReminders);
	2035	InitReminderList(EvaluatedReminders);
	2036	InitReminderList(ReminderCallList);
	2037	InitReminderList(RemindersInProcess);
	2038	InitReminderList(ProcessedReminders);
	2039
	2040	M.Code := @RemindersInProcessChanged;
	2041	M.Data := nil;
	2042	RemindersInProcess.Notifier.OnNotify := TCanNotifyEvent(M);
	2043
	2044	AddToNotifyWhenCreated(LocationChanged, TEncounter);
	2045
	2046	RemForm.Form := nil;
	2047	end;
	2048
	2049	procedure FreeReminderObjects;
	2050	begin
	2051	KillObj(@ActiveReminders);
	2052	KillObj(@OtherReminders);
	2053	KillObj(@EvaluatedReminders);
	2054	KillObj(@ReminderTreeMenuDlg);
	2055	KillObj(@ReminderTreeMenu);
	2056	KillObj(@ReminderCatMenu);
	2057	KillObj(@EducationTopics);
	2058	KillObj(@WebPages);
	2059	KillObj(@ReminderCallList);
	2060	KillObj(@TmpActive);
	2061	KillObj(@TmpOther);
	2062	KillObj(@RemindersInProcess, TRUE);
	2063	KillObj(@ReminderDialogInfo, TRUE);
	2064	KillObj(@PCERootList, TRUE);
	2065	KillObj(@ProcessedReminders);
	2066	end;
	2067
	2068	function GetReminder(ARemData: string): TReminder;
	2069	var
	2070	idx: integer;
	2071	SIEN: string;
	2072
	2073	begin
	2074	Result := nil;
	2075	SIEN := Piece(ARemData, U, 1);
	2076	if(Copy(SIEN,1,1) = RemCode) then
	2077	begin
	2078	SIEN := copy(Sien, 2, MaxInt);
	2079	idx := RemindersInProcess.IndexOf(SIEN);
	2080	if(idx < 0) then
	2081	begin
	2082	RemindersInProcess.Notifier.BeginUpdate;
	2083	try
	2084	idx := RemindersInProcess.AddObject(SIEN, TReminder.Create(ARemData));
	2085	finally
	2086	RemindersInProcess.Notifier.EndUpdate;
	2087	end;
	2088	end;
	2089	Result := TReminder(RemindersInProcess.Objects[idx]);
	2090	end;
	2091	end;
	2092
	2093	var
	2094	ScootOver: integer = 0;
	2095
	2096	procedure WordWrap(const AText: string; Output: TStrings; LineLength: integer;
	2097	AutoIndent: integer = 4);
	2098	var
	2099	i, l, max, FCount: integer;
	2100	First: boolean;
	2101	OrgText, Text, Prefix: string;
	2102
	2103	begin
	2104	inc(LineLength, ScootOver);
	2105	dec(AutoIndent, ScootOver);
	2106	FCount := Output.Count;
	2107	First := TRUE;
	2108	OrgText := InitText(AText);
	2109	Prefix := StringOfChar(' ',74-LineLength);
	2110	repeat
	2111	i := pos(CRCode, OrgText);
	2112	if(i = 0) then
	2113	begin
	2114	Text := OrgText;
	2115	OrgText := '';
	2116	end
	2117	else
	2118	begin
	2119	Text := copy(OrgText, 1, i - 1);
	2120	delete(OrgText, 1, i + CRCodeLen - 1);
	2121	end;
	2122	if(Text = '') and (OrgText <> '') then
	2123	begin
	2124	Output.Add('');
	2125	inc(FCount);
	2126	end;
	2127	while(Text <> '') do
	2128	begin
	2129	max := length(Text);
	2130	if(max > LineLength) then
	2131	begin
	2132	l := LineLength + 1;
	2133	while(l > 0) and (Text[l] <> ' ') do dec(l);
	2134	if(l < 1) then
	2135	begin
	2136	Output.Add(Prefix+copy(Text,1,LineLength));
	2137	delete(Text,1,LineLength);
	2138	end
	2139	else
	2140	begin
	2141	Output.Add(Prefix+copy(Text,1,l-1));
	2142	while(l <= max) and (Text[l] = ' ') do inc(l);
	2143	delete(Text,1,l-1);
	2144	end;
	2145	if(First) then
	2146	begin
	2147	dec(LineLength, AutoIndent);
	2148	Prefix := Prefix + StringOfChar(' ', AutoIndent);
	2149	First := FALSE;
	2150	end;
	2151	end
	2152	else
	2153	begin
	2154	Output.Add(Prefix+Text);
	2155	Text := '';
	2156	end;
	2157	end;
	2158	if(First) and (FCount <> Output.Count) then
	2159	begin
	2160	dec(LineLength, AutoIndent);
	2161	Prefix := Prefix + StringOfChar(' ', AutoIndent);
	2162	First := FALSE;
	2163	end;
	2164	until(OrgText = '');
	2165	end;
	2166
	2167	function InteractiveRemindersActive: boolean;
	2168	begin
	2169	if(not InteractiveRemindersActiveChecked) then
	2170	begin
	2171	InteractiveRemindersActiveStatus := GetRemindersActive;
	2172	InteractiveRemindersActiveChecked := TRUE;
	2173	end;
	2174	Result := InteractiveRemindersActiveStatus;
	2175	end;
	2176
	2177	function GetReminderData(Rem: TReminderDialog; Lst: TStrings; Finishing: boolean = FALSE;
	2178	Historical: boolean = FALSE): integer;
	2179	begin
	2180	Result := Rem.AddData(Lst, Finishing, Historical);
	2181	end;
	2182
	2183	function GetReminderData(Lst: TStrings; Finishing: boolean = FALSE;
	2184	Historical: boolean = FALSE): integer;
	2185	var
	2186	i: integer;
	2187	begin
	2188	Result := 0;
	2189	for i := 0 to RemindersInProcess.Count-1 do
	2190	inc(Result, TReminder(RemindersInProcess.Objects[i]).AddData(Lst, Finishing, Historical));
	2191	end;
	2192
	2193	procedure SetReminderFormBounds(Frm: TForm; DefX, DefY, DefW, DefH, ALeft, ATop, AWidth, AHeight: integer);
	2194	var
	2195	Rect: TRect;
	2196	ScreenW, ScreenH: integer;
	2197
	2198	begin
	2199	SystemParametersInfo(SPI_GETWORKAREA, 0, @Rect, 0);
	2200	ScreenW := Rect.Right - Rect.Left + 1;
	2201	ScreenH := Rect.Bottom - Rect.Top + 1;
	2202	if(AWidth = 0) then
	2203	AWidth := DefW
	2204	else
	2205	DefW := AWidth;
	2206	if(AHeight = 0) then
	2207	AHeight := DefH
	2208	else
	2209	DefH := AHeight;
	2210	if(DefX = 0) and (DefY = 0) then
	2211	begin
	2212	DefX := (ScreenW - DefW) div 2;
	2213	DefY := (ScreenH - DefH) div 2;
	2214	end
	2215	else
	2216	dec(DefY, DefH);
	2217	if((ALeft <= 0) or (ATop <= 0) or
	2218	((ALeft + AWidth) > ScreenW) or
	2219	((ATop + AHeight) > ScreenH)) then
	2220	begin
	2221	if(DefX < 0) then
	2222	DefX := 0
	2223	else
	2224	if((DefX + DefW) > ScreenW) then
	2225	DefX := ScreenW-DefW;
	2226	if(DefY < 0) then
	2227	DefY := 0
	2228	else
	2229	if((DefY + DefH) > ScreenH) then
	2230	DefY := ScreenH-DefH;
	2231	Frm.SetBounds(Rect.Left + DefX, Rect.Top + DefY, DefW, DefH);
	2232	end
	2233	else
	2234	Frm.SetBounds(Rect.Left + ALeft, Rect.Top + ATop, AWidth, AHeight);
	2235	end;
	2236
	2237	procedure UpdateReminderDialogStatus;
	2238	var
	2239	TmpSL: TStringList;
	2240	Changed: boolean;
	2241
	2242	procedure Build(AList :TORStringList; PNum: integer);
	2243	var
	2244	i: integer;
	2245	Code: string;
	2246
	2247	begin
	2248	for i := 0 to AList.Count-1 do
	2249	begin
	2250	Code := Piece(AList[i],U,PNum);
	2251	if((Code <> '') and (TmpSL.IndexOf(Code) < 0)) then
	2252	TmpSL.Add(Code);
	2253	end;
	2254	end;
	2255
	2256	procedure Reset(AList: TORStringList; PNum, DlgPNum: integer);
	2257	var
	2258	i, j: integer;
	2259	Tmp, Code, Dlg: string;
	2260
	2261	begin
	2262	for i := 0 to TmpSL.Count-1 do
	2263	begin
	2264	Code := Piece(TmpSL[i],U,1);
	2265	j := -1;
	2266	repeat
	2267	j := AList.IndexOfPiece(Code, U, PNum, j);
	2268	if(j >= 0) then
	2269	begin
	2270	Dlg := Piece(TmpSL[i],U,2);
	2271	if(Dlg <> Piece(AList[j], U, DlgPNum)) then
	2272	begin
	2273	Tmp := AList[j];
	2274	SetPiece(Tmp, U, DlgPNum, Dlg);
	2275	AList[j] := Tmp;
	2276	Changed := TRUE;
	2277	end;
	2278	end;
	2279	until (j < 0);
	2280	end;
	2281	end;
	2282
	2283	begin
	2284	Changed := FALSE;
	2285	BeginReminderUpdate;
	2286	try
	2287	TmpSL := TStringList.Create;
	2288	try
	2289	Build(ActiveReminders, 1);
	2290	Build(OtherReminders, 5);
	2291	Build(EvaluatedReminders, 1);
	2292	GetDialogStatus(TmpSL);
	2293	Reset(ActiveReminders, 1, 7);
	2294	Reset(OtherReminders, 5, 6);
	2295	Reset(EvaluatedReminders, 1, 7);
	2296	finally
	2297	TmpSL.Free;
	2298	end;
	2299	finally
	2300	EndReminderUpdate(Changed);
	2301	end;
	2302	end;
	2303
	2304	procedure PrepText4NextLine(var txt: string);
	2305	var
	2306	tlen: integer;
	2307
	2308	begin
	2309	if(txt <> '') then
	2310	begin
	2311	tlen := length(txt);
	2312	if(copy(txt, tlen - CRCodeLen + 1, CRCodeLen) = CRCode) then
	2313	exit;
	2314	if(copy(txt, tlen, 1) = '.') then
	2315	txt := txt + ' ';
	2316	txt := txt + ' ';
	2317	end;
	2318	end;
	2319
	2320	procedure ExpandTIUObjects(var Txt: string; msg: string = '');
	2321	var
	2322	ObjList: TStringList;
	2323	Err: TStringList;
	2324	i, j, k, oLen: integer;
	2325	obj, ObjTxt: string;
	2326
	2327	begin
	2328	ObjList := TStringList.Create;
	2329	try
	2330	Err := nil;
	2331	if(not dmodShared.BoilerplateOK(Txt, CRCode, ObjList, Err)) and (assigned(Err)) then
	2332	begin
	2333	try
	2334	Err.Add(CRLF + 'Contact IRM and inform them about this error.' + CRLF +
	2335	'Make sure you give them the name of the reminder that you are processing,' + CRLF +
	2336	'and which dialog elements were selected to produce this error.');
	2337	InfoBox(Err.Text,'Reminder Boilerplate Object Error', MB_OK + MB_ICONERROR);
	2338	finally
	2339	Err.Free;
	2340	end;
	2341	end;
	2342	if(ObjList.Count > 0) then
	2343	begin
	2344	GetTemplateText(ObjList);
	2345	i := 0;
	2346	while (i < ObjList.Count) do
	2347	begin
	2348	if(pos(ObjMarker, ObjList[i]) = 1) then
	2349	begin
	2350	obj := copy(ObjList[i], ObjMarkerLen+1, MaxInt);
	2351	if(obj = '') then break;
	2352	j := i + 1;
	2353	while (j < ObjList.Count) and (pos(ObjMarker, ObjList[j]) = 0) do
	2354	inc(j);
	2355	if((j - i) > 2) then
	2356	begin
	2357	ObjTxt := '';
	2358	for k := i+1 to j-1 do
	2359	ObjTxt := ObjTxt + CRCode + ObjList[k];
	2360	end
	2361	else
	2362	ObjTxt := ObjList[i+1];
	2363	i := j;
	2364	obj := '\|' + obj + '\|';
	2365	oLen := length(obj);
	2366	repeat
	2367	j := pos(obj, Txt);
	2368	if(j > 0) then
	2369	begin
	2370	delete(Txt, j, OLen);
	2371	insert(ObjTxt, Txt, j);
	2372	end;
	2373	until(j = 0);
	2374	end
	2375	else
	2376	inc(i);
	2377	end
	2378	end;
	2379	finally
	2380	ObjList.Free;
	2381	end;
	2382	end;
	2383
	2384	{ TReminderDialog }
	2385
	2386	const
	2387	RPCCalled = '99';
	2388	DlgCalled = RPCCalled + U + 'DLG';
	2389
	2390	constructor TReminderDialog.BaseCreate;
	2391	var
	2392	idx, eidx, i: integer;
	2393	TempSL: TORStringList;
	2394	ParentID: string;
	2395	// Line: string;
	2396	Element: TRemDlgElement;
	2397
	2398	begin
	2399	TempSL := GetDlgSL;
[460]	2400	if Piece(TempSL[0],U,2)='1' then
	2401	begin
	2402	Self.RemWipe := 1;
	2403	end;
[459]	2404	idx := -1;
	2405	repeat
	2406	idx := TempSL.IndexOfPiece('1', U, 1, idx);
	2407	if(idx >= 0) then
	2408	begin
	2409	if(not assigned(FElements)) then
	2410	FElements := TStringList.Create;
	2411	eidx := FElements.AddObject('',TRemDlgElement.Create);
	2412	Element := TRemDlgElement(FElements.Objects[eidx]);
	2413	with Element do
	2414	begin
	2415	FReminder := Self;
	2416	FRec1 := TempSL[idx];
	2417	FID := Piece(FRec1, U, 2);
	2418	FDlgID := Piece(FRec1, U, 3);
	2419	FElements[eidx] := FDlgID;
	2420	if(ElemType = etTaxonomy) then
	2421	FTaxID := BOOLCHAR[Historical] + FindingType
	2422	else
	2423	FTaxID := '';
	2424
	2425	FText := '';
	2426	i := -1;
	2427	// if Piece(FRec1,U,5) <> '1' then
	2428	repeat
	2429	i := TempSL.IndexOfPieces(['2',FID,FDlgID],i);
	2430	if(i >= 0) then
	2431	begin
	2432	PrepText4NextLine(FText);
	2433	FText := FText + Trim(Piece(TempSL[i], U, 4));
	2434	end;
	2435	until(i < 0);
	2436	ExpandTIUObjects(FText);
	2437	AssignFieldIDs(FText);
	2438
	2439	if(pos('.',FDlgID)>0) then
	2440	begin
	2441	ParentID := FDlgID;
	2442	i := length(ParentID);
	2443	while((i > 0) and (ParentID[i] <> '.')) do
	2444	dec(i);
	2445	if(i > 0) then
	2446	begin
	2447	ParentID := copy(ParentID,1,i-1);
	2448	i := FElements.IndexOf(ParentID);
	2449	if(i >= 0) then
	2450	begin
	2451	FParent := TRemDlgElement(FElements.Objects[i]);
	2452	if(not assigned(FParent.FChildren)) then
	2453	FParent.FChildren := TList.Create;
	2454	FParent.FChildren.Add(Element);
	2455	end;
	2456	end;
	2457	end;
	2458	if(ElemType = etDisplayOnly) then
	2459	SetChecked(TRUE);
	2460	UpdateData;
	2461	end;
	2462	end;
	2463	until(idx < 0);
	2464	end;
	2465
	2466	constructor TReminderDialog.Create(ADlgData: string);
	2467	begin
	2468	FDlgData := ADlgData;
	2469	BaseCreate;
	2470	end;
	2471
	2472	destructor TReminderDialog.Destroy;
	2473	begin
	2474	KillObj(@FElements, TRUE);
	2475	inherited;
	2476	end;
	2477
	2478	function TReminderDialog.Processing: boolean;
	2479	var
	2480	i,j: integer;
	2481	Elem: TRemDlgElement;
	2482	RData: TRemData;
	2483
	2484	function ChildrenChecked(Prnt: TRemDlgElement): boolean; forward;
	2485
	2486	function CheckItem(Item: TRemDlgElement): boolean;
	2487	begin
	2488	if(Item.ElemType = etDisplayOnly) then
	2489	begin
	2490	Result := ChildrenChecked(Item);
	2491	if(not Result) then
	2492	Result := Item.Add2PN;
	2493	end
	2494	else
	2495	Result := Item.FChecked;
	2496	end;
	2497
	2498	function ChildrenChecked(Prnt: TRemDlgElement): boolean;
	2499	var
	2500	i: integer;
	2501
	2502	begin
	2503	Result := FALSE;
	2504	if(assigned(Prnt.FChildren)) then
	2505	begin
	2506	for i := 0 to Prnt.FChildren.Count-1 do
	2507	begin
	2508	Result := CheckItem(TRemDlgElement(Prnt.FChildren[i]));
	2509	if(Result) then break;
	2510	end;
	2511	end;
	2512	end;
	2513
	2514	begin
	2515	Result := FALSE;
	2516	if(assigned(FElements)) then
	2517	begin
	2518	for i := 0 to FElements.Count-1 do
	2519	begin
	2520	Elem := TRemDlgElement(FElements.Objects[i]);
	2521	if(not assigned(Elem.FParent)) then
	2522	begin
	2523	Result := CheckItem(Elem);
	2524	if (Result = false) then //(AGP CHANGE 24.9 add check to have the finish problem check for MH test)
	2525	begin
	2526	if (assigned(Elem.FData)) then
	2527	begin
	2528	for j := 0 to Elem.FData.Count-1 do
	2529	begin
	2530	RData := TRemData(Elem.FData[j]);
	2531	if piece(RData.FRec3,U,4)='MH' then
	2532	Result := True;
	2533	if (Result) then break;
	2534	end;
	2535	end;
	2536	end;
	2537	if(Result) then break;
	2538	end;
	2539	end;
	2540	end;
	2541	end;
	2542
	2543	function TReminderDialog.GetDlgSL: TORStringList;
	2544	var
	2545	idx: integer;
	2546
	2547	begin
	2548	if(not assigned(ReminderDialogInfo)) then
	2549	ReminderDialogInfo := TStringList.Create;
	2550	idx := ReminderDialogInfo.IndexOf(GetIEN);
	2551	if(idx < 0) then
	2552	idx := ReminderDialogInfo.AddObject(GetIEN, TORStringList.Create);
	2553	Result := TORStringList(ReminderDialogInfo.Objects[idx]);
	2554	if(Result.Count = 0) then
	2555	begin
	2556	Result.Assign(GetDialogInfo(GetIEN, (Self is TReminder)));
	2557	Result.Add(DlgCalled); // Used to prevent repeated calling of RPC if dialog is empty
	2558	end;
	2559	end;
	2560
	2561	function TReminderDialog.BuildControls(ParentWidth: integer; AParent, AOwner: TWinControl): TWinControl;
	2562	var
	2563	Y, i: integer;
	2564	Elem: TRemDlgElement;
	2565	ERes: TWinControl;
	2566
	2567	begin
	2568	Result := nil;
	2569	if(assigned(FElements)) then
	2570	begin
	2571	Y := 0;
	2572	for i := 0 to FElements.Count-1 do
	2573	begin
	2574	Elem := TRemDlgElement(FElements.Objects[i]);
	2575	if (not assigned(Elem.FParent)) then
	2576	begin
	2577	ERes := Elem.BuildControls(Y, ParentWidth, AParent, AOwner);
	2578	if(not assigned(Result)) then
	2579	Result := ERes;
	2580	end;
	2581	end;
	2582	end;
	2583	if(AParent.ControlCount = 0) then
	2584	begin
	2585	with TLabel.Create(AOwner) do
	2586	begin
	2587	Parent := AParent;
	2588	Caption := 'No Dialog found for ' + Trim(GetPrintName) + ' Reminder.';
	2589	Left := Gap;
	2590	Top := Gap;
	2591	end;
	2592	end;
	2593	ElementChecked := nil;
	2594	end;
	2595
	2596	procedure TReminderDialog.AddText(Lst: TStrings);
	2597	var
	2598	i, idx: integer;
	2599	Elem: TRemDlgElement;
	2600
	2601	begin
	2602	if(assigned(FElements)) then
	2603	begin
	2604	idx := Lst.Count;
	2605	for i := 0 to FElements.Count-1 do
	2606	begin
	2607	Elem := TRemDlgElement(FElements.Objects[i]);
	2608	if (not assigned(Elem.FParent)) then
	2609	Elem.AddText(Lst);
	2610	end;
	2611	if (Self is TReminder) and (PrintName <> '') and (idx <> Lst.Count) then
	2612	Lst.Insert(idx, ' ' + PrintName + ':')
	2613	end;
	2614	end;
	2615
	2616	function TReminderDialog.AddData(Lst: TStrings; Finishing: boolean = FALSE;
	2617	Historical: boolean = FALSE): integer;
	2618	var
	2619	i: integer;
	2620	Elem: TRemDlgElement;
	2621
	2622	begin
	2623	Result := 0;
	2624	if(assigned(FElements)) then
	2625	begin
	2626	for i := 0 to FElements.Count-1 do
	2627	begin
	2628	Elem := TRemDlgElement(FElements.Objects[i]);
	2629	if (not assigned(Elem.FParent)) then
	2630	inc(Result, Elem.AddData(Lst, Finishing, Historical));
	2631	end;
	2632	end;
	2633	end;
	2634
	2635	procedure TReminderDialog.ComboBoxCheckedText(Sender: TObject; NumChecked: integer; var Text: string);
	2636	var
	2637	i, Done: integer;
	2638	DotLen, ComLen, TxtW, TotalW, NewLen: integer;
	2639	tmp: string;
	2640	Fnt: THandle;
	2641	lb: TORListBox;
	2642
	2643	begin
	2644	if(NumChecked = 0) then
	2645	Text := '(None Selected)'
	2646	else
	2647	if(NumChecked > 1) then
	2648	begin
	2649	Text := '';
	2650	lb := (Sender as TORListBox);
	2651	Fnt := lb.Font.Handle;
	2652	DotLen := TextWidthByFont(Fnt, '...');
	2653	TotalW := (lb.Owner as TControl).ClientWidth - 15;
	2654	ComLen := TextWidthByFont(fnt, ', ');
	2655	dec(TotalW,(NumChecked-1) * ComLen);
	2656	Done := 0;
	2657	for i := 0 to lb.Items.Count-1 do
	2658	begin
	2659	if(lb.Checked[i]) then
	2660	begin
	2661	inc(Done);
	2662	if(Text <> '') then
	2663	begin
	2664	Text := Text + ', ';
	2665	dec(TotalW, ComLen);
	2666	end;
	2667	Tmp := lb.DisplayText[i];
	2668	if(Done = NumChecked) then
	2669	TxtW := TotalW
	2670	else
	2671	TxtW := TotalW div (NumChecked - Done + 1);
	2672	NewLen := NumCharsFitInWidth(fnt, Tmp, TxtW);
	2673	if(NewLen < length(Tmp)) then
	2674	Tmp := copy(Tmp,1,NumCharsFitInWidth(fnt, Tmp, (TxtW - DotLen))) + '...';
	2675	dec(TotalW, TextWidthByFont(fnt, Tmp));
	2676	Text := Text + Tmp;
	2677	end;
	2678	end;
	2679	end;
	2680	end;
	2681
	2682	procedure TReminderDialog.BeginTextChanged;
	2683	begin
	2684	inc(FTextChangedCount);
	2685	end;
	2686
	2687	procedure TReminderDialog.EndTextChanged(Sender: TObject);
	2688	begin
	2689	if(FTextChangedCount > 0) then
	2690	begin
	2691	dec(FTextChangedCount);
	2692	if(FTextChangedCount = 0) and assigned(FOnTextChanged) then
	2693	FOnTextChanged(Sender);
	2694	end;
	2695	end;
	2696
	2697	function TReminderDialog.GetIEN: string;
	2698	begin
	2699	Result := Piece(FDlgData, U, 1);
	2700	end;
	2701
	2702	function TReminderDialog.GetPrintName: string;
	2703	begin
	2704	Result := Piece(FDlgData, U, 2);
	2705	end;
	2706
	2707	procedure TReminderDialog.BeginNeedRedraw;
	2708	begin
	2709	inc(FNeedRedrawCount);
	2710	end;
	2711
	2712	procedure TReminderDialog.EndNeedRedraw(Sender: TObject);
	2713	begin
	2714	if(FNeedRedrawCount > 0) then
	2715	begin
	2716	dec(FNeedRedrawCount);
	2717	if(FNeedRedrawCount = 0) and (assigned(FOnNeedRedraw)) then
	2718	FOnNeedRedraw(Sender);
	2719	end;
	2720	end;
	2721
	2722	procedure TReminderDialog.FinishProblems(List: TStrings; var MissingTemplateFields: boolean);
	2723	var
	2724	i: integer;
	2725	Elem: TRemDlgElement;
	2726	TmpSL: TStringList;
	2727	FldData: TORStringList;
	2728
	2729	begin
	2730	if(Processing and assigned(FElements)) then
	2731	begin
	2732	TmpSL := TStringList.Create;
	2733	try
	2734	FldData := TORStringList.Create;
	2735	try
	2736	for i := 0 to FElements.Count-1 do
	2737	begin
	2738	Elem := TRemDlgElement(FElements.Objects[i]);
	2739	if (not assigned(Elem.FParent)) then
	2740	begin
	2741	Elem.FinishProblems(List);
	2742	Elem.GetFieldValues(FldData);
	2743	end;
	2744	end;
	2745	FNoResolve := TRUE;
	2746	try
	2747	AddText(TmpSL);
	2748	finally
	2749	FNoResolve := FALSE;
	2750	end;
	2751	MissingTemplateFields := AreTemplateFieldsRequired(TmpSL.Text, FldData);
	2752	finally
	2753	FldData.Free;
	2754	end;
	2755	finally
	2756	TmpSL.Free;
	2757	end;
	2758	end;
	2759	end;
	2760
	2761	procedure TReminderDialog.ComboBoxResized(Sender: TObject);
	2762	begin
	2763	// This causes the ONCheckedText event to re-fire and re-update the text,
	2764	// based on the new size of the combo box.
	2765	if(Sender is TORComboBox) then
	2766	with (Sender as TORComboBox) do
	2767	OnCheckedText := OnCheckedText;
	2768	end;
	2769
	2770	function TReminderDialog.Visible: boolean;
	2771	begin
	2772	Result := (CurrentReminderInDialog = Self);
	2773	end;
	2774
	2775	{ TReminder }
	2776
	2777	constructor TReminder.Create(ARemData: string);
	2778	begin
	2779	FRemData := ARemData;
	2780	BaseCreate;
	2781	end;
	2782
	2783	function TReminder.GetDueDateStr: string;
	2784	begin
	2785	Result := Piece(FRemData, U ,3);
	2786	end;
	2787
	2788	function TReminder.GetIEN: string;
	2789	begin
	2790	Result := copy(Piece(FRemData, U, 1), 2, MaxInt);
	2791	end;
	2792
	2793	function TReminder.GetLastDateStr: string;
	2794	begin
	2795	Result := Piece(FRemData, U ,4);
	2796	end;
	2797
	2798	function TReminder.GetPrintName: string;
	2799	begin
	2800	Result := Piece(FRemData, U ,2);
	2801	end;
	2802
	2803	function TReminder.GetPriority: integer;
	2804	begin
	2805	Result := StrToIntDef(Piece(FRemData, U ,5), 2);
	2806	end;
	2807
	2808	function TReminder.GetStatus: string;
	2809	begin
	2810	Result := Piece(FRemData, U ,6);
	2811	end;
	2812
	2813	{ TRemDlgElement }
	2814
	2815	function Code2DataType(Code: string): TRemDataType;
	2816	var
	2817	idx: TRemDataType;
	2818
	2819	begin
	2820	Result := dtUnknown;
	2821	for idx := low(TRemDataType) to high(TRemDataType) do
	2822	begin
	2823	if(Code = RemDataCodes[idx]) then
	2824	begin
	2825	Result := idx;
	2826	break;
	2827	end;
	2828	end;
	2829	end;
	2830
	2831	function Code2PromptType(Code: string): TRemPromptType;
	2832	var
	2833	idx: TRemPromptType;
	2834
	2835	begin
	2836	if(Code = '') then
	2837	Result := ptSubComment
	2838	else
	2839	if(Code = MSTCode) then
	2840	Result := ptMST
	2841	else
	2842	begin
	2843	Result := ptUnknown;
	2844	for idx := low(TRemPromptType) to high(TRemPromptType) do
	2845	begin
	2846	if(Code = RemPromptCodes[idx]) then
	2847	begin
	2848	Result := idx;
	2849	break;
	2850	end;
	2851	end;
	2852	end;
	2853	end;
	2854
	2855	function TRemDlgElement.Add2PN: boolean;
	2856	var
	2857	Lst: TStringList;
	2858
	2859	begin
	2860	if (FChecked) then
	2861	begin
	2862	Result := (Piece(FRec1, U, 5) <> '1');
	2863	//Suppress := (Piece(FRec1,U,1)='1');
	2864	if(Result and (ElemType = etDisplayOnly)) then
	2865	begin
	2866	//Result := FALSE;
	2867	if(assigned(FPrompts) and (FPrompts.Count > 0)) or
	2868	(assigned(FData) and (FData.Count > 0)) or Result then
	2869	begin
	2870	Lst := TStringList.Create;
	2871	try
	2872	AddData(Lst, FALSE);
	2873	Result := (Lst.Count > 0);
	2874	if not assigned(FData) then Result := True;
	2875	finally
	2876	Lst.Free;
	2877	end;
	2878	end;
	2879	end;
	2880	end
	2881	else
	2882	Result := FALSE;
	2883	end;
	2884
	2885	function TRemDlgElement.Box: boolean;
	2886	begin
	2887	Result := (Piece(FRec1, U, 19) = '1');
	2888	end;
	2889
	2890	function TRemDlgElement.BoxCaption: string;
	2891	begin
	2892	if(Box) then
	2893	Result := Piece(FRec1, U, 20)
	2894	else
	2895	Result := '';
	2896	end;
	2897
	2898	function TRemDlgElement.ChildrenIndent: integer;
	2899	begin
	2900	Result := StrToIntDef(Piece(FRec1, U, 16), 0);
	2901	end;
	2902
	2903	function TRemDlgElement.ChildrenRequired: TRDChildReq;
	2904	var
	2905	Tmp: string;
	2906	begin
	2907	Tmp := Piece(FRec1, U, 18);
	2908	if Tmp = '1' then Result := crOne
	2909	else if Tmp = '2' then Result := crAtLeastOne
	2910	else if Tmp = '3' then Result := crNoneOrOne
	2911	else Result := crNone;
	2912	end;
	2913
	2914	function TRemDlgElement.ChildrenSharePrompts: boolean;
	2915	begin
	2916	Result := (Piece(FRec1, U, 17) = '1');
	2917	end;
	2918
	2919	destructor TRemDlgElement.Destroy;
	2920	begin
	2921	KillObj(@FFieldValues);
	2922	KillObj(@FData, TRUE);
	2923	KillObj(@FPrompts, TRUE);
	2924	KillObj(@FChildren);
	2925	inherited;
	2926	end;
	2927
	2928	function TRemDlgElement.ElemType: TRDElemType;
	2929	var
	2930	Tmp: string;
	2931
	2932	begin
[460]	2933	Tmp := Piece(FRec1, U, 4);
	2934	if(Tmp = 'D') then Result := etDisplayOnly
	2935	else if(Tmp = 'T') then Result := etTaxonomy
	2936	else Result := etCheckBox;
[459]	2937	end;
	2938
	2939	function TRemDlgElement.FindingType: string;
	2940	begin
	2941	if(ElemType = etTaxonomy) then
	2942	Result := Piece(FRec1, U, 7)
	2943	else
	2944	Result := '';
	2945	end;
	2946
	2947	function TRemDlgElement.HideChildren: boolean;
	2948	begin
	2949	Result := (Piece(FRec1, U, 15) <> '0');
	2950	end;
	2951
	2952	function TRemDlgElement.Historical: boolean;
	2953	begin
	2954	Result := (Piece(FRec1, U, 8) = '1');
	2955	end;
	2956
	2957	function TRemDlgElement.Indent: integer;
	2958	begin
	2959	Result := StrToIntDef(Piece(FRec1, U, 6), 0);
	2960	end;
	2961
	2962	procedure TRemDlgElement.GetData;
	2963	var
	2964	TempSL: TStrings;
	2965	i: integer;
	2966	Tmp: string;
	2967
	2968	begin
	2969	if FHaveData then exit;
	2970	if(FReminder.GetDlgSL.IndexOfPieces([RPCCalled, FID, FTaxID]) < 0) then
	2971	begin
	2972	TempSL := GetDialogPrompts(FID, Historical, FindingType);
	2973	TempSL.Add(RPCCalled);
	2974	for i := 0 to TempSL.Count-1 do
	2975	begin
	2976	Tmp := TempSL[i];
	2977	SetPiece(Tmp,U,2,FID);
	2978	SetPiece(Tmp,U,3,FTaxID);
	2979	TempSL[i] := Tmp;
	2980	end;
	2981	FReminder.GetDlgSL.AddStrings(TempSL);
	2982	end;
	2983	UpdateData;
	2984	end;
	2985
	2986	procedure TRemDlgElement.UpdateData;
	2987	var
	2988	Ary: array of integer;
	2989	idx, i,cnt: integer;
	2990	TempSL: TORStringList;
	2991	RData: TRemData;
	2992	RPrompt: TRemPrompt;
	2993	Tmp, Tmp2: string;
	2994	NewLine: boolean;
	2995	dt: TRemDataType;
	2996	pt: TRemPromptType;
	2997	DateRange: string;
	2998	ChoicesActiveDates: TStringList;
	2999	ChoiceIdx: integer;
	3000	Piece7: string;
	3001
	3002	begin
	3003	if FHaveData then exit;
	3004	TempSL := FReminder.GetDlgSL;
	3005	if(TempSL.IndexOfPieces([RPCCalled, FID, FTaxID]) >= 0) then
	3006	begin
	3007	FHaveData := TRUE;
	3008	RData := nil;
	3009	idx := -1;
	3010	repeat
	3011	idx := TempSL.IndexOfPieces(['3', FID, FTaxID], idx);
	3012	if (idx >= 0) and (Pieces(TempSL[idx-1],U,1,6) = Pieces(TempSL[idx],u,1,6)) then
	3013	if pos(':', Piece(TempSL[idx],U,7)) > 0 then //if has date ranges
	3014	begin
	3015	if RData <> nil then
	3016	begin
	3017	if (not assigned(RData.FActiveDates)) then
	3018	RData.FActiveDates := TStringList.Create;
	3019	DateRange := Pieces(Piece(TempSL[idx],U,7),':',2,3);
	3020	RData.FActiveDates.Add(DateRange);
	3021	end;
	3022	end;
	3023	if(idx >= 0) and (Pieces(TempSL[idx-1],U,1,6) <> Pieces(TempSL[idx],u,1,6)) then
	3024	begin
	3025	dt := Code2DataType(piece(TempSL[idx], U, r3Type));
	3026	if(dt <> dtUnknown) and ((dt <> dtOrder) or
[460]	3027	(CharAt(piece(TempSL[idx], U, 11),1) in ['D', 'Q', 'M', 'O', 'A'])) and //AGP change 26.10 for allergy orders
[459]	3028	((dt <> dtMentalHealthTest) or MHTestsOK) then
	3029	begin
	3030	if(not assigned(FData)) then
	3031	FData := TList.Create;
	3032	RData := TRemData(FData[FData.Add(TRemData.Create)]);
	3033	if pos(':',Piece(TempSL[idx],U,7)) > 0 then
	3034	begin
	3035	RData.FActiveDates := TStringList.Create;
	3036	RData.FActiveDates.Add(Pieces(Piece(TempSL[idx],U,7),':',2,3));
	3037	end;
	3038	with RData do
	3039	begin
	3040	FParent := Self;
	3041	Piece7 := Piece(Piece(TempSL[idx],U,7),':',1);
	3042	FRec3 := TempSL[idx];
	3043	SetPiece(FRec3,U,7,Piece7);
	3044	// FRoot := FRec3;
	3045	i := idx + 1;
	3046	ChoiceIdx := 0;
	3047	while((i < TempSL.Count) and (TempSL.PiecesEqual(i, ['5', FID, FTaxID]))) do
	3048	begin
	3049	if (Pieces(TempSL[i-1],U,1,6) = Pieces(TempSL[i],U,1,6)) then
	3050	begin
	3051	if pos(':', Piece(TempSL[i],U,7)) > 0 then
	3052	begin
	3053	if (not assigned(FChoicesActiveDates)) then
	3054	begin
	3055	FChoicesActiveDates := TList.Create;
	3056	ChoicesActiveDates := TStringList.Create;
	3057	FChoicesActiveDates.Insert(ChoiceIdx, ChoicesActiveDates);
	3058	end;
	3059	TStringList(FChoicesActiveDates[ChoiceIdx]).Add(Pieces(Piece(TempSL[i],U,7),':',2,3));
	3060	end;
	3061	inc(i);
	3062	end
	3063	else
	3064	begin
	3065	if(not assigned(FChoices)) then
	3066	begin
	3067	FChoices := TORStringList.Create;
	3068	if(not assigned(FPrompts)) then
	3069	FPrompts := TList.Create;
	3070	FChoicePrompt := TRemPrompt(FPrompts[FPrompts.Add(TRemPrompt.Create)]);
	3071	with FChoicePrompt do
	3072	begin
	3073	FParent := Self;
	3074	Tmp := Piece(FRec3,U,10);
	3075	NewLine := (Tmp <> '');
	3076	FRec4 := '4' + U + FID + U + FTaxID + U + U + BOOLCHAR[not RData.Add2PN] + U + U +
	3077	'P' + U + Tmp + U + BOOLCHAR[NewLine] + U + '1';
	3078	FData := RData;
	3079	FOverrideType := ptDataList;
	3080	InitValue;
	3081	end;
	3082	end;
	3083	Tmp := TempSL[i];
	3084	Piece7 := Piece(Piece(TempSL[i],U,7),':',1);
	3085	SetPiece(Tmp,U,7,Piece7);
	3086	Tmp2 := Piece(Piece(Tmp,U,r3Code),':',1);
	3087	if(Tmp2 <> '') then Tmp2 := ' (' + Tmp2 + ')';
	3088	Tmp2 := MixedCase(Piece(Tmp,U,r3Nar)) + Tmp2;
	3089	SetPiece(Tmp,U,12,Tmp2);
	3090	ChoiceIdx := FChoices.Add(Tmp);
	3091	if pos(':',Piece(TempSL[i],U,7)) > 0 then
	3092	begin
	3093	if (not assigned(FChoicesActiveDates)) then
	3094	FChoicesActiveDates := TList.Create;
	3095	ChoicesActiveDates := TStringList.Create;
	3096	ChoicesActiveDates.Add(Pieces(Piece(TempSL[i],U,7),':',2,3));
	3097	FChoicesActiveDates.Insert(ChoiceIdx, ChoicesActiveDates);
	3098	end
	3099	else
	3100	if assigned(FChoicesActiveDates) then
	3101	FChoicesActiveDates.Insert(ChoiceIdx, TStringList.Create);
	3102	inc(i);
	3103	end;
	3104	end;
	3105	if(assigned(FChoices)) and (FChoices.Count = 1) then // If only one choice just pick it
	3106	begin
	3107	FPrompts.Remove(FChoicePrompt);
	3108	KillObj(@FChoicePrompt);
	3109	Tmp := FChoices[0];
	3110	KillObj(@FChoices);
	3111	cnt := 5;
	3112	if(Piece(FRec3,U,9) = '') then inc(cnt);
	3113	SetLength(Ary,cnt);
	3114	for i := 0 to cnt-1 do
	3115	Ary[i] := i+4;
	3116	SetPieces(FRec3, U, Ary, Tmp);
	3117	end;
	3118	if(assigned(FChoices)) then
	3119	begin
	3120	for i := 0 to FChoices.Count-1 do
	3121	FChoices.Objects[i] := TRemPCERoot.GetRoot(RData, FChoices[i], Historical);
	3122	end
	3123	else
	3124	FPCERoot := TRemPCERoot.GetRoot(RData, RData.FRec3, Historical);
	3125	if(dt = dtVitals) then
	3126	begin
	3127	if(Code2VitalType(Piece(FRec3,U,6)) <> vtUnknown) then
	3128	begin
	3129	if(not assigned(FPrompts)) then
	3130	FPrompts := TList.Create;
	3131	FChoicePrompt := TRemPrompt(FPrompts[FPrompts.Add(TRemPrompt.Create)]);
	3132	with FChoicePrompt do
	3133	begin
	3134	FParent := Self;
	3135	Tmp := Piece(FRec3,U,10);
	3136	NewLine := FALSE;
	3137	// FRec4 := '4' + U + FID + U + FTaxID + U + U + BOOLCHAR[not RData.Add2PN] + U +
	3138	// RData.InternalValue + U + 'P' + U + Tmp + U + BOOLCHAR[SameL] + U + '1';
	3139	FRec4 := '4' + U + FID + U + FTaxID + U + U + BOOLCHAR[not RData.Add2PN] + U +
	3140	U + 'P' + U + Tmp + U + BOOLCHAR[NewLine] + U + '0';
	3141	FData := RData;
	3142	FOverrideType := ptVitalEntry;
	3143	InitValue;
	3144	end;
	3145	end;
	3146	end;
	3147	if(dt = dtMentalHealthTest) then
	3148	begin
	3149	if(not assigned(FPrompts)) then
	3150	FPrompts := TList.Create;
	3151	FChoicePrompt := TRemPrompt(FPrompts[FPrompts.Add(TRemPrompt.Create)]);
	3152	with FChoicePrompt do
	3153	begin
	3154	FParent := Self;
	3155	Tmp := Piece(FRec3,U,10);
	3156	NewLine := FALSE;
	3157	// FRec4 := '4' + U + FID + U + FTaxID + U + U + BOOLCHAR[not RData.Add2PN] + U +
	3158	// RData.InternalValue + U + 'P' + U + Tmp + U + BOOLCHAR[SameL] + U + '1';
	3159	FRec4 := '4' + U + FID + U + FTaxID + U + U + BOOLCHAR[not RData.Add2PN] + U +
	3160	U + 'P' + U + Tmp + U + BOOLCHAR[NewLine] + U + '0';
	3161	FData := RData;
	3162	if(Piece(FRec3, U, r3GAF) = '1') then
	3163	begin
	3164	FOverrideType := ptGAF;
	3165	SetPiece(FRec4, U, 8, ForcedCaption + ':');
	3166	end
	3167	else
	3168	FOverrideType := ptMHTest;
	3169	end;
	3170	end;
	3171	end;
	3172	end;
	3173	end;
	3174	until(idx < 0);
	3175
	3176	idx := -1;
	3177	repeat
	3178	idx := TempSL.IndexOfPieces(['4', FID, FTaxID], idx);
	3179	if(idx >= 0) then
	3180	begin
	3181	pt := Code2PromptType(piece(TempSL[idx], U, 4));
	3182	if(pt <> ptUnknown) and ((pt <> ptComment) or (not FHasComment)) then
	3183	begin
	3184	if(not assigned(FPrompts)) then
	3185	FPrompts := TList.Create;
	3186	RPrompt := TRemPrompt(FPrompts[FPrompts.Add(TRemPrompt.Create)]);
	3187	with RPrompt do
	3188	begin
	3189	FParent := Self;
	3190	FRec4 := TempSL[idx];
	3191	InitValue;
	3192	end;
	3193	if(pt = ptComment) then
	3194	begin
	3195	FHasComment := TRUE;
	3196	FCommentPrompt := RPrompt;
	3197	end;
	3198	if(pt = ptSubComment) then
	3199	FHasSubComments := TRUE;
	3200	if(pt = ptMST) then
	3201	FMSTPrompt := RPrompt;
	3202	end;
	3203	end;
	3204	until(idx < 0);
	3205
	3206	idx := -1;
	3207	repeat
	3208	idx := TempSL.IndexOfPieces(['6', FID, FTaxID], idx);
	3209	if(idx >= 0) then
	3210	begin
	3211	PrepText4NextLine(FPNText);
	3212	FPNText := FPNText + Trim(Piece(TempSL[idx], U, 4));
	3213	end;
	3214	until(idx < 0);
	3215	ExpandTIUObjects(FPNText);
	3216	end;
	3217	end;
	3218
	3219	procedure TRemDlgElement.SetChecked(const Value: boolean);
	3220	var
	3221	i, j, k: integer;
	3222	Kid: TRemDlgElement;
	3223	Prompt: TRemPrompt;
	3224	RData: TRemData;
	3225
	3226	procedure UpdateForcedValues(Elem: TRemDlgElement);
	3227	var
	3228	i: integer;
	3229
	3230	begin
	3231	if(Elem.IsChecked) then
	3232	begin
	3233	if(assigned(Elem.FPrompts)) then
	3234	begin
	3235	for i := 0 to Elem.FPrompts.Count-1 do
	3236	begin
	3237	Prompt := TRemPrompt(Elem.FPrompts[i]);
	3238	if Prompt.Forced then
	3239	begin
	3240	try
	3241	Prompt.SetValueFromParent(Prompt.FValue);
	3242	except
	3243	on E: EForcedPromptConflict do
	3244	begin
	3245	Elem.FChecked := FALSE;
	3246	InfoBox(E.Message, 'Error', MB_OK or MB_ICONERROR);
	3247	break;
	3248	end
	3249	else
	3250	raise;
	3251	end;
	3252	end;
	3253	end;
	3254	end;
	3255	if(Elem.FChecked) and (assigned(Elem.FChildren)) then
	3256	for i := 0 to Elem.FChildren.Count-1 do
	3257	UpdateForcedValues(TRemDlgElement(Elem.FChildren[i]));
	3258	end;
	3259	end;
	3260
	3261	begin
	3262	if(FChecked <> Value) then
	3263	begin
	3264	FChecked := Value;
	3265	if(Value) then
	3266	begin
	3267	GetData;
	3268	if(FChecked and assigned(FParent)) then
	3269	begin
	3270	FParent.Check4ChildrenSharedPrompts;
	3271	if(FParent.ChildrenRequired in [crOne, crNoneOrOne]) then
	3272	begin
	3273	for i := 0 to FParent.FChildren.Count-1 do
	3274	begin
	3275	Kid := TRemDlgElement(FParent.FChildren[i]);
	3276	if(Kid <> Self) and (Kid.FChecked) then
	3277	Kid.SetChecked(FALSE);
	3278	end;
	3279	end;
	3280	end;
	3281	UpdateForcedValues(Self);
	3282	end
	3283	else
	3284	if(assigned(FPrompts) and assigned(FData)) then
	3285	begin
	3286	for i := 0 to FPrompts.Count-1 do
	3287	begin
	3288	Prompt := TRemPrompt(FPrompts[i]);
	3289	if Prompt.Forced and (IsSyncPrompt(Prompt.PromptType)) then
	3290	begin
	3291	for j := 0 to FData.Count-1 do
	3292	begin
	3293	RData := TRemData(FData[j]);
	3294	if(assigned(RData.FPCERoot)) then
	3295	RData.FPCERoot.UnSync(Prompt);
	3296	if(assigned(RData.FChoices)) then
	3297	begin
	3298	for k := 0 to RData.FChoices.Count-1 do
	3299	begin
	3300	if(assigned(RData.FChoices.Objects[k])) then
	3301	TRemPCERoot(RData.FChoices.Objects[k]).UnSync(Prompt);
	3302	end;
	3303	end;
	3304	end;
	3305	end;
	3306	end;
	3307	end;
	3308	end;
	3309	end;
	3310
	3311	function TRemDlgElement.TrueIndent: integer;
	3312	var
	3313	Prnt: TRemDlgElement;
	3314	Nudge: integer;
	3315
	3316	begin
	3317	Result := Indent;
	3318	Nudge := Gap;
	3319	Prnt := FParent;
	3320	while assigned(Prnt) do
	3321	begin
	3322	if(Prnt.Box) then
	3323	begin
	3324	Prnt := nil;
	3325	inc(Nudge, Gap);
	3326	end
	3327	else
	3328	begin
	3329	Result := Result + Prnt.ChildrenIndent;
	3330	Prnt := Prnt.FParent;
	3331	end;
	3332	end;
	3333	Result := (Result * IndentMult) + Nudge;
	3334	end;
	3335
	3336	procedure TRemDlgElement.cbClicked(Sender: TObject);
	3337	begin
	3338	FReminder.BeginTextChanged;
	3339	try
	3340	FReminder.BeginNeedRedraw;
	3341	try
	3342	if(assigned(Sender)) then
	3343	begin
	3344	SetChecked((Sender as TORCheckBox).Checked);
	3345	ElementChecked := Self;
	3346	end;
	3347	finally
	3348	FReminder.EndNeedRedraw(Sender);
	3349	end;
	3350	finally
	3351	FReminder.EndTextChanged(Sender);
	3352	end;
	3353	RemindersInProcess.Notifier.Notify;
	3354	TFieldPanel(TORCheckBox(Sender).Associate).SetFocus;
	3355	end;
	3356
	3357	function TRemDlgElement.EnableChildren: boolean;
	3358	var
	3359	Chk: boolean;
	3360
	3361	begin
	3362	if(assigned(FParent)) then
	3363	Chk := FParent.EnableChildren
	3364	else
	3365	Chk := TRUE;
	3366	if(Chk) then
	3367	begin
	3368	if(ElemType = etDisplayOnly) then
	3369	Result := TRUE
	3370	else
	3371	Result := FChecked;
	3372	end
	3373	else
	3374	Result := FALSE;
	3375	end;
	3376
	3377	function TRemDlgElement.Enabled: boolean;
	3378	begin
	3379	if(assigned(FParent)) then
	3380	Result := FParent.EnableChildren
	3381	else
	3382	Result := TRUE;
	3383	end;
	3384
	3385	function TRemDlgElement.ShowChildren: boolean;
	3386	begin
	3387	if(assigned(FChildren) and (FChildren.Count > 0)) then
	3388	begin
	3389	if((ElemType = etDisplayOnly) or FChecked) then
	3390	Result := TRUE
	3391	else
	3392	Result := (not HideChildren);
	3393	end
	3394	else
	3395	Result := FALSE;
	3396	end;
	3397
	3398	procedure TRemDlgElement.ParentCBEnter(Sender: TObject);
	3399	begin
	3400	(Sender as TORCheckbox).FocusOnBox := true;
	3401	end;
	3402
	3403	procedure TRemDlgElement.ParentCBExit(Sender: TObject);
	3404	begin
	3405	(Sender as TORCheckbox).FocusOnBox := false;
	3406	end;
	3407
	3408
	3409	function TRemDlgElement.BuildControls(var Y: integer; ParentWidth: integer;
	3410	BaseParent, AOwner: TWinControl): TWinControl;
	3411	var
	3412	lbl: TLabel;
	3413	pnl: TPanel;
	3414	AutoFocusControl: TWinControl;
	3415	cb: TORCheckBox;
	3416	gb: TGroupBox;
	3417	ERes, prnt: TWinControl;
	3418	PrntWidth: integer;
	3419	i, X, Y1: integer;
	3420	LastX, MinX, MaxX: integer;
	3421	Prompt: TRemPrompt;
	3422	Ctrl: TMultiClassObj;
	3423	OK, DoLbl, HasVCombo, cbSingleLine: boolean;
	3424	ud: TUpDown;
	3425	HelpBtn: TButton;
	3426	vCombo: TComboBox;
	3427	pt: TRemPromptType;
	3428	SameLineCtrl: TList;
	3429	Kid: TRemDlgElement;
	3430	vt: TVitalType;
	3431	DefaultDate: TFMDateTime;
	3432
	3433	function GetPanel(const EID, AText: string; const PnlWidth: integer): TPanel;
	3434	var
	3435	idx, p: integer;
	3436	Entry: TTemplateDialogEntry;
	3437
	3438	begin
	3439	// This call creates a new TTemplateDialogEntry if necessary and creates the
	3440	// necessary template field controls with their default values stored in the
	3441	// TTemplateField object.
	3442	Entry := GetDialogEntry(BaseParent, EID + IntToStr(Integer(BaseParent)), AText);
	3443	Entry.InternalID := EID;
	3444	// This call looks for the Entry's values in TRemDlgElement.FFieldValues
	3445	idx := FFieldValues.IndexOfPiece(EID);
	3446	// If the Entry's values were found in the previous step then they will be
	3447	// restored to the TTemplateDialogEntry.FieldValues in the next step.
	3448	if(idx >= 0) then
	3449	begin
	3450	p := pos(U, FFieldValues[idx]); // Can't use Piece because 2nd piece may contain ^ characters
	3451	if(p > 0) then
	3452	Entry.FieldValues := copy(FFieldValues[idx],p+1,MaxInt);
	3453	end;
	3454	Entry.AutoDestroyOnPanelFree := TRUE;
	3455	// The FieldPanelChange event handler is where the Entry.FieldValues are saved to the
	3456	// Element.FFieldValues.
	3457	Entry.OnChange := FieldPanelChange;
	3458	// Calls TTemplateDialogEntry.SetFieldValues which calls
	3459	// TTemplateDialogEntry.SetControlText to reset the template field default
	3460	// values to the values that were restored to the Entry from the Element if
	3461	// they exist, otherwise the default values will remain.
	3462	Result := Entry.GetPanel(PnlWidth, BaseParent);
	3463	end;
	3464
	3465	procedure NextLine(var Y: integer);
	3466	var
	3467	i: integer;
	3468	MaxY: integer;
	3469	C: TControl;
	3470
	3471
	3472	begin
	3473	MaxY := 0;
	3474	for i := 0 to SameLineCtrl.Count-1 do
	3475	begin
	3476	C := TControl(SameLineCtrl[i]);
	3477	if(MaxY < C.Height) then
	3478	MaxY := C.Height;
	3479	end;
	3480	for i := 0 to SameLineCtrl.Count-1 do
	3481	begin
	3482	C := TControl(SameLineCtrl[i]);
	3483	if(MaxY > C.Height) then
	3484	C.Top := Y + ((MaxY - C.Height) div 2);
	3485	end;
	3486	inc(Y, MaxY);
	3487	if assigned(cb) and assigned(pnl) then
	3488	cb.Top := pnl.Top;
	3489	SameLineCtrl.Clear;
	3490	end;
	3491
	3492	procedure AddPrompts(Shared: boolean; AParent: TWinControl; PWidth: integer; var Y: integer);
	3493	var
	3494	i, j, k, idx: integer;
	3495	DefLoc: TStrings;
	3496	LocText: string;
	3497	LocFound: boolean;
	3498	m, n: integer;
	3499	ActDt, InActDt: Double;
	3500	EncDt: TFMDateTime;
	3501	ActChoicesSL: TORStringList;
	3502	Piece12, WHReportStr: String;
	3503	WrapLeft, LineWidth: integer;
	3504
	3505	begin
	3506	SameLineCtrl := TList.Create;
	3507	try
	3508	if(assigned(cb)) then
	3509	begin
	3510	if(not Shared) then
	3511	begin
	3512	SameLineCtrl.Add(cb);
	3513	SameLineCtrl.Add(pnl);
	3514	end;
	3515	if(cbSingleLine and (not Shared)) then
	3516	LastX := cb.Left + pnl.Width + PromptGap + IndentGap
	3517	else
	3518	LastX := PWidth;
	3519	end
	3520	else
	3521	begin
	3522	if(not Shared) then SameLineCtrl.Add(pnl);
	3523	LastX := PWidth;
	3524	end;
	3525	for i := 0 to FPrompts.Count-1 do
	3526	begin
	3527	Prompt := TRemPrompt(FPrompts[i]);
	3528	OK := ((Prompt.FIsShared = Shared) and Prompt.PromptOK and (not Prompt.Forced));
	3529	if(OK and Shared) then
	3530	begin
	3531	OK := FALSE;
	3532	for j := 0 to Prompt.FSharedChildren.Count-1 do
	3533	begin
	3534	Kid := TRemDlgElement(Prompt.FSharedChildren[j]);
	3535	// if(Kid.ElemType <> etDisplayOnly) and (Kid.FChecked) then
	3536	if(Kid.FChecked) then
	3537	begin
	3538	OK := TRUE;
	3539	break;
	3540	end;
	3541	end;
	3542	end;
	3543	Ctrl.Ctrl := nil;
	3544	ud := nil;
	3545	HelpBtn := nil;
	3546	vCombo := nil;
	3547	HasVCombo := FALSE;
	3548	if(OK) then
	3549	begin
	3550	pt := Prompt.PromptType;
	3551	MinX := 0;
	3552	MaxX := 0;
	3553	lbl := nil;
	3554	DoLbl := Prompt.Required;
	3555	case pt of
[460]	3556	ptComment, ptQuantity:
[459]	3557	begin
	3558	Ctrl.edt := TEdit.Create(AOwner);
	3559	Ctrl.ctrl.Parent := AParent;
	3560	Ctrl.edt.Text := Prompt.Value;
	3561	if(pt = ptComment) then
	3562	begin
	3563	Ctrl.edt.MaxLength := 245;
	3564	MinX := TextWidthByFont(Ctrl.edt.Font.Handle, 'AbCdEfGhIjKlMnOpQrStUvWxYz 1234');
	3565	MaxX := PWidth;
	3566	end
	3567	else
	3568	begin
	3569	ud := TUpDown.Create(AOwner);
	3570	ud.Parent := AParent;
	3571	ud.Associate := Ctrl.edt;
	3572	if(pt = ptQuantity) then
	3573	begin
	3574	ud.Min := 1;
	3575	ud.Max := 100;
	3576	end
	3577	else
	3578	begin
	3579	ud.Min := 0;
	3580	ud.Max := 40;
	3581	end;
	3582	MinX := TextWidthByFont(Ctrl.edt.Font.Handle, IntToStr(ud.Max)) + 24;
	3583	ud.Position := StrToIntDef(Prompt.Value, ud.Min);
	3584	end;
	3585	Ctrl.edt.OnKeyPress := Prompt.EditKeyPress;
	3586	Ctrl.edt.OnChange := Prompt.PromptChange;
	3587	DoLbl := TRUE;
	3588	end;
	3589
	3590	ptVisitLocation, ptLevelUnderstanding,
	3591	ptSeries, ptReaction, ptExamResults,
[460]	3592	ptLevelSeverity, ptSkinResults, ptSkinReading:
[459]	3593	begin
	3594	Ctrl.cbo := TORComboBox.Create(AOwner);
	3595	Ctrl.ctrl.Parent := AParent;
	3596	Ctrl.cbo.OnKeyDown := Prompt.ComboBoxKeyDown;
	3597	Ctrl.cbo.Style := orcsDropDown;
	3598	Ctrl.cbo.Pieces := '2';
[460]	3599	if pt = ptSkinReading then
	3600	begin
	3601	Ctrl.cbo.Pieces := '1';
	3602	Ctrl.cbo.Items.Add('');
	3603	for j := 0 to 50 do Ctrl.cbo.Items.Add(inttostr(j));
	3604	GetComboBoxMinMax(Ctrl.cbo,MinX, MaxX);
	3605	end;
	3606	if pt <> ptSkinReading then
	3607	begin
	3608	Ctrl.cbo.Tag := ComboPromptTags[pt];
	3609	PCELoadORCombo(Ctrl.cbo, MinX, MaxX);
	3610	end;
[459]	3611	if pt = ptVisitLocation then
	3612	begin
	3613	DefLoc := GetDefLocations;
	3614	if DefLoc.Count > 0 then
	3615	begin
	3616	idx := 1;
	3617	for j := 0 to DefLoc.Count-1 do
	3618	begin
	3619	LocText := piece(DefLoc[j],U,2);
	3620	if LocText <> '' then
	3621	begin
	3622	if (LocText <> '0') and (IntToStr(StrToIntDef(LocText,0)) = LocText) then
	3623	begin
	3624	LocFound := FALSE;
	3625	for k := 0 to Ctrl.cbo.Items.Count-1 do
	3626	begin
	3627	if(piece(Ctrl.cbo.Items[k],U,1) = LocText) then
	3628	begin
	3629	LocText := Ctrl.cbo.Items[k];
	3630	LocFound := TRUE;
	3631	break;
	3632	end;
	3633	end;
	3634	if not LocFound then
	3635	LocText := '';
	3636	end
	3637	else
	3638	LocText := '0^'+LocText;
	3639	if LocText <> '' then
	3640	begin
	3641	Ctrl.cbo.Items.Insert(idx, LocText);
	3642	inc(idx);
	3643	end;
	3644	end;
	3645	end;
	3646
	3647	if idx > 1 then
	3648	begin
	3649	Ctrl.cbo.Items.Insert(idx, '-1' + LLS_LINE);
	3650	Ctrl.cbo.Items.Insert(idx+1, '-1' + LLS_SPACE);
	3651	end;
	3652	end;
	3653	end;
	3654
	3655	MinX := MaxX;
	3656	Ctrl.cbo.SelectByID(Prompt.Value);
	3657	if(Ctrl.cbo.ItemIndex < 0) then
	3658	begin
	3659	Ctrl.cbo.Text := Prompt.Value;
	3660	if(pt = ptVisitLocation) then
	3661	Ctrl.cbo.Items[0] := '0' + U + Prompt.Value;
	3662	end;
	3663	if(Ctrl.cbo.ItemIndex < 0) then
	3664	Ctrl.cbo.ItemIndex := 0;
	3665	Ctrl.cbo.OnChange := Prompt.PromptChange;
	3666	DoLbl := TRUE;
	3667	Ctrl.cbo.ListItemsOnly := (pt <> ptVisitLocation);
	3668	end;
	3669
	3670	ptWHPapResult:
	3671	begin
	3672	if FData<>nil then
	3673	begin
	3674	if (TRemData(FData[i]).DisplayWHResults)=true then
	3675	begin
	3676	NextLine(Y);
	3677	Ctrl.btn := TButton.Create(AOwner);
	3678	Ctrl.ctrl.Parent := AParent;
	3679	Ctrl.btn.Left := NewLInePromptGap+15;
	3680	Ctrl.btn.Top := Y+7;
	3681	Ctrl.btn.OnClick := Prompt.DoWHReport;
	3682	Ctrl.btn.Caption := 'Review complete report';
	3683	Ctrl.btn.Width := TextWidthByFont(Ctrl.btn.Font.Handle, Ctrl.btn.Caption) + 13;
	3684	Ctrl.btn.Height := TextHeightByFont(Ctrl.btn.Font.Handle, Ctrl.btn.Caption) + 13;
	3685	Ctrl.btn.Height := TextHeightByFont(Ctrl.btn.Handle, Ctrl.btn.Caption) + 8;
	3686	Y := ctrl.btn.Top + Ctrl.btn.Height;
	3687	NextLine(Y);
	3688	Ctrl.WHChk := TWHCheckBox.Create(AOwner);
	3689	Ctrl.ctrl.Parent := AParent;
	3690	Ctrl.WHChk.Flbl := TLabel.Create(AOwner);
	3691	Ctrl.WHChk.Flbl.Parent := Ctrl.WHChk.Parent;
	3692	Ctrl.WHChk.Flbl.Caption := Prompt.Caption;
	3693	Ctrl.WHChk.Flbl.Top := Y + 5;
	3694	Ctrl.WHChk.Flbl.Left := NewLInePromptGap+15;
	3695	WrapLeft := Ctrl.WHChk.Flbl.Left;
	3696	Ctrl.WHChk.Flbl.Width := TextWidthByFont(Ctrl.WHChk.Flbl.Font.Handle, Ctrl.WHChk.Flbl.Caption)+25;
	3697	Ctrl.WHChk.Flbl.Height := TextHeightByFont(Ctrl.WHChk.Flbl.Font.Handle, Ctrl.WHChk.Flbl.Caption);
	3698	//LineWidth := WrapLeft + Ctrl.WHChk.Flbl.Width+10;
	3699	if Prompt.Required then
	3700	Ctrl.WHChk.Flbl.Caption := '* '+Ctrl.WHChk.Flbl.Caption;
	3701	Y := Ctrl.WHChk.Flbl.Top + Ctrl.WHChk.Flbl.Height;
	3702	NextLine(Y);
	3703	Ctrl.WHChk.RadioStyle:=true;
	3704	Ctrl.WHChk.GroupIndex:=1;
	3705	Ctrl.WHChk.Check2 := TWHCheckBox.Create(AOwner);
	3706	Ctrl.WHChk.Check2.Parent := Ctrl.WHChk.Parent;
	3707	Ctrl.WHChk.Check2.RadioStyle:=true;
	3708	Ctrl.WHChk.Check2.GroupIndex:=1;
	3709	Ctrl.WHChk.Check3 := TWHCheckBox.Create(AOwner);
	3710	Ctrl.WHChk.Check3.Parent := Ctrl.WHChk.Parent;
	3711	Ctrl.WHChk.Check3.RadioStyle:=true;
	3712	Ctrl.WHChk.Check3.GroupIndex:=1;
	3713	Ctrl.WHChk.Caption := 'NEM (No Evidence of Malignancy)';
	3714	Ctrl.WHChk.ShowHint := true;
	3715	Ctrl.WHChk.Hint := 'No Evidence of Malignancy';
	3716	Ctrl.WHChk.Width := TextWidthByFont(Ctrl.WHChk.Font.Handle, Ctrl.WHChk.Caption)+20;
	3717	Ctrl.WHChk.Height := TextHeightByFont(Ctrl.WHChk.Font.Handle, Ctrl.WHChk.Caption)+4;
	3718	Ctrl.WHChk.Top := Y + 5;
	3719	Ctrl.WHChk.Left := WrapLeft;
	3720	Ctrl.WHChk.OnClick := Prompt.PromptChange;
	3721	Ctrl.WHChk.Checked := (WHResultChk = 'N');
	3722	LineWidth := WrapLeft + Ctrl.WHChk.Width+5;
	3723	Ctrl.WHChk.Check2.Caption := 'Abnormal';
	3724	Ctrl.WHChk.Check2.Width := TextWidthByFont(Ctrl.WHChk.Check2.Font.Handle, Ctrl.WHChk.Check2.Caption) + 20;
	3725	Ctrl.WHChk.Check2.Height := TextHeightByFont(Ctrl.WHChk.check2.Font.Handle, Ctrl.WHChk.check2.Caption)+4;
	3726	if (LineWidth + Ctrl.WHChk.Check2.Width) > PWidth - 10 then
	3727	begin
	3728	LineWidth := WrapLeft;
	3729	Y := Ctrl.WHChk.Top + Ctrl.WHChk.Height;
	3730	Nextline(Y);
	3731	end;
	3732	Ctrl.WHChk.Check2.Top := Y + 5;
	3733	Ctrl.WHChk.Check2.Left := LineWidth;
	3734	Ctrl.WHChk.Check2.OnClick := Prompt.PromptChange;
	3735	Ctrl.WHChk.Check2.Checked := (WHResultChk = 'A');
	3736	LineWidth := LineWidth + Ctrl.WHChk.Check2.Width+5;
	3737	Ctrl.WHChk.Check3.Caption := 'Unsatisfactory for Diagnosis';
	3738	Ctrl.WHChk.Check3.Width := TextWidthByFont(Ctrl.WHChk.Check3.Font.Handle, Ctrl.WHChk.Check3.Caption)+20;
	3739	Ctrl.WHChk.Check3.Height := TextHeightByFont(Ctrl.WHChk.check3.Font.Handle, Ctrl.WHChk.check3.Caption)+4;
	3740	if (LineWidth + Ctrl.WHChk.Check3.Width) > PWidth - 10 then
	3741	begin
	3742	LineWidth := WrapLeft;
	3743	Y := Ctrl.WHChk.Check2.Top + Ctrl.WHChk.Check2.Height;
	3744	Nextline(Y);
	3745	end;
	3746	Ctrl.WHChk.Check3.Top := Y + 5;
	3747	Ctrl.WHChk.Check3.OnClick := Prompt.PromptChange;
	3748	Ctrl.WHChk.Check3.Checked := (WHResultChk = 'U');
	3749	Ctrl.WHChk.Check3.Left := LineWidth;
	3750	Y := Ctrl.WHChk.Check3.Top + Ctrl.WHChk.Check3.Height;
	3751	Nextline(Y);
	3752	end
	3753	else DoLbl := FALSE;
	3754	end
	3755	else DoLbl :=FALSE;
	3756	end;
	3757
	3758	ptWHNotPurp:
	3759	begin
	3760	NextLine(Y);
	3761	Ctrl.WHChk := TWHCheckBox.Create(AOwner);
	3762	Ctrl.ctrl.Parent := AParent;
	3763	Ctrl.WHChk.Flbl := TLabel.Create(AOwner);
	3764	Ctrl.WHChk.Flbl.Parent := Ctrl.WHChk.Parent;
	3765	Ctrl.WHChk.Flbl.Caption := Prompt.Caption;
	3766	Ctrl.WHChk.Flbl.Top := Y + 7;
	3767	Ctrl.WHChk.Flbl.Left := NewLInePromptGap+30;
	3768	WrapLeft := Ctrl.WHChk.Flbl.Left;
	3769	Ctrl.WHChk.Flbl.Width := TextWidthByFont(Ctrl.WHChk.Flbl.Font.Handle, Ctrl.WHChk.Flbl.Caption)+25;
	3770	Ctrl.WHChk.Flbl.Height := TextHeightByFont(Ctrl.WHChk.Flbl.Font.Handle, Ctrl.WHChk.Flbl.Caption)+4;
	3771	LineWidth := WrapLeft + Ctrl.WHChk.Flbl.Width+10;
	3772	if Prompt.Required then
	3773	Ctrl.WHChk.Flbl.Caption := '* '+Ctrl.WHChk.Flbl.Caption;
	3774	Ctrl.WHChk.Check2 := TWHCheckBox.Create(AOwner);
	3775	Ctrl.WHChk.Check2.Parent := Ctrl.WHChk.Parent;
	3776	Ctrl.WHChk.Check3 := TWHCheckBox.Create(AOwner);
	3777	Ctrl.WHChk.Check3.Parent := Ctrl.WHChk.Parent;
	3778	Ctrl.WHChk.ShowHint := true;
	3779	Ctrl.WHChk.Hint := 'Letter will print with next WH batch run';
	3780	Ctrl.WHChk.Caption := 'Letter';
	3781	Ctrl.WHChk.Width := TextWidthByFont(Ctrl.WHChk.Font.Handle, Ctrl.WHChk.Caption)+25;
	3782	Ctrl.WHChk.Height := TextHeightByFont(Ctrl.WHChk.Font.Handle, Ctrl.WHChk.Caption)+4;
	3783	if (LineWidth + Ctrl.WHChk.Width) > PWidth - 10 then
	3784	begin
	3785	LineWidth := WrapLeft;
	3786	Y := Ctrl.WHChk.Flbl.Top + Ctrl.WHChk.Flbl.Height;
	3787	Nextline(Y);
	3788	end;
	3789	Ctrl.WHChk.Top := Y + 7;
	3790	Ctrl.WHChk.Left := LineWidth;
	3791	Ctrl.WHChk.OnClick := Prompt.PromptChange;
	3792	Ctrl.WHChk.Checked := (Pos('L',WHResultNot)>0);
	3793	LineWidth := LineWidth + Ctrl.WHChk.Width+10;
	3794	Ctrl.WHChk.Check2.Caption := 'In-Person';
	3795	Ctrl.WHChk.Check2.Width := TextWidthByFont(Ctrl.WHChk.Check2.Font.Handle, Ctrl.WHChk.Check2.Caption) + 25;
	3796	Ctrl.WHChk.Check2.Height := TextHeightByFont(Ctrl.WHChk.check2.Font.Handle, Ctrl.WHChk.check2.Caption)+4;
	3797	if (LineWidth + Ctrl.WHChk.Check2.Width) > PWidth - 10 then
	3798	begin
	3799	LineWidth := WrapLeft;
	3800	Y := Ctrl.WHChk.Top + Ctrl.WHChk.Height;
	3801	Nextline(Y);
	3802	end;
	3803	Ctrl.WHChk.Check2.Top := Y + 7;
	3804	Ctrl.WHChk.Check2.Left := LineWidth;
	3805	Ctrl.WHChk.Check2.OnClick := Prompt.PromptChange;
	3806	Ctrl.WHChk.Check2.Checked := (Pos('I',WHResultNot)>0);
	3807	LineWidth := LineWidth + Ctrl.WHChk.Check2.Width+10;
	3808	Ctrl.WHChk.Check3.Caption := 'Phone Call';
	3809	Ctrl.WHChk.Check3.Width := TextWidthByFont(Ctrl.WHChk.Check3.Font.Handle, Ctrl.WHChk.Check3.Caption)+20;
	3810	Ctrl.WHChk.Check3.Height := TextHeightByFont(Ctrl.WHChk.check3.Font.Handle, Ctrl.WHChk.check3.Caption)+4;
	3811	if (LineWidth + Ctrl.WHChk.Check3.Width) > PWidth - 10 then
	3812	begin
	3813	LineWidth := WrapLeft;
	3814	Y := Ctrl.WHChk.Check2.Top + Ctrl.WHChk.Check2.Height;
	3815	Nextline(Y);
	3816	end;
	3817	Ctrl.WHChk.Check3.Top := Y + 7;
	3818	Ctrl.WHChk.Check3.OnClick := Prompt.PromptChange;
	3819	Ctrl.WHChk.Check3.Checked := (Pos('P',WHResultNot)>0);
	3820	Ctrl.WHChk.Check3.Left := LineWidth;
	3821	Y := Ctrl.WHChk.Check3.Top + Ctrl.WHChk.Check3.Height;
	3822	Nextline(Y);
	3823	Ctrl.WHChk.Fbutton := TButton.Create(AOwner);
	3824	Ctrl.WHChk.FButton.Parent := Ctrl.WHChk.Parent;
	3825	Ctrl.WHChk.FButton.Enabled:=(Pos('L',WHResultNot)>0);
	3826	Ctrl.WHChk.FButton.Left := Ctrl.WHChk.Flbl.Left;
	3827	Ctrl.WHChk.FButton.Top := Y+7;
	3828	Ctrl.WHChk.FButton.OnClick := Prompt.ViewWHText;
	3829	Ctrl.WHChk.FButton.Caption := 'View WH Notification Letter';
	3830	Ctrl.WHChk.FButton.Width := TextWidthByFont(Ctrl.WHChk.FButton.Font.Handle, Ctrl.WHChk.FButton.Caption) + 13;
	3831	Ctrl.WHChk.FButton.Height := TextHeightByFont(Ctrl.WHChk.FButton.Font.Handle, Ctrl.WHChk.FButton.Caption) + 13;
	3832	LineWidth := Ctrl.WHChk.FButton.Left + Ctrl.WHChk.FButton.Width;
	3833	if piece(Prompt.FRec4,u,12)='1' then
	3834	begin
	3835	Ctrl.WHChk.FPrintNow :=TORCheckBox.Create(AOwner);
	3836	Ctrl.WHChk.FPrintNow.Parent := Ctrl.WHChk.Parent;
	3837	Ctrl.WHChk.FPrintNow.ShowHint := true;
	3838	Ctrl.WHChk.FPrintNow.Hint := 'Letter will print after "Finish" button is clicked';
	3839	Ctrl.WHChk.FPrintNow.Caption:='Print Now';
	3840	Ctrl.WHChk.FPrintNow.Width := TextWidthByFont(Ctrl.WHChk.FPrintNow.Font.Handle, Ctrl.WHChk.FPrintNow.Caption)+20;
	3841	Ctrl.WHChk.FPrintNow.Height := TextHeightByFont(Ctrl.WHChk.FPrintNow.Font.Handle, Ctrl.WHChk.FPrintNow.Caption)+4;
	3842	if (LineWidth + Ctrl.WHChk.FPrintNow.Width) > PWidth - 10 then
	3843	begin
	3844	LineWidth := WrapLeft;
	3845	Y := Ctrl.WHChk.FButton.Top + Ctrl.WHChk.FButton.Height;
	3846	Nextline(Y);
	3847	end;
	3848	Ctrl.WHChk.FPrintNow.Left := LineWidth + 15;
	3849	Ctrl.WHChk.FPrintNow.Top := Y + 7;
	3850	Ctrl.WHChk.FPrintNow.Enabled := (Pos('L',WHResultNot)>0);
	3851	Ctrl.WHChk.FPrintNow.Checked :=(WHPrintDevice<>'');
	3852	Ctrl.WHChk.FPrintNow.OnClick := Prompt.PromptChange;
	3853	MinX :=PWidth;
	3854	if (Ctrl.WHChk.FButton.Top + Ctrl.WHChk.FButton.Height) > (Ctrl.WHChk.FPrintNow.Top + Ctrl.WHChk.FPrintNow.Height) then
	3855	Y := Ctrl.WHChk.FButton.Top + Ctrl.WHChk.FButton.Height + 7
	3856	else
	3857	Y := Ctrl.WHChk.FPrintNow.Top + Ctrl.WHChk.FPrintNow.Height + 7;
	3858	end
	3859	else
	3860	Y := Ctrl.WHChk.FButton.Top + Ctrl.WHChk.FButton.Height + 7;
	3861	NextLine(Y);
	3862	end;
	3863
	3864	ptVisitDate:
	3865	begin
	3866	Ctrl.dt := TORDateCombo.Create(AOwner);
	3867	Ctrl.ctrl.Parent := AParent;
	3868	Ctrl.dt.LongMonths := TRUE;
	3869	try
	3870	DefaultDate := Ctrl.dt.FMDate;
	3871	Ctrl.dt.FMDate := StrToFloat(Prompt.Value);
	3872	except
	3873	on EConvertError do
	3874	Ctrl.dt.FMDate := DefaultDate;
	3875	else
	3876	raise;
	3877	end;
	3878	Ctrl.dt.OnChange := Prompt.PromptChange;
	3879	DoLbl := TRUE;
	3880	MinX := Ctrl.dt.Width;
	3881	//TextWidthByFont(Ctrl.dt.Font.Handle, 'May 22, 2000') + 26;
	3882	end;
	3883
	3884	ptPrimaryDiag, ptAdd2PL, ptContraindicated:
	3885	begin
	3886	Ctrl.cb := TORCheckBox.Create(AOwner);
	3887	Ctrl.ctrl.Parent := AParent;
	3888	Ctrl.cb.Checked := (Prompt.Value = '1');
	3889	Ctrl.cb.Caption := Prompt.Caption;
	3890	if prompt.Required=false then DoLbl := true;
	3891	Ctrl.cb.AutoSize := False;
	3892	Ctrl.cb.OnEnter := ParentCBEnter;
	3893	Ctrl.cb.OnExit := ParentCBExit;
	3894	Ctrl.cb.Height := TORCheckBox(Ctrl.cb).Height + 5;
	3895	Ctrl.cb.Width := 17;
	3896	Ctrl.cb.OnClick := Prompt.PromptChange;
	3897	MinX := Ctrl.cb.Width;
	3898	end;
	3899
	3900	else
	3901	begin
	3902	if(pt = ptSubComment) then
	3903	begin
	3904	Ctrl.cb := TORCheckBox.Create(AOwner);
	3905	Ctrl.ctrl.Parent := AParent;
	3906	Ctrl.cb.Checked := (Prompt.Value = '1');
	3907	Ctrl.cb.Caption := Prompt.Caption;
	3908	Ctrl.cb.AutoSize := TRUE;
	3909	Ctrl.cb.OnClick := SubCommentChange;
	3910	Ctrl.cb.Tag := Integer(Prompt);
	3911	MinX := Ctrl.cb.Width;
	3912	end
	3913	else
	3914	if pt = ptVitalEntry then
	3915	begin
	3916	vt := Prompt.VitalType;
	3917	if(vt = vtPain) then
	3918	begin
	3919	Ctrl.cbo := TORComboBox.Create(AOwner);
	3920	Ctrl.ctrl.Parent := AParent;
	3921	Ctrl.cbo.Style := orcsDropDown;
	3922	Ctrl.cbo.Pieces := '1,2';
	3923	Ctrl.cbo.OnKeyDown := Prompt.ComboBoxKeyDown;
	3924	InitPainCombo(Ctrl.cbo);
	3925	Ctrl.cbo.ListItemsOnly := TRUE;
	3926	Ctrl.cbo.SelectByID(Prompt.VitalValue);
	3927	Ctrl.cbo.OnChange := Prompt.PromptChange;
	3928	Ctrl.cbo.SelLength := 0;
	3929	MinX := TextWidthByFont(Ctrl.cbo.Font.Handle, Ctrl.cbo.DisplayText[0]) + 24;
	3930	MaxX := TextWidthByFont(Ctrl.cbo.Font.Handle, Ctrl.cbo.DisplayText[1]) + 24;
	3931	if(ElementChecked = Self) then
	3932	begin
	3933	AutoFocusControl := Ctrl.cbo;
	3934	ElementChecked := nil;
	3935	end;
	3936	end
	3937	else
	3938	begin
	3939	Ctrl.vedt := TVitalEdit.Create(AOwner);
	3940	Ctrl.ctrl.Parent := AParent;
	3941	MinX := TextWidthByFont(Ctrl.vedt.Font.Handle, '12345.67');
	3942	Ctrl.edt.OnKeyPress := Prompt.EditKeyPress;
	3943	Ctrl.edt.OnChange := Prompt.PromptChange;
	3944	Ctrl.edt.OnExit := Prompt.VitalVerify;
	3945	if(vt in [vtTemp, vtHeight, vtWeight]) then
	3946	begin
	3947	HasVCombo := TRUE;
	3948	Ctrl.vedt.FLinkedCombo := TVitalComboBox.Create(AOwner);
	3949	Ctrl.vedt.FLinkedCombo.Parent := AParent;
	3950	Ctrl.vedt.FLinkedCombo.OnChange := Prompt.PromptChange;
	3951	Ctrl.vedt.FLinkedCombo.Tag := VitalControlTag(vt, TRUE);
	3952	Ctrl.vedt.FLinkedCombo.OnExit := Prompt.VitalVerify;
	3953	Ctrl.vedt.FLinkedCombo.FLinkedEdit := Ctrl.vedt;
	3954	case vt of
	3955	vtTemp:
	3956	begin
	3957	Ctrl.vedt.FLinkedCombo.Items.Add('F');
	3958	Ctrl.vedt.FLinkedCombo.Items.Add('C');
	3959	end;
	3960
	3961	vtHeight:
	3962	begin
	3963	Ctrl.vedt.FLinkedCombo.Items.Add('IN');
	3964	Ctrl.vedt.FLinkedCombo.Items.Add('CM');
	3965	end;
	3966
	3967	vtWeight:
	3968	begin
	3969	Ctrl.vedt.FLinkedCombo.Items.Add('LB');
	3970	Ctrl.vedt.FLinkedCombo.Items.Add('KG');
	3971	end;
	3972
	3973	end;
	3974	Ctrl.vedt.FLinkedCombo.SelectByID(Prompt.VitalUnitValue);
	3975	if(Ctrl.vedt.FLinkedCombo.ItemIndex < 0) then
	3976	Ctrl.vedt.FLinkedCombo.ItemIndex := 0;
	3977	Ctrl.vedt.FLinkedCombo.Width := TextWidthByFont(Ctrl.vedt.Font.Handle,
	3978	Ctrl.vedt.FLinkedCombo.Items[1]) + 30;
	3979	Ctrl.vedt.FLinkedCombo.SelLength := 0;
	3980	inc(MinX, Ctrl.vedt.FLinkedCombo.Width);
	3981	end;
	3982	if(ElementChecked = Self) then
	3983	begin
	3984	AutoFocusControl := Ctrl.edt;
	3985	ElementChecked := nil;
	3986	end;
	3987	end;
	3988	Ctrl.ctrl.Text := Prompt.VitalValue;
	3989	Ctrl.ctrl.Tag := VitalControlTag(vt);
	3990	DoLbl := TRUE;
	3991	end
	3992	else
	3993	if pt = ptDataList then
	3994	begin
	3995	Ctrl.cbo := TORComboBox.Create(AOwner);
	3996	Ctrl.ctrl.Parent := AParent;
	3997	Ctrl.cbo.Style := orcsDropDown;
	3998	Ctrl.cbo.Pieces := '12';
	3999	if ActChoicesSL = nil then
	4000	ActChoicesSL := TORStringList.Create;
	4001	if Self.Historical then
	4002	EncDt := DateTimeToFMDateTime(Date)
	4003	else
	4004	EncDt := RemForm.PCEObj.VisitDateTime;
	4005	if assigned(Prompt.FData.FChoicesActiveDates) then {csv active/inactive dates}
	4006	for m := 0 to (Prompt.FData.FChoices.Count - 1) do
	4007	begin
	4008	for n := 0 to (TStringList(Prompt.FData.FChoicesActiveDates[m]).Count - 1) do
	4009	begin
	4010	ActDt := StrToIntDef((Piece(TStringList(Prompt.FData.FChoicesActiveDates[m]).Strings[n], ':', 1)),0);
	4011	InActDt := StrToIntDef((Piece(TStringList(Prompt.FData.FChoicesActiveDates[m]).Strings[n], ':', 2)),9999999);
	4012	Piece12 := Piece(Piece(Prompt.FData.FChoices.Strings[m],U,12),':',1);
	4013	Prompt.FData.FChoices.SetStrPiece(m,12,Piece12);
	4014	if (EncDt >= ActDt) and (EncDt <= InActDt) then
	4015	ActChoicesSL.AddObject(Prompt.FData.FChoices[m], Prompt.FData.FChoices.Objects[m]);
	4016	end; {loop through the TStringList object in FChoicesActiveDates[m] object property}
	4017	end {loop through FChoices/FChoicesActiveDates}
	4018	else
	4019	ActChoicesSL.Assign(Prompt.FData.FChoices);
	4020	Ctrl.cbo.Items.Assign(ActChoicesSL);
	4021	Ctrl.cbo.CheckBoxes := TRUE;
	4022	Ctrl.cbo.SelectByID(Prompt.Value);
	4023	Ctrl.cbo.OnCheckedText := FReminder.ComboBoxCheckedText;
	4024	Ctrl.cbo.OnResize := FReminder.ComboBoxResized;
	4025	Ctrl.cbo.CheckedString := Prompt.Value;
	4026	Ctrl.cbo.OnChange := Prompt.PromptChange;
	4027	Ctrl.cbo.ListItemsOnly := TRUE;
	4028	if(ElementChecked = Self) then
	4029	begin
	4030	AutoFocusControl := Ctrl.cbo;
	4031	ElementChecked := nil;
	4032	end;
	4033	DoLbl := TRUE;
	4034	if(Prompt.FData.FChoicesFont = Ctrl.cbo.Font.Handle) then
	4035	begin
	4036	MinX := Prompt.FData.FChoicesMin;
	4037	MaxX := Prompt.FData.FChoicesMax;
	4038	end
	4039	else
	4040	begin
	4041	GetComboBoxMinMax(Ctrl.cbo, MinX, MaxX);
	4042	inc(MaxX,18); // Adjust for checkboxes
	4043	MinX := MaxX;
	4044	Prompt.FData.FChoicesFont := Ctrl.cbo.Font.Handle;
	4045	Prompt.FData.FChoicesMin := MinX;
	4046	Prompt.FData.FChoicesMax := MaxX;
	4047	end;
	4048	end
	4049	else
	4050	if(pt = ptMHTest) then
	4051	begin
	4052	Ctrl.btn := TButton.Create(AOwner);
	4053	Ctrl.ctrl.Parent := AParent;
	4054	Ctrl.btn.OnClick := Prompt.DoMHTest;
	4055	Ctrl.btn.Caption := Prompt.ForcedCaption;
	4056	if Piece(Prompt.FData.FRec3,U,13)='1' then
	4057	Ctrl.btn.Caption := Ctrl.btn.Caption + ' *';
	4058	MinX := TextWidthByFont(Ctrl.btn.Font.Handle, Ctrl.btn.Caption) + 13;
	4059	Ctrl.btn.Height := TextHeightByFont(Ctrl.btn.Font.Handle, Ctrl.btn.Caption) + 8;
	4060	DoLbl := TRUE;
	4061	end
	4062	else
	4063	if(pt = ptGAF) then
	4064	begin
	4065	Ctrl.edt := TEdit.Create(AOwner);
	4066	Ctrl.ctrl.Parent := AParent;
	4067	Ctrl.edt.Text := Prompt.Value;
	4068	ud := TUpDown.Create(AOwner);
	4069	ud.Parent := AParent;
	4070	ud.Associate := Ctrl.edt;
	4071	ud.Min := 0;
	4072	ud.Max := 100;
	4073	MinX := TextWidthByFont(Ctrl.edt.Font.Handle, IntToStr(ud.Max)) + 24 + Gap;
	4074	ud.Position := StrToIntDef(Prompt.Value, ud.Min);
	4075	Ctrl.edt.OnKeyPress := Prompt.EditKeyPress;
	4076	Ctrl.edt.OnChange := Prompt.PromptChange;
	4077	if(User.WebAccess and (GAFURL <> '')) then
	4078	begin
	4079	HelpBtn := TButton.Create(AOwner);
	4080	HelpBtn.Parent := AParent;
	4081	HelpBtn.Caption := 'Reference Info';
	4082	HelpBtn.OnClick := Prompt.GAFHelp;
	4083	HelpBtn.Width := TextWidthByFont(HelpBtn.Font.Handle, HelpBtn.Caption) + 13;
	4084	HelpBtn.Height := Ctrl.edt.Height;
	4085	inc(MinX, HelpBtn.Width);
	4086	end;
	4087	DoLbl := TRUE;
	4088	end
	4089	else
	4090	Ctrl.ctrl := nil;
	4091	end;
	4092	end;
	4093
	4094	if(DoLbl) and ((pt <> ptWHNotPurp) and (pt <> ptWHPapResult)) then
	4095	//if(DoLbl) then
	4096	begin
	4097	if(Prompt.Caption = '') and (not Prompt.Required) then
	4098	DoLbl := FALSE
	4099	else
	4100	begin
	4101	lbl := TLabel.Create(AOwner);
	4102	lbl.Parent := AParent;
	4103	lbl.Caption := Prompt.Caption;
	4104	if Prompt.Required then
	4105	lbl.Caption := lbl.Caption+' *';
	4106	if pt = ptGaf then
	4107	begin
	4108	if Piece(Prompt.FData.FRec3,U,13)='1' then
	4109	lbl.Caption := lbl.Caption + ' *';
	4110	end;
	4111	lbl.Enabled := Prompt.FParent.Enabled;
	4112	inc(MinX, lbl.Width + LblGap);
	4113	inc(MaxX, lbl.Width + LblGap);
	4114	end;
	4115	end;
	4116
	4117	if(MaxX < MinX) then
	4118	MaxX := MinX;
	4119
	4120	if((Prompt.SameLine) and ((LastX + MinX + Gap) < PWidth)) and
	4121	((pt <> ptWHNotPurp) and (pt <> ptWHPapResult)) then
	4122	//if((Prompt.SameLine) and ((LastX + MinX + Gap) < PWidth)) then
	4123	begin
	4124	X := LastX;
	4125	end
	4126	else
	4127	begin
	4128	if(Shared) and (assigned(FChildren)) and (FChildren.Count > 0) then
	4129	X := TRemDlgElement(FChildren[0]).TrueIndent
	4130	else
	4131	begin
	4132	if(assigned(cb)) then
	4133	X := cb.Left + NewLinePromptGap
	4134	else
	4135	X := pnl.Left + NewLinePromptGap;
	4136	end;
	4137	NextLine(Y);
	4138	end;
	4139	if(MaxX > (PWidth - X - Gap)) then
	4140	MaxX := PWidth - X - Gap;
	4141	if((DoLbl) or (assigned(Ctrl.Ctrl))) and
	4142	((pt <> ptWHNotPurp) and (pt <> ptWHPapResult)) then
	4143	//if((DoLbl) or (assigned(Ctrl.Ctrl))) then
	4144	begin
	4145	if DoLbl then
	4146	begin
	4147	lbl.Left := X;
	4148	lbl.Top := Y;
	4149	inc(X, lbl.Width + LblGap);
	4150	dec(MinX, lbl.Width + LblGap);
	4151	dec(MaxX, lbl.Width + LblGap);
	4152	SameLineCtrl.Add(lbl);
	4153	end;
	4154	if(assigned(Ctrl.Ctrl)) then
	4155	begin
	4156	Ctrl.Ctrl.Enabled := Prompt.FParent.Enabled;
	4157	if not Ctrl.Ctrl.Enabled then
	4158	Ctrl.Ctrl.Font.Color := DisabledFontColor;
	4159	Ctrl.Ctrl.Left := X;
	4160	Ctrl.Ctrl.Top := Y;
	4161	SameLineCtrl.Add(Ctrl.Ctrl);
	4162	if(assigned(ud)) then
	4163	begin
	4164	SameLineCtrl.Add(ud);
	4165	if(assigned(HelpBtn)) then
	4166	begin
	4167	SameLineCtrl.Add(HelpBtn);
	4168	Ctrl.Ctrl.Width := MinX - HelpBtn.Width - ud.Width;
	4169	HelpBtn.Left := X + Ctrl.Ctrl.Width + ud.Width + Gap;
	4170	HelpBtn.Top := Y;
	4171	HelpBtn.Enabled := Prompt.FParent.Enabled;
	4172	end
	4173	else
	4174	Ctrl.Ctrl.Width := MinX - ud.Width;
	4175	ud.Left := X + Ctrl.Ctrl.Width;
	4176	ud.Top := Y;
	4177	LastX := X + MinX + PromptGap;
	4178	ud.Enabled := Prompt.FParent.Enabled;
	4179	end
	4180	else
	4181	if(HasVCombo) then
	4182	begin
	4183	SameLineCtrl.Add(Ctrl.vedt.FLinkedCombo);
	4184	Ctrl.Ctrl.Width := MinX - Ctrl.vedt.FLinkedCombo.Width;
	4185	Ctrl.vedt.FLinkedCombo.Left := X + Ctrl.Ctrl.Width;
	4186	Ctrl.vedt.FLinkedCombo.Top := Y;
	4187	LastX := X + MinX + PromptGap;
	4188	Ctrl.vedt.FLinkedCombo.Enabled := Prompt.FParent.Enabled;
	4189	end
	4190	else
	4191	begin
	4192	Ctrl.Ctrl.Width := MaxX;
	4193	LastX := X + MaxX + PromptGap;
	4194	end;
	4195	end;
	4196	end;
	4197	end;
	4198	if(assigned(ud)) then
	4199	Prompt.FCurrentControl := ud
	4200	else
	4201	Prompt.FCurrentControl := Ctrl.Ctrl;
	4202	end;
	4203	NextLine(Y);
	4204	finally
	4205	SameLineCtrl.Free;
	4206	end;
	4207	end;
[460]	4208
[459]	4209	begin
	4210	Result := nil;
	4211	AutoFocusControl := nil;
	4212	X := TrueIndent;
	4213	if(assigned(FPrompts)) then
	4214	begin
	4215	for i := 0 to FPrompts.Count-1 do
	4216	TRemPrompt(FPrompts[i]).FCurrentControl := nil;
	4217	end;
	4218	if(ElemType = etDisplayOnly) then
	4219	begin
	4220	if(FText <> '') then
	4221	begin
	4222	inc(Y,Gap);
	4223	pnl := GetPanel(EntryID, CRLFText(FText), ParentWidth - X - (Gap * 2));
	4224	pnl.Left := X;
	4225	pnl.Top := Y;
	4226	if (FChecked and assigned(FPrompts) and (FPrompts.Count > 0)) then
	4227	begin
	4228	cb := nil;
	4229	AddPrompts(FALSE, BaseParent, ParentWidth, Y);
	4230	end
	4231	else
	4232	inc(Y,pnl.Height);
	4233	end;
	4234	end
	4235	else
	4236	begin
	4237	inc(Y,Gap);
	4238	cb := TORCheckBox.Create(AOwner);
	4239	cb.Parent := BaseParent;
	4240	cb.Left := X;
	4241	cb.Top := Y;
	4242	cb.Tag := Integer(Self);
	4243	cb.WordWrap := TRUE;
	4244	cb.AutoSize := TRUE;
	4245	cb.Checked := FChecked;
	4246	cb.Width := ParentWidth - X - Gap;
	4247	cb.Caption := CRLFText(FText);
	4248	cb.AutoAdjustSize;
	4249	cbSingleLine := cb.SingleLine;
	4250	cb.AutoSize := FALSE;
	4251	cb.WordWrap := FALSE;
	4252	cb.Caption := '';
	4253	cb.Width := 13;
	4254	cb.Height := 17;
	4255	cb.TabStop := False; {take checkboxes out of the tab order}
	4256	pnl := GetPanel(EntryID, CRLFText(FText), ParentWidth - X - (Gap * 2) - IndentGap);
	4257	pnl.Left := X + IndentGap;
	4258	pnl.Top := Y;
	4259	cb.Associate := pnl;
	4260	pnl.Tag := Integer(cb); {So the panel can check the checkbox}
	4261	pnl.TabStop := TRUE; {tab through the panels instead of the checkboxes}
	4262
	4263	cb.OnClick := cbClicked;
	4264	pnl.OnEnter := FieldPanelEntered;
	4265	pnl.OnExit := FieldPanelExited;
	4266	TFieldPanel(pnl).OnKeyPress := FieldPanelKeyPress;
	4267	pnl.OnClick := FieldPanelOnClick;
	4268	for i := 0 to pnl.ControlCount - 1 do
	4269	if (pnl.Controls[i] is TLabel) and
	4270	not (fsUnderline in TLabel(pnl.Controls[i]).Font.Style) then //If this isn't a hyperlink change then event handler
	4271	TLabel(pnl.Controls[i]).OnClick := FieldPanelLabelOnClick;
	4272
	4273	//cb.Enabled := Enabled;
	4274	if(assigned(FParent) and (FParent.ChildrenRequired in [crOne, crNoneOrOne])) then
	4275	cb.RadioStyle := TRUE;
	4276
	4277	if (FChecked and assigned(FPrompts) and (FPrompts.Count > 0)) then
	4278	AddPrompts(FALSE, BaseParent, ParentWidth, Y)
	4279	else
	4280	inc(Y, pnl.Height);
	4281	end;
	4282
	4283	if(ShowChildren) then
	4284	begin
	4285	gb := nil;
	4286	if(Box) then
	4287	begin
	4288	gb := TGroupBox.Create(AOwner);
	4289	gb.Parent := BaseParent;
	4290	gb.Left := TrueIndent + (ChildrenIndent * IndentMult);
	4291	gb.Top := Y;
	4292	gb.Width := ParentWidth - gb.Left - Gap;
	4293	PrntWidth := gb.Width - (Gap * 2);
	4294	gb.Caption := BoxCaption;
	4295	gb.Enabled := EnableChildren;
	4296	if(not EnableChildren) then
	4297	gb.Font.Color := DisabledFontColor;
	4298	prnt := gb;
	4299	if(gb.Caption = '') then
	4300	Y1 := gbTopIndent
	4301	else
	4302	Y1 := gbTopIndent2;
	4303	end
	4304	else
	4305	begin
	4306	prnt := BaseParent;
	4307	Y1 := Y;
	4308	PrntWidth := ParentWidth;
	4309	end;
	4310
	4311	for i := 0 to FChildren.Count-1 do
	4312	begin
	4313	ERes := TRemDlgElement(FChildren[i]).BuildControls(Y1, PrntWidth, prnt, AOwner);
	4314	if(not assigned(Result)) then
	4315	Result := ERes;
	4316	end;
	4317
	4318	if(FHasSharedPrompts) then
	4319	AddPrompts(TRUE, prnt, PrntWidth, Y1);
	4320
	4321	if(Box) then
	4322	begin
	4323	gb.Height := Y1 + (Gap * 3);
	4324	inc(Y, Y1 + (Gap * 4));
	4325	end
	4326	else
	4327	Y := Y1;
	4328	end;
	4329
	4330	SubCommentChange(nil);
	4331
	4332	if(assigned(AutoFocusControl)) then
	4333	begin
	4334	if(AutoFocusControl is TORComboBox) and
	4335	(TORComboBox(AutoFocusControl).CheckBoxes) and
	4336	(pos('1',TORComboBox(AutoFocusControl).CheckedString) = 0) then
	4337	Result := AutoFocusControl
	4338	else
	4339	if(TORExposedControl(AutoFocusControl).Text = '') then
	4340	Result := AutoFocusControl
	4341	end;
	4342	end;
	4343
	4344	//This is used to get the template field values if this reminder is not the
	4345	//current reminder in dialog, in which case no uEntries will exist so we have
	4346	//to get the template field values that were saved in the element.
	4347	function TRemDlgElement.GetTemplateFieldValues(const Text: string; FldValues: TORStringList = nil): string;
	4348	var
	4349	flen, CtrlID, i, j: integer;
	4350	Fld: TTemplateField;
	4351	Temp, FldName, NewTxt: string;
	4352
	4353	const
	4354	TemplateFieldBeginSignature = '{FLD:';
	4355	TemplateFieldEndSignature = '}';
	4356	TemplateFieldSignatureLen = length(TemplateFieldBeginSignature);
	4357	TemplateFieldSignatureEndLen = length(TemplateFieldEndSignature);
	4358	FieldIDDelim = '`';
	4359	FieldIDLen = 6;
	4360
	4361	procedure AddNewTxt;
	4362	begin
	4363	if(NewTxt <> '') then
	4364	begin
	4365	insert(StringOfChar('x',length(NewTxt)), Temp, i);
	4366	insert(NewTxt, Result, i);
	4367	inc(i, length(NewTxt));
	4368	end;
	4369	end;
	4370
	4371	begin
	4372	Result := Text;
	4373	Temp := Text;
	4374	repeat
	4375	i := pos(TemplateFieldBeginSignature, Temp);
	4376	if(i > 0) then
	4377	begin
	4378	CtrlID := 0;
	4379	if(copy(Temp, i + TemplateFieldSignatureLen, 1) = FieldIDDelim) then
	4380	begin
	4381	CtrlID := StrToIntDef(copy(Temp, i + TemplateFieldSignatureLen + 1, FieldIDLen-1), 0);
	4382	delete(Temp,i + TemplateFieldSignatureLen, FieldIDLen);
	4383	delete(Result,i + TemplateFieldSignatureLen, FieldIDLen);
	4384	end;
	4385	j := pos(TemplateFieldEndSignature, copy(Temp, i + TemplateFieldSignatureLen, MaxInt));
	4386	if(j > 0) then
	4387	begin
	4388	inc(j, i + TemplateFieldSignatureLen - 1);
	4389	flen := j - i - TemplateFieldSignatureLen;
	4390	FldName := copy(Temp, i + TemplateFieldSignatureLen, flen);
	4391	Fld := GetTemplateField(FldName, FALSE);
	4392	delete(Temp,i,flen + TemplateFieldSignatureLen + 1);
	4393	delete(Result,i,flen + TemplateFieldSignatureLen + 1);
	4394	end
	4395	else
	4396	begin
	4397	delete(Temp,i,TemplateFieldSignatureLen);
	4398	delete(Result,i,TemplateFieldSignatureLen);
	4399	Fld := nil;
	4400	end;
	4401	// Get the value that was entered if there is one
	4402	if assigned(FldValues) and (CtrlID > 0) then
	4403	begin
	4404	j := FldValues.IndexOfPiece(IntToStr(CtrlID));
	4405	if not(j<0) then
	4406	if Fld.DateType in DateComboTypes then
	4407	NewTxt := Piece(Piece(FldValues[j],U,2),':',1)
	4408	else
	4409	NewTxt := Piece(FldValues[j],U,2);
	4410	end;
	4411	// If nothing has been entered, use the default
	4412	if (NewTxt = '') and assigned(Fld) and
	4413	//If this template field is a dftHyperlink or dftText that is
	4414	//excluded (FSepLines = True) then don't get the default text
	4415	not ((Fld.FldType in [dftHyperlink, dftText]) and Fld.SepLines) then
	4416	NewTxt := Fld.TemplateFieldDefault;
	4417	AddNewTxt;
	4418	end;
	4419	until not (i > 0);
	4420	end;
	4421
	4422	procedure TRemDlgElement.AddText(Lst: TStrings);
	4423	var
	4424	i, ilvl: integer;
	4425	Prompt: TRemPrompt;
	4426	txt: string;
	4427	FldData: TORStringList;
	4428
	4429	begin
	4430	if (not (FReminder is TReminder)) then
	4431	ScootOver := 4;
	4432	try
	4433	if Add2PN then
	4434	begin
	4435	ilvl := IndentPNLevel;
	4436	if(FPNText <> '') then
	4437	txt := FPNText
	4438	else
	4439	begin
	4440	txt := FText;
	4441	if not FReminder.FNoResolve then
	4442	//If this is the CurrentReminderInDialog then we get the template field
	4443	//values from the visual control in the dialog window.
	4444	if FReminder = CurrentReminderInDialog then
	4445	txt := ResolveTemplateFields(txt, TRUE)
	4446	else
	4447	//If this is not the CurrentReminderInDialog (i.e.: Next or Back button
	4448	//has been pressed), then we have to get the template field values
	4449	//that were saved in the element.
	4450	begin
	4451	FldData := TORStringList.Create;
	4452	GetFieldValues(FldData);
	4453	txt := GetTemplateFieldValues(txt, FldData);
	4454	end;
	4455	end;
	4456	if FReminder.FNoResolve then
	4457	Lst.Add(txt)
	4458	else
	4459	WordWrap(txt, Lst, ilvl);
	4460	dec(ilvl,2);
	4461	if(assigned(FPrompts)) then
	4462	begin
	4463	for i := 0 to FPrompts.Count-1 do
	4464	begin
	4465	Prompt := TRemPrompt(FPrompts[i]);
	4466	if(not Prompt.FIsShared) then
	4467	WordWrap(Prompt.NoteText, Lst, ilvl);
	4468	end;
	4469	end;
	4470	if(assigned(FParent) and FParent.FHasSharedPrompts) then
	4471	begin
	4472	for i := 0 to FParent.FPrompts.Count-1 do
	4473	begin
	4474	Prompt := TRemPrompt(FParent.FPrompts[i]);
	4475	if(Prompt.FIsShared) and (Prompt.FSharedChildren.IndexOf(Self) >= 0) then
	4476	WordWrap(Prompt.NoteText, Lst, ilvl);
	4477	end;
	4478	end;
	4479	end;
	4480	if (assigned(FChildren)) and (FChecked or (ElemType = etDisplayOnly)) then
	4481	begin
	4482	for i := 0 to FChildren.Count-1 do
	4483	TRemDlgElement(FChildren[i]).AddText(Lst);
	4484	end;
	4485	finally
	4486	if (not (FReminder is TReminder)) then
	4487	ScootOver := 0;
	4488	end;
	4489	end;
	4490
	4491	function TRemDlgElement.AddData(Lst: TStrings; Finishing: boolean;
	4492	AHistorical: boolean = FALSE): integer;
	4493	var
	4494	i, j: integer;
	4495	OK: boolean;
	4496	ActDt, InActDt, EncDt: double;
	4497	RData: TRemData;
	4498
	4499	begin
	4500	Result := 0;
	4501	// OK := ((ElemType <> etDisplayOnly) and FChecked);
	4502	OK := FChecked;
	4503	if(OK and Finishing) then
	4504	OK := (Historical = AHistorical);
	4505	if OK then
	4506	begin
	4507	if(assigned(FData)) then
	4508	begin
	4509	if Self.Historical then
	4510	EncDt := DateTimeToFMDateTime(Date)
	4511	else
	4512	EncDt := RemForm.PCEObj.VisitDateTime;
	4513	for i := 0 to FData.Count-1 do
	4514	begin
	4515	RData := TRemData(FData[i]);
	4516	if assigned(RData.FActiveDates) then
	4517	for j := 0 to (TRemData(FData[i]).FActiveDates.Count - 1) do
	4518	begin
	4519	ActDt := StrToIntDef(Piece(TRemData(FData[i]).FActiveDates[j],':',1), 0);
	4520	InActDt := StrToIntDef(Piece(TRemData(FData[i]).FActiveDates[j], ':', 2), 9999999);
	4521	if (EncDt >= ActDt) and (EncDt <= InActDt) then
	4522	begin
	4523	inc(Result, TRemData(FData[i]).AddData(Lst, Finishing));
	4524	Break;
	4525	end;
	4526	end
	4527	else
	4528	inc(Result, TRemData(FData[i]).AddData(Lst, Finishing));
	4529	end;
	4530	end;
	4531	end;
	4532	if (assigned(FChildren)) and (FChecked or (ElemType = etDisplayOnly)) then
	4533	begin
	4534	for i := 0 to FChildren.Count-1 do
	4535	inc(Result, TRemDlgElement(FChildren[i]).AddData(Lst, Finishing, AHistorical));
	4536	end;
	4537	end;
	4538
	4539	procedure TRemDlgElement.Check4ChildrenSharedPrompts;
	4540	var
	4541	i, j: integer;
	4542	Kid: TRemDlgElement;
	4543	PList, EList: TList;
	4544	FirstMatch: boolean;
	4545	Prompt: TRemPrompt;
	4546
	4547	begin
	4548	if(not FChildrenShareChecked) then
	4549	begin
	4550	FChildrenShareChecked := TRUE;
	4551	if(ChildrenSharePrompts and assigned(FChildren)) then
	4552	begin
	4553	for i := 0 to FChildren.Count-1 do
	4554	TRemDlgElement(FChildren[i]).GetData;
	4555	PList := TList.Create;
	4556	try
	4557	EList := TList.Create;
	4558	try
	4559	for i := 0 to FChildren.Count-1 do
	4560	begin
	4561	Kid := TRemDlgElement(FChildren[i]);
	4562	// if(Kid.ElemType <> etDisplayOnly) and (assigned(Kid.FPrompts)) then
	4563	if(assigned(Kid.FPrompts)) then
	4564	begin
	4565	for j:= 0 to Kid.FPrompts.Count-1 do
	4566	begin
	4567	PList.Add(Kid.FPrompts[j]);
	4568	EList.Add(Kid);
	4569	end;
	4570	end;
	4571	end;
	4572	if(PList.Count > 1) then
	4573	begin
	4574	for i := 0 to PList.Count-2 do
	4575	begin
	4576	if(assigned(EList[i])) then
	4577	begin
	4578	FirstMatch := TRUE;
	4579	Prompt := TRemPrompt(PList[i]);
	4580	for j := i+1 to PList.Count-1 do
	4581	begin
	4582	if(assigned(EList[j]) and
	4583	(Prompt.CanShare(TRemPrompt(PList[j])))) then
	4584	begin
	4585	if(FirstMatch) then
	4586	begin
	4587	FirstMatch := FALSE;
	4588	if(not assigned(FPrompts)) then
	4589	FPrompts := TList.Create;
	4590	FHasSharedPrompts := TRUE;
	4591	Prompt.FIsShared := TRUE;
	4592	if(not assigned(Prompt.FSharedChildren)) then
	4593	Prompt.FSharedChildren := TList.Create;
	4594	Prompt.FSharedChildren.Add(EList[i]);
	4595	FPrompts.Add(PList[i]);
	4596	TRemDlgElement(EList[i]).FPrompts.Remove(PList[i]);
	4597	EList[i] := nil;
	4598	end;
	4599	Prompt.FSharedChildren.Add(EList[j]);
	4600	Kid := TRemDlgElement(EList[j]);
	4601	Kid.FPrompts.Remove(PList[j]);
	4602	if(Kid.FHasComment) and (Kid.FCommentPrompt = PList[j]) then
	4603	begin
	4604	Kid.FHasComment := FALSE;
	4605	Kid.FCommentPrompt := nil;
	4606	end;
	4607	TRemPrompt(PList[j]).Free;
	4608	EList[j] := nil;
	4609	end;
	4610	end;
	4611	end;
	4612	end;
	4613	end;
	4614	finally
	4615	EList.Free;
	4616	end;
	4617	finally
	4618	PList.Free;
	4619	end;
	4620	for i := 0 to FChildren.Count-1 do
	4621	begin
	4622	Kid := TRemDlgElement(FChildren[i]);
	4623	if(assigned(Kid.FPrompts) and (Kid.FPrompts.Count = 0)) then
	4624	begin
	4625	Kid.FPrompts.Free;
	4626	Kid.FPrompts := nil;
	4627	end;
	4628	end;
	4629	end;
	4630	end;
	4631	end;
	4632
	4633	procedure TRemDlgElement.FinishProblems(List: TStrings);
	4634	var
	4635	i,cnt: integer;
	4636	cReq: TRDChildReq;
	4637	Kid: TRemDlgElement;
	4638	Prompt: TRemPrompt;
	4639	txt, msg, Value: string;
	4640	pt: TRemPromptType;
	4641
	4642	begin
	4643	// if(ElemType <> etDisplayOnly) and (FChecked) and (assigned(FPrompts)) then
	4644	if(FChecked and (assigned(FPrompts))) then
	4645	begin
	4646	for i := 0 to FPrompts.Count-1 do
	4647	begin
	4648	Prompt := TRemPrompt(FPrompts[i]);
	4649	Value := Prompt.GetValue;
	4650	pt := Prompt.PromptType;
	4651	if(Prompt.PromptOK and (not Prompt.Forced) and Prompt.Required and
	4652	(((pt<>ptWHNotPurp)and(pt<>ptWHPapResult))and
	4653	((Value = '') or (Value = '@')) or
	4654	((pt = ptVisitDate) and Prompt.FMonthReq and (StrToIntDef(copy(Value,4,2),0) = 0)) or
	4655	((pt in [ptVisitDate, ptVisitLocation]) and (Value = '0')))) then
	4656	begin
	4657	WordWrap('Element: ' + FText, List, 68, 6);
	4658	txt := Prompt.ForcedCaption;
	4659	if(pt = ptVisitDate) and Prompt.FMonthReq then
	4660	txt := txt + ' (Month Required)';
	4661	WordWrap('Item: ' + txt, List, 65, 6);
	4662	end;
	4663	if (Prompt.PromptOK and (not Prompt.Forced) and Prompt.Required and
	4664	((WHResultChk='') and (Value='')) and ((pt=ptWHPapResult) and (FData<>nil))) then
	4665	begin
	4666	WordWrap('Prompt: ' + Prompt.ForcedCaption, List, 65,6);
	4667	end;
	4668	if (Prompt.PromptOK and (not Prompt.Forced) and Prompt.Required
	4669	and (pt=ptWHNotPurp)) and ((WHResultNot = '') and (Value = '')) then
	4670	begin
	4671	WordWrap('Element: ' + FText, List, 68, 6);
	4672	WordWrap('Prompt: ' + Prompt.ForcedCaption, List, 65,6);
	4673	end;
	4674	//(AGP Change 24.9 add check to see if MH tests are required)
	4675	if ((Pt = ptMHTest) or (Pt = ptGAF)) and (Piece(Prompt.FData.FRec3,U,13) = '1') and
	4676	(not Prompt.Forced) then
	4677	begin
[460]	4678	if (Pt = ptMHTest) and (Prompt.FMHTestComplete = 2) then
[459]	4679	begin
[460]	4680	if ((Prompt.FValue = '') or (pos('X',Prompt.FValue)>0)) then
	4681	begin
	4682	if Prompt.FValue = '' then
	4683	WordWrap('MH test '+ Piece(Prompt.FData.FRec3,U,8) + ' not done',List,65,6);
	4684	if pos('X',Prompt.FValue)>0 then
	4685	WordWrap('You are missing one or more responses in the MH test '+
	4686	Piece(Prompt.FData.FRec3,U,8),List,65,6);
	4687	WordWrap(' ',List,65,6);
	4688	end;
[459]	4689	end;
[460]	4690	if (Pt = ptMHTest) and (Prompt.FMHTestComplete = 0) or (Prompt.FValue = '') then
	4691	begin
	4692	if Prompt.FValue = '' then
	4693	WordWrap('MH test '+ Piece(Prompt.FData.FRec3,U,8) + ' not done',List,65,6);
	4694	if pos('X',Prompt.FValue)>0 then
	4695	WordWrap('You are missing one or more responses in the MH test '+
	4696	Piece(Prompt.FData.FRec3,U,8),List,65,6);
	4697	WordWrap(' ',List,65,6);
	4698	end;
[459]	4699	if (Pt = ptGAF) and ((Prompt.FValue = '0') or (Prompt.FValue = '')) then
	4700	begin
	4701	WordWrap('GAF test must have a score greater then zero',List,65,6);
	4702	WordWrap(' ',List,65,6);
	4703	end;
	4704	end;
	4705	end;
	4706	end;
	4707	if (assigned(FChildren)) and (FChecked or (ElemType = etDisplayOnly)) then
	4708	begin
	4709	cReq := ChildrenRequired;
	4710	if(cReq in [crOne, crAtLeastOne]) then
	4711	begin
	4712	cnt := 0;
	4713	for i := 0 to FChildren.Count-1 do
	4714	begin
	4715	Kid := TRemDlgElement(FChildren[i]);
	4716	// if(Kid.FChecked and (Kid.ElemType <> etDisplayOnly)) then
	4717	if(Kid.FChecked) then
	4718	inc(cnt);
	4719	end;
	4720	if(cReq = crOne) and (cnt <> 1) then
	4721	msg := 'One selection required'
	4722	else
	4723	if(cReq = crAtLeastOne) and (cnt < 1) then
	4724	msg := 'One or more selections required'
	4725	else
	4726	msg := '';
	4727	if(msg <> '') then
	4728	begin
	4729	txt := BoxCaption;
	4730	if(txt = '') then
	4731	txt := FText;
	4732	WordWrap('Group: ' + txt, List, 68, 6);
	4733	WordWrap(Msg, List, 65, 0);
	4734	WordWrap(' ',List,68,6); // (AGP change 24.9 added blank line for display spacing)
	4735	end;
	4736	end;
	4737	for i := 0 to FChildren.Count-1 do
	4738	TRemDlgElement(FChildren[i]).FinishProblems(List);
	4739	end;
	4740	end;
	4741
	4742	function TRemDlgElement.IsChecked: boolean;
	4743	var
	4744	Prnt: TRemDlgElement;
	4745
	4746	begin
	4747	Result := TRUE;
	4748	Prnt := Self;
	4749	while Result and assigned(Prnt) do
	4750	begin
	4751	Result := ((Prnt.ElemType = etDisplayOnly) or Prnt.FChecked);
	4752	Prnt := Prnt.FParent;
	4753	end;
	4754	end;
	4755
	4756	function TRemDlgElement.IndentChildrenInPN: boolean;
	4757	begin
	4758	//if(Box) then
	4759	Result := (Piece(FRec1, U, 21) = '1');
	4760	//else
	4761	// Result := FALSE;
	4762	end;
	4763
	4764	function TRemDlgElement.IndentPNLevel: integer;
	4765	begin
	4766	if(assigned(FParent)) then
	4767	begin
	4768	Result := FParent.IndentPNLevel;
	4769	if(FParent.IndentChildrenInPN) then
	4770	dec(Result,2);
	4771	end
	4772	else
	4773	Result := 70;
	4774	end;
	4775
	4776	function TRemDlgElement.IncludeMHTestInPN: boolean;
	4777	begin
	4778	Result := (Piece(FRec1, U, 9) = '0');
	4779	end;
	4780
	4781	function TRemDlgElement.ResultDlgID: integer;
	4782	begin
	4783	Result := StrToIntDef(Piece(FRec1, U, 10), 0);
	4784	end;
	4785
	4786	procedure TRemDlgElement.SubCommentChange(Sender: TObject);
	4787	var
	4788	i: integer;
	4789	txt: string;
	4790	ok: boolean;
	4791
	4792	begin
	4793	if(FHasSubComments and FHasComment and assigned(FCommentPrompt)) then
	4794	begin
	4795	ok := FALSE;
	4796	if(assigned(Sender)) then
	4797	begin
	4798	with (Sender as TORCheckBox) do
	4799	TRemPrompt(Tag).FValue := BOOLCHAR[Checked];
	4800	ok := TRUE;
	4801	end;
	4802	if(not ok) then
	4803	ok := (FCommentPrompt.GetValue = '');
	4804	if(ok) then
	4805	begin
	4806	txt := '';
	4807	for i := 0 to FPrompts.Count-1 do
	4808	begin
	4809	with TRemPrompt(FPrompts[i]) do
	4810	begin
	4811	if(PromptType = ptSubComment) and (FValue = BOOLCHAR[TRUE]) then
	4812	begin
	4813	if(txt <> '') then
	4814	txt := txt + ', ';
	4815	txt := txt + Caption;
	4816	end;
	4817	end;
	4818	end;
	4819	if(txt <> '') then
	4820	txt[1] := UpCase(txt[1]);
	4821	FCommentPrompt.SetValue(txt);
	4822	end;
	4823	end;
	4824	end;
	4825
	4826	constructor TRemDlgElement.Create;
	4827	begin
	4828	FFieldValues := TORStringList.Create;
	4829	end;
	4830
	4831	function TRemDlgElement.EntryID: string;
	4832	begin
	4833	Result := REMEntryCode + FReminder.GetIEN + '/' + IntToStr(integer(Self));
	4834	end;
	4835
	4836	procedure TRemDlgElement.FieldPanelChange(Sender: TObject);
	4837	var
	4838	idx: integer;
	4839	Entry: TTemplateDialogEntry;
	4840	fval: string;
	4841
	4842	begin
	4843	FReminder.BeginTextChanged;
	4844	try
	4845	Entry := TTemplateDialogEntry(Sender);
	4846	idx := FFieldValues.IndexOfPiece(Entry.InternalID);
	4847	fval := Entry.InternalID + U + Entry.FieldValues;
	4848	if(idx < 0) then
	4849	FFieldValues.Add(fval)
	4850	else
	4851	FFieldValues[idx] := fval;
	4852	finally
	4853	FReminder.EndTextChanged(Sender);
	4854	end;
	4855	end;
	4856
	4857	procedure TRemDlgElement.GetFieldValues(FldData: TStrings);
	4858	var
	4859	i, p: integer;
	4860	TmpSL: TStringList;
	4861
	4862	begin
	4863	TmpSL := TStringList.Create;
	4864	try
	4865	for i := 0 to FFieldValues.Count-1 do
	4866	begin
	4867	p := pos(U, FFieldValues[i]); // Can't use Piece because 2nd piece may contain ^ characters
	4868	if(p > 0) then
	4869	begin
	4870	TmpSL.CommaText := copy(FFieldValues[i],p+1,MaxInt);
	4871	FldData.AddStrings(TmpSL);
	4872	TmpSL.Clear;
	4873	end;
	4874	end;
	4875	finally
	4876	TmpSL.Free;
	4877	end;
	4878	if (assigned(FChildren)) and (FChecked or (ElemType = etDisplayOnly)) then
	4879	for i := 0 to FChildren.Count-1 do
	4880	TRemDlgElement(FChildren[i]).GetFieldValues(FldData);
	4881	end;
	4882
	4883	{cause the paint event to be called and draw a focus rectangle on the TFieldPanel}
	4884	procedure TRemDlgElement.FieldPanelEntered(Sender: TObject);
	4885	begin
	4886	with TFieldPanel(Sender) do
	4887	begin
	4888	Focus := TRUE;
	4889	Invalidate;
	4890	if Parent is TFieldPanel then
	4891	begin
	4892	TFieldPanel(Parent).Focus := FALSE;
	4893	TFieldPanel(Parent).Invalidate;
	4894	end;
	4895	end;
	4896	end;
	4897	{cause the paint event to be called and draw the TFieldPanel without the focus rect.}
	4898	procedure TRemDlgElement.FieldPanelExited(Sender: TObject);
	4899	begin
	4900	with TFieldPanel(Sender) do
	4901	begin
	4902	Focus := FALSE;
	4903	Invalidate;
	4904	if Parent is TFieldPanel then
	4905	begin
	4906	TFieldPanel(Parent).Focus := TRUE;
	4907	TFieldPanel(Parent).Invalidate;
	4908	end;
	4909	end;
	4910	end;
	4911
	4912	{Check the associated checkbox when spacebar is pressed}
	4913	procedure TRemDlgElement.FieldPanelKeyPress(Sender: TObject; var Key: Char);
	4914	begin
	4915	if Key = ' ' then
	4916	begin
	4917	FieldPanelOnClick(Sender);
	4918	Key := #0;
	4919	end;
	4920	end;
	4921
	4922	{So the FieldPanel will check the associated checkbox}
	4923	procedure TRemDlgElement.FieldPanelOnClick(Sender: TObject);
	4924	begin
	4925	// if TFieldPanel(Sender).Focus then
	4926	TORCheckBox(TFieldPanel(Sender).Tag).Checked := not FChecked;
	4927	end;
	4928
	4929	{call the FieldPanelOnClick so labels on the panels will also click the checkbox}
	4930	procedure TRemDlgElement.FieldPanelLabelOnClick(Sender: TObject);
	4931	begin
	4932	FieldPanelOnClick(TLabel(Sender).Parent); {use the parent/fieldpanel as the Sender}
	4933	end;
	4934
	4935	{ TRemData }
	4936
	4937	function TRemData.Add2PN: boolean;
	4938	begin
	4939	Result := (Piece(FRec3, U, 5) <> '1');
	4940	end;
	4941
	4942	function TRemData.AddData(List: TStrings; Finishing: boolean): integer;
	4943	var
	4944	i, j, k: integer;
	4945	PCECat: TPCEDataCat;
	4946	Primary: boolean;
	4947	ActDt, InActDt: Double;
	4948	EncDt: TFMDateTime;
	4949
	4950	procedure AddPrompt(Prompt: TRemPrompt; dt: TRemDataType; var x: string);
	4951	var
	4952	pt: TRemPromptType;
	4953	pnum: integer;
	4954	Pdt: TRemDataType;
	4955	v: TVitalType;
	4956	rte, unt, txt: string;
	4957	UIEN: Int64;
	4958
	4959	begin
	4960	pnum := -1;
	4961	pt := Prompt.PromptType;
	4962	if(pt = ptSubComment) or (pt = ptUnknown) then exit;
	4963	if(pt = ptMST) then
	4964	begin
	4965	if (PCECat in MSTDataTypes) then
	4966	begin
	4967	UIEN := FParent.FReminder.PCEDataObj.Providers.PCEProvider;
	4968	if UIEN <= 0 then
	4969	UIEN := User.DUZ;
	4970	SetPiece(x, U, pnumMST, Prompt.GetValue + ';' + // MST Code
	4971	FloatToStr(RemForm.PCEObj.VisitDateTime) + ';' +
	4972	IntToStr(UIEN) + ';' + //
	4973	Prompt.FMiscText); // IEN of Exam, if any
	4974	end;
	4975	end
	4976	else
	4977	if(PCECat = pdcVital) then
	4978	begin
	4979	if(pt = ptVitalEntry) then
	4980	begin
	4981	rte := Prompt.VitalValue;
	4982	if(rte <> '') then
	4983	begin
	4984	v := Prompt.VitalType;
	4985	unt := Prompt.VitalUnitValue;
	4986	ConvertVital(v, rte, unt);
[460]	4987	//txt := U + VitalCodes[v] + U + rte + U + FloatToStr(RemForm.PCEObj.VisitDateTime); AGP Change 26.1 commented out
	4988	txt := U + VitalCodes[v] + U + rte + U + '0'; //AGP Change 26.1 Use for Vital date/time
[459]	4989	if(not Finishing) then
	4990	txt := Char(ord('A')+ord(v)) + FormatVitalForNote(txt); // Add vital sort char
	4991	List.AddObject(Char(ord('A')+ord(PCECat)) + txt, Self);
	4992	end;
	4993	end
	4994	else
	4995	exit;
	4996	end
	4997	else
	4998	if(PCECat = pdcMH) then
	4999	begin
	5000	if(pt = ptMHTest) or (pt = ptGAF) then
	5001	x := x + U + Prompt.GetValue
	5002	else
	5003	exit;
	5004	end
	5005	else
	5006	if(pt <> ptDataList) and (ord(pt) >= ord(low(TRemPromptType))) then
	5007	begin
	5008	Pdt := RemPromptTypes[pt];
	5009	if (Pdt = dt) or (Pdt = dtAll) or
	5010	((Pdt = dtHistorical) and assigned(Prompt.FParent) and
	5011	Prompt.FParent.Historical) then
	5012	pnum := FinishPromptPieceNum[pt];
	5013	if(pnum > 0) then
	5014	begin
	5015	if(pt = ptPrimaryDiag) then
	5016	SetPiece(x, U, pnum, BoolChar[Primary])
	5017	else
	5018	SetPiece(x, U, pnum, Prompt.GetValue);
	5019	end;
	5020	end;
	5021	end;
	5022
	5023	procedure Add(Str: string; Root: TRemPCERoot);
	5024	var
	5025	i, Qty: integer;
	5026	Value, IsGAF, txt, x, Code, Nar, Cat: string;
	5027	Skip: boolean;
	5028	Prompt: TRemPrompt;
	5029	dt: TRemDataType;
	5030	TestDate: TFMDateTime;
	5031	i1,i2: integer;
	5032
	5033	begin
	5034	x := '';
	5035	dt := Code2DataType(Piece(Str, U, r3Type));
	5036	PCECat := RemData2PCECat[dt];
	5037	Code := Piece(Str, U, r3Code);
	5038	if(Code = '') then
	5039	Code := Piece(Str, U, r3Code2);
	5040	Nar := Piece(Str, U, r3Nar);
	5041	Cat := Piece(Str, U, r3Cat);
	5042
	5043	Primary := FALSE;
	5044	if(assigned(FParent) and assigned(FParent.FPrompts) and (PCECat = pdcDiag)) then
	5045	begin
	5046	if(FParent.Historical) then
	5047	begin
	5048	for i := 0 to FParent.FPrompts.Count-1 do
	5049	begin
	5050	Prompt := TRemPrompt(FParent.FPrompts[i]);
	5051	if(Prompt.PromptType = ptPrimaryDiag) then
	5052	begin
	5053	Primary := (Prompt.GetValue = BOOLCHAR[TRUE]);
	5054	break;
	5055	end;
	5056	end;
	5057	end
	5058	else
	5059	Primary := (Root = PrimaryDiagRoot);
	5060	end;
	5061
	5062	Skip := FALSE;
	5063	if (PCECat = pdcMH) then
	5064	begin
	5065	IsGAF := Piece(FRec3, U, r3GAF);
	5066	Value := FChoicePrompt.GetValue;
	5067	if(Value = '') or ((IsGAF = '1') and (Value = '0')) then
	5068	Skip := TRUE;
	5069	end;
	5070
	5071	if Finishing or (PCECat = pdcVital) then
	5072	begin
	5073	if(dt = dtOrder) then
	5074	x := U + Piece(Str,U,6) + U + Piece(Str,U,11) + U + Nar
	5075	else
	5076	begin
	5077	if (PCECat = pdcMH) then
	5078	begin
	5079	if(Skip) then
	5080	x := ''
	5081	else
	5082	begin
	5083	TestDate := Trunc(FParent.FReminder.PCEDataObj.VisitDateTime);
	5084	if(IsGAF = '1') then
	5085	ValidateGAFDate(TestDate);
	5086	x := U + Nar + U + IsGAF + U + FloatToStr(TestDate) + U +
	5087	IntToSTr(FParent.FReminder.PCEDataObj.Providers.PCEProvider);
	5088	end;
	5089	end
	5090	else
	5091	if (PCECat <> pdcVital) then
	5092	begin
	5093	x := Piece(Str, U, 6);
	5094	SetPiece(x, U, pnumCode, Code);
	5095	SetPiece(x, U, pnumCategory, Cat);
	5096	SetPiece(x, U, pnumNarrative, Nar);
	5097	end;
	5098	if(assigned(FParent)) then
	5099	begin
	5100	if(assigned(FParent.FPrompts)) then
	5101	begin
	5102	for i := 0 to FParent.FPrompts.Count-1 do
	5103	begin
	5104	Prompt := TRemPrompt(FParent.FPrompts[i]);
	5105	if(not Prompt.FIsShared) then
	5106	AddPrompt(Prompt, dt, x);
	5107	end;
	5108	end;
	5109	if(assigned(FParent.FParent) and FParent.FParent.FHasSharedPrompts) then
	5110	begin
	5111	for i := 0 to FParent.FParent.FPrompts.Count-1 do
	5112	begin
	5113	Prompt := TRemPrompt(FParent.FParent.FPrompts[i]);
	5114	if(Prompt.FIsShared) and (Prompt.FSharedChildren.IndexOf(FParent) >= 0) then
	5115	AddPrompt(Prompt, dt, x);
	5116	end;
	5117	end;
	5118	end;
	5119	end;
	5120	if(x <> '') then
	5121	List.AddObject(Char(ord('A')+ord(PCECat)) + x, Self);
	5122	end
	5123	else
	5124	begin
	5125	Qty := 1;
	5126	if(assigned(FParent) and assigned(FParent.FPrompts)) then
	5127	begin
	5128	if(PCECat = pdcProc) then
	5129	begin
	5130	for i := 0 to FParent.FPrompts.Count-1 do
	5131	begin
	5132	Prompt := TRemPrompt(FParent.FPrompts[i]);
	5133	if(Prompt.PromptType = ptQuantity) then
	5134	begin
	5135	Qty := StrToIntDef(Prompt.GetValue, 1);
	5136	if(Qty < 1) then Qty := 1;
	5137	break;
	5138	end;
	5139	end;
	5140	end;
	5141	end;
	5142	if (not Skip) then
	5143	begin
	5144	txt := Char(ord('A')+ord(PCECat)) +
	5145	GetPCEDataText(PCECat, Code, Cat, Nar, Primary, Qty);
	5146	if(assigned(FParent) and FParent.Historical) then
	5147	txt := txt + ' (Historical)';
	5148	List.AddObject(txt, Self);
	5149	inc(Result);
	5150	end;
	5151	if assigned(FParent) and assigned(FParent.FMSTPrompt) then
	5152	begin
	5153	txt := FParent.FMSTPrompt.Value;
	5154	if txt <> '' then
	5155	begin
	5156	if FParent.FMSTPrompt.FMiscText = '' then
	5157	begin
	5158	i1 := 0;
	5159	i2 := 2;
	5160	end
	5161	else
	5162	begin
	5163	i1 := 3;
	5164	i2 := 4;
	5165	end;
	5166	for i := i1 to i2 do
	5167	if txt = MSTDescTxt[i,1] then
	5168	begin
	5169	List.AddObject(Char( ord('A') + ord(pdcMST)) + MSTDescTxt[i,0], Self);
	5170	break;
	5171	end;
	5172	end;
	5173	end;
	5174	end;
	5175	end;
	5176
	5177	begin
	5178	Result := 0;
	5179	if(assigned(FChoicePrompt)) and (assigned(FChoices)) then
	5180	begin
	5181	If not assigned(FChoicesActiveDates) then
	5182	begin
	5183	for i := 0 to FChoices.Count - 1 do
	5184	begin
	5185	if (copy(FChoicePrompt.GetValue, i+1, 1) = '1') then
	5186	Add(FChoices[i], TRemPCERoot(FChoices.Objects[i]))
	5187	end
	5188	end
	5189	else {if there are active dates for each choice then check them}
	5190	begin
	5191	If Self.FParent.Historical then
	5192	EncDt := DateTimeToFMDateTime(Date)
	5193	else
	5194	EncDt := RemForm.PCEObj.VisitDateTime;
	5195	k := 0;
	5196	for i := 0 to FChoices.Count - 1 do
	5197	begin
	5198	for j := 0 to (TStringList(Self.FChoicesActiveDates[i]).Count - 1) do
	5199	begin
	5200	ActDt := StrToIntDef((Piece(TStringList(Self.FChoicesActiveDates[i]).Strings[j], ':', 1)),0);
	5201	InActDt := StrToIntDef((Piece(TStringList(Self.FChoicesActiveDates[i]).Strings[j], ':', 2)),9999999);
	5202	if (EncDt >= ActDt) and (EncDt <= InActDt) then
	5203	begin
	5204	if(copy(FChoicePrompt.GetValue, k+1,1) = '1') then
	5205	Add(FChoices[i], TRemPCERoot(FChoices.Objects[i]));
	5206	inc(k);
	5207	end; {Active date check}
	5208	end; {FChoicesActiveDates.Items[i] loop}
	5209	end; {FChoices loop}
	5210	end {FChoicesActiveDates check}
	5211	end {FChoicePrompt and FChoices check}
	5212	else
	5213	Add(FRec3, FPCERoot); {Active dates for this are checked in TRemDlgElement.AddData}
	5214	end;
	5215
	5216	function TRemData.Category: string;
	5217	begin
	5218	Result := Piece(FRec3, U, r3Cat);
	5219	end;
	5220
	5221	function TRemData.DataType: TRemDataType;
	5222	begin
	5223	Result := Code2DataType(Piece(FRec3, U, r3Type));
	5224	end;
	5225
	5226	destructor TRemData.Destroy;
	5227	var
	5228	i: integer;
	5229
	5230	begin
	5231	if(assigned(FPCERoot)) then
	5232	FPCERoot.Done(Self);
	5233	if(assigned(FChoices)) then
	5234	begin
	5235	for i := 0 to FChoices.Count-1 do
	5236	begin
	5237	if(assigned(FChoices.Objects[i])) then
	5238	TRemPCERoot(FChoices.Objects[i]).Done(Self);
	5239	end;
	5240	end;
	5241	KillObj(@FChoices);
	5242	inherited;
	5243	end;
	5244
	5245	function TRemData.DisplayWHResults: boolean;
	5246	begin
	5247	Result :=False;
	5248	if FRec3<>'' then
	5249	Result := (Piece(FRec3, U, 6) <> '0');
	5250	end;
	5251
	5252	function TRemData.ExternalValue: string;
	5253	begin
	5254	Result := Piece(FRec3, U, r3Code);
	5255	end;
	5256
	5257	function TRemData.InternalValue: string;
	5258	begin
	5259	Result := Piece(FRec3, U, 6);
	5260	end;
	5261
	5262	function TRemData.Narrative: string;
	5263	begin
	5264	Result := Piece(FRec3, U, r3Nar);
	5265	end;
	5266
	5267	{ TRemPrompt }
	5268
	5269	function TRemPrompt.Add2PN: boolean;
	5270	begin
	5271	Result := FALSE;
	5272	if (not Forced) and (PromptOK) then
	5273	//if PromptOK then
	5274	Result := (Piece(FRec4, U, 5) <> '1');
	5275	if (Result=false) and (Piece(FRec4,U,4)='WH_NOT_PURP') then
	5276	Result := True;
	5277	end;
	5278
	5279	function TRemPrompt.Caption: string;
	5280	begin
	5281	Result := Piece(FRec4, U, 8);
	5282	if(not FCaptionAssigned) then
	5283	begin
	5284	AssignFieldIDs(Result);
	5285	SetPiece(FRec4, U, 8, Result);
	5286	FCaptionAssigned := TRUE;
	5287	end;
	5288	end;
	5289
	5290	constructor TRemPrompt.Create;
	5291	begin
	5292	FOverrideType := ptUnknown;
	5293	end;
	5294
	5295	function TRemPrompt.Forced: boolean;
	5296	begin
	5297	Result := (Piece(FRec4, U, 7) = 'F');
	5298	end;
	5299
	5300	function TRemPrompt.InternalValue: string;
	5301	var
	5302	m, d, y: word;
	5303	Code: string;
	5304
	5305	begin
	5306	Result := Piece(FRec4, U, 6);
	5307	Code := Piece(FRec4, U, 4);
	5308	if(Code = RemPromptCodes[ptVisitDate]) then
	5309	begin
	5310	if(copy(Result,1,1) = MonthReqCode) then
	5311	begin
	5312	FMonthReq := TRUE;
	5313	delete(Result,1,1);
	5314	end;
	5315	if(Result = '') then
	5316	begin
	5317	DecodeDate(Now, y, m, d);
	5318	Result := inttostr(y-1700)+'0000';
	5319	SetPiece(FRec4, U, 6, Result);
	5320	end;
	5321	end;
	5322	end;
	5323
	5324	procedure TRemPrompt.PromptChange(Sender: TObject);
	5325	var
	5326	cbo: TORComboBox;
	5327	pt: TRemPromptType;
	5328	TmpValue, OrgValue: string;
	5329	idx, i: integer;
	5330	NeedRedraw: boolean;
	5331	dte: TFMDateTime;
	5332	whCKB: TWHCheckBox;
	5333	//printoption: TORCheckBox;
	5334	WHValue, WHValue1: String;
	5335	begin
	5336	FParent.FReminder.BeginTextChanged;
	5337	try
	5338	FFromControl := TRUE;
	5339	try
	5340	TmpValue := GetValue;
	5341	OrgValue := TmpValue;
	5342	pt := PromptType;
	5343	NeedRedraw := FALSE;
	5344	case pt of
[460]	5345	ptComment, ptQuantity:
[459]	5346	TmpValue := (Sender as TEdit).Text;
	5347
	5348	ptVisitDate:
	5349	begin
	5350	dte := (Sender as TORDateCombo).FMDate;
	5351	while (dte > 2000000) and (dte > FMToday) do
	5352	begin
	5353	dte := dte - 10000;
	5354	NeedRedraw := TRUE;
	5355	end;
	5356	TmpValue := FloatToStr(dte);
	5357	if(TmpValue = '1000000') then
	5358	TmpValue := '0';
	5359	end;
	5360
	5361	ptPrimaryDiag, ptAdd2PL, ptContraindicated:
	5362	begin
	5363	TmpValue := BOOLCHAR[(Sender as TORCheckBox).Checked];
	5364	NeedRedraw := (pt = ptPrimaryDiag);
	5365	end;
	5366
	5367	ptVisitLocation:
	5368	begin
	5369	cbo := (Sender as TORComboBox);
	5370	if(cbo.ItemIEN < 0) then
	5371	NeedRedraw := (not cbo.DroppedDown)
	5372	else
	5373	begin
	5374	if(cbo.ItemIndex <= 0) then
	5375	cbo.Items[0] := '0' + U + cbo.text;
	5376	TmpValue := cbo.ItemID;
	5377	if(StrToIntDef(TmpValue,0) = 0) then
	5378	TmpValue := cbo.Text;
	5379	end;
	5380	end;
	5381
	5382	ptWHPapResult:
	5383	begin
	5384	if (Sender is TWHCheckBox) then
	5385	begin
	5386	whCKB := (Sender as TWHCheckBox);
	5387	if whCKB.Checked = true then
	5388	begin
	5389	if whCKB.Caption ='NEM (No Evidence of Malignancy)' then FParent.WHResultChk := 'N';
	5390	if whCKB.Caption ='Abnormal' then FParent.WHResultChk := 'A';
	5391	if whCKB.Caption ='Unsatisfactory for Diagnosis' then FParent.WHResultChk := 'U';
	5392	//AGP Change 23.13 WH multiple processing
	5393	for i := 0 to FParent.FData.Count-1 do
	5394	begin
	5395	if Piece(TRemData(FParent.FData[i]).FRec3,U,4)='WHR' then
	5396	begin
	5397	FParent.FReminder.WHReviewIEN := Piece(TRemData(FParent.FData[i]).FRec3,U,6)
	5398	end;
	5399	end;
	5400	end
	5401	else
	5402	begin
	5403	FParent.WHResultChk := '';
	5404	FParent.FReminder.WHReviewIEN := ''; //AGP CHANGE 23.13
	5405	end;
	5406	end;
	5407	end;
	5408
	5409
	5410	ptWHNotPurp:
	5411	begin
	5412	if (Sender is TWHCheckBox) then
	5413	begin
	5414	whCKB := (Sender as TWHCheckBox);
	5415	if whCKB.Checked = true then
	5416	begin
	5417	if whCKB.Caption ='Letter' then
	5418	begin
	5419	if FParent.WHResultNot='' then FParent.WHResultNot := 'L'
	5420	else
	5421	if Pos('L',FParent.WHResultNot)=0 then FParent.WHResultNot := FParent.WHResultNot +':L';
	5422	if whCKB.FButton <> nil then whCKB.FButton.Enabled := true;
	5423	if whCKB.FPrintNow <> nil then
	5424	begin
	5425	whCKB.FPrintVis :='1';
	5426	whCKB.FPrintNow.Enabled := true;
	5427	end;
	5428	end;
	5429	if whCKB.Caption ='In-Person' then
	5430	begin
	5431	if FParent.WHResultNot='' then FParent.WHResultNot := 'I'
	5432	else
	5433	if Pos('I',FParent.WHResultNot)=0 then FParent.WHResultNot := FParent.WHResultNot+':I';
	5434	end;
	5435	if whCKB.Caption ='Phone Call' then
	5436	begin
	5437	if FParent.WHResultNot='' then FParent.WHResultNot := 'P'
	5438	else
	5439	if Pos('P',FParent.WHResultNot)=0 then FParent.WHResultNot := FParent.WHResultNot+':P';
	5440	end;
	5441	end
	5442	else
	5443	begin
	5444	// this section is to handle unchecking of boxes and disabling print now and view button
	5445	WHValue := FParent.WHResultNot;
	5446	if whCKB.Caption ='Letter' then
	5447	begin
	5448	for i:=1 to Length(WHValue) do
	5449	begin
	5450	if WHValue1='' then
	5451	begin
	5452	if (WHValue[i]<>'L') and (WHValue[i]<>':') then WHValue1 := WHValue[i];
	5453	end
	5454	else
	5455	if (WHValue[i]<>'L') and (WHValue[i]<>':') then WHValue1 := WHValue1+':'+WHValue[i];
	5456	end;
	5457	if (whCKB.FButton <> nil) and (whCKB.FButton.Enabled = true) then whCKB.FButton.Enabled := false;
	5458	if (whCKB.FPrintNow <> nil) and (whCKB.FPrintNow.Enabled = true) then
	5459	begin
	5460	whCKB.FPrintVis := '0';
	5461	if whCKB.FPrintNow.Checked = true then whCKB.FPrintNow.Checked := false;
	5462	whCKB.FPrintNow.Enabled := false;
	5463	FParent.WHPrintDevice := '';
	5464	end;
	5465	end;
	5466	if whCKB.Caption ='In-Person' then
	5467	begin
	5468	for i:=1 to Length(WHValue) do
	5469	begin
	5470	if WHValue1='' then
	5471	begin
	5472	if (WHValue[i]<>'I') and (WHValue[i]<>':') then WHValue1 := WHValue[i];
	5473	end
	5474	else
	5475	if (WHValue[i]<>'I') and (WHValue[i]<>':') then WHValue1 := WHValue1+':'+WHValue[i];
	5476	end;
	5477	end;
	5478	if whCKB.Caption ='Phone Call' then
	5479	begin
	5480	for i:=1 to Length(WHValue) do
	5481	begin
	5482	if WHValue1='' then
	5483	begin
	5484	if (WHValue[i]<>'P') and (WHValue[i]<>':') then WHValue1 := WHValue[i];
	5485	end
	5486	else
	5487	if (WHValue[i]<>'P') and (WHValue[i]<>':') then WHValue1 := WHValue1+':'+WHValue[i];
	5488	end;
	5489	end;
	5490	FParent.WHResultNot := WHValue1;
	5491	end;
	5492	end
	5493	else
	5494	if ((Sender as TORCheckBox)<>nil) and (Piece(FRec4,U,12)='1') then
	5495	begin
	5496	if (((Sender as TORCheckBox).Caption = 'Print Now') and
	5497	((Sender as TORCheckBox).Enabled =true)) and ((Sender as TORCheckBox).Checked = true) and
	5498	(FParent.WHPrintDevice ='') then
	5499	begin
	5500	FParent.WHPrintDevice := SelectDevice(Self, Encounter.Location, false, 'Women Health Print Device Selection');
	5501	FPrintNow :='1';
	5502	if FParent.WHPrintDevice ='' then
	5503	begin
	5504	FPrintNow :='0';
	5505	(Sender as TORCheckBox).Checked := false;
	5506	end;
	5507	end;
	5508	if (((Sender as TORCheckBox).Caption = 'Print Now') and
	5509	((Sender as TORCheckBox).Enabled =true)) and ((Sender as TORCheckBox).Checked = false) then
	5510	begin
	5511	FParent.WHPrintDevice := '';
	5512	FPrintNow :='0';
	5513	end;
	5514	end;
	5515	end;
[460]	5516
[459]	5517	ptExamResults, ptSkinResults, ptLevelSeverity,
[460]	5518	ptSeries, ptReaction, ptLevelUnderstanding, ptSkinReading: //(AGP Change 26.1)
[459]	5519	TmpValue := (Sender as TORComboBox).ItemID;
	5520	else
	5521	if pt = ptVitalEntry then
	5522	begin
	5523	case (Sender as TControl).Tag of
	5524	TAG_VITTEMPUNIT, TAG_VITHTUNIT, TAG_VITWTUNIT: idx := 2;
	5525	TAG_VITPAIN: begin
	5526	idx := -1;
	5527	TmpValue := (Sender as TORComboBox).ItemID;
[460]	5528	if FParent.VitalDateTime = 0 then
	5529	FParent.VitalDateTime := FMNow;
[459]	5530	end;
	5531	else
	5532	idx := 1;
	5533	end;
	5534	if(idx > 0) then
[460]	5535	begin
	5536	//AGP Change 26.1 change Vital time/date to Now instead of encounter date/time
	5537	SetPiece(TmpValue, ';', idx, TORExposedControl(Sender).Text);
	5538	if (FParent.VitalDateTime > 0) and (TORExposedControl(Sender).Text = '') then
	5539	FParent.VitalDateTime := 0;
	5540	if (FParent.VitalDateTime = 0) and (TORExposedControl(Sender).Text <> '') then
	5541	FParent.VitalDateTime := FMNow;
	5542	end;
[459]	5543	end
	5544	else
	5545	if pt = ptDataList then
	5546	begin
	5547	TmpValue := (Sender as TORComboBox).CheckedString;
	5548	NeedRedraw := TRUE;
	5549	end
	5550	else
	5551	if pt = ptGAF then
	5552	TmpValue := (Sender as TEdit).Text;
	5553	end;
	5554	if(TmpValue <> OrgValue) then
	5555	begin
	5556	if NeedRedraw then
	5557	FParent.FReminder.BeginNeedRedraw;
	5558	try
	5559	SetValue(TmpValue);
	5560	finally
	5561	if NeedRedraw then
	5562	FParent.FReminder.EndNeedRedraw(Self);
	5563	end;
	5564	end
	5565	else
	5566	if NeedRedraw then
	5567	begin
	5568	FParent.FReminder.BeginNeedRedraw;
	5569	FParent.FReminder.EndNeedRedraw(Self);
	5570	end;
	5571	finally
	5572	FFromControl := FALSE;
	5573	end;
	5574	finally
	5575	FParent.FReminder.EndTextChanged(Sender);
	5576	end;
	5577	if(FParent.ElemType = etDisplayOnly) and (not assigned(FParent.FParent)) then
	5578	RemindersInProcess.Notifier.Notify;
	5579	end;
	5580
	5581
	5582	procedure TRemPrompt.ComboBoxKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
	5583	begin
	5584	if(Key = VK_RETURN) and (Sender is TORComboBox) and
	5585	((Sender as TORComboBox).DroppedDown) then
	5586	(Sender as TORComboBox).DroppedDown := FALSE;
	5587	end;
	5588
	5589	function TRemPrompt.PromptOK: boolean;
	5590	var
	5591	pt: TRemPromptType;
	5592	dt: TRemDataType;
	5593	i: integer;
	5594
	5595	begin
	5596	pt := PromptType;
	5597	if(pt = ptUnknown) or (pt = ptMST) then
	5598	Result := FALSE
	5599	else
	5600	if(pt = ptDataList) or (pt = ptVitalEntry) or (pt = ptMHTest) or (pt = ptGAF) or
	5601	(pt = ptWHPapResult) then
	5602	Result := TRUE
	5603	else
	5604	if(pt = ptSubComment) then
	5605	Result := FParent.FHasComment
	5606	else
	5607	begin
	5608	dt := RemPromptTypes[PromptType];
	5609	if(dt = dtAll) then Result := TRUE
	5610	else if(dt = dtUnknown) then Result := FALSE
	5611	else if(dt = dtHistorical) then Result := FParent.Historical
	5612	else
	5613	begin
	5614	Result := FALSE;
	5615	if(assigned(FParent.FData)) then
	5616	begin
	5617	for i := 0 to FParent.FData.Count-1 do
	5618	begin
	5619	if(TRemData(FParent.FData[i]).DataType = dt) then
	5620	begin
	5621	Result := TRUE;
	5622	break;
	5623	end;
	5624	end;
	5625	end;
	5626	end;
	5627	end;
	5628	end;
	5629
	5630	function TRemPrompt.PromptType: TRemPromptType;
	5631	begin
	5632	if(assigned(FData)) then
	5633	Result := FOverrideType
	5634	else
	5635	Result := Code2PromptType(Piece(FRec4, U, 4));
	5636	end;
	5637
	5638
	5639	function TRemPrompt.Required: boolean;
	5640	var
	5641	pt: TRemPromptType;
	5642
	5643	begin
	5644	pt := PromptType;
	5645	if(pt = ptVisitDate) then
	5646	Result := TRUE
	5647	else
	5648	if(pt = ptSubComment) then
	5649	Result := FALSE
	5650	else
	5651	Result := (Piece(FRec4, U, 10) = '1');
	5652	end;
	5653
	5654	function TRemPrompt.SameLine: boolean;
	5655	begin
	5656	Result := (Piece(FRec4, U, 9) <> '1');
	5657	end;
	5658
	5659	function TRemPrompt.NoteText: string;
	5660	var
	5661	pt: TRemPromptType;
	5662	fmt, tmp, WHValue: string;
	5663	cnt, i, j, k: integer;
	5664	ActDt, InActDt: Double;
	5665	EncDt: TFMDateTime;
	5666
	5667	begin
	5668	Result := '';
	5669	if Add2PN then
	5670	begin
	5671	pt := PromptType;
	5672	tmp := GetValue;
	5673	case pt of
	5674	ptComment: Result := tmp;
	5675
	5676	ptQuantity: if(StrToIntDef(tmp,1) <> 1) then
	5677	Result := tmp;
	5678
[460]	5679	(* ptSkinReading: if(StrToIntDef(tmp,0) <> 0) then
	5680	Result := tmp; *)
[459]	5681
[460]	5682	ptSkinReading: // (AGP Change 26.1)
	5683	begin
	5684	Result := tmp;
	5685	end;
	5686
[459]	5687	ptVisitDate:
	5688	begin
	5689	try
	5690	if(tmp <> '') and (tmp <> '0') and (length(Tmp) = 7) then
	5691	begin
	5692	if FMonthReq and (copy(tmp,4,2) = '00') then
	5693	Result := ''
	5694	else
	5695	begin
	5696	if(copy(tmp,4,4) = '0000') then
	5697	fmt := 'YYYY'
	5698	else
	5699	if(copy(tmp,6,2) = '00') then
	5700	fmt := 'MMMM, YYYY'
	5701	else
	5702	fmt := 'MMMM D, YYYY';
	5703	Result := FormatFMDateTimeStr(fmt, tmp);
	5704	end;
	5705	end;
	5706	except
	5707	on EConvertError do
	5708	Result := tmp
	5709	else
	5710	raise;
	5711	end;
	5712	end;
	5713
	5714	ptPrimaryDiag, ptAdd2PL, ptContraindicated:
	5715	if(tmp = '1') then
	5716	Result := ' ';
	5717
	5718	ptVisitLocation:
	5719	if(StrToIntDef(tmp, 0) = 0) then
	5720	begin
	5721	if(tmp <> '0') then
	5722	Result := tmp;
	5723	end
	5724	else
	5725	begin
	5726	Result := GetPCEDisplayText(tmp, ComboPromptTags[pt]);
	5727	end;
	5728
	5729	ptWHPapResult:
	5730	begin
	5731	if Fparent.WHResultChk='N' then Result := 'NEM (No Evidence of Malignancy)';
	5732	if Fparent.WHResultChk='A' then Result := 'Abnormal';
	5733	if Fparent.WHResultChk='U' then Result := 'Unsatisfactory for Diagnosis';
	5734	if FParent.WHResultChk='' then Result := '';
	5735	end;
	5736
	5737	ptWHNotPurp:
	5738	begin
	5739	if FParent.WHResultNot <> '' then
	5740	begin
	5741	WHValue := FParent.WHResultNot;
	5742	//IF Forced = false then
	5743	//begin
	5744	if WHValue <> 'CPRS' then
	5745	begin
	5746	for cnt := 1 to Length(WHValue) do
	5747	begin
	5748	if Result ='' then
	5749	begin
	5750	if WHValue[cnt]='L' then Result := 'Letter';
	5751	if WHValue[cnt]='I' then Result := 'In-Person';
	5752	if WHValue[cnt]='P' then Result := 'Phone Call';
	5753	end
	5754	else
	5755	begin
	5756	if (WHValue[cnt]='L')and(Pos('Letter',Result)=0) then Result := Result+'; Letter';
	5757	if (WHValue[cnt]='I')and(Pos('In-Person',Result)=0) then Result := Result+'; In-Person';
	5758	if (WHValue[cnt]='P')and(Pos('Phone Call',Result)=0) then Result := Result+'; Phone Call';
	5759	end;
	5760	end;
	5761	end;
	5762	end
	5763	else
	5764	if Forced = true then
	5765	begin
	5766	if pos(':',Piece(FRec4,U,6))=0 then
	5767	begin
	5768	if Piece(FRec4,U,6)='L' then
	5769	begin
	5770	Result := 'Letter';
	5771	FParent.WHResultNot :='L';
	5772	end;
	5773	if Piece(FRec4,U,6)='I' then
	5774	begin
	5775	Result := 'In-Person';
	5776	FParent.WHResultNot := 'I';
	5777	end;
	5778	if Piece(FRec4,U,6)='P' then
	5779	begin
	5780	Result := 'Phone Call';
	5781	FParent.WHResultNot := 'P';
	5782	end;
	5783	if Piece(FRec4,U,6)='CPRS' then
	5784	begin
	5785	Result := '';
	5786	FParent.WHResultNot := 'CPRS';
	5787	end;
	5788	end
	5789	else
	5790	begin
	5791	WHValue := Piece(FRec4,U,6);
	5792	for cnt := 0 to Length(WHValue) do
	5793	begin
	5794	if Result ='' then
	5795	begin
	5796	if WHValue[cnt]='L' then
	5797	begin
	5798	Result := 'Letter';
	5799	FParent.WHResultNot := WHValue[cnt];
	5800	end;
	5801	if WHValue[cnt]='I' then
	5802	begin
	5803	Result := 'In-Person';
	5804	FParent.WHResultNot := WHValue[cnt];
	5805	end;
	5806	if WHValue[cnt]='P' then
	5807	begin
	5808	Result := 'Phone Call';
	5809	FParent.WHResultNot := WHValue[cnt];
	5810	end;
	5811	end
	5812	else
	5813	begin
	5814	if (WHValue[cnt]='L')and(Pos('Letter',Result)=0) then
	5815	begin
	5816	Result := Result +'; Letter';
	5817	FParent.WHResultNot := FParent.WHResultNot + ':' + WHValue[cnt];
	5818	end;
	5819	if (WHValue[cnt]='I')and(Pos('In-Person',Result)=0) then
	5820	begin
	5821	Result := Result +'; In-Person';
	5822	FParent.WHResultNot := FParent.WHResultNot + ':' + WHValue[cnt];
	5823	end;
	5824	if (WHValue[cnt]='P')and(Pos('Phone Call',Result)=0) then
	5825	begin
	5826	Result := Result +'; Phone Call';
	5827	FParent.WHResultNot := FParent.WHResultNot + ':' + WHValue[cnt];
	5828	end;
	5829	end;
	5830	end;
	5831
	5832	end;
	5833	end
	5834	else
	5835	Result := '';
	5836	end;
	5837
	5838	ptExamResults, ptSkinResults, ptLevelSeverity,
	5839	ptSeries, ptReaction, ptLevelUnderstanding:
	5840	begin
	5841	Result := tmp;
	5842	if(Piece(Result,U,1) = '@') then
	5843	Result := ''
	5844	else
	5845	Result := GetPCEDisplayText(tmp, ComboPromptTags[pt]);
	5846	end;
	5847
	5848	else
	5849	begin
	5850	if pt = ptDataList then
	5851	begin
	5852	if(assigned(FData) and assigned(FData.FChoices)) then
	5853	begin
	5854	if not(assigned(FData.FChoicesActiveDates)) then
	5855	for i := 0 to FData.FChoices.Count - 1 do
	5856	begin
	5857	if(copy(tmp,i+1,1) = '1') then
	5858	begin
	5859	if (Result <> '') then
	5860	Result := Result + ', ';
	5861	Result := Result + Piece(FData.FChoices[i],U,12);
	5862	end;
	5863	end
	5864	else {if there are active dates for each choice then check them}
	5865	begin
	5866	if Self.FParent.Historical then
	5867	EncDt := DateTimeToFMDateTime(Date)
	5868	else
	5869	EncDt := RemForm.PCEObj.VisitDateTime;
	5870	k := 0;
	5871	for i := 0 to FData.FChoices.Count - 1 do
	5872	begin
	5873	for j := 0 to (TStringList(FData.FChoicesActiveDates[i]).Count - 1) do
	5874	begin
	5875	ActDt := StrToIntDef((Piece(TStringList(FData.FChoicesActiveDates[i]).Strings[j], ':', 1)),0);
	5876	InActDt := StrToIntDef((Piece(TStringList(FData.FChoicesActiveDates[i]).Strings[j], ':', 2)),9999999);
	5877	if (EncDt >= ActDt) and (EncDt <= InActDt) then
	5878	begin
	5879	if(copy(tmp,k+1,1) = '1') then
	5880	begin
	5881	if(Result <> '') then
	5882	Result := Result + ', ';
	5883	Result := Result + Piece(FData.FChoices[i],U,12);
	5884	end;
	5885	inc(k);
	5886	end; {ActiveDate check}
	5887	end; {FChoicesActiveDates.Items[i] loop}
	5888	end; {FChoices loop}
	5889	end;
	5890	end;
	5891	end
	5892	else
	5893	if pt = ptVitalEntry then
	5894	begin
	5895	Result := VitalValue;
	5896	if(Result <> '') then
	5897	Result := ConvertVitalData(Result, VitalType, VitalUnitValue);
	5898	end
	5899	else
	5900	if pt = ptMHTest then
	5901	Result := FMiscText
	5902	else
	5903	if pt = ptGAF then
	5904	begin
	5905	if(StrToIntDef(Piece(tmp, U, 1),0) <> 0) then
	5906	begin
	5907	Result := tmp;
	5908	(*
	5909	GafDate := Trunc(FParent.FReminder.PCEDataObj.VisitDateTime);
	5910	ValidateGAFDate(GafDate);
	5911	Result := tmp + CRCode + 'Date Determined: ' + FormatFMDateTime('mm/dd/yyyy', GafDate) +
	5912	CRCode + 'Determined By: ' + FParent.FReminder.PCEDataObj.Providers.PCEProviderName;
	5913	*)
	5914	end;
	5915	end;
	5916	end;
	5917
	5918	end;
	5919	if(Result <> '') and (Caption <> '') then
	5920	Result := Trim(Caption + ' ' + Trim(Result));
	5921	end;
	5922	end;
	5923
	5924	function TRemPrompt.CanShare(Prompt: TRemPrompt): boolean;
	5925	var
	5926	pt: TRemPromptType;
	5927
	5928	begin
	5929	if(Forced or Prompt.Forced or Prompt.FIsShared or Required or Prompt.Required) then
	5930	Result := FALSE
	5931	else
	5932	begin
	5933	pt := PromptType;
	5934	Result := (pt = Prompt.PromptType);
	5935	if(Result) then
	5936	begin
	5937	if(pt in [ptAdd2PL, ptLevelUnderstanding]) or
	5938	((pt = ptComment) and (not FParent.FHasSubComments)) then
	5939	Result := ((Add2PN = Prompt.Add2PN) and
	5940	(Caption = Prompt.Caption))
	5941	else
	5942	Result := FALSE;
	5943	end;
	5944	end;
	5945	end;
	5946
	5947	destructor TRemPrompt.Destroy;
	5948	begin
	5949	KillObj(@FSharedChildren);
	5950	inherited;
	5951	end;
	5952
	5953	function TRemPrompt.RemDataActive(RData: TRemData; EncDt: TFMDateTime):Boolean;
	5954	var
	5955	ActDt, InActDt: Double;
	5956	j: integer;
	5957
	5958	begin
	5959	Result := FALSE;
	5960	if assigned(RData.FActiveDates) then
	5961	for j := 0 to (RData.FActiveDates.Count - 1) do
	5962	begin
	5963	ActDt := StrToIntDef(Piece(RData.FActiveDates[j],':',1), 0);
	5964	InActDt := StrToIntDef(Piece(RData.FActiveDates[j], ':', 2), 9999999);
	5965	if (EncDt >= ActDt) and (EncDt <= InActDt) then
	5966	begin
	5967	Result := TRUE;
	5968	Break;
	5969	end;
	5970	end
	5971	else
	5972	Result := TRUE;
	5973	end;
	5974
	5975	function TRemPrompt.RemDataChoiceActive(RData: TRemData; j: integer; EncDt: TFMDateTime):Boolean;
	5976	var
	5977	ActDt, InActDt: Double;
	5978	i: integer;
	5979	begin
	5980	Result := FALSE;
	5981	If not assigned(RData.FChoicesActiveDates) then //if no active dates were sent
	5982	Result := TRUE //from the server then don't check dates
	5983	else {if there are active dates for each choice then check them}
	5984	begin
	5985	for i := 0 to (TStringList(RData.FChoicesActiveDates[j]).Count - 1) do
	5986	begin
	5987	ActDt := StrToIntDef((Piece(TStringList(RData.FChoicesActiveDates[j]).Strings[i], ':', 1)),0);
	5988	InActDt := StrToIntDef((Piece(TStringList(RData.FChoicesActiveDates[j]).Strings[i], ':', 2)),9999999);
	5989	if (EncDt >= ActDt) and (EncDt <= InActDt) then
	5990	begin
	5991	Result := True;
	5992	end; {Active date check}
	5993	end; {FChoicesActiveDates.Items[i] loop}
	5994	end {FChoicesActiveDates check}
	5995	end;
	5996
	5997	function TRemPrompt.GetValue: string;
	5998	//Returns TRemPrompt.FValue if this TRemPrompt is not a ptPrimaryDiag
	5999	//Returns 0-False or 1-True if this TRemPrompt is a ptPrimaryDiag
	6000	var
	6001	i, j, k: integer;
	6002	RData: TRemData;
	6003	Ok: boolean;
	6004	EncDt: TFMDateTime;
	6005
	6006	begin
	6007	OK := (Piece(FRec4, U, 4) = RemPromptCodes[ptPrimaryDiag]);
	6008	if(OK) and (assigned(FParent)) then
	6009	OK := (not FParent.Historical);
	6010	if OK then
	6011	begin
	6012	Ok := FALSE;
	6013	if(assigned(FParent) and assigned(FParent.FData)) then {If there's FData, see if}
	6014	begin {there's a primary diagnosis}
	6015	for i := 0 to FParent.FData.Count-1 do {if there is return True}
	6016	begin
	6017	EncDt := RemForm.PCEObj.VisitDateTime;
	6018	RData := TRemData(FParent.FData[i]);
	6019	if(RData.DataType = dtDiagnosis) then
	6020	begin
	6021	if(assigned(RData.FPCERoot)) and (RemDataActive(RData, EncDt)) then
	6022	Ok := (RData.FPCERoot = PrimaryDiagRoot)
	6023	else
	6024	if(assigned(RData.FChoices)) and (assigned(RData.FChoicePrompt)) then
	6025	begin
	6026	k := 0;
	6027	for j := 0 to RData.FChoices.Count-1 do
	6028	begin
	6029	if RemDataChoiceActive(RData, j, EncDt) then
	6030	begin
	6031	if(assigned(RData.FChoices.Objects[j])) and
	6032	(copy(RData.FChoicePrompt.FValue,k+1,1)='1') then
	6033	begin
	6034	if(TRemPCERoot(RData.FChoices.Objects[j]) = PrimaryDiagRoot) then
	6035	begin
	6036	Ok := TRUE;
	6037	break;
	6038	end;
	6039	end; //if FChoices.Objects (which is the RemPCERoot object) is assigned
	6040	inc(k);
	6041	end; //if FChoices[j] is active
	6042	end; //loop through FChoices
	6043	end; //If there are FChoices and an FChoicePrompt (i.e.: is this a ptDataList}
	6044	end;
	6045	if Ok then break;
	6046	end;
	6047	end;
	6048	Result := BOOLCHAR[Ok];
	6049	end
	6050	else
	6051	Result := FValue;
	6052	end;
	6053
	6054
	6055
	6056	procedure TRemPrompt.SetValue(Value: string);
	6057	var
	6058	pt: TRemPromptType;
	6059	i, j, k : integer;
	6060	RData: TRemData;
	6061	Primary, Done: boolean;
	6062	Tmp: string;
	6063	OK, NeedRefresh: boolean;
	6064	EncDt: TFMDateTime;
	6065
	6066	begin
	6067	NeedRefresh := (not FFromControl);
	6068	if(Forced and (not FFromParent)) then exit;
	6069	pt := PromptType;
	6070	if(pt = ptVisitDate) then
	6071	begin
	6072	if(Value = '') then
	6073	Value := '0'
	6074	else
	6075	begin
	6076	try
	6077	if(StrToFloat(Value) > FMToday) then
	6078	begin
	6079	Value := '0';
	6080	InfoBox('Can not enter a future date for a historical event.',
	6081	'Invalid Future Date', MB_OK + MB_ICONERROR);
	6082	end;
	6083	except
	6084	on EConvertError do
	6085	Value := '0'
	6086	else
	6087	raise;
	6088	end;
	6089	if(Value = '0') then
	6090	NeedRefresh := TRUE;
	6091	end;
	6092	end;
	6093	if(GetValue <> Value) or (FFromParent) then
	6094	begin
	6095	FValue := Value;
	6096	EncDt := RemForm.PCEObj.VisitDateTime;
	6097	if((pt = ptExamResults) and assigned(FParent) and assigned(FParent.FData) and
	6098	(FParent.FData.Count > 0) and assigned(FParent.FMSTPrompt)) then
	6099	begin
	6100	FParent.FMSTPrompt.SetValueFromParent(Value);
	6101	if (FParent.FMSTPrompt.FMiscText = '') then
	6102	// Assumes first finding item is MST finding
	6103	FParent.FMSTPrompt.FMiscText := TRemData(FParent.FData[0]).InternalValue;
	6104	end;
	6105
	6106	OK := (assigned(FParent) and assigned(FParent.FData) and
	6107	(Piece(FRec4, U, 4) = RemPromptCodes[ptPrimaryDiag]));
	6108	if OK then
	6109	OK := (not FParent.Historical);
	6110	if OK then
	6111	begin
	6112	Done := FALSE;
	6113	Primary := (Value = BOOLCHAR[TRUE]);
	6114	for i := 0 to FParent.FData.Count-1 do
	6115	begin
	6116	RData := TRemData(FParent.FData[i]);
	6117	if(RData.DataType = dtDiagnosis) then
	6118	begin
	6119	if(assigned(RData.FPCERoot)) and (RemDataActive(RData, EncDt)) then
	6120	begin
	6121	if(Primary) then
	6122	begin
	6123	PrimaryDiagRoot := RData.FPCERoot;
	6124	Done := TRUE;
	6125	end
	6126	else
	6127	begin
	6128	if(PrimaryDiagRoot = RData.FPCERoot) then
	6129	begin
	6130	PrimaryDiagRoot := nil;
	6131	Done := TRUE;
	6132	end;
	6133	end;
	6134	end
	6135	else
	6136	if(assigned(RData.FChoices)) and (assigned(RData.FChoicePrompt)) then
	6137	begin
	6138	k := 0;
	6139	for j := 0 to RData.FChoices.Count-1 do
	6140	begin
	6141	if RemDataChoiceActive(RData, j, EncDt) then
	6142	begin
	6143	if(Primary) then
	6144	begin
	6145	if(assigned(RData.FChoices.Objects[j])) and
	6146	(copy(RData.FChoicePrompt.FValue,k+1,1)='1') then
	6147	begin
	6148	PrimaryDiagRoot := TRemPCERoot(RData.FChoices.Objects[j]);
	6149	Done := TRUE;
	6150	break;
	6151	end;
	6152	end
	6153	else
	6154	begin
	6155	if(assigned(RData.FChoices.Objects[j])) and
	6156	(PrimaryDiagRoot = TRemPCERoot(RData.FChoices.Objects[j])) then
	6157	begin
	6158	PrimaryDiagRoot := nil;
	6159	Done := TRUE;
	6160	break;
	6161	end;
	6162	end;
	6163	inc(k);
	6164	end;
	6165	end;
	6166	end;
	6167	end;
	6168	if Done then break;
	6169	end;
	6170	end;
	6171	if(assigned(FParent) and assigned(FParent.FData) and IsSyncPrompt(pt)) then
	6172	begin
	6173	for i := 0 to FParent.FData.Count-1 do
	6174	begin
	6175	RData := TRemData(FParent.FData[i]);
	6176	if(assigned(RData.FPCERoot)) and (RemDataActive(RData, EncDt)) then
	6177	RData.FPCERoot.Sync(Self);
	6178	if(assigned(RData.FChoices)) then
	6179	begin
	6180	for j := 0 to RData.FChoices.Count-1 do
	6181	begin
	6182	if(assigned(RData.FChoices.Objects[j])) and
	6183	RemDataChoiceActive(RData, j, EncDt) then
	6184	TRemPCERoot(RData.FChoices.Objects[j]).Sync(Self);
	6185	end;
	6186	end;
	6187	end;
	6188	end;
	6189	end;
	6190	if(not NeedRefresh) then
	6191	NeedRefresh := (GetValue <> Value);
	6192	if(NeedRefresh and assigned(FCurrentControl) and FParent.FReminder.Visible) then
	6193	begin
	6194	case pt of
	6195	ptComment:
	6196	(FCurrentControl as TEdit).Text := GetValue;
	6197
	6198	ptQuantity:
	6199	(FCurrentControl as TUpDown).Position := StrToIntDef(GetValue,1);
	6200
[460]	6201	(* ptSkinReading:
	6202	(FCurrentControl as TUpDown).Position := StrToIntDef(GetValue,0); *)
[459]	6203
	6204	ptVisitDate:
	6205	begin
	6206	try
	6207	(FCurrentControl as TORDateCombo).FMDate := StrToFloat(GetValue);
	6208	except
	6209	on EConvertError do
	6210	(FCurrentControl as TORDateCombo).FMDate := 0;
	6211	else
	6212	raise;
	6213	end;
	6214	end;
	6215
	6216	ptPrimaryDiag, ptAdd2PL, ptContraindicated:
	6217	(FCurrentControl as TORCheckBox).Checked := (GetValue = BOOLCHAR[TRUE]);
	6218
	6219	ptVisitLocation:
	6220	begin
	6221	Tmp := GetValue;
	6222	with (FCurrentControl as TORComboBox) do
	6223	begin
	6224	if(piece(Tmp,U,1)= '0') then
	6225	begin
	6226	Items[0] := Tmp;
	6227	SelectByID('0');
	6228	end
	6229	else
	6230	SelectByID(Tmp);
	6231	end;
	6232	end;
	6233
	6234	ptWHPapResult:
	6235	(FCurrentControl as TORCheckBox).Checked := (GetValue = BOOLCHAR[TRUE]);
	6236
	6237	ptWHNotPurp:
	6238	(FCurrentControl as TORCheckBox).Checked := (GetValue = BOOLCHAR[TRUE]);
	6239
	6240	ptExamResults, ptSkinResults, ptLevelSeverity,
[460]	6241	ptSeries, ptReaction, ptLevelUnderstanding, ptSkinReading: //(AGP Change 26.1)
[459]	6242	(FCurrentControl as TORComboBox).SelectByID(GetValue);
	6243
	6244	else
	6245	if(pt = ptVitalEntry) then
	6246	begin
	6247	if(FCurrentControl is TORComboBox) then
	6248	(FCurrentControl as TORComboBox).SelectByID(VitalValue)
	6249	else
	6250	if(FCurrentControl is TVitalEdit) then
	6251	begin
	6252	with (FCurrentControl as TVitalEdit) do
	6253	begin
	6254	Text := VitalValue;
	6255	if(assigned(FLinkedCombo)) then
	6256	begin
	6257	Tmp := VitalUnitValue;
	6258	if(Tmp <> '') then
	6259	FLinkedCombo.Text := VitalUnitValue
	6260	else
	6261	FLinkedCombo.ItemIndex := 0;
	6262	end;
	6263	end;
	6264	end;
	6265	end;
	6266	end;
	6267	end;
	6268	end;
	6269
	6270
	6271	procedure TRemPrompt.SetValueFromParent(Value: string);
	6272	begin
	6273	FFromParent := TRUE;
	6274	try
	6275	SetValue(Value);
	6276	finally
	6277	FFromParent := FALSE;
	6278	end;
	6279	end;
	6280
	6281	procedure TRemPrompt.InitValue;
	6282	var
	6283	Value: string;
	6284	pt: TRemPromptType;
	6285	idx, i, j: integer;
	6286	TempSL: TORStringList;
	6287	Found: boolean;
	6288	RData: TRemData;
	6289
	6290	begin
	6291	Value := InternalValue;
	6292	pt := PromptType;
	6293	if(ord(pt) >= ord(low(TRemPromptType))) and (ComboPromptTags[pt] <> 0) then
	6294	begin
	6295	TempSL := TORStringList.Create;
	6296	try
	6297	GetPCECodes(TempSL, ComboPromptTags[pt]);
	6298	idx := TempSL.CaseInsensitiveIndexOfPiece(Value, U, 1);
	6299	if(idx < 0) then
	6300	idx := TempSL.CaseInsensitiveIndexOfPiece(Value, U, 2);
	6301	if(idx >= 0) then
	6302	Value := Piece(TempSL[idx],U,1);
	6303	finally
	6304	TempSL.Free;
	6305	end;
	6306	end;
	6307	if((not Forced) and assigned(FParent) and assigned(FParent.FData) and IsSyncPrompt(pt)) then
	6308	begin
	6309	Found := FALSE;
	6310	for i := 0 to FParent.FData.Count-1 do
	6311	begin
	6312	RData := TRemData(FParent.FData[i]);
	6313	if(assigned(RData.FPCERoot)) then
	6314	Found := RData.FPCERoot.GetValue(pt, Value);
	6315	if(not Found) and (assigned(RData.FChoices)) then
	6316	begin
	6317	for j := 0 to RData.FChoices.Count-1 do
	6318	begin
	6319	if(assigned(RData.FChoices.Objects[j])) then
	6320	begin
	6321	Found := TRemPCERoot(RData.FChoices.Objects[j]).GetValue(pt, Value);
	6322	if(Found) then break;
	6323	end;
	6324	end;
	6325	end;
	6326	if(Found) then break;
	6327	end;
	6328	end;
	6329	FInitializing := TRUE;
	6330	try
	6331	SetValueFromParent(Value);
	6332	finally
	6333	FInitializing := FALSE;
	6334	end;
	6335	end;
	6336
	6337	function TRemPrompt.ForcedCaption: string;
	6338	var
	6339	pt: TRemPromptType;
	6340
	6341	begin
	6342	Result := Caption;
	6343	if(Result = '') then
	6344	begin
	6345	pt := PromptType;
	6346	if(pt = ptDataList) then
	6347	begin
	6348	if(assigned(FData)) then
	6349	begin
	6350	if(FData.DataType = dtDiagnosis) then
	6351	Result := 'Diagnosis'
	6352	else
	6353	if(FData.DataType = dtProcedure) then
	6354	Result := 'Procedure';
	6355	end;
	6356	end
	6357	else
	6358	if(pt = ptVitalEntry) then
	6359	Result := VitalDesc[VitalType] + ':'
	6360	else
	6361	if(pt = ptMHTest) then
	6362	Result := 'Perform ' + FData.Narrative
	6363	else
	6364	if(pt = ptGAF) then
	6365	Result := 'GAF Score'
	6366	else
	6367	Result := PromptDescriptions[pt];
	6368	if(Result = '') then Result := 'Prompt';
	6369	end;
	6370	if(copy(Result,length(Result),1) = ':') then
	6371	delete(Result,length(Result),1);
	6372	end;
	6373
	6374	function TRemPrompt.VitalType: TVitalType;
	6375	begin
	6376	Result := vtUnknown;
	6377	if(assigned(FData)) then
	6378	Result := Code2VitalType(FData.InternalValue);
	6379	end;
	6380
	6381	procedure TRemPrompt.VitalVerify(Sender: TObject);
	6382	var
	6383	vEdt: TVitalEdit;
	6384	vCbo: TVitalComboBox;
	6385	AObj: TWinControl;
	6386
	6387	begin
	6388	if(Sender is TVitalEdit) then
	6389	begin
	6390	vEdt := TVitalEdit(Sender);
	6391	vCbo := vEdt.FLinkedCombo;
	6392	end
	6393	else
	6394	if(Sender is TVitalComboBox) then
	6395	begin
	6396	vCbo := TVitalComboBox(Sender);
	6397	vEdt := vCbo.FLinkedEdit;
	6398	end
	6399	else
	6400	begin
	6401	vCbo := nil;
	6402	vEdt := nil;
	6403	end;
	6404	AObj := Screen.ActiveControl;
	6405	if((not assigned(AObj)) or ((AObj <> vEdt) and (AObj <> vCbo))) then
	6406	begin
	6407	if(vEdt.Tag = TAG_VITHEIGHT) then
	6408	vEdt.Text := ConvertHeight2Inches(vEdt.Text);
	6409	if VitalInvalid(vEdt, vCbo) then
	6410	vEdt.SetFocus;
	6411	end;
	6412	end;
	6413
	6414	function TRemPrompt.VitalUnitValue: string;
	6415	var
	6416	vt: TVitalType;
	6417
	6418	begin
	6419	vt := VitalType;
	6420	if (vt in [vtTemp, vtHeight, vtWeight]) then
	6421	begin
	6422	Result := Piece(GetValue,';',2);
	6423	if(Result = '') then
	6424	begin
	6425	case vt of
	6426	vtTemp: Result := 'F';
	6427	vtHeight: Result := 'IN';
	6428	vtWeight: Result := 'LB';
	6429	end;
	6430	SetPiece(FValue, ';', 2, Result);
	6431	end;
	6432	end
	6433	else
	6434	Result := '';
	6435	end;
	6436
	6437	function TRemPrompt.VitalValue: string;
	6438	begin
	6439	Result := Piece(GetValue,';',1);
	6440	end;
	6441
	6442	procedure TRemPrompt.DoWHReport(Sender: TObject);
	6443	Var
	6444	comp, ien: string;
	6445	i: integer;
	6446	begin
	6447	for i := 0 to FParent.FData.Count-1 do
	6448	begin
	6449	comp:= Piece(TRemData(FParent.FData[i]).FRec3,U,4);
	6450	ien:= Piece(TRemData(FParent.FData[i]).FRec3,U,6);
	6451	end;
	6452	CallV('ORQQPXRM GET WH REPORT TEXT', [ien]);
	6453	ReportBox(RPCBrokerV.Results,'Procedure Report Results',True);
	6454	end;
	6455
	6456	procedure TRemPrompt.ViewWHText(Sender: TObject);
	6457	var
	6458	WHRecNum, WHTitle: string;
	6459	i: integer;
	6460	begin
	6461	for i := 0 to FParent.FData.Count-1 do
	6462	begin
	6463	if Piece(TRemData(FParent.FData[i]).FRec3,U,4)='WH' then
	6464	begin
	6465	WHRecNum:=(Piece(TRemData(FParent.FData[i]).FRec3,U,6));
	6466	WHTitle :=(Piece(TRemData(FParent.FData[i]).FRec3,U,8));
	6467	end;
	6468	end;
	6469	CallV('ORQQPXRM GET WH LETTER TEXT', [WHRecNum]);
	6470	ReportBox(RPCBrokerV.Results,'Women Health Notification Purpose: '+WHTitle,false);
	6471	end;
	6472
	6473	procedure TRemPrompt.DoMHTest(Sender: TObject);
	6474	var
	6475	TmpSL: TStringList;
[460]	6476	i, TestComp: integer;
[459]	6477	Before, After: string;
	6478
	6479	begin
[460]	6480	TestComp := 0;
[459]	6481	if(MHTestAuthorized(FData.Narrative)) then
	6482	begin
	6483	FParent.FReminder.BeginTextChanged;
	6484	try
	6485	if(FParent.IncludeMHTestInPN) then
	6486	TmpSL := TStringList.Create
	6487	else
	6488	TmpSL := nil;
	6489	Before := GetValue;
	6490	After := PerformMHTest(Before, FData.Narrative, TmpSL);
[460]	6491	if uinit.TimedOut then After := '';
	6492	if pos(U,After)>0 then
	6493	begin
	6494	TestComp := StrtoInt(Piece(After,U,2));
	6495	self.FMHTestComplete := TestComp;
	6496	After := Piece(After,U,1);
	6497	end;
	6498	if(Before <> After) and (not uInit.TimedOut) then
[459]	6499	begin
	6500	if(After = '') or (FParent.ResultDlgID = 0) then
	6501	FMiscText := ''
	6502	else
[460]	6503	if TestComp > 0 then
[459]	6504	begin
	6505	MentalHealthTestResults(FMiscText, FParent.ResultDlgID, FData.Narrative,
	6506	FParent.FReminder.FPCEDataObj.Providers.PCEProvider, After);
	6507	if(assigned(TmpSL) and (TmpSL.Count > 0)) then
	6508	begin
	6509	if(FMiscText <> '') then
	6510	FMiscText := FMiscText + CRCode + CRCode;
	6511	for i := 0 to TmpSL.Count-1 do
	6512	begin
	6513	if(i > 0) then
	6514	FMiscText := FMiscText + CRCode + CRCode;
	6515	FMiscText := FMiscText + TmpSL[i];
	6516	end;
	6517	end;
	6518	ExpandTIUObjects(FMiscText);
	6519	end;
	6520	SetValue(After);
	6521	end;
	6522	finally
[460]	6523	if not uInit.TimedOut then
	6524	FParent.FReminder.EndTextChanged(Sender);
[459]	6525	end;
[460]	6526	if not uInit.TimedOut then
	6527	if(FParent.ElemType = etDisplayOnly) and (not assigned(FParent.FParent)) then
	6528	RemindersInProcess.Notifier.Notify;
	6529	end
	6530	else
	6531	InfoBox('Not Authorized to score the ' + FData.Narrative + ' test.',
	6532	'Insufficient Authorization', MB_OK + MB_ICONERROR);
[459]	6533	end;
	6534
	6535	procedure TRemPrompt.GAFHelp(Sender: TObject);
	6536	begin
	6537	inherited;
	6538	GotoWebPage(GAFURL);
	6539	end;
	6540
	6541	function TRemPrompt.EntryID: string;
	6542	begin
	6543	Result := FParent.EntryID + '/' + IntToStr(integer(Self));
	6544	end;
	6545
	6546	procedure TRemPrompt.EditKeyPress(Sender: TObject; var Key: Char);
	6547	begin
	6548	if (Key = '?') and (Sender is TCustomEdit) and
	6549	((TCustomEdit(Sender).Text = '') or (TCustomEdit(Sender).SelStart = 0)) then
	6550	Key := #0;
	6551	end;
	6552
	6553	{ TRemPCERoot }
	6554
	6555	destructor TRemPCERoot.Destroy;
	6556	begin
	6557	KillObj(@FData);
	6558	KillObj(@FForcedPrompts);
	6559	inherited;
	6560	end;
	6561
	6562	procedure TRemPCERoot.Done(Data: TRemData);
	6563	var
	6564	i, idx: integer;
	6565
	6566	begin
	6567	if(assigned(FForcedPrompts) and assigned(Data.FParent) and
	6568	assigned(Data.FParent.FPrompts)) then
	6569	begin
	6570	for i := 0 to Data.FParent.FPrompts.Count-1 do
	6571	UnSync(TRemPrompt(Data.FParent.FPrompts[i]));
	6572	end;
	6573	FData.Remove(Data);
	6574	if(FData.Count <= 0) then
	6575	begin
	6576	idx := PCERootList.IndexOfObject(Self);
	6577	// if(idx < 0) then
	6578	// idx := PCERootList.IndexOf(FID);
	6579	if(idx >= 0) then
	6580	PCERootList.Delete(idx);
	6581	if PrimaryDiagRoot = Self then
	6582	PrimaryDiagRoot := nil;
	6583	Free;
	6584	end;
	6585	end;
	6586
	6587	class function TRemPCERoot.GetRoot(Data: TRemData; Rec3: string;
	6588	Historical: boolean): TRemPCERoot;
	6589	var
	6590	DID: string;
	6591	Idx: integer;
	6592	obj: TRemPCERoot;
	6593
	6594	begin
	6595	if(Data.DataType = dtVitals) then
	6596	DID := 'V' + Piece(Rec3, U, 6)
	6597	else
	6598	begin
	6599	if(Historical) then
	6600	begin
	6601	inc(HistRootCount);
	6602	DID := IntToStr(HistRootCount);
	6603	end
	6604	else
	6605	DID := '0';
	6606	DID := DID + U +
	6607	Piece(Rec3, U, r3Type) + U +
	6608	Piece(Rec3, U, r3Code) + U +
	6609	Piece(Rec3, U, r3Cat) + U +
	6610	Piece(Rec3, U, r3Nar);
	6611	end;
	6612	idx := -1;
	6613	if(not assigned(PCERootList)) then
	6614	PCERootList := TStringList.Create
	6615	else
	6616	if(PCERootList.Count > 0) then
	6617	idx := PCERootList.IndexOf(DID);
	6618	if(idx < 0) then
	6619	begin
	6620	obj := TRemPCERoot.Create;
	6621	try
	6622	obj.FData := TList.Create;
	6623	obj.FID := DID;
	6624	idx := PCERootList.AddObject(DID, obj);
	6625	except
	6626	obj.Free;
	6627	raise;
	6628	end;
	6629	end;
	6630	Result := TRemPCERoot(PCERootList.Objects[idx]);
	6631	Result.FData.Add(Data);
	6632	end;
	6633
	6634	function TRemPCERoot.GetValue(PromptType: TRemPromptType; var NewValue: string): boolean;
	6635	var
	6636	ptS: string;
	6637	i: integer;
	6638
	6639	begin
	6640	ptS := char(ord('D') + ord(PromptType));
	6641	i := pos(ptS, FValueSet);
	6642	if(i = 0) then
	6643	Result := FALSE
	6644	else
	6645	begin
	6646	NewValue := Piece(FValue, U, i);
	6647	Result := TRUE;
	6648	end;
	6649	end;
	6650
	6651	procedure TRemPCERoot.Sync(Prompt: TRemPrompt);
	6652	var
	6653	i, j: integer;
	6654	RData: TRemData;
	6655	Prm: TRemPrompt;
	6656	pt: TRemPromptType;
	6657	ptS, Value: string;
	6658
	6659	begin
	6660	// if(assigned(Prompt.FParent) and ((not Prompt.FParent.FChecked) or
	6661	// (Prompt.FParent.ElemType = etDisplayOnly))) then exit;
	6662	if(assigned(Prompt.FParent) and (not Prompt.FParent.FChecked)) then exit;
	6663	pt := Prompt.PromptType;
	6664	Value := Prompt.GetValue;
	6665	if(Prompt.Forced) then
	6666	begin
	6667	if(not Prompt.FInitializing) then
	6668	begin
	6669	if(not assigned(FForcedPrompts)) then
	6670	FForcedPrompts := TStringList.Create;
	6671	if(FForcedPrompts.IndexOfObject(Prompt) < 0) then
	6672	begin
	6673	for i := 0 to FForcedPrompts.Count-1 do
	6674	begin
	6675	Prm := TRemPrompt(FForcedPrompts.Objects[i]);
	6676	if(pt = Prm.PromptType) and (FForcedPrompts[i] <> Value) and (Prm.FParent.IsChecked) then
	6677	raise EForcedPromptConflict.Create('Forced Value Error:' + CRLF + CRLF +
	6678	Prompt.ForcedCaption + ' is already being forced to another value.');
	6679	end;
	6680	FForcedPrompts.AddObject(Value, Prompt);
	6681	end;
	6682	end;
	6683	end
	6684	else
	6685	begin
	6686	if(assigned(FForcedPrompts)) then
	6687	begin
	6688	for i := 0 to FForcedPrompts.Count-1 do
	6689	begin
	6690	Prm := TRemPrompt(FForcedPrompts.Objects[i]);
	6691	if(pt = Prm.PromptType) and (FForcedPrompts[i] <> Value) and (Prm.FParent.IsChecked) then
	6692	begin
	6693	Prompt.SetValue(FForcedPrompts[i]);
	6694	if(assigned(Prompt.FParent)) then
	6695	Prompt.FParent.cbClicked(nil); // Forces redraw
	6696	exit;
	6697	end;
	6698	end;
	6699	end;
	6700	end;
	6701	if(Prompt.FInitializing) then exit;
	6702	for i := 0 to FData.Count-1 do
	6703	inc(TRemData(FData[i]).FSyncCount);
	6704	ptS := char(ord('D') + ord(pt));
	6705	i := pos(ptS, FValueSet);
	6706	if(i = 0) then
	6707	begin
	6708	FValueSet := FValueSet + ptS;
	6709	i := length(FValueSet);
	6710	end;
	6711	SetPiece(FValue, U, i, Value);
	6712	for i := 0 to FData.Count-1 do
	6713	begin
	6714	RData := TRemData(FData[i]);
	6715	if(RData.FSyncCount = 1) and (assigned(RData.FParent)) and
	6716	(assigned(RData.FParent.FPrompts)) then
	6717	begin
	6718	for j := 0 to RData.FParent.FPrompts.Count-1 do
	6719	begin
	6720	Prm := TRemPrompt(RData.FParent.FPrompts[j]);
	6721	if(Prm <> Prompt) and (pt = Prm.PromptType) and (not Prm.Forced) then
	6722	Prm.SetValue(Prompt.GetValue);
	6723	end;
	6724	end;
	6725	end;
	6726	for i := 0 to FData.Count-1 do
	6727	begin
	6728	RData := TRemData(FData[i]);
	6729	if(RData.FSyncCount > 0) then
	6730	dec(RData.FSyncCount);
	6731	end;
	6732	end;
	6733
	6734	procedure TRemPCERoot.UnSync(Prompt: TRemPrompt);
	6735	var
	6736	idx: integer;
	6737
	6738	begin
	6739	if(assigned(FForcedPrompts) and Prompt.Forced) then
	6740	begin
	6741	idx := FForcedPrompts.IndexOfObject(Prompt);
	6742	if(idx >= 0) then
	6743	FForcedPrompts.Delete(Idx);
	6744	end;
	6745	end;
	6746
	6747	initialization
	6748	InitReminderObjects;
	6749
	6750	finalization
	6751	FreeReminderObjects;
	6752
	6753	end.

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: cprs/branches/foia-cprs/CPRS-Chart/uReminders.pas@ 1115

Download in other formats: