source: cprs/trunk/CPRS-Chart/uVA508CPRSCompatibility.pas

Last change on this file was 1679, checked in by healthsevak, 9 years ago

Updating the working copy to CPRS version 28

File size: 16.8 KB
Line 
1unit uVA508CPRSCompatibility;
2
3interface
4
5uses
6 SysUtils, Windows, Classes, Controls, Forms, StdCtrls;
7
8procedure QuickCopyWith508Msg(AFrom, ATo: TObject; docType: string = '');
9procedure QuickAddWith508Msg(AFrom, ATo: TObject; docType: string = '');
10procedure FastAssignWith508Msg(source, destination: TStrings; docType: string = '');
11
12procedure SpeakTextInserted(docType: string = '');
13function GetTabText: string;
14procedure SpeakPatient;
15procedure SpeakTabAndPatient;
16
17implementation
18
19uses VA508AccessibilityRouter, VA508AccessibilityManager, ORFn, uDlgComponents,
20 VA508DelphiCompatibility, ORCtrls, fReminderDialog, fTemplateDialog, fFrame,
21 uCore, ORCtrlsVA508Compatibility, mTemplateFieldButton, VA508AccessibilityConst;
22
23type
24 TCPRSParentDialogCheckBox508Manager = class(TORCheckBox508Manager)
25 public
26 constructor Create; override;
27 function GetCaption(Component: TWinControl): string; override;
28 end;
29
30 TCPRSBaseDialogComponent508Manager = class(TVA508ManagedComponentClass)
31 public
32 function GetCaption(Component: TWinControl): string; override;
33 end;
34
35{ TCPRSDialogStaticLabel508Manager = class(TVA508StaticTextManager)
36 public
37 constructor Create; override;
38 function GetCaption(Component: TWinControl): string; override;
39 end;
40 }
41
42 TCPRSDialogEdit508Manager = class(TCPRSBaseDialogComponent508Manager)
43 public
44 constructor Create; override;
45 end;
46
47 TCPRSDialogFieldComboBox508Manager = class(TCPRSBaseDialogComponent508Manager)
48 public
49 constructor Create; override;
50 end;
51
52 TCPRSDialogDateBox508Manager = class(TCPRSBaseDialogComponent508Manager)
53 public
54 constructor Create; override;
55 end;
56
57 TCPRSDialogCheckBox508Manager = class(TORCheckBox508Manager)
58 public
59 constructor Create; override;
60 function GetCaption(Component: TWinControl): string; override;
61 end;
62
63 TCPRSDialogRichEdit508Manager = class(TCPRSBaseDialogComponent508Manager)
64 public
65 constructor Create; override;
66 end;
67
68 TCPRSDialogLabel508Manager = class(TCPRSBaseDialogComponent508Manager)
69 public
70 constructor Create; override;
71 function GetValue(Component: TWinControl): string; override;
72 end;
73
74 TCPRSDialogHyperlink508Manager = class(TCPRSBaseDialogComponent508Manager)
75 public
76 constructor Create; override;
77 function GetValue(Component: TWinControl): string; override;
78 function GetInstructions(Component: TWinControl): string; override;
79 end;
80
81 TCPRSDialogNumberComplexManager = class(TVA508ComplexComponentManager)
82 public
83 constructor Create;
84 procedure Refresh(Component: TWinControl;
85 AccessibilityManager: TVA508AccessibilityManager); override;
86 end;
87
88 TCPRSDialogYearEdit508Manager = class(TVA508ManagedComponentClass)
89 public
90 constructor Create; override;
91 function Redirect(Component: TWinControl; var ManagedType: TManagedType): TWinControl; override;
92 end;
93
94 TCPRSNumberField508Manager = class(TVA508ManagedComponentClass)
95 public
96 constructor Create; override;
97 function GetCaption(Component: TWinControl): string; override;
98 end;
99
100 TCPRSDialogDateCombo508Manager = class(TCPRSBaseDialogComponent508Manager)
101 public
102 constructor Create; override;
103 end;
104
105 TfraTemplateFieldButtonComplexManager = class(TVA508ComplexComponentManager)
106 public
107 constructor Create;
108 procedure Refresh(Component: TWinControl;
109 AccessibilityManager: TVA508AccessibilityManager); override;
110 end;
111
112 TfraTemplateFieldButton508Manager = class(TVA508ManagedComponentClass)
113 public
114 constructor Create; override;
115 function GetValue(Component: TWinControl): string; override;
116 function GetCaption(Component: TWinControl): string; override;
117 function GetComponentName(Component: TWinControl): string; override;
118 function GetInstructions(Component: TWinControl): string; override;
119 end;
120
121 TMentalHealthMemo508Manager = class(TVA508ManagedComponentClass)
122 public
123 constructor Create; override;
124 function GetComponentName(Component: TWinControl): string; override;
125 function GetInstructions(Component: TWinControl): string; override;
126 end;
127
128procedure SpeakTextInserted(docType: string = '');
129begin
130 if docType = '' then
131 GetScreenReader.Speak('text inserted')
132 else
133 GetScreenReader.Speak('text inserted in to ' + docType);
134end;
135
136procedure QuickCopyWith508Msg(AFrom, ATo: TObject; docType: string = '');
137begin
138 QuickCopy(AFrom, ATo);
139 if (AFrom is TStrings) and (TStrings(AFrom).Count > 0) then
140 SpeakTextInserted(docType);
141end;
142
143procedure QuickAddWith508Msg(AFrom, ATo: TObject; docType: string = '');
144begin
145 QuickAdd(AFrom, ATo);
146 if (AFrom is TStrings) and (TStrings(AFrom).Count > 0) then
147 SpeakTextInserted(docType);
148end;
149
150procedure FastAssignWith508Msg(source, destination: TStrings; docType: string = '');
151begin
152 FastAssign(source, destination);
153 if source.Count > 0 then
154 SpeakTextInserted(docType);
155end;
156
157procedure ControlShiftTOverride; forward;
158procedure ControlTabOverride; forward;
159procedure ControlShiftTabOverride; forward;
160
161type
162 TVA508RegistrationScreenReader = class(TVA508ScreenReader);
163
164procedure Register508CompatibilityChanges;
165begin
166 with GetScreenReader do
167 begin
168 RegisterDictionaryChange('<unknown>','unknown');
169 RegisterDictionaryChange('VistA','Vist a');
170 RegisterDictionaryChange('VA','V A');
171 RegisterDictionaryChange('VHA','V H A');
172 RegisterDictionaryChange('HealtheVet','Health E Vet');
173 end;
174 RegisterManagedComponentClass(TCPRSParentDialogCheckBox508Manager.Create);
175// RegisterManagedComponentClass(TCPRSDialogStaticLabel508Manager.Create);
176 RegisterManagedComponentClass(TCPRSDialogEdit508Manager.Create);
177 RegisterManagedComponentClass(TCPRSDialogFieldComboBox508Manager.Create);
178 RegisterManagedComponentClass(TCPRSDialogCheckBox508Manager.Create);
179 RegisterManagedComponentClass(TCPRSDialogRichEdit508Manager.Create);
180 RegisterManagedComponentClass(TCPRSDialogLabel508Manager.Create);
181 RegisterManagedComponentClass(TCPRSNumberField508Manager.Create);
182 RegisterManagedComponentClass(TCPRSDialogHyperlink508Manager.Create);
183 RegisterManagedComponentClass(TfraTemplateFieldButton508Manager.Create);
184 RegisterManagedComponentClass(TCPRSDialogDateBox508Manager.Create);
185 RegisterManagedComponentClass(TCPRSDialogDateCombo508Manager.Create);
186 RegisterManagedComponentClass(TCPRSDialogYearEdit508Manager.Create);
187 RegisterManagedComponentClass(TMentalHealthMemo508Manager.Create);
188
189 RegisterComplexComponentManager(TCPRSDialogNumberComplexManager.Create);
190
191 GetScreenReader.RegisterCustomKeyMapping('Control+Tab', ControlTabOverride,
192 'Advances to the next tab in a tab control',
193 'advances to the next tab in a tab control, when you are inside a control with tabs');
194 GetScreenReader.RegisterCustomKeyMapping('Control+Shift+Tab', ControlShiftTabOverride,
195 'Advances to the previous tab in a tab control',
196 'advances to the previous tab in a tab control, when you are inside a control with tabs');
197 GetScreenReader.RegisterCustomKeyMapping('Control+Shift+T', ControlShiftTOverride,
198 'Announces Chart Tab and Patient Name',
199 'Announces the current CPRS Chart tab and the current patient');
200
201 with TVA508RegistrationScreenReader(GetScreenReader) do
202 begin
203 RegisterCustomClassBehavior(TCPRSDialogParentCheckBox.ClassName, CLASS_BEHAVIOR_CHECK_BOX);
204 RegisterCustomClassBehavior(TCPRSDialogCheckBox.ClassName, CLASS_BEHAVIOR_CHECK_BOX);
205 RegisterCustomClassBehavior(TCPRSDialogRichEdit.ClassName, CLASS_BEHAVIOR_EDIT);
206 RegisterCustomClassBehavior(TCPRSDialogFieldEdit.ClassName, CLASS_BEHAVIOR_EDIT);
207 RegisterCustomClassBehavior(TCPRSDialogComboBox.ClassName, CLASS_BEHAVIOR_EDIT_COMBO);
208 RegisterCustomClassBehavior(TCPRSDialogButton.ClassName, CLASS_BEHAVIOR_BUTTON);
209 RegisterCustomClassBehavior(TCPRSDialogDateBox.ClassName, CLASS_BEHAVIOR_EDIT);
210 RegisterCustomClassBehavior(TCPRSDialogNumber.ClassName, CLASS_BEHAVIOR_EDIT);
211 RegisterCustomClassBehavior(TCPRSNumberField.ClassName, CLASS_BEHAVIOR_EDIT);
212 end;
213
214end;
215
216{ TCPRSDialogCheckBox }
217
218constructor TCPRSParentDialogCheckBox508Manager.Create;
219begin
220 inherited Create(TCPRSDialogParentCheckBox, [mtCaption, mtComponentName, mtInstructions, mtState, mtStateChange]);
221end;
222
223function TCPRSParentDialogCheckBox508Manager.GetCaption(Component: TWinControl): string;
224begin
225 Result := TCPRSDialogParentCheckBox(Component).AccessText;
226end;
227
228type
229 ExposedControl = class(TWinControl);
230
231// CQ #14984
232procedure ControlTabOverride;
233begin
234 if assigned(Screen.ActiveControl) and (Screen.ActiveControl is TCustomMemo) then
235 ExposedControl(Screen.FocusedForm).SelectNext(Screen.ActiveControl, TRUE, TRUE)
236 else
237 begin
238 keybd_event(VK_TAB, 0, 0, VK_CONTROL);
239 keybd_event(VK_TAB, 0, KEYEVENTF_KEYUP, VK_CONTROL);
240 end;
241end;
242
243procedure ControlShiftTabOverride;
244begin
245 if assigned(Screen.ActiveControl) and (Screen.ActiveControl is TCustomMemo) then
246 ExposedControl(Screen.FocusedForm).SelectNext(Screen.ActiveControl, FALSE, TRUE)
247 else
248 begin
249 keybd_event(VK_TAB, 0, 0, (VK_SHIFT * 256) + VK_CONTROL);
250 keybd_event(VK_TAB, 0, KEYEVENTF_KEYUP, (VK_SHIFT * 256) + VK_CONTROL);
251 end;
252end;
253
254procedure ControlShiftTOverride;
255begin
256 SpeakTabAndPatient;
257end;
258
259function GetTabText: string;
260var
261 idx: integer;
262begin
263 Result := '';
264 if assigned(frmFrame) and assigned(frmFrame.tabPage) then
265 begin
266 idx := frmFrame.tabPage.TabIndex;
267 if (idx >= 0) and (idx < uTabList.Count) then
268 begin
269 Result := frmFrame.tabPage.Tabs[idx];
270 if Result = 'D/C Summ' then
271 Result := 'Discharge Summary';
272 end;
273 end;
274end;
275
276procedure SpeakPatient;
277begin
278 //CQ #17491: Associating 508 change that allows JAWS to dictate the patient status indicator along with the name.
279 if assigned(Patient) and (Patient.Name <> '') and (Patient.Status <> '') then
280 GetScreenReader.Speak(Patient.Name + Patient.Status);
281end;
282
283procedure SpeakTabAndPatient;
284var
285 text: string;
286begin
287 text := GetTabText;
288 if text <> '' then
289 text := text + ' tab';
290 if text <> '' then
291 text := text + ', ';
292 //CQ #17491: Associating 508 change that allows JAWS to dictate the patient status indicator along with the name.
293 if assigned(Patient) and (Patient.Name <> '') and (Patient.Status <> '') then
294 text := text + Patient.Name + Patient.Status
295 else
296 text := text + 'no patient selected';
297 if text <> '' then
298 GetScreenReader.Speak(text);
299end;
300
301{ TCPRSDialogComponent508Manager }
302
303function TCPRSBaseDialogComponent508Manager.GetCaption(
304 Component: TWinControl): string;
305begin
306 if Supports(Component, ICPRSDialogComponent) then
307 begin
308 Result := (Component as ICPRSDialogComponent).AccessText;
309 end
310 else
311 Result := '';
312end;
313
314(*
315{ TCPRSDialogStaticLabel508Manager }
316
317constructor TCPRSDialogStaticLabel508Manager.Create;
318begin
319 inherited Create(TCPRSDialogStaticLabel, [mtCaption]);
320end;
321
322function TCPRSDialogStaticLabel508Manager.GetCaption(
323 Component: TWinControl): string;
324var
325 txt: string;
326begin
327 if Supports(Component, ICPRSDialogComponent) then
328 begin
329 Result := (Component as ICPRSDialogComponent).AccessText;
330 end
331 else
332 Result := '';
333 txt := inherited GetCaption(Component);
334 if txt <> '' then
335 begin
336 if Result <> '' then
337 Result := Result + ' ';
338 Result := Result + txt;
339 end;
340end;
341*)
342
343{ TCPRSTemplateFieldEdit508Manager }
344
345constructor TCPRSDialogEdit508Manager.Create;
346begin
347 inherited Create(TCPRSDialogFieldEdit, [mtCaption]);
348end;
349
350{ TCPRSTemplateFieldComboBox508Manager }
351
352constructor TCPRSDialogFieldComboBox508Manager.Create;
353begin
354 inherited Create(TCPRSDialogComboBox, [mtCaption]);
355end;
356
357{ TCPRSTemplateFieldCheckBox508Manager }
358
359constructor TCPRSDialogCheckBox508Manager.Create;
360begin
361 inherited Create(TCPRSDialogCheckBox, [mtCaption, mtComponentName, mtInstructions, mtState, mtStateChange]);
362end;
363
364function TCPRSDialogCheckBox508Manager.GetCaption(
365 Component: TWinControl): string;
366begin
367 if Supports(Component, ICPRSDialogComponent) then
368 begin
369 Result := (Component as ICPRSDialogComponent).AccessText;
370 end
371 else
372 Result := '';
373 Result := Result + ' ' + TCheckBox(Component).Caption;
374end;
375
376{ TCPRSTemplateFieldRichEdit508Manager }
377
378constructor TCPRSDialogRichEdit508Manager.Create;
379begin
380 inherited Create(TCPRSDialogRichEdit, [mtCaption]);
381end;
382
383{ TCPRSTemplateFieldDateCombo508Manager }
384
385constructor TCPRSDialogLabel508Manager.Create;
386begin
387 inherited Create(TCPRSTemplateFieldLabel, [mtCaption, mtValue]);
388end;
389
390function TCPRSDialogLabel508Manager.GetValue(
391 Component: TWinControl): string;
392begin
393 Result := TCPRSTemplateFieldLabel(Component).Caption;
394end;
395
396{ TCPRSTemplateFieldWebLabel508Manager }
397
398constructor TCPRSDialogHyperlink508Manager.Create;
399begin
400 inherited Create(TCPRSDialogHyperlinkLabel, [mtCaption, mtValue, mtInstructions]);
401end;
402
403function TCPRSDialogHyperlink508Manager.GetInstructions(
404 Component: TWinControl): string;
405begin
406 Result := 'To activate press space bar';
407end;
408
409function TCPRSDialogHyperlink508Manager.GetValue(
410 Component: TWinControl): string;
411begin
412 Result := TCPRSDialogHyperlinkLabel(Component).Caption;
413end;
414
415{ TCPRSTemplateFieldNumberComplexManager }
416
417constructor TCPRSDialogNumberComplexManager.Create;
418begin
419 inherited Create(TCPRSDialogNumber);
420end;
421
422procedure TCPRSDialogNumberComplexManager.Refresh(Component: TWinControl;
423 AccessibilityManager: TVA508AccessibilityManager);
424begin
425 with TCPRSDialogNumber(Component) do
426 begin
427 ClearSubControls(Component);
428 if assigned(Edit) then
429 AddSubControl(Component, Edit, AccessibilityManager);
430 end;
431end;
432
433{ TCPRSNumberField508Manager }
434
435constructor TCPRSNumberField508Manager.Create;
436begin
437 inherited Create(TCPRSNumberField, [mtCaption]);
438end;
439
440function TCPRSNumberField508Manager.GetCaption(Component: TWinControl): string;
441begin
442 if assigned(Component.Owner) and Supports(Component.Owner, ICPRSDialogComponent) then
443 begin
444 Result := (Component.Owner as ICPRSDialogComponent).AccessText;
445 end
446 else
447 Result := '';
448end;
449
450{ TfraTemplateFieldButtonComplexManager }
451
452constructor TfraTemplateFieldButtonComplexManager.Create;
453begin
454 inherited Create(TfraTemplateFieldButton);
455end;
456
457procedure TfraTemplateFieldButtonComplexManager.Refresh(Component: TWinControl;
458 AccessibilityManager: TVA508AccessibilityManager);
459begin
460 with TfraTemplateFieldButton(Component) do
461 begin
462 ClearSubControls(Component);
463 AddSubControl(Component, pnlBtn, AccessibilityManager);
464 end;
465end;
466
467{ TfraTemplateFieldButton508Manager }
468
469constructor TfraTemplateFieldButton508Manager.Create;
470begin
471 inherited Create(TfraTemplateFieldButton, [mtComponentName, mtCaption, mtInstructions, mtValue]);
472end;
473
474function TfraTemplateFieldButton508Manager.GetCaption(
475 Component: TWinControl): string;
476begin
477 if assigned(Component) and Supports(Component, ICPRSDialogComponent) then
478 begin
479 Result := (Component as ICPRSDialogComponent).AccessText;
480 end
481 else
482 Result := '';
483end;
484
485function TfraTemplateFieldButton508Manager.GetComponentName(
486 Component: TWinControl): string;
487begin
488 Result := 'multi value button';
489end;
490
491function TfraTemplateFieldButton508Manager.GetInstructions(
492 Component: TWinControl): string;
493begin
494 Result := 'to cycle through values press space bar';
495end;
496
497function TfraTemplateFieldButton508Manager.GetValue(
498 Component: TWinControl): string;
499begin
500 Result := TfraTemplateFieldButton(Component).ButtonText;
501 if Trim(Result) = '' then
502 Result := 'blank';
503end;
504
505{ TCPRSTemplateFieldDateBox508Manager }
506
507constructor TCPRSDialogDateBox508Manager.Create;
508begin
509 inherited Create(TCPRSDialogDateBox, [mtCaption]);
510end;
511
512{ TCPRSDialogYearEdit508Manager }
513
514constructor TCPRSDialogYearEdit508Manager.Create;
515begin
516 inherited Create(TCPRSDialogYearEdit, [mtComponentRedirect]);
517end;
518
519function TCPRSDialogYearEdit508Manager.Redirect(Component: TWinControl;
520 var ManagedType: TManagedType): TWinControl;
521begin
522 ManagedType := mtCaption;
523 Result := TWinControl(Component.Owner);
524end;
525
526{ TCPRSDialogDateCombo508Manager }
527
528constructor TCPRSDialogDateCombo508Manager.Create;
529begin
530 inherited Create(TCPRSDialogDateCombo, [mtCaption]);
531end;
532
533{ TMentalHealthMemo508Manager }
534
535constructor TMentalHealthMemo508Manager.Create;
536begin
537 inherited Create(TMentalHealthMemo, [mtComponentName, mtInstructions]);
538end;
539
540function TMentalHealthMemo508Manager.GetComponentName(
541 Component: TWinControl): string;
542begin
543 Result := ' ';
544end;
545
546function TMentalHealthMemo508Manager.GetInstructions(
547 Component: TWinControl): string;
548begin
549 Result := ' ';
550end;
551
552initialization
553 Register508CompatibilityChanges;
554
555
556end.
Note: See TracBrowser for help on using the repository browser.