source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/fODMedIV.~pas@ 525

Last change on this file since 525 was 453, checked in by Kevin Toppenberg, 17 years ago

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