source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/Orders/fODMedComplex.pas@ 1722

Last change on this file since 1722 was 829, checked in by Kevin Toppenberg, 14 years ago

Upgrade to version 27
File size: 18.7 KB
Line 
1unit fODMedComplex;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 fAutoSz, StdCtrls, Grids, Buttons, ExtCtrls, ORCtrls, Menus, ORFn, fODBase, uConst,
8 ComCtrls, VA508AccessibilityManager;
9
10type
11 TfrmODMedComplex = class(TfrmAutoSz)
12 grdDoses: TStringGrid;
13 cmdOK: TButton;
14 cmdCancel: TButton;
15 cboRoute: TORComboBox;
16 cboSchedule: TORComboBox;
17 pnlInstruct: TPanel;
18 cboInstruct: TORComboBox;
19 btnUnits: TSpeedButton;
20 pnlDays: TPanel;
21 txtDays: TCaptionEdit;
22 Label1: TLabel;
23 popUnits: TPopupMenu;
24 Bevel1: TBevel;
25 cmdInsert: TButton;
26 cmdRemove: TButton;
27 UpDown2: TUpDown;
28 procedure FormCreate(Sender: TObject);
29 procedure cmdOKClick(Sender: TObject);
30 procedure cmdCancelClick(Sender: TObject);
31 procedure btnUnitsClick(Sender: TObject);
32 procedure pnlInstructExit(Sender: TObject);
33 procedure cboRouteExit(Sender: TObject);
34 procedure cboScheduleExit(Sender: TObject);
35 procedure pnlDaysExit(Sender: TObject);
36 procedure grdDosesDrawCell(Sender: TObject; ACol, ARow: Integer;
37 Rect: TRect; State: TGridDrawState);
38 procedure pnlInstructEnter(Sender: TObject);
39 procedure pnlDaysEnter(Sender: TObject);
40 procedure grdDosesMouseUp(Sender: TObject; Button: TMouseButton;
41 Shift: TShiftState; X, Y: Integer);
42 procedure cmdInsertClick(Sender: TObject);
43 procedure cmdRemoveClick(Sender: TObject);
44 procedure grdDosesMouseDown(Sender: TObject; Button: TMouseButton;
45 Shift: TShiftState; X, Y: Integer);
46 procedure grdDosesKeyPress(Sender: TObject; var Key: Char);
47 procedure txtDaysChange(Sender: TObject);
48 procedure cboRouteClick(Sender: TObject);
49 private
50 FDropColumn: Integer;
51 procedure ShowEditor(ACol, ARow: Integer; AChar: Char);
52 procedure UnitClick(Sender: TObject);
53 procedure Validate(var AnErrMsg: string);
54 function ValFor(FieldID, ARow: Integer): string;
55 procedure UMDelayEvent(var Message: TMessage); message UM_DELAYEVENT;
56 public
57 { Public declarations }
58 end;
59
60function ExecuteComplexDose(CtrlInits: TCtrlInits; Responses: TResponses): Boolean;
61
62implementation
63
64{$R *.DFM}
65
66uses rODBase;
67
68const
69 COL_SELECT = 0;
70 COL_INSTRUCT = 1;
71 COL_ROUTE = 2;
72 COL_SCHEDULE = 3;
73 COL_DURATION = 4;
74 VAL_INSTR = 10;
75 VAL_MISC = 11;
76 VAL_ROUTE = 12;
77 VAL_SCHEDULE = 13;
78 VAL_DAYS = 14;
79 VAL_ABBROUTE = 15;
80 TAB = #9;
81 TX_NO_AMPER = ' Instructions may not contain the ampersand (&) character.';
82 TX_NF_ROUTE = ' not found in the Medication Routes file.';
83 TX_NO_ROUTE = ': Route must be entered.';
84 TX_NO_SCHED = ': Schedule must be entered.';
85
86{ public functions }
87
88function ExecuteComplexDose(CtrlInits: TCtrlInits; Responses: TResponses): Boolean;
89var
90 frmODMedComplex: TfrmODMedComplex;
91 AResponse: TResponse;
92 AnInstance, ARow: Integer;
93 x: string;
94begin
95 frmODMedComplex := TfrmODMedComplex.Create(Application);
96 try
97 ResizeFormToFont(TForm(frmODMedComplex));
98 with frmODMedComplex do
99 begin
100 grdDoses.Cells[COL_INSTRUCT, 0] := CtrlInits.DefaultText('Verb');
101 if grdDoses.Cells[COL_INSTRUCT, 0] = '' then grdDoses.Cells[COL_INSTRUCT, 0] := 'Amount';
102 CtrlInits.SetControl(cboInstruct, 'Instruct');
103 CtrlInits.SetPopupMenu(popUnits, UnitClick, 'Nouns');
104 CtrlInits.SetControl(cboRoute, 'Route');
105 CtrlInits.SetControl(cboSchedule, 'Schedules');
106 with Responses do
107 begin
108 grdDoses.RowCount := InstanceCount('INSTR') + 2; // 1 row for headers, 1 for new dose
109 ARow := 1; // row 1 is first dose row
110 AnInstance := NextInstance('INSTR', 0);
111 while AnInstance > 0 do
112 begin
113 grdDoses.Cells[COL_INSTRUCT, ARow] :=
114 IValueFor('INSTR', AnInstance) + ' ' + IValueFor('MISC', AnInstance) + TAB +
115 IValueFor('INSTR', AnInstance) + TAB + IValueFor('MISC', AnInstance);
116 AResponse := FindResponseByName('ROUTE', AnInstance);
117 cboRoute.SelectByID(AResponse.IValue);
118 with cboRoute do if ItemIndex > -1 then x := DisplayText[ItemIndex];
119 grdDoses.Cells[COL_ROUTE, ARow] := x + TAB + AResponse.IValue + TAB + AResponse.EValue;
120 grdDoses.Cells[COL_SCHEDULE, ARow] := IValueFor('SCHEDULE', AnInstance);
121 x := IValueFor('DAYS', AnInstance);
122 if Length(x) > 0 then x := x + ' day(s)';
123 grdDoses.Cells[COL_DURATION, ARow] := x + TAB + IValueFor('DAYS', AnInstance);
124 AnInstance := NextInstance('INSTR', AnInstance);
125 Inc(ARow);
126 end; {while AnInstance}
127 end; {with Responses}
128 end;
129 Result := frmODMedComplex.ShowModal = mrOK;
130 if Result then with frmODMedComplex, grdDoses, Responses do
131 begin
132 Clear('INSTR');
133 Clear('MISC');
134 Clear('ROUTE');
135 Clear('SCHEDULE');
136 Clear('DAYS');
137 for ARow := 1 to Pred(RowCount) do
138 begin
139 if Length(ValFor(VAL_INSTR, ARow)) > 0 then
140 begin
141 Update('INSTR', ARow, ValFor(VAL_INSTR, ARow), ValFor(VAL_INSTR, ARow));
142 if Length(ValFor(VAL_MISC, ARow)) > 0 then
143 Update('MISC', ARow, ValFor(VAL_MISC, ARow), ValFor(VAL_MISC, ARow));
144 Update('ROUTE', ARow, ValFor(VAL_ROUTE, ARow), ValFor(VAL_ABBROUTE, ARow));
145 Update('SCHEDULE', ARow, ValFor(VAL_SCHEDULE, ARow), ValFor(COL_SCHEDULE, ARow));
146 Update('DAYS', ARow, ValFor(VAL_DAYS, ARow), ValFor(VAL_DAYS, ARow));
147 end; {if Length}
148 end; {with...for}
149 end; {if Result}
150 finally
151 frmODMedComplex.Release;
152 end;
153end;
154
155{ General Functions - get & set cell values}
156
157function TfrmODMedComplex.ValFor(FieldID, ARow: Integer): string;
158{ Contents of grid cells is as follows (cells delimited by |, ^ indicates tab char)
159 InstructionText^INSTR^MISC | RouteText^ROUTE^Abbrev. | SCHEDULE DurationText^DAYS
160 Only the first tab piece for each cell is drawn. }
161begin
162 Result := '';
163 if (ARow < 1) or (ARow >= grdDoses.RowCount) then Exit;
164 with grdDoses do
165 case FieldID of
166 COL_INSTRUCT : Result := Piece(Cells[COL_INSTRUCT, ARow], TAB, 1);
167 COL_ROUTE : Result := Piece(Cells[COL_ROUTE, ARow], TAB, 1);
168 COL_SCHEDULE : Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
169 COL_DURATION : Result := Piece(Cells[COL_DURATION, ARow], TAB, 1);
170 VAL_INSTR : Result := Piece(Cells[COL_INSTRUCT, ARow], TAB, 2);
171 VAL_MISC : Result := Piece(Cells[COL_INSTRUCT, ARow], TAB, 3);
172 VAL_ROUTE : Result := Piece(Cells[COL_ROUTE, ARow], TAB, 2);
173 VAL_SCHEDULE : Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
174 VAL_DAYS : Result := Piece(Cells[COL_DURATION, ARow], TAB, 2);
175 VAL_ABBROUTE : Result := Piece(Cells[COL_ROUTE, ARow], Tab, 3);
176 end;
177end;
178
179procedure FindInCombo(const x: string; AComboBox: TORComboBox);
180var
181 i, Found: Integer;
182begin
183 with AComboBox do
184 begin
185 i := 0;
186 Found := -1;
187 while (i < Items.Count) and (Found < 0) do
188 begin
189 if CompareText(Copy(DisplayText[i], 1, Length(x)), x) = 0 then Found := i;
190 Inc(i);
191 end; {while}
192 if Found > -1 then
193 begin
194 ItemIndex := Found;
195 Application.ProcessMessages;
196 SelStart := 1;
197 SelLength := Length(Items[Found]);
198 end else
199 begin
200 Text := x;
201 SelStart := Length(x);
202 end;
203 end; {with AComboBox}
204end;
205
206{ Form Events }
207
208procedure TfrmODMedComplex.FormCreate(Sender: TObject);
209begin
210 inherited;
211 with grdDoses do
212 begin
213 ColWidths[COL_SELECT] := 12;
214 ColWidths[COL_INSTRUCT] := 160;
215 Cells[COL_INSTRUCT, 0] := 'Amount';
216 Cells[COL_ROUTE, 0] := 'Route';
217 Cells[COL_SCHEDULE, 0] := 'Schedule';
218 Cells[COL_DURATION, 0] := 'Duration';
219 end;
220 FDropColumn := -1;
221end;
222
223{ grdDoses events (including cell editors) }
224
225procedure TfrmODMedComplex.grdDosesMouseDown(Sender: TObject; Button: TMouseButton;
226 Shift: TShiftState; X, Y: Integer);
227var
228 ACol, ARow: Integer;
229begin
230 inherited;
231 grdDoses.MouseToCell(X, Y, ACol, ARow);
232 if (ARow < 0) or (ACol < 0) then Exit;
233 if ACol > COL_SELECT then ShowEditor(ACol, ARow, #0) else
234 begin
235 grdDoses.Col := COL_INSTRUCT;
236 grdDoses.Row := ARow;
237 end;
238end;
239
240procedure TfrmODMedComplex.grdDosesKeyPress(Sender: TObject; var Key: Char);
241begin
242 inherited;
243 if Key = #13 then ShowEditor(grdDoses.Col, grdDoses.Row, #0);
244 if Key in [#32..#127] then ShowEditor(grdDoses.Col, grdDoses.Row, Key);
245end;
246
247procedure TfrmODMedComplex.grdDosesMouseUp(Sender: TObject; Button: TMouseButton;
248 Shift: TShiftState; X, Y: Integer);
249begin
250 inherited;
251 case FDropColumn of
252 COL_INSTRUCT: with cboInstruct do if Items.Count > 0 then DroppedDown := True;
253 COL_ROUTE: with cboRoute do if Items.Count > 0 then DroppedDown := True;
254 COL_SCHEDULE: with cboSchedule do if Items.Count > 0 then DroppedDown := True;
255 end;
256 FDropColumn := -1;
257end;
258
259procedure TfrmODMedComplex.grdDosesDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect;
260 State: TGridDrawState);
261{ only show the first tab piece of the cell }
262begin
263 inherited;
264 grdDoses.Canvas.TextRect(Rect, Rect.Left+2, Rect.Top+2,
265 Piece(grdDoses.Cells[ACol, ARow], TAB, 1));
266end;
267
268procedure TfrmODMedComplex.ShowEditor(ACol, ARow: Integer; AChar: Char);
269
270 procedure PlaceControl(AControl: TWinControl);
271 var
272 ARect: TRect;
273 begin
274 with AControl do
275 begin
276 ARect := grdDoses.CellRect(ACol, ARow);
277 SetBounds(ARect.Left + grdDoses.Left + 1, ARect.Top + grdDoses.Top + 1,
278 ARect.Right - ARect.Left + 1, ARect.Bottom - ARect.Top + 1);
279 BringToFront;
280 Show;
281 SetFocus;
282 end;
283 end;
284
285begin
286 inherited;
287 if ARow = 0 then Exit; // header row
288 // require initial instruction entry when in last row
289 with grdDoses do if (ARow = Pred(RowCount)) and (ACol > COL_INSTRUCT) and
290 (ValFor(VAL_INSTR, ARow) = '') then Exit;
291 // only allow route when in first row
292 if (ACol = COL_ROUTE) and (ARow > 1) then Exit;
293 // display appropriate editor for row & column
294 case ACol of
295 COL_INSTRUCT: begin
296 // if this is the last row, default the route & schedule to previous row
297 if (ARow > 1) and (ARow = Pred(grdDoses.RowCount)) then
298 begin
299 grdDoses.Cells[COL_INSTRUCT, ARow] := TAB + TAB + ValFor(VAL_MISC, Pred(ARow));
300 grdDoses.Cells[COL_ROUTE, ARow] := grdDoses.Cells[COL_ROUTE, Pred(ARow)];
301 grdDoses.Cells[COL_SCHEDULE, ARow] := grdDoses.Cells[COL_SCHEDULE, Pred(ARow)];
302 end;
303 // set appropriate value for cboInstruct & btnUnits
304 btnUnits.Caption := ValFor(VAL_MISC, ARow);
305 pnlInstruct.Tag := ARow;
306 if popUnits.Items.Count = 0 then
307 begin
308 btnUnits.Visible := False;
309 cboInstruct.Width := pnlInstruct.Width;
310 end;
311 PlaceControl(pnlInstruct);
312 FDropColumn := COL_INSTRUCT;
313 if AChar <> #0
314 then PostMessage(Handle, UM_DELAYEVENT, Ord(AChar), COL_INSTRUCT)
315 else cboInstruct.Text := ValFor(VAL_INSTR, ARow);
316 end;
317 COL_ROUTE: begin
318 // set appropriate value for cboRoute
319 cboRoute.SelectByID(ValFor(VAL_ROUTE, ARow));
320 if cboRoute.Text = '' then cboRoute.Text := ValFor(COL_ROUTE, ARow);
321 cboRoute.Tag := ARow;
322 PlaceControl(cboRoute);
323 FDropColumn := COL_ROUTE;
324 if AChar <> #0 then PostMessage(Handle, UM_DELAYEVENT, Ord(AChar), COL_ROUTE);
325 end;
326 COL_SCHEDULE: begin
327 // set appropriate value for cboSchedule
328 cboSchedule.Tag := ARow;
329 PlaceControl(cboSchedule);
330 FDropColumn := COL_SCHEDULE;
331 if AChar <> #0
332 then PostMessage(Handle, UM_DELAYEVENT, Ord(AChar), COL_SCHEDULE)
333 else cboSchedule.Text := ValFor(COL_SCHEDULE, ARow);
334 end;
335 COL_DURATION: begin
336 // set appropriate value for txtDays
337 pnlDays.Tag := ARow;
338 PlaceControl(pnlDays);
339 txtDays.SetFocus;
340 if AChar <> #0
341 then PostMessage(Handle, UM_DELAYEVENT, Ord(AChar), COL_DURATION)
342 else txtDays.Text := ValFor(VAL_DAYS, ARow);
343 end;
344 end; {case ACol}
345end;
346
347procedure TfrmODMedComplex.UMDelayEvent(var Message: TMessage);
348{ after focusing events are completed for a combobox, set the key the user typed }
349begin
350 case Message.LParam of
351 COL_INSTRUCT : FindInCombo(Chr(Message.WParam), cboInstruct);
352 COL_ROUTE : FindInCombo(Chr(Message.WParam), cboRoute);
353 COL_SCHEDULE : FindInCombo(Chr(Message.WParam), cboSchedule);
354 COL_DURATION : begin
355 txtDays.Text := Chr(Message.WParam);
356 txtDays.SelStart := 1;
357 end;
358 end;
359end;
360
361{ Instructions Editor }
362
363procedure TfrmODMedComplex.pnlInstructEnter(Sender: TObject);
364begin
365 inherited;
366 // if this was the last row, create a new last row
367 if grdDoses.Row = Pred(grdDoses.RowCount) then grdDoses.RowCount := grdDoses.RowCount + 1;
368 // shift focus to the combobox portion of the instructions panel
369 cboInstruct.SetFocus;
370end;
371
372procedure TfrmODMedComplex.pnlInstructExit(Sender: TObject);
373var
374 ARow: Integer;
375begin
376 inherited;
377 ARow := pnlInstruct.Tag;
378 // clear the rest of the row if no instruction has been entered
379 with grdDoses do if (ARow = Pred(RowCount)) and (cboInstruct.Text = '') then
380 begin
381 Cells[COL_INSTRUCT, ARow] := '';
382 Cells[COL_ROUTE, ARow] := '';
383 Cells[COL_SCHEDULE, ARow] := '';
384 Cells[COL_DURATION, ARow] := '';
385 Exit;
386 end;
387 // save entered information in the cell
388 grdDoses.Cells[COL_INSTRUCT, ARow] := cboInstruct.Text + ' ' + btnUnits.Caption + TAB +
389 cboInstruct.Text + TAB + btnUnits.Caption;
390 pnlInstruct.Tag := -1;
391 pnlInstruct.Hide;
392end;
393
394procedure TfrmODMedComplex.btnUnitsClick(Sender: TObject);
395var
396 APoint: TPoint;
397begin
398 inherited;
399 APoint := btnUnits.ClientToScreen(Point(0, btnUnits.Height));
400 popUnits.Popup(APoint.X, APoint.Y);
401end;
402
403procedure TfrmODMedComplex.UnitClick(Sender: TObject);
404begin
405 btnUnits.Caption := TMenuItem(Sender).Caption;
406end;
407
408{ Route Editor }
409
410procedure TfrmODMedComplex.cboRouteClick(Sender: TObject);
411{ force all routes to be the same (until pharmacy changes to accomodate varying routes) }
412var
413 i: Integer;
414 x: string;
415begin
416 inherited;
417 with cboRoute do if ItemIndex > -1
418 then x := Piece(Items[ItemIndex], U, 3)
419 else x := cboRoute.Text;
420 for i := 1 to Pred(grdDoses.RowCount) do
421 if Length(ValFor(VAL_INSTR, i)) > 0
422 then grdDoses.Cells[COL_ROUTE, i] := cboRoute.Text + TAB + cboRoute.ItemID + TAB + x;
423end;
424
425procedure TfrmODMedComplex.cboRouteExit(Sender: TObject);
426begin
427 inherited;
428 cboRouteClick(Self);
429 cboRoute.Tag := -1;
430 cboRoute.Hide;
431end;
432
433{ Schedule Editor }
434
435procedure TfrmODMedComplex.cboScheduleExit(Sender: TObject);
436begin
437 inherited;
438 grdDoses.Cells[COL_SCHEDULE, cboSchedule.Tag] := cboSchedule.Text;
439 cboSchedule.Tag := -1;
440 cboSchedule.Hide;
441end;
442
443{ Duration Editor }
444
445procedure TfrmODMedComplex.pnlDaysEnter(Sender: TObject);
446begin
447 inherited;
448 txtDays.SetFocus;
449end;
450
451procedure TfrmODMedComplex.pnlDaysExit(Sender: TObject);
452var
453 x: string;
454begin
455 inherited;
456 x := txtDays.Text;
457 if Length(x) > 0 then x := x + ' day(s)';
458 x := x + TAB + txtDays.Text;
459 grdDoses.Cells[COL_DURATION, pnlDays.Tag] := x;
460 pnlDays.Tag := -1;
461 pnlDays.Hide;
462end;
463
464procedure TfrmODMedComplex.txtDaysChange(Sender: TObject);
465begin
466 inherited;
467 if txtDays.Text = '0' then txtDays.Text := '';
468end;
469
470{ Command Buttons }
471
472procedure TfrmODMedComplex.cmdInsertClick(Sender: TObject);
473var
474 i: Integer;
475 x0, x1, x2: string;
476begin
477 inherited;
478 cmdInsert.SetFocus; // make sure exit events for editors fire
479 with grdDoses do
480 begin
481 if Row < 1 then Exit;
482 x0 := TAB + TAB + ValFor(VAL_MISC, Row);
483 x1 := grdDoses.Cells[COL_ROUTE, Row];
484 x2 := grdDoses.Cells[COL_SCHEDULE, Row];
485 RowCount := RowCount + 1;
486 { move rows down }
487 for i := Pred(RowCount) downto Succ(Row) do Rows[i] := Rows[i-1];
488 Rows[Row].Clear;
489 Cells[COL_INSTRUCT, Row] := x0;
490 Cells[COL_ROUTE, Row] := x1;
491 Cells[COL_SCHEDULE, Row] := x2;
492 Col := COL_INSTRUCT;
493 ShowEditor(COL_INSTRUCT, Row, #0);
494 end;
495end;
496
497procedure TfrmODMedComplex.cmdRemoveClick(Sender: TObject);
498var
499 i: Integer;
500begin
501 inherited;
502 cmdRemove.SetFocus; // make sure exit events for editors fire
503 with grdDoses do if (Row > 0) and (RowCount > 2) then
504 begin
505 { move rows up }
506 for i := Row to RowCount - 2 do Rows[i] := Rows[i+1];
507 RowCount := RowCount - 1;
508 Rows[RowCount].Clear;
509 end;
510end;
511
512procedure TfrmODMedComplex.Validate(var AnErrMsg: string);
513var
514 i: Integer;
515 RouteID, RouteAbbr: string;
516
517 procedure SetError(const x: string);
518 begin
519 if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
520 AnErrMsg := AnErrMsg + x;
521 end;
522
523begin
524 AnErrMsg := '';
525 with grdDoses do for i := 1 to Pred(RowCount) do
526 begin
527 if Length(ValFor(VAL_INSTR, i)) > 0 then
528 begin
529 if Pos('&', cboInstruct.Text) > 0 then SetError(IntToStr(i) + TX_NO_AMPER);
530 if ValFor(COL_ROUTE, i) = '' then SetError(IntToStr(i) + TX_NO_ROUTE);
531 if ValFor(COL_SCHEDULE, i) = '' then SetError(IntToStr(i) + TX_NO_SCHED);
532 if (ValFor(VAL_ROUTE, i) = '') and (Length(ValFor(COL_ROUTE, i)) > 0) then
533 begin
534 LookupRoute(ValFor(COL_ROUTE, i), RouteID, RouteAbbr);
535 if RouteID = '0'
536 then SetError(ValFor(COL_ROUTE, i) + TX_NF_ROUTE)
537 else Cells[COL_ROUTE, i] := ValFor(COL_ROUTE, i) + TAB + RouteID + TAB + RouteAbbr;
538 end; {if ValFor}
539 end; {if Length}
540 end; {with grdDoses...for i}
541end;
542
543procedure TfrmODMedComplex.cmdOKClick(Sender: TObject);
544var
545 ErrMsg: string;
546begin
547 inherited;
548 cmdOK.SetFocus; // make sure exit events for editors fire
549 Validate(ErrMsg);
550 if ShowMsgOn(Length(ErrMsg) > 0, ErrMsg, 'Error') then Exit;
551 ModalResult := mrOK;
552end;
553
554procedure TfrmODMedComplex.cmdCancelClick(Sender: TObject);
555begin
556 inherited;
557 Close;
558end;
559
560{ Test Stuff }
561
562end.
Note: See TracBrowser for help on using the repository browser.