source: cprs/trunk/CPRS-Chart/Orders/fODMedIV.pas@ 792

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

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