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

Last change on this file since 924 was 830, checked in by Kevin Toppenberg, 14 years ago

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