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

Last change on this file since 1787 was 1679, checked in by healthsevak, 10 years ago

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