source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/Orders/fODMeds.pas@ 1727

Last change on this file since 1727 was 1693, checked in by healthsevak, 10 years ago

Committing the files for first time to this new branch

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