source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fODRad.pas@ 1011

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

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