source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fODMeds.pas@ 459

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

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