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