source: cprs/trunk/CPRS-Chart/Consults/fEditProc.pas@ 498

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

Initial Upload of Official WV CPRS 1.0.26.76
File size: 20.5 KB
RevLine 
[456]1unit fEditProc;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, uConsults, Buttons,
8 Menus;
9
10type
11 TfrmEditProc = class(TForm)
12 cmdAccept: TButton;
13 cmdQuit: TButton;
14 cboUrgency: TORComboBox;
15 radInpatient: TRadioButton;
16 radOutpatient: TRadioButton;
17 cboPlace: TORComboBox;
18 txtProvDiag: TCaptionEdit;
19 txtAttn: TORComboBox;
20 lblProc: TLabel;
21 cboProc: TORComboBox;
22 lblReason: TLabel;
23 lblUrgency: TStaticText;
24 lblPlace: TStaticText;
25 lblAttn: TStaticText;
26 lblProvDiag: TStaticText;
27 cboCategory: TORComboBox;
28 cboService: TORComboBox;
29 lblService: TOROffsetLabel;
30 memComment: TRichEdit;
31 lblComment: TLabel;
32 lblComments: TLabel;
33 pnlMessage: TPanel;
34 imgMessage: TImage;
35 memMessage: TRichEdit;
36 btnCmtCancel: TButton;
37 btnCmtOther: TButton;
38 mnuPopProvDx: TPopupMenu;
39 mnuPopProvDxDelete: TMenuItem;
40 cmdLexSearch: TButton;
41 lblInpOutp: TStaticText;
42 memReason: TRichEdit;
43 popReason: TPopupMenu;
44 popReasonCut: TMenuItem;
45 popReasonCopy: TMenuItem;
46 popReasonPaste: TMenuItem;
47 popReasonPaste2: TMenuItem;
48 popReasonReformat: TMenuItem;
49 procedure txtAttnNeedData(Sender: TObject; const StartFrom: String;
50 Direction, InsertAt: Integer);
51 procedure cboProcNeedData(Sender: TObject; const StartFrom: String;
52 Direction, InsertAt: Integer);
53 procedure radInpatientClick(Sender: TObject);
54 procedure radOutpatientClick(Sender: TObject);
55 procedure ControlChange(Sender: TObject);
56 procedure FormClose(Sender: TObject; var Action: TCloseAction);
57 procedure cboProcSelect(Sender: TObject);
58 procedure memReasonExit(Sender: TObject);
59 procedure cmdAcceptClick(Sender: TObject);
60 procedure cmdQuitClick(Sender: TObject);
61 procedure OrderMessage(const AMessage: string);
62 procedure btnCmtCancelClick(Sender: TObject);
63 procedure btnCmtOtherClick(Sender: TObject);
64 procedure cmdLexSearchClick(Sender: TObject);
65 procedure mnuPopProvDxDeleteClick(Sender: TObject);
66 procedure popReasonCutClick(Sender: TObject);
67 procedure popReasonCopyClick(Sender: TObject);
68 procedure popReasonPasteClick(Sender: TObject);
69 procedure popReasonPopup(Sender: TObject);
70 procedure popReasonReformatClick(Sender: TObject);
71 procedure memCommentKeyUp(Sender: TObject; var Key: Word;
72 Shift: TShiftState);
73 procedure memReasonKeyDown(Sender: TObject; var Key: Word;
74 Shift: TShiftState);
75 procedure memReasonKeyPress(Sender: TObject; var Key: Char);
76 private
77 FLastProcID: string;
78 FChanged: boolean;
79 FChanging: boolean;
80 FEditCtrl: TCustomEdit;
81 FNavigatingTab: boolean;
82 procedure SetProvDiagPromptingMode;
83 protected
84 procedure InitDialog;
85 procedure Validate(var AnErrMsg: string);
86 function ValidSave: Boolean;
87 end;
88
89
90function EditResubmitProcedure(FontSize: Integer; ConsultIEN: integer): boolean;
91
92var
93 frmEditProc: TfrmEditProc;
94
95implementation
96
97{$R *.DFM}
98
99uses
100 rConsults, uCore, rCore, fConsults, rODBase, fRptBox, fPCELex, rPCE, ORClasses, clipbrd ;
101
102var
103 OldRec, NewRec: TEditResubmitRec;
104 Defaults: TStringList;
105 uMessageVisible: DWORD;
106 ProvDx: TProvisionalDiagnosis;
107
108const
109 TX_NO_PROC = 'A procedure must be specified.' ;
110 TX_NO_REASON = 'A reason for this procedure must be entered.' ;
111 TX_NO_SERVICE = 'A service must be selected to perform this procedure.';
112 TX_NO_URGENCY = 'An urgency must be specified.';
113 TX_NO_PLACE = 'A place of consultation must be specified';
114 TX_NO_DIAG = 'A provisional diagnosis must be entered for consults to this service.';
115 TX_SELECT_DIAG = 'You must use the "Lexicon" button to select a diagnosis for consults to this service.';
116 TX_INACTIVE_CODE = 'The provisional diagnosis code is not active as of today''s date.' + #13#10 +
117 'Another code must be selected';
118 TC_INACTIVE_CODE = 'Inactive ICD Code';
119
120function EditResubmitProcedure(FontSize: Integer; ConsultIEN: integer): boolean;
121begin
122 Result := False;
123 if ConsultIEN = 0 then exit;
124 FillChar(OldRec, SizeOf(OldRec), 0);
125 FillChar(NewRec, SizeOf(NewRec), 0);
126 FillChar(ProvDx, SizeOf(ProvDx), 0);
127 OldRec := LoadConsultForEdit(ConsultIEN);
128 NewRec.IEN := OldRec.IEN;
129 NewRec.RequestType := OldRec.RequestType;
130 with NewRec do
131 begin
132 RequestReason:= TStringList.Create ;
133 DenyComments:= TStringList.Create ;
134 OtherComments:= TStringList.Create ;
135 NewComments:= TStringList.Create ;
136 end;
137 StatusText('Loading Procedure for Edit');
138 frmEditProc := TfrmEditProc.Create(Application);
139 Defaults := TStringList.Create;
140 try
141 ResizeAnchoredFormToFont(frmEditProc);
142 with frmEditProc do
143 begin
144 FChanged := False;
145 InitDialog;
146 ShowModal ;
147 Result := FChanged ;
148 end ;
149 finally
150 OldRec.RequestReason.Free;
151 OldRec.DenyComments.Free;
152 OldRec.OtherComments.Free;
153 OldRec.NewComments.Free;
154 NewRec.RequestReason.Free;
155 NewRec.DenyComments.Free;
156 NewRec.OtherComments.Free;
157 NewRec.NewComments.Free;
158 Defaults.Free;
159 frmEditProc.Release;
160 end;
161end;
162
163procedure TfrmEditProc.InitDialog;
164var
165 i: integer;
166begin
167 FChanging := True;
168 Defaults := TStringList.Create;
169 Defaults.Assign(ODForProcedures);
170 FLastProcID := '';
171 cboProc.InitLongList(OldRec.ConsultProcName) ;
172 cboProc.SelectByIEN(OldRec.OrderableItem);
173 if cboProc.ItemIndex = -1 then
174 begin
175 cboProc.Items.Insert(0, IntToStr(OldRec.OrderableItem) + U + OldRec.ConsultProcName +
176 U + OldRec.ConsultProcName + U + OldRec.ConsultProc);
177 cboProc.ItemIndex := 0;
178 end;
179 cboProcSelect(Self);
180 txtAttn.InitLongList(OldRec.AttnName) ;
181 if OldRec.Attention > 0 then
182 txtAttn.SelectByIEN(OldRec.Attention)
183 else
184 txtAttn.ItemIndex := -1;
185 cboService.SelectByIEN(OldRec.ToService);
186 if OldRec.InpOutp <> '' then
187 case OldRec.InpOutp[1] of
188 'I': radInpatient.Checked := True; //INPATIENT PROCEDURE
189 'O': radOutpatient.Checked := True; //OUTPATIENT PROCEDURE
190 end
191 else
192 begin
193 if Patient.Inpatient then
194 radInpatient.Checked := True
195 else
196 radOutpatient.Checked := True;
197 end;
198 cboPlace.SelectByID(OldRec.Place);
199 with cboUrgency do for i := 0 to Items.Count-1 do
200 if UpperCase(DisplayText[i]) = UpperCase(OldRec.UrgencyName) then ItemIndex := i;
201 txtProvDiag.Text := OldRec.ProvDiagnosis;
202 ProvDx.Code := OldRec.ProvDxCode;
203 if OldRec.ProvDxCodeInactive then
204 begin
205 InfoBox(TX_INACTIVE_CODE, TC_INACTIVE_CODE, MB_ICONWARNING or MB_OK);
206 ProvDx.CodeInactive := True;
207 end;
208 memReason.Lines.Assign(OldRec.RequestReason);
209 btnCmtCancel.Enabled := (OldRec.DenyComments.Count > 0);
210 btnCmtOther.Enabled := (OldRec.OtherComments.Count > 0);
211 memComment.Clear ;
212 SetProvDiagPromptingMode;
213 FChanging := False;
214 StatusText('');
215end;
216
217procedure TfrmEditProc.Validate(var AnErrMsg: string);
218
219 procedure SetError(const x: string);
220 begin
221 if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
222 AnErrMsg := AnErrMsg + x;
223 end;
224
225begin
226 if cboProc.ItemIEN = 0 then SetError(TX_NO_PROC);
227 if memReason.Lines.Count = 0 then SetError(TX_NO_REASON);
228 if cboService.ItemIEN = 0 then SetError(TX_NO_SERVICE);
229 if cboUrgency.ItemIEN = 0 then SetError(TX_NO_URGENCY);
230 if cboPlace.ItemID = '' then SetError(TX_NO_PLACE);
231 if (ProvDx.Reqd = 'R') and (Length(txtProvDiag.Text) = 0) then
232 begin
233 if ProvDx.PromptMode = 'F' then
234 SetError(TX_NO_DIAG)
235 else
236 SetError(TX_SELECT_DIAG);
237 end;
238 if OldRec.ProvDxCodeInactive and ProvDx.CodeInactive then
239 SetError(TX_INACTIVE_CODE);
240end;
241
242procedure TfrmEditProc.txtAttnNeedData(Sender: TObject;
243 const StartFrom: string; Direction, InsertAt: Integer);
244begin
245 inherited;
246 txtAttn.ForDataUse(SubSetOfPersons(StartFrom, Direction));
247end;
248
249procedure TfrmEditProc.cboProcNeedData(Sender: TObject;
250 const StartFrom: string; Direction, InsertAt: Integer);
251begin
252 inherited;
253 cboProc.ForDataUse(SubSetOfProcedures(StartFrom, Direction));
254end;
255
256procedure TfrmEditProc.radInpatientClick(Sender: TObject);
257begin
258 inherited;
259 cboCategory.Items.Clear;
260 cboCategory.Items.Add('I^Inpatient');
261 cboCategory.SelectById('I');
262 ExtractItems(cboPlace.Items, Defaults, 'Inpt Place');
263 ExtractItems(cboUrgency.Items, Defaults, 'Inpt Proc Urgencies'); //S.GMRCR
264 ControlChange(Self);
265end;
266
267procedure TfrmEditProc.radOutpatientClick(Sender: TObject);
268begin
269 inherited;
270 cboCategory.Items.Clear;
271 cboCategory.Items.Add('O^Outpatient');
272 cboCategory.SelectById('O');
273 ExtractItems(cboPlace.Items, Defaults, 'Outpt Place');
274 ExtractItems(cboUrgency.Items, Defaults, 'Outpt Urgencies'); //S.GMRCO
275 ControlChange(Self);
276end;
277
278procedure TfrmEditProc.ControlChange(Sender: TObject);
279begin
280 if FChanging then exit;
281 with NewRec do
282 begin
283 with cboProc do if ItemIEN > 0 then
284 if Piece(Items[ItemIndex], U, 4) <> OldRec.ConsultProc then
285 begin
286 ConsultProc := Piece(Items[ItemIndex], U, 4);
287 ConsultProcName := Text;
288 end
289 else
290 begin
291 ConsultProc := '';
292 ConsultProcName := '';
293 end;
294
295 with cboService do if ItemIEN > 0 then
296 if ItemIEN <> OldRec.ToService then
297 begin
298 ToService := ItemIEN;
299 ToServiceName := Text;
300 end
301 else
302 begin
303 ToService := 0;
304 ToServiceName := '';
305 end;
306
307 with cboCategory do if Length(ItemID) > 0 then
308 if ItemID <> OldRec.InpOutP then
309 InpOutP := ItemID
310 else
311 InpOutP := '';
312
313 with cboUrgency do if ItemIEN > 0 then
314 if StrToIntDef(Piece(Items[ItemIndex], U, 3), 0) <> OldRec.Urgency then
315 begin
316 Urgency := StrToIntDef(Piece(Items[ItemIndex], U, 3), 0);
317 UrgencyName := Text;
318 end
319 else
320 begin
321 Urgency := 0;
322 UrgencyName := '';
323 end;
324
325
326 with cboPlace do if Length(ItemID) > 0 then
327 if ItemID <> OldRec.Place then
328 begin
329 Place := ItemID;
330 PlaceName := Text;
331 end
332 else
333 begin
334 Place := '';
335 PlaceName := '';
336 end;
337
338 with txtAttn do
339 if ItemIEN > 0 then
340 begin
341 if ItemIEN <> OldRec.Attention then
342 begin
343 Attention := ItemIEN;
344 AttnName := Text;
345 end
346 else
347 begin
348 Attention := 0;
349 AttnName := '';
350 end;
351 end
352 else // blank
353 begin
354 if OldRec.Attention > 0 then
355 begin
356 Attention := -1;
357 AttnName := '';
358 end
359 else
360 begin
361 Attention := 0;
362 AttnName := '';
363 end;
364 end;
365
366 with txtProvDiag do
367 if Length(Text) > 0 then
368 begin
369 if Text <> OldRec.ProvDiagnosis then
370 ProvDiagnosis := Text
371 else
372 ProvDiagnosis := '';
373
374 if ProvDx.Code <> OldRec.ProvDxCode then
375 ProvDxCode := ProvDx.Code
376 else
377 ProvDxCode := '';
378
379 if OldRec.ProvDxCodeInactive then
380 ProvDx.CodeInactive := (ProvDx.Code = OldRec.ProvDxCode);
381 end
382 else //blank
383 begin
384 ProvDx.Code := '';
385 ProvDx.CodeInactive := False;
386 if OldRec.ProvDiagnosis <> '' then
387 ProvDiagnosis := '@'
388 else
389 ProvDiagnosis := '';
390 end;
391
392 with memReason do if Lines.Count > 0 then
393 if Lines.Equals(OldRec.RequestReason) then
394 RequestReason.Clear
395 else
396 RequestReason.Assign(Lines);
397
398 with memComment do
399 if GetTextLen > 0 then
400 NewComments.Assign(Lines)
401 else
402 NewComments.Clear;
403 end;
404end;
405
406procedure TfrmEditProc.FormClose(Sender: TObject; var Action: TCloseAction);
407const
408 TX_ACCEPT = 'Resubmit this request?' + CRLF + CRLF;
409 TX_ACCEPT_CAP = 'Unsaved Changes';
410begin
411 if FChanged then
412 if InfoBox(TX_ACCEPT, TX_ACCEPT_CAP, MB_YESNO) = ID_YES then
413 if not ValidSave then Action := caNone;
414end;
415
416function TfrmEditProc.ValidSave: Boolean;
417const
418 TX_NO_SAVE = 'This request cannot be saved for the following reason(s):' + CRLF + CRLF;
419 TX_NO_SAVE_CAP = 'Unable to Save Request';
420 TX_SAVE_ERR = 'Unexpected error - it was not possible to save this request.';
421var
422 ErrMsg: string;
423begin
424 Result := True;
425 Validate(ErrMsg);
426 if Length(ErrMsg) > 0 then
427 begin
428 InfoBox(TX_NO_SAVE + ErrMsg, TX_NO_SAVE_CAP, MB_OK);
429 Result := False;
430 end;
431 if (ProvDx.Reqd = 'R') and (Length(txtProvDiag.Text) = 0) and (ProvDx.PromptMode = 'L') then
432 cmdLexSearchClick(Self);
433end;
434
435procedure TfrmEditProc.cboProcSelect(Sender: TObject);
436begin
437 inherited;
438 with cboProc do
439 begin
440 if ItemIndex = -1 then Exit;
441 if ItemID <> FLastProcID then FLastProcID := ItemID else Exit;
442 with cboService do
443 begin
444 Clear;
445 Items.Assign(GetProcedureServices(cboProc.ItemIEN));
446 if Items.Count > 0 then
447 begin
448 ItemIndex := 0 ;
449 NewRec.ToService := ItemIEN;
450 NewRec.ToServiceName := Text;
451 end
452 else
453 begin
454 InfoBox('There are no services defined for this procedure.',
455 'Information', MB_OK or MB_ICONINFORMATION);
456 cboProc.ItemIndex := -1;
457 InitDialog;
458 Exit ;
459 end;
460 end;
461 end;
462 OrderMessage(ConsultMessage(cboProc.ItemIEN));
463 ControlChange(Self) ;
464end;
465
466procedure TfrmEditProc.memReasonExit(Sender: TObject);
467var
468 AStringList: TStringList;
469begin
470 inherited;
471 AStringList := TStringList.Create;
472 try
473 AStringList.Assign(memReason.Lines);
474 LimitStringLength(AStringList, 74);
475 memReason.Lines.Assign(AstringList);
476 ControlChange(Self);
477 finally
478 AStringList.Free;
479 end;
480end;
481
482procedure TfrmEditProc.cmdAcceptClick(Sender: TObject);
483begin
484 if ValidSave then
485 begin
486 FChanged := (ResubmitConsult(NewRec) = '0');
487 Close;
488 end;
489end;
490
491procedure TfrmEditProc.cmdQuitClick(Sender: TObject);
492begin
493 inherited;
494 FChanged := False;
495 Close;
496end;
497
498procedure TfrmEditProc.OrderMessage(const AMessage: string);
499begin
500 memMessage.Lines.SetText(PChar(AMessage));
501 if ContainsVisibleChar(AMessage) then
502 begin
503 pnlMessage.Visible := True;
504 pnlMessage.BringToFront;
505 uMessageVisible := GetTickCount;
506 end
507 else pnlMessage.Visible := False;
508end;
509
510procedure TfrmEditProc.btnCmtCancelClick(Sender: TObject);
511begin
512 ReportBox(OldRec.DenyComments, 'Cancellation Comments', False);
513end;
514
515procedure TfrmEditProc.btnCmtOtherClick(Sender: TObject);
516begin
517 ReportBox(OldRec.OtherComments, 'Added Comments', False);
518end;
519
520
521
522procedure TfrmEditProc.cmdLexSearchClick(Sender: TObject);
523var
524 Match: string;
525 i: integer;
526begin
527 inherited;
528 LexiconLookup(Match, LX_ICD);
529 if Match = '' then Exit;
530 ProvDx.Code := Piece(Match, U, 1);
531 ProvDx.Text := Piece(Match, U, 2);
532 i := Pos(' (ICD', ProvDx.Text);
533 if i = 0 then i := Length(ProvDx.Text) + 1;
534 if ProvDx.Text[i-1] = '*' then i := i - 2;
535 ProvDx.Text := Copy(ProvDx.Text, 1, i - 1);
536 txtProvDiag.Text := ProvDx.Text + ' (' + ProvDx.Code + ')';
537 ProvDx.CodeInactive := False;
538end;
539
540procedure TfrmEditProc.SetProvDiagPromptingMode;
541const
542 TX_USE_LEXICON = 'You must use the "Lexicon" button to select a provisional diagnosis for this service.';
543 TX_PROVDX_OPT = 'Provisional Diagnosis';
544 TX_PROVDX_REQD = 'Provisional Dx (REQUIRED)';
545begin
546 cmdLexSearch.Enabled := False;
547 txtProvDiag.Enabled := False;
548 txtProvDiag.ReadOnly := True;
549 txtProvDiag.Color := clBtnFace;
550 txtProvDiag.Font.Color := clBtnText;
551 lblProvDiag.Enabled := False;
552 txtProvDiag.Hint := '';
553 if cboProc.ItemIEN = 0 then Exit;
554 //GetProvDxMode(ProvDx, cboService.ItemID);
555 GetProvDxMode(ProvDx, Piece(cboProc.Items[cboProc.ItemIndex], U, 4));
556 // Returns: string A^B
557 // A = O (optional), R (required) or S (suppress)
558 // B = F (free-text) or L (lexicon)
559 with ProvDx do if (Reqd = '') or (PromptMode = '') then Exit;
560 if ProvDx.Reqd = 'R' then
561 lblProvDiag.Caption := TX_PROVDX_REQD
562 else
563 lblProvDiag.Caption := TX_PROVDX_OPT;
564 if ProvDx.Reqd = 'S' then
565 begin
566 cmdLexSearch.Enabled := False;
567 txtProvDiag.Enabled := False;
568 txtProvDiag.ReadOnly := True;
569 txtProvDiag.Color := clBtnFace;
570 txtProvDiag.Font.Color := clBtnText;
571 lblProvDiag.Enabled := False;
572 end
573 else
574 case ProvDx.PromptMode[1] of
575 'F': begin
576 cmdLexSearch.Enabled := False;
577 txtProvDiag.Enabled := True;
578 txtProvDiag.ReadOnly := False;
579 txtProvDiag.Color := clWindow;
580 txtProvDiag.Font.Color := clWindowText;
581 lblProvDiag.Enabled := True;
582 end;
583 'L': begin
584 cmdLexSearch.Enabled := True;
585 txtProvDiag.Enabled := True;
586 txtProvDiag.ReadOnly := True;
587 txtProvDiag.Color := clInfoBk;
588 txtProvDiag.Font.Color := clInfoText;
589 lblProvDiag.Enabled := True;
590 txtProvDiag.Hint := TX_USE_LEXICON;
591 end;
592 end;
593end;
594
595procedure TfrmEditProc.mnuPopProvDxDeleteClick(Sender: TObject);
596begin
597 inherited;
598 ProvDx.Text := '';
599 ProvDx.Code := '';
600 ProvDx.CodeInactive := False;
601 txtProvDiag.Text := '';
602 ControlChange(Self);
603end;
604
605procedure TfrmEditProc.popReasonPopup(Sender: TObject);
606begin
607 inherited;
608 if PopupComponent(Sender, popReason) is TCustomEdit
609 then FEditCtrl := TCustomEdit(PopupComponent(Sender, popReason))
610 else FEditCtrl := nil;
611 if FEditCtrl <> nil then
612 begin
613 popReasonCut.Enabled := FEditCtrl.SelLength > 0;
614 popReasonCopy.Enabled := popReasonCut.Enabled;
615 popReasonPaste.Enabled := (not TORExposedCustomEdit(FEditCtrl).ReadOnly) and
616 Clipboard.HasFormat(CF_TEXT);
617 end else
618 begin
619 popReasonCut.Enabled := False;
620 popReasonCopy.Enabled := False;
621 popReasonPaste.Enabled := False;
622 end;
623 popReasonReformat.Enabled := True;
624end;
625
626procedure TfrmEditProc.popReasonCutClick(Sender: TObject);
627begin
628 inherited;
629 FEditCtrl.CutToClipboard;
630end;
631
632procedure TfrmEditProc.popReasonCopyClick(Sender: TObject);
633begin
634 inherited;
635 FEditCtrl.CopyToClipboard;
636end;
637
638procedure TfrmEditProc.popReasonPasteClick(Sender: TObject);
639begin
640 inherited;
641 FEditCtrl.SelText := Clipboard.AsText;
642end;
643
644procedure TfrmEditProc.popReasonReformatClick(Sender: TObject);
645begin
646 if (Screen.ActiveControl <> memReason) and
647 (Screen.ActiveControl <> memComment)then Exit;
648 ReformatMemoParagraph(TCustomMemo(FEditCtrl));
649end;
650
651
652procedure TfrmEditProc.memCommentKeyUp(Sender: TObject; var Key: Word;
653 Shift: TShiftState);
654begin
655 if FNavigatingTab then
656 begin
657 if ssShift in Shift then
658 FindNextControl(Sender as TWinControl, False, True, False).SetFocus //previous control
659 else if ssCtrl in Shift then
660 FindNextControl(Sender as TWinControl, True, True, False).SetFocus; //next control
661 end;
662 if (key = VK_ESCAPE) then begin
663 FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
664 key := 0;
665 end;
666end;
667
668procedure TfrmEditProc.memReasonKeyDown(Sender: TObject; var Key: Word;
669 Shift: TShiftState);
670begin
671 //The navigating tab controls were inadvertantently adding tab characters
672 //This should fix it
673 FNavigatingTab := (Key = VK_TAB) and ([ssShift,ssCtrl] * Shift <> []);
674 if FNavigatingTab then
675 Key := 0;
676end;
677
678procedure TfrmEditProc.memReasonKeyPress(Sender: TObject; var Key: Char);
679begin
680 if FNavigatingTab then
681 Key := #0; //Disable shift-tab processing
682end;
683
684end.
685
686
Note: See TracBrowser for help on using the repository browser.