source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/Consults/fEditProc.pas@ 1727

Last change on this file since 1727 was 1693, checked in by healthsevak, 10 years ago

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