source: cprs/trunk/CPRS-Chart/Orders/fODRad.pas

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

Updating the working copy to CPRS version 28
File size: 30.0 KB
Line 
1unit fODRad;
2
3interface
4
5uses
6 SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
7 Forms, Dialogs, StdCtrls, ORCtrls, fODBase, ORFn, ExtCtrls,
8 ComCtrls, uConst, ORDtTm, VA508AccessibilityManager, VA508AccessibilityRouter;
9
10type
11 TfrmODRad = class(TfrmODBase)
12 lblDrug: TLabel;
13 cboProcedure: TORComboBox;
14 cboAvailMod: TORComboBox;
15 lblAvailMod: TLabel;
16 cmdRemove: TButton;
17 calRequestDate: TORDateBox;
18 cboUrgency: TORComboBox;
19 cboTransport: TORComboBox;
20 cboCategory: TORComboBox;
21 chkPreOp: TCheckBox;
22 cboSubmit: TORComboBox;
23 lstLastExam: TORListBox;
24 lblHistory: TLabel;
25 memHistory: TCaptionMemo;
26 lstSelectMod: TORListBox;
27 lblSelectMod: TLabel;
28 lblRequestDate: TLabel;
29 lblUrgency: TLabel;
30 lblTransport: TLabel;
31 lblCategory: TLabel;
32 lblSubmit: TLabel;
33 lblLastExam: TLabel;
34 lblAskSubmit: TLabel;
35 chkIsolation: TCheckBox;
36 FRadCommonCombo: TORListBox;
37 lblImType: TLabel;
38 cboImType: TORComboBox;
39 calPreOp: TORDateBox;
40 lblPreOp: TLabel;
41 pnlLeft: TORAutoPanel;
42 pnlRight: TORAutoPanel;
43 pnlHandR: TPanel;
44 grpPregnant: TGroupBox;
45 radPregnant: TRadioButton;
46 radPregnantNo: TRadioButton;
47 radPregnantUnknown: TRadioButton;
48 lblReason: TLabel;
49 txtReason: TCaptionEdit;
50 pnlRightBase: TORAutoPanel;
51 Submitlbl508: TVA508StaticText;
52 VA508ComponentAccessibility1: TVA508ComponentAccessibility;
53 VA508ComponentAccessibility2: TVA508ComponentAccessibility;
54 procedure cboProcedureNeedData(Sender: TObject;
55 const StartFrom: string; Direction, InsertAt: Integer);
56 procedure cboAvailModMouseClick(Sender: TObject);
57 procedure cmdRemoveClick(Sender: TObject);
58 procedure ControlChange(Sender: TObject);
59 procedure cboProcedureSelect(Sender: TObject);
60 procedure SetModifierList;
61 procedure cboCategoryChange(Sender: TObject);
62 procedure FormCreate(Sender: TObject);
63 procedure cboImTypeChange(Sender: TObject);
64 procedure memHistoryExit(Sender: TObject);
65 procedure FormResize(Sender: TObject);
66 procedure cboAvailModKeyDown(Sender: TObject; var Key: Word;
67 Shift: TShiftState);
68 procedure calPreOpChange(Sender: TObject);
69 procedure cmdAcceptClick(Sender: TObject);
70 procedure cboProcedureExit(Sender: TObject);
71 procedure cboImTypeExit(Sender: TObject);
72 procedure FormClose(Sender: TObject; var Action: TCloseAction);
73 procedure chkIsolationExit(Sender: TObject);
74 procedure calPreOpExit(Sender: TObject);
75 procedure cboImTypeDropDownClose(Sender: TObject);
76 procedure pnlMessageExit(Sender: TObject);
77 procedure VA508ComponentAccessibility1StateQuery(Sender: TObject;
78 var Text: string);
79 procedure pnlMessageMouseUp(Sender: TObject; Button: TMouseButton;
80 Shift: TShiftState; X, Y: Integer);
81 private
82 FLastRadID: string;
83 FEditCopy: boolean;
84 FPreOpDate: string;
85 FEvtDelayDiv: string;
86 FPredefineOrder: boolean;
87 ImageTypeChanged : boolean;
88 FFormFirstOpened: boolean;
89 function NoPregnantSelection : Boolean;
90 procedure ImageTypeChange;
91 procedure FormFirstOpened(Sender: TObject);
92 procedure setup508Label(text: string; lbl: TVA508StaticText; ctrl: TControl);
93 protected
94 procedure InitDialog; override;
95 procedure Validate(var AnErrMsg: string); override;
96 procedure SetDefaultPregant;
97 public
98 procedure SetupDialog(OrderAction: Integer; const ID: string); override;
99 end;
100
101implementation
102
103{$R *.DFM}
104
105uses rODBase, rODRad, rOrders, uCore, rCore, fODRadApproval, fODRadConShRes, fLkUpLocation, fFrame,
106 uFormMonitor;
107
108const
109 TX_NO_PROC = 'An Imaging Procedure must be specified.' ;
110 TX_NO_MODE = 'A mode of transport must be selected.';
111 TX_NO_REASON = 'A Reason for Study must be entered.' ;
112 TX_BAD_HISTORY = 'An incomplete or invalid Clinical History has been entered.' + CRLF +
113 'Please correct or clear.';
114 TX_NO_DATE = 'A "Date Desired" must be specified.' ;
115 TX_BAD_DATE = 'The "Date Desired" you have entered is invalid.';
116 TX_PAST_DATE = '"Date Desired" must not be in the past.';
117 TX_APPROVAL_REQUIRED= 'This procedure requires Radiologist approval.' ;
118 TX_NO_SOURCE = 'A source must be specified for Contract/Sharing/Research patients.';
119 TX_NO_AGREE = 'There are no active agreements of the type specified.';
120 TX_NO_AGREE_CAP = 'No Agreements on file';
121 TX_ORD_LOC = 'Ordering location must be specified if patient type and order category do not match.';
122 TC_REQ_LOC = 'Location Required';
123 TX_LOC_ORDER = 'The selected location will be used to determine the ordering location ' +
124 'when the patient location does not match the specified category.';
125 TX_NO_CATEGORY = 'A category of examination must be specified.';
126 TX_NO_IMAGING_LOCATION = 'A "Submit To" location must be specified.';
127
128var
129 Radiologist, Contract, Research: string ;
130 AName, IsPregnant: string;
131 ALocation, AType: integer;
132
133{ TfrmODBase common methods }
134
135procedure TfrmODRad.SetupDialog(OrderAction: Integer; const ID: string);
136var
137 tmpResp: TResponse;
138 i: integer;
139begin
140 inherited;
141 if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses do
142 begin
143 if (OrderAction = ORDER_QUICK) or (OrderAction = ORDER_EDIT) or (OrderAction = ORDER_COPY) then
144 FPredefineOrder := True;
145 FEditCopy := True;
146 Changing := True;
147 with cboImType do
148 begin
149 FastAssign(SubsetOfImagingTypes, cboImType.Items);
150 for i := 0 to Items.Count-1 do
151 if StrToIntDef(Piece(Items[i],U,4), 0) = DisplayGroup then ItemIndex := i;
152 if OrderAction = ORDER_EDIT then
153 begin
154 Enabled := False;
155 Color := clBtnFace;
156 end;
157 end;
158 if Self.EvtID>0 then
159 FEvtDelayDiv := GetEventDiv1(IntToStr(Self.EvtID));
160 CtrlInits.LoadDefaults(ODForRad(Patient.DFN, FEvtDelayDiv, DisplayGroup)); // ODForRad returns TStrings with defaults
161 InitDialog;
162 SetControl(cboProcedure, 'ORDERABLE', 1);
163 Changing := True;
164 SetModifierList;
165 SetControl(cboUrgency, 'URGENCY', 1);
166 SetControl(cboTransport, 'MODE', 1);
167 SetControl(cboSubmit, 'IMLOC', 1);
168 SetControl(cboCategory, 'CLASS', 1);
169 SetControl(txtReason, 'REASON', 1);
170 SetControl(memHistory, 'COMMENT', 1);
171 SetControl(chkIsolation, 'YN', 1);
172 SetControl(radPregnant, 'PREGNANT', 1);
173 SetControl(calPreOp, 'PREOP', 1);
174 tmpResp := FindResponseByName('START',1);
175 if tmpResp <> nil then
176 begin
177 if ContainsAlpha(tmpResp.IValue) then
178 calRequestDate.Text := tmpResp.IValue
179 else
180 calRequestDate.FMDateTime := StrToFMDateTime(tmpResp.IValue);
181 end;
182 tmpResp := FindResponseByName('PROVIDER',1);
183 if tmpResp <> nil then with tmpResp do if Length(EValue)>0 then Radiologist := IValue + '^' + EValue;
184 if (cboCategory.ItemID = 'C') or (cboCategory.ItemID = 'S') then
185 begin
186 tmpResp := FindResponseByName('CONTRACT',1);
187 if tmpResp <> nil then with tmpResp do
188 if Length(EValue)>0 then
189 begin
190 Contract := IValue + '^' + EValue;
191 Research := '';
192 end;
193 end;
194 if cboCategory.ItemID = 'R' then
195 begin
196 tmpResp := FindResponseByName('RESEARCH',1);
197 if tmpResp <> nil then with tmpResp do
198 if Length(EValue)>0 then
199 begin
200 Research := EValue;
201 Contract := '';
202 end;
203 end;
204 //hds00007460
205 tmpResp := FindResponseByName('PREGNANT',1);
206 if tmpResp <> nil then
207 if Length(tmpResp.EValue)>0 then
208 begin
209 IsPregnant := tmpResp.EValue;
210 if IsPregnant = 'YES' then
211 radPregnant.Checked := True
212 else
213 if IsPregnant = 'NO' then
214 radPregnantNo.Checked := True
215 else
216 if IsPregnant = 'UNKNOWN' then
217 radPregnantUnknown.Checked := True;
218 end;
219 //hds00007460
220 Changing := False;
221 FEditCopy := False;
222 OrderMessage(ImagingMessage(cboProcedure.ItemIEN)) ;
223 ControlChange(Self);
224 FPredefineOrder := False;
225 end;
226end;
227
228procedure TfrmODRad.InitDialog;
229var
230 i: integer;
231 tmplst: TStringList;
232 cboSubmitText: String;
233begin
234 if not FEditCopy then
235 begin
236 inherited;
237 if not ReasonForStudyCarryOn then txtReason.text := '';
238 end;
239
240 FPreOpDate := '';
241 FLastRadID := '';
242 Radiologist := '';
243 Contract := '';
244 Research := '';
245 ALocation := 0;
246 AName := '';
247 AType := 0;
248 FEvtDelayDiv := '';
249 if (Self.EvtID > 0 ) and (FEvtDelayDiv = '') then
250 FEvtDelayDiv := GetEventDiv1(IntToStr(Self.EvtID));
251 with CtrlInits do
252 begin
253 SetControl(cboProcedure, 'ShortList');
254 if cboProcedure.Items.Count > 0 then cboProcedure.InsertSeparator;
255 SetControl(FRadCommonCombo, 'Common Procedures');
256 for i := 0 to FRadCommonCombo.Items.Count-1 do
257 cboProcedure.Items.Add(FRadCommonCombo.Items[i]);
258 if FRadCommonCombo.Items.Count>0 then cboProcedure.InsertSeparator;
259
260 //calRequestDate.Text := 'TODAY'; default removed per E3R #19834 - v27.10 - RV
261 SetControl(cboAvailMod, 'Modifiers');
262 SetControl(cboUrgency, 'Urgencies');
263 SetControl(cboTransport, 'Transport');
264 with cboTransport do if OrderForInpatient
265 then SelectByID('W')
266 else SelectByID('A');
267 SetControl(cboCategory, 'Category');
268 with cboCategory do if OrderForInpatient
269 then SelectByID('I')
270 else SelectByID('O');
271 SetControl(cboSubmit, 'Submit to');
272 SetControl(lblAskSubmit,'Ask Submit') ;
273 if (cboSubmit.Items.Count = 0) then
274 begin
275 cboSubmit.ItemIndex := -1;
276 lblSubmit.Enabled := False;
277 cboSubmit.Enabled := False;
278 //TDP - CQ#19393 cboSubmit 508 changes
279 cboSubmitText := cboSubmit.Text;
280 if cboSubmitText = '' then cboSubmitText := 'No Value';
281 setup508Label(cboSubmitText, Submitlbl508, cboSubmit);
282 cboSubmit.Font.Color := clGrayText;
283 end
284 else if (lblAskSubmit.Caption = 'YES') then
285 begin
286 if (cboSubmit.Items.Count > 1) then
287 begin
288 tmplst := TStringList.Create;
289 try
290 FastAssign(cboSubmit.Items, tmplst);
291 SortByPiece(tmplst, U, 2);
292 FastAssign(tmplst, cboSubmit.Items);
293 finally
294 tmplst.Free;
295 end;
296 cboSubmit.ItemIndex := -1 ;
297 lblSubmit.Enabled := True;
298 cboSubmit.Enabled := True;
299 //TDP - CQ#19393 cboSubmit 508 changes
300 cboSubmitText := cboSubmit.Text;
301 if cboSubmitText = '' then cboSubmitText := 'No Value';
302 setup508Label(cboSubmitText, Submitlbl508, cboSubmit);
303 cboSubmit.Font.Color := clWindowText;
304 end
305 else
306 begin
307 cboSubmit.ItemIndex := 0;
308 lblSubmit.Enabled := False;
309 cboSubmit.Enabled := False;
310 //TDP - CQ#19393 cboSubmit 508 changes
311 cboSubmitText := cboSubmit.Text;
312 if cboSubmitText = '' then cboSubmitText := 'No Value';
313 setup508Label(cboSubmitText, Submitlbl508, cboSubmit);
314 cboSubmit.Font.Color := clGrayText;
315 end;
316 end
317 else if lblAskSubmit.Caption = 'NO' then
318 begin
319 if (cboSubmit.Items.Count = 1) then
320 cboSubmit.ItemIndex := 0
321 else
322 cboSubmit.ItemIndex := -1 ;
323 lblSubmit.Enabled := False;
324 cboSubmit.Enabled := False;
325 //TDP - CQ#19393 cboSubmit 508 changes
326 cboSubmitText := cboSubmit.Text;
327 if cboSubmitText = '' then cboSubmitText := 'No Value';
328 setup508Label(cboSubmitText, Submitlbl508, cboSubmit);
329 cboSubmit.Font.Color := clGrayText;
330 end;
331 chkIsolation.Checked := PatientOnIsolationProcedures(Patient.DFN) ;
332 SetControl(lstLastExam, 'Last 7 Days');
333 end;
334 lstSelectMod.Clear;
335 ControlChange(Self);
336 StatusText('Initializing Long List');
337 cboProcedure.InitLongList('') ;
338 StatusText('');
339end;
340
341procedure TfrmODRad.ControlChange(Sender: TObject);
342var
343 i: integer ;
344begin
345 inherited;
346 if Changing then Exit;
347 Responses.Clear;
348 with cboProcedure do
349 if ItemIEN > 0 then Responses.Update('ORDERABLE', 1, ItemID, Text)
350 else Responses.Update('ORDERABLE', 1, '' , '');
351 //with calRequestDate do if FMDateTime > 0 then RPC call on EVERY character typed in REASON box!!!! (v15)
352 with calRequestDate do if Length(Text) > 0 then
353 Responses.Update('START', 1, Text, Text)
354 else Responses.Update('START', 1, '', '') ;
355 with cboUrgency do if Length(ItemID) > 0 then Responses.Update('URGENCY', 1, ItemID, Text);
356 with cboTransport do if Length(ItemID) > 0 then Responses.Update('MODE', 1, ItemID, Text);
357 with cboCategory do if Length(ItemID) > 0 then Responses.Update('CLASS', 1, ItemID, Text);
358 with cboSubmit do if Length(ItemID) > 0 then Responses.Update('IMLOC', 1, ItemID, Text);
359 with radPregnant do if Checked then Responses.Update('PREGNANT', 1, 'Y' , 'Yes')
360 else if not Enabled then Responses.Update('PREGNANT', 1, '' , '');
361 with radPregnantNo do if Checked then Responses.Update('PREGNANT', 1, 'N' , 'No');
362 with radPregnantUnknown do if Checked then Responses.Update('PREGNANT', 1, 'U' , 'Unknown');
363 with chkIsolation do if Checked then Responses.Update('YN', 1, '1' , 'Yes')
364 else Responses.Update('YN', 1, '0' , 'No');
365 with calPreOp do if Length(Text) > 0 then Responses.Update('PREOP', 1, FPreOpDate, Text);
366 with txtReason do if GetTextLen > 0 then Responses.Update('REASON', 1, Text, Text);
367 with memHistory do if GetTextLen > 0 then Responses.Update('COMMENT', 1, TX_WPTYPE, Text);
368 with lstSelectMod do for i := 0 to Items.Count - 1 do
369 Responses.Update('MODIFIER',i+1, Piece(Items[i],U,1), Piece(Items[i],U,2));
370 Responses.Update('PROVIDER',1, Piece(Radiologist,U,1),Piece(Radiologist,U,2)) ;
371 Responses.Update('CONTRACT',1, Piece(Contract,U,1),Piece(Contract,U,2)) ;
372 Responses.Update('RESEARCH',1, Research, Research) ;
373 if ALocation > 0 then Responses.Update('LOCATION', 1, IntToStr(ALocation), AName)
374 else with Encounter do Responses.Update('LOCATION', 1, IntToStr(Location) , LocationName);
375 memOrder.Text := Responses.OrderText;
376end;
377
378//TDP - CQ#19393 Made history memobox read text
379procedure TfrmODRad.VA508ComponentAccessibility1StateQuery(Sender: TObject;
380 var Text: string);
381begin
382 inherited;
383 Text := memHistory.Text;
384end;
385
386procedure TfrmODRad.Validate(var AnErrMsg: string);
387var
388 i, j: integer;
389 AskLoc: boolean;
390
391 procedure SetError(const x: string);
392 begin
393 if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
394 AnErrMsg := AnErrMsg + x;
395 end;
396
397 procedure GetOrderingLocation(AType: integer);
398 begin
399 ALocation := 0;
400 AName := '';
401 LookupLocation(ALocation, AName, AType, TX_LOC_ORDER);
402 if ALocation = 0 then
403 begin
404 SetError(TX_ORD_LOC);
405 if OrderForInpatient then cboCategory.SelectByID('I') else cboCategory.SelectByID('O');
406 with Encounter do Responses.Update('LOCATION', 1, IntToStr(Location) , LocationName);
407 end
408 else
409 Responses.Update('LOCATION', 1, IntToStr(ALocation), AName);
410 end;
411
412begin
413 inherited ;
414 with cboProcedure do
415 begin
416 if ((Length(Text) = 0) or (ItemIEN <= 0)) then SetError(TX_NO_PROC)
417 else
418 begin
419 if ItemID <> FLastRadID then Responses.Update('PROVIDER',1, '','');
420 if (UpperCase(Piece(Items[ItemIndex],U,4))='Y') and (Radiologist='') then
421 begin
422 SelectApprovingRadiologist(Font.Size, Radiologist);
423 if Radiologist='' then SetError(TX_APPROVAL_REQUIRED)
424 else
425 Responses.Update('PROVIDER',1, Piece(Radiologist,U,1),Piece(Radiologist,U,2)) ;
426 end ;
427 end ;
428 end;
429
430 if Length(txtReason.Text) < 3 then
431 SetError(TX_NO_REASON)
432 else
433 begin
434 j := 0;
435 for i := 1 to Length(txtReason.Text) do
436 begin
437 if txtReason.Text[i] in ['A'..'Z','a'..'z','0'..'9'] then j := j + 1;
438 if not (txtReason.Text[i] in ['A'..'Z','a'..'z','0'..'9']) and (j > 0) then j := 0;
439 if j = 2 then break;
440 end;
441 if j < 2 then SetError(TX_NO_REASON);
442 end;
443
444 if Length(memHistory.Text) > 0 then
445 begin
446 j := 0;
447 for i := 1 to Length(memHistory.Text) do
448 begin
449 if memHistory.Text[i] in ['A'..'Z','a'..'z','0'..'9'] then j := j + 1;
450 if not (memHistory.Text[i] in ['A'..'Z','a'..'z','0'..'9']) and (j > 0) then j := 0;
451 if j = 2 then break;
452 end;
453 if j < 2 then SetError(TX_BAD_HISTORY);
454 end;
455
456 with cboCategory do
457 begin
458 AskLoc := (ALocation = 0);
459 if ((not Patient.Inpatient) and (Self.EvtType = 'A')) then
460 AskLoc := False;
461 if ItemID = '' then SetError(TX_NO_CATEGORY);
462 if (CharAt(ItemID,1) in ['C','S']) and (Contract = '') then SetError(TX_NO_SOURCE);
463 if (CharAt(ItemID, 1) = 'R') and (Research = '') then SetError(TX_NO_SOURCE);
464 if ((CharAt(ItemID, 1) = 'O') and (LocationType(Encounter.Location) = 'W')) then
465 begin
466 if AskLoc then
467 GetOrderingLocation(LOC_OUTP);
468 end
469 else if ((CharAt(ItemID, 1) = 'I') and (not (LocationType(Encounter.Location) = 'W'))) then
470 begin
471 if AskLoc then
472 GetOrderingLocation(LOC_INP);
473 end;
474 end;
475 if Length(cboTransport.Text) = 0 then SetError(TX_NO_MODE);
476
477 with cboSubmit do
478 if Enabled and (ItemIEN = 0)then SetError(TX_NO_IMAGING_LOCATION);
479
480 with calRequestDate do
481 begin
482 if FMDateTime = 0 then
483 SetError(TX_NO_DATE)
484 else if FMDateTime < 0 then
485 SetError(TX_BAD_DATE)
486 else if FMDateTime < FMToday then
487 SetError(TX_PAST_DATE);
488 end;
489
490end;
491
492procedure TfrmODRad.cboProcedureNeedData(Sender: TObject;
493 const StartFrom: string; Direction, InsertAt: Integer);
494
495begin
496 inherited ;
497 cboProcedure.ForDataUse(SubSetOfRadProcs(DisplayGroup, StartFrom, Direction));
498 end;
499
500procedure TfrmODRad.cboAvailModMouseClick(Sender: TObject);
501var
502 x: string;
503 i: integer;
504 Found: boolean;
505begin
506 if (cboAvailMod.Items.Count < 1) or //GE 04-30-05 prevent list index out of bounds when empty
507 (cboAvailMod.ItemIndex < 0) then Exit;
508 Found := False;
509 with cboAvailMod do x := Items[ItemIndex];
510 with lstSelectMod do
511 begin
512 if Items.Count > 0 then
513 for i := 0 to Items.Count - 1 do
514 if Items[i] = x then Found := True;
515 if not Found then
516 begin
517 Items.Add(x);
518 SelectByID(Piece(x, U, 1));
519 end;
520 end;
521 if Piece(x, '^', 2) = 'PORTABLE EXAM' then
522 cboTransport.SelectByID('P');
523 ControlChange(Sender);
524end;
525
526procedure TfrmODRad.cmdRemoveClick(Sender: TObject);
527begin
528 with lstSelectMod do
529 if (SelCount = 0) or (ItemIndex < 0) then exit
530 else
531 begin
532 if Piece(Items[ItemIndex], U, 2) = 'PORTABLE EXAM' then
533 with cboTransport do if OrderForInpatient
534 then SelectByID('W')
535 else SelectByID('A');
536 Items.Delete(ItemIndex);
537 ItemIndex := Items.Count - 1;
538 if ItemIndex > -1 then SelectByID(Piece(Items[ItemIndex], U, 1));
539 end ;
540 ControlChange(Sender);
541end;
542
543procedure TfrmODRad.cboProcedureSelect(Sender: TObject);
544var
545 tmpResp: TResponse;
546begin
547 inherited;
548 with cboProcedure do
549 begin
550 if ItemID <> FLastRadID then
551 begin
552 FLastRadID := ItemID;
553 if FPredefineOrder then
554 FPredefineOrder := False;
555 end else Exit;
556 Changing := True;
557 if Sender <> Self then
558 Responses.Clear; // Sender=Self when called from SetupDialog
559 ClearControl(lstSelectMod);
560 ClearControl(lstLastExam);
561 //ClearControl(memHistory); {WPB-1298-30758}
562 Changing := False;
563 if CharAt(ItemID, 1) = 'Q' then
564 with Responses do
565 begin
566 QuickOrder := ExtractInteger(ItemID);
567 //SetControl(cboProcedure, 'ORDERABLE', 1); //v22.9 - RV
568 //SetModifierList; //v22.9 - RV
569 FLastRadID := ItemID;
570 end;
571 end;
572 with Responses do if QuickOrder > 0 then
573 begin
574 Changing := True;
575 SetControl(cboProcedure, 'ORDERABLE', 1);
576 SetModifierList; //v22.9 - RV
577 SetControl(lstSelectMod, 'MODIFIER', 1);
578 SetControl(cboUrgency, 'URGENCY', 1);
579 SetControl(cboSubmit, 'IMLOC', 1);
580 SetControl(cboTransport, 'MODE', 1);
581 SetControl(cboCategory, 'CLASS', 1);
582 SetControl(txtReason, 'REASON', 1);
583 SetControl(memHistory, 'COMMENT', 1);
584 SetControl(chkIsolation, 'YN', 1);
585 SetControl(radPregnant, 'PREGNANT', 1);
586 SetControl(calPreOp , 'PREOP', 1);
587 tmpResp := FindResponseByName('START',1);
588 if tmpResp <> nil then
589 begin
590 if ContainsAlpha(tmpResp.IValue) then
591 calRequestDate.Text := tmpResp.IValue
592 else
593 calRequestDate.FMDateTime := StrToFMDateTime(tmpResp.IValue);
594 end;
595 Changing := False;
596 end;
597 OrderMessage(ImagingMessage(cboProcedure.ItemIEN)) ;
598 ControlChange(Self);
599end;
600
601procedure TfrmODRad.SetModifierList;
602var
603 i: integer;
604 tmpResp: TResponse;
605begin
606 i := 1;
607 tmpResp := Responses.FindResponseByName('MODIFIER',i);
608 while tmpResp <> nil do
609 begin
610 lstSelectMod.Items.Add(tmpResp.IValue + '^' + tmpResp.EValue);
611 if tmpResp.EValue = 'PORTABLE EXAM' then
612 with cboTransport do SelectByID('P');
613 Inc(i);
614 tmpResp := Responses.FindResponseByName('MODIFIER',i);
615 end ;
616end;
617
618procedure TfrmODRad.cboCategoryChange(Sender: TObject);
619var
620 Source: string;
621begin
622 inherited;
623 if Contract <> '' then Source := Contract
624 else if Research <> '' then Source := Research
625 else Source := '';
626 Contract := '';
627 Research := '';
628 with cboCategory do
629 begin
630 if CharAt(ItemID,1) in ['C','S','R'] then
631 begin
632 SelectSource(Font.Size, CharAt(ItemID,1), Source);
633 if Source = '-1' then
634 InfoBox(TX_NO_AGREE, TX_NO_AGREE_CAP, MB_OK or MB_ICONWARNING)
635 else if CharAt(ItemID,1) in ['C','S'] then
636 Contract := Source
637 else if ItemID='R' then
638 Research := Source;
639 end;
640 end;
641 ControlChange(Self);
642end;
643
644procedure TfrmODRad.FormCreate(Sender: TObject);
645begin
646 FFormFirstOpened := TRUE;
647 ImageTypeChanged := false;
648 frmFrame.pnlVisit.Enabled := false;
649 AutoSizeDisabled := True;
650 inherited;
651 memHistory.Width := pnlHandR.ClientWidth;
652 memHistory.Height := pnlHandR.ClientHeight - memHistory.Top;
653 FillerID := 'RA'; // does 'on Display' order check **KCM**
654 StatusText('Loading Dialog Definition');
655 Responses.Clear;
656 DisplayGroup := 0;
657 AllowQuickOrder := True;
658 Responses.Dialog := 'RA OERR EXAM'; // loads formatting info
659 StatusText('Loading Default Values');
660 FastAssign(SubsetOfImagingTypes, cboImType.Items);
661 if Self.EvtID>0 then
662 FEvtDelayDiv := GetEventDiv1(IntToStr(Self.EvtID));
663 PreserveControl(cboImType);
664 PreserveControl(calRequestDate);
665 PreserveControl(cboUrgency);
666 PreserveControl(cboTransport);
667 PreserveControl(cboSubmit);
668 PreserveControl(cboCategory);
669 PreserveControl(calPreOp);
670 PreserveControl(txtReason);
671 PreserveControl(memHistory); {WPB-1298-30758}
672 if (Patient.Sex <> 'F') then
673 begin
674 //TDP - CQ#19393 change to allow grpPregnant to be tabbed to if screen reader active
675 if ScreenReaderSystemActive then grpPregnant.TabStop := True;
676 radPregnant.Enabled := False;
677 radPregnantNo.Enabled := False;
678 radPregnantUnknown.Enabled := False;
679 end else SetDefaultPregant;
680 FormMonitorBringToFrontEvent(Self, FormFirstOpened);
681end;
682
683{Assigned to cbolmType.OnDropDownClose and cbolmType.OnExit, instead of
684 cbolmType.OnChange, becuase when it is OnChange the delay interfers with
685 Window-Eyes ability to read the drop-down Items.}
686procedure TfrmODRad.cboImTypeChange(Sender: TObject);
687begin
688 inherited;
689 ImageTypeChanged := true;
690end;
691
692procedure TfrmODRad.memHistoryExit(Sender: TObject);
693var
694 AStringList: TStringList;
695begin
696 inherited;
697 AStringList := TStringList.Create;
698 try
699 FastAssign(memHistory.Lines, AStringList);
700 LimitStringLength(AStringList, 74);
701 FastAssign(AstringList, memHistory.Lines);
702 ControlChange(Self);
703 finally
704 AStringList.Free;
705 end;
706end;
707
708procedure TfrmODRad.FormResize(Sender: TObject);
709begin
710 inherited;
711 memHistory.Width := pnlHandR.ClientWidth;
712 memHistory.Height := pnlHandR.ClientHeight - memHistory.Top;
713end;
714
715procedure TfrmODRad.cboAvailModKeyDown(Sender: TObject; var Key: Word;
716 Shift: TShiftState);
717begin
718 inherited;
719 if Key = VK_RETURN then cboAvailModMouseClick(Self);
720end;
721
722procedure TfrmODRad.calPreOpChange(Sender: TObject);
723begin
724 inherited;
725 FPreOpDate := FloatToStr(calPreOp.FMDateTime);
726 ControlChange(Self);
727end;
728
729procedure TfrmODRad.SetDefaultPregant;
730begin
731 if (Patient.Sex = 'F') and ((Patient.Age > 55) or (Patient.Age < 12)) then
732 begin
733 radPregnantNo.Checked := True;
734 grpPregnant.TabStop := False;
735 end;
736end;
737
738procedure TfrmODRad.cmdAcceptClick(Sender: TObject);
739const
740 Txt1 = 'This order can not be saved for the following reason(s):';
741 Txt2 = #13+#13+'A response for the pregnant field must be selected.';
742var
743 NeedCheckPregnant: boolean;
744begin
745 if Patient.Sex = 'F' then
746 begin
747 NeedCheckPregnant := True;
748 if radPregnant.Checked then NeedCheckPregnant := False
749 else if radPregnantNo.Checked then NeedCheckPregnant := False
750 else if radPregnantUnknown.Checked then NeedCheckPregnant := False;
751 if NeedCheckPregnant then
752 begin
753 MessageDlg(Txt1+Txt2, mtWarning,[mbOK],0);
754 Exit;
755 end;
756 end;
757 inherited;
758end;
759
760//TDP - CQ#19393 cboSubmit 508 changes. Can change in future to be generic if needed. (See fODLab.pas)
761procedure TfrmODRad.setup508Label(text: string; lbl: TVA508StaticText; ctrl: TControl);
762begin
763 if ScreenReaderSystemActive and not ctrl.Enabled then begin
764 lbl.Enabled := True;
765 lbl.Visible := True;
766 lbl.Caption := lblSubmit.Caption + '. Read Only. Value is ' + Text;
767 lbl.Width := lblSubmit.Width + 2;
768 end else
769 lbl.Visible := false;
770end;
771
772procedure TfrmODRad.cboProcedureExit(Sender: TObject);
773var
774 i: integer;
775 ModList: TStringList;
776begin
777 inherited;
778 ModList := TStringList.Create;
779 if lstSelectMod.Items.Count > 0 then
780 for i := 0 to lstSelectMod.Count - 1 do
781 ModList.Add(lstSelectMod.Items[i]);
782 cboProcedureSelect(Self);
783 for i := 0 to ModList.Count - 1 do
784 begin
785 lstSelectMod.Items.Add(ModList[i]);
786 lstSelectMod.SelectByID(Piece(ModList[i],U,1));
787 end;
788 with lstSelectMod do
789 for i := 0 to Items.Count - 1 do
790 Responses.Update('MODIFIER',i+1, Piece(Items[i],U,1), Piece(Items[i],U,2));
791 //TDP - Made Order Message next focus if showing and Tab or Entered was pressed
792 if (pnlMessage.Showing) AND ((TabIsPressed()) OR (EnterIsPressed())) then memMessage.SetFocus;
793end;
794
795
796procedure TfrmODRad.cboImTypeExit(Sender: TObject);
797begin
798 inherited;
799 ImageTypeChange;
800end;
801
802procedure TfrmODRad.FormClose(Sender: TObject; var Action: TCloseAction);
803begin
804 inherited;
805 frmFrame.pnlVisit.Enabled := true;
806 FormMonitorBringToFrontEvent(Self, nil);
807end;
808
809procedure TfrmODRad.chkIsolationExit(Sender: TObject);
810begin
811 inherited;
812 //Fix for CQ: 10025
813 if TabIsPressed() then
814 if NoPregnantSelection() then
815 if radPregnant.CanFocus then
816 radPregnant.SetFocus();
817end;
818
819procedure TfrmODRad.calPreOpExit(Sender: TObject);
820begin
821 inherited;
822 //Fix for CQ: 10025
823 if ShiftTabIsPressed() then
824 if NoPregnantSelection() then
825 if radPregnant.CanFocus then
826 radPregnant.SetFocus();
827end;
828
829function TfrmODRad.NoPregnantSelection : Boolean;
830begin
831 result := not ((radPregnant.Checked) or (radPregnantNo.Checked) or (radPregnantUnknown.Checked));
832end;
833
834{TDP - Added to control where focus went now that pnlMessage was being focused
835 out of turn after cboProcedure.}
836procedure TfrmODRad.pnlMessageExit(Sender: TObject);
837begin
838 inherited;
839 if TabIsPressed() then cboAvailMod.SetFocus;
840 if ShiftTabIsPressed() then cboProcedure.SetFocus;
841end;
842
843{TDP - Added to control where focus went now that pnlMessage was being focused
844 out of turn after cboProcedure.}
845procedure TfrmODRad.pnlMessageMouseUp(Sender: TObject; Button: TMouseButton;
846 Shift: TShiftState; X, Y: Integer);
847begin
848 inherited;
849 cboProcedure.SetFocus;
850end;
851
852procedure TfrmODRad.cboImTypeDropDownClose(Sender: TObject);
853begin
854 inherited;
855 ImageTypeChange;
856end;
857
858procedure TfrmODRad.ImageTypeChange;
859begin
860 if not ImageTypeChanged then Exit;
861 ImageTypeChanged := false;
862 if FPredefineOrder then
863 FPredefineOrder := False;
864 if Changing or (cboImtype.ItemIndex = -1) then exit;
865 with cboImType do DisplayGroup := StrToIntDef(Piece(Items[ItemIndex], U, 4), 0) ;
866 if DisplayGroup = 0 then exit;
867 CtrlInits.LoadDefaults(ODForRad(Patient.DFN, FEvtDelayDiv, DisplayGroup)); // ODForRad returns TStrings with defaults
868 FPredefineOrder := False;
869 InitDialog;
870end;
871
872procedure TfrmODRad.FormFirstOpened(Sender: TObject);
873begin
874 if(FFormFirstOpened) then
875 begin
876 FFormFirstOpened := FALSE;
877 with cboImType do
878 if not FEditCopy and (ItemIEN = 0) and (DroppedDown = False) and (Application.Active) then
879 begin
880 cboImType.DroppedDown := TRUE;
881 end;
882 end;
883end;
884
885end.
886
Note: See TracBrowser for help on using the repository browser.