Context Navigation

uReminders.pas@ 1035

Last change on this file since 1035 was 654, checked in by Kevin Toppenberg, 15 years ago
Added HTML templating
File size: 230.7 KB

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

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

Context Navigation

source: cprs/branches/tmg-cprs/CPRS-Chart/uReminders.pas@ 1035

Download in other formats: