source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/fODMedIn.pas@ 1700

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

Initial upload of TMG-CPRS 1.0.26.69
File size: 16.6 KB
Line 
1//kt -- Modified with SourceScanner on 8/8/2007
2unit fODMedIn;
3
4{$OPTIMIZATION OFF}
5
6interface
7
8uses
9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
10 fODBase, ORCtrls, StdCtrls, ORFn, ExtCtrls, uConst, ComCtrls, uCore,
11 Menus, DKLang;
12
13type
14 TfrmODMedIn = class(TfrmODBase)
15 lblMedication: TLabel;
16 cboMedication: TORComboBox;
17 lblDosage: TLabel;
18 lblRoute: TLabel;
19 cboRoute: TORComboBox;
20 lblSchedule: TLabel;
21 cboSchedule: TORComboBox;
22 Label5: TLabel;
23 cboDispense: TORComboBox;
24 lblComments: TLabel;
25 memComments: TMemo;
26 lblPriority: TLabel;
27 cboPriority: TORComboBox;
28 txtDosage: TCaptionEdit;
29 Bevel1: TBevel;
30 cboMedAlt: TORComboBox;
31 procedure cboMedicationNeedData(Sender: TObject; const StartFrom: string;
32 Direction, InsertAt: Integer);
33 procedure cboMedicationSelect(Sender: TObject);
34 procedure FormCreate(Sender: TObject);
35 procedure ControlChange(Sender: TObject);
36 procedure cboDispenseExit(Sender: TObject);
37 procedure cboDispenseMouseClick(Sender: TObject);
38 private
39 //kt Begin Mod (change Consts to Vars) 8/8/2007
40 TX_NO_MED : string; //kt
41 TX_NO_DOSE : string; //kt
42 TX_NO_AMPER : string; //kt
43 TX_NO_ROUTE : string; //kt
44 TX_NF_ROUTE : string; //kt
45 TX_NO_SCHED : string; //kt
46 TX_DOSE_AMT : string; //kt
47 TX_SCH_QUOTE : string; //kt
48 TX_SCH_MINUS : string; //kt
49 TX_SCH_SPACE : string; //kt
50 TX_SCH_LEN : string; //kt
51 TX_SCH_PRN : string; //kt
52 TX_SCH_ZERO : string; //kt
53 TX_SCH_LSP : string; //kt
54 TX_SCH_NS : string; //kt
55 TX_OUTPT_IV : string; //kt
56 //kt End Mod -------------------
57 { Private declarations }
58 FLastDrug: Integer;
59 FLastMedID: string;
60 FDispenseMsg: string;
61 FMedCombo: TORComboBox;
62 procedure CheckFormAlt;
63 procedure ResetOnMedChange;
64 procedure SetAltCombo;
65 procedure SetOnOISelect;
66 procedure SetupVars; //kt
67 protected
68 procedure InitDialog; override;
69 procedure Validate(var AnErrMsg: string); override;
70 public
71 procedure SetupDialog(OrderAction: Integer; const ID: string); override;
72 end;
73
74implementation
75
76{$R *.DFM}
77
78uses rOrders, rODBase, fODMedFA;
79
80//const
81//TX_NO_MED = 'Medication must be entered.'; <-- original line. //kt 8/8/2007
82//TX_NO_DOSE = 'Dosage must be entered.'; <-- original line. //kt 8/8/2007
83//TX_NO_AMPER = 'Dosage may not contain the ampersand (&) character.'; <-- original line. //kt 8/8/2007
84//TX_NO_ROUTE = 'Route must be entered.'; <-- original line. //kt 8/8/2007
85//TX_NF_ROUTE = 'Route not found in the Medication Routes file.'; <-- original line. //kt 8/8/2007
86//TX_NO_SCHED = 'Schedule must be entered.'; <-- original line. //kt 8/8/2007
87//TX_DOSE_AMT = 'Dosage must be the amount given, not simply the number of units.'; <-- original line. //kt 8/8/2007
88//TX_SCH_QUOTE = 'Schedule must not have quotemarks in it.'; <-- original line. //kt 8/8/2007
89//TX_SCH_MINUS = 'Schedule must not have a dash at the beginning.'; <-- original line. //kt 8/8/2007
90//TX_SCH_SPACE = 'Schedule must have only one space in it.'; <-- original line. //kt 8/8/2007
91//TX_SCH_LEN = 'Schedule must be less than 70 characters.'; <-- original line. //kt 8/8/2007
92//TX_SCH_PRN = 'Schedule cannot include PRN - use Comments to enter PRN.'; <-- original line. //kt 8/8/2007
93//TX_SCH_ZERO = 'Schedule cannot be Q0.'; <-- original line. //kt 8/8/2007
94//TX_SCH_LSP = 'Schedule may not have leading spaces.'; <-- original line. //kt 8/8/2007
95//TX_SCH_NS = 'Unable to resolve non-standard schedule.'; <-- original line. //kt 8/8/2007
96//TX_OUTPT_IV = 'This patient has not been admitted. Only IV orders may be entered.'; <-- original line. //kt 8/8/2007
97
98{ TfrmODBase common methods }
99
100
101
102procedure TfrmODMedIn.SetupVars;
103//kt Added entire function to replace constant declarations 8/8/2007
104begin
105 TX_NO_MED := DKLangConstW('fODMedIn_Medication_must_be_enteredx');
106 TX_NO_DOSE := DKLangConstW('fODMedIn_Dosage_must_be_enteredx');
107 TX_NO_AMPER := DKLangConstW('fODMedIn_Dosage_may_not_contain_the_ampersand_xxx_characterx');
108 TX_NO_ROUTE := DKLangConstW('fODMedIn_Route_must_be_enteredx');
109 TX_NF_ROUTE := DKLangConstW('fODMedIn_Route_not_found_in_the_Medication_Routes_filex');
110 TX_NO_SCHED := DKLangConstW('fODMedIn_Schedule_must_be_enteredx');
111 TX_DOSE_AMT := DKLangConstW('fODMedIn_Dosage_must_be_the_amount_givenx_not_simply_the_number_of_unitsx');
112 TX_SCH_QUOTE := DKLangConstW('fODMedIn_Schedule_must_not_have_quotemarks_in_itx');
113 TX_SCH_MINUS := DKLangConstW('fODMedIn_Schedule_must_not_have_a_dash_at_the_beginningx');
114 TX_SCH_SPACE := DKLangConstW('fODMedIn_Schedule_must_have_only_one_space_in_itx');
115 TX_SCH_LEN := DKLangConstW('fODMedIn_Schedule_must_be_less_than_70_charactersx');
116 TX_SCH_PRN := DKLangConstW('fODMedIn_Schedule_cannot_include_PRN_x_use_Comments_to_enter_PRNx');
117 TX_SCH_ZERO := DKLangConstW('fODMedIn_Schedule_cannot_be_Q0x');
118 TX_SCH_LSP := DKLangConstW('fODMedIn_Schedule_may_not_have_leading_spacesx');
119 TX_SCH_NS := DKLangConstW('fODMedIn_Unable_to_resolve_nonxstandard_schedulex');
120 TX_OUTPT_IV := DKLangConstW('fODMedIn_This_patient_has_not_been_admittedx__Only_IV_orders_may_be_enteredx');
121end;
122
123procedure TfrmODMedIn.FormCreate(Sender: TObject);
124//const
125//TC_RESTRICT = 'Ordering Restrictions'; <-- original line. //kt 8/8/2007
126var
127 Restriction: string;
128 TC_RESTRICT: string; //kt added 8/8/2007
129begin
130 TC_RESTRICT := DKLangConstW('fODMedIn_Ordering_Restrictions'); //kt added 8/8/2007
131 inherited;
132 AllowQuickOrder := True;
133 CheckAuthForMeds(Restriction);
134 if Length(Restriction) > 0 then
135 begin
136 InfoBox(Restriction, TC_RESTRICT, MB_OK);
137 Close;
138 Exit;
139 end;
140 FillerID := 'PSI'; // does 'on Display' order check **KCM**
141//StatusText('Loading Dialog Definition'); <-- original line. //kt 8/8/2007
142 StatusText(DKLangConstW('fODMedIn_Loading_Dialog_Definition')); //kt added 8/8/2007
143 Responses.Dialog := 'PSJ OR PAT OE'; // loads formatting info
144//StatusText('Loading Default Values'); <-- original line. //kt 8/8/2007
145 StatusText(DKLangConstW('fODMedIn_Loading_Default_Values')); //kt added 8/8/2007
146 CtrlInits.LoadDefaults(ODForMedIn); // ODForMedIn returns TStrings with defaults
147 InitDialog;
148end;
149
150procedure TfrmODMedIn.InitDialog;
151begin
152 inherited;
153 FLastDrug := 0;
154 FLastMedID := '';
155 FDispenseMsg := '';
156 FMedCombo := cboMedication; // this must be before SetControl(cboMedication)
157 with CtrlInits do
158 begin
159// SetControl(cboMedication, 'ShortList'); <-- original line. //kt 8/8/2007
160 SetControl(cboMedication, DKLangConstW('fODMedIn_ShortList')); //kt added 8/8/2007
161 cboMedication.InsertSeparator;
162 //SetControl(cboMedAlt, 'ShortList'); can't do this since it calls InitLongList
163// SetControl(cboSchedule, 'Schedules'); <-- original line. //kt 8/8/2007
164 SetControl(cboSchedule, DKLangConstW('fODMedIn_Schedules')); //kt added 8/8/2007
165// SetControl(cboPriority, 'Priorities'); <-- original line. //kt 8/8/2007
166 SetControl(cboPriority, DKLangConstW('fODMedIn_Priorities')); //kt added 8/8/2007
167 end;
168//StatusText('Initializing Long List'); <-- original line. //kt 8/8/2007
169 StatusText(DKLangConstW('fODMedIn_Initializing_Long_List')); //kt added 8/8/2007
170 cboMedAlt.Visible := False;
171 cboMedication.Visible := True;
172 cboMedication.InitLongList('');
173 ActiveControl := cboMedication; //SetFocusedControl(FMedCombo);
174 StatusText('');
175end;
176
177procedure TfrmODMedIn.SetupDialog(OrderAction: Integer; const ID: string);
178begin
179 inherited;
180 if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses do
181 begin
182 Changing := True; //v12a
183 SetControl(cboMedication, 'ORDERABLE', 1);
184 ResetOnMedChange; //v12a
185 SetOnOISelect; //v12a
186 SetAltCombo; //v12a
187 //cboMedicationSelect(Self);
188 SetControl(cboDispense, 'DRUG', 1);
189 SetControl(txtDosage, 'INSTR', 1);
190 SetControl(cboRoute, 'ROUTE', 1);
191 SetControl(cboSchedule, 'SCHEDULE', 1);
192 SetControl(memComments, 'COMMENT', 1);
193 SetControl(cboPriority, 'URGENCY', 1);
194 { can't edit the orderable item for a med order that has been released }
195 if (OrderAction = ORDER_EDIT) and OrderIsReleased(EditOrder)
196 then FMedCombo.Enabled := False;
197 Changing := False; //v12a
198 ControlChange(Self); //v12a
199 end;
200 if OrderAction <> ORDER_EDIT then SetFocusedControl(FMedCombo);
201end;
202
203procedure TfrmODMedIn.Validate(var AnErrMsg: string);
204var
205 Sched: Integer;
206 RouteID, RouteAbbr: string;
207
208
209 procedure SetError(const x: string);
210 begin
211 if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
212 AnErrMsg := AnErrMsg + x;
213 end;
214
215begin
216 SetupVars; //kt added 8/8/2007 to replace constants with vars.
217 inherited;
218 if Length(cboMedAlt.Text) = 0 then SetError(TX_NO_MED);
219 if Length(txtDosage.Text) = 0 then SetError(TX_NO_DOSE);
220 if Pos('&', txtDosage.Text) > 0 then SetError(TX_NO_AMPER);
221 if Length(cboRoute.Text) = 0 then SetError(TX_NO_ROUTE);
222 if (Length(cboRoute.Text) > 0) and (cboRoute.ItemIndex < 0) then
223 begin
224 LookupRoute(cboRoute.Text, RouteID, RouteAbbr);
225 if RouteID = '0'
226 then SetError(TX_NF_ROUTE)
227 else Responses.Update('ROUTE', 1, RouteID, RouteAbbr);
228 end;
229 if Length(cboSchedule.Text) = 0 then SetError(TX_NO_SCHED);
230 with cboSchedule do if Length(Text) > 0 then
231 begin
232 Sched := ValidSchedule(Text);
233 if Sched = -1 then
234 begin
235 if Pos('"', Text) > 0 then SetError(TX_SCH_QUOTE);
236 if Copy(Text, 1, 1) = '-' then SetError(TX_SCH_MINUS);
237 if Pos(' ', Copy(Text, Pos(' ', Text) + 1, 999)) > 0 then SetError(TX_SCH_SPACE);
238 if Length(Text) > 70 then SetError(TX_SCH_LEN);
239 if (Pos('P RN', Text) > 0) or (Pos('PR N', Text) > 0) then SetError(TX_SCH_PRN);
240 if Pos('Q0', Text) > 0 then SetError(TX_SCH_ZERO);
241 if TrimLeft(Text) <> Text then SetError(TX_SCH_LSP);
242 end;
243 if Sched = 0 then SetError(TX_SCH_NS);
244 end;
245 if (Length(txtDosage.Text) > 0) and (not ContainsAlpha(txtDosage.Text))
246 then SetError(TX_DOSE_AMT);
247 if (not OrderForInpatient) and (not MedTypeIsIV(cboMedAlt.ItemIEN))
248 then SetError(TX_OUTPT_IV);
249end;
250
251{ cboMedication methods }
252
253procedure TfrmODMedIn.ResetOnMedChange;
254begin
255 ClearControl(cboDispense);
256 ClearControl(txtDosage);
257 ClearControl(cboRoute); // routes should be cached
258 ResetControl(cboSchedule);
259 ClearControl(memComments);
260 ClearControl(memOrder);
261end;
262
263procedure TfrmODMedIn.SetAltCombo;
264begin
265 with cboMedication do
266 begin
267 FMedCombo := cboMedAlt;
268 if cboMedAlt.Items.Count = 0 then
269 begin
270// CtrlInits.SetListOnly(cboMedAlt, 'ShortList'); <-- original line. //kt 8/8/2007
271 CtrlInits.SetListOnly(cboMedAlt, DKLangConstW('fODMedIn_ShortList')); //kt added 8/8/2007
272 cboMedAlt.InsertSeparator;
273 end;
274 cboMedAlt.SetExactByIEN(ItemIEN, TrimRight(Piece(Text, '<', 1)));
275 cboMedication.Visible := False;
276 cboMedAlt.Visible := True;
277 end;
278end;
279
280procedure TfrmODMedIn.SetOnOISelect;
281begin
282 with CtrlInits do
283 begin
284 FLastMedID := FMedCombo.ItemID;
285 LoadOrderItem(OIForMedIn(FMedCombo.ItemIEN));
286// SetControl(cboDispense, 'Dispense'); <-- original line. //kt 8/8/2007
287 SetControl(cboDispense, DKLangConstW('fODMedIn_Dispense')); //kt added 8/8/2007
288 if cboDispense.Items.Count = 1 then cboDispense.ItemIndex := 0;
289// SetControl(txtDosage, 'Instruct'); <-- original line. //kt 8/8/2007
290 SetControl(txtDosage, DKLangConstW('fODMedIn_Instruct')); //kt added 8/8/2007
291// SetControl(cboRoute, 'Route'); <-- original line. //kt 8/8/2007
292 SetControl(cboRoute, DKLangConstW('fODMedIn_Route')); //kt added 8/8/2007
293 if cboRoute.Items.Count = 1 then cboRoute.ItemIndex := 0;
294 //cboRoute.InsertSeparator;
295 //AppendMedRoutes(cboRoute.Items);
296// if DefaultText('DefSched') <> '' then cboSchedule.SelectByID(DefaultText('DefSched')); <-- original line. //kt 8/8/2007
297 if DefaultText(DKLangConstW('fODMedIn_DefSched')) <> '' then cboSchedule.SelectByID(DefaultText(DKLangConstW('fODMedIn_DefSched'))); //kt added 8/8/2007
298// OrderMessage(TextOf('Message')); <-- original line. //kt 8/8/2007
299 OrderMessage(TextOf(DKLangConstW('fODMedIn_Message'))); //kt added 8/8/2007
300 end;
301end;
302
303procedure TfrmODMedIn.cboMedicationNeedData(Sender: TObject; const StartFrom: string;
304 Direction, InsertAt: Integer);
305{ retrieves a subset of inpatient medication orderable items }
306begin
307 inherited;
308 FMedCombo.ForDataUse(SubSetOfOrderItems(StartFrom, Direction, 'S.UD RX'));
309end;
310
311procedure TfrmODMedIn.cboMedicationSelect(Sender: TObject);
312{ sets related controls whenever orderable item changes (MouseClick or Exit) }
313begin
314 inherited;
315 with FMedCombo do
316 begin
317 if ItemID <> FLastMedID then FLastMedID := ItemID else Exit;
318 Changing := True;
319 if Sender <> Self then Responses.Clear; // Sender=Self when called from SetupDialog
320 ResetOnMedChange;
321 if CharAt(ItemID, 1) = 'Q' then
322 begin
323 Responses.QuickOrder := ExtractInteger(ItemID);
324 Responses.SetControl(FMedCombo, 'ORDERABLE', 1);
325 end;
326 if ItemIEN > 0 then SetOnOISelect;
327 end;
328 with Responses do if QuickOrder > 0 then
329 begin
330 SetControl(FMedCombo, 'ORDERABLE', 1);
331 SetControl(cboDispense, 'DRUG', 1);
332 SetControl(txtDosage, 'INSTR', 1);
333 SetControl(cboRoute, 'ROUTE', 1);
334 SetControl(cboSchedule, 'SCHEDULE', 1);
335 SetControl(memComments, 'COMMENT', 1);
336 SetControl(cboPriority, 'URGENCY', 1);
337 end;
338 Changing := False;
339 ControlChange(Self);
340 if FMedCombo = cboMedication then SetAltCombo;
341 // if the Dispense drug was stuffed - still do the checks (form alt, refills)
342 if cboDispense.ItemIndex > -1 then cboDispenseMouseClick(Self);
343end;
344
345{ cboDispense methods }
346
347procedure TfrmODMedIn.CheckFormAlt;
348var
349 DrugName, OIName: string;
350 Drug, OI: Integer;
351begin
352 with cboDispense do if (ItemIndex > -1) and (Piece(Items[ItemIndex], U, 4) = 'NF') then
353 begin
354 SelectFormularyAlt(ItemIEN, Drug, OI, DrugName, OIName, PST_UNIT_DOSE);
355 if Drug > 0 then
356 begin
357 if FMedCombo.ItemIEN <> OI then
358 begin
359 FMedCombo.InitLongList(OIName);
360 FMedCombo.SelectByIEN(OI);
361 cboMedicationSelect(Self);
362 end;
363 cboDispense.SelectByIEN(Drug);
364 end; {if FormAlt}
365 end; {if ItemIndex}
366end;
367
368procedure TfrmODMedIn.cboDispenseExit(Sender: TObject);
369var
370 AMsg: string;
371begin
372 inherited;
373 with cboDispense do
374 begin
375 if ItemIEN <> FLastDrug then CheckFormAlt;
376 if ItemIEN > 0 then
377 begin
378 AMsg := DispenseMessage(ItemIEN);
379 if memMessage.Text <> AMsg then OrderMessage(AMsg);
380 end;
381 FLastDrug := ItemIEN;
382 end;
383end;
384
385procedure TfrmODMedIn.cboDispenseMouseClick(Sender: TObject);
386begin
387 inherited;
388 with cboDispense do
389 begin
390 if ItemIEN <> FLastDrug then CheckFormAlt;
391 if ItemIEN > 0 then OrderMessage(DispenseMessage(ItemIEN));
392 FLastDrug := ItemIEN;
393 end;
394end;
395
396{ all controls }
397
398procedure TfrmODMedIn.ControlChange(Sender: TObject);
399begin
400 inherited;
401 if Changing then Exit;
402 with FMedCombo do if ItemIEN > 0
403 then Responses.Update('ORDERABLE', 1, ItemID, Piece(Items[ItemIndex], U, 3))
404 else Responses.Update('ORDERABLE', 1, '', '');
405 with cboDispense do if ItemIEN > 0
406 then Responses.Update('DRUG', 1, ItemID, Piece(Items[ItemIndex], U, 2));
407 with txtDosage do if Length(Text) > 0 then Responses.Update('INSTR', 1, Text, Text);
408 with cboRoute do if ItemIndex > -1
409 then Responses.Update('ROUTE', 1, ItemID, Piece(Items[ItemIndex], U, 3))
410 else Responses.Update('ROUTE', 1, Text, Text);
411 with cboSchedule do if Length(Text) > 0 then Responses.Update('SCHEDULE', 1, Text, Text);
412 with cboPriority do if ItemIndex > -1 then Responses.Update('URGENCY', 1, ItemID, Text);
413 with memComments do Responses.Update('COMMENT', 1, TX_WPTYPE, Text);
414 memOrder.Text := Responses.OrderText;
415end;
416
417end.
418
Note: See TracBrowser for help on using the repository browser.