Context Navigation

uReminders.pas@ 1035

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

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

Context Navigation

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

Download in other formats: