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

Last change on this file since 1240 was 654, checked in by Kevin Toppenberg, 15 years ago

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