source: cprs/trunk/CPRS-Chart/Consults/fODProc.pas@ 1211

Last change on this file since 1211 was 829, checked in by Kevin Toppenberg, 14 years ago

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