source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/Consults/fEditConsult.pas@ 1710

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

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