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

Last change on this file since 1679 was 1679, checked in by healthsevak, 9 years ago

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