source: cprs/branches/foia-cprs/CPRS-Chart/Consults/fODProc.pas@ 459

Last change on this file since 459 was 459, checked in by Kevin Toppenberg, 17 years ago

Adding foia-cprs branch
File size: 25.9 KB
Line 
1unit fODProc;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 fODBase, StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, Buttons,
8 Menus;
9
10type
11 TfrmODProc = class(TfrmODBase)
12 cboUrgency: TORComboBox;
13 cboPlace: TORComboBox;
14 txtProvDiag: TCaptionEdit;
15 txtAttn: TORComboBox;
16 lblProc: TLabel;
17 cboProc: TORComboBox;
18 lblUrgency: TStaticText;
19 lblPlace: TStaticText;
20 lblAttn: TStaticText;
21 lblProvDiag: TStaticText;
22 cboCategory: TORComboBox;
23 cboService: TORComboBox;
24 lblService: TOROffsetLabel;
25 mnuPopProvDx: TPopupMenu;
26 mnuPopProvDxDelete: TMenuItem;
27 cmdLexSearch: TButton;
28 popReason: TPopupMenu;
29 popReasonCut: TMenuItem;
30 popReasonCopy: TMenuItem;
31 popReasonPaste: TMenuItem;
32 popReasonPaste2: TMenuItem;
33 popReasonReformat: TMenuItem;
34 pnlReason: TPanel;
35 memReason: TCaptionRichEdit;
36 lblReason: TLabel;
37 gbInptOpt: TGroupBox;
38 radInpatient: TRadioButton;
39 radOutpatient: TRadioButton;
40 procedure FormCreate(Sender: TObject);
41 procedure txtAttnNeedData(Sender: TObject; const StartFrom: String;
42 Direction, InsertAt: Integer);
43 procedure cboProcNeedData(Sender: TObject; const StartFrom: String;
44 Direction, InsertAt: Integer);
45 procedure radInpatientClick(Sender: TObject);
46 procedure radOutpatientClick(Sender: TObject);
47 procedure ControlChange(Sender: TObject);
48 procedure cboProcSelect(Sender: TObject);
49 procedure memReasonExit(Sender: TObject);
50 procedure cmdLexSearchClick(Sender: TObject);
51 procedure cboServiceChange(Sender: TObject);
52 procedure mnuPopProvDxDeleteClick(Sender: TObject);
53 procedure txtProvDiagChange(Sender: TObject);
54 procedure popReasonCutClick(Sender: TObject);
55 procedure popReasonCopyClick(Sender: TObject);
56 procedure popReasonPasteClick(Sender: TObject);
57 procedure popReasonPopup(Sender: TObject);
58 procedure popReasonReformatClick(Sender: TObject);
59 procedure memReasonKeyUp(Sender: TObject; var Key: Word;
60 Shift: TShiftState);
61 procedure FormDestroy(Sender: TObject);
62 procedure memReasonKeyDown(Sender: TObject; var Key: Word;
63 Shift: TShiftState);
64 procedure memReasonKeyPress(Sender: TObject; var Key: Char);
65 private
66 FLastProcID: string;
67 FEditCtrl: TCustomEdit;
68 FNavigatingTab: boolean;
69 procedure ReadServerVariables;
70 procedure SetProvDiagPromptingMode;
71 procedure SetupReasonForRequest(OrderAction: integer);
72 procedure GetProvDxandValidateCode(AResponses: TResponses);
73 function ShowPrerequisites: boolean;
74 procedure DoSetFontSize( FontSize: integer);
75 protected
76 procedure InitDialog; override;
77 procedure Validate(var AnErrMsg: string); override;
78 function DefaultReasonForRequest(Service: string; Resolve: Boolean): TStrings;
79 public
80 procedure SetupDialog(OrderAction: Integer; const ID: string); override;
81 procedure SetFontSize( FontSize: integer); override;
82 end;
83
84implementation
85
86{$R *.DFM}
87
88uses
89 rODBase, rConsults, uCore, uConsults, rCore, fConsults, fPCELex, rPCE, ORClasses,
90 clipbrd, fPreReq, uTemplates, uAccessibleRichEdit;
91
92var
93 ProvDx: TProvisionalDiagnosis;
94 GMRCREAF: string;
95
96const
97 TX_NO_PROC = 'A procedure must be specified.' ;
98 TX_NO_REASON = 'A reason for this procedure must be entered.' ;
99 TX_NO_SERVICE = 'A service must be selected to perform this procedure.';
100 TX_NO_URGENCY = 'An urgency must be specified.';
101 TX_NO_PLACE = 'A place of consultation must be specified';
102 TX_NO_DIAG = 'A provisional diagnosis must be entered for consults to this service.';
103 TX_SELECT_DIAG = 'You must use the "Lexicon" button to select a diagnosis for consults to this service.';
104 TC_INACTIVE_CODE = 'Inactive ICD Code';
105 TX_INACTIVE_CODE1 = 'The provisional diagnosis code is not active as of today''s date.' + #13#10;
106 TX_INACTIVE_CODE_REQD = 'Another code must be selected before the order can be saved.';
107 TX_INACTIVE_CODE_OPTIONAL = 'If another code is not selected, no code will be saved.';
108
109procedure TfrmODProc.FormCreate(Sender: TObject);
110begin
111 AutoSizeDisabled := True;
112 inherited;
113 DoSetFontSize(MainFontSize);
114 TAccessibleRichEdit.WrapControl(memReason);
115 AllowQuickOrder := True;
116 FillChar(ProvDx, SizeOf(ProvDx), 0);
117 FillerID := 'GMRC'; // does 'on Display' order check **KCM**
118 StatusText('Loading Dialog Definition');
119 Responses.Dialog := 'GMRCOR REQUEST'; // loads formatting info
120 StatusText('Loading Default Values');
121 CtrlInits.LoadDefaults(ODForProcedures); // ODForProcedures returns TStrings with defaults
122 StatusText('Initializing Long List');
123 ReadServerVariables;
124 cboProc.InitLongList('') ;
125 txtAttn.InitLongList('') ;
126 PreserveControl(txtAttn);
127 PreserveControl(cboProc);
128 InitDialog;
129end;
130
131procedure TfrmODProc.InitDialog;
132begin
133 inherited;
134 Changing := True;
135 FLastProcID := '';
136 with CtrlInits do
137 begin
138 SetControl(cboProc, 'ShortList');
139 cboProc.InsertSeparator;
140 if OrderForInpatient then
141 begin
142 radInpatient.Checked := True; //INPATIENT PROCEDURE
143 cboCategory.Items.Clear;
144 cboCategory.Items.Add('I^Inpatient');
145 cboCategory.SelectById('I');
146 SetControl(cboPlace, 'Inpt Place');
147 SetControl(cboUrgency, 'Inpt Proc Urgencies'); //S.GMRCR
148 end
149 else
150 begin
151 radOutpatient.Checked := True; //OUTPATIENT PROCEDURE
152 cboCategory.Items.Clear;
153 cboCategory.Items.Add('O^Outpatient');
154 cboCategory.SelectById('O');
155 SetControl(cboPlace, 'Outpt Place');
156 SetControl(cboUrgency, 'Outpt Urgencies'); //S.GMRCO
157 end ;
158 end ;
159 txtAttn.ItemIndex := -1;
160 memOrder.Clear ;
161 memReason.Clear;
162 cboProc.Enabled := True;
163 cboProc.Font.Color := clWindowText;
164 //cboService.Enabled := True;
165 //cboService.Font.Color := clWindowText;
166 ActiveControl := cboProc;
167 SetProvDiagPromptingMode;
168 if not ShowPrerequisites then
169 begin
170 Close;
171 Exit;
172 end;
173 StatusText('');
174 Changing := False;
175end;
176
177procedure TfrmODProc.SetupDialog(OrderAction: Integer; const ID: string);
178var
179 tmpResp: TResponse;
180begin
181 inherited;
182 ReadServerVariables;
183 if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses do {*KCM*}
184 begin
185 SetControl(cboProc, 'ORDERABLE', 1);
186 if cboProc.ItemIndex < 0 then exit;
187 cboService.Items.Assign(GetProcedureServices(cboProc.ItemIEN));
188 Changing := True;
189 tmpResp := TResponse(FindResponseByName('CLASS',1));
190 cboCategory.SelectByID(tmpResp.IValue);
191 if tmpResp.IValue = 'I' then
192 radInpatient.Checked := True
193 else
194 radOutpatient.Checked := True ;
195 SetControl(cboUrgency, 'URGENCY', 1);
196 SetControl(cboPlace, 'PLACE', 1);
197 SetControl(txtAttn, 'PROVIDER', 1);
198 cboProc.Enabled := False;
199 cboProc.Font.Color := clGrayText;
200 //SetControl(cboService, 'SERVICE', 1); // to fix OR*3.0*95 bug in v17.6 (RV)
201 tmpResp := TResponse(FindResponseByName('SERVICE',1));
202 if tmpResp <> nil then
203 cboService.SelectByID(Piece(tmpResp.IValue, U, 1))
204 else if (cboService.Items.Count = 1) then
205 cboService.ItemIndex := 0
206 else if (cboService.Items.Count > 1) then
207 cboService.ItemIndex := -1 ;
208 if cboService.ItemIndex > -1 then
209 begin
210 cboService.Enabled := False;
211 cboService.Font.Color := clGrayText;
212 end
213 else
214 begin
215 cboService.Enabled := True;
216 cboService.Font.Color := clWindowText;
217 end;
218 if (OrderAction in [ORDER_COPY, ORDER_QUICK]) and (not ShowPrerequisites) then
219 begin
220 Close;
221 Exit;
222 end;
223 SetProvDiagPromptingMode;
224 GetProvDxandValidateCode(Responses);
225 SetControl(memReason, 'COMMENT', 1);
226 SetupReasonForRequest(OrderAction);
227 Changing := False;
228 OrderMessage(ConsultMessage(cboProc.ItemIEN));
229 ControlChange(Self);
230 end;
231end;
232
233procedure TfrmODProc.Validate(var AnErrMsg: string);
234
235 procedure SetError(const x: string);
236 begin
237 if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
238 AnErrMsg := AnErrMsg + x;
239 end;
240
241begin
242 inherited;
243 if cboProc.ItemIEN = 0 then SetError(TX_NO_PROC);
244 if cboUrgency.ItemIEN = 0 then SetError(TX_NO_URGENCY);
245 if cboPlace.ItemID = '' then SetError(TX_NO_PLACE);
246 if (not ContainsVisibleChar(memReason.Text))
247 then SetError(TX_NO_REASON);
248 if cboService.ItemIEN = 0 then SetError(TX_NO_SERVICE);
249 if (ProvDx.Reqd = 'R') and (Length(txtProvDiag.Text) = 0) then
250 begin
251 if ProvDx.PromptMode = 'F' then
252 SetError(TX_NO_DIAG)
253 else
254 SetError(TX_SELECT_DIAG);
255 end;
256end;
257
258procedure TfrmODProc.txtAttnNeedData(Sender: TObject;
259 const StartFrom: string; Direction, InsertAt: Integer);
260begin
261 inherited;
262 txtAttn.ForDataUse(SubSetOfPersons(StartFrom, Direction));
263end;
264
265procedure TfrmODProc.cboProcNeedData(Sender: TObject;
266 const StartFrom: string; Direction, InsertAt: Integer);
267begin
268 inherited;
269 cboProc.ForDataUse(SubSetOfProcedures(StartFrom, Direction));
270end;
271
272procedure TfrmODProc.radInpatientClick(Sender: TObject);
273begin
274 inherited;
275 with CtrlInits do
276 begin
277 SetControl(cboPlace, 'Inpt Place');
278 SetControl(cboUrgency, 'Inpt Proc Urgencies');
279 cboCategory.Items.Clear;
280 cboCategory.Items.Add('I^Inpatient') ;
281 cboCategory.SelectById('I');
282 end ;
283 ControlChange(Self);
284end;
285
286procedure TfrmODProc.radOutpatientClick(Sender: TObject);
287begin
288 inherited;
289 with CtrlInits do
290 begin
291 SetControl(cboPlace, 'Outpt Place');
292 SetControl(cboUrgency, 'Outpt Urgencies');
293 cboCategory.Items.Clear;
294 cboCategory.Items.Add('O^Outpatient');
295 cboCategory.SelectById('O');
296 end ;
297 ControlChange(Self);
298end;
299
300procedure TfrmODProc.ControlChange(Sender: TObject);
301var
302 x: string;
303 i: integer;
304begin
305 inherited;
306 if Changing or (cboProc.ItemIEN = 0) then Exit;
307 with cboProc do
308 begin
309 if ItemIEN > 0 then
310 begin
311 i := Pos('<', Text);
312 if i > 0 then
313 begin
314 x := Piece(Copy(Text, i + 1, 99), '>', 1);
315 x := UpperCase(Copy(x, 1, 1)) + Copy(x, 2, 99);
316 end
317 else
318 x := Text;
319 Responses.Update('ORDERABLE', 1, ItemID, x);
320 end
321 else Responses.Update('ORDERABLE', 1, '', '');
322 end;
323(* with cboProc do if ItemIEN > 0 then Responses.Update('ORDERABLE', 1, ItemID, Text)
324 else Responses.Update('ORDERABLE', 1, '', '');*)
325 with cboService do if ItemIEN > 0 then Responses.Update('SERVICE', 1, ItemID, Text)
326 else Responses.Update('SERVICE', 1, '', '');
327 with memReason do if GetTextLen > 0 then Responses.Update('COMMENT', 1, TX_WPTYPE, Text);
328 with cboCategory do if ItemID <> '' then Responses.Update('CLASS', 1, ItemID, Text);
329 with cboUrgency do if ItemIEN > 0 then Responses.Update('URGENCY', 1, ItemID, Text);
330 with cboPlace do if ItemID <> '' then Responses.Update('PLACE', 1, ItemID, Text);
331 with txtAttn do if ItemIEN > 0 then Responses.Update('PROVIDER', 1, ItemID, Text);
332 if Length(ProvDx.Text) > 0 then Responses.Update('MISC', 1, ProvDx.Text, ProvDx.Text)
333 else Responses.Update('MISC', 1, '', '');
334 if Length(ProvDx.Code) > 0 then Responses.Update('CODE', 1, ProvDx.Code, ProvDx.Code)
335 else Responses.Update('CODE', 1, '', '');
336
337 memOrder.Text := Responses.OrderText;
338end;
339
340procedure TfrmODProc.cboProcSelect(Sender: TObject);
341begin
342 inherited;
343 with cboProc do
344 begin
345 if ItemIndex = -1 then Exit;
346 if ItemID <> FLastProcID then FLastProcID := ItemID else Exit;
347 Changing := True;
348 if Sender <> Self then Responses.Clear; // Sender=Self when called from SetupDialog
349 Changing := False;
350 if CharAt(ItemID, 1) = 'Q' then
351 begin
352 Responses.QuickOrder := ExtractInteger(ItemID);
353 Responses.SetControl(cboProc, 'ORDERABLE', 1);
354 FLastProcID := ItemID;
355 end;
356 with cboService do
357 begin
358 Clear;
359 Items.Assign(GetProcedureServices(cboProc.ItemIEN));
360 if Items.Count > 1 then
361 ItemIndex := -1
362 else if Items.Count = 1 then
363 begin
364 ItemIndex := 0 ;
365 Responses.Update('SERVICE', 1, ItemID, Text);
366 end
367 else
368 begin
369 if Sender = Self then // Sender=Self when called from SetupDialog
370 InfoBox('There are no services defined for this procedure.',
371 'Information', MB_OK or MB_ICONINFORMATION);
372 cboProc.ItemIndex := -1;
373 InitDialog;
374 Exit ;
375 end;
376 end;
377 end;
378 with Responses do if QuickOrder > 0 then
379 begin
380 SetControl(cboProc, 'ORDERABLE', 1);
381 Changing := True;
382 with cboService do
383 begin
384 Items.Assign(GetProcedureServices(cboProc.ItemIEN));
385 if Items.Count > 1 then
386 ItemIndex := -1
387 else if Items.Count = 1 then
388 ItemIndex := 0 ;
389 end;
390 if not ShowPrerequisites then
391 begin
392 Close;
393 Exit;
394 end;
395 SetControl(cboCategory, 'CLASS', 1);
396 if cboCategory.ItemID = 'I' then radInpatient.Checked := True
397 else radOutpatient.Checked := True ;
398 SetControl(cboUrgency, 'URGENCY', 1);
399 SetControl(cboPlace, 'PLACE', 1);
400 SetControl(txtAttn, 'PROVIDER', 1);
401 SetControl(memReason, 'COMMENT', 1);
402// if ((cboProc.ItemIEN > 0) and (Length(memReason.Text) = 0)) then
403// memReason.Lines.Assign(DefaultReasonForRequest(Piece(cboProc.Items[cboProc.ItemIndex], U, 4), True));
404 SetupReasonForRequest(ORDER_QUICK);
405 GetProvDxandValidateCode(Responses);
406 SetControl(cboService, 'SERVICE', 1);
407 cboProc.Enabled := False;
408 cboProc.Font.Color := clGrayText;
409 if cboService.ItemIndex > -1 then
410 begin
411 cboService.Enabled := False;
412 cboService.Font.Color := clGrayText;
413 end
414 else
415 begin
416 cboService.Enabled := True;
417 cboService.Font.Color := clWindowText;
418 end;
419 Changing := False;
420 end
421 else
422 begin
423 if cboProc.ItemIEN > 0 then
424 begin
425 if cboService.ItemIndex > -1 then
426 begin
427 cboService.Enabled := False;
428 cboService.Font.Color := clGrayText;
429 end
430 else
431 begin
432 cboService.Enabled := True;
433 cboService.Font.Color := clWindowText;
434 end;
435 if not ShowPrerequisites then
436 begin
437 Close;
438 Exit;
439 end;
440 memReason.Lines.Assign(DefaultReasonForRequest(Piece(cboProc.Items[cboProc.ItemIndex], U, 4), True));
441 SetupReasonForRequest(ORDER_NEW);
442 end;
443 end;
444 SetProvDiagPromptingMode;
445 OrderMessage(ConsultMessage(cboProc.ItemIEN));
446 ControlChange(Self) ;
447end;
448
449procedure TfrmODProc.memReasonExit(Sender: TObject);
450var
451 AStringList: TStringList;
452begin
453 inherited;
454 AStringList := TStringList.Create;
455 try
456 AStringList.Assign(memReason.Lines);
457 LimitStringLength(AStringList, 74);
458 memReason.Lines.Assign(AstringList);
459 ControlChange(Self);
460 finally
461 AStringList.Free;
462 end;
463end;
464
465procedure TfrmODProc.ReadServerVariables;
466begin
467 if StrToIntDef(KeyVariable['GMRCNOAT'], 0) > 0 then
468 begin
469 txtAttn.Enabled := False;
470 txtAttn.Font.Color := clGrayText;
471 lblAttn.Enabled := False;
472 txtAttn.Color := clBtnFace;
473 end
474 else
475 begin
476 txtAttn.Enabled := True;
477 txtAttn.Font.Color := clWindowText;
478 lblAttn.Enabled := True;
479 txtAttn.Color := clWindow;
480 end;
481
482 if StrToIntDef(KeyVariable['GMRCNOPD'], 0) > 0 then
483 begin
484 cmdLexSearch.Enabled := False;
485 txtProvDiag.Enabled := False;
486 txtProvDiag.Font.Color := clGrayText;
487 lblProvDiag.Enabled := False;
488 txtProvDiag.ReadOnly := True;
489 txtProvDiag.Color := clBtnFace;
490 end
491 else SetProvDiagPromptingMode;
492
493 GMRCREAF := KeyVariable['GMRCREAF'];
494end;
495
496procedure TfrmODProc.cmdLexSearchClick(Sender: TObject);
497var
498 Match: string;
499 i: integer;
500begin
501 inherited;
502 LexiconLookup(Match, LX_ICD);
503 if Match = '' then Exit;
504 ProvDx.Code := Piece(Match, U, 1);
505 ProvDx.Text := Piece(Match, U, 2);
506 i := Pos(' (ICD', ProvDx.Text);
507 if i = 0 then i := Length(ProvDx.Text) + 1;
508 if ProvDx.Text[i-1] = '*' then i := i - 2;
509 ProvDx.Text := Copy(ProvDx.Text, 1, i - 1);
510 txtProvDiag.Text := ProvDx.Text + ' (' + ProvDx.Code + ')';
511 ProvDx.CodeInactive := False;
512end;
513
514procedure TfrmODProc.SetProvDiagPromptingMode;
515const
516 TX_USE_LEXICON = 'You must use the "Lexicon" button to select a provisional diagnosis for this service.';
517 TX_PROVDX_OPT = 'Provisional Diagnosis';
518 TX_PROVDX_REQD = 'Provisional Dx (REQUIRED)';
519begin
520 cmdLexSearch.Enabled := False;
521 txtProvDiag.Enabled := False;
522 txtProvDiag.ReadOnly := True;
523 txtProvDiag.Color := clBtnFace;
524 txtProvDiag.Font.Color := clBtnText;
525 lblProvDiag.Enabled := False;
526 txtProvDiag.Hint := '';
527 if cboProc.ItemIEN = 0 then Exit;
528 //GetProvDxMode(ProvDx, cboService.ItemID);
529 GetProvDxMode(ProvDx, Piece(cboProc.Items[cboProc.ItemIndex], U, 4));
530 // Returns: string A^B
531 // A = O (optional), R (required) or S (suppress)
532 // B = F (free-text) or L (lexicon)
533 with ProvDx do if (Reqd = '') or (PromptMode = '') then Exit;
534 if ProvDx.Reqd = 'R' then
535 lblProvDiag.Caption := TX_PROVDX_REQD
536 else
537 lblProvDiag.Caption := TX_PROVDX_OPT;
538 if ProvDx.Reqd = 'S' then
539 begin
540 cmdLexSearch.Enabled := False;
541 txtProvDiag.Enabled := False;
542 txtProvDiag.ReadOnly := True;
543 txtProvDiag.Color := clBtnFace;
544 txtProvDiag.Font.Color := clBtnText;
545 lblProvDiag.Enabled := False;
546 end
547 else
548 case ProvDx.PromptMode[1] of
549 'F': begin
550 cmdLexSearch.Enabled := False;
551 txtProvDiag.Enabled := True;
552 txtProvDiag.ReadOnly := False;
553 txtProvDiag.Color := clWindow;
554 txtProvDiag.Font.Color := clWindowText;
555 lblProvDiag.Enabled := True;
556 end;
557 'L': begin
558 cmdLexSearch.Enabled := True;
559 txtProvDiag.Enabled := True;
560 txtProvDiag.ReadOnly := True;
561 txtProvDiag.Color := clInfoBk;
562 txtProvDiag.Font.Color := clInfoText;
563 lblProvDiag.Enabled := True;
564 txtProvDiag.Hint := TX_USE_LEXICON;
565 end;
566 end;
567end;
568
569procedure TfrmODProc.cboServiceChange(Sender: TObject);
570begin
571 inherited;
572 //SetProvDiagPromptingMode;
573 ControlChange(Self);
574end;
575
576procedure TfrmODProc.mnuPopProvDxDeleteClick(Sender: TObject);
577begin
578 inherited;
579 ProvDx.Text := '';
580 ProvDx.Code := '';
581 txtProvDiag.Text := '';
582 ControlChange(Self);
583end;
584
585procedure TfrmODProc.txtProvDiagChange(Sender: TObject);
586begin
587 inherited;
588 if ProvDx.PromptMode = 'F' then
589 ProvDx.Text := txtProvDiag.Text;
590 ControlChange(Self);
591end;
592
593procedure TfrmODProc.popReasonPopup(Sender: TObject);
594begin
595 inherited;
596 if PopupComponent(Sender, popReason) is TCustomEdit
597 then FEditCtrl := TCustomEdit(PopupComponent(Sender, popReason))
598 else FEditCtrl := nil;
599 if FEditCtrl <> nil then
600 begin
601 popReasonCut.Enabled := FEditCtrl.SelLength > 0;
602 popReasonCopy.Enabled := popReasonCut.Enabled;
603 popReasonPaste.Enabled := (not TORExposedCustomEdit(FEditCtrl).ReadOnly) and
604 Clipboard.HasFormat(CF_TEXT);
605 end else
606 begin
607 popReasonCut.Enabled := False;
608 popReasonCopy.Enabled := False;
609 popReasonPaste.Enabled := False;
610 end;
611 popReasonReformat.Enabled := True;
612end;
613
614procedure TfrmODProc.popReasonCutClick(Sender: TObject);
615begin
616 inherited;
617 FEditCtrl.CutToClipboard;
618end;
619
620procedure TfrmODProc.popReasonCopyClick(Sender: TObject);
621begin
622 inherited;
623 FEditCtrl.CopyToClipboard;
624end;
625
626procedure TfrmODProc.popReasonPasteClick(Sender: TObject);
627begin
628 inherited;
629 FEditCtrl.SelText := Clipboard.AsText;
630end;
631
632procedure TfrmODProc.popReasonReformatClick(Sender: TObject);
633begin
634 inherited;
635 if Screen.ActiveControl <> memReason then Exit;
636 ReformatMemoParagraph(memReason);
637end;
638
639procedure TfrmODProc.SetupReasonForRequest(OrderAction: integer);
640var
641 EditReason: string;
642
643 procedure EnableReason;
644 begin
645 memReason.Color := clWindow;
646 memReason.Font.Color := clWindowText;
647 memReason.ReadOnly := False;
648 lblReason.Caption := 'Reason for Request';
649 end;
650
651 procedure DisableReason;
652 begin
653 memReason.Color := clInfoBk;
654 memReason.Font.Color := clInfoText;
655 memReason.ReadOnly := True;
656 lblReason.Caption := 'Reason for Request (not editable)';
657 end;
658
659begin
660 if ((OrderAction = ORDER_QUICK) and (cboProc.ItemID <> '') and (Length(memReason.Text) = 0)) then
661 memReason.Lines.Assign(DefaultReasonForRequest(Piece(cboProc.Items[cboProc.ItemIndex], U, 4), True));
662 EditReason := GMRCREAF;
663 if EditReason = '' then EditReason := ReasonForRequestEditable(Piece(cboProc.Items[cboProc.ItemIndex], U, 4));
664 case EditReason[1] of
665 '0': EnableReason;
666 '1': if OrderAction in [ORDER_COPY, ORDER_EDIT] then
667 EnableReason
668 else
669 DisableReason;
670 '2': DisableReason
671 else
672 EnableReason;
673 end;
674end;
675
676function TfrmODProc.ShowPrerequisites: boolean;
677var
678 AList: TStringList;
679const
680 TC_PREREQUISITES = 'Procedure Prerequisites - ';
681begin
682 Result := True;
683 AbortOrder := False;
684 AList := TStringList.Create;
685 try
686 with cboProc do
687 if ItemIEN > 0 then
688 begin
689 Alist.Assign(GetServicePrerequisites(Piece(Items[ItemIndex], U, 4)));
690 if AList.Count > 0 then
691 begin
692 if not DisplayPrerequisites(AList, TC_PREREQUISITES + DisplayText[ItemIndex]) then
693 begin
694 memOrder.Clear;
695 Result := False;
696 AbortOrder := True;
697 //cmdQuitClick(Self);
698 end
699 else Result := True;
700 end;
701 end;
702 finally
703 AList.Free;
704 end;
705end;
706
707function TfrmODProc.DefaultReasonForRequest(Service: string; Resolve: Boolean): TStrings;
708var
709 TmpSL: TStringList;
710 DocInfo: string;
711begin
712 DocInfo := '';
713 TmpSL := TStringList.Create;
714 try
715 Result := GetDefaultReasonForRequest(Piece(cboProc.Items[cboProc.ItemIndex], U, 4), Resolve);
716 TmpSL.Assign(Result);
717 ExecuteTemplateOrBoilerPlate(TmpSL, StrToIntDef(piece(piece(cboProc.Items[cboProc.ItemIndex],U,4),';',1),0),
718 ltProcedure, nil, 'Reason for Request: ' + cboProc.DisplayText[cboProc.ItemIndex], DocInfo);
719 Result.Assign(TmpSL);
720 finally
721 TmpSL.Free;
722 end;
723end;
724
725procedure TfrmODProc.memReasonKeyUp(Sender: TObject; var Key: Word;
726 Shift: TShiftState);
727begin
728 inherited;
729 if FNavigatingTab then
730 begin
731 if ssShift in Shift then
732 FindNextControl(Sender as TWinControl, False, True, False).SetFocus //previous control
733 else if ssCtrl in Shift then
734 FindNextControl(Sender as TWinControl, True, True, False).SetFocus; //next control
735 FNavigatingTab := False;
736 end;
737 if (key = VK_ESCAPE) then begin
738 FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
739 Key := 0;
740 end;
741end;
742
743procedure TfrmODProc.GetProvDxandValidateCode(AResponses: TResponses);
744var
745 tmpDx: TResponse;
746begin
747 with AResponses do
748 begin
749 tmpDx := TResponse(FindResponseByName('MISC',1));
750 if tmpDx <> nil then ProvDx.Text := tmpDx.Evalue;
751 tmpDx := TResponse(FindResponseByName('CODE',1));
752 if (tmpDx <> nil) and (tmpDx.EValue <> '') then
753 begin
754 if IsActiveICDCode(tmpDx.EValue) then
755 ProvDx.Code := tmpDx.Evalue
756 else
757 begin
758 if ProvDx.Reqd = 'R' then
759 InfoBox(TX_INACTIVE_CODE1 + TX_INACTIVE_CODE_REQD, TC_INACTIVE_CODE, MB_ICONWARNING or MB_OK)
760 else
761 InfoBox(TX_INACTIVE_CODE1 + TX_INACTIVE_CODE_OPTIONAL, TC_INACTIVE_CODE, MB_ICONWARNING or MB_OK);
762 ProvDx.Code := '';
763 ProvDx.Text := '';
764 end;
765 end;
766 txtProvDiag.Text := ProvDx.Text;
767 if ProvDx.Code <> '' then txtProvDiag.Text := txtProvDiag.Text + ' (' + ProvDx.Code + ')';
768 end;
769end;
770
771procedure TfrmODProc.FormDestroy(Sender: TObject);
772begin
773 inherited;
774 TAccessibleRichEdit.UnwrapControl(memReason);
775end;
776
777procedure TfrmODProc.SetFontSize(FontSize: integer);
778begin
779 inherited;
780 DoSetFontSize(FontSize);
781end;
782
783procedure TfrmODProc.DoSetFontSize(FontSize: integer);
784begin
785 memReason.Width := pnlReason.ClientWidth;
786 memReason.Height := pnlReason.ClientHeight;// - memReason.Height; MAC-0104-61043 - RV
787end;
788
789procedure TfrmODProc.memReasonKeyDown(Sender: TObject; var Key: Word;
790 Shift: TShiftState);
791begin
792 inherited;
793 //The navigating tab controls were inadvertantently adding tab characters
794 //This should fix it
795 FNavigatingTab := (Key = VK_TAB) and ([ssShift,ssCtrl] * Shift <> []);
796 if FNavigatingTab then
797 Key := 0;
798end;
799
800procedure TfrmODProc.memReasonKeyPress(Sender: TObject; var Key: Char);
801begin
802 inherited;
803 if FNavigatingTab then
804 Key := #0; //Disable shift-tab processing
805end;
806
807end.
808
809
Note: See TracBrowser for help on using the repository browser.