source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/fODMeds.~pas@ 708

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

Initial upload of TMG-CPRS 1.0.26.69
File size: 181.7 KB
Line 
1//kt -- Modified with SourceScanner on 8/8/2007
2unit fODMeds;
3
4{$OPTIMIZATION OFF} // REMOVE AFTER UNIT IS DEBUGGED
5
6interface
7
8uses
9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
10 QDialogs, //kt added
11 fODBase, StdCtrls, ComCtrls, ExtCtrls, ORCtrls, Grids, Buttons, uConst, ORDtTm,
12 Menus, XUDIGSIGSC_TLB, DKLang;
13
14const
15 UM_DELAYCLICK = 11037; // temporary for listview click event
16
17type
18 TfrmODMeds = class(TfrmODBase)
19 txtMed: TEdit;
20 pnlMeds: TPanel;
21 btnSelect: TButton;
22 pnlFields: TPanel;
23 lstQuick: TCaptionListView;
24 sptSelect: TSplitter;
25 lstAll: TCaptionListView;
26 dlgStart: TORDateTimeDlg;
27 cboXDosage: TORComboBox;
28 cboXRoute: TORComboBox;
29 pnlXDuration: TPanel;
30 pnlXSequence: TKeyClickPanel;
31 btnXSequence: TSpeedButton;
32 timCheckChanges: TTimer;
33 popDuration: TPopupMenu;
34 popDays: TMenuItem;
35 popBlank: TMenuItem;
36 hours1: TMenuItem;
37 minutes1: TMenuItem;
38 popXSequence: TPopupMenu;
39 and1: TMenuItem;
40 then1: TMenuItem;
41 months1: TMenuItem;
42 weeks1: TMenuItem;
43 pnlXSchedule: TPanel;
44 cboXSchedule: TORComboBox;
45 chkXPRN: TCheckBox;
46 txtXDuration: TCaptionEdit;
47 spnXDuration: TUpDown;
48 pnlXDurationButton: TKeyClickPanel;
49 btnXDuration: TSpeedButton;
50 pnlTop: TPanel;
51 lblRoute: TLabel;
52 lblSchedule: TLabel;
53 grdDoses: TCaptionStringGrid;
54 lblGuideline: TStaticText;
55 tabDose: TTabControl;
56 cboDosage: TORComboBox;
57 cboRoute: TORComboBox;
58 cboSchedule: TORComboBox;
59 chkPRN: TCheckBox;
60 btnXInsert: TButton;
61 btnXRemove: TButton;
62 pnlBottom: TPanel;
63 lblComment: TLabel;
64 lblDays: TLabel;
65 lblQuantity: TLabel;
66 lblRefills: TLabel;
67 lblPriority: TLabel;
68 chkDoseNow: TCheckBox;
69 memComment: TCaptionMemo;
70 lblQtyMsg: TStaticText;
71 txtSupply: TCaptionEdit;
72 spnSupply: TUpDown;
73 txtQuantity: TCaptionEdit;
74 spnQuantity: TUpDown;
75 txtRefills: TCaptionEdit;
76 spnRefills: TUpDown;
77 grpPickup: TGroupBox;
78 radPickWindow: TRadioButton;
79 radPickMail: TRadioButton;
80 radPickClinic: TRadioButton;
81 cboPriority: TORComboBox;
82 chkSC: TCheckBox;
83 lblAdminTime: TStaticText;
84 stcPI: TStaticText;
85 chkPtInstruct: TCheckBox;
86 memPI: TMemo;
87 Image1: TImage;
88 memDrugMsg: TMemo;
89 txtNSS: TLabel;
90 SpeedButton1: TSpeedButton;
91 procedure FormCreate(Sender: TObject);
92 procedure btnSelectClick(Sender: TObject);
93 procedure tabDoseChange(Sender: TObject);
94 procedure FormDestroy(Sender: TObject);
95 procedure txtMedKeyDown(Sender: TObject; var Key: Word;
96 Shift: TShiftState);
97 procedure txtMedKeyUp(Sender: TObject; var Key: Word;
98 Shift: TShiftState);
99 procedure txtMedChange(Sender: TObject);
100 procedure txtMedExit(Sender: TObject);
101 procedure ListViewEditing(Sender: TObject; Item: TListItem;
102 var AllowEdit: Boolean);
103 procedure ListViewKeyUp(Sender: TObject; var Key: Word;
104 Shift: TShiftState);
105 procedure ListViewResize(Sender: TObject);
106 procedure lstQuickData(Sender: TObject; Item: TListItem);
107 procedure lstQuickDataHint(Sender: TObject; StartIndex,
108 EndIndex: Integer);
109 procedure lstAllDataHint(Sender: TObject; StartIndex,
110 EndIndex: Integer);
111 procedure lstAllData(Sender: TObject; Item: TListItem);
112 procedure lblGuidelineClick(Sender: TObject);
113 procedure ListViewClick(Sender: TObject);
114 procedure cboScheduleChange(Sender: TObject);
115 procedure cboRouteChange(Sender: TObject);
116 procedure ControlChange(Sender: TObject);
117 procedure cboDosageClick(Sender: TObject);
118 procedure cboDosageChange(Sender: TObject);
119 procedure cboScheduleClick(Sender: TObject);
120 procedure txtSupplyChange(Sender: TObject);
121 procedure txtQuantityChange(Sender: TObject);
122 procedure cboRouteExit(Sender: TObject);
123 procedure grdDosesMouseDown(Sender: TObject; Button: TMouseButton;
124 Shift: TShiftState; X, Y: Integer);
125 procedure grdDosesKeyPress(Sender: TObject; var Key: Char);
126 procedure grdDosesMouseUp(Sender: TObject; Button: TMouseButton;
127 Shift: TShiftState; X, Y: Integer);
128 procedure grdDosesDrawCell(Sender: TObject; ACol, ARow: Integer;
129 Rect: TRect; State: TGridDrawState);
130 procedure cboXDosageClick(Sender: TObject);
131 procedure cboXDosageExit(Sender: TObject);
132 procedure cboXRouteClick(Sender: TObject);
133 procedure cboXRouteExit(Sender: TObject);
134 procedure cboXScheduleClick(Sender: TObject);
135 procedure pnlXDurationEnter(Sender: TObject);
136 procedure pnlXDurationExit(Sender: TObject);
137 procedure txtXDurationChange(Sender: TObject);
138 procedure cboXDosageEnter(Sender: TObject);
139 procedure cboXDosageChange(Sender: TObject);
140 procedure cboXRouteChange(Sender: TObject);
141 procedure cboXScheduleChange(Sender: TObject);
142 procedure pnlXSequenceExit(Sender: TObject);
143 procedure btnXSequenceClick(Sender: TObject);
144 procedure grdDosesExit(Sender: TObject);
145 procedure ListViewEnter(Sender: TObject);
146 procedure timCheckChangesTimer(Sender: TObject);
147 procedure popDurationClick(Sender: TObject);
148 procedure popXSequenceClick(Sender: TObject);
149 procedure chkSCEnter(Sender: TObject);
150 procedure chkSCClick(Sender: TObject);
151 procedure cmdAcceptClick(Sender: TObject);
152 procedure btnXInsertClick(Sender: TObject);
153 procedure btnXRemoveClick(Sender: TObject);
154 procedure pnlXScheduleEnter(Sender: TObject);
155 procedure pnlXScheduleExit(Sender: TObject);
156 procedure chkPtInstructClick(Sender: TObject);
157 procedure pnlFieldsResize(Sender: TObject);
158 procedure chkDoseNowClick(Sender: TObject);
159 procedure cboDosageExit(Sender: TObject);
160 procedure chkXPRNClick(Sender: TObject);
161 procedure memCommentClick(Sender: TObject);
162 procedure btnXDurationClick(Sender: TObject);
163 procedure chkPRNClick(Sender: TObject);
164 procedure grdDosesKeyDown(Sender: TObject; var Key: Word;
165 Shift: TShiftState);
166 procedure grdDosesEnter(Sender: TObject);
167 procedure FormKeyPress(Sender: TObject; var Key: Char);
168 procedure FormKeyDown(Sender: TObject; var Key: Word;
169 Shift: TShiftState);
170 procedure cboXRouteEnter(Sender: TObject);
171 procedure pnlXSequenceEnter(Sender: TObject);
172 procedure pnlMessageEnter(Sender: TObject);
173 procedure pnlMessageExit(Sender: TObject);
174 procedure memMessageKeyDown(Sender: TObject; var Key: Word;
175 Shift: TShiftState);
176 procedure memPIClick(Sender: TObject);
177 procedure FormResize(Sender: TObject);
178 procedure spnQuantityChangingEx(Sender: TObject;
179 var AllowChange: Boolean; NewValue: Smallint;
180 Direction: TUpDownDirection);
181 procedure memPIKeyDown(Sender: TObject; var Key: Word;
182 Shift: TShiftState);
183 procedure lstChange(Sender: TObject; Item: TListItem;
184 Change: TItemChange);
185 procedure FormClose(Sender: TObject; var Action: TCloseAction);
186 procedure txtNSSClick(Sender: TObject);
187 procedure cboScheduleEnter(Sender: TObject);
188 procedure FormShow(Sender: TObject);
189 procedure cboScheduleExit(Sender: TObject);
190 procedure cboXScheduleExit(Sender: TObject);
191 procedure cboDosageKeyUp(Sender: TObject; var Key: Word;
192 Shift: TShiftState);
193 procedure cboXDosageKeyUp(Sender: TObject; var Key: Word;
194 Shift: TShiftState);
195 procedure txtSupplyClick(Sender: TObject);
196 procedure txtQuantityClick(Sender: TObject);
197 procedure txtRefillsClick(Sender: TObject);
198 procedure WMClose(var Msg : TWMClose); message WM_CLOSE;
199 procedure cboXScheduleEnter(Sender: TObject);
200 //procedure btnNSSClick(Sender: TObject);
201 private
202 FScheduleChanged : Boolean;
203 {selection}
204 FAllItems: TStringList;
205 FAllFirst: Integer;
206 FAllLast: Integer;
207 FAllList: Integer;
208 FQuickList: Integer;
209 FQuickItems: TStringList;
210 FChangePending: Boolean;
211 FKeyTimerActive: Boolean;
212 FActiveMedList: TListView;
213 FRowHeight: Integer;
214 FFromSelf: Boolean;
215 {edit}
216 FAllDoses: TStringList;
217 FAllDrugs: TStringList;
218 FGuideline: TStringList;
219 FLastUnits: string;
220 FLastSchedule: string;
221 FLastDuration: string;
222 FLastInstruct: string;
223 FLastDispDrug: string;
224 FLastQuantity: Double;
225 FLastSupply: Integer;
226 FLastPickup: string;
227 FSIGVerb: string;
228 FSIGPrep: string;
229 FDropColumn: Integer;
230 FDrugID: string;
231 FInptDlg: Boolean;
232 FUpdated: Boolean;
233 FSuppressMsg: Boolean;
234 FPtInstruct: string;
235 FAltChecked: Boolean;
236 FOutptIV: Boolean;
237 FQOQuantity: Double;
238 FQODosage: string;
239 FNoZERO: boolean;
240 FIsQuickOrder: boolean;
241 FAdminTimeLbl: string;
242 FDisabledDefaultButton: TButton;
243 FDisabledCancelButton: TButton;
244 FShrinked: boolean;
245 FShrinkDrugMsg: boolean;
246 FResizedAlready: boolean;
247 FQOInitial: boolean;
248 FOrigiMsgDisp: boolean;
249 FNSSOther: boolean;
250 {selection}
251 FShowPnlXScheduleOk : boolean;
252 FRemoveText : Boolean;
253 FSmplPRNChkd: Boolean;
254 procedure ChangeDelayed;
255 function FindQuickOrder(const x: string): Integer;
256 function isUniqueQuickOrder(iText: string): Boolean;
257 procedure LoadMedCache(First, Last: Integer);
258 procedure ScrollToVisible(AListView: TListView);
259 procedure StartKeyTimer;
260 procedure StopKeyTimer;
261 procedure WMTimer(var Message: TWMTimer); message WM_TIMER;
262 {edit}
263 procedure ResetOnMedChange;
264 procedure ResetOnTabChange;
265 procedure SetControlsInpatient;
266 procedure SetControlsOutpatient;
267 procedure SetOnMedSelect;
268 procedure SetOnQuickOrder;
269 procedure SetVisibleCommentRows( Rows: integer );
270 procedure ShowMedSelect;
271 procedure ShowMedFields;
272 procedure ShowControlsSimple;
273 procedure ShowControlsComplex;
274 procedure SetDosage(const x: string);
275 procedure SetPickup(const x: string);
276 procedure SetSchedule(const x: string);
277 procedure CheckFormAltDose(DispDrug: Integer);
278 function DurationToDays: Integer;
279 function ConstructedDoseFields(const ADose: string; PrependName: Boolean = FALSE): string;
280 function FieldsForDose(ARow: Integer): string;
281 function FieldsForDrug(const DrugID: string): string;
282 function FindCommonDrug(DoseList: TStringList): string;
283 function FindDoseFields(const Drug, ADose: string): string;
284 function InpatientSig: string;
285 function OutpatientSig: string;
286 procedure UpdateRelated(DelayUpdate: Boolean = TRUE);
287 procedure UpdateRefills(const CurDispDrug: string; CurSupply: Integer);
288 procedure UpdateSC(const CurDispDrug: string);
289 procedure UpdateStartExpires(const CurSchedule: string);
290 procedure UpdateDefaultSupply(const CurUnits, CurSchedule, CurDuration, CurDispDrug: string;
291 var CurSupply: Integer; var CurQuantity: double; var SkipQtyCheck: Boolean);
292 procedure UpdateSupplyQuantity(const CurUnits, CurSchedule, CurDuration, CurDispDrug: string;
293 var CurSupply: Integer; var CurQuantity: double);
294 procedure UpdateDurationControls( FreeText: boolean);
295 function DisableDefaultButton(Control: TWinControl): boolean;
296 function DisableCancelButton(Control: TWinControl): boolean;
297 procedure RestoreDefaultButton;
298 procedure RestoreCancelButton;
299 function ValueOf(FieldID: Integer; ARow: Integer = -1): string;
300 function ValueOfResponse(FieldID: Integer; AnInstance: Integer = 1): string;
301 function ValFor(FieldID, ARow: Integer): string;
302 function TextDosage(ADosage: string): string;
303 //NSS
304 function CreateOtherScheduel: string;
305 function CreateOtherScheduelComplex: string;
306 procedure ShowEditor(ACol, ARow: Integer; AChar: Char);
307 procedure DropLastSequence(ASign: integer = 0);
308 procedure DispOrderMessage(const AMessage: string);
309 procedure UMDelayClick(var Message: TMessage); message UM_DELAYCLICK;
310 procedure UMDelayEvent(var Message: TMessage); message UM_DELAYEVENT;
311 procedure UMShowNSSBuilder(var Message: TMessage); message UM_NSSOTHER;
312 function IfIsIMODialog: boolean;
313 procedure ValidateInpatientSchedule(ScheduleCombo: TORComboBox);
314// function ValidateRoute(RouteCombo: TORComboBox) : Boolean; Removed based on Site feeback. See CQ: 7518
315 function IsSupplyAndOutPatient : boolean;
316 function GetSchedListIndex(SchedCombo: TORComboBox; pSchedule: String):integer;
317 protected
318 procedure InitDialog; override;
319 procedure Validate(var AnErrMsg: string); override;
320 public
321 ARow1: integer;
322 procedure SetupDialog(OrderAction: Integer; const ID: string); override;
323 procedure CheckDecimal(var AStr: string);
324 end;
325
326var
327 frmODMeds: TfrmODMeds;
328 crypto: IXuDigSigS;
329
330implementation
331
332{$R *.DFM}
333
334uses rCore, uCore, ORFn, rODMeds, rODBase, rOrders, fRptBox, fODMedOIFA,
335 uAccessibleStringGrid, uOrders, fOtherSchedule, StrUtils, fFrame;
336
337const
338 {grid columns for complex dosing}
339 COL_SELECT = 0;
340 COL_DOSAGE = 1;
341 COL_ROUTE = 2;
342 COL_SCHEDULE = 3;
343 COL_DURATION = 4;
344 COL_SEQUENCE = 5;
345 COL_CHKXPRN = 6;
346 VAL_DOSAGE = 10;
347 VAL_ROUTE = 20;
348 VAL_SCHEDULE = 30;
349 VAL_DURATION = 40;
350 VAL_SEQUENCE = 50;
351 VAL_CHKXPRN = 60;
352 TAB = #9;
353 {field identifiers}
354 FLD_LOCALDOSE = 1;
355 FLD_STRENGTH = 2;
356 FLD_DRUG_ID = 3;
357 FLD_DRUG_NM = 4;
358 FLD_DOSEFLDS = 5;
359 FLD_UNITNOUN = 6;
360 FLD_TOTALDOSE = 7;
361 FLD_DOSETEXT = 8;
362 FLD_INSTRUCT = 10;
363 FLD_DOSEUNIT = 11;
364 FLD_ROUTE_ID = 15;
365 FLD_ROUTE_NM = 16;
366 FLD_ROUTE_AB = 17;
367 FLD_ROUTE_EX = 18;
368 FLD_SCHEDULE = 20;
369 FLD_SCHED_EX = 21;
370 FLD_SCHED_TYP = 22;
371 FLD_DURATION = 30;
372 FLD_SEQUENCE = 31;
373 FLD_MISC_FLDS = 50;
374 FLD_SUPPLY = 51;
375 FLD_QUANTITY = 52;
376 FLD_REFILLS = 53;
377 FLD_PICKUP = 55;
378 FLD_QTYDISP = 56;
379 FLD_SC = 58;
380 FLD_PRIOR_ID = 60;
381 FLD_PRIOR_NM = 61;
382 FLD_START_ID = 70;
383 FLD_START_NM = 71;
384 FLD_EXPIRE = 72;
385 FLD_ANDTHEN = 73;
386 FLD_NOW_ID = 75;
387 FLD_NOW_NM = 76;
388 FLD_COMMENT = 80;
389 FLD_PTINSTR = 85;
390 {dosage type tab index values}
391 TI_DOSE = 0;
392 TI_RATE = 99;
393 TI_COMPLEX = 1;
394 {misc constants}
395 TIMER_ID = 6902; // arbitrary number
396 TIMER_DELAY = 500; // 500 millisecond delay
397 TIMER_FROM_DAYS = 1;
398 TIMER_FROM_QTY = 2;
399 {text constants}
400//TX_ADMIN = 'Requested Start: '; <-- original line. //kt 8/8/2007
401 TX_TAKE = '';
402//TX_NO_DEA = 'Provider must have a DEA# or VA# to order this medication'; <-- original line. //kt 8/8/2007
403//TC_NO_DEA = 'DEA# Required'; <-- original line. //kt 8/8/2007
404//TX_NO_MED = 'Medication must be selected.'; <-- original line. //kt 8/8/2007
405//TX_NO_SEQ = 'Missing one or more conjunction.'; <-- original line. //kt 8/8/2007
406//TX_NO_DOSE = 'Dosage must be entered.'; <-- original line. //kt 8/8/2007
407//TX_DOSE_NUM = 'Dosage may not be numeric only'; <-- original line. //kt 8/8/2007
408//TX_DOSE_LEN = 'Dosage may not exceed 60 characters'; <-- original line. //kt 8/8/2007
409//TX_NO_ROUTE = 'Route must be entered.'; <-- original line. //kt 8/8/2007
410//TX_NF_ROUTE = 'Route not found in the Medication Routes file.'; <-- original line. //kt 8/8/2007
411//TX_NO_SCHED = 'Schedule must be entered.'; <-- original line. //kt 8/8/2007
412//TX_NO_PICK = 'A method for picking up the medication must be entered.'; <-- original line. //kt 8/8/2007
413//TX_RNG_REFILL = 'The number of refills must be in the range of 0 through '; <-- original line. //kt 8/8/2007
414//TX_SCH_QUOTE = 'Schedule must not have quotemarks in it.'; <-- original line. //kt 8/8/2007
415//TX_SCH_MINUS = 'Schedule must not have a dash at the beginning.'; <-- original line. //kt 8/8/2007
416//TX_SCH_SPACE = 'Schedule must have only one space in it.'; <-- original line. //kt 8/8/2007
417//TX_SCH_LEN = 'Schedule must be less than 70 characters.'; <-- original line. //kt 8/8/2007
418//TX_SCH_PRN = 'Schedule cannot include PRN - use Comments to enter PRN.'; <-- original line. //kt 8/8/2007
419//TX_SCH_ZERO = 'Schedule cannot be Q0'; <-- original line. //kt 8/8/2007
420//TX_SCH_LSP = 'Schedule may not have leading spaces.'; <-- original line. //kt 8/8/2007
421//TX_SCH_NS = 'Unable to resolve non-standard schedule.'; <-- original line. //kt 8/8/2007
422//TX_MAX_STOP = 'The maximum expiration for this order is '; <-- original line. //kt 8/8/2007
423//TX_OUTPT_IV = 'This patient has not been admitted. Only IV orders may be entered.'; <-- original line. //kt 8/8/2007
424//TX_QTY_NV = 'Unable to validate quantity.'; <-- original line. //kt 8/8/2007
425//TX_QTY_MAIL = 'Quantity for mailed items must be a whole number.'; <-- original line. //kt 8/8/2007
426//TX_SUPPLY_LIM = 'Days Supply may not be greater than 90.'; <-- original line. //kt 8/8/2007
427//TX_SUPPLY_LIM1 = 'Days Supply may not be less than 1.'; <-- original line. //kt 8/8/2007
428//TX_SUPPLY_NINT= 'Days Supply is an invalid number.'; <-- original line. //kt 8/8/2007
429//TC_RESTRICT = 'Ordering Restrictions'; <-- original line. //kt 8/8/2007
430//TC_GUIDELINE = 'Restrictions/Guidelines'; <-- original line. //kt 8/8/2007
431//TX_QTY_PRE = '>> Quantity Dispensed: '; <-- original line. //kt 8/8/2007
432 TX_QTY_POST = ' <<';
433
434{ procedures inherited from fODBase --------------------------------------------------------- }
435
436var
437 TX_ADMIN : string; //kt
438 TX_NO_DEA : string; //kt
439 TC_NO_DEA : string; //kt
440 TX_NO_MED : string; //kt
441 TX_NO_SEQ : string; //kt
442 TX_NO_DOSE : string; //kt
443 TX_DOSE_NUM : string; //kt
444 TX_DOSE_LEN : string; //kt
445 TX_NO_ROUTE : string; //kt
446 TX_NF_ROUTE : string; //kt
447 TX_NO_SCHED : string; //kt
448 TX_NO_PICK : string; //kt
449 TX_RNG_REFILL : string; //kt
450 TX_SCH_QUOTE : string; //kt
451 TX_SCH_MINUS : string; //kt
452 TX_SCH_SPACE : string; //kt
453 TX_SCH_LEN : string; //kt
454 TX_SCH_PRN : string; //kt
455 TX_SCH_ZERO : string; //kt
456 TX_SCH_LSP : string; //kt
457 TX_SCH_NS : string; //kt
458 TX_MAX_STOP : string; //kt
459 TX_OUTPT_IV : string; //kt
460 TX_QTY_NV : string; //kt
461 TX_QTY_MAIL : string; //kt
462 TX_SUPPLY_LIM : string; //kt
463 TX_SUPPLY_LIM1 : string; //kt
464 TX_SUPPLY_NINT : string; //kt
465 TC_RESTRICT : string; //kt
466 TC_GUIDELINE : string; //kt
467 TX_QTY_PRE : string; //kt
468
469
470procedure SetupVars;
471//kt Added entire function to replace constant declarations 8/8/2007
472begin
473 TX_ADMIN := DKLangConstW('fODMeds_Requested_Startx');
474 TX_NO_DEA := DKLangConstW('fODMeds_Provider_must_have_a_DEAx_or_VAx_to_order_this_medication');
475 TC_NO_DEA := DKLangConstW('fODMeds_DEAx_Required');
476 TX_NO_MED := DKLangConstW('fODMeds_Medication_must_be_selectedx');
477 TX_NO_SEQ := DKLangConstW('fODMeds_Missing_one_or_more_conjunctionx');
478 TX_NO_DOSE := DKLangConstW('fODMeds_Dosage_must_be_enteredx');
479 TX_DOSE_NUM := DKLangConstW('fODMeds_Dosage_may_not_be_numeric_only');
480 TX_DOSE_LEN := DKLangConstW('fODMeds_Dosage_may_not_exceed_60_characters');
481 TX_NO_ROUTE := DKLangConstW('fODMeds_Route_must_be_enteredx');
482 TX_NF_ROUTE := DKLangConstW('fODMeds_Route_not_found_in_the_Medication_Routes_filex');
483 TX_NO_SCHED := DKLangConstW('fODMeds_Schedule_must_be_enteredx');
484 TX_NO_PICK := DKLangConstW('fODMeds_A_method_for_picking_up_the_medication_must_be_enteredx');
485 TX_RNG_REFILL := DKLangConstW('fODMeds_The_number_of_refills_must_be_in_the_range_of_0_through');
486 TX_SCH_QUOTE := DKLangConstW('fODMeds_Schedule_must_not_have_quotemarks_in_itx');
487 TX_SCH_MINUS := DKLangConstW('fODMeds_Schedule_must_not_have_a_dash_at_the_beginningx');
488 TX_SCH_SPACE := DKLangConstW('fODMeds_Schedule_must_have_only_one_space_in_itx');
489 TX_SCH_LEN := DKLangConstW('fODMeds_Schedule_must_be_less_than_70_charactersx');
490 TX_SCH_PRN := DKLangConstW('fODMeds_Schedule_cannot_include_PRN_x_use_Comments_to_enter_PRNx');
491 TX_SCH_ZERO := DKLangConstW('fODMeds_Schedule_cannot_be_Q0');
492 TX_SCH_LSP := DKLangConstW('fODMeds_Schedule_may_not_have_leading_spacesx');
493 TX_SCH_NS := DKLangConstW('fODMeds_Unable_to_resolve_nonxstandard_schedulex');
494 TX_MAX_STOP := DKLangConstW('fODMeds_The_maximum_expiration_for_this_order_is');
495 TX_OUTPT_IV := DKLangConstW('fODMeds_This_patient_has_not_been_admittedx__Only_IV_orders_may_be_enteredx');
496 TX_QTY_NV := DKLangConstW('fODMeds_Unable_to_validate_quantityx');
497 TX_QTY_MAIL := DKLangConstW('fODMeds_Quantity_for_mailed_items_must_be_a_whole_numberx');
498 TX_SUPPLY_LIM := DKLangConstW('fODMeds_Days_Supply_may_not_be_greater_than_90x');
499 TX_SUPPLY_LIM1 := DKLangConstW('fODMeds_Days_Supply_may_not_be_less_than_1x');
500 TX_SUPPLY_NINT:= DKLangConstW('fODMeds_Days_Supply_is_an_invalid_numberx');
501 TC_RESTRICT := DKLangConstW('fODMeds_Ordering_Restrictions');
502 TC_GUIDELINE := DKLangConstW('fODMeds_RestrictionsxGuidelines');
503 TX_QTY_PRE := DKLangConstW('fODMeds_xx_Quantity_Dispensedx');
504end;
505
506procedure TfrmODMeds.FormCreate(Sender: TObject);
507var
508 ListCount: Integer;
509 x: string;
510begin
511 SetupVars; //kt added 8/8/2007 to replace constants with vars.
512 frmFrame.pnlVisit.Enabled := false;
513 AutoSizeDisabled := True;
514 inherited;
515 btnXDuration.Align := alClient;
516 AllowQuickOrder := True;
517 FSmplPRNChkd := False; // GE CQ7585
518 CheckAuthForMeds(x);
519 if Length(x) > 0 then
520 begin
521 InfoBox(x, TC_RESTRICT, MB_OK);
522 Close;
523 Exit;
524 end;
525 if DlgFormID = OD_MEDINPT then FInptDlg := TRUE;
526 if DlgFormID = OD_MEDOUTPT then FInptDlg := FALSE;
527 if DlgFormID = OD_MEDNONVA then FInptDlg := FALSE;
528 if DlgFormID = OD_MEDS then FInptDlg := OrderForInpatient;
529 if XfInToOutNow then
530 FInptDlg := False;
531 if XferOuttoInOnMeds then
532 FInptDlg := True;
533 if ImmdCopyAct and isUDGroup and (Patient.Inpatient) then
534 FInptDlg := True;
535 if ImmdcopyAct and (not isUDGroup) then
536 FInptDlg := False;
537 if FInptDlg then FillerID := 'PSI' else FillerID := 'PSO';
538 FGuideline := TStringList.Create;
539 FAllDoses := TStringList.Create;
540 FAllDrugs := TStringList.Create;
541//StatusText('Loading Dialog Definition'); <-- original line. //kt 8/8/2007
542 StatusText(DKLangConstW('fODMeds_Loading_Dialog_Definition')); //kt added 8/8/2007
543 if DlgFormID = OD_MEDINPT then Responses.Dialog := 'PSJ OR PAT OE'
544 else if DlgFormID = OD_MEDOUTPT then Responses.Dialog := 'PSO OERR'
545 else if DlgFormID = OD_MEDNONVA then Responses.Dialog := 'PSH OERR'
546 else Responses.Dialog := 'PS MEDS'; // loads formatting info
547 {if not FInptDlg then } Responses.SetPromptFormat('INSTR', '@');
548//StatusText('Loading Schedules'); <-- original line. //kt 8/8/2007
549 StatusText(DKLangConstW('fODMeds_Loading_Schedules')); //kt added 8/8/2007
550 //if (Self.EvtID > 0) then LoadSchedules(cboSchedule.Items)
551 //else LoadSchedules(cboSchedule.Items, FInptDlg);
552 LoadSchedules(cboSchedule.Items, FInptDlg);
553 StatusText('');
554 if FInptDlg then SetControlsInpatient else SetControlsOutpatient;
555//CtrlInits.SetControl(cboPriority, 'Priority'); <-- original line. //kt 8/8/2007
556 CtrlInits.SetControl(cboPriority, DKLangConstW('fODMeds_Priority')); //kt added 8/8/2007
557//FSuppressMsg := CtrlInits.DefaultText('DispMsg') = '1'; <-- original line. //kt 8/8/2007
558 FSuppressMsg := CtrlInits.DefaultText(DKLangConstW('fODMeds_DispMsg')) = '1'; //kt added 8/8/2007
559 FOrigiMsgDisp := FSuppressMsg;
560 InitDialog;
561 if FInptDlg then
562 begin
563 txtNss.Visible := True;
564 //cboSchedule.ListItemsOnly := True;
565 //cboXSchedule.ListItemsOnly := True;
566 end;
567 with grdDoses do
568 begin
569 ColWidths[0] := 8; // select
570 ColWidths[1] := 160; // dosage
571 ColWidths[2] := 82; // route
572 ColWidths[3] := 102; // schedule
573 ColWidths[4] := 70; // duration
574 ColWidths[5] := 58; // and/then
575// Cells[1, 0] := 'Dosage'; <-- original line. //kt 8/8/2007
576 Cells[1, 0] := DKLangConstW('fODMeds_Dosage'); //kt added 8/8/2007
577// Cells[2, 0] := 'Route'; <-- original line. //kt 8/8/2007
578 Cells[2, 0] := DKLangConstW('fODMeds_Route'); //kt added 8/8/2007
579// Cells[3, 0] := 'Schedule'; <-- original line. //kt 8/8/2007
580 Cells[3, 0] := DKLangConstW('fODMeds_Schedule'); //kt added 8/8/2007
581// Cells[4, 0] := 'Duration (optional)'; <-- original line. //kt 8/8/2007
582 Cells[4, 0] := DKLangConstW('fODMeds_Duration_xoptionalx'); //kt added 8/8/2007
583// Cells[5, 0] := 'then/and'; <-- original line. //kt 8/8/2007
584 Cells[5, 0] := DKLangConstW('fODMeds_thenxand'); //kt added 8/8/2007
585 end;
586 TAccessibleStringGrid.WrapControl(grdDoses);
587
588 // medication selection
589 FRowHeight := MainFontHeight + 1;
590
591 IsIMO := IfIsIMODialog; //IMO
592 if (Self.EvtID > 0) then IsIMO := False; // event order can not be IMO order.
593 if FInptDlg then x := 'UD RX'
594 else if (not FInptDlg) and (DlgFormID = OD_MEDNONVA) then x := 'NV RX'
595 else x := 'O RX';
596 if FInptDlg and (not OrderForInpatient) and (not IsIMO) then //IMO
597 begin
598 FOutptIV := TRUE;
599 x := 'IVM RX';
600 end;
601 ListForOrderable(FAllList, ListCount, x);
602 lstAll.Items.Count := ListCount;
603 FAllItems := TStringList.Create;
604 FAllFirst := -1;
605 FAllLast := -1;
606 FQuickItems := TStringList.Create;
607 ListForQuickOrders(FQuickList, ListCount, x);
608 if ListCount > 0 then
609 begin
610 lstQuick.Items.Count := ListCount;
611 SubsetOfQuickOrders(FQuickItems, FQuickList, 0, 0);
612 FActiveMedList := lstQuick;
613 end else
614 begin
615 lstQuick.Items.Count := 1;
616 ListCount := 1;
617// FQuickItems.Add('0^(No quick orders available)'); <-- original line. //kt 8/8/2007
618 FQuickItems.Add(DKLangConstW('fODMeds_0xxNo_quick_orders_availablex')); //kt added 8/8/2007
619 FActiveMedList := lstAll;
620 end;
621 // set the height based on user parameter here
622 with lstQuick do if ListCount < VisibleRowCount
623 then Height := (((Height - 6) div VisibleRowCount) * ListCount) + 6;
624 pnlFields.Height := memOrder.Top - 4 - pnlFields.Top;
625 FNoZero := False;
626 FShrinked := False;
627 FShrinkDrugMsg := False;
628 FResizedAlready := False;
629 FShowPnlXScheduleOk := True;
630 FRemoveText := True;
631end;
632
633procedure TfrmODMeds.FormDestroy(Sender: TObject);
634begin
635 {selection}
636 FQuickItems.Free;
637 FAllItems.Free;
638 {edit}
639 FGuideline.Free;
640 FAllDoses.Free;
641 FAllDrugs.Free;
642 TAccessibleStringGrid.UnwrapControl(grdDoses);
643 frmFrame.pnlVisit.Enabled := true;
644 inherited;
645end;
646
647procedure TfrmODMeds.InitDialog;
648{ Executed each time dialog is reset after pressing accept. Clears controls & responses }
649begin
650 inherited;
651 FLastPickup := ValueOf(FLD_PICKUP);
652 Changing := True;
653 ResetOnMedChange;
654 txtMed.Text := '';
655 txtMed.Tag := 0;
656 lstQuick.Selected := nil;
657 lstAll.Selected := nil;
658 if Visible then ShowMedSelect;
659 Changing := False;
660 FIsQuickOrder := False;
661 FQOQuantity := 0 ;
662 FQODosage := '';
663 FQOInitial := False;
664 FNSSOther := False;
665end;
666
667procedure TfrmODMeds.SetupDialog(OrderAction: Integer; const ID: string);
668var
669 AnInstr, OrderID, nsSch, Text: string;
670 ix: integer;
671begin
672 inherited;
673 if XfInToOutNow then DisplayGroup := DisplayGroupByName('O RX');
674 if CharAt(ID,1)='X' then
675 begin
676 OrderID := Copy(Piece(ID, ';', 1), 2, Length(ID));
677 CheckExistingPI(OrderID, FPtInstruct);
678 end;
679 if OrderAction = ORDER_QUICK then
680 begin
681 FIsQuickOrder := True;
682 FQOInitial := True;
683 end
684 else
685 begin
686 FIsQuickOrder := False;
687 FQOInitial := False;
688 end;
689 if lblDays.Visible then SetVisibleCommentRows(2) else SetVisibleCommentRows(4);
690 if OrderAction in [ORDER_COPY, ORDER_EDIT] then Responses.Remove('START', 1);
691 if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then
692 begin
693 Changing := True;
694 txtMed.Tag := StrToIntDef(Responses.IValueFor('ORDERABLE', 1), 0);
695 SetOnMedSelect; // set up for this medication
696 SetOnQuickOrder; // insert quick order responses
697 ShowMedFields;
698 if (OrderAction = ORDER_EDIT) and OrderIsReleased(Responses.EditOrder)
699 then btnSelect.Enabled := False;
700 if (OrderAction in [ORDER_COPY, ORDER_EDIT]) and (self.EvtID <= 0) then //nss
701 begin
702 if NSSchedule then
703 begin
704 for ix := 0 to Responses.TheList.Count - 1 do
705 begin
706 if TResponse(Responses.TheList[ix]).promptid = 'SCHEDULE' then
707 begin
708 nsSch := TResponse(Responses.theList[ix]).EVALUE;
709 if length(nsSch) > 0 then
710 begin
711 SetSchedule(nsSch);
712 {cboSchedule.SelectByID(nsSch);
713 if cboSchedule.ItemIndex < 0 then
714 begin
715 cboSchedule.Items.Add(nsSch);
716 cboSchedule.ItemIndex := cboSchedule.Items.IndexOf(nsSch);
717 end;}
718 end;
719 end;
720 end;
721 end;
722 end; //nss
723 if ((OrderAction <> Order_COPY) and (OrderAction <> Order_EDIT)) or
724 (XfInToOutNow = true) then UpdateRelated(FALSE); //AGP Change
725 Changing := False;
726 end;
727 { prevent the SIG from being part of the comments on pre-CPRS prescriptions }
728 if (OrderAction in [ORDER_COPY, ORDER_EDIT]) and (cboDosage.Text = '') then
729 begin
730 OrderID := Copy(Piece(ID, ';', 1), 2, Length(ID));
731 AnInstr := TextForOrder(OrderID);
732 pnlMessage.TabOrder := 0;
733 DispOrderMessage(AnInstr);
734 if OrderAction = ORDER_COPY
735// then AnInstr := 'Copy: ' + AnInstr <-- original line. //kt 8/8/2007
736 then AnInstr := DKLangConstW('fODMeds_Copyx') + AnInstr //kt added 8/8/2007
737// else AnInstr := 'Change: ' + AnInstr; <-- original line. //kt 8/8/2007
738 else AnInstr := DKLangConstW('fODMeds_Changex') + AnInstr; //kt added 8/8/2007
739 Text := AnsiReplaceText(AnInstr,CRLF,'');
740 Caption := Text;
741 memComment.Clear; // sometimes the sig is in the comment
742 end;
743 ControlChange(Self);
744 if Self.IsSupply then
745 btnSelect.Enabled := False;
746end;
747
748procedure TfrmODMeds.Validate(var AnErrMsg: string);
749var
750 i,ie,code: Integer;
751
752 procedure SetError(const x: string);
753 begin
754 if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
755 AnErrMsg := AnErrMsg + x;
756 end;
757
758 procedure ValidateDosage(const x: string);
759 begin
760 if Length(x) = 0 then SetError(TX_NO_DOSE);
761 end;
762
763 procedure ValidateRoute(const x: string; NeedLookup: Boolean; AnInstance: Integer);
764 var
765 RouteID, RouteAbbr: string;
766 begin
767 //if order does not have route, and is not a supply order,
768 // and is not an outpaitent order, then display error text to require route
769 if (Length(x) = 0) and (Not IsSupplyAndOutPatient) then
770 begin
771 if cboRoute.Showing = true then cboRoute.SetFocus; //CQ: 7467
772 SetError(TX_NO_ROUTE);
773 end;
774 if (Length(x) > 0) and NeedLookup then
775 begin
776 LookupRoute(x, RouteID, RouteAbbr);
777 if RouteID = '0'
778 then
779 begin
780 if cboRoute.Showing = true then cboRoute.SetFocus; //CQ: 7467
781 SetError(TX_NF_ROUTE);
782 end
783 else Responses.Update('ROUTE', AnInstance, RouteID, RouteAbbr);
784 end;
785 end;
786
787 procedure ValidateSchedule(const x: string; AnInstance: Integer);
788 const
789 SCH_BAD = 0;
790 SCH_NO_RTN = -1;
791 var
792 ValidLevel: Integer;
793 ARoute, ADrug, tmpX: string;
794 begin
795 ARoute := ValueOfResponse(FLD_ROUTE_ID, AnInstance);
796 ADrug := ValueOfResponse(FLD_DRUG_ID, AnInstance);
797 tmpX := x; //Changed for CQ: 7370 - it was tmpX := Trim(x);
798 if (Length(tmpX) = 0) and (not FInptDlg) then SetError(TX_NO_SCHED)
799 else if (Length(tmpX) = 0) and FInptDlg and ScheduleRequired(txtMed.Tag, ARoute, ADrug)
800 then SetError(TX_NO_SCHED);
801 if Length(tmpX) > 0 then
802 begin
803 if FInptDlg then ValidLevel := ValidSchedule(tmpX) else ValidLevel := ValidSchedule(tmpX, 'O');
804 if ValidLevel = SCH_NO_RTN then
805 begin
806 if Pos('"', tmpX) > 0 then SetError(TX_SCH_QUOTE);
807 if Copy(tmpX, 1, 1) = '-' then SetError(TX_SCH_MINUS);
808 if Pos(' ', Copy(tmpX, Pos(' ', tmpX) + 1, 999)) > 0 then SetError(TX_SCH_SPACE);
809 if Length(tmpX) > 70 then SetError(TX_SCH_LEN);
810 if (Pos('P RN', tmpX) > 0) or (Pos('PR N', tmpX) > 0) then SetError(TX_SCH_PRN);
811 if Pos('Q0', tmpX) > 0 then SetError(TX_SCH_ZERO);
812 if TrimLeft(tmpX) <> tmpX then SetError(TX_SCH_LSP);
813 end;
814 if ValidLevel = SCH_BAD then SetError(TX_SCH_NS);
815 end;
816 end;
817
818begin
819 SetupVars; //kt added 8/8/2007 to replace constants with vars.
820 SetupVars; //kt added 8/8/2007 to replace constants with vars.
821 SetupVars; //kt added 8/8/2007 to replace constants with vars.
822 inherited;
823 ControlChange(Self); // make sure everything is updated
824 if txtMed.Tag = 0 then SetError(TX_NO_MED);
825 if Responses.InstanceCount('INSTR') < 1 then SetError(TX_NO_DOSE);
826 i := Responses.NextInstance('INSTR', 0);
827 while i > 0 do
828 begin
829 if (ValueOfResponse(FLD_DRUG_ID, i) = '') then
830 begin
831 if not ContainsAlpha(Responses.IValueFor('INSTR', i)) then
832 begin
833 SetError(TX_DOSE_NUM);
834 if tabDose.TabIndex = TI_DOSE then
835 cboDosage.SetFocus; //CQ: 7467
836 end;
837 if Length(Responses.IValueFor('INSTR', i)) > 60 then
838 begin
839 SetError(TX_DOSE_LEN);
840 cboDosage.SetFocus; //CQ: 7467
841 end;
842 end;
843 ValidateRoute(Responses.EValueFor('ROUTE', i), Responses.IValueFor('ROUTE', i) = '', i);
844 ValidateSchedule(ValueOfResponse(FLD_SCHEDULE, i), i);
845 i := Responses.NextInstance('INSTR', i);
846 end;
847 //AGP Change 26.45 Fix for then/and conjucntion PSI-04-069
848 if self.tabDose.TabIndex = 1 then
849 begin
850 for i := 2 to self.grdDoses.RowCount do
851 begin
852 if ((ValFor(COL_DOSAGE, i-1) <> '') and (ValFor(COL_DOSAGE, i) <> '')) and (ValFor(COL_SEQUENCE,i-1) = '') then
853 begin
854 SetError(TX_NO_SEQ);
855 Exit;
856 end;
857 end;
858 end;
859 if not FInptDlg then // outpatient stuff
860 begin
861 if Responses.IValueFor('PICKUP', 1) = '' then SetError(TX_NO_PICK);
862 if StrToIntDef(Responses.IValueFor('REFILLS', 1), 99) > spnRefills.Max
863 then SetError(TX_RNG_REFILL + IntToStr(spnRefills.Max));
864 with txtQuantity do
865 if not ValidQuantity(Responses.IValueFor('QTY', 1)) then SetError(TX_QTY_NV);
866 with txtSupply do
867 begin
868 txtSupply.Text := Trim(txtSupply.Text);
869 Val( txtSupply.Text, ie, code);
870 if (code <> 0) and (ie = 0)then
871 begin
872 SetError(TX_SUPPLY_NINT);
873 Exit;
874 end;
875 if (StrToIntDef(Responses.IValueFor('SUPPLY', 1), 0) > 90) then SetError(TX_SUPPLY_LIM);
876 if (StrToIntDef(Responses.IValueFor('SUPPLY', 1), 0) < 1) then SetError(TX_SUPPLY_LIM1);
877 end;
878 end;
879end;
880
881procedure TfrmODMeds.SetVisibleCommentRows( Rows: integer);
882begin
883 memComment.Height := (Abs(Font.Height)+2)*Rows+8;
884end;
885
886procedure TfrmODMeds.SetControlsInpatient;
887begin
888 FillerID := 'PSI';
889 CtrlInits.LoadDefaults(ODForMedsIn);
890 lblPriority.Top := pnlFields.Height - cboPriority.Height - lblPriority.Height - 1;
891 cboPriority.Top := pnlFields.Height - cboPriority.Height;
892 lblDays.Visible := False;
893 txtSupply.Visible := False;
894 spnSupply.Visible := False;
895 lblQuantity.Visible := False;
896 txtQuantity.Visible := False;
897 spnQuantity.Visible := False;
898 lblQtyMsg.Visible := False;
899 lblRefills.Visible := False;
900 txtRefills.Visible := False;
901 spnRefills.Visible := False;
902 grpPickup.Visible := False;
903 lblPriority.Visible := True;
904 cboPriority.Visible := True;
905 chkSC.Visible := False;
906 chkDoseNow.Visible := True;
907 lblAdminTime.Visible := True;
908end;
909
910procedure TfrmODMeds.SetControlsOutpatient;
911var
912 ExceptItem: TMenuItem;
913begin
914 FillerID := 'PSO';
915 CtrlInits.LoadDefaults(ODForMedsOut);
916 lblPriority.Top := lblQuantity.Top;
917 cboPriority.Top := txtQuantity.Top;
918 lblDays.Visible := True;
919 txtSupply.Visible := True;
920 spnSupply.Visible := True;
921 lblQuantity.Visible := True;
922 txtQuantity.Visible := True;
923 spnQuantity.Visible := True;
924 lblQtyMsg.Visible := True;
925 lblRefills.Visible := True;
926 txtRefills.Visible := True;
927 spnRefills.Visible := True;
928 grpPickup.Visible := True;
929 lblPriority.Visible := True;
930 cboPriority.Visible := True;
931 chkSC.Visible := True;
932 chkDoseNow.Visible := False;
933 lblAdminTime.Visible := False;
934 ExceptItem := TMenuItem.Create(Self);
935//ExceptItem.Caption := 'except'; <-- original line. //kt 8/8/2007
936 ExceptItem.Caption := DKLangConstW('fODMeds_except'); //kt added 8/8/2007
937 ExceptItem.Tag := 3;
938 ExceptItem.OnClick := popXSequenceClick;
939 popXSequence.Items.Add(ExceptItem);
940end;
941
942{ Navigate medication selection lists ------------------------------------------------------- }
943
944{ txtMed methods (including timers) }
945
946procedure TfrmODMeds.WMTimer(var Message: TWMTimer);
947begin
948 inherited;
949 if (Message.TimerID = TIMER_ID) then
950 begin
951 StopKeyTimer;
952 ChangeDelayed;
953 end;
954end;
955
956procedure TfrmODMeds.StartKeyTimer;
957{ start (or restart) a timer (done on keyup to delay before calling OnKeyPause) }
958var
959 ATimerID: Integer;
960begin
961 StopKeyTimer;
962 ATimerID := SetTimer(Handle, TIMER_ID, TIMER_DELAY, nil);
963 FKeyTimerActive := ATimerID > 0;
964 // if can't get a timer, just call the event immediately F
965 if not FKeyTimerActive then Perform(WM_TIMER, TIMER_ID, 0);
966end;
967
968procedure TfrmODMeds.StopKeyTimer;
969{ stop the timer (done whenever a key is pressed or the combobox no longer has focus) }
970begin
971 if FKeyTimerActive then
972 begin
973 KillTimer(Handle, TIMER_ID);
974 FKeyTimerActive := False;
975 end;
976end;
977
978function TfrmODMeds.FindQuickOrder(const x: string): Integer;
979var
980 i: Integer;
981begin
982 Result := -1;
983 if x = '' then Exit;
984 for i := 0 to Pred(FQuickItems.Count) do
985 begin
986 if (Result > -1) or (FQuickItems[i] = '') then Break;
987 if AnsiCompareText(x, Copy(Piece(FQuickItems[i],'^',2), 1, Length(x))) = 0 then Result := i;
988 end;
989end;
990
991procedure TfrmODMeds.txtMedKeyDown(Sender: TObject; var Key: Word;
992 Shift: TShiftState);
993var
994 i: Integer;
995 x: string;
996begin
997 if Key in [VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN] then // navigation
998 begin
999 FActiveMedList.Perform(WM_KEYDOWN, Key, 0);
1000 FFromSelf := True;
1001 //txtMed.Text := FActiveMedList.Selected.Caption;
1002 txtMed.SelectAll;
1003 FFromSelf := False;
1004 Key := 0;
1005 end
1006 else if Key = VK_BACK then
1007 begin
1008 FFromSelf := True;
1009 x := txtMed.Text;
1010 i := txtMed.SelStart;
1011 if i > 1 then Delete(x, i + 1, Length(x)) else x := '';
1012 txtMed.Text := x;
1013 if i > 1 then txtMed.SelStart := i;
1014 FFromSelf := False;
1015 end
1016 else {StartKeyTimer};
1017end;
1018
1019procedure TfrmODMeds.txtMedKeyUp(Sender: TObject; var Key: Word;
1020 Shift: TShiftState);
1021begin
1022 if not (Key in [VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN]) then StartKeyTimer;
1023end;
1024
1025procedure TfrmODMeds.txtMedChange(Sender: TObject);
1026begin
1027 if FFromSelf then Exit;
1028 FChangePending := True;
1029end;
1030
1031procedure TfrmODMeds.ScrollToVisible(AListView: TListView);
1032var
1033 Offset: Integer;
1034 SelRect: TRect;
1035begin
1036 AListView.Selected.MakeVisible(FALSE);
1037 SelRect := AListView.Selected.DisplayRect(drBounds);
1038 FRowHeight := SelRect.Bottom - SelRect.Top;
1039 Offset := AListView.Selected.Index - AListView.TopItem.Index;
1040 Application.ProcessMessages;
1041 if Offset > 0 then AListView.Scroll(0, (Offset * FRowHeight));
1042 Application.ProcessMessages;
1043end;
1044
1045procedure TfrmODMeds.ChangeDelayed;
1046var
1047 QuickIndex, AllIndex: Integer;
1048 NewText, OldText, UserText: string;
1049 UniqueText: Boolean;
1050begin
1051 FRemoveText := False;
1052 UniqueText := False;
1053 FChangePending := False;
1054 if (Length(txtMed.Text) > 0) and (txtMed.SelStart = 0) then Exit; // don't lookup null
1055 // lookup item in appropriate list box
1056 NewText := '';
1057 UserText := Copy(txtMed.Text, 1, txtMed.SelStart);
1058 QuickIndex := FindQuickOrder(UserText); // look in quick list first
1059 AllIndex := IndexOfOrderable(FAllList, UserText); // but always synch the full list
1060 if UserText <> Copy(txtMed.Text, 1, txtMed.SelStart) then Exit; // if typing during lookup
1061 if AllIndex > -1 then
1062 begin
1063 lstAll.Selected := lstAll.Items[AllIndex];
1064 FActiveMedList := lstAll;
1065 end;
1066 if QuickIndex > -1 then
1067 begin
1068 try
1069 lstQuick.Selected := lstQuick.Items[QuickIndex];
1070 lstQuick.ItemFocused := lstQuick.Selected;
1071 NewText := lstQuick.Selected.Caption;
1072 FActiveMedList := lstQuick;
1073 //Search Quick List for Uniqueness
1074 UniqueText := isUniqueQuickOrder(UserText);
1075 except
1076 //doing nothing short term solution related to 117
1077 end;
1078 end
1079 else if AllIndex > -1 then
1080 begin
1081 lstAll.Selected := lstAll.Items[AllIndex];
1082 lstAll.ItemFocused := lstAll.Selected;
1083 NewText := lstAll.Selected.Caption;
1084 lstQuick.Selected := nil;
1085 FActiveMedList := lstAll;
1086 //List is alphabetical, So compare next Item in list to establish uniqueness.
1087 if CompareText(UserText, Copy(lstAll.Items[AllIndex+1].Caption, 1, Length(UserText))) <> 0 then
1088 UniqueText := True;
1089 end
1090 else
1091 begin
1092 lstQuick.Selected := nil;
1093 lstAll.Selected := nil;
1094 FActiveMedList := lstAll;
1095 NewText := txtMed.Text;
1096 end;
1097 if (AllIndex > -1) and (QuickIndex > -1) then //Not Unique Between Lists
1098 UniqueText := False;
1099 FFromSelf := True;
1100 {AutoSelection is only based upon uniquely matching characters.
1101 Several CQs have been resolved relating to this issue:
1102 See CQ:
1103 7326 - Auto complete does not work correctly if user has quick orders in Medication list
1104 7328 - PSI-05-016: TAM-0205-31170 Med Error due to pre-populated med screen
1105 6715 PSI-04-044 Orders: NJH-0804-20315 Physician unable to enter medication order
1106 }
1107 if UniqueText then
1108 begin
1109 OldText := Copy(txtMed.Text, 1, txtMed.SelStart);
1110 txtMed.Text := NewText;
1111 //txtMed.SelStart := Length(OldText); // v24.14 RV
1112 txtMed.SelStart := Length(UserText); // v24.14 RV
1113 txtMed.SelLength := Length(NewText);
1114 end
1115 else begin
1116 txtMed.Text := UserText;
1117 txtMed.SelStart := Length(txtMed.Text);
1118 end;
1119 FFromSelf := False;
1120 if lstAll.Selected <> nil then
1121 ScrollToVisible(lstAll);
1122 if lstQuick.Selected <> nil then
1123 ScrollToVisible(lstQuick);
1124 if Not UniqueText then
1125 begin
1126 lstQuick.ItemIndex := -1;
1127 lstAll.ItemIndex := -1;
1128 end;
1129 FRemoveText := True;
1130end;
1131
1132procedure TfrmODMeds.txtMedExit(Sender: TObject);
1133begin
1134 StopKeyTimer;
1135 if not ((ActiveControl = lstAll) or (ActiveControl = lstQuick)) then ChangeDelayed;
1136end;
1137
1138{ lstAll & lstQuick methods }
1139
1140procedure TfrmODMeds.ListViewEnter(Sender: TObject);
1141begin
1142 inherited;
1143 FActiveMedList := TListView(Sender);
1144 with Sender as TListView do
1145 begin
1146 if Selected = nil then Selected := TopItem;
1147// if Name = 'lstQuick' then lstAll.Selected := nil else lstQuick.Selected := nil; <-- original line. //kt 8/8/2007
1148 if Name = DKLangConstW('fODMeds_lstQuick') then lstAll.Selected := nil else lstQuick.Selected := nil; //kt added 8/8/2007
1149 ItemFocused := Selected;
1150 //ScrollToVisible(TListView(Sender));
1151 end;
1152end;
1153
1154procedure TfrmODMeds.ListViewClick(Sender: TObject);
1155begin
1156 inherited;
1157 btnSelect.Visible := True;
1158 btnSelect.Enabled := True;
1159 //txtMed.Text := FActiveMedList.Selected.Caption;
1160 PostMessage(Handle, UM_DELAYCLICK, 0, 0);
1161end;
1162
1163procedure TfrmODMeds.UMDelayClick(var Message: TMessage);
1164begin
1165 btnSelectClick(Self);
1166end;
1167
1168procedure TfrmODMeds.ListViewEditing(Sender: TObject; Item: TListItem;
1169 var AllowEdit: Boolean);
1170begin
1171 AllowEdit := FALSE;
1172end;
1173
1174procedure TfrmODMeds.ListViewKeyUp(Sender: TObject; var Key: Word;
1175 Shift: TShiftState);
1176begin
1177//This code emulates combo-box behavior on the quick view and all meds view.
1178//I think this is a really bad idea because it cannot automatically be undone.
1179//Example: pull up a valid medication. Press change button. Press tab. Valid
1180//medication is gone, replaced by first quick order entry. Not good behavior
1181//when tabbing through page.
1182//If we are going to use an edit box to play combo box, I emphatically suggest
1183//that we use a different edit box.
1184(*
1185 with Sender as TListView do
1186 begin
1187 if txtMed.Text = Selected.Caption then Exit; // for tabs, arrows, etc.
1188 FFromSelf := True;
1189 txtMed.Text := Selected.Caption;
1190 txtMed.SelectAll;
1191 FFromSelf := False;
1192 Key := 0;
1193 end;
1194*)
1195end;
1196
1197procedure TfrmODMeds.ListViewResize(Sender: TObject);
1198begin
1199 with Sender as TListView do Columns.Items[0].Width := ClientWidth - 20;
1200end;
1201
1202{ lstAll Methods (lstAll is TListView) }
1203
1204procedure TfrmODMeds.LoadMedCache(First, Last: Integer);
1205const
1206 MAX_CACHE_ITEMS = 1000;
1207begin
1208 // if range is within cache range we don't need to update anything
1209 if (First >= FAllFirst) and (Last <= FAllLast) then Exit;
1210 // if range is outside of cache or a superset of cache, start over
1211 if (Last < Pred(FAllFirst)) or (First > Succ(FAllLast)) or
1212 ((First < FAllFirst) and (Last > FAllLast)) or
1213 (FAllItems.Count > MAX_CACHE_ITEMS) then
1214 begin
1215 FAllItems.Clear;
1216 FAllFirst := -1;
1217 FAllLast := -1;
1218 end;
1219 // if getting items immediately before cache range
1220 if (First < FAllFirst) and (Last >= FAllFirst) then Last := Pred(FAllFirst);
1221 // if getting items immediately after cache range
1222 if (Last > FAllLast) and (First <= FAllLast) then First := Succ(FAllLast);
1223 // retrieve the items and append (First>FAllLast) or prepend them to FAllItems
1224 SubsetOfOrderable(FAllItems, First>FAllLast, FAllList, First, Last);
1225 // reset FAllFirst & FAllLast indexes to reflect current FAllItems
1226 if FAllFirst < 0 then FAllFirst := First;
1227 if FAllLast < 0 then FAllLast := Last;
1228 if First < FAllFirst then FAllFirst := First;
1229 if Last > FAllLast then FAllLast := Last;
1230end;
1231
1232procedure TfrmODMeds.lstAllData(Sender: TObject; Item: TListItem);
1233var
1234 x: string;
1235begin
1236 if (FAllFirst = -1) or (Item.Index < FAllFirst) or (Item.Index > FAllLast)
1237 then LoadMedCache(Item.Index, Item.Index);
1238 x := FAllItems[Item.Index - FAllFirst];
1239 Item.Caption := Piece(x, U, 2);
1240 Item.Data := Pointer(StrToIntDef(Piece(x, U, 1), 0));
1241end;
1242
1243procedure TfrmODMeds.lstAllDataHint(Sender: TObject; StartIndex,
1244 EndIndex: Integer);
1245begin
1246 LoadMedCache(StartIndex, EndIndex);
1247end;
1248
1249{ lstQuick methods (lstQuick is TListView) }
1250
1251procedure TfrmODMeds.lstQuickData(Sender: TObject; Item: TListItem);
1252var
1253 x: string;
1254begin
1255{ try
1256 if FQuickItems[Item.Index] = '' then
1257 SubsetOfQuickOrders(FQuickItems, FQuickList, Item.Index, Item.Index);}
1258 x := FQuickItems[Item.Index];
1259 Item.Caption := Piece(x, U, 2);
1260 Item.Data := Pointer(StrToIntDef(Piece(x, U, 1), 0));
1261{ except
1262 // doing nothing
1263 end;}
1264end;
1265
1266procedure TfrmODMeds.lstQuickDataHint(Sender: TObject; StartIndex,
1267 EndIndex: Integer);
1268begin
1269
1270end;
1271
1272{ Medication is now selected ---------------------------------------------------------------- }
1273
1274procedure TfrmODMeds.btnSelectClick(Sender: TObject);
1275var
1276 MedIEN: Integer;
1277 MedName: string;
1278 QOQuantityStr: string;
1279 ErrMsg: string;
1280begin
1281 SetupVars; //kt added 8/8/2007 to replace constants with vars.
1282 inherited;
1283 QOQuantityStr := '';
1284 btnSelect.SetFocus; // let the exit events finish
1285
1286 if pnlMeds.Visible then // display the medication fields
1287 begin
1288 Changing := True;
1289 ResetOnMedChange;
1290 if (FActiveMedList = lstQuick) and (lstQuick.Selected <> nil) then // quick order
1291 begin
1292 ErrMsg := '';
1293 FIsQuickOrder := True;
1294 FQOInitial := True;
1295 Responses.QuickOrder := Integer(lstQuick.Selected.Data);
1296 txtMed.Tag := StrToIntDef(Responses.IValueFor('ORDERABLE', 1), 0);
1297 IsActivateOI(ErrMsg, txtMed.Tag);
1298 if Length(ErrMsg)>0 then
1299 begin
1300 //btnSelect.Visible := False;
1301 btnSelect.Enabled := False;
1302 ShowMessage(ErrMsg);
1303 Exit;
1304 end;
1305 if DEACheckFailed(txtMed.Tag, FInptDlg) then
1306 begin
1307 //btnSelect.Visible := False;
1308 btnSelect.Enabled := False;
1309 InfoBox(TX_NO_DEA, TC_NO_DEA, MB_OK);
1310 txtMed.Tag := 0;
1311 txtMed.SetFocus;
1312 Exit;
1313 end;
1314 if txtMed.Tag = 0 then
1315 begin
1316 //btnSelect.Visible := False;
1317 btnSelect.Enabled := False;
1318 txtMed.SetFocus;
1319 Exit;
1320 end;
1321 SetOnMedSelect; // set up for this medication
1322 SetOnQuickOrder; // insert quick order responses
1323 if Length(txtQuantity.Text)>0 then
1324 QOQuantityStr := txtQuantity.Text;
1325 ShowMedFields;
1326 if (txtQuantity.Text = '0') and (Length(QOQuantityStr)>0) then
1327 txtQuantity.Text := QOQuantityStr;
1328 end
1329 else if (FActiveMedList = lstAll) and (lstAll.Selected <> nil) then // orderable item
1330 begin
1331 MedIEN := Integer(lstAll.Selected.Data);
1332 MedName := lstAll.Selected.Caption;
1333 txtMed.Tag := MedIEN;
1334 ErrMsg := '';
1335 IsActivateOI(ErrMsg, txtMed.Tag);
1336 if Length(ErrMsg)>0 then
1337 begin
1338 //btnSelect.Visible := False;
1339 btnSelect.Enabled := False;
1340 ShowMessage(ErrMsg);
1341 Exit;
1342 end;
1343 if DEACheckFailed(txtMed.Tag, FInptDlg) then
1344 begin
1345 //btnSelect.Visible := False;
1346 btnSelect.Enabled := False;
1347 InfoBox(TX_NO_DEA, TC_NO_DEA, MB_OK);
1348 txtMed.Tag := 0;
1349 txtMed.SetFocus;
1350 Exit;
1351 end;
1352 if Pos(' NF', MedName) > 0 then
1353 begin
1354 CheckFormularyOI(MedIEN, MedName, FInptDlg);
1355 FAltChecked := True;
1356 end;
1357 if MedIEN <> txtMed.Tag then
1358 begin
1359 txtMed.Tag := MedIEN;
1360 txtMed.Text := MedName;
1361 end;
1362 SetOnMedSelect;
1363 ShowMedFields;
1364 end
1365 else // no selection
1366 begin
1367 //btnSelect.Visible := False;
1368 btnSelect.Enabled := False;
1369 MessageBeep(0);
1370 //btnSelect.Visible := False;
1371 btnSelect.Enabled := False;
1372 Exit;
1373 end;
1374 UpdateRelated(False);
1375 Changing := False;
1376 ControlChange(Self);
1377 end
1378 else ShowMedSelect; // show the selection fields
1379 FNoZERO := False;
1380end;
1381
1382procedure TfrmODMeds.ResetOnMedChange;
1383var
1384 i: Integer;
1385begin
1386 Responses.Clear;
1387 // clear dialog controls individually, since they are on panels
1388 with grdDoses do for i := 1 to Pred(RowCount) do Rows[i].Clear;
1389 cboDosage.Items.Clear;
1390 cboDosage.Text := '';
1391 cboRoute.Items.Clear;
1392 cboRoute.Text := '';
1393 cboRoute.Hint := cboRoute.Text;
1394 cboSchedule.ItemIndex := -1;
1395 cboSchedule.Text := ''; // leave items intact
1396 chkPRN.Checked := False;
1397 memComment.Lines.Clear;
1398 txtSupply.Text := '';
1399 txtQuantity.Text := '';
1400 txtRefills.Text := '0';
1401 lblQtyMsg.Caption := '';
1402//lblQuantity.Caption := 'Quantity'; <-- original line. //kt 8/8/2007
1403 lblQuantity.Caption := DKLangConstW('fODMeds_Quantity'); //kt added 8/8/2007
1404 chkDoseNow.Checked := FALSE;
1405 lblAdminTime.Caption := '';
1406 chkPtInstruct.Checked := False;
1407 chkPtInstruct.Visible := False;
1408 memPI.Visible := False;
1409 stcPI.Visible := False;
1410 image1.Visible := False;
1411 memDrugMsg.Visible := False;
1412 FLastUnits := '';
1413 FLastSchedule := '';
1414 FLastDuration := '';
1415 FLastInstruct := '';
1416 FLastDispDrug := '-1';
1417 FLastQuantity := 0;
1418 FLastSupply := 0;
1419 FAltChecked := False;
1420 FPtInstruct := '';
1421end;
1422
1423procedure TfrmODMeds.ResetOnTabChange;
1424var
1425 i: Integer;
1426begin
1427 with grdDoses do for i := 1 to Pred(RowCount) do Rows[i].Clear;
1428 Responses.Clear('STRENGTH');
1429 Responses.Clear('NAME');
1430 Responses.Clear('INSTR');
1431 Responses.Clear('DOSE');
1432 Responses.Clear('DRUG');
1433 Responses.Clear('DAYS');
1434 Responses.Clear('ROUTE');
1435 Responses.Clear('SCHEDULE');
1436 Responses.Clear('START', 1);
1437 Responses.Clear('SIG');
1438 Responses.Clear('SUPPLY');
1439 Responses.Clear('QTY');
1440 cboDosage.ItemIndex := -1;
1441 cboDosage.Text := '';
1442 cboRoute.ItemIndex := -1;
1443 cboRoute.Text := '';
1444 cboSchedule.ItemIndex := -1;
1445 cboSchedule.Text := ''; // leave items intact
1446 txtSupply.Text := '';
1447 txtSupply.Tag := 0;
1448 txtQuantity.Text := '';
1449 txtQuantity.Tag := 0;
1450 lblQtyMsg.Caption := '';
1451//lblQuantity.Caption := 'Quantity'; <-- original line. //kt 8/8/2007
1452 lblQuantity.Caption := DKLangConstW('fODMeds_Quantity'); //kt added 8/8/2007
1453 FSmplPRNChkd := chkPRN.Checked; // GE CQ7585
1454 chkPRN.Checked := False;
1455 FLastUnits := '';
1456 FLastSchedule := '';
1457 FLastDuration := '';
1458 FLastInstruct := '';
1459 FLastDispDrug := '';
1460 FDrugID := '';
1461end;
1462
1463procedure TfrmODMeds.SetOnMedSelect;
1464var
1465 i,j: Integer;
1466 x: string;
1467 QOPiUnChk: boolean;
1468 PKIEnviron: boolean;
1469begin
1470 // clear controls?
1471 cboDosage.Tag := -1;
1472 txtSupply.Tag := 0;
1473 txtQuantity.Tag := 0;
1474 spnQuantity.Tag := 0;
1475 chkSC.Tag := 0;
1476 QOPiUnChk := False;
1477 PKIEnviron := False;
1478 if GetPKISite then PKIEnviron := True;
1479 with CtrlInits do
1480 begin
1481 // set up CtrlInits for orderable item
1482 LoadOrderItem(OIForMed(txtMed.Tag, FInptDlg, IncludeOIPI, PKIEnviron));
1483 // set up lists & initial values based on orderable item
1484// SetControl(txtMed, 'Medication'); <-- original line. //kt 8/8/2007
1485 SetControl(txtMed, DKLangConstW('fODMeds_Medication')); //kt added 8/8/2007
1486// SetControl(cboDosage, 'Dosage'); <-- original line. //kt 8/8/2007
1487 SetControl(cboDosage, DKLangConstW('fODMeds_Dosage')); //kt added 8/8/2007
1488// SetControl(cboRoute, 'Route'); <-- original line. //kt 8/8/2007
1489 SetControl(cboRoute, DKLangConstW('fODMeds_Route')); //kt added 8/8/2007
1490 if cboRoute.Items.Count = 1 then cboRoute.ItemIndex := 0;
1491 cboRouteChange(Self);
1492// x := DefaultText('Schedule'); <-- original line. //kt 8/8/2007
1493 x := DefaultText(DKLangConstW('fODMeds_Schedule')); //kt added 8/8/2007
1494 if x <> '' then
1495 begin
1496 cboSchedule.SelectByID(x);
1497 cboSchedule.Text := x;
1498 end;
1499 if Length(ValueOf(FLD_QTYDISP))>10 then
1500 begin
1501 lblQuantity.Caption := Copy(ValueOf(FLD_QTYDISP),0,7) + '...';
1502 lblQuantity.Hint := ValueOf(FLD_QTYDISP);
1503 end;
1504// FAllDoses.Text := TextOf('AllDoses'); <-- original line. //kt 8/8/2007
1505 FAllDoses.Text := TextOf(DKLangConstW('fODMeds_AllDoses')); //kt added 8/8/2007
1506// FAllDrugs.Text := TextOf('Dispense'); <-- original line. //kt 8/8/2007
1507 FAllDrugs.Text := TextOf(DKLangConstW('fODMeds_Dispense')); //kt added 8/8/2007
1508// FGuideline.Text := TextOf('Guideline'); <-- original line. //kt 8/8/2007
1509 FGuideline.Text := TextOf(DKLangConstW('fODMeds_Guideline')); //kt added 8/8/2007
1510 case FGuideline.Count of
1511 0: lblGuideline.Visible := False;
1512 1: begin
1513 lblGuideline.Caption := FGuideline[0];
1514 lblGuideline.Visible := TRUE;
1515 end;
1516 else begin
1517// lblGuideline.Caption := 'Display Restrictions/Guidelines'; <-- original line. //kt 8/8/2007
1518 lblGuideline.Caption := DKLangConstW('fODMeds_Display_RestrictionsxGuidelines'); //kt added 8/8/2007
1519 lblGuideline.Visible := TRUE;
1520 end;
1521 end;
1522 if FInptDlg then
1523 begin
1524 if not FResizedAlready then
1525 begin
1526 pnlBottom.Height := pnlBottom.Height - lblDays.Height - txtSupply.Height
1527 - stcPi.Height - memPi.Height + 6;
1528 FResizedAlready := True;
1529 end;
1530 pnlTop.Height := pnlFields.Height - pnlBottom.Height;
1531 chkDoseNow.Top := memComment.Top + memComment.Height + 1;
1532 lblPriority.Top := memcomment.Top + memComment.Height + 1;
1533 cboPriority.Top := lblPriority.Top + lblPriority.Height;
1534 lblAdminTime.Left := chkDoseNow.Left;
1535 lblAdminTime.Top := chkDoseNow.Top + chkDoseNow.Height - 1;
1536 end else
1537 begin
1538 DEASig := '';
1539// if GetPKISite then DEASig := DefaultText('DEASchedule'); <-- original line. //kt 8/8/2007
1540 if GetPKISite then DEASig := DefaultText(DKLangConstW('fODMeds_DEASchedule')); //kt added 8/8/2007
1541// FSIGVerb := DefaultText('Verb'); <-- original line. //kt 8/8/2007
1542 FSIGVerb := DefaultText(DKLangConstW('fODMeds_Verb')); //kt added 8/8/2007
1543 if Length(FSIGVerb) = 0 then FSIGVerb := TX_TAKE;
1544// FSIGPrep := DefaultText('Preposition'); <-- original line. //kt 8/8/2007
1545 FSIGPrep := DefaultText(DKLangConstW('fODMeds_Preposition')); //kt added 8/8/2007
1546// if FLastPickup <> '' then SetPickup(FLastPickup) else SetPickup(DefaultText('Pickup')); <-- original line. //kt 8/8/2007
1547 if FLastPickup <> '' then SetPickup(FLastPickup) else SetPickup(DefaultText(DKLangConstW('fODMeds_Pickup'))); //kt added 8/8/2007
1548// SetControl(txtRefills, 'Refills'); <-- original line. //kt 8/8/2007
1549 SetControl(txtRefills, DKLangConstW('fODMeds_Refills')); //kt added 8/8/2007
1550 for j := 0 to Responses.TheList.Count - 1 do
1551 begin
1552 if (TResponse(Responses.theList[j]).PromptID = 'PI') and (TResponse(Responses.theList[j]).EValue = ' ') then
1553 QOPiUnChk := True;
1554 end;
1555 //if Length(FPtInstruct) = 0 then
1556// FPtInstruct := TextOf('PtInstr'); <-- original line. //kt 8/8/2007
1557 FPtInstruct := TextOf(DKLangConstW('fODMeds_PtInstr')); //kt added 8/8/2007
1558 for i := 1 to Length(FPtInstruct) do if Ord(FPtInstruct[i]) < 32 then FPtInstruct[i] := ' ';
1559 FPtInstruct := TrimRight(FPtInstruct);
1560 if Length(FPtInstruct) > 0 then
1561 begin
1562 //chkPtInstruct.Caption := FPtInstruct;
1563 if memPI.Lines.Count > 0 then
1564 memPI.Lines.Clear;
1565 memPI.Lines.Add(FPtInstruct);
1566 chkPtInstruct.Visible := True;
1567 chkPtInstruct.Checked := True;
1568 stcPI.Visible := True;
1569 memPI.Visible := True;
1570 if FShrinked then
1571 begin
1572 pnlBottom.Height := pnlBottom.Height + memPi.Height + stcPI.Height + 2;
1573 FShrinked := False;
1574 end;
1575 if QOPiUnChk then
1576 chkPtInstruct.Checked := False;
1577 end else
1578 begin
1579 chkPtInstruct.Visible := False;
1580 chkPtInstruct.Checked := False;
1581 stcPI.Visible := False;
1582 memPI.Visible := False;
1583 if not FShrinked then
1584 begin
1585 pnlBottom.Height := pnlBottom.Height - stcPI.Height - memPI.Height - 2;
1586 FShrinked := True;
1587 end;
1588 end;
1589 end;
1590 pnlMessage.TabOrder := cboDosage.TabOrder + 1;
1591// DispOrderMessage(TextOf('Message')); <-- original line. //kt 8/8/2007
1592 DispOrderMessage(TextOf(DKLangConstW('fODMeds_Message'))); //kt added 8/8/2007
1593 end;
1594end;
1595
1596procedure TfrmODMeds.SetOnQuickOrder;
1597var
1598 AResponse: TResponse;
1599 x,LocRoute,TempSch,DispGrp: string;
1600 i, DispDrug: Integer;
1601begin
1602 SetupVars; //kt added 8/8/2007 to replace constants with vars.
1603 // txtMed already set by SetOnMedSelect
1604 with Responses do
1605 begin
1606 if (InstanceCount('INSTR') > 1) or (InstanceCount('DAYS') > 0) then // complex dose
1607 begin
1608 grdDoses.RowCount := HigherOf(InstanceCount('INSTR')+2, 4);
1609 i := Responses.NextInstance('INSTR', 0);
1610 while i > 0 do
1611 begin
1612 SetDosage(IValueFor('INSTR', i));
1613 with cboDosage do
1614 if ItemIndex > -1 then x := Text + TAB + Items[ItemIndex]
1615 else x := IValueFor('INSTR',i); //AGP Change 26.41 for CQ 9102 PSI-05-015 affect copy and edit functionality
1616 grdDoses.Cells[COL_DOSAGE, i] := x;
1617 SetControl(cboRoute, 'ROUTE', i);
1618 with cboRoute do
1619 if ItemIndex > -1 then x := Text + TAB + Items[ItemIndex] else x := Text;
1620 grdDoses.Cells[COL_ROUTE, i] := x;
1621 if FIsQuickOrder then TempSch := cboSchedule.Text;
1622 SetSchedule(IValueFor('SCHEDULE', i));
1623 if (cboSchedule.Text = '') and FIsQuickOrder then
1624 begin
1625 cboSchedule.SelectByID(TempSch);
1626 cboSchedule.Text := TempSch;
1627 end;
1628 x := cboSchedule.Text;
1629 if chkPRN.Checked then x := x + ' PRN';
1630 with cboSchedule do
1631 if ItemIndex > -1 then x := x + TAB + Items[ItemIndex];
1632 grdDoses.Cells[COL_SCHEDULE, i] := x;
1633 if chkPRN.Checked = True then grdDoses.Cells[COL_CHKXPRN,i] := '1';
1634 grdDoses.Cells[COL_DURATION, i] := IValueFor('DAYS', i);
1635 if IValueFor('CONJ', i) = 'A' then x := 'AND'
1636 else if IValueFor('CONJ', i) = 'T' then x := 'THEN'
1637 else if IValueFor('CONJ', i) = 'X' then x := 'EXCEPT'
1638 else x := '';
1639 grdDoses.Cells[COL_SEQUENCE, i] := x;
1640 i := Responses.NextInstance('INSTR', i);
1641 end; {while}
1642 end else // single dose
1643 begin
1644 if FIsQuickOrder then
1645 begin
1646 FQODosage := IValueFor('INSTR', 1);
1647 SetDosage(FQODosage);
1648 TempSch := cboSchedule.Text;
1649 end
1650 else
1651 SetDosage(IValueFor('INSTR', 1));
1652 SetControl(cboRoute, 'ROUTE', 1);
1653 SetSchedule(IValueFor('SCHEDULE', 1));
1654 if (cboSchedule.Text = '') and FIsQuickOrder then
1655 begin
1656 cboSchedule.SelectByID(TempSch);
1657 cboSchedule.Text := TempSch;
1658 end;
1659 if ((cboSchedule.Text = 'OTHER') and FIsQuickOrder) then
1660 FNSSOther := True;
1661 DispDrug := StrToIntDef(ValueOf(FLD_DRUG_ID), 0);
1662 if Length(ValueOf(FLD_QTYDISP))>10 then
1663 begin
1664 lblQuantity.Caption := Copy(ValueOf(FLD_QTYDISP),0,7) + '...';
1665 lblQuantity.Hint := ValueOf(FLD_QTYDISP);
1666 end;
1667 if DispDrug > 0 then
1668 begin
1669 DispOrderMessage(DispenseMessage(DispDrug));
1670 x := QuantityMessage(DispDrug);
1671 end;
1672 if Length(x) > 0
1673 then lblQtyMsg.Caption := TX_QTY_PRE + x + TX_QTY_POST
1674 else lblQtyMsg.Caption := '';
1675 end;
1676 SetControl(memComment , 'COMMENT', 1);
1677 SetControl(cboPriority, 'URGENCY', 1);
1678 if FInptDlg then
1679 begin
1680 SetControl(chkDoseNow, 'NOW', 1);
1681 chkDoseNowClick(Self);
1682 end else
1683 begin
1684 SetControl(txtSupply, 'SUPPLY', 1);
1685 txtSupply.Text := Trim(txtSupply.Text);
1686 spnSupply.Position := StrToIntDef(txtSupply.Text, 0);
1687 { setting .Tag=1 was commented out because xfer & change were not auto-calculating }
1688 //if spnSupply.Position <> 0 then txtSupply.Tag := 1;
1689 if Length(IValueFor('QTY',1))>0 then
1690 begin
1691 FQOQuantity := StrToFloat(IValueFor('QTY',1));
1692 txtQuantity.Text := FloatToStr(FQOQuantity);
1693 end;
1694 SetControl(txtQuantity, 'QTY', 1);
1695 SetControl(txtRefills, 'REFILLS', 1);
1696 spnRefills.Position := StrToIntDef(txtRefills.Text, 0);
1697 AResponse := Responses.FindResponseByName('PICKUP', 1);
1698 if AResponse <> nil then SetPickup(AResponse.IValue);
1699 if FIsQuickOrder then
1700 begin
1701 if not QOHasRouteDefined(Responses.QuickOrder) then
1702 begin
1703 LocRoute := GetPickupForLocation(IntToStr(Encounter.Location));
1704 SetPickup(LocRoute);
1705 end;
1706 end;
1707 DispGrp := NameOfDGroup(Responses.DisplayGroup);
1708// if (AResponse = nil) or ((StrToIntDef(Piece(Responses.CopyOrder,';',1),0)>0) and AnsiSameText('Out. Meds',DispGrp)) then <-- original line. //kt 8/8/2007
1709 if (AResponse = nil) or ((StrToIntDef(Piece(Responses.CopyOrder,';',1),0)>0) and AnsiSameText(DKLangConstW('fODMeds_Outx_Meds'),DispGrp)) then //kt added 8/8/2007
1710 begin
1711 LocRoute := GetPickupForLocation(IntToStr(Encounter.Location));
1712 SetPickup(LocRoute);
1713 end;
1714 if ValueOf(FLD_PICKUP) = '' then SetPickup(FLastPickup);
1715 AResponse := Responses.FindResponseByName('SC', 1);
1716 if AResponse <> nil then chkSC.Checked := AResponse.IValue = '1';
1717 end; {if FInptDlg..else}
1718 end; {with}
1719 if FInptDlg then
1720 begin
1721 x := ValueOfResponse(FLD_SCHEDULE, 1);
1722 if Length(x) > 0 then UpdateStartExpires(x);
1723 end;
1724end;
1725
1726procedure TfrmODMeds.ShowMedSelect;
1727begin
1728 txtMed.SelStart := Length(txtMed.Text);
1729 ChangeDelayed; // synch the listboxes with display
1730 pnlFields.Enabled := False;
1731 pnlFields.Visible := False;
1732 pnlMeds.Enabled := True;
1733 pnlMeds.Visible := True;
1734 pnlFields.Height := MemOrder.Top - 4 - pnlFields.Top;
1735//if btnSelect.Caption = 'Change' then <-- original line. //kt 8/8/2007
1736 if btnSelect.Caption = DKLangConstW('fODMeds_Change') then //kt added 8/8/2007
1737 begin
1738 btnSelect.Caption := 'OK';
1739 //btnSelect.Visible := false;
1740 btnSelect.Enabled := false;
1741 end;
1742 btnSelect.Top := memOrder.Top;
1743 btnSelect.Anchors := [akRight, akBottom];
1744 btnSelect.BringToFront;
1745 cmdAccept.Visible := False;
1746 cmdAccept.Default := False;
1747 btnSelect.Default := True;
1748 cmdAccept.Left := cmdQuit.Left;
1749 cmdAccept.Top := MemOrder.Top;
1750 btnSelect.TabOrder := cmdAccept.TabOrder;
1751 cmdAccept.TabStop := False;
1752 txtMed.Width := grdDoses.Width;
1753 txtMed.Font.Color := clWindowText;
1754 txtMed.Color := clWindow;
1755 txtMed.ReadOnly := False;
1756 txtMed.SelectAll;
1757 txtMed.SetFocus;
1758 FDrugID := '';
1759 //ShowOrderMessage( False );
1760end;
1761
1762procedure TfrmODMeds.ShowMedFields;
1763begin
1764 pnlMeds.Enabled := False;
1765 pnlMeds.Visible := False;
1766 pnlFields.Enabled := True;
1767 pnlFields.Visible := True;
1768 pnlFields.Height := MemOrder.Top - 4 - pnlFields.Top;
1769//btnSelect.Caption := 'Change'; <-- original line. //kt 8/8/2007
1770 btnSelect.Caption := DKLangConstW('fODMeds_Change'); //kt added 8/8/2007
1771 btnSelect.Visible := True;
1772 btnSelect.Enabled := True;
1773 btnSelect.Top := txtMed.Top;
1774 btnSelect.Anchors := [akRight, akTop];
1775 btnSelect.Default := False;
1776 cmdAccept.Visible := True;
1777 cmdAccept.Default := True;
1778 cmdAccept.Left := cmdQuit.Left;
1779 cmdAccept.Top := MemOrder.Top;
1780 btnSelect.TabOrder := txtMed.TabOrder + 1;
1781 cmdAccept.TabStop := True;
1782 txtMed.Width := memOrder.Width;
1783 txtMed.Font.Color := clInfoText;
1784 txtMed.Color := clInfoBk;
1785 txtMed.ReadOnly := True;
1786 if (Responses.InstanceCount('INSTR') > 1) or (Responses.InstanceCount('DAYS') > 0)
1787 then ShowControlsComplex else ShowControlsSimple;
1788end;
1789
1790procedure TfrmODMeds.ShowControlsSimple;
1791//var
1792 //dosagetxt: string;
1793begin
1794 //Commented out, no longer using CharsNeedMatch Property
1795{ NumCharsForMatch := 0;
1796 for i := 0 to cboDosage.Items.Count - 1 do //find the shortest unit dose text on fifth piece
1797 begin
1798 dosagetxt := Piece(cboDosage.Items[i],'^',5);
1799 if Length(dosagetxt) < 1 then break;
1800 if NumCharsForMatch = 0 then
1801 NumCharsForMatch := Length(dosagetxt);
1802 if (NumCharsForMatch > Length(dosagetxt)) then
1803 NumCharsForMatch := Length(dosagetxt);
1804 end;
1805 if NumCharsForMatch > 1 then
1806 cboDosage.CharsNeedMatch := NumCharsForMatch - 1;
1807 if NumCharsForMatch > 5 then
1808 cboDosage.CharsNeedMatch := 5;}
1809 tabDose.TabIndex := TI_DOSE;
1810 grdDoses.Visible := False;
1811 btnXInsert.Visible := False;
1812 btnXRemove.Visible := False;
1813 cboDosage.Visible := True;
1814 lblRoute.Visible := True;
1815 cboRoute.Visible := True;
1816 lblSchedule.Visible := True;
1817 cboSchedule.Visible := True;
1818 chkPRN.Visible := True;
1819 ActiveControl := cboDosage;
1820end;
1821
1822procedure TfrmODMeds.ShowControlsComplex;
1823
1824 procedure MoveCombo(SrcCombo, DestCombo: TORComboBox; CompSch: boolean = false); //AGP Changes 26.12 PSI-04-63
1825 var
1826 cnt,i,index: integer;
1827 node,text: string;
1828 begin
1829 if (CompSch = false) or not (FInptDlg)then
1830 begin
1831 DestCombo.Items.Clear;
1832 DestCombo.Items.Assign(SrcCombo.Items);
1833 DestCombo.ItemIndex := SrcCombo.ItemIndex;
1834 DestCombo.Text := Piece(SrcCombo.Text, TAB, 1);
1835 end;
1836 if (CompSch = true) and (FInptDlg) then // AGP Changes 26.12 PSI-04-63
1837 begin
1838 //AGP change 26.34 CQ 7201,6902 fix the problem with one time schedule still showing for inpatient complex orders
1839 DestCombo.ItemIndex := -1;
1840 Text := SrcCombo.Text;
1841 index := SrcCombo.ItemIndex;
1842 cnt := 0;
1843 for i := 0 to SrcCombo.Items.Count - 1 do
1844 begin
1845 node := SrcCombo.Items.Strings[i];
1846 if piece(node,U,3) <> 'O' then
1847 begin
1848 DestCombo.Items.Add(SrcCombo.Items.Strings[i]);
1849 if Piece(node,U,1) = text then DestCombo.ItemIndex := index - cnt;
1850 end
1851 else cnt := cnt+1;
1852 end;
1853 end;
1854 end;
1855
1856//var
1857 //dosagetxt: string;
1858begin
1859 tabDose.TabIndex := TI_COMPLEX;
1860 MoveCombo(cboDosage, cboXDosage);
1861 MoveCombo(cboRoute, cboXRoute);
1862 MoveCombo(cboSchedule, cboXSchedule, true); //AGP Changes 26.12 PSI-04-063
1863 grdDoses.Visible := True;
1864 btnXInsert.Visible := True;
1865 btnXRemove.Visible := True;
1866 cboDosage.Visible := False;
1867 lblRoute.Visible := False;
1868 cboRoute.Visible := False;
1869 lblSchedule.Visible := False;
1870 cboSchedule.Visible := False;
1871 chkPRN.Visible := False;
1872 FDropColumn := -1;
1873 pnlFieldsResize(Self);
1874 ActiveControl := grdDoses;
1875 //Commented out, no longer using CharsNeedMatch Property
1876{ NumCharsForMatch := 0;
1877 for i := 0 to cboXDosage.Items.Count - 1 do //find the shortest unit dose text on fifth piece
1878 begin
1879 dosagetxt := Piece(cboXDosage.Items[i],'^',5);
1880 if Length(dosagetxt) < 1 then break;
1881 if NumCharsForMatch = 0 then
1882 NumCharsForMatch := Length(dosagetxt);
1883 if (NumCharsForMatch > Length(dosagetxt)) then
1884 NumCharsForMatch := Length(dosagetxt);
1885 end;
1886 if NumCharsForMatch > 1 then
1887 cboXDosage.CharsNeedMatch := NumCharsForMatch - 1;
1888 if NumCharsForMatch > 5 then
1889 cboDosage.CharsNeedMatch := 5;}
1890end;
1891
1892procedure TfrmODMeds.SetDosage(const x: string);
1893var
1894 i, DoseIndex: Integer;
1895begin
1896 DoseIndex := -1;
1897 with cboDosage do
1898 begin
1899 ItemIndex := -1;
1900 for i := 0 to Pred(Items.Count) do
1901 if Piece(Items[i], U, 5) = x then
1902 begin
1903 DoseIndex := i;
1904 Break;
1905 end;
1906 if DoseIndex <0 then Text := x
1907 (* if ((DoseIndex < 0) and (not IsTransferAction)) then Text := x
1908 else if ((DoseIndex < 0) and IsTransferAction) and (DosageTab = False) then Text := ''
1909 else if ((DoseIndex < 0) and IsTransferAction) and (DosageTab = True) then Text := x *)
1910 else ItemIndex := DoseIndex;
1911 end;
1912end;
1913
1914procedure TfrmODMeds.SetPickup(const x: string);
1915begin
1916 radPickClinic.Checked := FALSE;
1917 radPickMail.Checked := FALSE;
1918 radPickWindow.Checked := FALSE;
1919 case CharAt(x, 1) of
1920 'C': radPickClinic.Checked := TRUE;
1921 'M': radPickMail.Checked := TRUE;
1922 'W': radPickWindow.Checked := TRUE;
1923 else {leave all unchecked}
1924 end;
1925end;
1926
1927procedure TfrmODMeds.SetSchedule(const x: string);
1928var
1929NonPRNPart: string;
1930begin
1931 cboSchedule.ItemIndex := -1;
1932 //AGP change CQ 10593, remove code to match the new expected first dose code
1933 //PSI-05-026
1934 (* if Pos('PRN', x) > 0 then
1935 begin
1936 NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1));
1937 cboSchedule.SelectByID(NonPRNPart);
1938 if cboSchedule.ItemIndex < 0 then
1939 begin
1940 if NSSchedule then
1941 begin
1942 chkPRN.Checked := False;
1943 cboSchedule.Text := '';
1944 end else
1945 begin
1946 chkPRN.Checked := True;
1947 cboSchedule.Items.Add(NonPRNPart);
1948 cboSchedule.Text := NonPRNPart;
1949 end;
1950 end else
1951 chkPRN.Checked := True;
1952 end else
1953 begin *)
1954 chkPRN.Checked := False;
1955 cboSchedule.SelectByID(x);
1956 if cboSchedule.ItemIndex < 0 then
1957 begin
1958 if NSSchedule then
1959 begin
1960 cboSchedule.Text := '';
1961 end
1962 else
1963 begin
1964 if Pos('PRN', x) > 0 then
1965 begin
1966 NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1));
1967 chkPRN.Checked := True;
1968 cboSchedule.SelectByID(NonPRNPart);
1969 if cboSchedule.ItemIndex > -1 then EXIT;
1970 cboSchedule.Items.Add(NonPRNPart);
1971 cboSchedule.Text := NonPRNPart;
1972 cboSchedule.SelectByID(NonPRNPart);
1973 EXIT;
1974 end;
1975 cboSchedule.Items.Add(x);
1976 cboSchedule.Text := x;
1977 cboSchedule.SelectByID(x);
1978 end;
1979 end;
1980end;
1981
1982{ Medication edit --------------------------------------------------------------------------- }
1983procedure TfrmODMeds.tabDoseChange(Sender: TObject);
1984var
1985 //text,x, tmpsch: string;
1986 text, x: string;
1987 reset: integer;
1988begin
1989 inherited;
1990 reset := 0;
1991 //AGP change for CQ 6521 added warning message
1992 //AGP Change for CQ 7508 added tab information
1993 //GE Change warning message functionality show only cq 7590
1994 // when tab changes from complex to simple.
1995 //AGP Change for CQ 7834 and 7832 change text and added check to see if some values have been completed in row 1
1996 if (tabDose.TabIndex = 0) and ((ValFor(COL_DOSAGE, 1)<>'') or (ValFor(COL_SCHEDULE, 1)<>'') or (ValFor(COL_DURATION, 1)<>'') or
1997 (ValFor(COL_SEQUENCE, 1)<>'')) then
1998 begin
1999// text := 'By switching to the Dosage Tab, ' ; <-- original line. //kt 8/8/2007
2000 text := DKLangConstW('fODMeds_By_switching_to_the_Dosage_Tabx') ; //kt added 8/8/2007
2001// if (InfoBox(text +'you will lose all data on this screen. Click “OK” to continue or “Cancel”','Warning',MB_OKCANCEL)=IDCANCEL) then <-- original line. //kt 8/8/2007
2002 if (InfoBox(text +DKLangConstW('fODMeds_you_will_lose_all_data_on_this_screenx_Click_xOKx_to_continue_or_xCancelx'),DKLangConstW('fODMeds_Warning'),MB_OKCANCEL)=IDCANCEL) then //kt added 8/8/2007
2003 begin
2004 if tabDose.TabIndex = 1 then tabDose.TabIndex := 0
2005 else tabDose.TabIndex := 1;
2006 reset := 1;
2007 end;
2008 end;
2009 case tabDose.TabIndex of
2010 TI_DOSE: begin
2011 cboXSchedule.Clear; // Added to Fix CQ: 9603
2012 // clean up responses?
2013 FSuppressMsg := FOrigiMsgDisp;
2014 ShowControlsSimple;
2015 if reset = 0 then ResetOnTabChange;
2016 txtNss.Left := lblSchedule.Left + lblSchedule.Width + 2;
2017 if (FInptDlg) then txtNss.Visible := True
2018 else txtNss.Visible := False;
2019 cboXRoute.Hide; // Added to Fix CQ: 7640
2020 ControlChange(Self);
2021 end;
2022 TI_RATE: begin
2023 // for future use...
2024 end;
2025 TI_COMPLEX: begin
2026 FSuppressMsg := FOrigiMsgDisp;
2027 if reset = 1 then exit;
2028 ShowControlsComplex;
2029 ResetOnTabChange;
2030 txtNss.Left := grdDoses.Left + grdDoses.ColWidths[0] + grdDoses.ColWidths[1] + grdDoses.ColWidths[2] + 3;
2031 txtNss.Visible := False;
2032 x := cboXDosage.Text + TAB;
2033 with cboXDosage do if ItemIndex > -1 then x := x + Items[ItemIndex];
2034 grdDoses.Cells[COL_DOSAGE, 1] := x;
2035 x := cboXRoute.Text + TAB;
2036 with cboXRoute do if ItemIndex > -1 then x := x + Items[ItemIndex];
2037 grdDoses.Cells[COL_ROUTE, 1] := x;
2038 x := cboXSchedule.Text + TAB;
2039 with cboXSchedule do if ItemIndex > -1 then x := x + Items[ItemIndex];
2040 grdDoses.Cells[COL_SCHEDULE, 1] := x;
2041 UpdateStartExpires(ValFor(VAL_SCHEDULE,1));
2042 ControlChange(Self);
2043 end; {TI_COMPLEX}
2044 end; {case}
2045end;
2046
2047
2048procedure TfrmODMeds.lblGuidelineClick(Sender: TObject);
2049var
2050 TextStrings: TStringList;
2051begin
2052 SetupVars; //kt added 8/8/2007 to replace constants with vars.
2053 inherited;
2054 TextStrings := TStringList.Create;
2055 try
2056 TextStrings.Text := FGuideline.Text;
2057 ReportBox(TextStrings, TC_GUIDELINE, TRUE);
2058 finally
2059 TextStrings.Free;
2060 end;
2061 //if FGuideline.Count > 0 then InfoBox(FGuideline.Text, 'Restrictions/Guidelines', MB_OK);
2062end;
2063
2064{ cboDosage ------------------------------------- }
2065
2066procedure TfrmODMeds.CheckFormAltDose(DispDrug: Integer);
2067var
2068 OI: Integer;
2069 OIName: string;
2070begin
2071 if FAltChecked or (DispDrug = 0) then Exit;
2072 OI := txtMed.Tag;
2073 OIName := txtMed.Text;
2074 CheckFormularyDose(DispDrug, OI, OIName, FInptDlg);
2075 if OI <> txtMed.Tag then
2076 begin
2077 ResetOnMedChange;
2078 txtMed.Tag := OI;
2079 txtMed.Text := OIName;
2080 SetOnMedSelect;
2081 end;
2082end;
2083
2084procedure TfrmODMeds.cboDosageClick(Sender: TObject);
2085var
2086 DispDrug: Integer;
2087 x: string;
2088begin
2089 SetupVars; //kt added 8/8/2007 to replace constants with vars.
2090 inherited;
2091 if FSuppressMsg then
2092 begin
2093 if PnlMessage.Visible = true then
2094 begin
2095 memMessage.SendToBack;
2096 PnlMessage.Visible := False;
2097 end;
2098 end;
2099 UpdateRelated(False);
2100 DispDrug := StrToIntDef(ValueOf(FLD_DRUG_ID), 0);
2101 if DispDrug > 0 then
2102 begin
2103 if not FSuppressMsg then
2104 begin
2105 DispOrderMessage(DispenseMessage(DispDrug));
2106 end;
2107 x := QuantityMessage(DispDrug);
2108 end
2109 else x := '';
2110 if Length(ValueOf(FLD_QTYDISP))>10 then
2111 begin
2112 lblQuantity.Caption := Copy(ValueOf(FLD_QTYDISP),0,7) + '...';
2113 lblQuantity.Hint := ValueOf(FLD_QTYDISP);
2114 end else
2115 begin
2116 lblQuantity.Caption := ValueOf(FLD_QTYDISP);
2117 lblQuantity.Hint := '';
2118 end;
2119 if Length(x) > 0
2120 then lblQtyMsg.Caption := TX_QTY_PRE + x + TX_QTY_POST
2121 else lblQtyMsg.Caption := '';
2122 with cboDosage do
2123 if (ItemIndex > -1) and (Piece(Items[ItemIndex], U, 3) = 'NF')
2124 then CheckFormAltDose(DispDrug);
2125end;
2126
2127procedure TfrmODMeds.cboDosageChange(Sender: TObject);
2128begin
2129 inherited;
2130 UpdateRelated;
2131end;
2132
2133procedure TfrmODMeds.cboDosageExit(Sender: TObject);
2134begin
2135 inherited;
2136 if (length(cboDosage.Text)<1) then
2137 cboDosage.ItemIndex := -1;
2138 if ActiveControl = memMessage then
2139 begin
2140 memMessage.SendToBack;
2141 PnlMessage.Visible := False;
2142 Exit;
2143 end;
2144 if ActiveControl = memComment then
2145 begin
2146 if PnlMessage.Visible = true then
2147 begin
2148 memMessage.SendToBack;
2149 PnlMessage.Visible := False;
2150 end;
2151 end
2152 else if (ActiveControl <> btnSelect) and (ActiveControl <> memComment) then
2153 begin
2154 if PnlMessage.Visible = true then
2155 begin
2156 memMessage.SendToBack;
2157 PnlMessage.Visible := False;
2158 end;
2159 //cboDosageClick(Self);
2160 end;
2161end;
2162
2163{ cboRoute -------------------------------------- }
2164
2165procedure TfrmODMeds.cboRouteChange(Sender: TObject);
2166begin
2167 inherited;
2168 with cboRoute do
2169 if ItemIndex > -1 then
2170 begin
2171 if Piece(Items[ItemIndex], U, 5) = '1'
2172// then tabDose.Tabs[0] := 'Dosage / Rate' <-- original line. //kt 8/8/2007
2173 then tabDose.Tabs[0] := DKLangConstW('fODMeds_Dosage_x_Rate') //kt added 8/8/2007
2174// else tabDose.Tabs[0] := 'Dosage'; <-- original line. //kt 8/8/2007
2175 else tabDose.Tabs[0] := DKLangConstW('fODMeds_Dosage'); //kt added 8/8/2007
2176 end;
2177 cboDosage.Caption := tabDose.Tabs[0];
2178 if Sender <> Self then ControlChange(Sender);
2179end;
2180
2181procedure TfrmODMeds.cboRouteExit(Sender: TObject);
2182begin
2183 if Trim(cboRoute.Text) = '' then
2184 cboRoute.ItemIndex := -1;
2185// ValidateRoute(cboRoute); Removed based on Site feeback. See CQ: 7518
2186 inherited;
2187end;
2188
2189{ cboSchedule ----------------------------------- }
2190
2191procedure TfrmODMeds.cboScheduleClick(Sender: TObject);
2192var
2193 othSch: string;
2194 idx : integer;
2195begin
2196 inherited;
2197 if (FInptDlg) and (cboSchedule.Text = 'OTHER') then
2198 begin
2199 othSch := CreateOtherScheduel;
2200 if length(trim(othSch)) > 1 then
2201 begin
2202 cboSchedule.Items.Add(othSch);
2203 idx := cboSchedule.Items.IndexOf(OthSch);
2204 cboSchedule.ItemIndex := idx;
2205 end;
2206 end;
2207 UpdateRelated(False);
2208end;
2209
2210procedure TfrmODMeds.cboScheduleChange(Sender: TObject);
2211var
2212 othSch: string;
2213 idx : integer;
2214begin
2215 inherited;
2216 if (FInptDlg) and (cboSchedule.Text = 'OTHER') then
2217 begin
2218 othSch := CreateOtherScheduel;
2219 if length(trim(othSch)) > 1 then
2220 begin
2221 cboSchedule.Items.Add(othSch);
2222 idx := cboSchedule.Items.IndexOf(OthSch);
2223 cboSchedule.ItemIndex := idx;
2224 end;
2225 end;
2226//Remove Deletion of Text, since we are changing the validation to be on exit of the control.
2227{ if (Length(cboSchedule.Text)>0) and (cboSchedule.ItemIndex < 0) and FInptDlg then
2228 cboSchedule.Text := '';}
2229 FScheduleChanged := true;
2230 UpdateRelated;
2231end;
2232
2233
2234{ Duration ----------------------------- }
2235procedure TfrmODMeds.UpdateDurationControls( FreeText: boolean);
2236begin
2237 if FreeText then
2238 begin
2239 pnlXDurationButton.Width := 8;
2240 pnlXDurationButton.Align := alRight;
2241 spnXDuration.Visible := False;
2242 txtXduration.Align := alClient;
2243 end
2244 else
2245 begin
2246 txtXduration.Align := alNone;
2247 txtXduration.Width := pnlXDuration.Width - (pnlXDuration.Width div 2) - spnXDuration.Width + 2;
2248 pnlXDurationButton.Width := pnlXDuration.Width div 2;
2249 pnlXDurationButton.Align := alRight;
2250 spnXDuration.Visible := True;
2251 spnXDuration.AlignButton := udRight;
2252 end;
2253end;
2254
2255procedure TfrmODMeds.popDurationClick(Sender: TObject);
2256var
2257 x: string;
2258begin
2259 inherited;
2260 with TMenuItem(Sender) do
2261 begin
2262 if Tag > 0 then
2263 begin
2264 x := LowerCase(Caption);
2265 //Make sure duration is integer
2266 txtXDuration.Text := IntToStr(StrToIntDef(txtXDuration.Text,0));
2267 UpdateDurationControls(False);
2268 end
2269 else begin
2270 x := '';
2271 txtXDuration.Text := '';
2272 UpdateDurationControls(True);
2273 end;
2274 end;
2275 btnXDuration.Caption := x;
2276 txtXDurationChange(Sender);
2277 ControlChange(Sender);
2278end;
2279
2280{ txtSupply, txtQuantity -------------------------- }
2281
2282procedure TfrmODMeds.txtSupplyChange(Sender: TObject);
2283begin
2284 inherited;
2285 if Changing then Exit;
2286 if not Showing then Exit;
2287 if FNoZERO = False then FNoZERO := True;
2288
2289 // if value = 0, change probably caused by the spin button
2290 if txtSupply.Text <> '0' then txtSupply.Tag := 1;
2291 UpdateRelated;
2292end;
2293
2294procedure TfrmODMeds.txtQuantityChange(Sender: TObject);
2295begin
2296 inherited;
2297 if Changing then Exit;
2298 if not Showing then Exit;
2299 if FNoZERO = False then FNoZERO := True;
2300 // if value = 0, change probably caused by the spin button
2301 if txtQuantity.Text <> '0' then txtQuantity.Tag := 1;
2302 UpdateRelated;
2303end;
2304
2305procedure TfrmODMeds.chkSCEnter(Sender: TObject);
2306begin
2307 inherited;
2308 pnlMessage.TabOrder := chkSC.TabOrder+1;
2309 DispOrderMessage(RatedDisabilities);
2310end;
2311
2312procedure TfrmODMeds.chkSCClick(Sender: TObject);
2313begin
2314 inherited;
2315 chkSC.Tag := 1;
2316end;
2317
2318{ values changing }
2319
2320function TfrmODMeds.OutpatientSig: string;
2321var
2322 Dose, Route, Schedule, Duration, x: string;
2323 i: Integer;
2324begin
2325 case tabDose.TabIndex of
2326 TI_DOSE:
2327 begin
2328 if ValueOf(FLD_TOTALDOSE) = ''
2329 then Dose := ValueOf(FLD_LOCALDOSE)
2330 else Dose := ValueOf(FLD_UNITNOUN);
2331 CheckDecimal(Dose);
2332 Route := ValueOf(FLD_ROUTE_EX);
2333 if (Length(Route) > 0) and (Length(FSigPrep) > 0) then Route := FSigPrep + ' ' + Route;
2334 if Length(Route) = 0 then Route := ValueOf(FLD_ROUTE_NM);
2335 Schedule := ValueOf(FLD_SCHED_EX);
2336 (* Schedule := Piece(Temp,U,1);
2337 if Piece(Temp,U,3) = '1' then Schedule := Schedule + ' AS NEEDED';
2338 if UpperCase(Copy(Schedule, Length(Schedule) - 18, Length(Schedule))) = 'AS NEEDED AS NEEDED'
2339 then Schedule := Copy(Schedule, 1, Length(Schedule) - 10); *)
2340 if Length(Schedule) = 0 then
2341 begin
2342 Schedule := ValueOf(FLD_SCHEDULE);
2343 if RightStr(Schedule,3) = 'PRN' then
2344 begin
2345 Schedule := Copy(Schedule,1,Length(Schedule)-3); //Remove the Trailing PRN
2346 if (RightStr(Schedule,1) = ' ') or (RightStr(Schedule,1) = '-') then
2347 Schedule := Copy(Schedule,1,Length(Schedule)-1);
2348 Schedule := Schedule + ' AS NEEDED'
2349 end;
2350 end;
2351 Result := FSIGVerb + ' ' + Dose + ' ' + Route + ' ' + Schedule;
2352 end;
2353 TI_COMPLEX:
2354 begin
2355 with grdDoses do for i := 1 to Pred(RowCount) do
2356 begin
2357 if Length(ValueOf(FLD_LOCALDOSE, i)) = 0 then Continue;
2358 if FDrugID = '' then
2359 begin
2360 Dose := ValueOf(FLD_DOSETEXT, i);
2361 CheckDecimal(Dose);
2362 end
2363 else
2364 begin
2365 if ValueOf(FLD_TOTALDOSE, i) = ''
2366 then Dose := ValueOf(FLD_LOCALDOSE, i)
2367 else Dose := ValueOf(FLD_UNITNOUN, i);
2368 CheckDecimal(Dose);
2369 end;
2370 Route := ValueOf(FLD_ROUTE_EX, i);
2371 if (Length(Route) > 0) and (Length(FSigPrep) > 0) then Route := FSigPrep + ' ' + Route;
2372 if Length(Route) = 0 then Route := ValueOf(FLD_ROUTE_NM, i);
2373 Schedule := ValueOf(FLD_SCHED_EX, i);
2374 //if Length(Schedule) = 0 then Schedule := ValueOf(FLD_SCHEDULE, i);
2375 if Length(Schedule) = 0 then
2376 begin
2377 Schedule := ValueOf(FLD_SCHEDULE);
2378 if RightStr(Schedule,3) = 'PRN' then
2379 begin
2380 Schedule := Copy(Schedule,1,Length(Schedule)-3); //Remove the Trailing PRN
2381 if (RightStr(Schedule,1) = ' ') or (RightStr(Schedule,1) = '-') then
2382 Schedule := Copy(Schedule,1,Length(Schedule)-1);
2383 Schedule := Schedule + ' AS NEEDED'
2384 end;
2385 end;
2386 Duration := ValueOf(FLD_DURATION, i);
2387 if Length(Duration) > 0 then Duration := 'FOR ' + Duration;
2388 x := FSIGVerb + ' ' + Dose + ' ' + Route + ' ' + Schedule + ' ' + Duration;
2389 if i > 1
2390 then Result := Result + ' ' + ValueOf(FLD_SEQUENCE, i-1) + ' ' + x
2391 else Result := x;
2392 end; {with grdDoses}
2393 end; {TI__COMPLEX}
2394 end; {case}
2395end;
2396
2397function TfrmODMeds.InpatientSig: string;
2398var
2399 Dose, Route, Schedule, Duration, x: string;
2400 i: Integer;
2401begin
2402 case tabDose.TabIndex of
2403 TI_DOSE:
2404 begin
2405 Dose := ValueOf(FLD_LOCALDOSE);
2406 CheckDecimal(Dose);
2407 Route := ValueOf(FLD_ROUTE_AB);
2408 if Route = '' then Route := ValueOf(FLD_ROUTE_NM);
2409 Schedule := ValueOf(FLD_SCHEDULE);
2410 Result := Dose + ' ' + Route + ' ' + Schedule;
2411 end;
2412 TI_COMPLEX:
2413 begin
2414 with grdDoses do for i := 1 to Pred(RowCount) do
2415 begin
2416 if Length(ValueOf(FLD_LOCALDOSE, i)) = 0 then Continue;
2417 if FDrugID = ''
2418 then Dose := ValueOf(FLD_DOSETEXT, i)
2419 else Dose := ValueOf(FLD_LOCALDOSE, i);
2420 CheckDecimal(Dose);
2421 Route := ValueOf(FLD_ROUTE_AB, i);
2422 if Route = '' then Route := ValueOf(FLD_ROUTE_NM, i);
2423 Schedule := ValueOf(FLD_SCHEDULE, i);
2424 Duration := ValueOf(FLD_DURATION, i);
2425 if Length(Duration) > 0 then Duration := 'FOR ' + Duration;
2426 x := Dose + ' ' + Route + ' ' + Schedule + ' ' + Duration;
2427 if i > 1
2428 then Result := Result + ' ' + ValueOf(FLD_SEQUENCE, i-1) + ' ' + x
2429 else Result := x;
2430 end; {with grdDoses}
2431 end; {TI__COMPLEX}
2432 end; {case}
2433end;
2434
2435function TfrmODMeds.ConstructedDoseFields(const ADose: string; PrependName: Boolean = FALSE): string;
2436var
2437 i, DrugIndex: Integer;
2438 UnitsPerDose, Strength: Extended;
2439 Units, Noun, AName: string;
2440begin
2441 DrugIndex := -1;
2442 for i := 0 to Pred(FAllDrugs.Count) do
2443 if AnsiSameText(Piece(FAllDrugs[i], U, 1), FDrugID) then
2444 begin
2445 DrugIndex := i;
2446 Break;
2447 end;
2448 Strength := StrToFloatDef(Piece(FAllDrugs[DrugIndex], U, 2), 0);
2449 Units := Piece(FAllDrugs[DrugIndex], U, 3);
2450 AName := Piece(FAllDrugs[DrugIndex], U, 4);
2451 if FAllDoses.Count > 0
2452 then Noun := Piece(Piece(FAllDoses[0], U, 3), '&', 4)
2453 else Noun := '';
2454 if Strength > 0
2455 then UnitsPerDose := ExtractFloat(ADose) / Strength
2456 else UnitsPerDose := 0;
2457 if (UnitsPerDose > 1) and (Noun <> '') and (CharAt(Noun, Length(Noun)) <> 'S')
2458 then Noun := Noun + 'S';
2459 Result := FloatToStr(ExtractFloat(ADose)) + '&' + Units + '&' + FloatToStr(UnitsPerDose)
2460 + '&' + Noun + '&' + ADose + '&' + FDrugID + '&' + FloatToStr(Strength) + '&'
2461 + Units;
2462 if PrependName then Result := AName + U + FloatToStr(Strength) + Units + U + U +
2463 Result + U + ADose;
2464 Result := UpperCase(Result);
2465end;
2466
2467function TfrmODMeds.FieldsForDrug(const DrugID: string): string;
2468var
2469 i, DrugIndex: Integer;
2470begin
2471 Result := '';
2472 DrugIndex := -1;
2473 for i := 0 to Pred(FAllDrugs.Count) do
2474 begin
2475 if AnsiSameText(Piece(FAllDrugs[i], U, 1), DrugID) then DrugIndex := i;
2476 end;
2477 if DrugIndex > -1 then Result := FAllDrugs[DrugIndex];
2478end;
2479
2480function TfrmODMeds.FieldsForDose(ARow: Integer): string;
2481var
2482 i: Integer;
2483 DoseDrug: string;
2484begin
2485 Result := Piece(Piece(grdDoses.Cells[COL_DOSAGE, ARow], TAB, 2), U, 4);
2486 //AGP CHANGE 26.33 change for Remedy ticket 87476 fix for quick orders for complex
2487 //inpatient orders not displaying the correct unit dose in Pharmacy
2488 //if (not FInptDlg) and (Length(FDrugID) > 0) then
2489 if Length(FDrugID) > 0 then
2490 begin
2491 Result := '';
2492 DoseDrug := Piece(Piece(grdDoses.Cells[COL_DOSAGE, ARow], TAB, 2), U, 5);
2493 if DoseDrug = '' then DoseDrug := Piece(grdDoses.Cells[COL_DOSAGE, ARow], TAB, 1);
2494 DoseDrug := DoseDrug + U + FDrugID;
2495 for i := 0 to Pred(FAllDoses.Count) do
2496 begin
2497 if AnsiSameText(DoseDrug, Copy(FAllDoses[i], 1, Length(DoseDrug))) then
2498 begin
2499 Result := Piece(FAllDoses[i], U, 3);
2500 Break;
2501 end; {if AnsiSameText}
2502 end; {for i}
2503 if Result = '' then Result := ConstructedDoseFields(Piece(DoseDrug, U, 1));
2504 end;
2505end;
2506
2507function TfrmODMeds.FindDoseFields(const Drug, ADose: string): string;
2508var
2509 i: Integer;
2510 x: string;
2511begin
2512 Result := '';
2513 x := ADose + U + Drug + U;
2514 for i := 0 to Pred(FAllDoses.Count) do
2515 begin
2516 if AnsiSameText(x, Copy(FAllDoses[i], 1, Length(x))) then
2517 begin
2518 Result := Piece(FAllDoses[i], U, 3);
2519 Break;
2520 end;
2521 end;
2522end;
2523
2524function TfrmODMeds.FindCommonDrug(DoseList: TStringList): string;
2525// DoseList[n] = DoseText ^ Dispense Drug Pointer
2526var
2527 i, j, UnitIndex: Integer;
2528 DrugStrength, DoseValue, UnitsPerDose: Extended;
2529 DrugOK, PossibleDoses, SplitTab: Boolean;
2530 ADrug, ADose, DoseFields, DoseUnits, DrugUnits: string;
2531 FoundDrugs: TStringList;
2532
2533 procedure SaveDrug(const ADrug: string; UnitsPerDose: Extended);
2534 var
2535 i, DrugIndex: Integer;
2536 CurUnits: Extended;
2537 begin
2538 DrugIndex := -1;
2539 for i := 0 to Pred(FoundDrugs.Count) do
2540 if AnsiSameText(Piece(FoundDrugs[i], U, 1), ADrug) then DrugIndex := i;
2541 if DrugIndex = -1 then FoundDrugs.Add(ADrug + U + FloatToStr(UnitsPerDose)) else
2542 begin
2543 CurUnits := StrToFloatDef(Piece(FoundDrugs[DrugIndex], U, 2), 0);
2544 if UnitsPerDose > CurUnits
2545 then FoundDrugs[DrugIndex] := ADrug + U + FloatToStr(UnitsPerDose);
2546 end;
2547 end;
2548
2549 procedure KillDrug(const ADrug: string);
2550 var
2551 i, DrugIndex: Integer;
2552 begin
2553 DrugIndex := -1;
2554 for i := 0 to Pred(FoundDrugs.Count) do
2555 if AnsiSameText(Piece(FoundDrugs[i], U, 1), ADrug) then DrugIndex := i;
2556 if DrugIndex > -1 then FoundDrugs.Delete(DrugIndex);
2557 end;
2558
2559begin
2560 Result := '';
2561 if FInptDlg then // inpatient dialog
2562 begin
2563 DrugOK := True;
2564 for i := 0 to Pred(DoseList.Count) do
2565 begin
2566 ADrug := Piece(DoseList[i], U, 2);
2567 if ADrug = '' then DrugOK := False;
2568 if Result = '' then Result := ADrug;
2569 if not AnsiSameText(ADrug, Result) then DrugOK := False;
2570 if not DrugOK then Break;
2571 end;
2572 if not DrugOK then Result :='';
2573 end else // outpatient dialog
2574 begin
2575 // check the dose combinations for each dispense drug
2576 FoundDrugs := TStringList.Create;
2577 try
2578 if FAllDoses.Count > 0
2579 then PossibleDoses := Length(Piece(Piece(FAllDoses[0], U, 3), '&', 1)) > 0
2580 else PossibleDoses := False;
2581 for i := 0 to Pred(FAllDrugs.Count) do
2582 begin
2583 ADrug := Piece(FAllDrugs[i], U, 1);
2584 DrugOK := True;
2585 DrugStrength := StrToFloatDef(Piece(FAllDrugs[i], U, 2), 0);
2586 DrugUnits := Piece(FAllDrugs[i], U, 3);
2587 SplitTab := Piece(FAllDrugs[i], U, 5) = '1';
2588 for j := 0 to Pred(DoseList.Count) do
2589 begin
2590 ADose:= Piece(DoseList[j], U, 1);
2591 DoseFields := FindDoseFields(ADrug, ADose); // get the idnode for the dose/drug combination
2592 if not PossibleDoses then
2593 begin
2594 if DoseFields = '' then DrugOK := False else SaveDrug(ADrug, 0);
2595 end else
2596 begin
2597 DoseValue := StrToFloatDef(Piece(DoseFields, '&', 1), 0);
2598 if DoseValue = 0 then DoseValue := ExtractFloat(ADose);
2599 UnitsPerDose := DoseValue / DrugStrength;
2600 if (Frac(UnitsPerDose) = 0) or (SplitTab and (Frac(UnitsPerDose) = 0.5))
2601 then SaveDrug(ADrug, UnitsPerDose)
2602 else DrugOK := False;
2603 // make sure this dose is using the same units as the drug
2604 if DoseFields = '' then
2605 begin
2606 for UnitIndex := 1 to Length(ADose) do
2607 if not (ADose[UnitIndex] in ['0'..'9','.']) then Break;
2608 DoseUnits := Copy(ADose, UnitIndex, Length(ADose));
2609 end
2610 else DoseUnits := Piece(DoseFields, '&', 2);
2611 if not AnsiSameText(DoseUnits, DrugUnits) then DrugOK := False;
2612 end;
2613 if not DrugOK then
2614 begin
2615 KillDrug(ADrug);
2616 Break;
2617 end; {if not DrugOK}
2618 end; {with..for j}
2619 end; {for i}
2620 if FoundDrugs.Count > 0 then
2621 begin
2622 if not PossibleDoses then Result := Piece(FoundDrugs[0], U, 1) else
2623 begin
2624 UnitsPerDose := 99999999;
2625 for i := 0 to Pred(FoundDrugs.Count) do
2626 begin
2627 if StrToFloatDef(Piece(FoundDrugs[i], U, 2), 99999999) < UnitsPerDose then
2628 begin
2629 Result := Piece(FoundDrugs[i], U, 1);
2630 UnitsPerDose := StrToFloatDef(Piece(FoundDrugs[i], U, 2), 99999999);
2631 end; {if StrToFloatDef}
2632 end; {for i..FoundDrugs}
2633 end; {if not..else PossibleDoses}
2634 end; {if FoundDrugs}
2635 finally
2636 FoundDrugs.Free;
2637 end; {try}
2638 end; {if..else FInptDlg}
2639end; {FindCommonDrug}
2640
2641procedure TfrmODMeds.ControlChange(Sender: TObject);
2642var
2643 x,ADose,AUnit,ADosageText: string;
2644 i, LastDose: Integer;
2645 DoseList: TStringList;
2646begin
2647 inherited;
2648 if csLoading in ComponentState then Exit; // to prevent error caused by txtRefills
2649 if Changing then Exit;
2650 if txtMed.Tag = 0 then Exit;
2651 ADose := '';
2652 AUnit := '';
2653 ADosageText := '';
2654 FUpdated := FALSE;
2655 Responses.Clear;
2656 Responses.Update('ORDERABLE', 1, IntToStr(txtMed.Tag), txtMed.Text);
2657 DoseList := TStringList.Create;
2658 case tabDose.TabIndex of
2659 TI_DOSE:
2660 begin
2661 if (cboDosage.ItemIndex < 0) and (Length(cboDosage.Text) > 0) then
2662 begin
2663 // try to resolve freetext dose and add it as a new item to the combobox
2664 ADosageText := cboDosage.Text;
2665 ADose := Piece(ADosageText,' ',1);
2666 Delete(ADosageText,1,Length(ADose)+1);
2667 ADosageText := ADose + Trim(ADosageText);
2668 DoseList.Add(ADosageText);
2669 FDrugID := FindCommonDrug(DoseList);
2670 if FDrugID <> '' then
2671 begin
2672 if ExtractFloat(cboDosage.Text) > 0 then
2673 begin
2674 x := ConstructedDoseFields(cboDosage.Text, TRUE);
2675 FDrugID := '';
2676 with cboDosage do ItemIndex := cboDosage.Items.Add(x);
2677 end;
2678 end;
2679 end;
2680 x := ValueOf(FLD_DOSETEXT); Responses.Update('INSTR', 1, x, x);
2681 x := ValueOf(FLD_DRUG_ID); Responses.Update('DRUG', 1, x, '');
2682 x := ValueOf(FLD_DOSEFLDS); Responses.Update('DOSE', 1, x, '');
2683 x := ValueOf(FLD_STRENGTH);
2684 // if outpt or inpt order with no total dose (i.e., topical)
2685 if (not FInptDlg) or (ValueOf(FLD_TOTALDOSE) = '')
2686 then Responses.Update('STRENGTH', 1, x, x);
2687 // if no strength for dosage, use dispense drug name
2688 if Length(x) = 0 then
2689 begin
2690 x := ValueOf(FLD_DRUG_NM);
2691 if Length(x) > 0 then Responses.Update('NAME', 1, x, x);
2692 end;
2693 x := ValueOf(FLD_ROUTE_AB);
2694 if Length(x) = 0 then x := ValueOf(FLD_ROUTE_NM);
2695 if Length(ValueOf(FLD_ROUTE_ID)) > 0
2696 then Responses.Update('ROUTE', 1, ValueOf(FLD_ROUTE_ID), x)
2697 else Responses.Update('ROUTE', 1, '', x);
2698 x := ValueOf(FLD_SCHEDULE); Responses.Update('SCHEDULE', 1, x, x);
2699 end;
2700 TI_COMPLEX:
2701 begin
2702 //if txtNss.Visible then txtNss.Visible := False;
2703 with grdDoses do for i := 1 to Pred(RowCount) do
2704 begin
2705 x := Piece(Piece(grdDoses.Cells[COL_DOSAGE, i], TAB, 2), U, 5);
2706 if x = '' then x := Piece(grdDoses.Cells[COL_DOSAGE, i], TAB, 1);
2707 if x = '' then Continue;
2708 x := x + U + Piece(Piece(grdDoses.Cells[COL_DOSAGE, i], U, 4), '&', 6);
2709 DoseList.Add(x);
2710 end;
2711 FDrugID := FindCommonDrug(DoseList);
2712 if FDrugID <> '' then // common drug found
2713 begin
2714 x := ValueOf(FLD_STRENGTH, 1);
2715 if (not FInptDlg) or (ValueOf(FLD_TOTALDOSE, 1) = '')
2716 then Responses.Update('STRENGTH', 1, x, x);
2717 // if no strength, use dispense drug
2718 if Length(x) = 0 then
2719 begin
2720 x := ValueOf(FLD_DRUG_NM, 1);
2721 if Length(x) > 0 then Responses.Update('NAME', 1, x, x);
2722 end;
2723 Responses.Update('DRUG', 1, FDrugID, '');
2724 end; {if FDrugID}
2725 LastDose := 0;
2726 with grdDoses do for i := 1 to Pred(RowCount) do
2727 if Length(ValueOf(FLD_DOSETEXT, i)) > 0 then LastDose := i;
2728 with grdDoses do for i := 1 to Pred(RowCount) do
2729 begin
2730 if Length(ValueOf(FLD_DOSETEXT, i)) = 0 then Continue;
2731 x := ValueOf(FLD_DOSETEXT, i); Responses.Update('INSTR', i, x, x);
2732 x := ValueOf(FLD_DOSEFLDS, i); Responses.Update('DOSE', i, x, '');
2733 x := ValueOf(FLD_ROUTE_AB, i);
2734 if Length(x) = 0 then x := ValueOf(FLD_ROUTE_NM, i);
2735 if Length(ValueOf(FLD_ROUTE_ID, i)) > 0
2736 then Responses.Update('ROUTE', i, ValueOf(FLD_ROUTE_ID, i), x)
2737 else Responses.Update('ROUTE', i, '', x);
2738 x := ValueOf(FLD_SCHEDULE, i); Responses.Update('SCHEDULE', i, x, x);
2739 if FSmplPRNChkd then // GE CQ7585 Carry PRN checked from simple to complex tab
2740 begin
2741 pnlXSchedule.Tag := 1;
2742 chkXPRN.Checked := True;
2743 //cboXScheduleClick(Self);// force onclick to fire when complex tab is entered
2744 FSmplPRNChkd := False;
2745 end;
2746 x := ValueOf(FLD_DURATION, i); Responses.Update('DAYS', i, UpperCase(x), x);
2747 x := ValueOf(FLD_SEQUENCE, i);
2748 if Uppercase(x) = 'THEN' then x := 'T'
2749 else if Uppercase(x) = 'AND' then x := 'A'
2750 else if Uppercase(x) = 'EXCEPT' then x := 'X'
2751 else x := '';
2752 if i = LastDose then x := ''; // no conjunction for last dose
2753 Responses.Update('CONJ', i, x, x);
2754 end; {with grdDoses}
2755 end; {TI_COMPLEX}
2756 end; {case TabDose.TabIndex}
2757 DoseList.Free;
2758 Responses.Update('URGENCY', 1, ValueOf(FLD_PRIOR_ID), '');
2759 Responses.Update('COMMENT', 1, TX_WPTYPE, ValueOf(FLD_COMMENT));
2760 if FInptDlg then // inpatient orders
2761 begin
2762 Responses.Update('NOW', 1, ValueOf(FLD_NOW_ID), ValueOf(FLD_NOW_NM));
2763 x := InpatientSig;
2764 Responses.Update('SIG', 1, TX_WPTYPE, x);
2765 end else // outpatient orders
2766 begin
2767 x := ValueOf(FLD_SUPPLY); Responses.Update('SUPPLY', 1, x, x);
2768 x := ValueOf(FLD_QUANTITY); Responses.Update('QTY', 1, x, x);
2769 x := ValueOf(FLD_REFILLS); Responses.Update('REFILLS', 1, x, x);
2770 x := ValueOf(FLD_SC); Responses.Update('SC', 1, x, '');
2771 x := ValueOf(FLD_PICKUP); Responses.Update('PICKUP', 1, x, '');
2772 x := ValueOf(FLD_PTINSTR); Responses.Update('PI', 1, TX_WPTYPE, x);
2773 x := '';
2774 x := OutpatientSig; Responses.Update('SIG', 1, TX_WPTYPE, x);
2775 end;
2776 memOrder.Text := Responses.OrderText;
2777end;
2778
2779{ complex dose ------------------------------------------------------------------------------ }
2780
2781{ General Functions - get & set cell values}
2782
2783function TfrmODMeds.ValFor(FieldID, ARow: Integer): string;
2784{ Contents of grid cells (Only the first tab piece for each cell is drawn)
2785 Dosage <TAB> DosageFields
2786 RouteText <TAB> IEN^RouteName^Abbreviation
2787 Schedule <TAB> (nothing)
2788 Duration <TAB> Duration^Units }
2789begin
2790 Result := '';
2791 if (ARow < 1) or (ARow >= grdDoses.RowCount) then Exit;
2792 with grdDoses do
2793 case FieldID of
2794 COL_DOSAGE : Result := Piece(Cells[COL_DOSAGE, ARow], TAB, 1);
2795 COL_ROUTE : Result := Piece(Cells[COL_ROUTE, ARow], TAB, 1);
2796 COL_SCHEDULE : Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
2797 COL_DURATION : Result := Piece(Cells[COL_DURATION, ARow], TAB, 1);
2798 COL_SEQUENCE : Result := Piece(Cells[COL_SEQUENCE, ARow], TAB, 1);
2799 VAL_DOSAGE : Result := Piece(Cells[COL_DOSAGE, ARow], TAB, 2);
2800 VAL_ROUTE : Result := Piece(Cells[COL_ROUTE, ARow], TAB, 2);
2801 VAL_SCHEDULE : Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
2802 VAL_DURATION : Result := Piece(Cells[COL_DURATION, ARow], TAB, 1);
2803 VAL_SEQUENCE : Result := Piece(Cells[COL_SEQUENCE, ARow], TAB, 1);
2804 VAL_CHKXPRN : Result := Cells[COL_CHKXPRN, ARow];
2805 end;
2806end;
2807
2808procedure FindInCombo(const x: string; AComboBox: TORComboBox);
2809begin
2810 AComboBox.SetTextAutoComplete(x);
2811end;
2812
2813(*
2814procedure TfrmODMeds.DurationToDays;
2815var
2816 i, DoseHours, TotalHours: Integer;
2817 AllRows: Boolean;
2818 Days: Extended;
2819 x: string;
2820begin
2821 Exit; // don't try to figure out days supply from duration for now
2822 if txtSupply.Tag = 1 then Exit;
2823 AllRows := True;
2824 with grdDoses do for i := 1 to Pred(RowCount) do
2825 if (Length(ValFor(COL_DOSAGE, i)) > 0) and (Length(ValFor(VAL_DURATION, i)) = 0)
2826 then AllRows := False;
2827 if not AllRows then Exit;
2828 Changing := True;
2829 TotalHours := 0;
2830 with grdDoses do for i := 1 to Pred(RowCount) do
2831 if Length(ValFor(COL_DOSAGE, i)) > 0 then
2832 begin
2833 x := ValFor(VAL_DURATION, i);
2834 if Piece(x, U, 2) = 'D'
2835 then DoseHours := ExtractInteger(x) * 24
2836 else DoseHours := ExtractInteger(x);
2837 TotalHours := TotalHours + DoseHours;
2838 end;
2839 Days := TotalHours / 24;
2840 if Days > Int(Days) then Days := Days + 1;
2841 txtSupply.Text := IntToStr(Trunc(Days));
2842 //timDayQty.Tag := TIMER_FROM_DAYS;
2843 //timDayQtyTimer(Self);
2844 Changing := False;
2845end;
2846*)
2847
2848function TfrmODMeds.DurationToDays: Integer;
2849var
2850 i, DoseMinutes, TotalMinutes: Integer;
2851 AllRows: Boolean;
2852 Days: Extended;
2853 x: string;
2854begin
2855 Result := 0;
2856 // make sure a duration exists for all rows with a dose
2857 AllRows := True;
2858 with grdDoses do for i := 1 to Pred(RowCount) do
2859 if (Length(ValFor(COL_DOSAGE, i)) > 0) and (Length(ValFor(VAL_DURATION, i)) = 0)
2860 then AllRows := False;
2861 if not AllRows then Exit;
2862
2863 TotalMinutes := 0;
2864 with grdDoses do for i := 1 to Pred(RowCount) do
2865 if Length(ValFor(COL_DOSAGE, i)) > 0 then
2866 begin
2867 x := ValFor(VAL_DURATION, i);
2868 DoseMinutes := 0;
2869 if Piece(x, ' ', 2) = 'MONTHS' then DoseMinutes := ExtractInteger(x) * 43200;
2870 if Piece(x, ' ', 2) = 'WEEKS' then DoseMinutes := ExtractInteger(x) * 10080;
2871 if Piece(x, ' ', 2) = 'DAYS' then DoseMinutes := ExtractInteger(x) * 1440;
2872 if Piece(x, ' ', 2) = 'HOURS' then DoseMinutes := ExtractInteger(x) * 60;
2873 if Piece(x, ' ', 2) = 'MINUTES' then DoseMinutes := ExtractInteger(x);
2874 TotalMinutes := TotalMinutes + DoseMinutes;
2875 end;
2876 Days := TotalMinutes / 1440;
2877 if Days > Int(Days) then Days := Days + 1;
2878 Result := Trunc(Days);
2879end;
2880
2881procedure TfrmODMeds.pnlFieldsResize(Sender: TObject);
2882const
2883 REL_DOSAGE = 0.38;
2884 REL_ROUTE = 0.17;
2885 REL_SCHEDULE = 0.19;
2886 REL_DURATION = 0.16;
2887 REL_ANDTHEN = 0.10;
2888var
2889 i, ht, RowCountShowing: Integer;
2890 ColControl: TWinControl;
2891begin
2892 inherited;
2893 with grdDoses do
2894 begin
2895 i := grdDoses.Width - 12; // 12 = 4 pixel margin + 8 pixel column 0
2896 i := i - GetSystemMetrics(SM_CXVSCROLL); // compensate for appearance of scroll bar
2897 ColWidths[1] := Round(REL_DOSAGE * i); // dosage
2898 ColWidths[2] := Round(REL_ROUTE * i); // route
2899 ColWidths[3] := Round(REL_SCHEDULE * i); // schedule
2900 ColWidths[4] := Round(REL_DURATION * i); // duration
2901 ColWidths[5] := Round(REL_ANDTHEN * i); // and/then
2902 // adjust height of grid to not show partial rows
2903 ht := pnlBottom.Top - Top - 6;
2904
2905 ht := ht div (DefaultRowHeight+1);
2906 ht := ht * (DefaultRowHeight+1);
2907 Inc(ht, 3);
2908 Height := ht;
2909 // Move a column control if it is showing
2910 ColControl := nil;
2911 case grdDoses.Col of
2912 COL_DOSAGE:ColControl := cboXDosage;
2913 COL_ROUTE:ColControl := cboXRoute;
2914 COL_SCHEDULE:ColControl := pnlXSchedule;
2915 COL_DURATION:ColControl := pnlXDuration;
2916 COL_SEQUENCE:ColControl := pnlXSequence;
2917 end; {case}
2918
2919 if assigned(ColControl) and ColControl.Showing then
2920 begin
2921 RowCountShowing := (Height - 25) div (DefaultRowHeight+1);
2922 if (grdDoses.Row <= RowCountShowing) then
2923 ShowEditor(grdDoses.col, grdDoses.row, #0)
2924 else
2925 ColControl.Hide;
2926 end;
2927
2928 end;
2929end;
2930
2931procedure TfrmODMeds.grdDosesMouseDown(Sender: TObject; Button: TMouseButton;
2932 Shift: TShiftState; X, Y: Integer);
2933var
2934 ACol, ARow: Integer;
2935begin
2936 inherited;
2937 grdDoses.MouseToCell(X, Y, ACol, ARow);
2938 if (ARow < 0) or (ACol < 0) then Exit;
2939 if ACol > COL_SELECT then ShowEditor(ACol, ARow, #0) else
2940 begin
2941 grdDoses.Col := COL_DOSAGE;
2942 grdDoses.Row := ARow;
2943 end;
2944 if grdDoses.Col <> COL_DOSAGE then
2945 DropLastSequence;
2946end;
2947
2948procedure TfrmODMeds.grdDosesKeyPress(Sender: TObject; var Key: Char);
2949begin
2950 inherited;
2951 if Key in [#32..#127] then ShowEditor(grdDoses.Col, grdDoses.Row, Key);
2952 if grdDoses.Col <> COL_DOSAGE then
2953 DropLastSequence;
2954end;
2955
2956procedure TfrmODMeds.grdDosesMouseUp(Sender: TObject; Button: TMouseButton;
2957 Shift: TShiftState; X, Y: Integer);
2958begin
2959 inherited;
2960 case FDropColumn of
2961 COL_DOSAGE: with cboXDosage do if Items.Count > 0 then DroppedDown := True;
2962 COL_ROUTE: with cboXRoute do if Items.Count > 0 then DroppedDown := True;
2963 COL_SCHEDULE: with cboXSchedule do if Items.Count > 0 then DroppedDown := True;
2964 end;
2965 FDropColumn := -1;
2966end;
2967
2968procedure TfrmODMeds.grdDosesDrawCell(Sender: TObject; ACol, ARow: Integer;
2969 Rect: TRect; State: TGridDrawState);
2970begin
2971 inherited;
2972 grdDoses.Canvas.TextRect(Rect, Rect.Left+2, Rect.Top+2,
2973 Piece(grdDoses.Cells[ACol, ARow], TAB, 1));
2974end;
2975
2976procedure TfrmODMeds.grdDosesExit(Sender: TObject);
2977begin
2978 inherited;
2979 UpdateRelated(FALSE);
2980 RestoreDefaultButton;
2981 RestoreCancelButton;
2982end;
2983
2984procedure TfrmODMeds.ShowEditor(ACol, ARow: Integer; AChar: Char);
2985var
2986 x,tmpText: string;
2987
2988 procedure PlaceControl(AControl: TWinControl);
2989 var
2990 ARect: TRect;
2991 begin
2992 with AControl do
2993 begin
2994 ARect := grdDoses.CellRect(ACol, ARow);
2995 SetBounds(ARect.Left + grdDoses.Left + 1, ARect.Top + grdDoses.Top + 1,
2996 ARect.Right - ARect.Left + 1, ARect.Bottom - ARect.Top + 1);
2997 Tag := ARow;
2998 BringToFront;
2999 Show;
3000 SetFocus;
3001 end;
3002 end;
3003
3004 procedure SynchCombo(ACombo: TORComboBox; const ItemText, EditText: string);
3005 var
3006 i: Integer;
3007 begin
3008 ACombo.ItemIndex := -1;
3009 for i := 0 to Pred(ACombo.Items.Count) do
3010 if ACombo.Items[i] = ItemText then ACombo.ItemIndex := i;
3011 if ACombo.ItemIndex < 0 then ACombo.Text := EditText;
3012 end;
3013
3014begin
3015 inherited;
3016 txtNSS.Visible := False;
3017 //Make space just select editor. This blows up as soon as some joker makes a
3018 //dosage starting with a space.
3019 if AChar = ' ' then
3020 AChar := #0;
3021 if ARow = 0 then Exit; // header row
3022 // require initial instruction entry when in last row
3023 with grdDoses do if {(ARow = Pred(RowCount)) and} (ACol > COL_DOSAGE) and
3024 (ValFor(COL_DOSAGE, ARow) = '') then Exit;
3025 // require that initial instructions for rows get entered from top to bottom
3026 //(this does not include behaivor of row insertion button.)
3027 if (ACol = COL_DOSAGE) and (ARow > 1) and (ValFor(COL_DOSAGE, ARow-1) = '') then
3028 Exit;
3029 // display appropriate editor for row & column
3030 case ACol of
3031 COL_DOSAGE: begin
3032 // default route & schedule to previous row
3033 if (ARow > 1) then
3034 begin
3035 if (grdDoses.Cells[COL_ROUTE, ARow] = '') and
3036 (grdDoses.Cells[COL_SCHEDULE, ARow] = '') then
3037 begin
3038 grdDoses.Cells[COL_ROUTE, ARow] := grdDoses.Cells[COL_ROUTE, Pred(ARow)];
3039 { don't default schedule - recommended by Martin Lowe }
3040 //grdDoses.Cells[COL_SCHEDULE, ARow] := grdDoses.Cells[COL_SCHEDULE, Pred(ARow)];
3041 end;
3042 //AGP Change 26.45 remove auto-populate of the sequence field
3043 {* if grdDoses.Cells[COL_SEQUENCE, Pred(ARow)] = '' then
3044 begin
3045 if StrToIntDef(Piece(grdDoses.Cells[COL_DURATION, Pred(ARow)], ' ', 1), 0) > 0
3046 then grdDoses.Cells[COL_SEQUENCE, Pred(ARow)] := 'THEN'
3047 else grdDoses.Cells[COL_SEQUENCE, Pred(ARow)] := 'AND';
3048 end; *}
3049 end;
3050 // set appropriate value for cboDosage
3051 SynchCombo(cboXDosage, ValFor(VAL_DOSAGE, ARow), ValFor(COL_DOSAGE, ARow));
3052 PlaceControl(cboXDosage);
3053 FDropColumn := COL_DOSAGE;
3054 if AChar <> #0 then PostMessage(Handle, UM_DELAYEVENT, Ord(AChar), COL_DOSAGE);
3055 end;
3056 COL_ROUTE: begin
3057 // set appropriate value for cboRoute
3058 SynchCombo(cboXRoute, ValFor(VAL_ROUTE, ARow), ValFor(COL_ROUTE, ARow));
3059 PlaceControl(cboXRoute);
3060 FDropColumn := COL_ROUTE;
3061 if AChar <> #0 then PostMessage(Handle, UM_DELAYEVENT, Ord(AChar), COL_ROUTE);
3062 end;
3063 COL_SCHEDULE: begin
3064 // set appropriate value for cboSchedule
3065 if FInptDlg then txtNSS.Visible := True;
3066 x := Piece(grdDoses.Cells[COL_SCHEDULE, ARow], TAB, 1);
3067 Changing := TRUE;
3068 if ValFor(VAL_CHKXPRN,Arow)='1' then chkXPRN.Checked := true
3069 else chkXPRN.Checked := False;
3070 if Pos('PRN',x)>0 then
3071 begin
3072 cboXSchedule.SelectByID(x);
3073 if cboXSchedule.ItemIndex <0 then
3074 begin
3075 x := Trim(Copy(x, 1, Pos('PRN', x) - 1));
3076 chkXPRN.Checked := true;
3077 end;
3078 end;
3079 if Length(x) > 0 then
3080 begin
3081 cboXSchedule.SelectByID(x);
3082 cboXSchedule.Text := x;
3083 end
3084 else cboXSchedule.ItemIndex := -1;
3085 (* if Pos('PRN', x) > 0 then
3086 begin
3087 NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1));
3088 cboXSchedule.SelectByID(NonPRNPart);
3089 if cboXSchedule.ItemIndex > -1 then chkXPRN.Checked := True else
3090 begin
3091 chkXPRN.Checked := False;
3092 cboXSchedule.SelectByID(x);
3093 if cboXSchedule.ItemIndex < 0 then cboXSchedule.Text := x;
3094 end;
3095 end; *)
3096 Changing := FALSE;
3097 pnlXSequence.Tag := ARow;
3098 PlaceControl(pnlXSchedule);
3099 //cboXSchedule.SetFocus;
3100 FDropColumn := COL_SCHEDULE;
3101 if AChar <> #0 then PostMessage(Handle, UM_DELAYEVENT, Ord(AChar), COL_SCHEDULE);
3102 end;
3103 COL_DURATION: begin
3104 // set appropriate value for pnlDuration
3105 x := ValFor(VAL_DURATION, ARow);
3106 Changing := TRUE;
3107 txtXDuration.Text := Piece(x, ' ', 1);
3108 x := Piece(x, ' ', 2);
3109 if Length(x) > 0 then btnXDuration.Caption := LowerCase(x)
3110 else begin
3111 txtXDuration.Text := '0';
3112// btnXDuration.Caption := 'days'; <-- original line. //kt 8/8/2007
3113 btnXDuration.Caption := DKLangConstW('fODMeds_days'); //kt added 8/8/2007
3114 end;
3115 tmpText := txtXDuration.Text; //Fix for CQ: 8107 - Kloogy but works.
3116 UpdateDurationControls(False);
3117 Changing := FALSE;
3118 pnlXDuration.Tag := ARow;
3119 PlaceControl(pnlXDuration);
3120 txtXDuration.SetFocus;
3121 ARow1 := ARow;
3122 txtXDuration.Text := tmpText; //Fix for CQ: 8107 - Kloogy but works.
3123 if AChar <> #0 then PostMessage(Handle, UM_DELAYEVENT, Ord(AChar), COL_DURATION);
3124 end;
3125 COL_SEQUENCE: begin
3126 x := ValFor(COL_SEQUENCE, ARow);
3127 //if x = '' then x := 'and'; AGP Change 26.46 remove for CQ 9535
3128 btnXSequence.Caption := x;
3129 pnlXSequence.Caption := btnXSequence.Caption;
3130 pnlXSequence.Tag := ARow;
3131 ARow1 := ARow;
3132 PlaceControl(pnlXSequence);
3133 btnXSequence.Width := pnlXSequence.Width;
3134 end;
3135 end; {case ACol}
3136end;
3137
3138procedure TfrmODMeds.UMDelayEvent(var Message: TMessage);
3139{ after focusing events are completed for a combobox, set the key the user typed }
3140begin
3141 case Message.LParam of
3142 COL_DOSAGE : FindInCombo(Chr(Message.WParam), cboXDosage);
3143 COL_ROUTE : FindInCombo(Chr(Message.WParam), cboXRoute);
3144 COL_SCHEDULE : FindInCombo(Chr(Message.WParam), cboXSchedule);
3145 COL_DURATION : begin
3146 txtXDuration.Text := Chr(Message.WParam);
3147 txtXDuration.SelStart := 1;
3148 end;
3149 end;
3150end;
3151
3152procedure TfrmODMeds.cboXDosageEnter(Sender: TObject);
3153begin
3154 inherited;
3155 // if this was the last row, create a new last row
3156 if grdDoses.Row = Pred(grdDoses.RowCount) then grdDoses.RowCount := grdDoses.RowCount + 1;
3157 DisableDefaultButton(self);
3158 DisableCancelButton(self);
3159end;
3160
3161procedure TfrmODMeds.cboXDosageChange(Sender: TObject);
3162begin
3163 inherited;
3164 if not Changing and (cboXDosage.ItemIndex < 0) then
3165 begin
3166 grdDoses.Cells[COL_DOSAGE, cboXDosage.Tag] := cboXDosage.Text;
3167 UpdateRelated;
3168 end;
3169end;
3170
3171procedure TfrmODMeds.cboXDosageClick(Sender: TObject);
3172var
3173 DispDrug: Integer;
3174 x: string;
3175begin
3176 SetupVars; //kt added 8/8/2007 to replace constants with vars.
3177 inherited;
3178 if FSuppressMsg then
3179 begin
3180 if PnlMessage.Visible = true then
3181 begin
3182 memMessage.SendToBack;
3183 PnlMessage.Visible := False;
3184 end;
3185 end;
3186
3187 with cboXDosage do if ItemIndex > -1 then x := Text + TAB + Items[ItemIndex] else x := Text;
3188 grdDoses.Cells[COL_DOSAGE, cboXDosage.Tag] := x;
3189 UpdateRelated(FALSE);
3190 DispDrug := StrToIntDef(ValueOf(FLD_DRUG_ID, cboXDosage.Tag), 0);
3191 if DispDrug > 0 then
3192 begin
3193 if not FSuppressMsg then
3194 begin
3195 DispOrderMessage(DispenseMessage(DispDrug));
3196 FSuppressMsg := False;
3197 end;
3198 x := QuantityMessage(DispDrug);
3199 end
3200 else x := '';
3201 if Length(x) > 0
3202 then lblQtyMsg.Caption := TX_QTY_PRE + x + TX_QTY_POST
3203 else lblQtyMsg.Caption := '';
3204end;
3205
3206procedure TfrmODMeds.cboXDosageExit(Sender: TObject);
3207begin
3208 inherited;
3209 cboXDosageClick(Self);
3210 cboXDosage.Tag := -1;
3211 cboXDosage.Hide;
3212 UpdateRelated;
3213 RestoreDefaultButton;
3214 RestoreCancelButton;
3215 if (pnlMessage.Visible) and (memMessage.TabStop) then
3216 begin
3217 pnlMessage.Parent := grdDoses.Parent;
3218 pnlMessage.TabOrder := grdDoses.TabOrder;
3219 ActiveControl := memMessage;
3220 end
3221 else if grdDoses.Showing then
3222 ActiveControl := grdDoses
3223 else
3224 ActiveControl := cboDosage;
3225end;
3226
3227procedure TfrmODMeds.cboXRouteChange(Sender: TObject);
3228begin
3229 inherited;
3230 //Commented out to fix CQ: 7280
3231// if cboXRoute.Text = '' then cboXRoute.ItemIndex := -1;
3232 if not Changing and (cboXRoute.ItemIndex < 0) then
3233 begin
3234 grdDoses.Cells[COL_ROUTE, cboXRoute.Tag] := cboXRoute.Text;
3235 ControlChange(Self);
3236 end;
3237end;
3238
3239procedure TfrmODMeds.cboXRouteClick(Sender: TObject);
3240var
3241 x: string;
3242begin
3243 inherited;
3244 with cboXRoute do if ItemIndex > -1 then x := Text + TAB + Items[ItemIndex] else x := Text;
3245 grdDoses.Cells[COL_ROUTE, cboXRoute.Tag] := x;
3246 ControlChange(Self);
3247end;
3248
3249procedure TfrmODMeds.cboXRouteExit(Sender: TObject);
3250begin
3251 inherited;
3252 //Removed based on Site feeback. See CQ: 7518
3253{ if Not ValidateRoute(cboXRoute) then
3254 Exit; }
3255 if Trim(cboXRoute.Text) = '' then
3256 begin
3257 cboXRoute.ItemIndex := -1;
3258 Exit;
3259 end;
3260 cboXRouteClick(Self);
3261 cboXRoute.Tag := -1;
3262 cboXRoute.Hide;
3263 RestoreDefaultButton;
3264 RestoreCancelButton;
3265 if (pnlMessage.Visible) and (memMessage.TabStop) then
3266 begin
3267 pnlMessage.Parent := grdDoses.Parent;
3268 pnlMessage.TabOrder := grdDoses.TabOrder;
3269 ActiveControl := memMessage;
3270 end
3271 else if grdDoses.Showing then
3272 ActiveControl := grdDoses
3273 else
3274 ActiveControl := cboDosage;
3275end;
3276
3277procedure TfrmODMeds.pnlXScheduleEnter(Sender: TObject);
3278begin
3279 inherited;
3280 cboXSchedule.SetFocus;
3281 DisableDefaultButton(self);
3282 DisableCancelButton(self);
3283end;
3284
3285procedure TfrmODMeds.cboXScheduleChange(Sender: TObject);
3286var
3287 othSch, x: string;
3288 idx : integer;
3289begin
3290 inherited;
3291 //Commented out to fix CQ: 7280
3292// if cboXSchedule.Text = '' then cboXSchedule.ItemIndex := -1;
3293 if not Changing {and (cboXSchedule.ItemIndex < 0)} then
3294 begin
3295 if (FInptDlg) and (cboXSchedule.Text = 'OTHER') then
3296 begin
3297 othSch := CreateOtherScheduelComplex;
3298 if length(trim(othSch)) > 1 then
3299 begin
3300 cboXSchedule.Items.Add(othSch);
3301 idx := cboXSchedule.Items.IndexOf(OthSch);
3302 cboXSchedule.ItemIndex := idx;
3303 end;
3304 end;
3305 (* if chkXPRN.Checked then PRN := ' PRN' else PRN := '';
3306 with cboXSchedule do if ItemIndex > -1
3307 then x := Text + PRN + TAB + Items[ItemIndex]
3308 else x := Text + PRN; *)
3309 with cboXSchedule do if ItemIndex > -1
3310 then x := Text + TAB + Items[ItemIndex]
3311 else x := Text;
3312 grdDoses.Cells[COL_SCHEDULE, pnlXSchedule.Tag] := x;
3313 self.cboSchedule.Text := x;
3314 UpdateRelated;
3315 end;
3316end;
3317
3318procedure TfrmODMeds.cboXScheduleClick(Sender: TObject);
3319var
3320 x: string;
3321begin
3322 inherited;
3323 //if chkXPRN.Checked then PRN := ' PRN' else PRN := '';
3324 (* with cboXSchedule do if ItemIndex > -1
3325 then x := Text + PRN + TAB + Items[ItemIndex]
3326 else x := Text + PRN; *)
3327 with cboXSchedule do if ItemIndex > -1
3328 then x := Text + TAB + Items[ItemIndex]
3329 else x := Text;
3330 (* if (Pos('PRN',X)>0) and (pnlXSchedule.Tag = 1) then
3331 if lblAdmintime.visible then
3332 lblAdmintime.Caption := ''; *)
3333 grdDoses.Cells[COL_SCHEDULE, pnlXSchedule.Tag] := x;
3334 UpdateStartExpires(x);
3335 UpdateRelated;
3336end;
3337
3338procedure TfrmODMeds.chkXPRNClick(Sender: TObject);
3339var
3340check: string;
3341begin
3342 inherited;
3343 if self.chkXPRN.Checked = True then check := '1'
3344 else check := '0';
3345 self.grdDoses.Cells[COL_CHKXPRN, self.grdDoses.Row] := check;
3346 if not Changing then cboXScheduleClick(Self);
3347end;
3348
3349procedure TfrmODMeds.pnlXScheduleExit(Sender: TObject);
3350begin
3351 inherited;
3352 if Not FShowPnlXScheduleOk then //Added for CQ: 7370
3353 Exit;
3354 cboXScheduleClick(Self);
3355 pnlXSchedule.Tag := -1;
3356 pnlXSchedule.Hide;
3357 UpdateRelated;
3358 RestoreDefaultButton;
3359 RestoreCancelButton;
3360 if (pnlMessage.Visible) and (memMessage.TabStop) then
3361 begin
3362 pnlMessage.Parent := grdDoses.Parent;
3363 pnlMessage.TabOrder := grdDoses.TabOrder;
3364 ActiveControl := memMessage;
3365 end
3366 else if grdDoses.Showing then
3367 ActiveControl := grdDoses
3368 else
3369 ActiveControl := cboDosage;
3370end;
3371
3372procedure TfrmODMeds.pnlXDurationEnter(Sender: TObject);
3373begin
3374 inherited;
3375 txtXDuration.SetFocus;
3376 DisableDefaultButton(self);
3377 DisableCancelButton(self);
3378end;
3379
3380procedure TfrmODMeds.txtXDurationChange(Sender: TObject);
3381var
3382 I, Code: Integer;
3383 OrgValue: string;
3384begin
3385 inherited;
3386 if Changing then Exit;
3387 if (txtXDuration.Text <> '0') and (txtXDuration.Text <> '') then
3388 begin
3389 Val(txtXDuration.Text, I, Code);
3390 UpdateDurationControls(Code <> 0);
3391 //Commented out the "and" to resolve CQ: 7557
3392 if (Code <> 0) {and (I=0)} then
3393 begin
3394// ShowMessage('Please use numeric characters only.'); <-- original line. //kt 8/8/2007
3395 ShowMessage(DKLangConstW('fODMeds_Please_use_numeric_characters_onlyx')); //kt added 8/8/2007
3396 with txtXDuration do
3397 begin
3398 Text := IntToStr(I);
3399 SelStart := Length(Text);
3400 end;
3401 Exit;
3402 btnXDuration.Width := 8;
3403 btnXDuration.Align := alRight;
3404 spnXDuration.Visible := False;
3405 txtXduration.Align := alClient;
3406 PopDuration.Items.Tag := 0;
3407 btnXDuration.Caption := '';
3408 end;
3409 {AGP change 26.19 for PSI-05-018 cq #7322
3410 else if PopDuration.Items.Tag = 0 then
3411 begin
3412 PopDuration.Items.Tag := 3; //Days selection
3413// btnXDuration.Caption := 'days'; <-- original line. //kt 8/8/2007
3414 btnXDuration.Caption := DKLangConstW('fODMeds_days'); //kt added 8/8/2007
3415 end; }
3416 grdDoses.Cells[COL_DURATION, pnlXDuration.Tag] := txtXDuration.Text + ' ' + Uppercase(btnXDuration.Caption);
3417 end else //AGP CHANGE ORDER
3418 begin
3419 if not(FInptDlg) then grdDoses.Cells[COL_DURATION, pnlXDuration.Tag] := '';
3420 OrgValue := ValFor(COL_DURATION, pnlxDuration.tag);
3421 //if ((txtXDuration.Text = '0') or (txtXDuration.Text = '')) and ((ValFor(COL_SEQUENCE, ARow1) = 'THEN') and (FInptDlg)) then //AGP CHANGE ORDER
3422 //AGP change 26.33 Then/And conjunction requiring a duration to include outpatient orders also
3423 if ((txtXDuration.Text = '0') or (txtXDuration.Text = '')) and (ValFor(COL_SEQUENCE, ARow1) = 'THEN') then //AGP CHANGE ORDER
3424 begin
3425// if (InfoBox('A duration is required when using "Then" as a sequence.'+CRLF+'"Then" will be remove from the sequence field if you continue'+ <-- original line. //kt 8/8/2007
3426 if (InfoBox(DKLangConstW('fODMeds_A_duration_is_required_when_using_xThenx_as_a_sequencex')+CRLF+DKLangConstW('fODMeds_xThenx_will_be_remove_from_the_sequence_field_if_you_continue')+ //kt added 8/8/2007
3427// CRLF+'Click "OK" to continue or click "Cancel"','Duration Warning', MB_OKCANCEL)=1) then <-- original line. //kt 8/8/2007
3428 CRLF+DKLangConstW('fODMeds_Click_xOKx_to_continue_or_click_xCancelx'),DKLangConstW('fODMeds_Duration_Warning'), MB_OKCANCEL)=1) then //kt added 8/8/2007
3429 begin
3430 grdDoses.Cells[COL_DURATION, pnlXDuration.Tag] := '';
3431 pnlXSequence.Tag := ARow1;
3432 pnlXSequence.Caption := '';
3433 grdDoses.Cells[COL_SEQUENCE, pnlXSequence.Tag] := '';
3434 btnXSequence.Click;
3435 end
3436 else
3437 grdDoses.Cells[COL_DURATION, pnlXDuration.Tag] := OrgValue;
3438 end
3439 else grdDoses.Cells[COL_DURATION, pnlXDuration.Tag] := txtXDuration.Text;
3440 end;
3441 // end;
3442 ControlChange(Self);
3443 UpdateRelated;
3444end;
3445
3446procedure TfrmODMeds.pnlXDurationExit(Sender: TObject);
3447begin
3448 inherited;
3449 pnlXDuration.Tag := -1;
3450 pnlXDuration.Hide;
3451 UpdateRelated;
3452 RestoreDefaultButton;
3453 RestoreCancelButton;
3454 if (pnlMessage.Visible) and (memMessage.TabStop) then
3455 begin
3456 pnlMessage.Parent := grdDoses.Parent;
3457 pnlMessage.TabOrder := grdDoses.TabOrder;
3458 ActiveControl := memMessage;
3459 end
3460 else if grdDoses.Showing then
3461 ActiveControl := grdDoses
3462 else
3463 ActiveControl := cboDosage;
3464end;
3465
3466procedure TfrmODMeds.btnXSequenceClick(Sender: TObject);
3467var
3468 APoint: TPoint;
3469begin
3470 inherited;
3471 inherited;
3472 with TSpeedButton(Sender) do APoint := ClientToScreen(Point(0, Height));
3473 popXSequence.Popup(APoint.X, APoint.Y);
3474 pnlXSequence.Caption := btnXSequence.Caption;
3475 {
3476 with TSpeedButton(Sender) do APoint := ClientToScreen(Point(0, Height));
3477 popXSequence.Popup(APoint.X, APoint.Y);
3478 pnlXSequence.Caption := btnXSequence.Caption;
3479//if (pnlXSequence.Caption = 'then') and <-- original line. //kt 8/8/2007
3480 if (pnlXSequence.Caption = DKLangConstW('fODMeds_then')) and //kt added 8/8/2007
3481 ((ValFor(COL_DURATION, ARow1) = '') or
3482 (ValFor(COL_DURATION, ARow1) = '0')) then
3483 begin
3484// InfoBox('A duration is required when using "Then" as a conjunction','Duration Warning',MB_OK); <-- original line. //kt 8/8/2007
3485 InfoBox(DKLangConstW('fODMeds_A_duration_is_required_when_using_xThenx_as_a_conjunction'),DKLangConstW('fODMeds_Duration_Warning'),MB_OK); //kt added 8/8/2007
3486 pnlXSequence.Caption := '';
3487 btnXSequence.Caption := '';
3488 end;
3489 }
3490end;
3491
3492procedure TfrmODMeds.popXSequenceClick(Sender: TObject);
3493var
3494 x: string;
3495begin
3496 inherited;
3497 with TMenuItem(Sender) do if Tag > 0 then x := Caption else x := '';
3498 //AGP Changes 26.12 PSI-04-63
3499 //if ((x = 'then') and (FInptDlg)) and ((ValFor(COL_DURATION, ARow1) = '') or (ValFor(COL_DURATION, ARow1) = '0')) then
3500 //AGP change 26.32 Then/And conjunction requiring a duration to include outpatient orders
3501//if (x = 'then') and ((ValFor(COL_DURATION, ARow1) = '') or (ValFor(COL_DURATION, ARow1) = '0')) then <-- original line. //kt 8/8/2007
3502 if (x = DKLangConstW('fODMeds_then')) and ((ValFor(COL_DURATION, ARow1) = '') or (ValFor(COL_DURATION, ARow1) = '0')) then //kt added 8/8/2007
3503 begin
3504// InfoBox('A duration is required when using "Then" as a conjunction' + CRLF + CRLF+ <-- original line. //kt 8/8/2007
3505 InfoBox(DKLangConstW('fODMeds_A_duration_is_required_when_using_xThenx_as_a_conjunction') + CRLF + CRLF+ //kt added 8/8/2007
3506// 'The patient will be instructed to take these doses consecutively, not concurrently.','Duration Warning',MB_OK); <-- original line. //kt 8/8/2007
3507 DKLangConstW('fODMeds_The_patient_will_be_instructed_to_take_these_doses_consecutivelyx_not_concurrentlyx'),DKLangConstW('fODMeds_Duration_Warning'),MB_OK); //kt added 8/8/2007
3508 x := '';
3509 end;
3510 btnXSequence.Caption := x;
3511 pnlXSequence.Caption := btnXSequence.Caption;
3512 grdDoses.Cells[COL_SEQUENCE, pnlXSequence.Tag] := Uppercase(x);
3513 ControlChange(Sender);
3514end;
3515
3516procedure TfrmODMeds.pnlXSequenceExit(Sender: TObject);
3517begin
3518 inherited;
3519 grdDoses.Cells[COL_SEQUENCE, pnlXSequence.Tag] := Uppercase(btnXSequence.Caption);
3520 if ActiveControl = grdDoses then
3521 begin
3522 //This next condition seldom occurs, since entering the dosage on the last
3523 // row adds another row
3524 if grdDoses.Row = grdDoses.RowCount - 1 then
3525 grdDoses.RowCount := grdDoses.RowCount + 1;
3526 end;
3527 pnlXSequence.Tag := -1;
3528 pnlXSequence.Hide;
3529 RestoreDefaultButton;
3530 RestoreCancelButton;
3531 if (pnlMessage.Visible) and (memMessage.TabStop) then
3532 begin
3533 pnlMessage.Parent := grdDoses.Parent;
3534 pnlMessage.TabOrder := grdDoses.TabOrder;
3535 ActiveControl := memMessage;
3536 end
3537 else if grdDoses.Showing then
3538 ActiveControl := grdDoses
3539 else
3540 ActiveControl := cboDosage;
3541end;
3542
3543procedure TfrmODMeds.btnXInsertClick(Sender: TObject);
3544var
3545 i: Integer;
3546 x1, x2: string;
3547begin
3548 inherited;
3549 grdDoses.SetFocus; // make sure exit events for editors fire
3550 with grdDoses do
3551 begin
3552 if Row < 1 then Exit;
3553 x1 := grdDoses.Cells[COL_ROUTE, Row];
3554 x2 := grdDoses.Cells[COL_SCHEDULE, Row];
3555 RowCount := RowCount + 1;
3556 { move rows down }
3557 for i := Pred(RowCount) downto Succ(Row) do Rows[i] := Rows[i-1];
3558 Rows[Row].Clear;
3559 Cells[COL_ROUTE, Row] := x1;
3560 Cells[COL_SCHEDULE, Row] := x2;
3561 Col := COL_DOSAGE;
3562 ShowEditor(COL_DOSAGE, Row, #0);
3563 end;
3564 DropLastSequence;
3565end;
3566
3567procedure TfrmODMeds.btnXRemoveClick(Sender: TObject);
3568var
3569 i: Integer;
3570begin
3571 inherited;
3572 grdDoses.SetFocus; // make sure exit events for editors fire
3573 with grdDoses do if (Row > 0) and (RowCount > 2) then
3574 begin
3575 { move rows up }
3576 for i := Row to RowCount - 2 do Rows[i] := Rows[i+1];
3577 RowCount := RowCount - 1;
3578 Rows[RowCount].Clear;
3579 end;
3580 DropLastSequence;
3581 ControlChange(Self);
3582end;
3583
3584function TfrmODMeds.ValueOf(FieldID: Integer; ARow: Integer = -1): string;
3585var
3586 x: string;
3587{ Contents of cboDosage
3588 DrugName^Strength^NF^TDose&Units&U/D&Noun&LDose&Drug^DoseText^CostText^MaxRefills
3589 Contents of grid cells (Only the first tab piece for each cell is drawn)
3590 Dosage <TAB> DosageFields
3591 RouteText <TAB> IEN^RouteName^Abbreviation
3592 Schedule <TAB> (nothing)
3593 Duration <TAB> Duration^Units }
3594begin
3595 Result := '';
3596 if ARow < 0 then // use single dose controls
3597 begin
3598 case FieldID of
3599 FLD_DOSETEXT : with cboDosage do
3600 if ItemIndex > -1 then Result := Uppercase(Piece(Items[ItemIndex], U, 5))
3601 else Result := Uppercase(Text);
3602 FLD_LOCALDOSE : with cboDosage do
3603 if ItemIndex > -1 then Result := Piece(Piece(Items[ItemIndex], U, 4), '&', 5)
3604 else Result := Uppercase(Text);
3605 FLD_STRENGTH : with cboDosage do
3606 if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 2);
3607 FLD_DRUG_ID : with cboDosage do
3608 if ItemIndex > -1 then Result := Piece(Piece(Items[ItemIndex], U, 4), '&', 6);
3609 FLD_DRUG_NM : with cboDosage do
3610 if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 1);
3611 FLD_DOSEFLDS : with cboDosage do
3612 if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 4);
3613 FLD_TOTALDOSE : with cboDosage do
3614 if ItemIndex > -1 then Result := Piece(Piece(Items[ItemIndex], U, 4), '&', 1);
3615 FLD_UNITNOUN : with cboDosage do
3616 if ItemIndex > -1 then Result := Piece(Piece(Items[ItemIndex], U, 4), '&', 3) + ' '
3617 + Piece(Piece(Items[ItemIndex], U, 4), '&', 4);
3618 FLD_ROUTE_ID : with cboRoute do
3619 if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 1);
3620 FLD_ROUTE_NM : with cboRoute do
3621 if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 2)
3622 else Result := Text;
3623 FLD_ROUTE_AB : with cboRoute do
3624 if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 3);
3625 FLD_ROUTE_EX : with cboRoute do
3626 if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 4);
3627 FLD_SCHEDULE : begin //gary)
3628 Result := UpperCase(Trim(cboSchedule.Text));
3629 if chkPRN.Checked then Result := Result + ' PRN';
3630 if UpperCase(Copy(Result, Length(Result) - 6, Length(Result))) = 'PRN PRN'
3631 then Result := Copy(Result, 1, Length(Result) - 4);
3632 end;
3633 FLD_SCHED_EX : begin
3634 with cboSchedule do
3635 begin
3636 if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 2);
3637 (* if (Length(Result)=0) and (ItemIndex > -1) then
3638 begin
3639 Result := Piece(Items[ItemIndex], U, 1);
3640 if Piece(Items[ItemIndex], U, 3) = 'P' then
3641 begin
3642 if RightStr(Result,3) = 'PRN' then
3643 begin
3644 Result := Copy(Result,1,Length(Result)-3); //Remove the Trailing PRN
3645 if (RightStr(Result,1) = ' ') or (RightStr(Result,1) = '-') then
3646 Result := Copy(Result,1,Length(Result)-1);
3647 end;
3648 Result := Result + ' AS NEEDED';
3649 end;
3650 end;
3651 end; *)
3652 if RightStr(Result,3) = 'PRN' then
3653 begin
3654 Result := Copy(Result,1,Length(Result)-3); //Remove the Trailing PRN
3655 if (RightStr(Result,1) = ' ') or (RightStr(Result,1) = '-') then
3656 Result := Copy(Result,1,Length(Result)-1);
3657 Result := Result + ' AS NEEDED'
3658 end;
3659 if (Length(Result) > 0) and chkPRN.Checked then Result := Result + ' AS NEEDED';
3660 if UpperCase(Copy(Result, Length(Result) - 18, Length(Result))) = 'AS NEEDED AS NEEDED'
3661 then Result := Copy(Result, 1, Length(Result) - 10);
3662 if UpperCase(Copy(Result, Length(Result) - 12, Length(Result))) = 'PRN AS NEEDED' then
3663 begin
3664 Result := Copy(Result, 1, Length(Result) - 13);
3665 if RightStr(Result,1)=' ' then Result := Result + 'AS NEEDED'
3666 else Result := Result + ' AS NEEDED';
3667 end;
3668 end;
3669 end;
3670 FLD_SCHED_TYP : with cboSchedule do
3671 if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 3);
3672 FLD_QTYDISP : with cboDosage do
3673 begin
3674 if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 8);
3675 if (Result = '') and (Items.Count > 0) then Result := Piece(Items[0], U, 8);
3676 if Result <> ''
3677// then Result := 'Qty (' + Result + ')' <-- original line. //kt 8/8/2007
3678 then Result := DKLangConstW('fODMeds_Qty_x') + Result + ')' //kt added 8/8/2007
3679// else Result := 'Quantity'; <-- original line. //kt 8/8/2007
3680 else Result := DKLangConstW('fODMeds_Quantity'); //kt added 8/8/2007
3681 end;
3682 end; {case FieldID} // use complex dose controls
3683 end else
3684 begin
3685 if (ARow < 1) or (ARow >= grdDoses.RowCount) then Exit;
3686 if Length(FDrugID) > 0
3687 then x := FieldsForDose(ARow)
3688 else x := Piece(Piece(grdDoses.Cells[COL_DOSAGE, ARow], TAB, 2), U, 4);
3689 with grdDoses do
3690 case FieldID of
3691 FLD_DOSETEXT : Result := Uppercase(Piece(Cells[COL_DOSAGE, ARow], TAB, 1));
3692 FLD_LOCALDOSE : begin
3693 if (Length(x) > 0) and (Length(FDrugID) > 0)
3694 then Result := Piece(x, '&', 5)
3695 else Result := Uppercase(Piece(Cells[COL_DOSAGE, ARow], TAB, 1));
3696 end;
3697 FLD_STRENGTH : Result := Piece(x, '&', 7) + Piece(x, '&', 8);
3698 FLD_DRUG_ID : Result := Piece(x, '&', 6);
3699 FLD_DRUG_NM : Result := Piece(FieldsForDrug(Piece(x, '&', 6)), U, 4);
3700 FLD_DOSEFLDS : Result := x;
3701 FLD_TOTALDOSE : Result := Piece(x, '&', 1);
3702 FLD_UNITNOUN : Result := Piece(x, '&', 3) + ' ' + Piece(x, '&', 4);
3703 FLD_ROUTE_ID : Result := Piece(Piece(Cells[COL_ROUTE, ARow], TAB, 2), U, 1);
3704 FLD_ROUTE_NM : begin
3705 Result := Piece(Piece(Cells[COL_ROUTE, ARow], TAB, 2), U, 2);
3706 if Result = '' then Result := Piece(Cells[COL_ROUTE, ARow], TAB, 1);
3707 end;
3708 FLD_ROUTE_AB : Result := Piece(Piece(Cells[COL_ROUTE, ARow], TAB, 2), U, 3);
3709 FLD_ROUTE_EX : Result := Piece(Piece(Cells[COL_ROUTE, ARow], TAB, 2), U, 4);
3710 FLD_SCHEDULE : begin
3711 Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 1);
3712 if Result = '' then Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
3713 if valFor(VAL_CHKXPRN,ARow)='1' then Result := Result + ' PRN';
3714 if UpperCase(Copy(Result, Length(Result) - 6, Length(Result))) = 'PRN PRN' then
3715 Result := Copy(Result, 1, Length(Result) - 4);
3716 end;
3717 FLD_SCHED_EX : begin
3718 (*Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 2);
3719 if Result = '' then //Added for CQ: 7639
3720 begin
3721 Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
3722 if RightStr(Result,4) = ' PRN' then
3723 Result := Copy(Result,1,Length(Result)-4); //Remove the Trailing PRN
3724 end;
3725 if (Piece(Cells[COL_SCHEDULE, ARow], TAB, 1) <>
3726 Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 1)) and
3727 (Pos('PRN', Piece(Cells[COL_SCHEDULE, ARow], TAB, 1)) > 0)
3728 then Result := Result + ' AS NEEDED';
3729 end;*)
3730 Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2),U,2);
3731 if Result = '' then Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2),U,1); //Added for CQ: 7639
3732 if Result = '' then Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
3733 if RightStr(Result,3) = 'PRN' then
3734 begin
3735 Result := Copy(Result,1,Length(Result)-3); //Remove the Trailing PRN
3736 if (RightStr(Result,1) = ' ') or (RightStr(Result,1) = '-') then
3737 Result := Copy(Result,1,Length(Result)-1);
3738 Result := Result + ' AS NEEDED';
3739 end;
3740 if valFor(VAL_CHKXPRN,ARow)='1' then Result := Result + ' AS NEEDED';
3741 if UpperCase(Copy(Result, Length(Result) - 18, Length(Result))) = 'AS NEEDED AS NEEDED'
3742 then Result := Copy(Result, 1, Length(Result) - 10);
3743 if UpperCase(Copy(Result, Length(Result) - 12, Length(Result))) = 'PRN AS NEEDED' then
3744 begin
3745 Result := Copy(Result, 1, Length(Result) - 13);
3746 if RightStr(Result,1)=' ' then Result := Result + 'AS NEEDED'
3747 else Result := Result + ' AS NEEDED';
3748 end;
3749 end;
3750 FLD_SCHED_TYP : Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 3);
3751 FLD_DURATION : Result := Piece(Cells[COL_DURATION, ARow], TAB, 1);
3752 FLD_SEQUENCE : Result := Piece(Cells[COL_SEQUENCE, ARow], TAB, 1);
3753 end; {case FieldID}
3754 end; {if ARow}
3755 if FieldID > FLD_MISC_FLDS then // still need to process 'non-sig' fields
3756 begin
3757 case FieldID of
3758 FLD_SUPPLY : Result := Trim(txtSupply.Text);
3759 FLD_QUANTITY :
3760 begin
3761 if Pos(',', txtQuantity.Text)>0 then
3762 Result := Piece(txtQuantity.Text,',',1) + Piece(txtQuantity.Text,',',2)
3763 else
3764 Result := Trim(txtQuantity.Text);
3765 end;
3766 FLD_REFILLS : Result := txtRefills.Text;
3767 FLD_PICKUP : if radPickWindow.Checked then Result := 'W'
3768 else if radPickMail.Checked then Result := 'M'
3769 else if radPickClinic.Checked then Result := 'C'
3770 else Result := '';
3771 FLD_PRIOR_ID : Result := cboPriority.ItemID;
3772 FLD_PRIOR_NM : Result := cboPriority.Text;
3773 FLD_COMMENT : Result := memComment.Text;
3774 FLD_SC : if chkSC.Visible then
3775 begin
3776 if chkSC.Checked then Result := '1' else Result := '0';
3777 end;
3778 FLD_NOW_ID : if chkDoseNow.Visible and chkDoseNow.Checked then Result := '1' else Result := '';
3779 FLD_NOW_NM : if chkDoseNow.Visible and chkDoseNow.Checked then Result := 'NOW' else Result := '';
3780 FLD_PTINSTR : if chkPtInstruct.Visible and chkPtInstruct.Checked
3781 then Result := FPtInstruct
3782 else Result := ' ';
3783 end; {case FieldID}
3784 end; {if FieldID}
3785end;
3786
3787function TfrmODMeds.ValueOfResponse(FieldID: Integer; AnInstance: Integer = 1): string;
3788var
3789 x: string;
3790begin
3791 case FieldID of
3792 FLD_SCHEDULE : Result := Responses.IValueFor('SCHEDULE', AnInstance);
3793 FLD_UNITNOUN : begin
3794 x := Responses.IValueFor('DOSE', AnInstance);
3795 Result := Piece(x, '&', 3) + ' ' + Piece(x, '&', 4);
3796 end;
3797 FLD_DOSEUNIT : begin
3798 x := Responses.IValueFor('DOSE', AnInstance);
3799 Result := Piece(x, '&', 3);
3800 end;
3801 FLD_DRUG_ID : Result := Responses.IValueFor('DRUG', AnInstance);
3802 FLD_INSTRUCT : Result := Responses.IValueFor('INSTR', AnInstance);
3803 FLD_SUPPLY : Result := Responses.IValueFor('SUPPLY', AnInstance);
3804 FLD_QUANTITY : Result := Responses.IValueFor('QTY', AnInstance);
3805 FLD_ROUTE_ID : Result := Responses.IValueFor('ROUTE', AnInstance);
3806 FLD_EXPIRE : Result := Responses.IValueFor('DAYS', AnInstance);
3807 FLD_ANDTHEN : Result := Responses.IValueFor('CONJ', AnInstance);
3808 end;
3809end;
3810
3811procedure TfrmODMeds.UpdateDefaultSupply(const CurUnits, CurSchedule, CurDuration, CurDispDrug: string;
3812 var CurSupply: Integer; var CurQuantity: double; var SkipQtyCheck: Boolean);
3813var
3814 ADrug: string;
3815begin
3816 if ((StrToFloatDef(txtQuantity.Text, 0) = 0) and (StrToIntDef(txtSupply.Text, 0) = 0) and
3817 (txtQuantity.Tag = 0) and (txtSupply.Tag = 0) and (cboDosage.Text <> ''))
3818 or ((cboDosage.ItemIndex < 0) and not FIsQuickOrder ) then
3819 begin
3820 ADrug := Piece(CurDispDrug, U, 1);
3821 CurSupply := DefaultDays(ADrug, CurUnits, CurSchedule);
3822 if CurSupply > 0 then
3823 begin
3824 spnSupply.Position := CurSupply;
3825 if (txtSupply.Text = '') or (StrToInt(txtSupply.Text)<>CurSupply) then
3826 txtSupply.Text := IntToStr(CurSupply);
3827 if (FIsQuickOrder and FQOInitial) then
3828 begin
3829 if StrToFloatDef(txtSupply.Text,0) > 0 then
3830 begin
3831 Exit;
3832 end;
3833 end;
3834 CurQuantity := DaysToQty(CurSupply, CurUnits, CurSchedule, CurDuration, ADrug);
3835 if CurQuantity >= 0 then
3836 begin
3837 //spnQuantity.Position := CurQuantity;
3838 if txtQuantity.Text <> '' then
3839 txtQuantity.Text := FloatToStr(CurQuantity);
3840 if (txtQuantity.Text = '') or (StrToInt(txtQuantity.Text) <> CurQuantity) then
3841 txtQuantity.Text := FloatToStr(CurQuantity);
3842 end;
3843 SkipQtyCheck := TRUE;
3844 end;
3845 end;
3846end;
3847
3848procedure TfrmODMeds.UpdateSupplyQuantity(const CurUnits, CurSchedule, CurDuration, CurDispDrug: string;
3849 var CurSupply: Integer; var CurQuantity: double);
3850const
3851 UPD_NONE = 0;
3852 UPD_QUANTITY = 1;
3853 UPD_SUPPLY = 2;
3854 UPD_COMPLEX = 3;
3855 UPD_BOTH = 4;
3856var
3857 UpdateControl, NewSupply: Integer;
3858 ADrug: string;
3859 SaveChanging: Boolean;
3860 tmpQuty: Double;
3861begin
3862 tmpQuty := 0;
3863 if (tabDose.TabIndex = TI_COMPLEX) and (txtSupply.Tag = 0) and (txtQuantity.Tag = 0) then
3864 begin
3865 // set days supply based on durations
3866 NewSupply := DurationToDays;
3867 if NewSupply > 0 then
3868 begin
3869 SaveChanging := Changing;
3870 Changing := TRUE;
3871 txtSupply.Text := IntToStr(NewSupply);
3872 CurSupply := NewSupply;
3873 Changing := SaveChanging;
3874 end;
3875 end;
3876 // exit if not enough fields to calculation supply or quantity
3877 if (CurQuantity = 0) and (CurSupply = 0) then Exit;
3878 // exit if nothing has changed
3879 if (CurUnits = FLastUnits) and
3880 (CurSchedule = FLastSchedule) and
3881 (CurDuration = FLastDuration) and
3882 (CurQuantity = FLastQuantity) and
3883 (CurSupply = FLastSupply) then Exit;
3884 // exit if supply & quantity have both been directly edited
3885 if (txtSupply.Tag > 0) and (txtQuantity.Tag > 0) then Exit;
3886 // figure out which control to update
3887 UpdateControl := UPD_NONE;
3888
3889 if (CurSupply <> FLastSupply) and (txtQuantity.Tag = 0) and (CurQuantity <> FLastQuantity) and (txtSupply.Tag = 0) and Changing then UpdateControl := UPD_BOTH
3890 else if (CurSupply <> FLastSupply) and (txtQuantity.Tag = 0) then UpdateControl := UPD_QUANTITY
3891 else if (CurQuantity <> FLastQuantity) and (txtSupply.Tag = 0) then UpdateControl := UPD_SUPPLY;
3892 if (UpdateControl = UPD_NONE) and ((CurUnits <> FLastUnits) or (CurSchedule <> FLastSchedule)) then
3893 begin
3894 if txtQuantity.Tag = 0 then UpdateControl := UPD_QUANTITY
3895 else if txtSupply.Tag = 0 then UpdateControl := UPD_SUPPLY;
3896 end;
3897 ADrug := Piece(CurDispDrug, U, 1); // just use the first dispense drug (for clozapine chk)
3898 case UpdateControl of
3899 UPD_QUANTITY : begin
3900 if FIsQuickOrder and (CurQuantity > 0) and FQOInitial then
3901 begin
3902 FQOInitial := False;
3903 Exit;
3904 end;
3905 if FIsQuickOrder and (CurQuantity > 0) then
3906 tmpQuty := CurQuantity;
3907 CurQuantity := DaysToQty(CurSupply, CurUnits, CurSchedule, CurDuration, ADrug);
3908 if (tmpQuty > 0) and (CurQuantity <= 0) then
3909 begin
3910 txtQuantity.Text := FloatToStr(tmpQuty);
3911 CurQuantity := tmpQuty;
3912 end else if (CurQuantity >= 0) then
3913 txtQuantity.Text := FloatToStr(CurQuantity);
3914 end;
3915 UPD_SUPPLY : begin
3916 CurSupply := QtyToDays(CurQuantity, CurUnits, CurSchedule, CurDuration, ADrug);
3917 if CurSupply > 0 then txtSupply.Text := IntToStr(CurSupply);
3918 end;
3919 UPD_BOTH : begin
3920 txtSupply.Text := IntToStr(CurSupply);
3921 tmpQuty := 0;
3922 if FIsQuickOrder and (CurQuantity > 0) and FQOInitial then
3923 begin
3924 FQOInitial := False;
3925 Exit;
3926 end;
3927 if FIsQuickOrder and (CurQuantity > 0) then
3928 tmpQuty := CurQuantity;
3929 CurQuantity := DaysToQty(CurSupply, CurUnits, CurSchedule, CurDuration, ADrug);
3930 if (tmpQuty > 0) and (CurQuantity <= 0) then
3931 begin
3932 txtQuantity.Text := FloatToStr(tmpQuty);
3933 CurQuantity := tmpQuty;
3934 end else if CurQuantity >= 0 then
3935 txtQuantity.Text := FloatToStr(CurQuantity);
3936 end;
3937 end;
3938 if UpdateControl > UPD_NONE then FUpdated := True;
3939end;
3940
3941procedure TfrmODMeds.UpdateSC(const CurDispDrug: string);
3942var
3943 Dispense: Integer;
3944begin
3945 Dispense := StrToIntDef(Piece(CurDispDrug, U, 1), 0); // just use first dispense drug for now
3946 if Patient.ServiceConnected and RequiresCopay(Dispense) then
3947 begin
3948 chkSC.Visible := True;
3949 if chkSC.Tag = 0 then chkSC.Checked := Patient.SCPercent > 50;
3950 if chkSC.Hint = '' then chkSC.Hint := RatedDisabilities;
3951 end
3952 else chkSC.Visible := False;
3953 FUpdated := True;
3954end;
3955
3956procedure TfrmODMeds.UpdateStartExpires(const CurSchedule: string);
3957var
3958 CompSch, ShowText, Duration, ASchedule: string;
3959 AdminTime: TFMDateTime;
3960 i, j, Interval, PrnPos: Integer;
3961begin
3962 if Length(CurSchedule)=0 then Exit;
3963 ASchedule := Trim(CurSchedule);
3964 if (Pos('^',ASchedule)>0) then
3965 begin
3966 PrnPos := Pos('PRN',ASchedule);
3967 if (PrnPos > 1) and (CharAt(ASchedule,PrnPos-1)=' ') then
3968 Delete(ASchedule, PrnPos-1, 4);
3969 end;
3970 ASchedule := Trim(ASchedule);
3971 if self.tabDose.TabIndex = TI_COMPLEX then
3972 begin
3973 CompSch := valFor(VAL_SCHEDULE,1);
3974 if CompSch = '' then
3975 begin
3976 ASchedule := '';
3977 AdminTime := -1;
3978 end;
3979 if CompSch <> '' then
3980 begin
3981 for i := 0 to self.cboXSchedule.Items.Count-1 do
3982 begin
3983 if (Piece(self.cboXSchedule.Items.Strings[i],U,1) = CompSch) and (Piece(self.cboXSchedule.Items.Strings[i],U,3)='P') then
3984 begin
3985 AdminTime := -1;
3986 Aschedule := '';
3987 end;
3988 end;
3989 end;
3990 if valFor(VAL_CHKXPRN,1)='1' then
3991 begin
3992 AdminTime := -1;
3993 Aschedule := '';
3994 end;
3995 if (ASchedule <> '') and (CompSch <> '') then ASchedule := ';' + CompSch;
3996 end;
3997 if Length(ASchedule)>0 then
3998 LoadAdminInfo(ASchedule, txtMed.Tag, ShowText, AdminTime, Duration);
3999 //else Exit;
4000 if (AdminTime > 0) and (self.tabDose.TabIndex = TI_DOSE) then
4001 begin
4002 if self.cboSchedule.ItemIndex = -1 then
4003 begin
4004 for j := 0 to self.cboSchedule.items.Count -1 do
4005 begin
4006 if (Piece(self.cboSchedule.Items.Strings[j],U,1) = Piece(Aschedule,';',2)) and (Piece(self.cboSchedule.Items.Strings[j],U,3)='P') then
4007 begin
4008 AdminTime := -1;
4009 break;
4010 end;
4011 end;
4012 end;
4013 if (self.cboSchedule.ItemIndex > -1) and (Piece(self.cboSchedule.Items.Strings[self.cboSchedule.ItemIndex],U,3)='P') then
4014 AdminTime := -1;
4015 if self.chkPRN.Checked = true then AdminTime := -1
4016 end;
4017 if AdminTime > 0 then
4018 begin
4019// ShowText := 'Expected First Dose: '; <-- original line. //kt 8/8/2007
4020 ShowText := DKLangConstW('fODMeds_Expected_First_Dosex'); //kt added 8/8/2007
4021 Interval := Trunc(FMDateTimeToDateTime(AdminTime) - FMDateTimeToDateTime(FMToday));
4022 case Interval of
4023 0: ShowText := ShowText + 'TODAY ' + FormatFMDateTime('(mmm dd, yy) at hh:nn', AdminTime);
4024 1: ShowText := ShowText + 'TOMORROW ' + FormatFMDateTime('(mmm dd, yy) at hh:nn', AdminTime);
4025 else ShowText := ShowText + FormatFMDateTime('mmm dd, yy at hh:nn', AdminTime);
4026 end;
4027
4028 if (Pos('PRN',Piece(CurSchedule,'^',1))>0) and ((pnlXSchedule.Tag = 1) or chkPrn.Checked ) then
4029 begin
4030 if lblAdmintime.visible then
4031 begin
4032 lblAdmintime.Caption := '';
4033 FAdminTimeLbl := lblAdminTime.Caption;
4034 end;
4035 end else
4036 lblAdminTime.Caption := ShowText;
4037 FAdminTimeLbl := lblAdminTime.Caption;
4038 end
4039 else lblAdminTime.Caption := '';
4040end;
4041
4042procedure TfrmODMeds.UpdateRefills(const CurDispDrug: string; CurSupply: Integer);
4043begin
4044 if EvtForPassDischarge = 'D' then
4045 spnRefills.Max := CalcMaxRefills(CurDispDrug, CurSupply, txtMed.Tag, True)
4046 else
4047 spnRefills.Max := CalcMaxRefills(CurDispDrug, CurSupply, txtMed.Tag, Responses.EventType = 'D');
4048 if StrToIntDef(txtRefills.Text, 0) > spnRefills.Max then
4049 begin
4050 txtRefills.Text := IntToStr(spnRefills.Max);
4051 spnRefills.Position := spnRefills.Max;
4052 FUpdated := True;
4053 end;
4054end;
4055
4056procedure TfrmODMeds.UpdateRelated(DelayUpdate: Boolean = TRUE);
4057begin
4058 timCheckChanges.Enabled := False; // turn off timer
4059 if DelayUpdate
4060 then timCheckChanges.Enabled := True // restart timer
4061 else timCheckChangesTimer(Self); // otherwise call directly
4062end;
4063
4064procedure TfrmODMeds.timCheckChangesTimer(Sender: TObject);
4065const
4066 UPD_NONE = 0;
4067 UPD_QUANTITY = 1;
4068 UPD_SUPPLY = 2;
4069var
4070 CurUnits, CurSchedule, CurInstruct, CurDispDrug, CurDuration, TmpSchedule, x, x1: string;
4071 CurScheduleIN, CurScheduleOut: string;
4072 CurSupply, i, pNum, j: Integer;
4073 CurQuantity: double;
4074 LackQtyInfo, SaveChanging, DispFirstDose: Boolean;
4075begin
4076 inherited;
4077 timCheckChanges.Enabled := False;
4078 ControlChange(Self);
4079 SaveChanging := Changing;
4080 Changing := TRUE;
4081 DispFirstDose := FALSE;
4082 // don't allow Exit procedure so Changing gets reset appropriately
4083 CurUnits := '';
4084 CurSchedule := '';
4085 CurDuration := '';
4086 LackQtyInfo := False;
4087 i := Responses.NextInstance('DOSE', 0);
4088 while i > 0 do
4089 begin
4090 x := ValueOfResponse(FLD_DOSEUNIT, i);
4091 if (x = '') and (not FIsQuickOrder) then LackQtyInfo := TRUE //StrToIntDef(x, 0) = 0
4092 else if (x = '') and FIsQuickOrder and (Length(txtQuantity.Text)>0) then
4093 LackQtyInfo := false;
4094 CurUnits := CurUnits + x + U;
4095 x := ValueOfResponse(FLD_SCHEDULE, i);
4096 if Length(x) = 0 then LackQtyInfo := TRUE;
4097 CurScheduleOut := CurScheduleOut + x + U;
4098 x1 := ValueOf(FLD_SEQUENCE,i);
4099 if Length(x1)>0 then
4100 begin
4101 X1 := CharAt(X1,1);
4102 CurScheduleIn := CurScheduleIn + x1 + ';' + x + U;
4103 end
4104 else
4105 CurScheduleIn := CurScheduleIn + ';' + x + U;
4106 x := ValueOfResponse(FLD_EXPIRE, i);
4107 CurDuration := CurDuration + x + '~';
4108 x := ValueOfResponse(FLD_ANDTHEN, i);
4109 CurDuration := CurDuration + x + U;
4110 x := ValueOfResponse(FLD_DRUG_ID, i);
4111 CurDispDrug := CurDispDrug + x + U;
4112 x := ValueOfResponse(FLD_INSTRUCT, i);
4113 CurInstruct := CurInstruct + x + U; //AGP CHANGE 26.19 FOR CQ 7465
4114 i := Responses.NextInstance('DOSE', i);
4115 end;
4116
4117 pNum := 1;
4118 while Length( Piece(CurScheduleIn,U,pNum)) > 0 do
4119 pNum := pNum + 1;
4120 if Length(Piece(CurScheduleIn,U,pNum)) < 1 then
4121 for j := 1 to pNum - 1 do
4122 begin
4123 if j = pNum -1 then
4124 TmpSchedule := TmpSchedule + ';' + Piece(Piece(CurScheduleIn,U,j),';',2)
4125 else
4126 TmpSchedule := TmpSchedule + Piece(CurScheduleIn,U,j) + U
4127 end;
4128 CurScheduleIn := TmpSchedule;
4129 CurQuantity := StrToFloatDef(ValueOfResponse(FLD_QUANTITY), 0);
4130 CurSupply := StrToIntDef(ValueOfResponse(FLD_SUPPLY) ,0);
4131 if FInptDlg then
4132 begin
4133 CurSchedule := CurScheduleIn;
4134 if Pos('^',CurSchedule)>0 then
4135 begin
4136 if Pos('PRN',Piece(CurSchedule,'^',1))>0 then
4137 if lblAdminTime.Visible then
4138 lblAdminTime.Caption := '';
4139 end;
4140 if CurSchedule <> FLastSchedule then UpdateStartExpires(CurSchedule);
4141 if (ValueOf(FLD_SCHED_TYP) = 'O')
4142 or (Responses.EventType in ['A','D','T','M','O'])
4143 or ((Length(cboSchedule.Text)>0) and (cboSchedule.ItemIndex < 0)) then
4144 begin
4145 if (chkDoseNow.Checked) and (chkDoseNow.Visible) then
4146 begin
4147 chkDoseNowClick(Self);
4148 chkDoseNow.Checked := False;
4149 end;
4150 for i := 0 to cboSchedule.Items.Count-1 do
4151 begin
4152 if Piece(cboSchedule.Items.Strings[i],U,1) = Uppercase(cboSchedule.Text) then
4153 begin
4154 DispFirstDose := True;
4155 break;
4156 end;
4157 end;
4158 if not DispFirstDose then
4159 begin
4160 chkDoseNow.Visible := False;
4161 lblAdminTime.Visible := False;
4162 end;
4163 end
4164 else
4165 begin
4166 chkDoseNow.Visible := TRUE;
4167 lblAdminTime.Visible := not chkDoseNow.Checked;
4168 end;
4169 if Responses.EventType in ['A','D','T','M','O'] then lblAdminTime.Visible := False;
4170 end;
4171 if not FInptDlg then
4172 begin
4173 CurSchedule := CurScheduleOut;
4174 if (CurInstruct <> FLastInstruct) and (CurUnits <> U) //AGP Change 26.48 Do not update quantity and day supply if no matching dose on the server
4175 then UpdateDefaultSupply(CurUnits, CurSchedule, CurDuration, CurDispDrug, CurSupply, CurQuantity,
4176 LackQtyInfo);
4177 if LackQtyInfo then begin
4178 if FScheduleChanged then
4179 txtQuantity.Text := '0';
4180 end
4181 else
4182 UpdateSupplyQuantity(CurUnits, CurSchedule, CurDuration, CurDispDrug, CurSupply, CurQuantity);
4183 if (CurDispDrug <> FLastDispDrug) then UpdateSC(CurDispDrug);
4184 if (CurDispDrug <> FLastDispDrug) or (CurSupply <> FLastSupply) then
4185 UpdateRefills(CurDispDrug, CurSupply);
4186 end;
4187
4188 FLastUnits := CurUnits;
4189 FLastSchedule := CurSchedule;
4190 FLastDuration := CurDuration;
4191 FLastInstruct := CurInstruct;
4192 FLastDispDrug := CurDispDrug;
4193 FLastQuantity := CurQuantity;
4194 FLastSupply := CurSupply;
4195 if (not FNoZERO) and (txtQuantity.Text = '') and (FLastQuantity = 0) then
4196 txtQuantity.Text := FloatToStr(FLastQuantity);
4197 if (not FNoZERO) and (txtSupply.Text = '') and (FLastSupply = 0) then
4198 txtSupply.Text := IntToStr(FLastSupply);
4199 if (ActiveControl <> nil) and (ActiveControl.Parent <> cboDosage)
4200 then cboDosage.Text := Piece(cboDosage.Text, TAB, 1);
4201 Changing := SaveChanging;
4202 if FUpdated then ControlChange(Self);
4203 FScheduleChanged := false;
4204end;
4205
4206procedure TfrmODMeds.cmdAcceptClick(Sender: TObject);
4207var
4208i: integer;
4209begin
4210 if (FInptDlg) and (cboSchedule.Text = 'OTHER') then
4211 begin
4212 cboScheduleClick(Self);
4213 Exit;
4214 end;
4215 //AGP Change for 26.45 PSI-04-069
4216 if self.tabDose.TabIndex = 1 then
4217 begin
4218 for i := 2 to self.grdDoses.RowCount do
4219 begin
4220 if ((ValFor(COL_DOSAGE, i-1) <> '') and (ValFor(COL_DOSAGE, i) <> '')) and (ValFor(COL_SEQUENCE,i-1) = '') then
4221 begin
4222// infoBox('To be able to complete a complex order every row except for the last row must have a conjunction defined. ' + CRLF <-- original line. //kt 8/8/2007
4223 infoBox(DKLangConstW('fODMeds_To_be_able_to_complete_a_complex_order_every_row_except_for_the_last_row_must_have_a_conjunction_definedx') + CRLF //kt added 8/8/2007
4224// + CRLF + 'Verify that all rows have a conjunction defined.','Sequence Error',MB_OK); <-- original line. //kt 8/8/2007
4225 + CRLF + DKLangConstW('fODMeds_Verify_that_all_rows_have_a_conjunction_definedx'),DKLangConstW('fODMeds_Sequence_Error'),MB_OK); //kt added 8/8/2007
4226 Exit;
4227 end;
4228 //text := Self.cboXDosage.Items.Strings[i];
4229 end;
4230 end;
4231 if FInptDlg and (not FOutptIV)
4232 then DisplayGroup := DisplayGroupByName('UD RX')
4233 else DisplayGroup := DisplayGroupByName('O RX');
4234 //timCheckChangesTimer(Self);
4235 DropLastSequence;
4236 cmdAccept.SetFocus;
4237 inherited;
4238 (*if self.Responses.Cancel = true then
4239 begin
4240 self.Destroy;
4241 exit;
4242 end; *)
4243end;
4244
4245procedure TfrmODMeds.chkPtInstructClick(Sender: TObject);
4246begin
4247 inherited;
4248 ControlChange(Self);
4249end;
4250
4251procedure TfrmODMeds.chkDoseNowClick(Sender: TObject);
4252const
4253 T = '"';
4254//T1 = 'By checking the "Give additional dose now" box, you have actually entered two orders for the same medication "'; <-- original line. //kt 8/8/2007
4255//T2 = #13#13'The first order''s administrative schedule is "'; <-- original line. //kt 8/8/2007
4256//T3 = #13'The second order''s administrative schedule is "'; <-- original line. //kt 8/8/2007
4257//T4 = #13#13'Do you want to continue?'; <-- original line. //kt 8/8/2007
4258//T1A = 'By checking the "Give additional dose now" box, you have actually entered a new order with the schedule "NOW"'; <-- original line. //kt 8/8/2007
4259//T2A = ' in addition to the one you are placing for the same medication "'; <-- original line. //kt 8/8/2007
4260var
4261 medNm: string;
4262 theSch: string;
4263 T1 : string; //kt
4264 T2 : string; //kt
4265 T3 : string; //kt
4266 T4 : string; //kt
4267 T1A : string; //kt
4268 T2A : string; //kt
4269begin
4270 inherited;
4271 T1 := DKLangConstW('fODMeds_By_checking_the_xGive_additional_dose_nowx_boxx_you_have_actually_entered_two_orders_for_the_same_medication_x'); //kt added 8/8/2007
4272 T2 := #13#13+DKLangConstW('fODMeds_The_first_orderxxs_administrative_schedule_is_x'); //kt added 8/8/2007
4273 T3 := #13+DKLangConstW('fODMeds_The_second_orderxxs_administrative_schedule_is_x'); //kt added 8/8/2007
4274 T4 := #13#13+DKLangConstW('fODMeds_Do_you_want_to_continuex'); //kt added 8/8/2007
4275 T1A := DKLangConstW('fODMeds_By_checking_the_xGive_additional_dose_nowx_boxx_you_have_actually_entered_a_new_order_with_the_schedule_xNOWx'); //kt added 8/8/2007
4276 T2A := DKLangConstW('fODMeds_in_addition_to_the_one_you_are_placing_for_the_same_medication_x'); //kt added 8/8/2007
4277 if (chkDoseNow.Checked) and (tabDose.TabIndex <> TI_COMPLEX) then
4278 begin
4279 medNm := txtMed.Text;
4280 theSch := cboSchedule.Text;
4281 if length(theSch)>0 then
4282 begin
4283// if ( (ValueOf(FLD_SCHED_TYP) <> 'O') and (InfoBox(T1+medNm+T+T2+theSch+T+T3+'NOW"'+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL) )then <-- original line. //kt 8/8/2007
4284 if ( (ValueOf(FLD_SCHED_TYP) <> 'O') and (InfoBox(T1+medNm+T+T2+theSch+T+T3+DKLangConstW('fODMeds_NOWx')+T4, DKLangConstW('fODMeds_Warning'), MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL) )then //kt added 8/8/2007
4285 begin
4286 chkDoseNow.Checked := False;
4287 Exit;
4288 end;
4289 end else
4290 begin
4291// if InfoBox(T1A+T2A+medNm+T+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL then <-- original line. //kt 8/8/2007
4292 if InfoBox(T1A+T2A+medNm+T+T4, DKLangConstW('fODMeds_Warning'), MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL then //kt added 8/8/2007
4293 begin
4294 chkDoseNow.Checked := False;
4295 Exit;
4296 end;
4297 end;
4298 end;
4299 lblAdminTime.Visible := not chkDoseNow.Checked;
4300 if (tabDose.TabIndex = TI_COMPLEX) and chkDoseNow.Checked then
4301 begin
4302// if ( (ValueOf(FLD_SCHED_TYP) <> 'O') and (InfoBox('Give Additional Dose Now is in addition to those listed in the table.' + CRLF + <-- original line. //kt 8/8/2007
4303 if ( (ValueOf(FLD_SCHED_TYP) <> 'O') and (InfoBox(DKLangConstW('fODMeds_Give_Additional_Dose_Now_is_in_addition_to_those_listed_in_the_tablex') + CRLF + //kt added 8/8/2007
4304// 'Please adjust the duration of the first row, if necessary.', <-- original line. //kt 8/8/2007
4305 DKLangConstW('fODMeds_Please_adjust_the_duration_of_the_first_rowx_if_necessaryx'), //kt added 8/8/2007
4306// 'Give Additional Dose Now for Complex Order', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL) ) then <-- original line. //kt 8/8/2007
4307 DKLangConstW('fODMeds_Give_Additional_Dose_Now_for_Complex_Order'), MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL) ) then //kt added 8/8/2007
4308 begin
4309 chkDoseNow.Checked := False;
4310 Exit;
4311 end;
4312 end;
4313 ControlChange(Self);
4314end;
4315
4316
4317procedure TfrmODMeds.CheckDecimal(var AStr: string);
4318var
4319 DUName,UnitNum,tempStr: string;
4320 ToWord: string;
4321 ie,code: integer;
4322begin
4323 ToWord := '';
4324 tempStr := AStr;
4325 UnitNum := Piece(AStr,' ',1);
4326 DUName := Copy(tempStr,Length(UnitNum)+1,Length(tempStr));
4327 DUName := Trim(DUName);
4328 if CharAt(UnitNum,1)='.' then
4329 begin
4330 if CharAt(UnitNum,2) in ['0','1','2','3','4','5','6','7','8','9'] then
4331 begin
4332 UnitNum := '0' + UnitNum;
4333 AStr := '0' + AStr;
4334 end;
4335 end;
4336 if ((Pos('TABLET',upperCase(DUName))= 0)) and ( Pos('DROP',upperCase(DUName))= 0 )then
4337 Exit;
4338 if (Length(UnitNum)>0) and (Length(DUName)>0) then
4339 begin
4340 if CharAt(UnitNum,1) <> '0' then
4341 begin
4342 Val(UnitNum, ie, code);
4343 if (code <> 0) and (ie=0) then
4344 Exit;
4345 end;
4346 AStr := TextDosage(UnitNum) + ' ' + DUName;
4347 end;
4348end;
4349
4350procedure TfrmODMeds.DropLastSequence(ASign: integer);
4351//const
4352//TXT_CONJUNCTIONWARNING = 'is not associated with the comment field, and has been deleted.'; <-- original line. //kt 8/8/2007
4353var
4354 i :integer;
4355 StrConjunc: string;
4356 TXT_CONJUNCTIONWARNING : string; //kt
4357begin
4358 TXT_CONJUNCTIONWARNING := DKLangConstW('fODMeds_is_not_associated_with_the_comment_fieldx_and_has_been_deletedx'); //kt added 8/8/2007
4359 for i := 1 to grdDoses.RowCount - 1 do
4360 begin
4361 if (i = 1) and (grdDoses.Cells[COL_DOSAGE,i] = '' ) then
4362 Exit
4363 else if (i>1) and (grdDoses.Cells[COL_DOSAGE,i] = '') and (grdDoses.Cells[COL_ROUTE,i] = '') then
4364 begin
4365 if Length(grdDoses.Cells[COL_SEQUENCE, i-1])>0 then
4366 begin
4367 StrConjunc := grdDoses.Cells[COL_SEQUENCE, i-1];
4368 if ASign = 1 then
4369 begin
4370// if InfoBox('The "' + StrConjunc + '" ' + TXT_CONJUNCTIONWARNING, 'Warning', MB_OK or MB_ICONWARNING) = IDOK then <-- original line. //kt 8/8/2007
4371 if InfoBox(DKLangConstW('fODMeds_The_x') + StrConjunc + '" ' + TXT_CONJUNCTIONWARNING, DKLangConstW('fODMeds_Warning'), MB_OK or MB_ICONWARNING) = IDOK then //kt added 8/8/2007
4372 begin
4373 grdDoses.Cells[COL_SEQUENCE, i-1] := '';
4374 ActiveControl := memOrder;
4375 end
4376 end
4377 else
4378 begin
4379 grdDoses.Cells[COL_SEQUENCE, i-1] := '';
4380 end;
4381 end;
4382 Exit;
4383 end;
4384 end;
4385end;
4386
4387procedure TfrmODMeds.memCommentClick(Sender: TObject);
4388var
4389 theSign : integer;
4390begin
4391 inherited;
4392 theSign := 1;
4393 DropLastSequence(theSign);
4394end;
4395
4396procedure TfrmODMeds.btnXDurationClick(Sender: TObject);
4397var
4398 APoint: TPoint;
4399begin
4400 inherited;
4401 with TSpeedButton(Sender) do APoint := ClientToScreen(Point(0, Height));
4402 popDuration.Popup(APoint.X, APoint.Y);
4403end;
4404
4405procedure TfrmODMeds.chkPRNClick(Sender: TObject);
4406var
4407 tempSch: string;
4408 PRNPos: integer;
4409begin
4410 inherited;
4411 //GE CQ 7552
4412 if chkPRN.Checked then
4413 begin
4414 lblAdminTime.Caption := '';
4415 PrnPos := Pos('PRN',cboSchedule.Text);
4416 if (PrnPos < 1) then
4417 UpdateStartExpires(cboSchedule.Text + ' PRN');
4418 end
4419 else
4420 begin
4421 if Length(Trim(cboSchedule.Text))>0 then
4422 begin
4423 tempSch := ';'+Trim(cboSchedule.Text);
4424 UpdateStartExpires(tempSch);
4425 end;
4426 //lblAdminTime.Caption := FAdminTimeLbl;
4427 if txtQuantity.visible then
4428 cboScheduleClick(Self);
4429 end;
4430 ControlChange(Self);
4431end;
4432
4433procedure TfrmODMeds.grdDosesKeyDown(Sender: TObject; var Key: Word;
4434 Shift: TShiftState);
4435begin
4436 inherited;
4437 case Key of
4438// VK_RETURN: //moved to form key press
4439 VK_ESCAPE:
4440 begin
4441 ActiveControl := FindNextControl(Sender as TWinControl, False, True, False); //Previous control
4442 Key := 0;
4443 end;
4444 VK_INSERT:
4445 begin
4446 btnXInsertClick(self);
4447 Key := 0;
4448 end;
4449 VK_DELETE:
4450 begin
4451 btnXRemoveClick(self);
4452 Key := 0;
4453 end;
4454 VK_TAB:
4455 begin
4456 if ssShift in Shift then
4457 begin
4458 ActiveControl := tabDose; //Previeous control
4459 Key := 0;
4460 end
4461 else if ssCtrl in Shift then
4462 begin
4463 ActiveControl := memComment;
4464 Key := 0;
4465 end;
4466 end;
4467 end;
4468end;
4469
4470procedure TfrmODMeds.grdDosesEnter(Sender: TObject);
4471begin
4472 inherited;
4473 DisableDefaultButton(self);
4474 DisableCancelButton(self);
4475end;
4476
4477function TfrmODMeds.DisableCancelButton(Control: TWinControl): boolean;
4478var
4479 i: integer;
4480begin
4481 if (Control is TButton) and TButton(Control).Cancel then begin
4482 result := True;
4483 FDisabledCancelButton := TButton(Control);
4484 TButton(Control).Cancel := False;
4485 end else begin
4486 result := False;
4487 for i := 0 to Control.ControlCount-1 do
4488 if (Control.Controls[i] is TWinControl) then
4489 if DisableCancelButton(TWinControl(Control.Controls[i])) then begin
4490 result := True;
4491 break;
4492 end;
4493 end;
4494end;
4495
4496function TfrmODMeds.DisableDefaultButton(Control: TWinControl): boolean;
4497var
4498 i: integer;
4499begin
4500 if (Control is TButton) and TButton(Control).Default then begin
4501 result := True;
4502 FDisabledDefaultButton := TButton(Control);
4503 TButton(Control).Default := False;
4504 end else begin
4505 result := False;
4506 for i := 0 to Control.ControlCount-1 do
4507 if (Control.Controls[i] is TWinControl) then
4508 if DisableDefaultButton(TWinControl(Control.Controls[i])) then begin
4509 result := True;
4510 break;
4511 end;
4512 end;
4513end;
4514
4515procedure TfrmODMeds.RestoreCancelButton;
4516begin
4517 if Assigned(FDisabledCancelButton) then begin
4518 FDisabledCancelButton.Cancel := True;
4519 FDisabledCancelButton := nil;
4520 end;
4521end;
4522
4523procedure TfrmODMeds.RestoreDefaultButton;
4524begin
4525 if Assigned(FDisabledDefaultButton) then begin
4526 FDisabledDefaultButton.Default := True;
4527 FDisabledDefaultButton := nil;
4528 end;
4529end;
4530
4531procedure TfrmODMeds.FormKeyPress(Sender: TObject; var Key: Char);
4532begin
4533 if (Key = #13) and (ActiveControl = grdDoses{pnlXSequence}) then
4534 begin
4535 ShowEditor(grdDoses.Col, grdDoses.Row, #0);
4536 Key := #0; //Don't let the base class turn it into a forward tab!
4537 end
4538 else if (Key = #13) and (ActiveControl = txtMed) then
4539 Key := #0; //Don't let the base class turn it into a forward tab!
4540end;
4541
4542procedure TfrmODMeds.FormKeyDown(Sender: TObject; var Key: Word;
4543 Shift: TShiftState);
4544begin
4545 inherited;
4546 if (Key = VK_TAB) and (ssCtrl in Shift) and (ActiveControl <> grdDoses) then
4547 begin
4548 //Back-tab works the same as forward-tab because there are only two tabs.
4549 tabDose.TabIndex := (tabDose.TabIndex + 1) mod tabDose.Tabs.Count;
4550 Key := 0;
4551 tabDoseChange(tabDose);
4552 end;
4553end;
4554
4555procedure TfrmODMeds.cboXRouteEnter(Sender: TObject);
4556begin
4557 inherited;
4558 DisableDefaultButton(self);
4559 DisableCancelButton(self);
4560end;
4561
4562procedure TfrmODMeds.pnlXSequenceEnter(Sender: TObject);
4563begin
4564 inherited;
4565 DisableDefaultButton(self);
4566 DisableCancelButton(self);
4567end;
4568
4569procedure TfrmODMeds.pnlMessageEnter(Sender: TObject);
4570begin
4571 inherited;
4572 DisableDefaultButton(self);
4573 DisableCancelButton(self);
4574end;
4575
4576procedure TfrmODMeds.pnlMessageExit(Sender: TObject);
4577begin
4578 inherited;
4579 RestoreDefaultButton;
4580 RestoreCancelButton;
4581end;
4582
4583procedure TfrmODMeds.memMessageKeyDown(Sender: TObject; var Key: Word;
4584 Shift: TShiftState);
4585begin
4586 inherited;
4587 if (Key = VK_RETURN) or (Key = VK_ESCAPE) then
4588 begin
4589 Perform(WM_NEXTDLGCTL, 0, 0);
4590 Key := 0;
4591 end;
4592end;
4593
4594procedure TfrmODMeds.memPIClick(Sender: TObject);
4595begin
4596 inherited;
4597//ShowMessage('The patient instruction field may not be edited.'); <-- original line. //kt 8/8/2007
4598 ShowMessage(DKLangConstW('fODMeds_The_patient_instruction_field_may_not_be_editedx')); //kt added 8/8/2007
4599 chkPtInstruct.SetFocus;
4600end;
4601
4602procedure TfrmODMeds.FormResize(Sender: TObject);
4603var
4604 aftHeight: integer;
4605begin
4606 inherited;
4607 pnlFields.Height := memOrder.Top - 4 - pnlFields.Top;
4608 aftHeight := pnlFields.Top + pnlFields.Height + memOrder.Height;
4609 if aftHeight > Height then
4610 Height := aftHeight;
4611 if pnlMessage.Visible then
4612 pnlMessage.Top := pnlFields.Top + pnlTop.Height + 8;
4613end;
4614
4615procedure TfrmODMeds.spnQuantityChangingEx(Sender: TObject;
4616 var AllowChange: Boolean; NewValue: Smallint;
4617 Direction: TUpDownDirection);
4618var
4619 tempQuant: double;
4620begin
4621 inherited;
4622 if Direction = updUp then
4623 begin
4624 tempQuant := StrToFloatDef(txtQuantity.Text,0) + 1;
4625 txtQuantity.Text := FloatToStr(tempQuant);
4626 end else if Direction = updDown then
4627 begin
4628 tempQuant := StrToFloatDef(txtQuantity.Text,0) - 1 ;
4629 if tempQuant < 0 then tempQuant := 0;
4630 txtQuantity.Text := FloatToStr(tempQuant);
4631 end;
4632 spnQuantity.Tag := 1;
4633 txtQuantity.Tag := 1;
4634end;
4635
4636procedure TfrmODMeds.memPIKeyDown(Sender: TObject; var Key: Word;
4637 Shift: TShiftState);
4638begin
4639 inherited;
4640//ShowMessage('The patient instruction field may not be edited.'); <-- original line. //kt 8/8/2007
4641 ShowMessage(DKLangConstW('fODMeds_The_patient_instruction_field_may_not_be_editedx')); //kt added 8/8/2007
4642 chkPtInstruct.SetFocus;
4643end;
4644
4645function TfrmODMeds.TextDosage(ADosage: string): string;
4646var
4647 intS, fltS: string;
4648 iNum: integer;
4649 fNum: double;
4650begin
4651 intS := '';
4652 fltS := '';
4653 Result := intS + fltS;
4654 try
4655 begin
4656 iNum := StrToIntDef(Piece(ADosage,'.',1),0);
4657 fNum := StrToFloatDef('0.'+Piece(ADosage,'.',2),0);
4658 if fNum = 0.5 then
4659 fltS := 'ONE-HALF';
4660 if ( fNum >= 0.3 ) and ( fNum <= 0.4 ) then
4661 fltS := 'ONE-THIRD';
4662 if fNum = 0.25 then
4663 fltS := 'ONE-FOURTH';
4664 if ( fNum >= 0.6 ) and ( fNum <= 0.7 ) then
4665 fltS := 'TWO-THIRDS';
4666 if fNum = 0.75 then
4667 fltS := 'THREE-FOURTHS';
4668 if iNum = 1 then
4669 intS := 'ONE';
4670 if iNum = 2 then
4671 intS := 'TWO';
4672 if iNum = 3 then
4673 intS := 'THREE';
4674 if iNum = 4 then
4675 intS := 'FOUR';
4676 if iNum = 5 then
4677 intS := 'FIVE';
4678 if iNum = 6 then
4679 intS := 'SIX';
4680 if iNum = 7 then
4681 intS := 'SEVEN';
4682 if iNum = 8 then
4683 intS := 'EIGHT';
4684 if iNum = 9 then
4685 intS := 'NINE';
4686 if iNum = 10 then
4687 intS := 'TEN';
4688 if Length(intS) > 0 then
4689 begin
4690 if Length(fltS)>1 then
4691 fltS :=' AND ' + fltS;
4692 end;
4693 Result := intS + fltS;
4694 if Result = '' then
4695 Result := ADosage;
4696 end
4697 except
4698 on EConvertError do Result := '';
4699 end;
4700end;
4701
4702function TfrmODMeds.CreateOtherScheduel: string; //NSS
4703var
4704 aSchedule: string;
4705begin
4706 aSchedule := '';
4707 if not ShowOtherSchedule(aSchedule) then
4708 begin
4709 cboSchedule.ItemIndex := -1;
4710 cboSchedule.Text := '';
4711 end;
4712 Result := aSchedule;
4713end;
4714
4715function TfrmODMeds.IfIsIMODialog: boolean;
4716var
4717 IsInptDlg, IsIMOLocation: boolean;
4718 Td: TFMDateTime;
4719begin
4720 result := False;
4721 IsInptDlg := False;
4722 Td := FMToday;
4723 if DlgFormID = MedsInDlgFormId then IsInptDlg := TRUE;
4724 IsIMOLocation := IsValidIMOLoc(Encounter.Location,Patient.DFN);
4725 if (IsInptDlg) and (not Patient.Inpatient) and IsIMOLocation and (Encounter.DateTime > Td) then
4726 result := True;
4727end;
4728
4729procedure TfrmODMeds.lstChange(Sender: TObject; Item: TListItem;
4730 Change: TItemChange);
4731begin
4732 inherited;
4733 btnSelect.Enabled := (lstAll.ItemIndex > -1) or
4734 ((lstQuick.ItemIndex > -1) and
4735 (Assigned(lstQuick.Items[lstQuick.ItemIndex].Data)) and
4736 (Integer(lstQuick.Selected.Data) > 0)) ;
4737 if (btnSelect.Enabled) and (FRemoveText) then
4738 txtMed.Text := '';
4739end;
4740
4741
4742procedure TfrmODMeds.DispOrderMessage(const AMessage: string);
4743begin
4744 if ContainsVisibleChar(AMessage) then
4745 begin
4746 image1.Visible := True;
4747 memDrugMsg.Visible := True;
4748 image1.Picture.Icon.Handle := LoadIcon(0, IDI_ASTERISK);
4749 memDrugMsg.Lines.Clear;
4750 memDrugMsg.Lines.SetText(PChar(AMessage));
4751 if fShrinkDrugMsg then
4752 begin
4753 pnlBottom.Height := pnlBottom.Height + memDrugMsg.Height + 2;
4754 fShrinkDrugMsg := False;
4755 end;
4756 end else
4757 begin
4758 image1.Visible := False;
4759 memDrugMsg.Visible := False;
4760 if not fShrinkDrugMsg then
4761 begin
4762 pnlBottom.Height := pnlBottom.Height - memDrugMsg.Height - 2;
4763 fShrinkDrugMsg := True;
4764 end;
4765 end;
4766end;
4767
4768
4769procedure TfrmODMeds.FormClose(Sender: TObject; var Action: TCloseAction);
4770begin
4771 FResizedAlready := False;
4772 inherited;
4773end;
4774
4775function TfrmODMeds.CreateOtherScheduelComplex: string;
4776var
4777 aSchedule: string;
4778begin
4779 aSchedule := '';
4780 if not ShowOtherSchedule(aSchedule) then
4781 begin
4782 cboXSchedule.ItemIndex := -1;
4783 cboXSchedule.Text := '';
4784 end;
4785 Result := aSchedule;
4786end;
4787
4788procedure TfrmODMeds.txtNSSClick(Sender: TObject);
4789begin
4790 inherited;
4791//if MessageDlg('You can also select ' + '"' + 'Other' + '"' + ' from the schedule list' <-- original line. //kt 8/8/2007
4792 if MessageDlg(DKLangConstW('fODMeds_You_can_also_select')+' ' + '"' + DKLangConstW('fODMeds_Other') + '"' + DKLangConstW('fODMeds_from_the_schedule_list') //kt added 8/8/2007
4793// + ' to create a day-of-week schedule.' <-- original line. //kt 8/8/2007
4794 + DKLangConstW('fODMeds_to_create_a_dayxofxweek_schedulex') //kt added 8/8/2007
4795// + #13#10 + 'Click OK to launch schedule builder', <-- original line. //kt 8/8/2007
4796 + #13#10 + DKLangConstW('fODMeds_Click_OK_to_launch_schedule_builder'), //kt added 8/8/2007
4797 mtInformation, [mbOK, mbCancel],0) = mrOK then
4798 begin
4799 if (tabDose.TabIndex = TI_DOSE) then
4800 begin
4801 cboSchedule.SelectByID('OTHER');
4802 cboScheduleClick(Self);
4803 end;
4804 if (tabDose.TabIndex = TI_COMPLEX) then
4805 begin
4806 cboXSchedule.SelectByID('OTHER');
4807 CBOXScheduleChange(Self);
4808 end;
4809 end;
4810end;
4811
4812procedure TfrmODMeds.cboScheduleEnter(Sender: TObject);
4813begin
4814 inherited;
4815 if (FInptDlg) and (cboSchedule.Text = 'OTHER') then
4816 cboScheduleClick(Self);
4817end;
4818
4819procedure TfrmODMeds.FormShow(Sender: TObject);
4820begin
4821 inherited;
4822 if ( (cboSchedule.Text = 'OTHER') and FNSSOther and FInptDlg )then
4823 PostMessage(Handle, UM_NSSOTHER, 0, 0);
4824end;
4825
4826procedure TfrmODMeds.UMShowNSSBuilder(var Message: TMessage);
4827begin
4828 Sleep(1000);
4829 cboScheduleClick(Self);
4830end;
4831
4832procedure TfrmODMeds.cboScheduleExit(Sender: TObject);
4833begin
4834 inherited;
4835 if Trim(cboSchedule.Text) = '' then
4836 cboSchedule.ItemIndex := -1;
4837 ValidateInpatientSchedule(cboSchedule);
4838end;
4839
4840procedure TfrmODMeds.ValidateInpatientSchedule(ScheduleCombo: TORComboBox);
4841var
4842 tmpIndex : Integer;
4843begin
4844{CQ: 6690 - Orders - autopopulation of schedule field - overtyping only 1 character
4845 CQ: 7280 - PTM 32-34, 42 Meds: NJH-0205-20901 MED DIALOG DROPPING FIRST LETTER (schedule)}
4846
4847 //CQ 7575 Schedule coming across lower-case, change all schedules to Upper-Case.
4848 if (Length(ScheduleCombo.Text) > 0) then
4849 ScheduleCombo.Text := TrimLeft(UpperCase(ScheduleCombo.Text));
4850 {if user entered schedule verify it is in list}
4851 if ScheduleCombo.ItemIndex < 0 then // CQ: 7397
4852 begin //Fix for CQ: 9299 - Outpatient Med orders will not accept free text schedule
4853 tmpIndex := GetSchedListIndex(ScheduleCombo,ScheduleCombo.Text);
4854 if tmpIndex > -1 then
4855 ScheduleCombo.ItemIndex := tmpIndex;
4856 end;
4857 if (Length(ScheduleCombo.Text) > 0) and (ScheduleCombo.ItemIndex < 0) and FInptDlg then
4858 begin
4859 FShowPnlXScheduleOk := False; //Added for CQ: 7370
4860 //kt begin mod
4861 // Application.MessageBox('Please select a valid schedule from the list.'+#13+#13+ <-- original line. //kt 8/8/2007
4862 // 'If you would like to create a Day-of-Week schedule please'+ <-- original line. //kt 8/8/2007
4863 // ' select ''OTHER'' from the list.', <-- original line. //kt 8/8/2007
4864 // 'Incorrect Schedule.'); <-- original line. //kt 8/8/2007
4865 //kt MessageBox doesn't seem to support WideStrings.
4866 MessageDlg(DKLangConstW('fODMeds_Incorrect_Schedulex'),
4867 DKLangConstW('fODMeds_Please_select_a_valid_schedule_from_the_listx')+#13+#13+
4868 DKLangConstW('fODMeds_If_you_would_like_to_create_a_DayxofxWeek_schedule_please')+
4869 DKLangConstW('fODMeds_select_xxOTHERxx_from_the_listx'),
4870 mtCustom, [mbYes,mbNo], 0); //kt
4871 //kt end mod
4872 FShowPnlXScheduleOk := True; //Added for CQ: 7370
4873 if ScheduleCombo.CanFocus then
4874 ScheduleCombo.SetFocus;
4875 ScheduleCombo.SelStart := Length(ScheduleCombo.Text);
4876 end;
4877end;
4878
4879//Removed based on Site feeback. See CQ: 7518
4880(*function TfrmODMeds.ValidateRoute(RouteCombo: TORComboBox) : Boolean;
4881begin
4882{CQ: 7331 - Medications - Route - Can not enter any route not listed in Route field in window}
4883 Result := True;
4884 if (Length(RouteCombo.Text) > 0) and (RouteCombo.ItemIndex < 0) and (Not IsSupplyAndOutPatient) then
4885 begin
4886// Application.MessageBox('Please select a correct route from the list.', <-- original line. //kt 8/8/2007
4887 Application.MessageBox(DKLangConstW('fODMeds_Please_select_a_correct_route_from_the_listx'), //kt added 8/8/2007
4888// 'Incorrect Route.'); <-- original line. //kt 8/8/2007
4889 DKLangConstW('fODMeds_Incorrect_Routex')); //kt added 8/8/2007
4890 if RouteCombo.CanFocus then
4891 RouteCombo.SetFocus;
4892 RouteCombo.SelStart := Length(RouteCombo.Text);
4893 Result := False;
4894 end;
4895end;*)
4896
4897function TfrmODMeds.isUniqueQuickOrder(iText: string): Boolean;
4898var
4899 counter,i: Integer;
4900begin
4901 counter := 0;
4902 Result := False;
4903 if iText = '' then Exit;
4904 for i := 0 to FQuickItems.Count-1 do
4905 if AnsiCompareText(iText, Copy(Piece(FQuickItems[i],'^',2), 1, Length(iText))) = 0 then
4906 Inc(counter); //Found a Match
4907 Result := counter = 1;
4908end;
4909
4910function TfrmODMeds.IsSupplyAndOutPatient: boolean;
4911begin
4912{CQ: 7331 - Medications - Route - Can not enter any route not listed in Route field in window}
4913 Result := False;
4914 if (MedIsSupply(txtMed.Tag)) and (not FInptDlg) then
4915 Result := True;
4916end;
4917
4918// CQ: 7397 - Inpatient med orders with PRN cancel due to invalid schedule.
4919function TfrmODMeds.GetSchedListIndex(SchedCombo: TORComboBox; pSchedule: String):integer;
4920var i: integer;
4921begin
4922 result := -1;
4923 for i := 0 to SchedCombo.items.Count-1 do
4924 begin
4925 if pSchedule = SchedCombo.DisplayText[i] then
4926 begin
4927 result := i; // match found
4928 break;
4929 end;
4930 end;
4931end;
4932
4933
4934procedure TfrmODMeds.cboXScheduleExit(Sender: TObject);
4935begin
4936 inherited;
4937{CQ: 7344 - Inconsistency with Schedule box: Allows free-text entry for Complex orders,
4938 doesn't for simple orders }
4939 ValidateInpatientSchedule(cboXSchedule);
4940end;
4941
4942procedure TfrmODMeds.cboDosageKeyUp(Sender: TObject; var Key: Word;
4943 Shift: TShiftState);
4944begin
4945 inherited;
4946 //Fix for CQ: 7545
4947 if cboDosage.ItemIndex > -1 then
4948 cboDosageClick(Sender);
4949end;
4950
4951procedure TfrmODMeds.cboXDosageKeyUp(Sender: TObject; var Key: Word;
4952 Shift: TShiftState);
4953begin
4954 inherited;
4955 //Fix for CQ: 7545
4956 if cboXDosage.ItemIndex > -1 then
4957 cboXDosageClick(Sender);
4958end;
4959
4960procedure TfrmODMeds.txtSupplyClick(Sender: TObject);
4961begin
4962 inherited;
4963 Self.txtSupply.SelectAll;
4964end;
4965
4966procedure TfrmODMeds.txtQuantityClick(Sender: TObject);
4967begin
4968 inherited;
4969 self.txtQuantity.SelectAll;
4970end;
4971
4972procedure TfrmODMeds.txtRefillsClick(Sender: TObject);
4973begin
4974 inherited;
4975 self.txtRefills.SelectAll;
4976end;
4977
4978procedure TfrmODMeds.WMClose(var Msg: TWMClose);
4979begin
4980 if self <> nil then
4981 begin
4982 if (self.tabDose.TabIndex = TI_Dose) then
4983 begin
4984 if Trim(cboSchedule.Text) = '' then cboSchedule.ItemIndex := -1;
4985 ValidateInpatientSchedule(cboSchedule);
4986 if self.cboSchedule.Focused = true then exit;
4987 end;
4988 if (self.tabDose.TabIndex = TI_Complex) then
4989 begin
4990 ValidateInpatientSchedule(cboXSchedule);
4991 if self.cboXSchedule.Focused = true then exit;
4992 end;
4993 end;
4994 inherited
4995end;
4996
4997procedure TfrmODMeds.cboXScheduleEnter(Sender: TObject);
4998begin
4999 inherited;
5000 //agp Change CQ 10719
5001 self.chkXPRN.OnClick(self.chkXPRN);
5002end;
5003
5004end.
Note: See TracBrowser for help on using the repository browser.