source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fODMedIV.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: 27.9 KB
Line 
1unit fODMedIV;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 fODBase, Grids, StdCtrls, ORCtrls, ComCtrls, ExtCtrls, Buttons, Menus, IdGlobal;
8
9type
10 TfrmODMedIV = class(TfrmODBase)
11 tabFluid: TTabControl;
12 cboSolution: TORComboBox;
13 lblInfusionRate: TLabel;
14 txtRate: TCaptionEdit;
15 lblPriority: TLabel;
16 cboPriority: TORComboBox;
17 lblComponent: TLabel;
18 lblAmount: TLabel;
19 grdSelected: TCaptionStringGrid;
20 cmdRemove: TButton;
21 lblComments: TLabel;
22 memComments: TCaptionMemo;
23 cboAdditive: TORComboBox;
24 txtSelected: TCaptionEdit;
25 cboSelected: TCaptionComboBox;
26 Label1: TStaticText;
27 popDuration: TPopupMenu;
28 popML: TMenuItem;
29 popDays: TMenuItem;
30 popHours: TMenuItem;
31 popL: TMenuItem;
32 pnlXDuration: TPanel;
33 txtXDuration: TCaptionEdit;
34 lblLimit: TLabel;
35 btnXDuration: TSpeedButton;
36 procedure FormCreate(Sender: TObject);
37 procedure tabFluidChange(Sender: TObject);
38 procedure cboAdditiveNeedData(Sender: TObject; const StartFrom: string; Direction,
39 InsertAt: Integer);
40 procedure cboSolutionNeedData(Sender: TObject; const StartFrom: string; Direction,
41 InsertAt: Integer);
42 procedure cboAdditiveMouseClick(Sender: TObject);
43 procedure cboAdditiveExit(Sender: TObject);
44 procedure cboSolutionMouseClick(Sender: TObject);
45 procedure cboSolutionExit(Sender: TObject);
46 procedure FormDestroy(Sender: TObject);
47 procedure cmdRemoveClick(Sender: TObject);
48 procedure FormResize(Sender: TObject);
49 procedure txtSelectedExit(Sender: TObject);
50 procedure cboSelectedExit(Sender: TObject);
51 procedure ControlChange(Sender: TObject);
52 procedure txtSelectedChange(Sender: TObject);
53 procedure cboSelectedChange(Sender: TObject);
54 procedure grdSelectedDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
55 State: TGridDrawState);
56 procedure FormKeyDown(Sender: TObject; var Key: Word;
57 Shift: TShiftState);
58 procedure grdSelectedKeyPress(Sender: TObject; var Key: Char);
59 procedure grdSelectedMouseDown(Sender: TObject; Button: TMouseButton;
60 Shift: TShiftState; X, Y: Integer);
61 procedure btnXDurationClick(Sender: TObject);
62 procedure popDurationClick(Sender: TObject);
63 procedure txtXDurationChange(Sender: TObject);
64 procedure pnlXDurationEnter(Sender: TObject);
65 procedure txtXDurationExit(Sender: TObject);
66 private
67 FInpatient: Boolean;
68 procedure SetValuesFromResponses;
69 procedure DoSetFontSize( FontSize: integer);
70 procedure ClickOnGridCell;
71 procedure SetLimitationControl(aValue: string);
72 public
73 procedure InitDialog; override;
74 procedure SetupDialog(OrderAction: Integer; const ID: string); override;
75 procedure Validate(var AnErrMsg: string); override;
76 procedure SetFontSize( FontSize: integer); override;
77 end;
78
79var
80 frmODMedIV: TfrmODMedIV;
81
82implementation
83
84{$R *.DFM}
85
86uses ORFn, uConst, rODMeds, rODBase, uAccessibleStringGrid;
87
88const
89 TX_NO_DEA = 'Provider must have a DEA# or VA# to order this medication';
90 TC_NO_DEA = 'DEA# Required';
91
92type
93 TIVComponent = class
94 private
95 IEN: Integer;
96 Name: string;
97 Fluid: Char;
98 Amount: Integer;
99 Units: string;
100 Volumes: string;
101 end;
102
103const
104 TC_RESTRICT = 'Ordering Restrictions';
105 TX_NO_BASE = 'A solution must be selected.';
106 TX_NO_AMOUNT = 'A valid strength or volume must be entered for ';
107 TX_NO_UNITS = 'Units must be entered for ';
108 TX_NO_RATE = 'An infusion rate must be entered.';
109 TX_BAD_RATE = 'The infusion rate must be: # ml/hr or text@labels per day';
110
111(*
112 { TIVComponent methods }
113
114procedure TIVComponent.Clear;
115begin
116 IEN := 0;
117 Name := '';
118 Fluid := #0;
119 Amount := 0;
120 Units := '';
121 Volumes := '';
122end;
123*)
124
125{ Form methods }
126
127procedure TfrmODMedIV.FormCreate(Sender: TObject);
128var
129 Restriction: string;
130begin
131 inherited;
132 AllowQuickOrder := True;
133 CheckAuthForMeds(Restriction);
134 if Length(Restriction) > 0 then
135 begin
136 InfoBox(Restriction, TC_RESTRICT, MB_OK);
137 Close;
138 Exit;
139 end;
140 DoSetFontSize(MainFontSize);
141 FillerID := 'PSIV'; // does 'on Display' order check **KCM**
142 StatusText('Loading Dialog Definition');
143 Responses.Dialog := 'PSJI OR PAT FLUID OE'; // loads formatting info
144 StatusText('Loading Default Values');
145 CtrlInits.LoadDefaults(ODForIVFluids); // ODForIVFluids returns TStrings with defaults
146 InitDialog;
147 TAccessibleStringGrid.WrapControl(grdSelected);
148end;
149
150procedure TfrmODMedIV.FormDestroy(Sender: TObject);
151var
152 i: Integer;
153begin
154 TAccessibleStringGrid.UnwrapControl(grdSelected);
155 with grdSelected do for i := 0 to RowCount - 1 do TIVComponent(Objects[0, i]).Free;
156 inherited;
157end;
158
159procedure TfrmODMedIV.FormResize(Sender: TObject);
160begin
161 inherited;
162 with grdSelected do
163 begin
164 ColWidths[1] := Canvas.TextWidth(' 10000 ') + GetSystemMetrics(SM_CXVSCROLL);
165 ColWidths[2] := Canvas.TextWidth('meq.') + GetSystemMetrics(SM_CXVSCROLL);
166 ColWidths[0] := ClientWidth - ColWidths[1] - ColWidths[2] - 4;
167 end;
168 lblAmount.Left := grdSelected.Left + grdSelected.ColWidths[0];
169end;
170
171{ TfrmODBase overrides }
172
173procedure TfrmODMedIV.InitDialog;
174const
175 NOSELECTION: TGridRect = (Left: -1; Top: -1; Right: -1; Bottom: -1);
176var
177 i: Integer;
178begin
179 inherited;
180 //grdSelected.Selection := NOSELECTION;
181 with grdSelected do for i := 0 to RowCount - 1 do
182 begin
183 TIVComponent(Objects[0, i]).Free;
184 Rows[i].Clear;
185 end;
186 grdSelected.RowCount := 1;
187 //txtRate.Text := ' ml/hr'; {*kcm*}
188 with CtrlInits do
189 begin
190 SetControl(cboSolution, 'ShortList');
191 cboSolution.InsertSeparator;
192 SetControl(cboPriority, 'Priorities');
193 end;
194 tabFluid.TabIndex := 0;
195 tabFluidChange(Self); // this makes cboSolution visible
196 cboSolution.InitLongList('');
197 cboAdditive.InitLongList('');
198 ActiveControl := cboSolution; //SetFocusedControl(cboSolution);
199 StatusText('');
200end;
201
202procedure TfrmODMedIV.Validate(var AnErrMsg: string);
203var
204 ItemOK: Boolean;
205 x: string;
206 i: Integer;
207
208 procedure SetError(const x: string);
209 begin
210 if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
211 AnErrMsg := AnErrMsg + x;
212 end;
213
214begin
215 inherited;
216 with grdSelected do
217 begin
218 ItemOK := False;
219 for i := 0 to RowCount - 1 do
220 if TIVComponent(Objects[0, i]).Fluid = 'B' then ItemOK := True;
221 if not ItemOK then SetError(TX_NO_BASE);
222 for i := 0 to RowCount - 1 do
223 begin
224 if (Objects[0, i] <> nil) and ((Length(Cells[1, i]) = 0) or (StrToFloat(Cells[1,i])=0))
225 then SetError(TX_NO_AMOUNT + Cells[0, i]);
226 if (Objects[0, i] <> nil) and (Length(Cells[2, i]) = 0)
227 then SetError(TX_NO_UNITS + Cells[0, i]);
228 end;
229 end;
230 if Length(txtRate.Text) = 0 then SetError(TX_NO_RATE) else
231 begin
232 x := Trim(txtRate.Text);
233 ValidateIVRate(x);
234 if Length(x) = 0 then SetError(TX_BAD_RATE) else Responses.Update('RATE', 1, x, x);
235 end;
236end;
237
238procedure TfrmODMedIV.SetValuesFromResponses;
239var
240 x: string;
241 AnInstance: Integer;
242 AResponse: TResponse;
243 AnIVComponent: TIVComponent;
244begin
245 Changing := True;
246 with Responses do
247 begin
248 FInpatient := OrderForInpatient;
249 AnInstance := NextInstance('ORDERABLE', 0);
250 while AnInstance > 0 do
251 begin
252 AResponse := FindResponseByName('ORDERABLE', AnInstance);
253 if AResponse <> nil then
254 begin
255 x := AmountsForIVFluid(StrToIntDef(AResponse.IValue, 0), 'B');
256 AnIVComponent := TIVComponent.Create;
257 AnIVComponent.IEN := StrToIntDef(AResponse.IValue, 0);
258 if not FInpatient then
259 begin
260 if DEACheckFailedForIVOnOutPatient(AnIVComponent.IEN,'S') then
261 begin
262 InfoBox(TX_NO_DEA, TC_NO_DEA, MB_OK);
263 cboAdditive.Text := '';
264 Exit;
265 end;
266 end else
267 begin
268 if DEACheckFailed(AnIVComponent.IEN, FInpatient) then
269 begin
270 InfoBox(TX_NO_DEA, TC_NO_DEA, MB_OK);
271 cboAdditive.Text := '';
272 Exit;
273 end;
274 end;
275 AnIVComponent.Name := AResponse.EValue;
276 AnIVComponent.Fluid := 'B';
277 AnIVComponent.Amount := StrToIntDef(Piece(x, U, 2), 0);
278 AnIVComponent.Units := Piece(x, U, 1);
279 AnIVComponent.Volumes := Copy(x, Pos(U, x) + 1, Length(x));
280 with grdSelected do
281 begin
282 if Objects[0, RowCount - 1] <> nil then RowCount := RowCount + 1;
283 Objects[0, RowCount - 1] := AnIVComponent;
284 Cells[0, RowCount - 1] := AnIVComponent.Name;
285 if AnIVComponent.Amount <> 0 then
286 Cells[1, RowCount - 1] := IntToStr(AnIVComponent.Amount);
287 Cells[2, RowCount - 1] := AnIVComponent.Units;
288 end;
289 end;
290 AResponse := FindResponseByName('VOLUME', AnInstance);
291 if AResponse <> nil then with grdSelected do Cells[1, RowCount - 1] := AResponse.EValue;
292 AnInstance := NextInstance('ORDERABLE', AnInstance);
293 end; {while AnInstance - ORDERABLE}
294 AnInstance := NextInstance('ADDITIVE', 0);
295 while AnInstance > 0 do
296 begin
297 AResponse := FindResponseByName('ADDITIVE', AnInstance);
298 if AResponse <> nil then
299 begin
300 x := AmountsForIVFluid(StrToIntDef(AResponse.IValue, 0), 'A');
301 AnIVComponent := TIVComponent.Create;
302 AnIVComponent.IEN := StrToIntDef(AResponse.IValue, 0);
303 if not FInpatient then
304 begin
305 if DEACheckFailedForIVOnOutPatient(AnIVComponent.IEN,'A') then
306 begin
307 InfoBox(TX_NO_DEA, TC_NO_DEA, MB_OK);
308 cboAdditive.Text := '';
309 Exit;
310 end;
311 end else
312 begin
313 if DEACheckFailed(AnIVComponent.IEN, FInpatient) then
314 begin
315 InfoBox(TX_NO_DEA, TC_NO_DEA, MB_OK);
316 cboAdditive.Text := '';
317 Exit;
318 end;
319 end;
320 AnIVComponent.Name := AResponse.EValue;
321 AnIVComponent.Fluid := 'A';
322 AnIVComponent.Amount := StrToIntDef(Piece(x, U, 2), 0);
323 AnIVComponent.Units := Piece(x, U, 1);
324 AnIVComponent.Volumes := Copy(x, Pos(U, x) + 1, Length(x));
325 with grdSelected do
326 begin
327 if Objects[0, RowCount - 1] <> nil then RowCount := RowCount + 1;
328 Objects[0, RowCount - 1] := AnIVComponent;
329 Cells[0, RowCount - 1] := AnIVComponent.Name;
330 if AnIVComponent.Amount <> 0 then
331 Cells[1, RowCount - 1] := IntToStr(AnIVComponent.Amount);
332 Cells[2, RowCount - 1] := AnIVComponent.Units;
333 end;
334 end;
335 AResponse := FindResponseByName('STRENGTH', AnInstance);
336 if AResponse <> nil then with grdSelected do Cells[1, RowCount - 1] := AResponse.EValue;
337 AResponse := FindResponseByName('UNITS', AnInstance);
338 if AResponse <> nil then with grdSelected do Cells[2, RowCount - 1] := AResponse.EValue;
339 AnInstance := NextInstance('ADDITIVE', AnInstance);
340 end; {while AnInstance - ADDITIVE}
341 SetControl(txtRate, 'RATE', 1);
342 if LowerCase(Copy(ReverseStr(txtRate.Text), 1, 6)) = 'rh/lm ' {*kcm*}
343 then txtRate.Text := Copy(txtRate.Text, 1, Length(txtRate.Text) - 6);
344 SetControl(cboPriority, 'URGENCY', 1);
345 SetControl(memComments, 'COMMENT', 1);
346
347 AnInstance := NextInstance('DAYS', 0);
348 if AnInstance > 0 then
349 begin
350 AResponse := FindResponseByName('DAYS', AnInstance);
351 if AResponse <> nil then
352 SetLimitationControl(AResponse.EValue);
353 end;
354 end; {if...with Responses}
355 Changing := False;
356 ControlChange(Self);
357end;
358
359procedure TfrmODMedIV.SetupDialog(OrderAction: Integer; const ID: string);
360begin
361 inherited;
362 if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then SetValuesFromResponses;
363end;
364
365{ tabFluid events }
366
367procedure TfrmODMedIV.tabFluidChange(Sender: TObject);
368begin
369 inherited;
370 case TabFluid.TabIndex of
371 0: begin
372 cboSolution.Visible := True;
373 cboAdditive.Visible := False;
374 end;
375 1: begin
376 cboAdditive.Visible := True;
377 cboSolution.Visible := False;
378 end;
379 end;
380 if cboSolution.Visible then
381 ActiveControl := cboSolution;
382 if cboAdditive.Visible then
383 ActiveControl := cboAdditive;
384end;
385
386{ cboSolution events }
387
388procedure TfrmODMedIV.cboSolutionNeedData(Sender: TObject; const StartFrom: string;
389 Direction, InsertAt: Integer);
390var
391 CurString: string;
392begin
393 inherited;
394 if (Direction = 1) then
395 CurString := AnsiUpperCase(StartFrom) + ' ';
396 cboSolution.ForDataUse(SubSetOfOrderItems(CurString, Direction, 'S.IVB RX'));
397end;
398
399procedure TfrmODMedIV.cboSolutionMouseClick(Sender: TObject);
400var
401 AnIVComponent: TIVComponent;
402 x: string;
403begin
404 inherited;
405 if CharAt(cboSolution.ItemID, 1) = 'Q' then // setup quick order
406 begin
407 Responses.QuickOrder := ExtractInteger(cboSolution.ItemID);
408 SetValuesFromResponses;
409 cboSolution.ItemIndex := -1;
410 Exit;
411 end;
412 if cboSolution.ItemIEN <= 0 then Exit; // process selection of solution
413 FInpatient := OrderForInpatient;
414 if not FInpatient then
415 begin
416 if DEACheckFailedForIVOnOutPatient(cboSolution.ItemIEN,'S') then
417 begin
418 InfoBox(TX_NO_DEA, TC_NO_DEA, MB_OK);
419 cboSolution.Text := '';
420 Exit;
421 end;
422 end else
423 begin
424 if DEACheckFailed(cboSolution.ItemIEN, FInpatient) then
425 begin
426 InfoBox(TX_NO_DEA, TC_NO_DEA, MB_OK);
427 cboSolution.Text := '';
428 Exit;
429 end;
430 end;
431
432 x := AmountsForIVFluid(cboSolution.ItemIEN, 'B');
433 AnIVComponent := TIVComponent.Create;
434 AnIVComponent.IEN := cboSolution.ItemIEN;
435 AnIVComponent.Name := Piece(cboSolution.Items[cboSolution.ItemIndex], U, 3);
436 AnIVComponent.Fluid := 'B';
437 AnIVComponent.Amount := StrToIntDef(Piece(x, U, 2), 0);
438 AnIVComponent.Units := Piece(x, U, 1);
439 AnIVComponent.Volumes := Copy(x, Pos(U, x) + 1, Length(x));
440 cboSolution.ItemIndex := -1;
441 with grdSelected do
442 begin
443 if Objects[0, RowCount - 1] <> nil then RowCount := RowCount + 1;
444 Objects[0, RowCount - 1] := AnIVComponent;
445 Cells[0, RowCount - 1] := AnIVComponent.Name;
446 Cells[1, RowCount - 1] := IntToStr(AnIVComponent.Amount);
447 Cells[2, RowCount - 1] := AnIVComponent.Units;
448 Row := RowCount - 1;
449 if Length(Piece(AnIVComponent.Volumes, U, 2)) > 0 then Col := 1 else Col := 0;
450 if RowCount = 1 then // switch to additives after 1st IV
451 begin
452 tabFluid.TabIndex := 1;
453 tabFluidChange(Self);
454 end;
455 end;
456 ClickOnGridCell;
457 if cboAdditive.Visible then
458 ActiveControl := cboAdditive;
459 ControlChange(Sender);
460end;
461
462procedure TfrmODMedIV.cboSolutionExit(Sender: TObject);
463begin
464 inherited;
465 if cboSolution.ItemIEN > 0 then cboSolutionMouseClick(Self);
466end;
467
468{ cboAdditive events }
469
470procedure TfrmODMedIV.cboAdditiveNeedData(Sender: TObject; const StartFrom: string;
471 Direction, InsertAt: Integer);
472var
473 CurString: string;
474begin
475 inherited;
476 if (Direction = 1) then
477 CurString := AnsiUpperCase(StartFrom) + ' ';
478 cboAdditive.ForDataUse(SubSetOfOrderItems(CurString, Direction, 'S.IVA RX'));
479end;
480
481procedure TfrmODMedIV.cboAdditiveMouseClick(Sender: TObject);
482var
483 AnIVComponent: TIVComponent;
484 x: string;
485begin
486 inherited;
487 if cboAdditive.ItemIEN <= 0 then Exit;
488 FInpatient := OrderForInpatient;
489 if not FInpatient then
490 begin
491 if DEACheckFailedForIVOnOutPatient(cboAdditive.ItemIEN,'A') then
492 begin
493 InfoBox(TX_NO_DEA, TC_NO_DEA, MB_OK);
494 cboAdditive.Text := '';
495 Exit;
496 end;
497 end else
498 begin
499 if DEACheckFailed(cboAdditive.ItemIEN, FInpatient) then
500 begin
501 InfoBox(TX_NO_DEA, TC_NO_DEA, MB_OK);
502 cboAdditive.Text := '';
503 Exit;
504 end;
505 end;
506 x := AmountsForIVFluid(cboAdditive.ItemIEN, 'A');
507 AnIVComponent := TIVComponent.Create;
508 AnIVComponent.IEN := cboAdditive.ItemIEN;
509 AnIVComponent.Name := Piece(cboAdditive.Items[cboAdditive.ItemIndex], U, 3);
510 AnIVComponent.Fluid := 'A';
511 AnIVComponent.Amount := 0;
512 AnIVComponent.Units := Piece(x, U, 1);
513 AnIVComponent.Volumes := '';
514 cboAdditive.ItemIndex := -1;
515 with grdSelected do
516 begin
517 if Objects[0, RowCount - 1] <> nil then RowCount := RowCount + 1;
518 Objects[0, RowCount - 1] := AnIVComponent;
519 Cells[0, RowCount - 1] := AnIVComponent.Name;
520 Cells[2, RowCount - 1] := AnIVComponent.Units;
521 Row := RowCount - 1;
522 Col := 1;
523 end;
524 ClickOnGridCell;
525 ControlChange(Sender);
526end;
527
528procedure TfrmODMedIV.cboAdditiveExit(Sender: TObject);
529begin
530 inherited;
531 if cboAdditive.ItemIEN > 0 then cboAdditiveMouseClick(Self);
532end;
533
534{ grdSelected events }
535
536procedure TfrmODMedIV.ClickOnGridCell;
537var
538 AnIVComponent: TIVComponent;
539
540 procedure PlaceControl(AControl: TWinControl);
541 var
542 ARect: TRect;
543 begin
544 with AControl do
545 begin
546 ARect := grdSelected.CellRect(grdSelected.Col, grdSelected.Row);
547 SetBounds(ARect.Left + grdSelected.Left + 1, ARect.Top + grdSelected.Top + 1,
548 ARect.Right - ARect.Left + 1, ARect.Bottom - ARect.Top + 1);
549 BringToFront;
550 Show;
551 SetFocus;
552 end;
553 end;
554
555begin
556 AnIVComponent := TIVComponent(grdSelected.Objects[0, grdSelected.Row]);
557 if (AnIVComponent = nil) or (grdSelected.Col = 0) then Exit;
558 // allow selection if more the 1 unit to choose from
559 if (grdSelected.Col = 2) and (Length(Piece(AnIVComponent.Units, U, 2)) > 0) then
560 begin
561 PiecesToList(AnIVComponent.Units, U, cboSelected.Items);
562 cboSelected.ItemIndex := cboSelected.Items.IndexOf(grdSelected.Cells[grdSelected.Col, grdSelected.Row]);
563 cboSelected.Tag := (grdSelected.Col * 256) + grdSelected.Row;
564 PlaceControl(cboSelected);
565 end;
566 // allow selection if more than 1 volume to choose from
567 if (grdSelected.Col = 1) and (Length(Piece(AnIVComponent.Volumes, U, 2)) > 0) then
568 begin
569 PiecesToList(AnIVComponent.Volumes, U, cboSelected.Items);
570 cboSelected.ItemIndex := cboSelected.Items.IndexOf(grdSelected.Cells[grdSelected.Col, grdSelected.Row]);
571 cboSelected.Tag := (grdSelected.Col * 256) + grdSelected.Row;
572 PlaceControl(cboSelected);
573 end;
574 // display text box to enter strength if the entry is an additive
575 if (grdSelected.Col = 1) and (AnIVComponent.Fluid = 'A') then
576 begin
577 txtSelected.Text := grdSelected.Cells[grdSelected.Col, grdSelected.Row];
578 txtSelected.Tag := (grdSelected.Col * 256) + grdSelected.Row;
579 PlaceControl(txtSelected);
580 end;
581end;
582
583procedure TfrmODMedIV.txtSelectedChange(Sender: TObject); // text editor for grid
584begin
585 inherited;
586 with txtSelected do
587 begin
588 if Tag < 0 then Exit;
589 grdSelected.Cells[Tag div 256, Tag mod 256] := Text;
590 end;
591 ControlChange(Sender);
592end;
593
594procedure TfrmODMedIV.txtSelectedExit(Sender: TObject);
595begin
596 inherited;
597 with txtSelected do
598 begin
599 grdSelected.Cells[Tag div 256, Tag mod 256] := Text;
600 Tag := -1;
601 Hide;
602 end;
603end;
604
605procedure TfrmODMedIV.cboSelectedChange(Sender: TObject); // combo editor for grid
606begin
607 inherited;
608 with cboSelected do
609 begin
610 if Tag < 0 then Exit;
611 grdSelected.Cells[Tag div 256, Tag mod 256] := Text;
612 end;
613 ControlChange(Sender);
614end;
615
616procedure TfrmODMedIV.cboSelectedExit(Sender: TObject);
617begin
618 inherited;
619 with cboSelected do
620 begin
621 grdSelected.Cells[Tag div 256, Tag mod 256] := Text;
622 Tag := -1;
623 Hide;
624 end;
625end;
626
627procedure TfrmODMedIV.cmdRemoveClick(Sender: TObject); // remove button for grid
628var
629 i: Integer;
630begin
631 inherited;
632 with grdSelected do
633 begin
634 if Row < 0 then Exit;
635 if Objects[0, Row] <> nil then TIVComponent(Objects[0, Row]).Free;
636 for i := Row to RowCount - 2 do Rows[i] := Rows[i + 1];
637 Rows[RowCount - 1].Clear;
638 RowCount := RowCount - 1;
639 end;
640 ControlChange(Sender);
641end;
642
643{ update Responses & Create Order Text }
644
645procedure TfrmODMedIV.ControlChange(Sender: TObject);
646var
647 i, CurAdd, CurBase: Integer;
648 x,xlimIn,xLimEx,eSch,iSch: string;
649 AnIVComponent: TIVComponent;
650 FQOSchedule: TResponse;
651
652 function IsNumericRate(const x: string): Boolean;
653 var
654 i: Integer;
655 begin
656 Result := True;
657 for i := 1 to Length(x) do if not (x[i] in ['0'..'9','.']) then Result := False;
658 end;
659
660begin
661 inherited;
662 if Changing then Exit;
663// FQOSchedule := TResponse.Create;
664 FQOSchedule := Responses.FindResponseByName('SCHEDULE',1);
665 if FQOSchedule <> nil then
666 begin
667 eSch := FQOSchedule.EValue;
668 iSch := FQOSchedule.IValue;
669 end;
670 //if Sender <> Self then Responses.Clear; // Sender=Self when called from SetupDialog
671 Responses.Clear; // want this to clear even after SetupDialog in case instances don't match
672 CurAdd := 1; CurBase := 1;
673 with grdSelected do for i := 0 to RowCount - 1 do
674 begin
675 AnIVComponent := TIVComponent(Objects[0, i]);
676 if AnIVComponent = nil then Continue;
677 with AnIVComponent do
678 begin
679 if Fluid = 'B' then // Solutions
680 begin
681 if IEN > 0 then Responses.Update('ORDERABLE', CurBase, IntToStr(IEN), Name);
682 if Length(Cells[1,i]) > 0 then Responses.Update('VOLUME', CurBase, Cells[1,i], Cells[1,i]);
683 Inc(CurBase);
684 end; {if Fluid B}
685 if Fluid = 'A' then // Additives
686 begin
687 if IEN > 0 then Responses.Update('ADDITIVE', CurAdd, IntToStr(IEN), Name);
688 if Length(Cells[1,i]) > 0 then Responses.Update('STRENGTH', CurAdd, Cells[1,i], Cells[1,i]);
689 if Length(Cells[2,i]) > 0 then Responses.Update('UNITS', CurAdd, Cells[2,i], Cells[2,i]);
690 Inc(CurAdd);
691 end; {if Fluid A}
692 end; {with AnIVComponent}
693 end; {with grdSelected}
694 x := txtRate.Text;
695 xlimIn := '';
696 xlimEx := '';
697 if length(txtXDuration.Text) > 0 then
698 begin
699 if (btnXDuration.Caption = 'L') or (btnXDuration.Caption = 'ml') then
700 begin
701 xlimEx := 'with total volume ' + txtXDuration.Text + btnXDuration.Caption;
702 xlimIn := 'with total volume ' + txtXDuration.Text + btnXDuration.Caption;
703 end
704 else if (btnXDuration.Caption = 'days') or (btnXDuration.Caption = 'hours') then
705 begin
706 xlimEx := 'for ' + txtXDuration.Text + ' ' + btnXDuration.Caption;
707 xlimIn := 'for ' + txtXDuration.Text + ' ' + btnXDuration.Caption;
708 end else
709 begin
710 xlimIn := '';
711 xlimEx := '';
712 end;
713 end;
714 //if x = IntToStr(StrToIntDef(x, -1)) then x := x + ' ml/hr';
715 if IsNumericRate(x) then x := x + ' ml/hr';
716 if (Pos('@',x)>0) and (Piece(x,'@',1) = IntToStr(StrToIntDef(Piece(x,'@',1), -1)))
717 then x := Piece(x,'@',1) + ' ml/hr@' + Copy(x, Pos('@',x) + 1, Length(x));
718 with txtRate do if (Length(Text) > 0) then Responses.Update('RATE', 1, x, x);
719 with cboPriority do if ItemIndex > -1 then Responses.Update('URGENCY', 1, ItemID, Text);
720 if Length(xlimIn)>0 then Responses.Update('DAYS',1, xlimIn, xlimEx);
721 with memComments do if GetTextLen > 0 then Responses.Update('COMMENT', 1, TX_WPTYPE, Text);
722 memOrder.Text := Responses.OrderText;
723 if (Length(eSch)>0) or (Length(iSch)>0) then
724 Responses.Update('SCHEDULE',1,iSch,eSch);
725end;
726
727procedure TfrmODMedIV.grdSelectedDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
728 State: TGridDrawState);
729begin
730 inherited;
731 if Sender = ActiveControl then Exit;
732 if not (gdSelected in State) then Exit;
733 with Sender as TStringGrid do
734 begin
735 Canvas.Brush.Color := Color;
736 Canvas.Font := Font;
737 Canvas.TextRect(Rect, Rect.Left + 2, Rect.Top + 2, Cells[ACol, ARow]);
738 end;
739end;
740
741procedure TfrmODMedIV.SetFontSize( FontSize: integer);
742begin
743 inherited SetFontSize( FontSize );
744 DoSetFontSize( FontSize );
745end;
746
747procedure TfrmODMedIV.DoSetFontSize( FontSize: integer);
748begin
749 tabFluid.TabHeight := Abs(Font.Height) + 4;
750 grdSelected.DefaultRowHeight := Abs(Font.Height) + 8;
751end;
752
753procedure TfrmODMedIV.FormKeyDown(Sender: TObject; var Key: Word;
754 Shift: TShiftState);
755begin
756 inherited;
757 if (Key = VK_TAB) and (ssCtrl in Shift) then
758 begin
759 //Back-tab works the same as forward-tab because there are only two tabs.
760 tabFluid.TabIndex := (tabFluid.TabIndex + 1) mod tabFluid.Tabs.Count;
761 Key := 0;
762 tabFluidChange(tabFluid);
763 end;
764end;
765
766procedure TfrmODMedIV.grdSelectedKeyPress(Sender: TObject; var Key: Char);
767begin
768 inherited;
769 ClickOnGridCell;
770end;
771
772procedure TfrmODMedIV.grdSelectedMouseDown(Sender: TObject;
773 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
774begin
775 inherited;
776 ClickOnGridCell;
777end;
778
779procedure TfrmODMedIV.btnXDurationClick(Sender: TObject);
780var
781 APoint: TPoint;
782begin
783 inherited;
784 txtXDuration.SetFocus;
785 with TSpeedButton(Sender) do APoint := ClientToScreen(Point(0, Height));
786 popDuration.Popup(APoint.X, APoint.Y);
787end;
788
789procedure TfrmODMedIV.popDurationClick(Sender: TObject);
790var
791 x: string;
792begin
793 inherited;
794 with TMenuItem(Sender) do
795 begin
796 x := Caption;
797 {if Length(Trim(txtXDuration.Text)) > 0 then
798 if AnsiCompareStr(btnXduration.Caption,x) <> 0 then
799 txtXDuration.Text := '';}
800 end;
801 btnXDuration.Caption := x;
802 txtXDurationChange(Sender);
803 ControlChange(Sender);
804end;
805
806procedure TfrmODMedIV.txtXDurationChange(Sender: TObject);
807begin
808 inherited;
809 if Changing then Exit;
810 ControlChange(Sender);
811end;
812
813procedure TfrmODMedIV.pnlXDurationEnter(Sender: TObject);
814begin
815 inherited;
816 txtXDuration.SetFocus;
817end;
818
819procedure TfrmODMedIV.SetLimitationControl(aValue: string);
820var
821 limitUnit,limitValue,tempval: string;
822begin
823 limitUnit := '';
824 limitValue := '';
825 tempVal := '';
826 if ( CharAt(aValue,1)= 'f') or ( CharAt(aValue,1)= 'F') then //days, hours
827 begin
828 limitValue := Piece(aValue,' ',2);
829 limitUnit := Piece(aValue,' ',3);
830 end;
831 if (CharAt(aValue,1)= 'w') or (CharAt(aValue,1)= 'W') then //L, ml
832 begin
833 tempval := Piece(aValue,' ',4);
834 limitValue := FloatToStr(ExtractFloat(tempVal));
835 limitUnit := Copy(tempVal,length(limitValue)+1,Length(tempVal));
836 end;
837 if isNumeric(CharAt(aValue,1)) then
838 begin
839 limitValue := FloatToStr(ExtractFloat(aValue));
840 limitUnit := Copy(aValue,length(limitValue)+1,Length(aValue));
841 if limitUnit = 'D' then limitUnit := 'days'
842 else if limitUnit = 'H' then limitUnit := 'hours'
843 else if limitUnit = 'ML' then limitUnit := 'ml';
844 end;
845 if ( Length(limitUnit)> 0) and ( (Length(limitValue) > 0 ) ) then
846 begin
847 txtXDuration.Text := limitValue;
848 if Trim(UpperCase(limitUnit))='CC' then
849 limitUnit := 'ml';
850 btnXDuration.Caption := limitUnit;
851 end;
852
853end;
854
855procedure TfrmODMedIV.txtXDurationExit(Sender: TObject);
856var
857 Code: double;
858begin
859 inherited;
860 if Changing then Exit;
861 if (Pos('.', txtXDuration.Text)>0) and
862 ((btnXduration.Caption = 'days') or (btnXduration.Caption = 'hours')) then
863 begin
864 ShowMessage('Can not save order.' + #13#10
865 + 'Reason: Invalid Duration, please enter an integer value for days or hours.');
866 txtXDuration.Text := '';
867 txtXDuration.SetFocus;
868 Exit;
869 end;
870 if (txtXDuration.Text <> '0') and (txtXDuration.Text <> '') then
871 begin
872 try
873 code := StrToFloat(txtXDuration.Text);
874 except
875 code := 0;
876 end;
877 if code < 0.0001 then
878 begin
879 ShowMessage('Can not save order.' + #13#10 + 'Reason: Invalid Duration or Total Volume!');
880 txtXDuration.Text := '';
881 txtXDuration.SetFocus;
882 Exit;
883 end;
884 end;
885 try
886 if (Length(txtXDuration.Text)>0) and (StrToFloat(txtXDuration.Text)<0) then
887 begin
888 ShowMessage('Can not save order.' + #13#10 + 'Reason: Invalid Duration or total volume!');
889 txtXDuration.Text := '';
890 txtXDuration.SetFocus;
891 Exit;
892 end;
893 except
894 txtXDuration.Text := '';
895 end;
896 ControlChange(Sender);
897end;
898
899end.
Note: See TracBrowser for help on using the repository browser.