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

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

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