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

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

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