source: cprs/branches/foia-cprs/CPRS-Chart/uReminders.pas@ 459

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

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