Context Navigation

uReminders.pas@ 1727

Last change on this file since 1727 was 1692, checked in by healthsevak, 10 years ago
Committing the files for first time to this new branch
File size: 222.8 KB

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

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

Context Navigation

source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/uReminders.pas@ 1727

Download in other formats: