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

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

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