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

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

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