source: cprs/branches/tmg-cprs/CPRS-Chart/Consults/fEditConsult.pas@ 697

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

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