source: cprs/trunk/CPRS-Chart/Orders/fODMeds.pas@ 1226

Last change on this file since 1226 was 829, checked in by Kevin Toppenberg, 14 years ago

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