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

Last change on this file since 476 was 453, checked in by Kevin Toppenberg, 16 years ago

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