Context Navigation

source: cprs/trunk/CPRS-Chart/uReminders.pas@ 1008

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

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

Download in other formats: