close Warning: Can't use blame annotator: 
svn blame failed on cprs/branches/tmg-cprs/CPRS-Chart/Orders/fODMedOut.pas: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/fODMedOut.pas@ 859

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

Initial upload of TMG-CPRS 1.0.26.69
File size: 27.0 KB
RevLine 
1//kt -- Modified with SourceScanner on 8/8/2007
2unit fODMedOut;
3
4interface
5
6uses
7 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
8 fODBase, ORCtrls, StdCtrls, ORFn, ExtCtrls, uConst, ComCtrls, uCore, Mask,
9 Menus, Buttons, DKLang;
10
11type
12 TfrmODMedOut = class(TfrmODBase)
13 lblMedication: TLabel;
14 cboMedication: TORComboBox;
15 lblDosage: TLabel;
16 lblRoute: TLabel;
17 cboRoute: TORComboBox;
18 lblSchedule: TLabel;
19 cboSchedule: TORComboBox;
20 lblDispense: TLabel;
21 cboDispense: TORComboBox;
22 memComments: TMemo;
23 cboPriority: TORComboBox;
24 Bevel1: TBevel;
25 cboMedAlt: TORComboBox;
26 cboInstructions: TORComboBox;
27 lblQuantity: TLabel;
28 cboPickup: TORComboBox;
29 lblPickup: TLabel;
30 cboSC: TORComboBox;
31 lblSC: TLabel;
32 lblRefills: TLabel;
33 txtQuantity: TCaptionEdit;
34 lblComment: TLabel;
35 lblPriority: TLabel;
36 txtRefills: TCaptionEdit;
37 spnRefills: TUpDown;
38 cmdComplex: TButton;
39 btnUnits: TSpeedButton;
40 txtSIG: TCaptionEdit;
41 lblSIG: TLabel;
42 popUnits: TPopupMenu;
43 memComplex: TMemo;
44 procedure cboMedicationNeedData(Sender: TObject; const StartFrom: string;
45 Direction, InsertAt: Integer);
46 procedure cboMedicationSelect(Sender: TObject);
47 procedure FormCreate(Sender: TObject);
48 procedure ControlChange(Sender: TObject);
49 procedure cboDispenseExit(Sender: TObject);
50 procedure cboDispenseMouseClick(Sender: TObject);
51 procedure cboSCEnter(Sender: TObject);
52 procedure txtQuantityEnter(Sender: TObject);
53 procedure btnUnitsClick(Sender: TObject);
54 procedure cmdComplexClick(Sender: TObject);
55 procedure memCommentsEnter(Sender: TObject);
56 private
57 //kt Begin Mod (change Consts to Vars) 8/8/2007
58 TX_NO_MED : string; //kt
59 TX_NO_DOSE : string; //kt
60 TX_NO_AMPER : string; //kt
61 TX_NO_ROUTE : string; //kt
62 TX_NF_ROUTE : string; //kt
63 TX_NO_SCHED : string; //kt
64 TX_NO_PICK : string; //kt
65 TX_RNG_REFILL : string; //kt
66 TX_SCH_QUOTE : string; //kt
67 TX_SCH_MINUS : string; //kt
68 TX_SCH_SPACE : string; //kt
69 TX_SCH_LEN : string; //kt
70 TX_SCH_PRN : string; //kt
71 TX_SCH_ZERO : string; //kt
72 TX_SCH_LSP : string; //kt
73 TX_SCH_NS : string; //kt
74 TX_OUTPT_IV : string; //kt
75 TX_QTY_NV : string; //kt
76 TX_QTY_MAIL : string; //kt
77 //kt End Mod -------------------
78 { Private declarations }
79 FLastDrug: Integer;
80 FLastMedID: string;
81 FDispenseMsg: string;
82 FMedCombo: TORComboBox;
83 procedure CheckFormAlt;
84 procedure ResetOnMedChange;
85 procedure SetAskSC;
86 procedure SetAltCombo;
87 procedure SetInstructions;
88 procedure SetOnOISelect;
89 procedure SetMaxRefills;
90 procedure SetupNouns;
91 procedure SetComplex;
92 procedure SetSimple;
93 procedure UnitClick(Sender: TObject);
94 procedure SetupVars; //kt
95 protected
96 procedure InitDialog; override;
97 procedure Validate(var AnErrMsg: string); override;
98 public
99 procedure SetupDialog(OrderAction: Integer; const ID: string); override;
100 end;
101
102implementation
103
104{$R *.DFM}
105
106uses rOrders, rODBase, fODMedFA, fODMedComplex;
107
108const
109 REFILLS_DFLT = '0';
110 REFILLS_MAX = 11;
111
112//TX_NO_MED = 'Medication must be entered.'; <-- original line. //kt 8/8/2007
113//TX_NO_DOSE = 'Instructions must be entered.'; <-- original line. //kt 8/8/2007
114//TX_NO_AMPER = 'Instructions may not contain the ampersand (&) character.'; <-- original line. //kt 8/8/2007
115//TX_NO_ROUTE = 'Route must be entered.'; <-- original line. //kt 8/8/2007
116//TX_NF_ROUTE = 'Route not found in the Medication Routes file.'; <-- original line. //kt 8/8/2007
117//TX_NO_SCHED = 'Schedule must be entered.'; <-- original line. //kt 8/8/2007
118//TX_NO_PICK = 'A method for picking up the medication must be entered.'; <-- original line. //kt 8/8/2007
119//TX_RNG_REFILL = 'The number of refills must be in the range of 0 through '; <-- original line. //kt 8/8/2007
120//TX_SCH_QUOTE = 'Schedule must not have quotemarks in it.'; <-- original line. //kt 8/8/2007
121//TX_SCH_MINUS = 'Schedule must not have a dash at the beginning.'; <-- original line. //kt 8/8/2007
122//TX_SCH_SPACE = 'Schedule must have only one space in it.'; <-- original line. //kt 8/8/2007
123//TX_SCH_LEN = 'Schedule must be less than 70 characters.'; <-- original line. //kt 8/8/2007
124//TX_SCH_PRN = 'Schedule cannot include PRN - use Comments to enter PRN.'; <-- original line. //kt 8/8/2007
125//TX_SCH_ZERO = 'Schedule cannot be Q0'; <-- original line. //kt 8/8/2007
126//TX_SCH_LSP = 'Schedule may not have leading spaces.'; <-- original line. //kt 8/8/2007
127//TX_SCH_NS = 'Unable to resolve non-standard schedule.'; <-- original line. //kt 8/8/2007
128//TX_OUTPT_IV = 'This patient has not been admitted. Only IV orders may be entered.'; <-- original line. //kt 8/8/2007
129//TX_QTY_NV = 'Unable to validate quantity.'; <-- original line. //kt 8/8/2007
130//TX_QTY_MAIL = 'Quantity for mailed items must be a whole number.'; <-- original line. //kt 8/8/2007
131
132
133{ TfrmODBase common methods }
134
135
136
137procedure TfrmODMedOut.SetupVars;
138//kt Added entire function to replace constant declarations 8/8/2007
139begin
140 TX_NO_MED := DKLangConstW('fODMedOut_Medication_must_be_enteredx');
141 TX_NO_DOSE := DKLangConstW('fODMedOut_Instructions_must_be_enteredx');
142 TX_NO_AMPER := DKLangConstW('fODMedOut_Instructions_may_not_contain_the_ampersand_xxx_characterx');
143 TX_NO_ROUTE := DKLangConstW('fODMedOut_Route_must_be_enteredx');
144 TX_NF_ROUTE := DKLangConstW('fODMedOut_Route_not_found_in_the_Medication_Routes_filex');
145 TX_NO_SCHED := DKLangConstW('fODMedOut_Schedule_must_be_enteredx');
146 TX_NO_PICK := DKLangConstW('fODMedOut_A_method_for_picking_up_the_medication_must_be_enteredx');
147 TX_RNG_REFILL := DKLangConstW('fODMedOut_The_number_of_refills_must_be_in_the_range_of_0_through');
148 TX_SCH_QUOTE := DKLangConstW('fODMedOut_Schedule_must_not_have_quotemarks_in_itx');
149 TX_SCH_MINUS := DKLangConstW('fODMedOut_Schedule_must_not_have_a_dash_at_the_beginningx');
150 TX_SCH_SPACE := DKLangConstW('fODMedOut_Schedule_must_have_only_one_space_in_itx');
151 TX_SCH_LEN := DKLangConstW('fODMedOut_Schedule_must_be_less_than_70_charactersx');
152 TX_SCH_PRN := DKLangConstW('fODMedOut_Schedule_cannot_include_PRN_x_use_Comments_to_enter_PRNx');
153 TX_SCH_ZERO := DKLangConstW('fODMedOut_Schedule_cannot_be_Q0');
154 TX_SCH_LSP := DKLangConstW('fODMedOut_Schedule_may_not_have_leading_spacesx');
155 TX_SCH_NS := DKLangConstW('fODMedOut_Unable_to_resolve_nonxstandard_schedulex');
156 TX_OUTPT_IV := DKLangConstW('fODMedOut_This_patient_has_not_been_admittedx__Only_IV_orders_may_be_enteredx');
157 TX_QTY_NV := DKLangConstW('fODMedOut_Unable_to_validate_quantityx');
158 TX_QTY_MAIL := DKLangConstW('fODMedOut_Quantity_for_mailed_items_must_be_a_whole_numberx');
159end;
160
161procedure TfrmODMedOut.FormCreate(Sender: TObject);
162//const
163//TC_RESTRICT = 'Ordering Restrictions'; <-- original line. //kt 8/8/2007
164var
165 Restriction: string;
166 TC_RESTRICT : string;
167begin
168 TC_RESTRICT := DKLangConstW('fODMedOut_Ordering_Restrictions'); //kt added 8/8/2007
169 inherited;
170 AllowQuickOrder := True;
171 CheckAuthForMeds(Restriction);
172 if Length(Restriction) > 0 then
173 begin
174 InfoBox(Restriction, TC_RESTRICT, MB_OK);
175 Close;
176 Exit;
177 end;
178 FillerID := 'PSO'; // does 'on Display' order check **KCM**
179//StatusText('Loading Dialog Definition'); <-- original line. //kt 8/8/2007
180 StatusText(DKLangConstW('fODMedOut_Loading_Dialog_Definition')); //kt added 8/8/2007
181 Responses.Dialog := 'PSO OERR'; // loads formatting info
182//StatusText('Loading Default Values'); <-- original line. //kt 8/8/2007
183 StatusText(DKLangConstW('fODMedOut_Loading_Default_Values')); //kt added 8/8/2007
184 CtrlInits.LoadDefaults(ODForMedOut); // ODForMedOut returns TStrings with defaults
185 InitDialog;
186//CtrlInits.SetControl(cboPickup, 'Pickup'); // do only once, so don't do in InitDialog <-- original line. //kt 8/8/2007
187 CtrlInits.SetControl(cboPickup, DKLangConstW('fODMedOut_Pickup')); //kt 8/8/2007
188 PreserveControl(cboPickup);
189end;
190
191procedure TfrmODMedOut.InitDialog;
192begin
193 inherited;
194 FLastDrug := 0;
195 FLastMedID := '';
196 FDispenseMsg := '';
197 FMedCombo := cboMedication; // this must be before SetControl(cboMedication)
198 with CtrlInits do
199 begin
200// SetControl(cboMedication, 'ShortList'); <-- original line. //kt 8/8/2007
201 SetControl(cboMedication, DKLangConstW('fODMedOut_ShortList')); //kt added 8/8/2007
202 cboMedication.InsertSeparator;
203 //SetControl(cboMedAlt, 'ShortList'); can't do this since it calls InitLongList
204// SetControl(cboSchedule, 'Schedules'); <-- original line. //kt 8/8/2007
205 SetControl(cboSchedule, DKLangConstW('fODMedOut_Schedules')); //kt added 8/8/2007
206// SetControl(cboPriority, 'Priorities'); <-- original line. //kt 8/8/2007
207 SetControl(cboPriority, DKLangConstW('fODMedOut_Priorities')); //kt added 8/8/2007
208 //SetControl(cboPickup, 'Pickup');
209// SetControl(cboSC, 'SCStatus'); <-- original line. //kt 8/8/2007
210 SetControl(cboSC, DKLangConstW('fODMedOut_SCStatus')); //kt added 8/8/2007
211 end;
212 SetAskSC;
213//StatusText('Retrieving List of Medications'); <-- original line. //kt 8/8/2007
214 StatusText(DKLangConstW('fODMedOut_Retrieving_List_of_Medications')); //kt added 8/8/2007
215 cboMedAlt.Visible := False;
216 cboMedication.Visible := True;
217 cboMedication.InitLongList('');
218 ActiveControl := cboMedication; //SetFocusedControl(FMedCombo);
219 SetSimple;
220 StatusText('');
221end;
222
223procedure TfrmODMedOut.SetupDialog(OrderAction: Integer; const ID: string);
224var
225 AnInstr: string;
226begin
227 inherited;
228 if OrderAction in [ORDER_COPY, ORDER_EDIT] then Responses.Remove('START', 1);
229 if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses do
230 begin
231 Changing := True;
232 SetControl(cboMedication, 'ORDERABLE', 1);
233 ResetOnMedChange;
234 SetOnOISelect;
235 SetAltCombo;
236 //cboMedicationSelect(Self);
237 SetControl(cboDispense, 'DRUG', 1);
238 SetInstructions;
239 SetControl(txtQuantity, 'QTY', 1);
240 SetControl(txtRefills, 'REFILLS', 1);
241 spnRefills.Position := StrToIntDef(txtRefills.Text, 0);
242 SetControl(cboPickup, 'PICKUP', 1);
243 SetControl(memComments, 'COMMENT', 1);
244 SetControl(cboPriority, 'URGENCY', 1);
245 { prevent the SIG from being part of the comments on pre-CPRS prescriptions }
246 if (OrderAction in [ORDER_COPY, ORDER_EDIT]) and (cboInstructions.Text = '') then
247 begin
248 AnInstr := TextForOrder(ID); //'SIG: ' + memComments.Text;
249 OrderMessage(AnInstr);
250 lblSIG.Visible := True;
251 txtSIG.Visible := True;
252 txtSIG.Text := memComments.Text;
253 memComments.Clear;
254 end;
255 { can't edit the orderable item for a med order that has been released }
256 if (OrderAction = ORDER_EDIT) and OrderIsReleased(EditOrder)
257 then FMedCombo.Enabled := False;
258 Changing := False;
259 ControlChange(Self);
260 end;
261 if OrderAction <> ORDER_EDIT then SetFocusedControl(FMedCombo);
262end;
263
264procedure TfrmODMedOut.Validate(var AnErrMsg: string);
265var
266 Sched: Integer;
267 RouteID, RouteAbbr: string;
268
269 procedure SetError(const x: string);
270 begin
271 if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
272 AnErrMsg := AnErrMsg + x;
273 end;
274
275begin
276 SetupVars; //kt added 8/8/2007 to replace constants with vars.
277 inherited;
278 if Length(cboMedAlt.Text) = 0 then SetError(TX_NO_MED);
279 // if memComplex is Visible, then the dosage fields were validated in fMedComplex
280 if memComplex.Visible = False then
281 begin
282 if Length(cboInstructions.Text) = 0 then SetError(TX_NO_DOSE);
283 if Pos('&', cboInstructions.Text) > 0 then SetError(TX_NO_AMPER);
284 if (Length(cboRoute.Text) = 0) and (not MedIsSupply(cboMedAlt.ItemIEN))
285 then SetError(TX_NO_ROUTE);
286 if (Length(cboRoute.Text) > 0) and (cboRoute.ItemIndex < 0) then
287 begin
288 LookupRoute(cboRoute.Text, RouteID, RouteAbbr);
289 if RouteID = '0'
290 then SetError(TX_NF_ROUTE)
291 else Responses.Update('ROUTE', 1, RouteID, RouteAbbr);
292 end;
293 if Length(cboSchedule.Text) = 0 then SetError(TX_NO_SCHED);
294 end;
295 if cboPickup.ItemID = '' then SetError(TX_NO_PICK);
296 if StrToIntDef(txtRefills.Text, 99) > spnRefills.Max
297 then SetError(TX_RNG_REFILL + IntToStr(spnRefills.Max));
298 with cboSchedule do if Length(Text) > 0 then
299 begin
300 Sched := ValidSchedule(Text);
301 if Sched = -1 then
302 begin
303 if Pos('"', Text) > 0 then SetError(TX_SCH_QUOTE);
304 if Copy(Text, 1, 1) = '-' then SetError(TX_SCH_MINUS);
305 if Pos(' ', Copy(Text, Pos(' ', Text) + 1, 999)) > 0 then SetError(TX_SCH_SPACE);
306 if Length(Text) > 70 then SetError(TX_SCH_LEN);
307 if (Pos('P RN', Text) > 0) or (Pos('PR N', Text) > 0) then SetError(TX_SCH_PRN);
308 if Pos('Q0', Text) > 0 then SetError(TX_SCH_ZERO);
309 if TrimLeft(Text) <> Text then SetError(TX_SCH_LSP);
310 end;
311 if Sched = 0 then SetError(TX_SCH_NS);
312 end;
313 with txtQuantity do if Length(Text) > 0 then
314 begin
315 if not ValidQuantity(Text) then SetError(TX_QTY_NV);
316 //if (cboPickup.ItemID = 'M') and (IntToStr(StrToIntDef(Text,-1)) <> Text)
317 // then SetError(TX_QTY_MAIL);
318 end;
319end;
320
321{ cboMedication methods }
322
323procedure TfrmODMedOut.ResetOnMedChange;
324begin
325 ClearControl(cboDispense);
326 ClearControl(cboInstructions);
327 btnUnits.Caption := '';
328 ResetControl(cboRoute);
329 ResetControl(cboSchedule);
330 ClearControl(txtQuantity);
331 txtRefills.Text := REFILLS_DFLT;
332 spnRefills.Max := REFILLS_MAX;
333 ClearControl(memComments);
334 ClearControl(memOrder);
335end;
336
337procedure TfrmODMedOut.SetAltCombo;
338begin
339 with cboMedication do
340 begin
341 FMedCombo := cboMedAlt;
342// if cboMedAlt.Items.Count = 0 then CtrlInits.SetListOnly(cboMedAlt, 'ShortList'); <-- original line. //kt 8/8/2007
343 if cboMedAlt.Items.Count = 0 then CtrlInits.SetListOnly(cboMedAlt, DKLangConstW('fODMedOut_ShortList')); //kt added 8/8/2007
344 cboMedAlt.SetExactByIEN(ItemIEN, TrimRight(Piece(Text, '<', 1)));
345 cboMedication.Visible := False;
346 cboMedAlt.Visible := True;
347 end;
348end;
349
350procedure TfrmODMedOut.SetOnOISelect;
351begin
352 with CtrlInits do
353 begin
354 FLastMedID := FMedCombo.ItemID;
355 LoadOrderItem(OIForMedOut(FMedCombo.ItemIEN));
356// SetControl(cboDispense, 'Dispense'); <-- original line. //kt 8/8/2007
357 SetControl(cboDispense, DKLangConstW('fODMedOut_Dispense')); //kt added 8/8/2007
358 if cboDispense.Items.Count = 1 then cboDispense.ItemIndex := 0;
359// lblDosage.Caption := DefaultText('Verb'); <-- original line. //kt 8/8/2007
360 lblDosage.Caption := DefaultText(DKLangConstW('fODMedOut_Verb')); //kt added 8/8/2007
361// if lblDosage.Caption = '' then lblDosage.Caption := 'Amount'; <-- original line. //kt 8/8/2007
362 if lblDosage.Caption = '' then lblDosage.Caption := DKLangConstW('fODMedOut_Amount'); //kt added 8/8/2007
363// SetControl(cboInstructions, 'Instruct'); <-- original line. //kt 8/8/2007
364 SetControl(cboInstructions, DKLangConstW('fODMedOut_Instruct')); //kt added 8/8/2007
365 SetupNouns;
366// SetControl(cboRoute, 'Route'); <-- original line. //kt 8/8/2007
367 SetControl(cboRoute, DKLangConstW('fODMedOut_Route')); //kt added 8/8/2007
368 if cboRoute.Items.Count = 1 then cboRoute.ItemIndex := 0;
369// if DefaultText('DefSched') <> '' then cboSchedule.SelectByID(DefaultText('DefSched')); <-- original line. //kt 8/8/2007
370 if DefaultText(DKLangConstW('fODMedOut_DefSched')) <> '' then cboSchedule.SelectByID(DefaultText(DKLangConstW('fODMedOut_DefSched'))); //kt added 8/8/2007
371// OrderMessage(TextOf('Message')); <-- original line. //kt 8/8/2007
372 OrderMessage(TextOf(DKLangConstW('fODMedOut_Message'))); //kt added 8/8/2007
373 end;
374end;
375
376procedure TfrmODMedOut.cboMedicationNeedData(Sender: TObject; const StartFrom: string;
377 Direction, InsertAt: Integer);
378{ retrieves a subset of inpatient medication orderable items }
379begin
380 inherited;
381 FMedCombo.ForDataUse(SubSetOfOrderItems(StartFrom, Direction, 'S.O RX'));
382end;
383
384procedure TfrmODMedOut.cboMedicationSelect(Sender: TObject);
385{ sets related controls whenever orderable item changes (MouseClick or Exit) }
386begin
387 inherited;
388 with FMedCombo do
389 begin
390 if ItemID <> FLastMedID then FLastMedID := ItemID else Exit;
391 Changing := True;
392 if Sender <> Self then Responses.Clear; // Sender=Self when called from SetupDialog
393 ResetOnMedChange;
394 if CharAt(ItemID, 1) = 'Q' then
395 begin
396 Responses.QuickOrder := ExtractInteger(ItemID);
397 Responses.SetControl(FMedCombo, 'ORDERABLE', 1);
398 end;
399 if ItemIEN > 0 then SetOnOISelect;
400 end;
401 with Responses do if QuickOrder > 0 then
402 begin
403 SetControl(FMedCombo, 'ORDERABLE', 1);
404 SetControl(cboDispense, 'DRUG', 1);
405 SetInstructions;
406 SetControl(txtQuantity, 'QTY', 1);
407 SetControl(txtRefills, 'REFILLS', 1);
408 spnRefills.Position := StrToIntDef(txtRefills.Text, 0);
409 SetControl(cboPickup, 'PICKUP', 1);
410 SetControl(memComments, 'COMMENT', 1);
411 SetControl(cboPriority, 'URGENCY', 1);
412 end;
413 Changing := False;
414 ControlChange(Self);
415 if FMedCombo = cboMedication then SetAltCombo;
416 // if the Dispense drug was stuffed - still do the checks (form alt, refills)
417 if cboDispense.ItemIndex > -1 then cboDispenseMouseClick(Self);
418end;
419
420{ cboDispense methods }
421
422procedure TfrmODMedOut.CheckFormAlt;
423var
424 DrugName, OIName: string;
425 Drug, OI: Integer;
426begin
427 with cboDispense do if (ItemIndex > -1) and (Piece(Items[ItemIndex], U, 4) = 'NF') then
428 begin
429 SelectFormularyAlt(ItemIEN, Drug, OI, DrugName, OIName, PST_OUTPATIENT);
430 if Drug > 0 then
431 begin
432 if FMedCombo.ItemIEN <> OI then
433 begin
434 FMedCombo.InitLongList(OIName);
435 FMedCombo.SelectByIEN(OI);
436 cboMedicationSelect(Self);
437 end;
438 cboDispense.SelectByIEN(Drug);
439 end; {if FormAlt}
440 end; {if ItemIndex}
441 SetAskSC; // now check enabled for the service connected prompt
442end;
443
444procedure TfrmODMedOut.SetMaxRefills;
445begin
446 with cboDispense do if (ItemIndex > -1) and (Length(Piece(Items[ItemIndex], U, 6)) > 0) then
447 begin
448 spnRefills.Max := StrToIntDef(Piece(Items[ItemIndex], U, 6), REFILLS_MAX);
449 if StrToIntDef(txtRefills.Text, 0) > spnRefills.Max then
450 begin
451 txtRefills.Text := IntToStr(spnRefills.Max);
452 spnRefills.Position := spnRefills.Max;
453 end;
454 end;
455end;
456
457procedure TfrmODMedOut.cboDispenseExit(Sender: TObject);
458var
459 AMsg: string;
460begin
461 inherited;
462 SetMaxRefills;
463 with cboDispense do
464 begin
465 if ItemIEN <> FLastDrug then CheckFormAlt;
466 if ItemIEN > 0 then
467 begin
468 AMsg := DispenseMessage(ItemIEN) + CRLF;
469 if memMessage.Text <> AMsg then OrderMessage(AMsg);
470 end;
471 FLastDrug := ItemIEN;
472 end;
473end;
474
475procedure TfrmODMedOut.cboDispenseMouseClick(Sender: TObject);
476begin
477 inherited;
478 SetMaxRefills;
479 with cboDispense do
480 begin
481 if ItemIEN <> FLastDrug then CheckFormAlt;
482 if ItemIEN > 0 then OrderMessage(DispenseMessage(ItemIEN));
483 FLastDrug := ItemIEN;
484 end;
485end;
486
487{ dosage instructions }
488
489procedure TfrmODMedOut.SetupNouns;
490var
491 AvailWidth, MaxWidth: Integer;
492begin
493//CtrlInits.SetPopupMenu(popUnits, UnitClick, 'Nouns'); <-- original line. //kt 8/8/2007
494 CtrlInits.SetPopupMenu(popUnits, UnitClick, DKLangConstW('fODMedOut_Nouns')); //kt added 8/8/2007
495 if popUnits.Items.Count > 0 then
496 begin
497 // Make sure cboInstructions is at least 40 pixels wide so it can show values
498 // like "1/2". Allow for a 3 pixel space between the the Units button & Route.
499 AvailWidth := (cboRoute.Left - 3) - (cboInstructions.Left + 40);
500 MaxWidth := popUnits.Tag + 9; // allow 9 pixels for the down arrow & button border
501 if MaxWidth > AvailWidth then MaxWidth := AvailWidth;
502 btnUnits.Width := MaxWidth;
503 btnUnits.Left := cboRoute.Left - MaxWidth - 3;
504 cboInstructions.Width := btnUnits.Left - cboInstructions.Left;
505 btnUnits.Caption := popUnits.Items[0].Caption;
506 btnUnits.Visible := True;
507 end else
508 begin
509 btnUnits.Visible := False;
510 // Allow for a 6 pixel margin between the Instructions box & Route
511 cboInstructions.Width := cboRoute.Left - cboInstructions.Left - 6;
512 end;
513end;
514
515procedure TfrmODMedOut.btnUnitsClick(Sender: TObject);
516var
517 APoint: TPoint;
518begin
519 inherited;
520 APoint := btnUnits.ClientToScreen(Point(0, btnUnits.Height));
521 popUnits.Popup(APoint.X, APoint.Y);
522end;
523
524procedure TfrmODMedOut.UnitClick(Sender: TObject);
525begin
526 btnUnits.Caption := TMenuItem(Sender).Caption;
527end;
528
529procedure TfrmODMedOut.SetComplex;
530begin
531 lblDosage.Visible := False;;
532 lblRoute.Visible := False;;
533 lblSchedule.Visible := False;;
534 cboInstructions.Visible := False;
535 btnUnits.Visible := False;;
536 cboRoute.Visible := False;
537 cboSchedule.Visible := False;
538 memComplex.Visible := True;
539//cmdComplex.Caption := 'Change Dose...'; <-- original line. //kt 8/8/2007
540 cmdComplex.Caption := DKLangConstW('fODMedOut_Change_Dosexxx'); //kt added 8/8/2007
541end;
542
543procedure TfrmODMedOut.SetSimple;
544begin
545 memComplex.Visible := False;
546 lblDosage.Visible := True;;
547 lblRoute.Visible := True;;
548 lblSchedule.Visible := True;;
549 cboInstructions.Visible := True;
550 btnUnits.Visible := (popUnits.Items.Count > 0) or (btnUnits.Caption <> '');
551 cboRoute.Visible := True;
552 cboSchedule.Visible := True;
553//cmdComplex.Caption := 'Complex Dose...'; <-- original line. //kt 8/8/2007
554 cmdComplex.Caption := DKLangConstW('fODMedOut_Complex_Dosexxx'); //kt added 8/8/2007
555end;
556
557procedure TfrmODMedOut.SetInstructions;
558var
559 x: string;
560 AnInstance: Integer;
561begin
562 case Responses.InstanceCount('INSTR') of
563 0: begin
564 cboInstructions.ItemIndex := -1;
565 // there may still be a route & schedule (for copied orders)
566 if Responses.EValueFor('MISC', 1) <> ''
567 then btnUnits.Caption := Responses.EValueFor('MISC', 1);
568 Responses.SetControl(cboRoute, 'ROUTE', 1);
569 with cboRoute do if ItemIndex > -1 then Text := DisplayText[ItemIndex];
570 Responses.SetControl(cboSchedule, 'SCHEDULE', 1);
571 SetSimple;
572 end;
573 1: begin
574 AnInstance := Responses.NextInstance('INSTR', 0);
575 Responses.SetControl(cboInstructions, 'INSTR', AnInstance);
576 btnUnits.Caption := Responses.IValueFor('MISC', AnInstance);
577 Responses.SetControl(cboRoute, 'ROUTE', AnInstance);
578 with cboRoute do if ItemIndex > -1 then Text := DisplayText[ItemIndex];
579 Responses.SetControl(cboSchedule, 'SCHEDULE', AnInstance);
580 SetSimple;
581 end;
582 else begin
583 memComplex.Clear;
584 AnInstance := Responses.NextInstance('INSTR', 0);
585 while AnInstance > 0 do
586 begin
587 x := Responses.EValueFor('INSTR', AnInstance);
588 x := x + ' ' + Responses.EValueFor('MISC', AnInstance);
589 x := x + ' ' + Responses.EValueFor('ROUTE', AnInstance);
590 x := x + ' ' + Responses.EValueFor('SCHEDULE', AnInstance);
591 if Length(Responses.EValueFor('DAYS', AnInstance)) > 0
592// then x := x + ' ' + Responses.EValueFor('DAYS', AnInstance) + ' day(s)'; <-- original line. //kt 8/8/2007
593 then x := x + ' ' + Responses.EValueFor('DAYS', AnInstance) + DKLangConstW('fODMedOut_dayxsx'); //kt added 8/8/2007
594 memComplex.Lines.Add(x);
595 AnInstance := Responses.NextInstance('INSTR', AnInstance);
596 end;
597 SetComplex;
598 end;
599 end; {case}
600 memOrder.Text := Responses.OrderText;
601end; {if ExecuteComplexDose}
602
603procedure TfrmODMedOut.cmdComplexClick(Sender: TObject);
604begin
605 SetupVars; //kt added 8/8/2007 to replace constants with vars.
606 inherited;
607 if FMedCombo.ItemIEN = 0 then
608 begin
609// InfoBox(TX_NO_MED, 'Error', MB_OK); <-- original line. //kt 8/8/2007
610 InfoBox(TX_NO_MED, DKLangConstW('fODMedOut_Error'), MB_OK); //kt added 8/8/2007
611 Exit;
612 end;
613 if ExecuteComplexDose(CtrlInits, Responses) then SetInstructions;
614end;
615
616{ quantity }
617
618procedure TfrmODMedOut.txtQuantityEnter(Sender: TObject);
619begin
620 inherited;
621 with cboDispense do if ItemIEN > 0 then OrderMessage(QuantityMessage(ItemIEN));
622end;
623
624{ service connection }
625
626procedure TfrmODMedOut.SetAskSC;
627const
628 SC_NO = 0;
629 SC_YES = 1;
630begin
631 if Patient.ServiceConnected and RequiresCopay(FLastDrug) then
632 begin
633 lblSC.Font.Color := clWindowText;
634 cboSC.Enabled := True;
635 cboSC.Color := clWindow;
636 if Patient.SCPercent > 50 then cboSC.SelectByIEN(SC_YES) else cboSC.SelectByIEN(SC_NO);
637 end else
638 begin
639 lblSC.Font.Color := clGrayText;
640 cboSC.Enabled := False;
641 cboSC.Color := clBtnFace;
642 cboSC.ItemIndex := -1;
643 end;
644end;
645
646procedure TfrmODMedOut.cboSCEnter(Sender: TObject);
647begin
648 inherited;
649 OrderMessage(RatedDisabilities);
650end;
651
652{ comments }
653
654procedure TfrmODMedOut.memCommentsEnter(Sender: TObject);
655begin
656 inherited;
657 OrderMessage(''); // make sure Order Message disappears when in comments box
658end;
659
660{ all controls }
661
662procedure TfrmODMedOut.ControlChange(Sender: TObject);
663begin
664 inherited;
665 if csLoading in ComponentState then Exit; // to prevent error caused by txtRefills
666 if Changing then Exit;
667 if FMedCombo.ItemIEN = 0 then Exit; // prevent txtRefills from updating early
668 with FMedCombo do if ItemIEN > 0
669 then Responses.Update('ORDERABLE', 1, ItemID, Piece(Items[ItemIndex], U, 3))
670 else Responses.Update('ORDERABLE', 1, '', '');
671 with cboDispense do if ItemIEN > 0
672 then Responses.Update('DRUG', 1, ItemID, Piece(Items[ItemIndex], U, 2))
673 else Responses.Update('DRUG', 1, '', '');
674 if memComplex.Visible = False then
675 begin
676 with cboInstructions do Responses.Update('INSTR', 1, Text, Text);
677 with btnUnits do if Visible then Responses.Update('MISC', 1, Caption, Caption);
678 with cboRoute do if ItemIndex > -1
679 then Responses.Update('ROUTE', 1, ItemID, Piece(Items[ItemIndex], U, 3)) // abbreviation
680 else Responses.Update('ROUTE', 1, Text, Text);
681 with cboSchedule do Responses.Update('SCHEDULE', 1, Text, Text);
682 end;
683 with txtQuantity do Responses.Update('QTY', 1, Text, Text);
684 with txtRefills do Responses.Update('REFILLS', 1, Text, Text);
685 with cboPickup do Responses.Update('PICKUP', 1, ItemID, Text);
686 with cboPriority do Responses.Update('URGENCY', 1, ItemID, Text);
687 with memComments do Responses.Update('COMMENT', 1, TX_WPTYPE, Text);
688 with cboSC do if Enabled then Responses.Update('SC', 1, ItemID, Text);
689 memOrder.Text := Responses.OrderText;
690end;
691
692end.
693
Note: See TracBrowser for help on using the repository browser.