source: cprs/branches/tmg-cprs/CPRS-Chart/Consults/fEditProc.pas@ 834

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

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