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

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

TMG Ver 1.1 Added HTML Support, better demographics editing
File size: 230.4 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
4582begin
4583 if (not (FReminder is TReminder)) then
4584 ScootOver := 4;
4585 try
4586 if Add2PN then
4587 begin
4588 ilvl := IndentPNLevel;
4589 if(FPNText <> '') then
4590 txt := FPNText
4591 else
4592 begin
4593 txt := FText;
4594 if not FReminder.FNoResolve then
4595 //If this is the CurrentReminderInDialog then we get the template field
4596 //values from the visual control in the dialog window.
4597 if FReminder = CurrentReminderInDialog then
4598 txt := ResolveTemplateFields(txt, TRUE)
4599 else
4600 //If this is not the CurrentReminderInDialog (i.e.: Next or Back button
4601 //has been pressed), then we have to get the template field values
4602 //that were saved in the element.
4603 begin
4604 FldData := TORStringList.Create;
4605 GetFieldValues(FldData);
4606 txt := GetTemplateFieldValues(txt, FldData);
4607 end;
4608 end;
4609 if FReminder.FNoResolve then
4610 Lst.Add(txt)
4611 else
4612 WordWrap(txt, Lst, ilvl);
4613 dec(ilvl,2);
4614 if(assigned(FPrompts)) then
4615 begin
4616 for i := 0 to FPrompts.Count-1 do
4617 begin
4618 Prompt := TRemPrompt(FPrompts[i]);
4619 if(not Prompt.FIsShared) then
4620 WordWrap(Prompt.NoteText, Lst, ilvl);
4621 end;
4622 end;
4623 if(assigned(FParent) and FParent.FHasSharedPrompts) then
4624 begin
4625 for i := 0 to FParent.FPrompts.Count-1 do
4626 begin
4627 Prompt := TRemPrompt(FParent.FPrompts[i]);
4628 if(Prompt.FIsShared) and (Prompt.FSharedChildren.IndexOf(Self) >= 0) then
4629 WordWrap(Prompt.NoteText, Lst, ilvl);
4630 end;
4631 end;
4632 end;
4633 if (assigned(FChildren)) and (FChecked or (ElemType = etDisplayOnly)) then
4634 begin
4635 for i := 0 to FChildren.Count-1 do
4636 TRemDlgElement(FChildren[i]).AddText(Lst);
4637 end;
4638 finally
4639 if (not (FReminder is TReminder)) then
4640 ScootOver := 0;
4641 end;
4642end;
4643
4644function TRemDlgElement.AddData(Lst: TStrings; Finishing: boolean;
4645 AHistorical: boolean = FALSE): integer;
4646var
4647 i, j: integer;
4648 OK: boolean;
4649 ActDt, InActDt, EncDt: double;
4650 RData: TRemData;
4651
4652begin
4653 Result := 0;
4654// OK := ((ElemType <> etDisplayOnly) and FChecked);
4655 OK := FChecked;
4656 if(OK and Finishing) then
4657 OK := (Historical = AHistorical);
4658 if OK then
4659 begin
4660 if(assigned(FData)) then
4661 begin
4662 if Self.Historical then
4663 EncDt := DateTimeToFMDateTime(Date)
4664 else
4665 EncDt := RemForm.PCEObj.VisitDateTime;
4666 for i := 0 to FData.Count-1 do
4667 begin
4668 RData := TRemData(FData[i]);
4669 if assigned(RData.FActiveDates) then
4670 for j := 0 to (TRemData(FData[i]).FActiveDates.Count - 1) do
4671 begin
4672 ActDt := StrToIntDef(Piece(TRemData(FData[i]).FActiveDates[j],':',1), 0);
4673 InActDt := StrToIntDef(Piece(TRemData(FData[i]).FActiveDates[j], ':', 2), 9999999);
4674 if (EncDt >= ActDt) and (EncDt <= InActDt) then
4675 begin
4676 inc(Result, TRemData(FData[i]).AddData(Lst, Finishing));
4677 Break;
4678 end;
4679 end
4680 else
4681 inc(Result, TRemData(FData[i]).AddData(Lst, Finishing));
4682 end;
4683 end;
4684 end;
4685 if (assigned(FChildren)) and (FChecked or (ElemType = etDisplayOnly)) then
4686 begin
4687 for i := 0 to FChildren.Count-1 do
4688 inc(Result, TRemDlgElement(FChildren[i]).AddData(Lst, Finishing, AHistorical));
4689 end;
4690end;
4691
4692procedure TRemDlgElement.Check4ChildrenSharedPrompts;
4693var
4694 i, j: integer;
4695 Kid: TRemDlgElement;
4696 PList, EList: TList;
4697 FirstMatch: boolean;
4698 Prompt: TRemPrompt;
4699
4700begin
4701 if(not FChildrenShareChecked) then
4702 begin
4703 FChildrenShareChecked := TRUE;
4704 if(ChildrenSharePrompts and assigned(FChildren)) then
4705 begin
4706 for i := 0 to FChildren.Count-1 do
4707 TRemDlgElement(FChildren[i]).GetData;
4708 PList := TList.Create;
4709 try
4710 EList := TList.Create;
4711 try
4712 for i := 0 to FChildren.Count-1 do
4713 begin
4714 Kid := TRemDlgElement(FChildren[i]);
4715// if(Kid.ElemType <> etDisplayOnly) and (assigned(Kid.FPrompts)) then
4716 if(assigned(Kid.FPrompts)) then
4717 begin
4718 for j:= 0 to Kid.FPrompts.Count-1 do
4719 begin
4720 PList.Add(Kid.FPrompts[j]);
4721 EList.Add(Kid);
4722 end;
4723 end;
4724 end;
4725 if(PList.Count > 1) then
4726 begin
4727 for i := 0 to PList.Count-2 do
4728 begin
4729 if(assigned(EList[i])) then
4730 begin
4731 FirstMatch := TRUE;
4732 Prompt := TRemPrompt(PList[i]);
4733 for j := i+1 to PList.Count-1 do
4734 begin
4735 if(assigned(EList[j]) and
4736 (Prompt.CanShare(TRemPrompt(PList[j])))) then
4737 begin
4738 if(FirstMatch) then
4739 begin
4740 FirstMatch := FALSE;
4741 if(not assigned(FPrompts)) then
4742 FPrompts := TList.Create;
4743 FHasSharedPrompts := TRUE;
4744 Prompt.FIsShared := TRUE;
4745 if(not assigned(Prompt.FSharedChildren)) then
4746 Prompt.FSharedChildren := TList.Create;
4747 Prompt.FSharedChildren.Add(EList[i]);
4748 FPrompts.Add(PList[i]);
4749 TRemDlgElement(EList[i]).FPrompts.Remove(PList[i]);
4750 EList[i] := nil;
4751 end;
4752 Prompt.FSharedChildren.Add(EList[j]);
4753 Kid := TRemDlgElement(EList[j]);
4754 Kid.FPrompts.Remove(PList[j]);
4755 if(Kid.FHasComment) and (Kid.FCommentPrompt = PList[j]) then
4756 begin
4757 Kid.FHasComment := FALSE;
4758 Kid.FCommentPrompt := nil;
4759 end;
4760 TRemPrompt(PList[j]).Free;
4761 EList[j] := nil;
4762 end;
4763 end;
4764 end;
4765 end;
4766 end;
4767 finally
4768 EList.Free;
4769 end;
4770 finally
4771 PList.Free;
4772 end;
4773 for i := 0 to FChildren.Count-1 do
4774 begin
4775 Kid := TRemDlgElement(FChildren[i]);
4776 if(assigned(Kid.FPrompts) and (Kid.FPrompts.Count = 0)) then
4777 begin
4778 Kid.FPrompts.Free;
4779 Kid.FPrompts := nil;
4780 end;
4781 end;
4782 end;
4783 end;
4784end;
4785
4786procedure TRemDlgElement.FinishProblems(List: TStrings);
4787var
4788 i,cnt: integer;
4789 cReq: TRDChildReq;
4790 Kid: TRemDlgElement;
4791 Prompt: TRemPrompt;
4792 txt, msg, Value: string;
4793 pt: TRemPromptType;
4794
4795begin
4796// if(ElemType <> etDisplayOnly) and (FChecked) and (assigned(FPrompts)) then
4797 if(FChecked and (assigned(FPrompts))) then
4798 begin
4799 for i := 0 to FPrompts.Count-1 do
4800 begin
4801 Prompt := TRemPrompt(FPrompts[i]);
4802 Value := Prompt.GetValue;
4803 pt := Prompt.PromptType;
4804 if(Prompt.PromptOK and (not Prompt.Forced) and Prompt.Required and
4805 (((pt<>ptWHNotPurp)and(pt<>ptWHPapResult))and
4806 ((Value = '') or (Value = '@')) or
4807 ((pt = ptVisitDate) and Prompt.FMonthReq and (StrToIntDef(copy(Value,4,2),0) = 0)) or
4808 ((pt in [ptVisitDate, ptVisitLocation]) and (Value = '0')))) then
4809 begin
4810// WordWrap('Element: ' + FText, List, 68, 6); <-- original line. //kt 9/5/2007
4811 WordWrap(DKLangConstW('uReminders_Elementx') + FText, List, 68, 6); //kt added 9/5/2007
4812 txt := Prompt.ForcedCaption;
4813 if(pt = ptVisitDate) and Prompt.FMonthReq then
4814// txt := txt + ' (Month Required)'; <-- original line. //kt 9/5/2007
4815 txt := txt + DKLangConstW('uReminders_xMonth_Requiredx'); //kt added 9/5/2007
4816// WordWrap('Item: ' + txt, List, 65, 6); <-- original line. //kt 9/5/2007
4817 WordWrap(DKLangConstW('uReminders_Itemx') + txt, List, 65, 6); //kt added 9/5/2007
4818 end;
4819 if (Prompt.PromptOK and (not Prompt.Forced) and Prompt.Required and
4820 ((WHResultChk='') and (Value='')) and ((pt=ptWHPapResult) and (FData<>nil))) then
4821 begin
4822// WordWrap('Prompt: ' + Prompt.ForcedCaption, List, 65,6); <-- original line. //kt 9/5/2007
4823 WordWrap(DKLangConstW('uReminders_Promptx') + Prompt.ForcedCaption, List, 65,6); //kt added 9/5/2007
4824 end;
4825 if (Prompt.PromptOK and (not Prompt.Forced) and Prompt.Required
4826 and (pt=ptWHNotPurp)) and ((WHResultNot = '') and (Value = '')) then
4827 begin
4828// WordWrap('Element: ' + FText, List, 68, 6); <-- original line. //kt 9/5/2007
4829 WordWrap(DKLangConstW('uReminders_Elementx') + FText, List, 68, 6); //kt added 9/5/2007
4830// WordWrap('Prompt: ' + Prompt.ForcedCaption, List, 65,6); <-- original line. //kt 9/5/2007
4831 WordWrap(DKLangConstW('uReminders_Promptx') + Prompt.ForcedCaption, List, 65,6); //kt added 9/5/2007
4832 end;
4833 //(AGP Change 24.9 add check to see if MH tests are required)
4834 if ((Pt = ptMHTest) or (Pt = ptGAF)) and (Piece(Prompt.FData.FRec3,U,13) = '1') and
4835 (not Prompt.Forced) then
4836 begin
4837 if (Pt = ptMHTest) and (Prompt.FMHTestComplete = 2) then
4838 begin
4839 if ((Prompt.FValue = '') or (pos('X',Prompt.FValue)>0)) then
4840 begin
4841 if Prompt.FValue = '' then
4842// WordWrap('MH test '+ Piece(Prompt.FData.FRec3,U,8) + ' not done',List,65,6); <-- original line. //kt 9/5/2007
4843 WordWrap(DKLangConstW('uReminders_MH_test')+' '+ Piece(Prompt.FData.FRec3,U,8) + DKLangConstW('uReminders_not_done'),List,65,6); //kt added 9/5/2007
4844 if pos('X',Prompt.FValue)>0 then
4845// WordWrap('You are missing one or more responses in the MH test '+ <-- original line. //kt 9/5/2007
4846 WordWrap(DKLangConstW('uReminders_You_are_missing_one_or_more_responses_in_the_MH_test')+ //kt added 9/5/2007
4847 Piece(Prompt.FData.FRec3,U,8),List,65,6);
4848 WordWrap(' ',List,65,6);
4849 end;
4850 end;
4851 if (Pt = ptMHTest) and (Prompt.FMHTestComplete = 0) or (Prompt.FValue = '') then
4852 begin
4853 if Prompt.FValue = '' then
4854// WordWrap('MH test '+ Piece(Prompt.FData.FRec3,U,8) + ' not done',List,65,6); <-- original line. //kt 9/5/2007
4855 WordWrap(DKLangConstW('uReminders_MH_test')+ Piece(Prompt.FData.FRec3,U,8) + DKLangConstW('uReminders_not_done'),List,65,6); //kt added 9/5/2007
4856 if pos('X',Prompt.FValue)>0 then
4857// WordWrap('You are missing one or more responses in the MH test '+ <-- original line. //kt 9/5/2007
4858 WordWrap(DKLangConstW('uReminders_You_are_missing_one_or_more_responses_in_the_MH_test')+ //kt added 9/5/2007
4859 Piece(Prompt.FData.FRec3,U,8),List,65,6);
4860 WordWrap(' ',List,65,6);
4861 end;
4862 if (Pt = ptGAF) and ((Prompt.FValue = '0') or (Prompt.FValue = '')) then
4863 begin
4864// WordWrap('GAF test must have a score greater then zero',List,65,6); <-- original line. //kt 9/5/2007
4865 WordWrap(DKLangConstW('uReminders_GAF_test_must_have_a_score_greater_then_zero'),List,65,6); //kt added 9/5/2007
4866 WordWrap(' ',List,65,6);
4867 end;
4868 end;
4869 end;
4870 end;
4871 if (assigned(FChildren)) and (FChecked or (ElemType = etDisplayOnly)) then
4872 begin
4873 cReq := ChildrenRequired;
4874 if(cReq in [crOne, crAtLeastOne]) then
4875 begin
4876 cnt := 0;
4877 for i := 0 to FChildren.Count-1 do
4878 begin
4879 Kid := TRemDlgElement(FChildren[i]);
4880// if(Kid.FChecked and (Kid.ElemType <> etDisplayOnly)) then
4881 if(Kid.FChecked) then
4882 inc(cnt);
4883 end;
4884 if(cReq = crOne) and (cnt <> 1) then
4885// msg := 'One selection required' <-- original line. //kt 9/5/2007
4886 msg := DKLangConstW('uReminders_One_selection_required') //kt added 9/5/2007
4887 else
4888 if(cReq = crAtLeastOne) and (cnt < 1) then
4889// msg := 'One or more selections required' <-- original line. //kt 9/5/2007
4890 msg := DKLangConstW('uReminders_One_or_more_selections_required') //kt added 9/5/2007
4891 else
4892 msg := '';
4893 if(msg <> '') then
4894 begin
4895 txt := BoxCaption;
4896 if(txt = '') then
4897 txt := FText;
4898// WordWrap('Group: ' + txt, List, 68, 6); <-- original line. //kt 9/5/2007
4899 WordWrap(DKLangConstW('uReminders_Groupx') + txt, List, 68, 6); //kt added 9/5/2007
4900 WordWrap(Msg, List, 65, 0);
4901 WordWrap(' ',List,68,6); // (AGP change 24.9 added blank line for display spacing)
4902 end;
4903 end;
4904 for i := 0 to FChildren.Count-1 do
4905 TRemDlgElement(FChildren[i]).FinishProblems(List);
4906 end;
4907end;
4908
4909function TRemDlgElement.IsChecked: boolean;
4910var
4911 Prnt: TRemDlgElement;
4912
4913begin
4914 Result := TRUE;
4915 Prnt := Self;
4916 while Result and assigned(Prnt) do
4917 begin
4918 Result := ((Prnt.ElemType = etDisplayOnly) or Prnt.FChecked);
4919 Prnt := Prnt.FParent;
4920 end;
4921end;
4922
4923function TRemDlgElement.IndentChildrenInPN: boolean;
4924begin
4925 //if(Box) then
4926 Result := (Piece(FRec1, U, 21) = '1');
4927 //else
4928 // Result := FALSE;
4929end;
4930
4931function TRemDlgElement.IndentPNLevel: integer;
4932begin
4933 if(assigned(FParent)) then
4934 begin
4935 Result := FParent.IndentPNLevel;
4936 if(FParent.IndentChildrenInPN) then
4937 dec(Result,2);
4938 end
4939 else
4940 Result := 70;
4941end;
4942
4943function TRemDlgElement.IncludeMHTestInPN: boolean;
4944begin
4945 Result := (Piece(FRec1, U, 9) = '0');
4946end;
4947
4948function TRemDlgElement.ResultDlgID: integer;
4949begin
4950 Result := StrToIntDef(Piece(FRec1, U, 10), 0);
4951end;
4952
4953procedure TRemDlgElement.SubCommentChange(Sender: TObject);
4954var
4955 i: integer;
4956 txt: string;
4957 ok: boolean;
4958
4959begin
4960 if(FHasSubComments and FHasComment and assigned(FCommentPrompt)) then
4961 begin
4962 ok := FALSE;
4963 if(assigned(Sender)) then
4964 begin
4965 with (Sender as TORCheckBox) do
4966 TRemPrompt(Tag).FValue := BOOLCHAR[Checked];
4967 ok := TRUE;
4968 end;
4969 if(not ok) then
4970 ok := (FCommentPrompt.GetValue = '');
4971 if(ok) then
4972 begin
4973 txt := '';
4974 for i := 0 to FPrompts.Count-1 do
4975 begin
4976 with TRemPrompt(FPrompts[i]) do
4977 begin
4978 if(PromptType = ptSubComment) and (FValue = BOOLCHAR[TRUE]) then
4979 begin
4980 if(txt <> '') then
4981 txt := txt + ', ';
4982 txt := txt + Caption;
4983 end;
4984 end;
4985 end;
4986 if(txt <> '') then
4987 txt[1] := UpCase(txt[1]);
4988 FCommentPrompt.SetValue(txt);
4989 end;
4990 end;
4991end;
4992
4993constructor TRemDlgElement.Create;
4994begin
4995 FFieldValues := TORStringList.Create;
4996end;
4997
4998function TRemDlgElement.EntryID: string;
4999begin
5000 Result := REMEntryCode + FReminder.GetIEN + '/' + IntToStr(integer(Self));
5001end;
5002
5003procedure TRemDlgElement.FieldPanelChange(Sender: TObject);
5004var
5005 idx: integer;
5006 Entry: TTemplateDialogEntry;
5007 fval: string;
5008
5009begin
5010 FReminder.BeginTextChanged;
5011 try
5012 Entry := TTemplateDialogEntry(Sender);
5013 idx := FFieldValues.IndexOfPiece(Entry.InternalID);
5014 fval := Entry.InternalID + U + Entry.FieldValues;
5015 if(idx < 0) then
5016 FFieldValues.Add(fval)
5017 else
5018 FFieldValues[idx] := fval;
5019 finally
5020 FReminder.EndTextChanged(Sender);
5021 end;
5022end;
5023
5024procedure TRemDlgElement.GetFieldValues(FldData: TStrings);
5025var
5026 i, p: integer;
5027 TmpSL: TStringList;
5028
5029begin
5030 TmpSL := TStringList.Create;
5031 try
5032 for i := 0 to FFieldValues.Count-1 do
5033 begin
5034 p := pos(U, FFieldValues[i]); // Can't use Piece because 2nd piece may contain ^ characters
5035 if(p > 0) then
5036 begin
5037 TmpSL.CommaText := copy(FFieldValues[i],p+1,MaxInt);
5038 FldData.AddStrings(TmpSL);
5039 TmpSL.Clear;
5040 end;
5041 end;
5042 finally
5043 TmpSL.Free;
5044 end;
5045 if (assigned(FChildren)) and (FChecked or (ElemType = etDisplayOnly)) then
5046 for i := 0 to FChildren.Count-1 do
5047 TRemDlgElement(FChildren[i]).GetFieldValues(FldData);
5048end;
5049
5050{cause the paint event to be called and draw a focus rectangle on the TFieldPanel}
5051procedure TRemDlgElement.FieldPanelEntered(Sender: TObject);
5052begin
5053 with TFieldPanel(Sender) do
5054 begin
5055 Focus := TRUE;
5056 Invalidate;
5057 if Parent is TFieldPanel then
5058 begin
5059 TFieldPanel(Parent).Focus := FALSE;
5060 TFieldPanel(Parent).Invalidate;
5061 end;
5062 end;
5063end;
5064{cause the paint event to be called and draw the TFieldPanel without the focus rect.}
5065procedure TRemDlgElement.FieldPanelExited(Sender: TObject);
5066begin
5067 with TFieldPanel(Sender) do
5068 begin
5069 Focus := FALSE;
5070 Invalidate;
5071 if Parent is TFieldPanel then
5072 begin
5073 TFieldPanel(Parent).Focus := TRUE;
5074 TFieldPanel(Parent).Invalidate;
5075 end;
5076 end;
5077end;
5078
5079{Check the associated checkbox when spacebar is pressed}
5080procedure TRemDlgElement.FieldPanelKeyPress(Sender: TObject; var Key: Char);
5081begin
5082 if Key = ' ' then
5083 begin
5084 FieldPanelOnClick(Sender);
5085 Key := #0;
5086 end;
5087end;
5088
5089{So the FieldPanel will check the associated checkbox}
5090procedure TRemDlgElement.FieldPanelOnClick(Sender: TObject);
5091begin
5092// if TFieldPanel(Sender).Focus then
5093 TORCheckBox(TFieldPanel(Sender).Tag).Checked := not FChecked;
5094end;
5095
5096{call the FieldPanelOnClick so labels on the panels will also click the checkbox}
5097procedure TRemDlgElement.FieldPanelLabelOnClick(Sender: TObject);
5098begin
5099 FieldPanelOnClick(TLabel(Sender).Parent); {use the parent/fieldpanel as the Sender}
5100end;
5101
5102{ TRemData }
5103
5104function TRemData.Add2PN: boolean;
5105begin
5106 Result := (Piece(FRec3, U, 5) <> '1');
5107end;
5108
5109function TRemData.AddData(List: TStrings; Finishing: boolean): integer;
5110var
5111 i, j, k: integer;
5112 PCECat: TPCEDataCat;
5113 Primary: boolean;
5114 ActDt, InActDt: Double;
5115 EncDt: TFMDateTime;
5116
5117 procedure AddPrompt(Prompt: TRemPrompt; dt: TRemDataType; var x: string);
5118 var
5119 pt: TRemPromptType;
5120 pnum: integer;
5121 Pdt: TRemDataType;
5122 v: TVitalType;
5123 rte, unt, txt: string;
5124 UIEN: Int64;
5125
5126 begin
5127 pnum := -1;
5128 pt := Prompt.PromptType;
5129 if(pt = ptSubComment) or (pt = ptUnknown) then exit;
5130 if(pt = ptMST) then
5131 begin
5132 if (PCECat in MSTDataTypes) then
5133 begin
5134 UIEN := FParent.FReminder.PCEDataObj.Providers.PCEProvider;
5135 if UIEN <= 0 then
5136 UIEN := User.DUZ;
5137 SetPiece(x, U, pnumMST, Prompt.GetValue + ';' + // MST Code
5138 FloatToStr(RemForm.PCEObj.VisitDateTime) + ';' +
5139 IntToStr(UIEN) + ';' + //
5140 Prompt.FMiscText); // IEN of Exam, if any
5141 end;
5142 end
5143 else
5144 if(PCECat = pdcVital) then
5145 begin
5146 if(pt = ptVitalEntry) then
5147 begin
5148 rte := Prompt.VitalValue;
5149 if(rte <> '') then
5150 begin
5151 v := Prompt.VitalType;
5152 unt := Prompt.VitalUnitValue;
5153 ConvertVital(v, rte, unt);
5154 //txt := U + VitalCodes[v] + U + rte + U + FloatToStr(RemForm.PCEObj.VisitDateTime); AGP Change 26.1 commented out
5155 txt := U + VitalCodes[v] + U + rte + U + '0'; //AGP Change 26.1 Use for Vital date/time
5156 if(not Finishing) then
5157 txt := Char(ord('A')+ord(v)) + FormatVitalForNote(txt); // Add vital sort char
5158 List.AddObject(Char(ord('A')+ord(PCECat)) + txt, Self);
5159 end;
5160 end
5161 else
5162 exit;
5163 end
5164 else
5165 if(PCECat = pdcMH) then
5166 begin
5167 if(pt = ptMHTest) or (pt = ptGAF) then
5168 x := x + U + Prompt.GetValue
5169 else
5170 exit;
5171 end
5172 else
5173 if(pt <> ptDataList) and (ord(pt) >= ord(low(TRemPromptType))) then
5174 begin
5175 Pdt := RemPromptTypes[pt];
5176 if (Pdt = dt) or (Pdt = dtAll) or
5177 ((Pdt = dtHistorical) and assigned(Prompt.FParent) and
5178 Prompt.FParent.Historical) then
5179 pnum := FinishPromptPieceNum[pt];
5180 if(pnum > 0) then
5181 begin
5182 if(pt = ptPrimaryDiag) then
5183 SetPiece(x, U, pnum, BoolChar[Primary])
5184 else
5185 SetPiece(x, U, pnum, Prompt.GetValue);
5186 end;
5187 end;
5188 end;
5189
5190 procedure Add(Str: string; Root: TRemPCERoot);
5191 var
5192 i, Qty: integer;
5193 Value, IsGAF, txt, x, Code, Nar, Cat: string;
5194 Skip: boolean;
5195 Prompt: TRemPrompt;
5196 dt: TRemDataType;
5197 TestDate: TFMDateTime;
5198 i1,i2: integer;
5199
5200 begin
5201 x := '';
5202 dt := Code2DataType(Piece(Str, U, r3Type));
5203 PCECat := RemData2PCECat[dt];
5204 Code := Piece(Str, U, r3Code);
5205 if(Code = '') then
5206 Code := Piece(Str, U, r3Code2);
5207 Nar := Piece(Str, U, r3Nar);
5208 Cat := Piece(Str, U, r3Cat);
5209
5210 Primary := FALSE;
5211 if(assigned(FParent) and assigned(FParent.FPrompts) and (PCECat = pdcDiag)) then
5212 begin
5213 if(FParent.Historical) then
5214 begin
5215 for i := 0 to FParent.FPrompts.Count-1 do
5216 begin
5217 Prompt := TRemPrompt(FParent.FPrompts[i]);
5218 if(Prompt.PromptType = ptPrimaryDiag) then
5219 begin
5220 Primary := (Prompt.GetValue = BOOLCHAR[TRUE]);
5221 break;
5222 end;
5223 end;
5224 end
5225 else
5226 Primary := (Root = PrimaryDiagRoot);
5227 end;
5228
5229 Skip := FALSE;
5230 if (PCECat = pdcMH) then
5231 begin
5232 IsGAF := Piece(FRec3, U, r3GAF);
5233 Value := FChoicePrompt.GetValue;
5234 if(Value = '') or ((IsGAF = '1') and (Value = '0')) then
5235 Skip := TRUE;
5236 end;
5237
5238 if Finishing or (PCECat = pdcVital) then
5239 begin
5240 if(dt = dtOrder) then
5241 x := U + Piece(Str,U,6) + U + Piece(Str,U,11) + U + Nar
5242 else
5243 begin
5244 if (PCECat = pdcMH) then
5245 begin
5246 if(Skip) then
5247 x := ''
5248 else
5249 begin
5250 TestDate := Trunc(FParent.FReminder.PCEDataObj.VisitDateTime);
5251 if(IsGAF = '1') then
5252 ValidateGAFDate(TestDate);
5253 x := U + Nar + U + IsGAF + U + FloatToStr(TestDate) + U +
5254 IntToSTr(FParent.FReminder.PCEDataObj.Providers.PCEProvider);
5255 end;
5256 end
5257 else
5258 if (PCECat <> pdcVital) then
5259 begin
5260 x := Piece(Str, U, 6);
5261 SetPiece(x, U, pnumCode, Code);
5262 SetPiece(x, U, pnumCategory, Cat);
5263 SetPiece(x, U, pnumNarrative, Nar);
5264 end;
5265 if(assigned(FParent)) then
5266 begin
5267 if(assigned(FParent.FPrompts)) then
5268 begin
5269 for i := 0 to FParent.FPrompts.Count-1 do
5270 begin
5271 Prompt := TRemPrompt(FParent.FPrompts[i]);
5272 if(not Prompt.FIsShared) then
5273 AddPrompt(Prompt, dt, x);
5274 end;
5275 end;
5276 if(assigned(FParent.FParent) and FParent.FParent.FHasSharedPrompts) then
5277 begin
5278 for i := 0 to FParent.FParent.FPrompts.Count-1 do
5279 begin
5280 Prompt := TRemPrompt(FParent.FParent.FPrompts[i]);
5281 if(Prompt.FIsShared) and (Prompt.FSharedChildren.IndexOf(FParent) >= 0) then
5282 AddPrompt(Prompt, dt, x);
5283 end;
5284 end;
5285 end;
5286 end;
5287 if(x <> '') then
5288 List.AddObject(Char(ord('A')+ord(PCECat)) + x, Self);
5289 end
5290 else
5291 begin
5292 Qty := 1;
5293 if(assigned(FParent) and assigned(FParent.FPrompts)) then
5294 begin
5295 if(PCECat = pdcProc) then
5296 begin
5297 for i := 0 to FParent.FPrompts.Count-1 do
5298 begin
5299 Prompt := TRemPrompt(FParent.FPrompts[i]);
5300 if(Prompt.PromptType = ptQuantity) then
5301 begin
5302 Qty := StrToIntDef(Prompt.GetValue, 1);
5303 if(Qty < 1) then Qty := 1;
5304 break;
5305 end;
5306 end;
5307 end;
5308 end;
5309 if (not Skip) then
5310 begin
5311 txt := Char(ord('A')+ord(PCECat)) +
5312 GetPCEDataText(PCECat, Code, Cat, Nar, Primary, Qty);
5313 if(assigned(FParent) and FParent.Historical) then
5314// txt := txt + ' (Historical)'; <-- original line. //kt 9/5/2007
5315 txt := txt + DKLangConstW('uReminders_xHistoricalx'); //kt added 9/5/2007
5316 List.AddObject(txt, Self);
5317 inc(Result);
5318 end;
5319 if assigned(FParent) and assigned(FParent.FMSTPrompt) then
5320 begin
5321 txt := FParent.FMSTPrompt.Value;
5322 if txt <> '' then
5323 begin
5324 if FParent.FMSTPrompt.FMiscText = '' then
5325 begin
5326 i1 := 0;
5327 i2 := 2;
5328 end
5329 else
5330 begin
5331 i1 := 3;
5332 i2 := 4;
5333 end;
5334 for i := i1 to i2 do
5335 //kt if txt = MSTDescTxt[i,1] then
5336 if txt = MSTDescTxt(i,1) then
5337 begin
5338 //kt List.AddObject(Char( ord('A') + ord(pdcMST)) + MSTDescTxt[i,0], Self);
5339 List.AddObject(Char( ord('A') + ord(pdcMST)) + MSTDescTxt(i,0), Self);
5340 break;
5341 end;
5342 end;
5343 end;
5344 end;
5345 end;
5346
5347begin
5348 Result := 0;
5349 if(assigned(FChoicePrompt)) and (assigned(FChoices)) then
5350 begin
5351 If not assigned(FChoicesActiveDates) then
5352 begin
5353 for i := 0 to FChoices.Count - 1 do
5354 begin
5355 if (copy(FChoicePrompt.GetValue, i+1, 1) = '1') then
5356 Add(FChoices[i], TRemPCERoot(FChoices.Objects[i]))
5357 end
5358 end
5359 else {if there are active dates for each choice then check them}
5360 begin
5361 If Self.FParent.Historical then
5362 EncDt := DateTimeToFMDateTime(Date)
5363 else
5364 EncDt := RemForm.PCEObj.VisitDateTime;
5365 k := 0;
5366 for i := 0 to FChoices.Count - 1 do
5367 begin
5368 for j := 0 to (TStringList(Self.FChoicesActiveDates[i]).Count - 1) do
5369 begin
5370 ActDt := StrToIntDef((Piece(TStringList(Self.FChoicesActiveDates[i]).Strings[j], ':', 1)),0);
5371 InActDt := StrToIntDef((Piece(TStringList(Self.FChoicesActiveDates[i]).Strings[j], ':', 2)),9999999);
5372 if (EncDt >= ActDt) and (EncDt <= InActDt) then
5373 begin
5374 if(copy(FChoicePrompt.GetValue, k+1,1) = '1') then
5375 Add(FChoices[i], TRemPCERoot(FChoices.Objects[i]));
5376 inc(k);
5377 end; {Active date check}
5378 end; {FChoicesActiveDates.Items[i] loop}
5379 end; {FChoices loop}
5380 end {FChoicesActiveDates check}
5381 end {FChoicePrompt and FChoices check}
5382 else
5383 Add(FRec3, FPCERoot); {Active dates for this are checked in TRemDlgElement.AddData}
5384end;
5385
5386function TRemData.Category: string;
5387begin
5388 Result := Piece(FRec3, U, r3Cat);
5389end;
5390
5391function TRemData.DataType: TRemDataType;
5392begin
5393 Result := Code2DataType(Piece(FRec3, U, r3Type));
5394end;
5395
5396destructor TRemData.Destroy;
5397var
5398 i: integer;
5399
5400begin
5401 if(assigned(FPCERoot)) then
5402 FPCERoot.Done(Self);
5403 if(assigned(FChoices)) then
5404 begin
5405 for i := 0 to FChoices.Count-1 do
5406 begin
5407 if(assigned(FChoices.Objects[i])) then
5408 TRemPCERoot(FChoices.Objects[i]).Done(Self);
5409 end;
5410 end;
5411 KillObj(@FChoices);
5412 inherited;
5413end;
5414
5415function TRemData.DisplayWHResults: boolean;
5416begin
5417 Result :=False;
5418 if FRec3<>'' then
5419 Result := (Piece(FRec3, U, 6) <> '0');
5420end;
5421
5422function TRemData.ExternalValue: string;
5423begin
5424 Result := Piece(FRec3, U, r3Code);
5425end;
5426
5427function TRemData.InternalValue: string;
5428begin
5429 Result := Piece(FRec3, U, 6);
5430end;
5431
5432function TRemData.Narrative: string;
5433begin
5434 Result := Piece(FRec3, U, r3Nar);
5435end;
5436
5437{ TRemPrompt }
5438
5439function TRemPrompt.Add2PN: boolean;
5440begin
5441 Result := FALSE;
5442 if (not Forced) and (PromptOK) then
5443 //if PromptOK then
5444 Result := (Piece(FRec4, U, 5) <> '1');
5445 if (Result=false) and (Piece(FRec4,U,4)='WH_NOT_PURP') then
5446 Result := True;
5447end;
5448
5449function TRemPrompt.Caption: string;
5450begin
5451 Result := Piece(FRec4, U, 8);
5452 if(not FCaptionAssigned) then
5453 begin
5454 AssignFieldIDs(Result);
5455 SetPiece(FRec4, U, 8, Result);
5456 FCaptionAssigned := TRUE;
5457 end;
5458end;
5459
5460constructor TRemPrompt.Create;
5461begin
5462 FOverrideType := ptUnknown;
5463end;
5464
5465function TRemPrompt.Forced: boolean;
5466begin
5467 Result := (Piece(FRec4, U, 7) = 'F');
5468end;
5469
5470function TRemPrompt.InternalValue: string;
5471var
5472 m, d, y: word;
5473 Code: string;
5474
5475begin
5476 Result := Piece(FRec4, U, 6);
5477 Code := Piece(FRec4, U, 4);
5478 if(Code = RemPromptCodes[ptVisitDate]) then
5479 begin
5480 if(copy(Result,1,1) = MonthReqCode) then
5481 begin
5482 FMonthReq := TRUE;
5483 delete(Result,1,1);
5484 end;
5485 if(Result = '') then
5486 begin
5487 DecodeDate(Now, y, m, d);
5488 Result := inttostr(y-1700)+'0000';
5489 SetPiece(FRec4, U, 6, Result);
5490 end;
5491 end;
5492end;
5493
5494procedure TRemPrompt.PromptChange(Sender: TObject);
5495var
5496 cbo: TORComboBox;
5497 pt: TRemPromptType;
5498 TmpValue, OrgValue: string;
5499 idx, i: integer;
5500 NeedRedraw: boolean;
5501 dte: TFMDateTime;
5502 whCKB: TWHCheckBox;
5503 //printoption: TORCheckBox;
5504 WHValue, WHValue1: String;
5505begin
5506 FParent.FReminder.BeginTextChanged;
5507 try
5508 FFromControl := TRUE;
5509 try
5510 TmpValue := GetValue;
5511 OrgValue := TmpValue;
5512 pt := PromptType;
5513 NeedRedraw := FALSE;
5514 case pt of
5515 ptComment, ptQuantity:
5516 TmpValue := (Sender as TEdit).Text;
5517
5518 ptVisitDate:
5519 begin
5520 dte := (Sender as TORDateCombo).FMDate;
5521 while (dte > 2000000) and (dte > FMToday) do
5522 begin
5523 dte := dte - 10000;
5524 NeedRedraw := TRUE;
5525 end;
5526 TmpValue := FloatToStr(dte);
5527 if(TmpValue = '1000000') then
5528 TmpValue := '0';
5529 end;
5530
5531 ptPrimaryDiag, ptAdd2PL, ptContraindicated:
5532 begin
5533 TmpValue := BOOLCHAR[(Sender as TORCheckBox).Checked];
5534 NeedRedraw := (pt = ptPrimaryDiag);
5535 end;
5536
5537 ptVisitLocation:
5538 begin
5539 cbo := (Sender as TORComboBox);
5540 if(cbo.ItemIEN < 0) then
5541 NeedRedraw := (not cbo.DroppedDown)
5542 else
5543 begin
5544 if(cbo.ItemIndex <= 0) then
5545 cbo.Items[0] := '0' + U + cbo.text;
5546 TmpValue := cbo.ItemID;
5547 if(StrToIntDef(TmpValue,0) = 0) then
5548 TmpValue := cbo.Text;
5549 end;
5550 end;
5551
5552 ptWHPapResult:
5553 begin
5554 if (Sender is TWHCheckBox) then
5555 begin
5556 whCKB := (Sender as TWHCheckBox);
5557 if whCKB.Checked = true then
5558 begin
5559// if whCKB.Caption ='NEM (No Evidence of Malignancy)' then FParent.WHResultChk := 'N'; <-- original line. //kt 9/5/2007
5560 if whCKB.Caption =DKLangConstW('uReminders_NEM_xNo_Evidence_of_Malignancyx') then FParent.WHResultChk := 'N'; //kt added 9/5/2007
5561// if whCKB.Caption ='Abnormal' then FParent.WHResultChk := 'A'; <-- original line. //kt 9/5/2007
5562 if whCKB.Caption =DKLangConstW('uReminders_Abnormal') then FParent.WHResultChk := 'A'; //kt added 9/5/2007
5563// if whCKB.Caption ='Unsatisfactory for Diagnosis' then FParent.WHResultChk := 'U'; <-- original line. //kt 9/5/2007
5564 if whCKB.Caption =DKLangConstW('uReminders_Unsatisfactory_for_Diagnosis') then FParent.WHResultChk := 'U'; //kt added 9/5/2007
5565 //AGP Change 23.13 WH multiple processing
5566 for i := 0 to FParent.FData.Count-1 do
5567 begin
5568 if Piece(TRemData(FParent.FData[i]).FRec3,U,4)='WHR' then
5569 begin
5570 FParent.FReminder.WHReviewIEN := Piece(TRemData(FParent.FData[i]).FRec3,U,6)
5571 end;
5572 end;
5573 end
5574 else
5575 begin
5576 FParent.WHResultChk := '';
5577 FParent.FReminder.WHReviewIEN := ''; //AGP CHANGE 23.13
5578 end;
5579 end;
5580 end;
5581
5582
5583 ptWHNotPurp:
5584 begin
5585 if (Sender is TWHCheckBox) then
5586 begin
5587 whCKB := (Sender as TWHCheckBox);
5588 if whCKB.Checked = true then
5589 begin
5590// if whCKB.Caption ='Letter' then <-- original line. //kt 9/5/2007
5591 if whCKB.Caption =DKLangConstW('uReminders_Letter') then //kt added 9/5/2007
5592 begin
5593 if FParent.WHResultNot='' then FParent.WHResultNot := 'L'
5594 else
5595 if Pos('L',FParent.WHResultNot)=0 then FParent.WHResultNot := FParent.WHResultNot +':L';
5596 if whCKB.FButton <> nil then whCKB.FButton.Enabled := true;
5597 if whCKB.FPrintNow <> nil then
5598 begin
5599 whCKB.FPrintVis :='1';
5600 whCKB.FPrintNow.Enabled := true;
5601 end;
5602 end;
5603// if whCKB.Caption ='In-Person' then <-- original line. //kt 9/5/2007
5604 if whCKB.Caption =DKLangConstW('uReminders_InxPerson') then //kt added 9/5/2007
5605 begin
5606 if FParent.WHResultNot='' then FParent.WHResultNot := 'I'
5607 else
5608 if Pos('I',FParent.WHResultNot)=0 then FParent.WHResultNot := FParent.WHResultNot+':I';
5609 end;
5610// if whCKB.Caption ='Phone Call' then <-- original line. //kt 9/5/2007
5611 if whCKB.Caption =DKLangConstW('uReminders_Phone_Call') then //kt added 9/5/2007
5612 begin
5613 if FParent.WHResultNot='' then FParent.WHResultNot := 'P'
5614 else
5615 if Pos('P',FParent.WHResultNot)=0 then FParent.WHResultNot := FParent.WHResultNot+':P';
5616 end;
5617 end
5618 else
5619 begin
5620 // this section is to handle unchecking of boxes and disabling print now and view button
5621 WHValue := FParent.WHResultNot;
5622// if whCKB.Caption ='Letter' then <-- original line. //kt 9/5/2007
5623 if whCKB.Caption =DKLangConstW('uReminders_Letter') then //kt added 9/5/2007
5624 begin
5625 for i:=1 to Length(WHValue) do
5626 begin
5627 if WHValue1='' then
5628 begin
5629 if (WHValue[i]<>'L') and (WHValue[i]<>':') then WHValue1 := WHValue[i];
5630 end
5631 else
5632 if (WHValue[i]<>'L') and (WHValue[i]<>':') then WHValue1 := WHValue1+':'+WHValue[i];
5633 end;
5634 if (whCKB.FButton <> nil) and (whCKB.FButton.Enabled = true) then whCKB.FButton.Enabled := false;
5635 if (whCKB.FPrintNow <> nil) and (whCKB.FPrintNow.Enabled = true) then
5636 begin
5637 whCKB.FPrintVis := '0';
5638 if whCKB.FPrintNow.Checked = true then whCKB.FPrintNow.Checked := false;
5639 whCKB.FPrintNow.Enabled := false;
5640 FParent.WHPrintDevice := '';
5641 end;
5642 end;
5643// if whCKB.Caption ='In-Person' then <-- original line. //kt 9/5/2007
5644 if whCKB.Caption =DKLangConstW('uReminders_InxPerson') then //kt added 9/5/2007
5645 begin
5646 for i:=1 to Length(WHValue) do
5647 begin
5648 if WHValue1='' then
5649 begin
5650 if (WHValue[i]<>'I') and (WHValue[i]<>':') then WHValue1 := WHValue[i];
5651 end
5652 else
5653 if (WHValue[i]<>'I') and (WHValue[i]<>':') then WHValue1 := WHValue1+':'+WHValue[i];
5654 end;
5655 end;
5656// if whCKB.Caption ='Phone Call' then <-- original line. //kt 9/5/2007
5657 if whCKB.Caption =DKLangConstW('uReminders_Phone_Call') then //kt added 9/5/2007
5658 begin
5659 for i:=1 to Length(WHValue) do
5660 begin
5661 if WHValue1='' then
5662 begin
5663 if (WHValue[i]<>'P') and (WHValue[i]<>':') then WHValue1 := WHValue[i];
5664 end
5665 else
5666 if (WHValue[i]<>'P') and (WHValue[i]<>':') then WHValue1 := WHValue1+':'+WHValue[i];
5667 end;
5668 end;
5669 FParent.WHResultNot := WHValue1;
5670 end;
5671 end
5672 else
5673 if ((Sender as TORCheckBox)<>nil) and (Piece(FRec4,U,12)='1') then
5674 begin
5675// if (((Sender as TORCheckBox).Caption = 'Print Now') and <-- original line. //kt 9/5/2007
5676 if (((Sender as TORCheckBox).Caption = DKLangConstW('uReminders_Print_Now')) and //kt added 9/5/2007
5677 ((Sender as TORCheckBox).Enabled =true)) and ((Sender as TORCheckBox).Checked = true) and
5678 (FParent.WHPrintDevice ='') then
5679 begin
5680// FParent.WHPrintDevice := SelectDevice(Self, Encounter.Location, false, 'Women Health Print Device Selection'); <-- original line. //kt 9/5/2007
5681 FParent.WHPrintDevice := SelectDevice(Self, Encounter.Location, false, DKLangConstW('uReminders_Women_Health_Print_Device_Selection')); //kt added 9/5/2007
5682 FPrintNow :='1';
5683 if FParent.WHPrintDevice ='' then
5684 begin
5685 FPrintNow :='0';
5686 (Sender as TORCheckBox).Checked := false;
5687 end;
5688 end;
5689// if (((Sender as TORCheckBox).Caption = 'Print Now') and <-- original line. //kt 9/5/2007
5690 if (((Sender as TORCheckBox).Caption = DKLangConstW('uReminders_Print_Now')) and //kt added 9/5/2007
5691 ((Sender as TORCheckBox).Enabled =true)) and ((Sender as TORCheckBox).Checked = false) then
5692 begin
5693 FParent.WHPrintDevice := '';
5694 FPrintNow :='0';
5695 end;
5696 end;
5697 end;
5698
5699 ptExamResults, ptSkinResults, ptLevelSeverity,
5700 ptSeries, ptReaction, ptLevelUnderstanding, ptSkinReading: //(AGP Change 26.1)
5701 TmpValue := (Sender as TORComboBox).ItemID;
5702 else
5703 if pt = ptVitalEntry then
5704 begin
5705 case (Sender as TControl).Tag of
5706 TAG_VITTEMPUNIT, TAG_VITHTUNIT, TAG_VITWTUNIT: idx := 2;
5707 TAG_VITPAIN: begin
5708 idx := -1;
5709 TmpValue := (Sender as TORComboBox).ItemID;
5710 if FParent.VitalDateTime = 0 then
5711 FParent.VitalDateTime := FMNow;
5712 end;
5713 else
5714 idx := 1;
5715 end;
5716 if(idx > 0) then
5717 begin
5718 //AGP Change 26.1 change Vital time/date to Now instead of encounter date/time
5719 SetPiece(TmpValue, ';', idx, TORExposedControl(Sender).Text);
5720 if (FParent.VitalDateTime > 0) and (TORExposedControl(Sender).Text = '') then
5721 FParent.VitalDateTime := 0;
5722 if (FParent.VitalDateTime = 0) and (TORExposedControl(Sender).Text <> '') then
5723 FParent.VitalDateTime := FMNow;
5724 end;
5725 end
5726 else
5727 if pt = ptDataList then
5728 begin
5729 TmpValue := (Sender as TORComboBox).CheckedString;
5730 NeedRedraw := TRUE;
5731 end
5732 else
5733 if pt = ptGAF then
5734 TmpValue := (Sender as TEdit).Text;
5735 end;
5736 if(TmpValue <> OrgValue) then
5737 begin
5738 if NeedRedraw then
5739 FParent.FReminder.BeginNeedRedraw;
5740 try
5741 SetValue(TmpValue);
5742 finally
5743 if NeedRedraw then
5744 FParent.FReminder.EndNeedRedraw(Self);
5745 end;
5746 end
5747 else
5748 if NeedRedraw then
5749 begin
5750 FParent.FReminder.BeginNeedRedraw;
5751 FParent.FReminder.EndNeedRedraw(Self);
5752 end;
5753 finally
5754 FFromControl := FALSE;
5755 end;
5756 finally
5757 FParent.FReminder.EndTextChanged(Sender);
5758 end;
5759 if(FParent.ElemType = etDisplayOnly) and (not assigned(FParent.FParent)) then
5760 RemindersInProcess.Notifier.Notify;
5761end;
5762
5763
5764procedure TRemPrompt.ComboBoxKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
5765begin
5766 if(Key = VK_RETURN) and (Sender is TORComboBox) and
5767 ((Sender as TORComboBox).DroppedDown) then
5768 (Sender as TORComboBox).DroppedDown := FALSE;
5769end;
5770
5771function TRemPrompt.PromptOK: boolean;
5772var
5773 pt: TRemPromptType;
5774 dt: TRemDataType;
5775 i: integer;
5776
5777begin
5778 pt := PromptType;
5779 if(pt = ptUnknown) or (pt = ptMST) then
5780 Result := FALSE
5781 else
5782 if(pt = ptDataList) or (pt = ptVitalEntry) or (pt = ptMHTest) or (pt = ptGAF) or
5783 (pt = ptWHPapResult) then
5784 Result := TRUE
5785 else
5786 if(pt = ptSubComment) then
5787 Result := FParent.FHasComment
5788 else
5789 begin
5790 dt := RemPromptTypes[PromptType];
5791 if(dt = dtAll) then Result := TRUE
5792 else if(dt = dtUnknown) then Result := FALSE
5793 else if(dt = dtHistorical) then Result := FParent.Historical
5794 else
5795 begin
5796 Result := FALSE;
5797 if(assigned(FParent.FData)) then
5798 begin
5799 for i := 0 to FParent.FData.Count-1 do
5800 begin
5801 if(TRemData(FParent.FData[i]).DataType = dt) then
5802 begin
5803 Result := TRUE;
5804 break;
5805 end;
5806 end;
5807 end;
5808 end;
5809 end;
5810end;
5811
5812function TRemPrompt.PromptType: TRemPromptType;
5813begin
5814 if(assigned(FData)) then
5815 Result := FOverrideType
5816 else
5817 Result := Code2PromptType(Piece(FRec4, U, 4));
5818end;
5819
5820
5821function TRemPrompt.Required: boolean;
5822var
5823 pt: TRemPromptType;
5824
5825begin
5826 pt := PromptType;
5827 if(pt = ptVisitDate) then
5828 Result := TRUE
5829 else
5830 if(pt = ptSubComment) then
5831 Result := FALSE
5832 else
5833 Result := (Piece(FRec4, U, 10) = '1');
5834end;
5835
5836function TRemPrompt.SameLine: boolean;
5837begin
5838 Result := (Piece(FRec4, U, 9) <> '1');
5839end;
5840
5841function TRemPrompt.NoteText: string;
5842var
5843 pt: TRemPromptType;
5844 fmt, tmp, WHValue: string;
5845 cnt, i, j, k: integer;
5846 ActDt, InActDt: Double;
5847 EncDt: TFMDateTime;
5848
5849begin
5850 Result := '';
5851 if Add2PN then
5852 begin
5853 pt := PromptType;
5854 tmp := GetValue;
5855 case pt of
5856 ptComment: Result := tmp;
5857
5858 ptQuantity: if(StrToIntDef(tmp,1) <> 1) then
5859 Result := tmp;
5860
5861 (* ptSkinReading: if(StrToIntDef(tmp,0) <> 0) then
5862 Result := tmp; *)
5863
5864 ptSkinReading: // (AGP Change 26.1)
5865 begin
5866 Result := tmp;
5867 end;
5868
5869 ptVisitDate:
5870 begin
5871 try
5872 if(tmp <> '') and (tmp <> '0') and (length(Tmp) = 7) then
5873 begin
5874 if FMonthReq and (copy(tmp,4,2) = '00') then
5875 Result := ''
5876 else
5877 begin
5878 if(copy(tmp,4,4) = '0000') then
5879 fmt := 'YYYY'
5880 else
5881 if(copy(tmp,6,2) = '00') then
5882 fmt := 'MMMM, YYYY'
5883 else
5884 fmt := 'MMMM D, YYYY';
5885 Result := FormatFMDateTimeStr(fmt, tmp);
5886 end;
5887 end;
5888 except
5889 on EConvertError do
5890 Result := tmp
5891 else
5892 raise;
5893 end;
5894 end;
5895
5896 ptPrimaryDiag, ptAdd2PL, ptContraindicated:
5897 if(tmp = '1') then
5898 Result := ' ';
5899
5900 ptVisitLocation:
5901 if(StrToIntDef(tmp, 0) = 0) then
5902 begin
5903 if(tmp <> '0') then
5904 Result := tmp;
5905 end
5906 else
5907 begin
5908 Result := GetPCEDisplayText(tmp, ComboPromptTags[pt]);
5909 end;
5910
5911 ptWHPapResult:
5912 begin
5913// if Fparent.WHResultChk='N' then Result := 'NEM (No Evidence of Malignancy)'; <-- original line. //kt 9/5/2007
5914 if Fparent.WHResultChk='N' then Result := DKLangConstW('uReminders_NEM_xNo_Evidence_of_Malignancyx'); //kt added 9/5/2007
5915// if Fparent.WHResultChk='A' then Result := 'Abnormal'; <-- original line. //kt 9/5/2007
5916 if Fparent.WHResultChk='A' then Result := DKLangConstW('uReminders_Abnormal'); //kt added 9/5/2007
5917// if Fparent.WHResultChk='U' then Result := 'Unsatisfactory for Diagnosis'; <-- original line. //kt 9/5/2007
5918 if Fparent.WHResultChk='U' then Result := DKLangConstW('uReminders_Unsatisfactory_for_Diagnosis'); //kt added 9/5/2007
5919 if FParent.WHResultChk='' then Result := '';
5920 end;
5921
5922 ptWHNotPurp:
5923 begin
5924 if FParent.WHResultNot <> '' then
5925 begin
5926 WHValue := FParent.WHResultNot;
5927 //IF Forced = false then
5928 //begin
5929 if WHValue <> 'CPRS' then
5930 begin
5931 for cnt := 1 to Length(WHValue) do
5932 begin
5933 if Result ='' then
5934 begin
5935// if WHValue[cnt]='L' then Result := 'Letter'; <-- original line. //kt 9/5/2007
5936 if WHValue[cnt]='L' then Result := DKLangConstW('uReminders_Letter'); //kt added 9/5/2007
5937// if WHValue[cnt]='I' then Result := 'In-Person'; <-- original line. //kt 9/5/2007
5938 if WHValue[cnt]='I' then Result := DKLangConstW('uReminders_InxPerson'); //kt added 9/5/2007
5939// if WHValue[cnt]='P' then Result := 'Phone Call'; <-- original line. //kt 9/5/2007
5940 if WHValue[cnt]='P' then Result := DKLangConstW('uReminders_Phone_Call'); //kt added 9/5/2007
5941 end
5942 else
5943 begin
5944// if (WHValue[cnt]='L')and(Pos('Letter',Result)=0) then Result := Result+'; Letter'; <-- original line. //kt 9/5/2007
5945 if (WHValue[cnt]='L')and(Pos(DKLangConstW('uReminders_Letter'),Result)=0) then Result := Result+DKLangConstW('uReminders_x_Letter'); //kt added 9/5/2007
5946// if (WHValue[cnt]='I')and(Pos('In-Person',Result)=0) then Result := Result+'; In-Person'; <-- original line. //kt 9/5/2007
5947 if (WHValue[cnt]='I')and(Pos(DKLangConstW('uReminders_InxPerson'),Result)=0) then Result := Result+DKLangConstW('uReminders_x_InxPerson'); //kt added 9/5/2007
5948// if (WHValue[cnt]='P')and(Pos('Phone Call',Result)=0) then Result := Result+'; Phone Call'; <-- original line. //kt 9/5/2007
5949 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
5950 end;
5951 end;
5952 end;
5953 end
5954 else
5955 if Forced = true then
5956 begin
5957 if pos(':',Piece(FRec4,U,6))=0 then
5958 begin
5959 if Piece(FRec4,U,6)='L' then
5960 begin
5961// Result := 'Letter'; <-- original line. //kt 9/5/2007
5962 Result := DKLangConstW('uReminders_Letter'); //kt added 9/5/2007
5963 FParent.WHResultNot :='L';
5964 end;
5965 if Piece(FRec4,U,6)='I' then
5966 begin
5967// Result := 'In-Person'; <-- original line. //kt 9/5/2007
5968 Result := DKLangConstW('uReminders_InxPerson'); //kt added 9/5/2007
5969 FParent.WHResultNot := 'I';
5970 end;
5971 if Piece(FRec4,U,6)='P' then
5972 begin
5973// Result := 'Phone Call'; <-- original line. //kt 9/5/2007
5974 Result := DKLangConstW('uReminders_Phone_Call'); //kt added 9/5/2007
5975 FParent.WHResultNot := 'P';
5976 end;
5977 if Piece(FRec4,U,6)='CPRS' then
5978 begin
5979 Result := '';
5980 FParent.WHResultNot := 'CPRS';
5981 end;
5982 end
5983 else
5984 begin
5985 WHValue := Piece(FRec4,U,6);
5986 for cnt := 0 to Length(WHValue) do
5987 begin
5988 if Result ='' then
5989 begin
5990 if WHValue[cnt]='L' then
5991 begin
5992// Result := 'Letter'; <-- original line. //kt 9/5/2007
5993 Result := DKLangConstW('uReminders_Letter'); //kt added 9/5/2007
5994 FParent.WHResultNot := WHValue[cnt];
5995 end;
5996 if WHValue[cnt]='I' then
5997 begin
5998// Result := 'In-Person'; <-- original line. //kt 9/5/2007
5999 Result := DKLangConstW('uReminders_InxPerson'); //kt added 9/5/2007
6000 FParent.WHResultNot := WHValue[cnt];
6001 end;
6002 if WHValue[cnt]='P' then
6003 begin
6004// Result := 'Phone Call'; <-- original line. //kt 9/5/2007
6005 Result := DKLangConstW('uReminders_Phone_Call'); //kt added 9/5/2007
6006 FParent.WHResultNot := WHValue[cnt];
6007 end;
6008 end
6009 else
6010 begin
6011// if (WHValue[cnt]='L')and(Pos('Letter',Result)=0) then <-- original line. //kt 9/5/2007
6012 if (WHValue[cnt]='L')and(Pos(DKLangConstW('uReminders_Letter'),Result)=0) then //kt added 9/5/2007
6013 begin
6014// Result := Result +'; Letter'; <-- original line. //kt 9/5/2007
6015 Result := Result +DKLangConstW('uReminders_x_Letter'); //kt added 9/5/2007
6016 FParent.WHResultNot := FParent.WHResultNot + ':' + WHValue[cnt];
6017 end;
6018// if (WHValue[cnt]='I')and(Pos('In-Person',Result)=0) then <-- original line. //kt 9/5/2007
6019 if (WHValue[cnt]='I')and(Pos(DKLangConstW('uReminders_InxPerson'),Result)=0) then //kt added 9/5/2007
6020 begin
6021// Result := Result +'; In-Person'; <-- original line. //kt 9/5/2007
6022 Result := Result +DKLangConstW('uReminders_x_InxPerson'); //kt added 9/5/2007
6023 FParent.WHResultNot := FParent.WHResultNot + ':' + WHValue[cnt];
6024 end;
6025// if (WHValue[cnt]='P')and(Pos('Phone Call',Result)=0) then <-- original line. //kt 9/5/2007
6026 if (WHValue[cnt]='P')and(Pos(DKLangConstW('uReminders_Phone_Call'),Result)=0) then //kt added 9/5/2007
6027 begin
6028// Result := Result +'; Phone Call'; <-- original line. //kt 9/5/2007
6029 Result := Result +DKLangConstW('uReminders_x_Phone_Call'); //kt added 9/5/2007
6030 FParent.WHResultNot := FParent.WHResultNot + ':' + WHValue[cnt];
6031 end;
6032 end;
6033 end;
6034
6035 end;
6036 end
6037 else
6038 Result := '';
6039 end;
6040
6041 ptExamResults, ptSkinResults, ptLevelSeverity,
6042 ptSeries, ptReaction, ptLevelUnderstanding:
6043 begin
6044 Result := tmp;
6045 if(Piece(Result,U,1) = '@') then
6046 Result := ''
6047 else
6048 Result := GetPCEDisplayText(tmp, ComboPromptTags[pt]);
6049 end;
6050
6051 else
6052 begin
6053 if pt = ptDataList then
6054 begin
6055 if(assigned(FData) and assigned(FData.FChoices)) then
6056 begin
6057 if not(assigned(FData.FChoicesActiveDates)) then
6058 for i := 0 to FData.FChoices.Count - 1 do
6059 begin
6060 if(copy(tmp,i+1,1) = '1') then
6061 begin
6062 if (Result <> '') then
6063 Result := Result + ', ';
6064 Result := Result + Piece(FData.FChoices[i],U,12);
6065 end;
6066 end
6067 else {if there are active dates for each choice then check them}
6068 begin
6069 if Self.FParent.Historical then
6070 EncDt := DateTimeToFMDateTime(Date)
6071 else
6072 EncDt := RemForm.PCEObj.VisitDateTime;
6073 k := 0;
6074 for i := 0 to FData.FChoices.Count - 1 do
6075 begin
6076 for j := 0 to (TStringList(FData.FChoicesActiveDates[i]).Count - 1) do
6077 begin
6078 ActDt := StrToIntDef((Piece(TStringList(FData.FChoicesActiveDates[i]).Strings[j], ':', 1)),0);
6079 InActDt := StrToIntDef((Piece(TStringList(FData.FChoicesActiveDates[i]).Strings[j], ':', 2)),9999999);
6080 if (EncDt >= ActDt) and (EncDt <= InActDt) then
6081 begin
6082 if(copy(tmp,k+1,1) = '1') then
6083 begin
6084 if(Result <> '') then
6085 Result := Result + ', ';
6086 Result := Result + Piece(FData.FChoices[i],U,12);
6087 end;
6088 inc(k);
6089 end; {ActiveDate check}
6090 end; {FChoicesActiveDates.Items[i] loop}
6091 end; {FChoices loop}
6092 end;
6093 end;
6094 end
6095 else
6096 if pt = ptVitalEntry then
6097 begin
6098 Result := VitalValue;
6099 if(Result <> '') then
6100 Result := ConvertVitalData(Result, VitalType, VitalUnitValue);
6101 end
6102 else
6103 if pt = ptMHTest then
6104 Result := FMiscText
6105 else
6106 if pt = ptGAF then
6107 begin
6108 if(StrToIntDef(Piece(tmp, U, 1),0) <> 0) then
6109 begin
6110 Result := tmp;
6111 (*
6112 GafDate := Trunc(FParent.FReminder.PCEDataObj.VisitDateTime);
6113 ValidateGAFDate(GafDate);
6114 Result := tmp + CRCode + 'Date Determined: ' + FormatFMDateTime('mm/dd/yyyy', GafDate) +
6115 CRCode + 'Determined By: ' + FParent.FReminder.PCEDataObj.Providers.PCEProviderName;
6116 *)
6117 end;
6118 end;
6119 end;
6120
6121 end;
6122 if(Result <> '') and (Caption <> '') then
6123 Result := Trim(Caption + ' ' + Trim(Result));
6124 end;
6125end;
6126
6127function TRemPrompt.CanShare(Prompt: TRemPrompt): boolean;
6128var
6129 pt: TRemPromptType;
6130
6131begin
6132 if(Forced or Prompt.Forced or Prompt.FIsShared or Required or Prompt.Required) then
6133 Result := FALSE
6134 else
6135 begin
6136 pt := PromptType;
6137 Result := (pt = Prompt.PromptType);
6138 if(Result) then
6139 begin
6140 if(pt in [ptAdd2PL, ptLevelUnderstanding]) or
6141 ((pt = ptComment) and (not FParent.FHasSubComments)) then
6142 Result := ((Add2PN = Prompt.Add2PN) and
6143 (Caption = Prompt.Caption))
6144 else
6145 Result := FALSE;
6146 end;
6147 end;
6148end;
6149
6150destructor TRemPrompt.Destroy;
6151begin
6152 KillObj(@FSharedChildren);
6153 inherited;
6154end;
6155
6156function TRemPrompt.RemDataActive(RData: TRemData; EncDt: TFMDateTime):Boolean;
6157var
6158 ActDt, InActDt: Double;
6159 j: integer;
6160
6161begin
6162 Result := FALSE;
6163 if assigned(RData.FActiveDates) then
6164 for j := 0 to (RData.FActiveDates.Count - 1) do
6165 begin
6166 ActDt := StrToIntDef(Piece(RData.FActiveDates[j],':',1), 0);
6167 InActDt := StrToIntDef(Piece(RData.FActiveDates[j], ':', 2), 9999999);
6168 if (EncDt >= ActDt) and (EncDt <= InActDt) then
6169 begin
6170 Result := TRUE;
6171 Break;
6172 end;
6173 end
6174 else
6175 Result := TRUE;
6176end;
6177
6178function TRemPrompt.RemDataChoiceActive(RData: TRemData; j: integer; EncDt: TFMDateTime):Boolean;
6179var
6180 ActDt, InActDt: Double;
6181 i: integer;
6182begin
6183 Result := FALSE;
6184 If not assigned(RData.FChoicesActiveDates) then //if no active dates were sent
6185 Result := TRUE //from the server then don't check dates
6186 else {if there are active dates for each choice then check them}
6187 begin
6188 for i := 0 to (TStringList(RData.FChoicesActiveDates[j]).Count - 1) do
6189 begin
6190 ActDt := StrToIntDef((Piece(TStringList(RData.FChoicesActiveDates[j]).Strings[i], ':', 1)),0);
6191 InActDt := StrToIntDef((Piece(TStringList(RData.FChoicesActiveDates[j]).Strings[i], ':', 2)),9999999);
6192 if (EncDt >= ActDt) and (EncDt <= InActDt) then
6193 begin
6194 Result := True;
6195 end; {Active date check}
6196 end; {FChoicesActiveDates.Items[i] loop}
6197 end {FChoicesActiveDates check}
6198end;
6199
6200function TRemPrompt.GetValue: string;
6201//Returns TRemPrompt.FValue if this TRemPrompt is not a ptPrimaryDiag
6202//Returns 0-False or 1-True if this TRemPrompt is a ptPrimaryDiag
6203var
6204 i, j, k: integer;
6205 RData: TRemData;
6206 Ok: boolean;
6207 EncDt: TFMDateTime;
6208
6209begin
6210 OK := (Piece(FRec4, U, 4) = RemPromptCodes[ptPrimaryDiag]);
6211 if(OK) and (assigned(FParent)) then
6212 OK := (not FParent.Historical);
6213 if OK then
6214 begin
6215 Ok := FALSE;
6216 if(assigned(FParent) and assigned(FParent.FData)) then {If there's FData, see if}
6217 begin {there's a primary diagnosis}
6218 for i := 0 to FParent.FData.Count-1 do {if there is return True}
6219 begin
6220 EncDt := RemForm.PCEObj.VisitDateTime;
6221 RData := TRemData(FParent.FData[i]);
6222 if(RData.DataType = dtDiagnosis) then
6223 begin
6224 if(assigned(RData.FPCERoot)) and (RemDataActive(RData, EncDt)) then
6225 Ok := (RData.FPCERoot = PrimaryDiagRoot)
6226 else
6227 if(assigned(RData.FChoices)) and (assigned(RData.FChoicePrompt)) then
6228 begin
6229 k := 0;
6230 for j := 0 to RData.FChoices.Count-1 do
6231 begin
6232 if RemDataChoiceActive(RData, j, EncDt) then
6233 begin
6234 if(assigned(RData.FChoices.Objects[j])) and
6235 (copy(RData.FChoicePrompt.FValue,k+1,1)='1') then
6236 begin
6237 if(TRemPCERoot(RData.FChoices.Objects[j]) = PrimaryDiagRoot) then
6238 begin
6239 Ok := TRUE;
6240 break;
6241 end;
6242 end; //if FChoices.Objects (which is the RemPCERoot object) is assigned
6243 inc(k);
6244 end; //if FChoices[j] is active
6245 end; //loop through FChoices
6246 end; //If there are FChoices and an FChoicePrompt (i.e.: is this a ptDataList}
6247 end;
6248 if Ok then break;
6249 end;
6250 end;
6251 Result := BOOLCHAR[Ok];
6252 end
6253 else
6254 Result := FValue;
6255end;
6256
6257
6258
6259procedure TRemPrompt.SetValue(Value: string);
6260var
6261 pt: TRemPromptType;
6262 i, j, k : integer;
6263 RData: TRemData;
6264 Primary, Done: boolean;
6265 Tmp: string;
6266 OK, NeedRefresh: boolean;
6267 EncDt: TFMDateTime;
6268
6269begin
6270 NeedRefresh := (not FFromControl);
6271 if(Forced and (not FFromParent)) then exit;
6272 pt := PromptType;
6273 if(pt = ptVisitDate) then
6274 begin
6275 if(Value = '') then
6276 Value := '0'
6277 else
6278 begin
6279 try
6280 if(StrToFloat(Value) > FMToday) then
6281 begin
6282 Value := '0';
6283// InfoBox('Can not enter a future date for a historical event.', <-- original line. //kt 9/5/2007
6284 InfoBox(DKLangConstW('uReminders_Can_not_enter_a_future_date_for_a_historical_eventx'), //kt added 9/5/2007
6285// 'Invalid Future Date', MB_OK + MB_ICONERROR); <-- original line. //kt 9/5/2007
6286 DKLangConstW('uReminders_Invalid_Future_Date'), MB_OK + MB_ICONERROR); //kt added 9/5/2007
6287 end;
6288 except
6289 on EConvertError do
6290 Value := '0'
6291 else
6292 raise;
6293 end;
6294 if(Value = '0') then
6295 NeedRefresh := TRUE;
6296 end;
6297 end;
6298 if(GetValue <> Value) or (FFromParent) then
6299 begin
6300 FValue := Value;
6301 EncDt := RemForm.PCEObj.VisitDateTime;
6302 if((pt = ptExamResults) and assigned(FParent) and assigned(FParent.FData) and
6303 (FParent.FData.Count > 0) and assigned(FParent.FMSTPrompt)) then
6304 begin
6305 FParent.FMSTPrompt.SetValueFromParent(Value);
6306 if (FParent.FMSTPrompt.FMiscText = '') then
6307 // Assumes first finding item is MST finding
6308 FParent.FMSTPrompt.FMiscText := TRemData(FParent.FData[0]).InternalValue;
6309 end;
6310
6311 OK := (assigned(FParent) and assigned(FParent.FData) and
6312 (Piece(FRec4, U, 4) = RemPromptCodes[ptPrimaryDiag]));
6313 if OK then
6314 OK := (not FParent.Historical);
6315 if OK then
6316 begin
6317 Done := FALSE;
6318 Primary := (Value = BOOLCHAR[TRUE]);
6319 for i := 0 to FParent.FData.Count-1 do
6320 begin
6321 RData := TRemData(FParent.FData[i]);
6322 if(RData.DataType = dtDiagnosis) then
6323 begin
6324 if(assigned(RData.FPCERoot)) and (RemDataActive(RData, EncDt)) then
6325 begin
6326 if(Primary) then
6327 begin
6328 PrimaryDiagRoot := RData.FPCERoot;
6329 Done := TRUE;
6330 end
6331 else
6332 begin
6333 if(PrimaryDiagRoot = RData.FPCERoot) then
6334 begin
6335 PrimaryDiagRoot := nil;
6336 Done := TRUE;
6337 end;
6338 end;
6339 end
6340 else
6341 if(assigned(RData.FChoices)) and (assigned(RData.FChoicePrompt)) then
6342 begin
6343 k := 0;
6344 for j := 0 to RData.FChoices.Count-1 do
6345 begin
6346 if RemDataChoiceActive(RData, j, EncDt) then
6347 begin
6348 if(Primary) then
6349 begin
6350 if(assigned(RData.FChoices.Objects[j])) and
6351 (copy(RData.FChoicePrompt.FValue,k+1,1)='1') then
6352 begin
6353 PrimaryDiagRoot := TRemPCERoot(RData.FChoices.Objects[j]);
6354 Done := TRUE;
6355 break;
6356 end;
6357 end
6358 else
6359 begin
6360 if(assigned(RData.FChoices.Objects[j])) and
6361 (PrimaryDiagRoot = TRemPCERoot(RData.FChoices.Objects[j])) then
6362 begin
6363 PrimaryDiagRoot := nil;
6364 Done := TRUE;
6365 break;
6366 end;
6367 end;
6368 inc(k);
6369 end;
6370 end;
6371 end;
6372 end;
6373 if Done then break;
6374 end;
6375 end;
6376 if(assigned(FParent) and assigned(FParent.FData) and IsSyncPrompt(pt)) then
6377 begin
6378 for i := 0 to FParent.FData.Count-1 do
6379 begin
6380 RData := TRemData(FParent.FData[i]);
6381 if(assigned(RData.FPCERoot)) and (RemDataActive(RData, EncDt)) then
6382 RData.FPCERoot.Sync(Self);
6383 if(assigned(RData.FChoices)) then
6384 begin
6385 for j := 0 to RData.FChoices.Count-1 do
6386 begin
6387 if(assigned(RData.FChoices.Objects[j])) and
6388 RemDataChoiceActive(RData, j, EncDt) then
6389 TRemPCERoot(RData.FChoices.Objects[j]).Sync(Self);
6390 end;
6391 end;
6392 end;
6393 end;
6394 end;
6395 if(not NeedRefresh) then
6396 NeedRefresh := (GetValue <> Value);
6397 if(NeedRefresh and assigned(FCurrentControl) and FParent.FReminder.Visible) then
6398 begin
6399 case pt of
6400 ptComment:
6401 (FCurrentControl as TEdit).Text := GetValue;
6402
6403 ptQuantity:
6404 (FCurrentControl as TUpDown).Position := StrToIntDef(GetValue,1);
6405
6406 (* ptSkinReading:
6407 (FCurrentControl as TUpDown).Position := StrToIntDef(GetValue,0); *)
6408
6409 ptVisitDate:
6410 begin
6411 try
6412 (FCurrentControl as TORDateCombo).FMDate := StrToFloat(GetValue);
6413 except
6414 on EConvertError do
6415 (FCurrentControl as TORDateCombo).FMDate := 0;
6416 else
6417 raise;
6418 end;
6419 end;
6420
6421 ptPrimaryDiag, ptAdd2PL, ptContraindicated:
6422 (FCurrentControl as TORCheckBox).Checked := (GetValue = BOOLCHAR[TRUE]);
6423
6424 ptVisitLocation:
6425 begin
6426 Tmp := GetValue;
6427 with (FCurrentControl as TORComboBox) do
6428 begin
6429 if(piece(Tmp,U,1)= '0') then
6430 begin
6431 Items[0] := Tmp;
6432 SelectByID('0');
6433 end
6434 else
6435 SelectByID(Tmp);
6436 end;
6437 end;
6438
6439 ptWHPapResult:
6440 (FCurrentControl as TORCheckBox).Checked := (GetValue = BOOLCHAR[TRUE]);
6441
6442 ptWHNotPurp:
6443 (FCurrentControl as TORCheckBox).Checked := (GetValue = BOOLCHAR[TRUE]);
6444
6445 ptExamResults, ptSkinResults, ptLevelSeverity,
6446 ptSeries, ptReaction, ptLevelUnderstanding, ptSkinReading: //(AGP Change 26.1)
6447 (FCurrentControl as TORComboBox).SelectByID(GetValue);
6448
6449 else
6450 if(pt = ptVitalEntry) then
6451 begin
6452 if(FCurrentControl is TORComboBox) then
6453 (FCurrentControl as TORComboBox).SelectByID(VitalValue)
6454 else
6455 if(FCurrentControl is TVitalEdit) then
6456 begin
6457 with (FCurrentControl as TVitalEdit) do
6458 begin
6459 Text := VitalValue;
6460 if(assigned(FLinkedCombo)) then
6461 begin
6462 Tmp := VitalUnitValue;
6463 if(Tmp <> '') then
6464 FLinkedCombo.Text := VitalUnitValue
6465 else
6466 FLinkedCombo.ItemIndex := 0;
6467 end;
6468 end;
6469 end;
6470 end;
6471 end;
6472 end;
6473end;
6474
6475
6476procedure TRemPrompt.SetValueFromParent(Value: string);
6477begin
6478 FFromParent := TRUE;
6479 try
6480 SetValue(Value);
6481 finally
6482 FFromParent := FALSE;
6483 end;
6484end;
6485
6486procedure TRemPrompt.InitValue;
6487var
6488 Value: string;
6489 pt: TRemPromptType;
6490 idx, i, j: integer;
6491 TempSL: TORStringList;
6492 Found: boolean;
6493 RData: TRemData;
6494
6495begin
6496 Value := InternalValue;
6497 pt := PromptType;
6498 if(ord(pt) >= ord(low(TRemPromptType))) and (ComboPromptTags[pt] <> 0) then
6499 begin
6500 TempSL := TORStringList.Create;
6501 try
6502 GetPCECodes(TempSL, ComboPromptTags[pt]);
6503 idx := TempSL.CaseInsensitiveIndexOfPiece(Value, U, 1);
6504 if(idx < 0) then
6505 idx := TempSL.CaseInsensitiveIndexOfPiece(Value, U, 2);
6506 if(idx >= 0) then
6507 Value := Piece(TempSL[idx],U,1);
6508 finally
6509 TempSL.Free;
6510 end;
6511 end;
6512 if((not Forced) and assigned(FParent) and assigned(FParent.FData) and IsSyncPrompt(pt)) then
6513 begin
6514 Found := FALSE;
6515 for i := 0 to FParent.FData.Count-1 do
6516 begin
6517 RData := TRemData(FParent.FData[i]);
6518 if(assigned(RData.FPCERoot)) then
6519 Found := RData.FPCERoot.GetValue(pt, Value);
6520 if(not Found) and (assigned(RData.FChoices)) then
6521 begin
6522 for j := 0 to RData.FChoices.Count-1 do
6523 begin
6524 if(assigned(RData.FChoices.Objects[j])) then
6525 begin
6526 Found := TRemPCERoot(RData.FChoices.Objects[j]).GetValue(pt, Value);
6527 if(Found) then break;
6528 end;
6529 end;
6530 end;
6531 if(Found) then break;
6532 end;
6533 end;
6534 FInitializing := TRUE;
6535 try
6536 SetValueFromParent(Value);
6537 finally
6538 FInitializing := FALSE;
6539 end;
6540end;
6541
6542function TRemPrompt.ForcedCaption: string;
6543var
6544 pt: TRemPromptType;
6545
6546begin
6547 Result := Caption;
6548 if(Result = '') then
6549 begin
6550 pt := PromptType;
6551 if(pt = ptDataList) then
6552 begin
6553 if(assigned(FData)) then
6554 begin
6555 if(FData.DataType = dtDiagnosis) then
6556// Result := 'Diagnosis' <-- original line. //kt 9/5/2007
6557 Result := DKLangConstW('uReminders_Diagnosis') //kt added 9/5/2007
6558 else
6559 if(FData.DataType = dtProcedure) then
6560// Result := 'Procedure'; <-- original line. //kt 9/5/2007
6561 Result := DKLangConstW('uReminders_Procedure'); //kt added 9/5/2007
6562 end;
6563 end
6564 else
6565 if(pt = ptVitalEntry) then
6566 //kt Result := VitalDesc[VitalType] + ':'
6567 Result := VitalDesc(VitalType) + ':'
6568 else
6569 if(pt = ptMHTest) then
6570// Result := 'Perform ' + FData.Narrative <-- original line. //kt 9/5/2007
6571 Result := DKLangConstW('uReminders_Perform') + FData.Narrative //kt added 9/5/2007
6572 else
6573 if(pt = ptGAF) then
6574// Result := 'GAF Score' <-- original line. //kt 9/5/2007
6575 Result := DKLangConstW('uReminders_GAF_Score') //kt added 9/5/2007
6576 else
6577 Result := PromptDescriptions(pt);
6578 //kt Result := PromptDescriptions[pt];
6579// if(Result = '') then Result := 'Prompt'; <-- original line. //kt 9/5/2007
6580 if(Result = '') then Result := DKLangConstW('uReminders_Prompt'); //kt added 9/5/2007
6581 end;
6582 if(copy(Result,length(Result),1) = ':') then
6583 delete(Result,length(Result),1);
6584end;
6585
6586function TRemPrompt.VitalType: TVitalType;
6587begin
6588 Result := vtUnknown;
6589 if(assigned(FData)) then
6590 Result := Code2VitalType(FData.InternalValue);
6591end;
6592
6593procedure TRemPrompt.VitalVerify(Sender: TObject);
6594var
6595 vEdt: TVitalEdit;
6596 vCbo: TVitalComboBox;
6597 AObj: TWinControl;
6598
6599begin
6600 if(Sender is TVitalEdit) then
6601 begin
6602 vEdt := TVitalEdit(Sender);
6603 vCbo := vEdt.FLinkedCombo;
6604 end
6605 else
6606 if(Sender is TVitalComboBox) then
6607 begin
6608 vCbo := TVitalComboBox(Sender);
6609 vEdt := vCbo.FLinkedEdit;
6610 end
6611 else
6612 begin
6613 vCbo := nil;
6614 vEdt := nil;
6615 end;
6616 AObj := Screen.ActiveControl;
6617 if((not assigned(AObj)) or ((AObj <> vEdt) and (AObj <> vCbo))) then
6618 begin
6619 if(vEdt.Tag = TAG_VITHEIGHT) then
6620 vEdt.Text := ConvertHeight2Inches(vEdt.Text);
6621 if VitalInvalid(vEdt, vCbo) then
6622 vEdt.SetFocus;
6623 end;
6624end;
6625
6626function TRemPrompt.VitalUnitValue: string;
6627var
6628 vt: TVitalType;
6629
6630begin
6631 vt := VitalType;
6632 if (vt in [vtTemp, vtHeight, vtWeight]) then
6633 begin
6634 Result := Piece(GetValue,';',2);
6635 if(Result = '') then
6636 begin
6637 case vt of
6638 vtTemp: Result := 'F';
6639 vtHeight: Result := 'IN';
6640 vtWeight: Result := 'LB';
6641 end;
6642 SetPiece(FValue, ';', 2, Result);
6643 end;
6644 end
6645 else
6646 Result := '';
6647end;
6648
6649function TRemPrompt.VitalValue: string;
6650begin
6651 Result := Piece(GetValue,';',1);
6652end;
6653
6654procedure TRemPrompt.DoWHReport(Sender: TObject);
6655Var
6656comp, ien: string;
6657i: integer;
6658begin
6659 for i := 0 to FParent.FData.Count-1 do
6660 begin
6661 comp:= Piece(TRemData(FParent.FData[i]).FRec3,U,4);
6662 ien:= Piece(TRemData(FParent.FData[i]).FRec3,U,6);
6663 end;
6664 CallV('ORQQPXRM GET WH REPORT TEXT', [ien]);
6665// ReportBox(RPCBrokerV.Results,'Procedure Report Results',True); <-- original line. //kt 9/5/2007
6666 ReportBox(RPCBrokerV.Results,DKLangConstW('uReminders_Procedure_Report_Results'),True); //kt added 9/5/2007
6667end;
6668
6669procedure TRemPrompt.ViewWHText(Sender: TObject);
6670var
6671WHRecNum, WHTitle: string;
6672i: integer;
6673begin
6674 for i := 0 to FParent.FData.Count-1 do
6675 begin
6676 if Piece(TRemData(FParent.FData[i]).FRec3,U,4)='WH' then
6677 begin
6678 WHRecNum:=(Piece(TRemData(FParent.FData[i]).FRec3,U,6));
6679 WHTitle :=(Piece(TRemData(FParent.FData[i]).FRec3,U,8));
6680 end;
6681 end;
6682 CallV('ORQQPXRM GET WH LETTER TEXT', [WHRecNum]);
6683//ReportBox(RPCBrokerV.Results,'Women Health Notification Purpose: '+WHTitle,false); <-- original line. //kt 9/5/2007
6684 ReportBox(RPCBrokerV.Results,DKLangConstW('uReminders_Women_Health_Notification_Purposex')+WHTitle,false); //kt added 9/5/2007
6685end;
6686
6687procedure TRemPrompt.DoMHTest(Sender: TObject);
6688var
6689 TmpSL: TStringList;
6690 i, TestComp: integer;
6691 Before, After: string;
6692
6693begin
6694 TestComp := 0;
6695 if(MHTestAuthorized(FData.Narrative)) then
6696 begin
6697 FParent.FReminder.BeginTextChanged;
6698 try
6699 if(FParent.IncludeMHTestInPN) then
6700 TmpSL := TStringList.Create
6701 else
6702 TmpSL := nil;
6703 Before := GetValue;
6704 After := PerformMHTest(Before, FData.Narrative, TmpSL);
6705 if uinit.TimedOut then After := '';
6706 if pos(U,After)>0 then
6707 begin
6708 TestComp := StrtoInt(Piece(After,U,2));
6709 self.FMHTestComplete := TestComp;
6710 After := Piece(After,U,1);
6711 end;
6712 if(Before <> After) and (not uInit.TimedOut) then
6713 begin
6714 if(After = '') or (FParent.ResultDlgID = 0) then
6715 FMiscText := ''
6716 else
6717 if TestComp > 0 then
6718 begin
6719 MentalHealthTestResults(FMiscText, FParent.ResultDlgID, FData.Narrative,
6720 FParent.FReminder.FPCEDataObj.Providers.PCEProvider, After);
6721 if(assigned(TmpSL) and (TmpSL.Count > 0)) then
6722 begin
6723 if(FMiscText <> '') then
6724 FMiscText := FMiscText + CRCode + CRCode;
6725 for i := 0 to TmpSL.Count-1 do
6726 begin
6727 if(i > 0) then
6728 FMiscText := FMiscText + CRCode + CRCode;
6729 FMiscText := FMiscText + TmpSL[i];
6730 end;
6731 end;
6732 ExpandTIUObjects(FMiscText);
6733 end;
6734 SetValue(After);
6735 end;
6736 finally
6737 if not uInit.TimedOut then
6738 FParent.FReminder.EndTextChanged(Sender);
6739 end;
6740 if not uInit.TimedOut then
6741 if(FParent.ElemType = etDisplayOnly) and (not assigned(FParent.FParent)) then
6742 RemindersInProcess.Notifier.Notify;
6743 end
6744 else
6745// InfoBox('Not Authorized to score the ' + FData.Narrative + ' test.', <-- original line. //kt 9/5/2007
6746 InfoBox(DKLangConstW('uReminders_Not_Authorized_to_score_the')+' ' + FData.Narrative + DKLangConstW('uReminders_testx'), //kt added 9/5/2007
6747// 'Insufficient Authorization', MB_OK + MB_ICONERROR); <-- original line. //kt 9/5/2007
6748 DKLangConstW('uReminders_Insufficient_Authorization'), MB_OK + MB_ICONERROR); //kt added 9/5/2007
6749end;
6750
6751procedure TRemPrompt.GAFHelp(Sender: TObject);
6752begin
6753 inherited;
6754 GotoWebPage(GAFURL);
6755end;
6756
6757function TRemPrompt.EntryID: string;
6758begin
6759 Result := FParent.EntryID + '/' + IntToStr(integer(Self));
6760end;
6761
6762procedure TRemPrompt.EditKeyPress(Sender: TObject; var Key: Char);
6763begin
6764 if (Key = '?') and (Sender is TCustomEdit) and
6765 ((TCustomEdit(Sender).Text = '') or (TCustomEdit(Sender).SelStart = 0)) then
6766 Key := #0;
6767end;
6768
6769{ TRemPCERoot }
6770
6771destructor TRemPCERoot.Destroy;
6772begin
6773 KillObj(@FData);
6774 KillObj(@FForcedPrompts);
6775 inherited;
6776end;
6777
6778procedure TRemPCERoot.Done(Data: TRemData);
6779var
6780 i, idx: integer;
6781
6782begin
6783 if(assigned(FForcedPrompts) and assigned(Data.FParent) and
6784 assigned(Data.FParent.FPrompts)) then
6785 begin
6786 for i := 0 to Data.FParent.FPrompts.Count-1 do
6787 UnSync(TRemPrompt(Data.FParent.FPrompts[i]));
6788 end;
6789 FData.Remove(Data);
6790 if(FData.Count <= 0) then
6791 begin
6792 idx := PCERootList.IndexOfObject(Self);
6793// if(idx < 0) then
6794 // idx := PCERootList.IndexOf(FID);
6795 if(idx >= 0) then
6796 PCERootList.Delete(idx);
6797 if PrimaryDiagRoot = Self then
6798 PrimaryDiagRoot := nil;
6799 Free;
6800 end;
6801end;
6802
6803class function TRemPCERoot.GetRoot(Data: TRemData; Rec3: string;
6804 Historical: boolean): TRemPCERoot;
6805var
6806 DID: string;
6807 Idx: integer;
6808 obj: TRemPCERoot;
6809
6810begin
6811 if(Data.DataType = dtVitals) then
6812 DID := 'V' + Piece(Rec3, U, 6)
6813 else
6814 begin
6815 if(Historical) then
6816 begin
6817 inc(HistRootCount);
6818 DID := IntToStr(HistRootCount);
6819 end
6820 else
6821 DID := '0';
6822 DID := DID + U +
6823 Piece(Rec3, U, r3Type) + U +
6824 Piece(Rec3, U, r3Code) + U +
6825 Piece(Rec3, U, r3Cat) + U +
6826 Piece(Rec3, U, r3Nar);
6827 end;
6828 idx := -1;
6829 if(not assigned(PCERootList)) then
6830 PCERootList := TStringList.Create
6831 else
6832 if(PCERootList.Count > 0) then
6833 idx := PCERootList.IndexOf(DID);
6834 if(idx < 0) then
6835 begin
6836 obj := TRemPCERoot.Create;
6837 try
6838 obj.FData := TList.Create;
6839 obj.FID := DID;
6840 idx := PCERootList.AddObject(DID, obj);
6841 except
6842 obj.Free;
6843 raise;
6844 end;
6845 end;
6846 Result := TRemPCERoot(PCERootList.Objects[idx]);
6847 Result.FData.Add(Data);
6848end;
6849
6850function TRemPCERoot.GetValue(PromptType: TRemPromptType; var NewValue: string): boolean;
6851var
6852 ptS: string;
6853 i: integer;
6854
6855begin
6856 ptS := char(ord('D') + ord(PromptType));
6857 i := pos(ptS, FValueSet);
6858 if(i = 0) then
6859 Result := FALSE
6860 else
6861 begin
6862 NewValue := Piece(FValue, U, i);
6863 Result := TRUE;
6864 end;
6865end;
6866
6867procedure TRemPCERoot.Sync(Prompt: TRemPrompt);
6868var
6869 i, j: integer;
6870 RData: TRemData;
6871 Prm: TRemPrompt;
6872 pt: TRemPromptType;
6873 ptS, Value: string;
6874
6875begin
6876// if(assigned(Prompt.FParent) and ((not Prompt.FParent.FChecked) or
6877// (Prompt.FParent.ElemType = etDisplayOnly))) then exit;
6878 if(assigned(Prompt.FParent) and (not Prompt.FParent.FChecked)) then exit;
6879 pt := Prompt.PromptType;
6880 Value := Prompt.GetValue;
6881 if(Prompt.Forced) then
6882 begin
6883 if(not Prompt.FInitializing) then
6884 begin
6885 if(not assigned(FForcedPrompts)) then
6886 FForcedPrompts := TStringList.Create;
6887 if(FForcedPrompts.IndexOfObject(Prompt) < 0) then
6888 begin
6889 for i := 0 to FForcedPrompts.Count-1 do
6890 begin
6891 Prm := TRemPrompt(FForcedPrompts.Objects[i]);
6892 if(pt = Prm.PromptType) and (FForcedPrompts[i] <> Value) and (Prm.FParent.IsChecked) then
6893// raise EForcedPromptConflict.Create('Forced Value Error:' + CRLF + CRLF + <-- original line. //kt 9/5/2007
6894 raise EForcedPromptConflict.Create(DKLangConstW('uReminders_Forced_Value_Errorx') + CRLF + CRLF + //kt added 9/5/2007
6895// Prompt.ForcedCaption + ' is already being forced to another value.'); <-- original line. //kt 9/5/2007
6896 Prompt.ForcedCaption + DKLangConstW('uReminders_is_already_being_forced_to_another_valuex')); //kt added 9/5/2007
6897 end;
6898 FForcedPrompts.AddObject(Value, Prompt);
6899 end;
6900 end;
6901 end
6902 else
6903 begin
6904 if(assigned(FForcedPrompts)) then
6905 begin
6906 for i := 0 to FForcedPrompts.Count-1 do
6907 begin
6908 Prm := TRemPrompt(FForcedPrompts.Objects[i]);
6909 if(pt = Prm.PromptType) and (FForcedPrompts[i] <> Value) and (Prm.FParent.IsChecked) then
6910 begin
6911 Prompt.SetValue(FForcedPrompts[i]);
6912 if(assigned(Prompt.FParent)) then
6913 Prompt.FParent.cbClicked(nil); // Forces redraw
6914 exit;
6915 end;
6916 end;
6917 end;
6918 end;
6919 if(Prompt.FInitializing) then exit;
6920 for i := 0 to FData.Count-1 do
6921 inc(TRemData(FData[i]).FSyncCount);
6922 ptS := char(ord('D') + ord(pt));
6923 i := pos(ptS, FValueSet);
6924 if(i = 0) then
6925 begin
6926 FValueSet := FValueSet + ptS;
6927 i := length(FValueSet);
6928 end;
6929 SetPiece(FValue, U, i, Value);
6930 for i := 0 to FData.Count-1 do
6931 begin
6932 RData := TRemData(FData[i]);
6933 if(RData.FSyncCount = 1) and (assigned(RData.FParent)) and
6934 (assigned(RData.FParent.FPrompts)) then
6935 begin
6936 for j := 0 to RData.FParent.FPrompts.Count-1 do
6937 begin
6938 Prm := TRemPrompt(RData.FParent.FPrompts[j]);
6939 if(Prm <> Prompt) and (pt = Prm.PromptType) and (not Prm.Forced) then
6940 Prm.SetValue(Prompt.GetValue);
6941 end;
6942 end;
6943 end;
6944 for i := 0 to FData.Count-1 do
6945 begin
6946 RData := TRemData(FData[i]);
6947 if(RData.FSyncCount > 0) then
6948 dec(RData.FSyncCount);
6949 end;
6950end;
6951
6952procedure TRemPCERoot.UnSync(Prompt: TRemPrompt);
6953var
6954 idx: integer;
6955
6956begin
6957 if(assigned(FForcedPrompts) and Prompt.Forced) then
6958 begin
6959 idx := FForcedPrompts.IndexOfObject(Prompt);
6960 if(idx >= 0) then
6961 FForcedPrompts.Delete(Idx);
6962 end;
6963end;
6964
6965initialization
6966 InitReminderObjects;
6967
6968finalization
6969 FreeReminderObjects;
6970
6971end.
Note: See TracBrowser for help on using the repository browser.