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

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

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