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

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

Adding foia-cprs branch
File size: 69.2 KB
Line 
1unit fODMedNVA;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 fODBase, StdCtrls, ComCtrls, ExtCtrls, ORCtrls, Grids, Buttons, uConst, ORDtTm,
8 Menus, XUDIGSIGSC_TLB, rMisc, uOrders, StrUtils, oRFn;
9
10const
11 UM_DELAYCLICK = 11037; // temporary for listview click event
12 NVA_CR = #13;
13 NVA_LF = #10;
14
15type
16 TfrmODMedNVA = class(TfrmODBase)
17 txtMed: TEdit;
18 pnlMeds: TPanel;
19 lstQuick: TCaptionListView;
20 sptSelect: TSplitter;
21 lstAll: TCaptionListView;
22 dlgStart: TORDateTimeDlg;
23 timCheckChanges: TTimer;
24 pnlFields: TPanel;
25 pnlTop: TPanel;
26 lblRoute: TLabel;
27 lblSchedule: TLabel;
28 lblGuideline: TStaticText;
29 tabDose: TTabControl;
30 cboDosage: TORComboBox;
31 cboRoute: TORComboBox;
32 cboSchedule: TORComboBox;
33 chkPRN: TCheckBox;
34 pnlBottom: TPanel;
35 lblComment: TLabel;
36 memComment: TCaptionMemo;
37 lblAdminTime: TStaticText;
38 calStart: TORDateBox;
39 Label1: TLabel;
40 lbStatements: TORListBox;
41 Label2: TLabel;
42 btnSelect: TButton;
43 procedure FormCreate(Sender: TObject);
44 procedure btnSelectClick(Sender: TObject);
45 procedure tabDoseChange(Sender: TObject);
46 procedure FormDestroy(Sender: TObject);
47 procedure txtMedKeyDown(Sender: TObject; var Key: Word;
48 Shift: TShiftState);
49 procedure txtMedKeyUp(Sender: TObject; var Key: Word;
50 Shift: TShiftState);
51 procedure txtMedChange(Sender: TObject);
52 procedure txtMedExit(Sender: TObject);
53 procedure ListViewEditing(Sender: TObject; Item: TListItem;
54 var AllowEdit: Boolean);
55 procedure ListViewResize(Sender: TObject);
56 procedure lstQuickData(Sender: TObject; Item: TListItem);
57 procedure lstAllDataHint(Sender: TObject; StartIndex,
58 EndIndex: Integer);
59 procedure lstAllData(Sender: TObject; Item: TListItem);
60 procedure lblGuidelineClick(Sender: TObject);
61 procedure ListViewClick(Sender: TObject);
62 procedure cboScheduleExit(Sender: TObject);
63 procedure cboScheduleChange(Sender: TObject);
64 procedure cboRouteChange(Sender: TObject);
65 procedure ControlChange(Sender: TObject);
66 procedure cboDosageClick(Sender: TObject);
67 procedure cboDosageChange(Sender: TObject);
68 procedure cboScheduleClick(Sender: TObject);
69 procedure cboRouteExit(Sender: TObject);
70
71
72
73 procedure grdDosesExit(Sender: TObject);
74 procedure ListViewEnter(Sender: TObject);
75 procedure timCheckChangesTimer(Sender: TObject);
76 procedure cmdAcceptClick(Sender: TObject);
77 procedure cboDosageExit(Sender: TObject);
78 procedure chkPRNClick(Sender: TObject);
79 procedure grdDosesKeyDown(Sender: TObject; var Key: Word;
80 Shift: TShiftState);
81 procedure grdDosesEnter(Sender: TObject);
82 procedure pnlMessageEnter(Sender: TObject);
83 procedure pnlMessageExit(Sender: TObject);
84 procedure memMessageKeyDown(Sender: TObject; var Key: Word;
85 Shift: TShiftState);
86 procedure FormResize(Sender: TObject);
87 procedure lbStatementsClickCheck(Sender: TObject; Index: Integer);
88 procedure lstChange(Sender: TObject; Item: TListItem;
89 Change: TItemChange);
90 procedure FormKeyPress(Sender: TObject; var Key: Char);
91 private
92 {selection}
93 FAllItems: TStringList;
94 FAllFirst: Integer;
95 FAllLast: Integer;
96 FAllList: Integer;
97 FQuickList: Integer;
98 FQuickItems: TStringList;
99 FChangePending: Boolean;
100 FKeyTimerActive: Boolean;
101 FActiveMedList: TListView;
102 FRowHeight: Integer;
103 FFromSelf: Boolean;
104 {edit}
105 FAllDoses: TStringList;
106 FAllDrugs: TStringList;
107 FGuideline: TStringList;
108 FLastUnits: string;
109 FLastSchedule: string;
110 FLastDispDrug: string;
111 FLastQuantity: Integer;
112 FLastSupply: Integer;
113 FLastPickup: string;
114 FSIGVerb: string;
115 FSIGPrep: string;
116 FDrugID: string;
117 fInptDlg: Boolean;
118 FNonVADlg: Boolean;
119 FUpdated: Boolean;
120 FSuppressMsg: Boolean;
121 FPtInstruct: string;
122 FAltChecked: Boolean;
123 FQOQuantity: Double;
124 FQODosage: string;
125 FNoZERO: boolean;
126 FIsQuickOrder: boolean;
127 FAdminTimeLbl: string;
128 FDisabledDefaultButton: TButton;
129 FDisabledCancelButton: TButton;
130 FShrinked: boolean;
131 FRemoveText : Boolean;
132 {selection}
133 procedure ChangeDelayed;
134 procedure LoadNonVAMedCache(First, Last: Integer);
135 function FindQuickOrder(const x: string): Integer;
136 function isUniqueQuickOrder(iText: string): Boolean;
137 procedure ScrollToVisible(AListView: TListView);
138 procedure StartKeyTimer;
139 procedure StopKeyTimer;
140 procedure WMTimer(var Message: TWMTimer); message WM_TIMER;
141 // NON VA MEDS
142 procedure LoadOTCStatements(Dest: TStrings);
143
144 {edit}
145 procedure ResetOnMedChange;
146 procedure SetOnMedSelect;
147 procedure SetOnQuickOrder;
148 procedure ShowMedSelect;
149 procedure ShowMedFields;
150 procedure ShowControlsSimple;
151 procedure SetDosage(const x: string);
152 procedure SetStatements(x: string);
153 procedure SetStartDate(const x: string);
154 procedure SetSchedule(const x: string);
155 procedure CheckFormAltDose(DispDrug: Integer);
156 function ConstructedDoseFields(const ADose: string; PrependName: Boolean = FALSE): string;
157 function FindCommonDrug(DoseList: TStringList): string;
158 function FindDoseFields(const Drug, ADose: string): string;
159 function OutpatientSig: string;
160 function SearchStatements(StatementList:TStringList;Statement: string): Boolean;
161 procedure UpdateRelated(DelayUpdate: Boolean = TRUE);
162 procedure UpdateStartExpires(const CurSchedule: string);
163 function DisableDefaultButton(Control: TWinControl): boolean;
164 function DisableCancelButton(Control: TWinControl): boolean;
165 procedure RestoreDefaultButton;
166 procedure RestoreCancelButton;
167 function ValueOf(FieldID: Integer; ARow: Integer = -1): string;
168 function ValueOfResponse(FieldID: Integer; AnInstance: Integer = 1): string;
169 procedure UMDelayClick(var Message: TMessage); message UM_DELAYCLICK;
170
171 protected
172 procedure InitDialog; override;
173 procedure Validate(var AnErrMsg: string); override;
174 public
175 procedure SetupDialog(OrderAction: Integer; const ID: string); override;
176 procedure CheckDecimal(var AStr: string);
177 end;
178
179var
180 frmODMedNVA: TfrmODMedNVA;
181 crypto: IXuDigSigS;
182
183function OIForNVA(AnIEN: Integer; ForNonVAMed: Boolean; HavePI: boolean = True; PKIActive: Boolean = False): TStrings;
184procedure CheckAuthForNVAMeds(var x: string);
185
186implementation
187
188{$R *.DFM}
189
190uses rCore, uCore, rODMeds, rODBase, rOrders, fRptBox, fODMedOIFA,
191 uAccessibleStringGrid, fFrame, ORNet;
192
193const
194 {grid columns for complex dosing }
195 COL_SELECT = 0;
196 COL_DOSAGE = 1;
197 COL_ROUTE = 2;
198 COL_SCHEDULE = 3;
199 COL_DURATION = 4;
200
201 COL_SEQUENCE = 5;
202 VAL_DOSAGE = 10;
203 VAL_ROUTE = 20;
204 VAL_SCHEDULE = 30;
205 VAL_DURATION = 40;
206 VAL_SEQUENCE = 50;
207 TAB = #9;
208 {field identifiers}
209 FLD_LOCALDOSE = 1;
210 FLD_STRENGTH = 2;
211 FLD_DRUG_ID = 3;
212 FLD_DRUG_NM = 4;
213 FLD_DOSEFLDS = 5;
214 FLD_UNITNOUN = 6;
215 FLD_TOTALDOSE = 7;
216 FLD_DOSETEXT = 8;
217 FLD_INSTRUCT = 10;
218 FLD_DOSEUNIT = 11;
219 FLD_ROUTE_ID = 15;
220 FLD_ROUTE_NM = 16;
221 FLD_ROUTE_AB = 17;
222 FLD_ROUTE_EX = 18;
223 FLD_SCHEDULE = 20;
224 FLD_SCHED_EX = 21;
225 FLD_SCHED_TYP = 22;
226 FLD_DURATION = 30;
227 FLD_SEQUENCE = 31;
228 FLD_MISC_FLDS = 50;
229 FLD_SUPPLY = 51;
230 FLD_QUANTITY = 52;
231 FLD_REFILLS = 53;
232 FLD_PICKUP = 55;
233 FLD_QTYDISP = 56;
234 FLD_SC = 58;
235 FLD_PRIOR_ID = 60;
236 FLD_PRIOR_NM = 61;
237 FLD_START_ID = 70;
238 FLD_START_NM = 71;
239 FLD_EXPIRE = 72;
240 FLD_ANDTHEN = 73;
241 FLD_NOW_ID = 75;
242 FLD_NOW_NM = 76;
243 FLD_COMMENT = 80;
244 FLD_PTINSTR = 85;
245 FLD_START = 88;
246 FLD_STATEMENTS = 90;
247 {dosage type tab index values}
248 TI_DOSE = 0;
249 TI_RATE = 99;
250 TI_COMPLEX = 1;
251 {misc constants}
252 TIMER_ID = 6902; // arbitrary number
253 TIMER_DELAY = 500; // 500 millisecond delay
254 TIMER_FROM_DAYS = 1;
255 TIMER_FROM_QTY = 2;
256 {text constants}
257 TX_ADMIN = 'Requested Start: ';
258 TX_TAKE = '';
259 TX_NO_DEA = 'Provider must have a DEA# or VA# to order this medication';
260 TC_NO_DEA = 'DEA# Required';
261 TX_NO_MED = 'Medication must be selected.';
262 TX_NO_DOSE = 'Dosage must be entered.';
263 TX_DOSE_NUM = 'Dosage may not be numeric only';
264 TX_DOSE_LEN = 'Dosage may not exceed 60 characters';
265 TX_NO_ROUTE = 'Route must be entered.';
266 TX_NF_ROUTE = 'Route not found in the Medication Routes file.';
267 TX_NO_SCHED = 'Schedule must be entered.';
268 TX_NO_PICK = 'A method for picking up the medication must be entered.';
269 TX_RNG_REFILL = 'The number of refills must be in the range of 0 through ';
270 TX_SCH_QUOTE = 'Schedule must not have quotemarks in it.';
271 TX_SCH_MINUS = 'Schedule must not have a dash at the beginning.';
272 TX_SCH_SPACE = 'Schedule must have only one space in it.';
273 TX_SCH_LEN = 'Schedule must be less than 70 characters.';
274 TX_SCH_PRN = 'Schedule cannot include PRN - use Comments to enter PRN.';
275 TX_SCH_ZERO = 'Schedule cannot be Q0';
276 TX_SCH_LSP = 'Schedule may not have leading spaces.';
277 TX_SCH_NS = 'Unable to resolve non-standard schedule.';
278 TX_MAX_STOP = 'The maximum expiration for this order is ';
279 TX_OUTPT_IV = 'This patient has not been admitted. Only IV orders may be entered.';
280 TX_QTY_NV = 'Unable to validate quantity.';
281 TX_QTY_MAIL = 'Quantity for mailed items must be a whole number.';
282 TX_SUPPLY_LIM = 'Days Supply may not be greater than 90.';
283 TX_SUPPLY_LIM1 = 'Days Supply may not be less than 1.';
284 TX_SUPPLY_NINT= 'Days Supply is an invalid number.';
285 TC_RESTRICT = 'Ordering Restrictions';
286 TC_GUIDELINE = 'Restrictions/Guidelines';
287 TX_QTY_PRE = '>> Quantity Dispensed: ';
288 TX_QTY_POST = ' <<';
289 TX_STARTDT = 'Unable to interpret start date.'; //cla 7-17-03
290 TX_FUTUREDT = 'Dates in the future are not allowed.'; //cla 7-17-03
291 TX_NO_FUTURE_DATES = 'Dates in the future are not allowed.';
292 TX_BAD_DATE = 'Dates must be in the format mm/dd/yy or mm/yy';
293
294
295{ procedures inherited from fODBase --------------------------------------------------------- }
296
297procedure TfrmODMedNVA.FormCreate(Sender: TObject);
298const
299 TC_RESTRICT = 'Ordering Restrictions';
300var
301 ListCount: Integer;
302 Restriction, x : string;
303begin
304 AutoSizeDisabled := True;
305 // ActivateOrderDialog(Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
306 inherited;
307 if User.OrderRole in[OR_CLERK] then // if user is clerk check restrictions else ok to write NonVA Order.
308 begin
309 CheckAuthForNVAMeds(Restriction);
310 if Length(Restriction) > 0 then
311 begin
312 InfoBox(Restriction, TC_RESTRICT, MB_OK);
313 Close;
314 Exit;
315 end;
316 end;
317
318 if DlgFormID = OD_MEDNONVA then FNonVADlg := TRUE;
319 FillerID := 'PSH'; // CLA 6/3/03
320 FGuideline := TStringList.Create;
321 FAllDoses := TStringList.Create;
322 FAllDrugs := TStringList.Create;
323 StatusText('Loading Dialog Definition');
324
325 Responses.Dialog := 'PSH OERR'; // CLA 6/3/03
326 Responses.SetPromptFormat('INSTR', '@');
327 StatusText('Loading Schedules');
328 LoadSchedules(cboSchedule.Items); // load the schedules combobox (cached)
329 StatusText('');
330 FSuppressMsg := CtrlInits.DefaultText('DispMsg') = '1';
331 InitDialog;
332
333 // medication selection
334 FRowHeight := MainFontHeight + 1;
335 x := 'NV RX'; // CLA 6/3/03
336 ListForOrderable(FAllList, ListCount, x);
337 lstAll.Items.Count := ListCount;
338 FAllItems := TStringList.Create;
339 FAllFirst := -1;
340 FAllLast := -1;
341 FQuickItems := TStringList.Create;
342 ListForQuickOrders(FQuickList, ListCount, x);
343 if ListCount > 0 then
344 begin
345 lstQuick.Items.Count := ListCount;
346 SubsetOfQuickOrders(FQuickItems, FQuickList, 0, 0);
347 FActiveMedList := lstQuick;
348 end else
349 begin
350 lstQuick.Items.Count := 1;
351 ListCount := 1;
352 FQuickItems.Add('0^(No quick orders available)');
353 FActiveMedList := lstAll;
354 end;
355
356 // set the height based on user parameter here
357 with lstQuick do if ListCount < VisibleRowCount
358 then Height := (((Height - 6) div VisibleRowCount) * ListCount) + 6;
359 pnlFields.Height := cmdAccept.Top - 4 - pnlFields.Top;
360 FNoZero := False;
361 FShrinked := False;
362 // Load OTC Statement/Explanations
363 LoadOTCStatements(lbStatements.Items);
364 FRemoveText := True;
365end;
366
367procedure TfrmODMedNVA.FormDestroy(Sender: TObject);
368begin
369 {selection}
370 FQuickItems.Free;
371 FAllItems.Free;
372 {edit}
373 FGuideline.Free;
374 FAllDoses.Free;
375 FAllDrugs.Free;
376 // TAccessibleStringGrid.UnwrapControl(grdDoses);
377 inherited;
378end;
379
380procedure TfrmODMedNVA.InitDialog;
381{ Executed each time dialog is reset after pressing accept. Clears controls & responses }
382begin
383 inherited;
384 FLastPickup := ValueOf(FLD_PICKUP);
385 Changing := True;
386 ResetOnMedChange;
387 txtMed.Text := '';
388 txtMed.Tag := 0;
389 lstQuick.Selected := nil;
390 lstAll.Selected := nil;
391 if Visible then ShowMedSelect;
392 Changing := False;
393 FIsQuickOrder := False;
394 FQOQuantity := 0 ;
395 FQODosage := '';
396 memComment.Clear; // sometimes the sig is in the comment
397 LoadOTCStatements(lbStatements.Items);
398
399end;
400
401procedure TfrmODMedNVA.SetupDialog(OrderAction: Integer; const ID: string);
402var
403 OrderID: string;
404begin
405 inherited;
406 // if FInptDlg and (not FOutptIV) then DisplayGroup := DisplayGroupByName('UD RX')
407 DisplayGroup := DisplayGroupByName('NV RX'); // CLA 6/3/03
408 if XfInToOutNow then DisplayGroup := DisplayGroupByName('O RX');
409 if CharAt(ID,1)='X' then
410 begin
411 OrderID := Copy(Piece(ID, ';', 1), 2, Length(ID));
412 CheckExistingPI(OrderID, FPtInstruct);
413 end;
414 if OrderAction = ORDER_QUICK then
415 FIsQuickOrder := True
416 else
417 FIsQuickOrder := False;
418// if OrderAction in [ORDER_COPY, ORDER_EDIT] then Responses.Remove('START', 1);
419 if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then
420 begin
421 Changing := True;
422 txtMed.Tag := StrToIntDef(Responses.IValueFor('ORDERABLE', 1), 0);
423 SetOnMedSelect;
424 SetOnQuickOrder; // set up for this medication
425 ShowMedFields;
426 if (OrderAction = ORDER_EDIT) and OrderIsReleased(Responses.EditOrder)
427 then btnSelect.Enabled := False;
428 UpdateRelated(FALSE);
429 Changing := False;
430 end;
431
432 ControlChange(Self);
433end;
434
435procedure TfrmODMedNVA.Validate(var AnErrMsg: string);
436var
437 i: Integer;
438 StartDate: TFMDateTime;
439
440 procedure SetError(const x: string);
441 begin
442 if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
443 AnErrMsg := AnErrMsg + x;
444 end;
445
446 procedure ValidateDosage(const x: string);
447 begin
448 if Length(x) = 0 then SetError(TX_NO_DOSE);
449 end;
450
451 procedure ValidateRoute(const x: string; NeedLookup: Boolean; AnInstance: Integer);
452 var
453 RouteID, RouteAbbr: string;
454 begin
455 if (Length(x) = 0) and (not MedIsSupply(txtMed.Tag)) then SetError(TX_NO_ROUTE);
456 if (Length(x) > 0) and NeedLookup then
457 begin
458 LookupRoute(x, RouteID, RouteAbbr);
459 if RouteID = '0'
460 then SetError(TX_NF_ROUTE)
461 else Responses.Update('ROUTE', AnInstance, RouteID, RouteAbbr);
462 end;
463 end;
464
465 procedure ValidateSchedule(const x: string; AnInstance: Integer);
466 const
467 SCH_BAD = 0;
468 SCH_NO_RTN = -1;
469 var
470 ValidLevel: Integer;
471 ARoute, ADrug: string;
472 begin
473 ARoute := ValueOfResponse(FLD_ROUTE_ID, AnInstance);
474 ADrug := ValueOfResponse(FLD_DRUG_ID, AnInstance);
475 { if (Length(x) = 0) and (not FNonVADlg) then SetError(TX_NO_SCHED)
476 else if (Length(x) = 0) and FNonVADlg and ScheduleRequired(txtMed.Tag, ARoute, ADrug)
477 then SetError(TX_NO_SCHED);
478}
479 if Length(x) > 0 then
480 begin
481 ValidLevel := ValidSchedule(x, 'O');
482 if ValidLevel = SCH_NO_RTN then
483 begin
484 if Pos('"', x) > 0 then SetError(TX_SCH_QUOTE);
485 if Copy(x, 1, 1) = '-' then SetError(TX_SCH_MINUS);
486 if Pos(' ', Copy(x, Pos(' ', x) + 1, 999)) > 0 then SetError(TX_SCH_SPACE);
487 if Length(x) > 70 then SetError(TX_SCH_LEN);
488 if (Pos('P RN', x) > 0) or (Pos('PR N', x) > 0) then SetError(TX_SCH_PRN);
489 if Pos('Q0', x) > 0 then SetError(TX_SCH_ZERO);
490 if TrimLeft(x) <> x then SetError(TX_SCH_LSP);
491 end;
492 if ValidLevel = SCH_BAD then SetError(TX_SCH_NS);
493 end;
494 end;
495
496begin
497 inherited;
498 begin
499 AnErrMsg := '';
500 if User.NoOrdering then AnErrMsg := 'Ordering has been disabled. Press Quit';
501
502 ControlChange(Self); // make sure everything is updated
503 if txtMed.Tag = 0 then SetError(TX_NO_MED);
504 if Responses.InstanceCount('INSTR') < 1 then SetError(TX_NO_DOSE);
505 i := Responses.NextInstance('INSTR', 0);
506 while i > 0 do
507 begin
508 { if (ValueOfResponse(FLD_DRUG_ID, i) = '') then
509 begin
510 if not ContainsAlpha(Responses.IValueFor('INSTR', i)) then SetError(TX_DOSE_NUM);
511 if Length(Responses.IValueFor('INSTR', i)) > 60 then SetError(TX_DOSE_LEN);
512 end;
513 ValidateRoute(Responses.EValueFor('ROUTE', i), Responses.IValueFor('ROUTE', i) = '', i);
514 ValidateSchedule(ValueOfResponse(FLD_SCHEDULE, i), i);
515 }
516 i := Responses.NextInstance('INSTR', i);
517 // inherited; - do not reject past dates - historical would not be allowed
518
519 if calStart.Text <> '' then
520 begin
521 StartDate := ValidDateTimeStr(calStart.Text,'TS');
522 if StartDate > FMNow then SetError(TX_NO_FUTURE_DATES);
523 if StartDate < 0 then SetError(TX_BAD_DATE);
524 end;
525 end;
526 end;
527end;
528
529
530{ Navigate medication selection lists ------------------------------------------------------- }
531
532{ txtMed methods (including timers) }
533
534procedure TfrmODMedNVA.WMTimer(var Message: TWMTimer);
535begin
536 inherited;
537 if (Message.TimerID = TIMER_ID) then
538 begin
539 StopKeyTimer;
540 ChangeDelayed;
541 end;
542end;
543
544procedure TfrmODMedNVA.StartKeyTimer;
545{ start (or restart) a timer (done on keyup to delay before calling OnKeyPause) }
546var
547 ATimerID: Integer;
548begin
549 StopKeyTimer;
550 ATimerID := SetTimer(Handle, TIMER_ID, TIMER_DELAY, nil);
551 FKeyTimerActive := ATimerID > 0;
552 // if can't get a timer, just call the event immediately F
553 if not FKeyTimerActive then Perform(WM_TIMER, TIMER_ID, 0);
554end;
555
556procedure TfrmODMedNVA.StopKeyTimer;
557{ stop the timer (done whenever a key is pressed or the combobox no longer has focus) }
558begin
559 if FKeyTimerActive then
560 begin
561 KillTimer(Handle, TIMER_ID);
562 FKeyTimerActive := False;
563 end;
564end;
565
566procedure TfrmODMedNVA.txtMedKeyDown(Sender: TObject; var Key: Word;
567 Shift: TShiftState);
568var
569 i: Integer;
570 x: string;
571begin
572 if Key in [VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN] then // navigation
573 begin
574 FActiveMedList.Perform(WM_KEYDOWN, Key, 0);
575 FFromSelf := True;
576 txtMed.Text := FActiveMedList.Selected.Caption;
577 txtMed.SelectAll;
578 FFromSelf := False;
579 Key := 0;
580 end
581 else if Key = VK_BACK then
582 begin
583 FFromSelf := True;
584 x := txtMed.Text;
585 i := txtMed.SelStart;
586 if i > 1 then Delete(x, i + 1, Length(x)) else x := '';
587 txtMed.Text := x;
588 if i > 1 then txtMed.SelStart := i;
589 FFromSelf := False;
590 end
591 else {StartKeyTimer};
592end;
593
594procedure TfrmODMedNVA.txtMedKeyUp(Sender: TObject; var Key: Word;
595 Shift: TShiftState);
596begin
597 if not (Key in [VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN]) then StartKeyTimer;
598end;
599
600procedure TfrmODMedNVA.txtMedChange(Sender: TObject);
601begin
602 if FFromSelf then Exit;
603 FChangePending := True;
604end;
605
606procedure TfrmODMedNVA.ScrollToVisible(AListView: TListView);
607var
608 Offset: Integer;
609begin
610 AListView.Selected.MakeVisible(FALSE);
611 Offset := AListView.Selected.Index - AListView.TopItem.Index;
612 Application.ProcessMessages;
613 if Offset > 0 then AListView.Scroll(0, (Offset * FRowHeight));
614 Application.ProcessMessages;
615end;
616
617procedure TfrmODMedNVA.ChangeDelayed;
618var
619 QuickIndex, AllIndex: Integer;
620 NewText, OldText, UserText: string;
621 UniqueText: Boolean;
622begin
623 FRemoveText := False;
624 UniqueText := False;
625 FChangePending := False;
626 if (Length(txtMed.Text) > 0) and (txtMed.SelStart = 0) then Exit; // don't lookup null
627 // lookup item in appropriate list box
628 NewText := '';
629 UserText := Copy(txtMed.Text, 1, txtMed.SelStart);
630 QuickIndex := FindQuickOrder(UserText);
631 AllIndex := IndexOfOrderable(FAllList, UserText); // but always synch the full list
632 if UserText <> Copy(txtMed.Text, 1, txtMed.SelStart) then Exit; // if typing during lookup
633 if AllIndex > -1 then
634 begin
635 lstAll.Selected := lstAll.Items[AllIndex];
636 FActiveMedList := lstAll;
637 end;
638 if QuickIndex > -1 then
639 begin
640 try
641 lstQuick.Selected := lstQuick.Items[QuickIndex];
642 lstQuick.ItemFocused := lstQuick.Selected;
643 NewText := lstQuick.Selected.Caption;
644 FActiveMedList := lstQuick;
645 //Search Quick List for Uniqueness
646 UniqueText := isUniqueQuickOrder(UserText);
647 except
648 //doing nothing short term solution related to 117
649 end;
650 end
651 else if AllIndex > -1 then
652 begin
653 lstAll.Selected := lstAll.Items[AllIndex];
654 lstAll.ItemFocused := lstAll.Selected;
655 NewText := lstAll.Selected.Caption;
656 lstQuick.Selected := nil;
657 FActiveMedList := lstAll;
658 //List is alphabetical, So compare next Item in list to establish uniqueness.
659 if CompareText(UserText, Copy(lstAll.Items[AllIndex+1].Caption, 1, Length(UserText))) <> 0 then
660 UniqueText := True;
661 end
662 else
663 begin
664 lstQuick.Selected := nil;
665 lstAll.Selected := nil;
666 FActiveMedList := lstAll;
667 NewText := txtMed.Text;
668 end;
669 if (AllIndex > -1) and (QuickIndex > -1) then //Not Unique Between Lists
670 UniqueText := False;
671 FFromSelf := True;
672 if UniqueText then
673 begin
674 OldText := Copy(txtMed.Text, 1, txtMed.SelStart);
675 txtMed.Text := NewText;
676 //txtMed.SelStart := Length(OldText); // v24.14 RV
677 txtMed.SelStart := Length(UserText); // v24.14 RV
678 txtMed.SelLength := Length(NewText);
679 end
680 else begin
681 txtMed.Text := UserText;
682 txtMed.SelStart := Length(txtMed.Text);
683 end;
684 FFromSelf := False;
685 if lstAll.Selected <> nil then
686 ScrollToVisible(lstAll);
687 if lstQuick.Selected <> nil then
688 ScrollToVisible(lstQuick);
689 if Not UniqueText then
690 begin
691 lstQuick.ItemIndex := -1;
692 lstAll.ItemIndex := -1;
693 end;
694 FRemoveText := True;
695end;
696
697procedure TfrmODMedNVA.txtMedExit(Sender: TObject);
698begin
699 StopKeyTimer;
700 if not ((ActiveControl = lstAll) or (ActiveControl = lstQuick)) then ChangeDelayed;
701end;
702
703{ lstAll & lstQuick methods }
704
705procedure TfrmODMedNVA.ListViewEnter(Sender: TObject);
706begin
707 inherited;
708 FActiveMedList := TListView(Sender);
709 with Sender as TListView do
710 begin
711 if Selected = nil then Selected := TopItem;
712 if Name = 'lstQuick' then lstAll.Selected := nil else lstQuick.Selected := nil;
713 ItemFocused := Selected;
714 end;
715end;
716
717procedure TfrmODMedNVA.ListViewClick(Sender: TObject);
718begin
719 inherited;
720 btnSelect.Visible := True;
721 btnSelect.Enabled := True;
722 //txtMed.Text := FActiveMedList.Selected.Caption;
723 PostMessage(Handle, UM_DELAYCLICK, 0, 0);
724end;
725
726procedure TfrmODMedNVA.UMDelayClick(var Message: TMessage);
727begin
728 btnSelectClick(Self);
729end;
730
731procedure TfrmODMedNVA.ListViewEditing(Sender: TObject; Item: TListItem;
732 var AllowEdit: Boolean);
733begin
734 AllowEdit := FALSE;
735end;
736
737procedure TfrmODMedNVA.ListViewResize(Sender: TObject);
738begin
739 with Sender as TListView do Columns.Items[0].Width := ClientWidth - 20;
740end;
741
742{ lstAll Methods (lstAll is TListView) }
743
744procedure TfrmODMedNVA.LoadNonVAMedCache(First, Last: Integer);
745const
746 MAX_CACHE_ITEMS = 1000;
747begin
748 // if range is within cache range we don't need to update anything
749 if (First >= FAllFirst) and (Last <= FAllLast) then Exit;
750 // if range is outside of cache or a superset of cache, start over
751 if (Last < Pred(FAllFirst)) or (First > Succ(FAllLast)) or
752 ((First < FAllFirst) and (Last > FAllLast)) or
753 (FAllItems.Count > MAX_CACHE_ITEMS) then
754 begin
755 FAllItems.Clear;
756 FAllFirst := -1;
757 FAllLast := -1;
758 end;
759 // if getting items immediately before cache range
760 if (First < FAllFirst) and (Last >= FAllFirst) then Last := Pred(FAllFirst);
761 // if getting items immediately after cache range
762 if (Last > FAllLast) and (First <= FAllLast) then First := Succ(FAllLast);
763 // retrieve the items and append (First>FAllLast) or prepend them to FAllItems
764 SubsetOfOrderable(FAllItems, First>FAllLast, FAllList, First, Last);
765 // reset FAllFirst & FAllLast indexes to reflect current FAllItems
766 if FAllFirst < 0 then FAllFirst := First;
767 if FAllLast < 0 then FAllLast := Last;
768 if First < FAllFirst then FAllFirst := First;
769 if Last > FAllLast then FAllLast := Last;
770end;
771
772procedure TfrmODMedNVA.lstAllData(Sender: TObject; Item: TListItem);
773var
774 x: string;
775begin
776 if (FAllFirst = -1) or (Item.Index < FAllFirst) or (Item.Index > FAllLast)
777 then LoadNonVAMedCache(Item.Index, Item.Index);
778 x := FAllItems[Item.Index - FAllFirst];
779 Item.Caption := Piece(x, U, 2);
780 Item.Data := Pointer(StrToIntDef(Piece(x, U, 1), 0));
781end;
782
783procedure TfrmODMedNVA.lstAllDataHint(Sender: TObject; StartIndex,
784 EndIndex: Integer);
785begin
786 LoadNonVAMedCache(StartIndex, EndIndex);
787end;
788
789{ Medication is now selected ---------------------------------------------------------------- }
790
791procedure TfrmODMedNVA.btnSelectClick(Sender: TObject);
792var
793 MedIEN: Integer;
794 MedName: string;
795 QOQuantityStr: string;
796 ErrMsg: string;
797begin
798 inherited;
799 QOQuantityStr := '';
800 btnSelect.SetFocus; // let the exit events finish
801 if pnlMeds.Visible then // display the medication fields
802 begin
803 Changing := True;
804 ResetOnMedChange;
805 if (FActiveMedList = lstAll) and (lstAll.Selected <> nil) then // orderable item
806 begin
807 MedIEN := Integer(lstAll.Selected.Data);
808 MedName := lstAll.Selected.Caption;
809 txtMed.Tag := MedIEN;
810 ErrMsg := '';
811 IsActivateOI(ErrMsg, txtMed.Tag);
812 if Length(ErrMsg)>0 then
813 begin
814 btnSelect.Enabled := False;
815 ShowMessage(ErrMsg);
816 Exit;
817 end;
818
819 { if Pos(' NF', MedName) > 0 then
820 begin
821 CheckFormularyOI(MedIEN, MedName, FNonVADlg);
822 FAltChecked := True;
823 end;
824 }
825 if MedIEN <> txtMed.Tag then
826 begin
827 txtMed.Tag := MedIEN;
828 txtMed.Text := MedName;
829 end;
830 SetOnMedSelect;
831 ShowMedFields;
832 end
833 else // no selection
834 begin
835 MessageBeep(0);
836 Exit;
837 end;
838 UpdateRelated(False);
839 Changing := False;
840 ControlChange(Self);
841 end
842 else ShowMedSelect; // show the selection fields
843 FNoZERO := False;
844
845end;
846
847procedure TfrmODMedNVA.ResetOnMedChange;
848begin
849 cboDosage.Items.Clear;
850 cboDosage.Text := '';
851 cboRoute.Items.Clear;
852 cboRoute.Text := '';
853 cboRoute.Hint := cboRoute.Text;
854 ResetControl(cboSchedule); /// cla 2/26/04
855 Responses.Clear;
856end;
857
858procedure TfrmODMedNVA.SetOnMedSelect;
859var
860 i,j: Integer;
861 x: string;
862 QOPiUnChk: boolean;
863 PKIEnviron: boolean;
864begin
865 // clear controls?
866 cboDosage.Tag := -1;
867 QOPiUnChk := False;
868 PKIEnviron := False;
869 if GetPKISite and GetPKIUse then //PKI check for crypto object on workstation
870 begin
871 try //PKI object creation
872 crypto := CoXuDigSigS.Create;
873 crypto.GetCSP;
874 StatusText(crypto.Reason);
875 PKIEnviron := True;
876 except
877 on E: Exception do
878 begin
879 {ShowMessage('An error has been encountered while trying to create PKI environment: '+ E.Message +
880 '. This order will be processed without Digital Signature encryption.');}
881 PKIEnviron := False;
882 end;
883 end;
884 crypto := nil;
885 end;
886 if PKIEnviron = False then
887 if GetPKISite then PKIEnviron := True;
888 with CtrlInits do
889 begin
890 // set up CtrlInits for orderable item
891 LoadOrderItem(OIForNVA(txtMed.Tag, FNonVADlg, IncludeOIPI, PKIEnviron));
892 // set up lists & initial values based on orderable item
893 SetControl(txtMed, 'Medication');
894 SetControl(cboDosage, 'Dosage');
895 SetControl(cboRoute, 'Route');
896 SetControl(calStart, 'START'); //cla 7-17-03
897 if cboRoute.Items.Count = 1 then cboRoute.ItemIndex := 0;
898 cboRouteChange(Self);
899 x := DefaultText('Schedule');
900 if x <> '' then
901 begin
902 cboSchedule.SelectByID(x);
903 cboSchedule.Text := x;
904 end;
905 if Length(ValueOf(FLD_QTYDISP))>10 then
906 begin
907 end;
908 FAllDoses.Text := TextOf('AllDoses');
909 FAllDrugs.Text := TextOf('Dispense');
910 FGuideline.Text := TextOf('Guideline');
911 case FGuideline.Count of
912 0: lblGuideline.Visible := False;
913 1: begin
914 lblGuideline.Caption := FGuideline[0];
915 lblGuideline.Visible := TRUE;
916 end;
917 else begin
918 lblGuideline.Caption := 'Display Restrictions/Guidelines';
919 lblGuideline.Visible := TRUE;
920 end;
921 end;
922
923 DEASig := '';
924 if GetPKISite then DEASig := DefaultText('DEASchedule');
925 FSIGVerb := DefaultText('Verb');
926 if Length(FSIGVerb) = 0 then FSIGVerb := TX_TAKE;
927 FSIGPrep := DefaultText('Preposition');
928 for j := 0 to Responses.TheList.Count - 1 do
929 begin
930 if (TResponse(Responses.theList[j]).PromptID = 'PI') and (TResponse(Responses.theList[j]).EValue = ' ') then
931 QOPiUnChk := True;
932 end;
933 FPtInstruct := TextOf('PtInstr');
934 for i := 1 to Length(FPtInstruct) do if Ord(FPtInstruct[i]) < 32 then FPtInstruct[i] := ' ';
935 FPtInstruct := TrimRight(FPtInstruct);
936 if Length(FPtInstruct) > 0 then
937 begin
938 if FShrinked then
939 begin
940 FShrinked := False;
941 end;
942 if QOPiUnChk then
943 end else
944 begin
945 if not FShrinked then
946 begin
947 FShrinked := True;
948 end;
949 end;
950 // end;
951 pnlMessage.TabOrder := cboDosage.TabOrder + 1;
952 OrderMessage(TextOf('Message'));
953 end;
954end;
955
956procedure TfrmODMedNVA.SetOnQuickOrder;
957var
958 AResponse: TResponse;
959 x,LocRoute,TempSch,DispGrp: string;
960 i, DispDrug: Integer;
961begin
962 // txtMed already set by SetOnMedSelect
963 with Responses do
964 begin
965 if (InstanceCount('INSTR') > 1) or (InstanceCount('DAYS') > 0) then // complex dose
966 begin
967 i := Responses.NextInstance('INSTR', 0);
968 while i > 0 do
969 begin
970 SetDosage(IValueFor('INSTR', i));
971 with cboDosage do
972 if ItemIndex > -1 then x := Text + TAB + Items[ItemIndex] else x := Text;
973 SetControl(cboRoute, 'ROUTE', i);
974 with cboRoute do
975 if ItemIndex > -1 then x := Text + TAB + Items[ItemIndex] else x := Text;
976 if FIsQuickOrder then TempSch := cboSchedule.Text;
977 SetSchedule(IValueFor('SCHEDULE', i));
978 if (cboSchedule.Text = '') and FIsQuickOrder then
979 begin
980 cboSchedule.SelectByID(TempSch);
981 cboSchedule.Text := TempSch;
982 end;
983 x := cboSchedule.Text;
984 if chkPRN.Checked then x := x + ' PRN';
985 with cboSchedule do
986 if ItemIndex > -1 then x := x + TAB + Items[ItemIndex];
987 if IValueFor('CONJ', i) = 'A' then x := 'AND'
988 else if IValueFor('CONJ', i) = 'T' then x := 'THEN'
989 else if IValueFor('CONJ', i) = 'X' then x := 'EXCEPT'
990 else x := '';
991 i := Responses.NextInstance('INSTR', i);
992 end; {while}
993 end else // single dose
994 begin
995 if FIsQuickOrder then
996 begin
997 FQODosage := IValueFor('INSTR', 1);
998 SetDosage(FQODosage);
999 TempSch := cboSchedule.Text;
1000 end
1001 else
1002 SetDosage(IValueFor('INSTR', 1));
1003 SetControl(cboRoute, 'ROUTE', 1);
1004 SetSchedule(IValueFor('SCHEDULE', 1));
1005 if (cboSchedule.Text = '') and FIsQuickOrder then
1006 begin
1007 cboSchedule.SelectByID(TempSch);
1008 cboSchedule.Text := TempSch;
1009 end;
1010 DispDrug := StrToIntDef(ValueOf(FLD_DRUG_ID), 0);
1011 if DispDrug > 0 then x := QuantityMessage(DispDrug) else x := '';
1012 SetControl(memComment , 'COMMENT', 1);
1013 SetControl(calStart, 'START', 1);
1014 SetStartDate(EValueFor('START', 1));
1015 SetStatements(EValueFor('STATEMENTS', 1));
1016 if FIsQuickOrder then
1017 begin
1018 if not QOHasRouteDefined(Responses.QuickOrder) then
1019 begin
1020 LocRoute := GetPickupForLocation(IntToStr(Encounter.Location));
1021 end;
1022 end;
1023 AResponse := Responses.FindResponseByName('SC', 1);
1024 DispGrp := NameOfDGroup(Responses.DisplayGroup);
1025 if (AResponse = nil) or ((StrToIntDef(Piece(Responses.CopyOrder,';',1),0)>0) and AnsiSameText('Out. Meds',DispGrp)) then
1026 begin
1027 LocRoute := GetPickupForLocation(IntToStr(Encounter.Location));
1028 end;
1029
1030 end;
1031 end; {with}
1032 if FInptDlg then
1033 begin
1034 x := ValueOfResponse(FLD_SCHEDULE, 1);
1035 if Length(x) > 0 then UpdateStartExpires(x);
1036 end;
1037end;
1038
1039
1040procedure TfrmODMedNVA.ShowMedSelect;
1041begin
1042 txtMed.SelStart := Length(txtMed.Text);
1043 ChangeDelayed; // synch the listboxes with display
1044 pnlFields.Enabled := False;
1045 pnlFields.Visible := False;
1046 pnlMeds.Enabled := True;
1047 pnlMeds.Visible := True;
1048 btnSelect.Caption := 'OK';
1049 btnSelect.Top := cmdAccept.Top;
1050 btnSelect.Anchors := [akRight, akBottom];
1051 btnSelect.BringToFront;
1052 cmdAccept.Visible := False;
1053 cmdAccept.Default := False;
1054 btnSelect.Default := True;
1055 btnSelect.TabOrder := cmdAccept.TabOrder;
1056 cmdAccept.TabStop := False;
1057 txtMed.Font.Color := clWindowText;
1058 txtMed.Color := clWindow;
1059 txtMed.ReadOnly := False;
1060 txtMed.SelectAll;
1061 txtMed.SetFocus;
1062 FDrugID := '';
1063end;
1064
1065procedure TfrmODMedNVA.ShowMedFields;
1066begin
1067 pnlMeds.Enabled := False;
1068 pnlMeds.Visible := False;
1069 pnlFields.Enabled := True;
1070 pnlFields.Visible := True;
1071 btnSelect.Caption := 'Change';
1072 btnSelect.Top := txtMed.Top;
1073 btnSelect.Anchors := [akRight, akTop];
1074 btnSelect.Default := False;
1075 cmdAccept.Visible := True;
1076 cmdAccept.Default := True;
1077 btnSelect.TabOrder := txtMed.TabOrder + 1;
1078 cmdAccept.TabStop := True;
1079 txtMed.Width := memOrder.Width;
1080 txtMed.Font.Color := clInfoText;
1081 txtMed.Color := clInfoBk;
1082 txtMed.ReadOnly := True;
1083 ShowControlsSimple;
1084end;
1085
1086procedure TfrmODMedNVA.ShowControlsSimple;
1087begin
1088 tabDose.TabIndex := TI_DOSE;
1089 cboDosage.Visible := True;
1090 lblRoute.Visible := True;
1091 cboRoute.Visible := True;
1092 lblSchedule.Visible := True;
1093 cboSchedule.Visible := True;
1094 chkPRN.Visible := True;
1095 ActiveControl := cboDosage;
1096end;
1097
1098procedure TfrmODMedNVA.SetDosage(const x: string);
1099var
1100 i, DoseIndex: Integer;
1101begin
1102 DoseIndex := -1;
1103 with cboDosage do
1104 begin
1105 ItemIndex := -1;
1106 for i := 0 to Pred(Items.Count) do
1107 if Piece(Items[i], U, 5) = x then
1108 begin
1109 DoseIndex := i;
1110 Break;
1111 end;
1112 if DoseIndex < 0 then Text := x else ItemIndex := DoseIndex;
1113 end;
1114end;
1115
1116procedure TfrmODMedNVA.SetStatements(x: string);
1117var
1118i,stmtLen: integer;
1119stmt: string;
1120hldStr, matchStmt: string;
1121stmtList: TStringList;
1122begin
1123 stmt := x;
1124 stmtLen := Length(stmt);
1125 stmtList := TStringList.Create;
1126 stmtList.Clear;
1127 for i := 1 to stmtLen do
1128 if((stmt[i] <> NVA_CR) and (stmt[i] <> NVA_LF)) then
1129 hldStr := hldStr + stmt[i]
1130 else
1131 hldStr := hldStr + '^';
1132 hldStr := hldStr + '^'; // end line with a '^' for piece.
1133
1134 // Load List of statements.
1135 stmtList.Add(Piece(hldStr,U,1));
1136 stmtList.Add(Piece(hldStr,U,3));
1137 stmtList.Add(Piece(hldStr,U,5));
1138 stmtList.Add(Piece(hldStr,U,7));
1139
1140 for i := 0 to lbStatements.count-1 do
1141 begin
1142 matchStmt := lbStatements.Items.Strings[i];
1143 if SearchStatements(stmtList,matchStmt) then
1144 lbStatements.Checked[i] := True;
1145 end;
1146
1147end;
1148
1149function TfrmODMedNVA.SearchStatements(StatementList: TStringList; Statement: string): Boolean;
1150var
1151i : integer;
1152x: string;
1153begin
1154
1155 Result := FALSE;
1156 for i := 0 to StatementList.Count-1 do
1157 begin
1158 x := StatementList.Strings[i];
1159 if Statement = Trim(StatementList.Strings[i]) then
1160 begin
1161 Result := TRUE;
1162 Break;
1163 end;
1164 end;
1165end;
1166
1167procedure TfrmODMedNVA.SetStartDate(const x: string);
1168begin
1169 calStart.Text := x;
1170end;
1171
1172procedure TfrmODMedNVA.SetSchedule(const x: string);
1173var
1174 NonPRNPart: string;
1175begin
1176 cboSchedule.ItemIndex := -1;
1177 if Pos('PRN', x) > 0 then
1178 begin
1179 NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1));
1180 cboSchedule.SelectByID(NonPRNPart);
1181 if cboSchedule.ItemIndex > -1 then chkPRN.Checked := True else
1182 begin
1183 cboSchedule.SelectByID(x);
1184 if cboSchedule.ItemIndex < 0 then cboSchedule.Text := x;
1185 end;
1186 end else
1187 begin
1188 chkPRN.Checked := False;
1189 cboSchedule.SelectByID(x);
1190 if cboSchedule.ItemIndex < 0 then cboSchedule.Text := x;
1191 end;
1192end;
1193
1194{ Medication edit --------------------------------------------------------------------------- }
1195
1196procedure TfrmODMedNVA.tabDoseChange(Sender: TObject);
1197begin
1198 inherited;
1199 case tabDose.TabIndex of
1200 TI_DOSE: begin
1201 // clean up responses?
1202 ShowControlsSimple;
1203 ControlChange(Self);
1204 end;
1205 TI_RATE: begin
1206 // for future use...
1207 end;
1208 end; {case}
1209end;
1210
1211procedure TfrmODMedNVA.lblGuidelineClick(Sender: TObject);
1212var
1213 TextStrings: TStringList;
1214begin
1215 inherited;
1216 TextStrings := TStringList.Create;
1217 try
1218 TextStrings.Text := FGuideline.Text;
1219 ReportBox(TextStrings, TC_GUIDELINE, TRUE);
1220 finally
1221 TextStrings.Free;
1222 end;
1223end;
1224
1225{ cboDosage ------------------------------------- }
1226
1227procedure TfrmODMedNVA.CheckFormAltDose(DispDrug: Integer);
1228var
1229 OI: Integer;
1230 OIName: string;
1231begin
1232 if FAltChecked or (DispDrug = 0) then Exit;
1233 OI := txtMed.Tag;
1234 OIName := txtMed.Text;
1235 CheckFormularyDose(DispDrug, OI, OIName, FNonVADlg);
1236 if OI <> txtMed.Tag then
1237 begin
1238 ResetOnMedChange;
1239 txtMed.Tag := OI;
1240 txtMed.Text := OIName;
1241 SetOnMedSelect;
1242 end;
1243end;
1244
1245procedure TfrmODMedNVA.cboDosageClick(Sender: TObject);
1246var
1247 DispDrug: Integer;
1248 x: string;
1249begin
1250 inherited;
1251 UpdateRelated(False);
1252 DispDrug := StrToIntDef(ValueOf(FLD_DRUG_ID), 0);
1253 if cboDosage.Text = '' then //cla 3/18/04
1254 begin
1255 DispDrug := 0;
1256 cboDosage.ItemIndex := -1;
1257 end;
1258 if DispDrug > 0 then
1259 begin
1260 if not FSuppressMsg then begin
1261 pnlMessage.TabOrder := cboDosage.TabOrder + 1;
1262 OrderMessage(DispenseMessage(DispDrug));
1263 end;
1264 x := QuantityMessage(DispDrug);
1265 end
1266 else x := '';
1267 with cboDosage do
1268 if (ItemIndex > -1) and (Piece(Items[ItemIndex], U, 3) = 'NF')
1269 then CheckFormAltDose(DispDrug);
1270end;
1271
1272procedure TfrmODMedNVA.cboDosageChange(Sender: TObject);
1273begin
1274 inherited;
1275 UpdateRelated;
1276end;
1277
1278procedure TfrmODMedNVA.cboDosageExit(Sender: TObject);
1279begin
1280 inherited;
1281 if ActiveControl = memMessage then
1282 begin
1283 memMessage.SendToBack;
1284 PnlMessage.Visible := False;
1285 Exit;
1286 end;
1287 if ActiveControl = memComment then
1288 begin
1289 if PnlMessage.Visible = true then
1290 begin
1291 memMessage.SendToBack;
1292 PnlMessage.Visible := False;
1293 end;
1294 end
1295 else if (ActiveControl <> btnSelect) and (ActiveControl <> memComment) then
1296 begin
1297 if PnlMessage.Visible = true then
1298 begin
1299 memMessage.SendToBack;
1300 PnlMessage.Visible := False;
1301 end;
1302 cboDosageClick(Self);
1303 end;
1304end;
1305
1306{ cboRoute -------------------------------------- }
1307
1308procedure TfrmODMedNVA.cboRouteChange(Sender: TObject);
1309begin
1310 inherited;
1311 with cboRoute do
1312 if ItemIndex > -1 then
1313 begin
1314 if Piece(Items[ItemIndex], U, 5) = '1'
1315 then tabDose.Tabs[0] := 'Dosage / Rate'
1316 else tabDose.Tabs[0] := 'Dosage';
1317 end;
1318 cboDosage.Caption := tabDose.Tabs[0];
1319 if Sender <> Self then ControlChange(Sender);
1320end;
1321
1322procedure TfrmODMedNVA.cboRouteExit(Sender: TObject);
1323begin
1324 inherited;
1325end;
1326
1327{ cboSchedule ----------------------------------- }
1328
1329procedure TfrmODMedNVA.cboScheduleClick(Sender: TObject);
1330begin
1331 inherited;
1332 UpdateRelated(False);
1333end;
1334
1335procedure TfrmODMedNVA.cboScheduleChange(Sender: TObject);
1336begin
1337 inherited;
1338 UpdateRelated;
1339end;
1340
1341procedure TfrmODMedNVA.cboScheduleExit(Sender: TObject);
1342begin
1343end;
1344
1345{ values changing }
1346
1347function TfrmODMedNVA.OutpatientSig: string;
1348var
1349 Dose, Route, Schedule: string;
1350begin
1351 case tabDose.TabIndex of
1352 TI_DOSE:
1353 begin
1354 if ValueOf(FLD_TOTALDOSE) = ''
1355 then Dose := ValueOf(FLD_LOCALDOSE)
1356 else Dose := ValueOf(FLD_UNITNOUN);
1357 CheckDecimal(Dose);
1358 Route := ValueOf(FLD_ROUTE_EX);
1359 if (Length(Route) > 0) and (Length(FSigPrep) > 0) then Route := FSigPrep + ' ' + Route;
1360 if Length(Route) = 0 then Route := ValueOf(FLD_ROUTE_NM);
1361 Schedule := ValueOf(FLD_SCHED_EX);
1362 if Length(Schedule) = 0 then Schedule := ValueOf(FLD_SCHEDULE);
1363 Result := FSIGVerb + ' ' + Dose + ' ' + Route + ' ' + Schedule;
1364 end;
1365 end; {case}
1366end;
1367
1368function TfrmODMedNVA.ConstructedDoseFields(const ADose: string; PrependName: Boolean = FALSE): string;
1369var
1370 i, DrugIndex: Integer;
1371 UnitsPerDose, Strength: Extended;
1372 Units, Noun, AName: string;
1373begin
1374 DrugIndex := -1;
1375 for i := 0 to Pred(FAllDrugs.Count) do
1376 if AnsiSameText(Piece(FAllDrugs[i], U, 1), FDrugID) then
1377 begin
1378 DrugIndex := i;
1379 Break;
1380 end;
1381 Strength := StrToFloatDef(Piece(FAllDrugs[DrugIndex], U, 2), 0);
1382 Units := Piece(FAllDrugs[DrugIndex], U, 3);
1383 AName := Piece(FAllDrugs[DrugIndex], U, 4);
1384 if FAllDoses.Count > 0
1385 then Noun := Piece(Piece(FAllDoses[0], U, 3), '&', 4)
1386 else Noun := '';
1387 if Strength > 0
1388 then UnitsPerDose := ExtractFloat(ADose) / Strength
1389 else UnitsPerDose := 0;
1390 if (UnitsPerDose > 1) and (Noun <> '') and (CharAt(Noun, Length(Noun)) <> 'S')
1391 then Noun := Noun + 'S';
1392 Result := FloatToStr(ExtractFloat(ADose)) + '&' + Units + '&' + FloatToStr(UnitsPerDose)
1393 + '&' + Noun + '&' + ADose + '&' + FDrugID + '&' + FloatToStr(Strength) + '&'
1394 + Units;
1395 if PrependName then Result := AName + U + FloatToStr(Strength) + Units + U + U +
1396 Result + U + ADose;
1397 Result := UpperCase(Result);
1398end;
1399
1400function TfrmODMedNVA.FindDoseFields(const Drug, ADose: string): string;
1401var
1402 i: Integer;
1403 x: string;
1404begin
1405 Result := '';
1406 x := ADose + U + Drug + U;
1407 for i := 0 to Pred(FAllDoses.Count) do
1408 begin
1409 if AnsiSameText(x, Copy(FAllDoses[i], 1, Length(x))) then
1410 begin
1411 Result := Piece(FAllDoses[i], U, 3);
1412 Break;
1413 end;
1414 end;
1415end;
1416
1417function TfrmODMedNVA.FindCommonDrug(DoseList: TStringList): string;
1418// DoseList[n] = DoseText ^ Dispense Drug Pointer
1419var
1420 i, j, UnitIndex: Integer;
1421 DrugStrength, DoseValue, UnitsPerDose: Extended;
1422 DrugOK, PossibleDoses, SplitTab: Boolean;
1423 ADrug, ADose, DoseFields, DoseUnits, DrugUnits: string;
1424 FoundDrugs: TStringList;
1425
1426 procedure SaveDrug(const ADrug: string; UnitsPerDose: Extended);
1427 var
1428 i, DrugIndex: Integer;
1429 CurUnits: Extended;
1430 begin
1431 DrugIndex := -1;
1432 for i := 0 to Pred(FoundDrugs.Count) do
1433 if AnsiSameText(Piece(FoundDrugs[i], U, 1), ADrug) then DrugIndex := i;
1434 if DrugIndex = -1 then FoundDrugs.Add(ADrug + U + FloatToStr(UnitsPerDose)) else
1435 begin
1436 CurUnits := StrToFloatDef(Piece(FoundDrugs[DrugIndex], U, 2), 0);
1437 if UnitsPerDose > CurUnits
1438 then FoundDrugs[DrugIndex] := ADrug + U + FloatToStr(UnitsPerDose);
1439 end;
1440 end;
1441
1442 procedure KillDrug(const ADrug: string);
1443 var
1444 i, DrugIndex: Integer;
1445 begin
1446 DrugIndex := -1;
1447 for i := 0 to Pred(FoundDrugs.Count) do
1448 if AnsiSameText(Piece(FoundDrugs[i], U, 1), ADrug) then DrugIndex := i;
1449 if DrugIndex > -1 then FoundDrugs.Delete(DrugIndex);
1450 end;
1451
1452begin
1453 Result := '';
1454 if FInptDlg then // inpatient dialog
1455 begin
1456 DrugOK := True;
1457 for i := 0 to Pred(DoseList.Count) do
1458 begin
1459 ADrug := Piece(DoseList[i], U, 2);
1460 if ADrug = '' then DrugOK := False;
1461 if Result = '' then Result := ADrug;
1462 if not AnsiSameText(ADrug, Result) then DrugOK := False;
1463 if not DrugOK then Break;
1464 end;
1465
1466 if not DrugOK then Result :='';
1467 end else // outpatient dialog
1468 begin
1469 // check the dose combinations for each dispense drug
1470 FoundDrugs := TStringList.Create;
1471 try
1472 if FAllDoses.Count > 0
1473 then PossibleDoses := Length(Piece(Piece(FAllDoses[0], U, 3), '&', 1)) > 0
1474 else PossibleDoses := False;
1475 for i := 0 to Pred(FAllDrugs.Count) do
1476 begin
1477 ADrug := Piece(FAllDrugs[i], U, 1);
1478 DrugOK := True;
1479 DrugStrength := StrToFloatDef(Piece(FAllDrugs[i], U, 2), 0);
1480 DrugUnits := Piece(FAllDrugs[i], U, 3);
1481 SplitTab := Piece(FAllDrugs[i], U, 5) = '1';
1482 for j := 0 to Pred(DoseList.Count) do
1483 begin
1484 ADose:= Piece(DoseList[j], U, 1);
1485 DoseFields := FindDoseFields(ADrug, ADose); // get the idnode for the dose/drug combination
1486 if not PossibleDoses then
1487 begin
1488 if DoseFields = '' then DrugOK := False else SaveDrug(ADrug, 0);
1489 end else
1490 begin
1491 DoseValue := StrToFloatDef(Piece(DoseFields, '&', 1), 0);
1492 if DoseValue = 0 then DoseValue := ExtractFloat(ADose);
1493 UnitsPerDose := DoseValue / DrugStrength;
1494 if (Frac(UnitsPerDose) = 0) or (SplitTab and (Frac(UnitsPerDose) = 0.5))
1495 then SaveDrug(ADrug, UnitsPerDose)
1496 else DrugOK := False;
1497 // make sure this dose is using the same units as the drug
1498 if DoseFields = '' then
1499 begin
1500 for UnitIndex := 1 to Length(ADose) do
1501 if not (ADose[UnitIndex] in ['0'..'9','.']) then Break;
1502 DoseUnits := Copy(ADose, UnitIndex, Length(ADose));
1503 end
1504 else DoseUnits := Piece(DoseFields, '&', 2);
1505 if not AnsiSameText(DoseUnits, DrugUnits) then DrugOK := False;
1506 end;
1507 if not DrugOK then
1508 begin
1509 KillDrug(ADrug);
1510 Break;
1511 end; {if not DrugOK}
1512 end; {with..for j}
1513 end; {for i}
1514 if FoundDrugs.Count > 0 then
1515 begin
1516 if not PossibleDoses then Result := Piece(FoundDrugs[0], U, 1) else
1517 begin
1518 UnitsPerDose := 99999999;
1519 for i := 0 to Pred(FoundDrugs.Count) do
1520 begin
1521 if StrToFloatDef(Piece(FoundDrugs[i], U, 2), 99999999) < UnitsPerDose then
1522 begin
1523 Result := Piece(FoundDrugs[i], U, 1);
1524 UnitsPerDose := StrToFloatDef(Piece(FoundDrugs[i], U, 2), 99999999);
1525 end; {if StrToFloatDef}
1526 end; {for i..FoundDrugs}
1527 end; {if not..else PossibleDoses}
1528 end; {if FoundDrugs}
1529 finally
1530 FoundDrugs.Free;
1531 end; {try}
1532 end; {if..else FInptDlg}
1533end; {FindCommonDrug}
1534
1535procedure TfrmODMedNVA.ControlChange(Sender: TObject);
1536var
1537 x,ADose,AUnit,ADosageText: string;
1538 DoseList: TStringList;
1539begin
1540 inherited;
1541 if csLoading in ComponentState then Exit; // to prevent error caused by txtRefills
1542 if Changing then Exit;
1543 if txtMed.Tag = 0 then Exit;
1544 ADose := '';
1545 AUnit := '';
1546 ADosageText := '';
1547 FUpdated := FALSE;
1548 Responses.Clear;
1549 Responses.Update('ORDERABLE', 1, IntToStr(txtMed.Tag), txtMed.Text);
1550 DoseList := TStringList.Create;
1551 case tabDose.TabIndex of
1552 TI_DOSE:
1553 begin
1554 if (cboDosage.ItemIndex < 0) and (Length(cboDosage.Text) > 0) then
1555 begin
1556 // try to resolve freetext dose and add it as a new item to the combobox
1557 ADosageText := cboDosage.Text;
1558 ADose := Piece(ADosageText,' ',1);
1559 Delete(ADosageText,1,Length(ADose)+1);
1560 ADosageText := ADose + Trim(ADosageText);
1561 DoseList.Add(ADosageText);
1562 FDrugID := FindCommonDrug(DoseList);
1563 if FDrugID <> '' then
1564 begin
1565 if ExtractFloat(cboDosage.Text) > 0 then
1566 begin
1567 x := ConstructedDoseFields(cboDosage.Text, TRUE);
1568 FDrugID := '';
1569 with cboDosage do ItemIndex := cboDosage.Items.Add(x);
1570 end;
1571 end;
1572 end;
1573 x := ValueOf(FLD_DOSETEXT); Responses.Update('INSTR', 1, x, x);
1574 x := ValueOf(FLD_DRUG_ID); Responses.Update('DRUG', 1, x, '');
1575 x := ValueOf(FLD_DOSEFLDS); Responses.Update('DOSE', 1, x, '');
1576 x := ValueOf(FLD_STRENGTH);
1577 // if outpt or inpt order with no total dose (i.e., topical)
1578 if (not FInptDlg) or (ValueOf(FLD_TOTALDOSE) = '')
1579 then Responses.Update('STRENGTH', 1, x, x);
1580 // if no strength for dosage, use dispense drug name
1581 if Length(x) = 0 then
1582 begin
1583 x := ValueOf(FLD_DRUG_NM);
1584 if Length(x) > 0 then Responses.Update('NAME', 1, x, x);
1585 end;
1586 x := ValueOf(FLD_ROUTE_AB);
1587 if Length(x) = 0 then x := ValueOf(FLD_ROUTE_NM);
1588 if Length(ValueOf(FLD_ROUTE_ID)) > 0
1589 then Responses.Update('ROUTE', 1, ValueOf(FLD_ROUTE_ID), x)
1590 else Responses.Update('ROUTE', 1, '', x);
1591 // x := ValueOf(FLD_SCHEDULE); Responses.Update('SCHEDULE', 1, x, x);
1592 end;
1593 end; {case TabDose.TabIndex}
1594 DoseList.Free;
1595 Responses.Update('URGENCY', 1, ValueOf(FLD_PRIOR_ID), '');
1596 Responses.Update('COMMENT', 1, TX_WPTYPE, ValueOf(FLD_COMMENT));
1597
1598 if Length(calStart.Text) > 0 then
1599 Responses.Update('START', 1, calStart.Text, 'Start Date: ' + calStart.Text); //cla 7-17-03
1600
1601 x := ValueOf(FLD_STATEMENTS);
1602 Responses.Update('STATEMENTS',1, TX_WPTYPE, x);
1603
1604
1605 if FInptDlg then // inpatient orders
1606 begin
1607 Responses.Update('NOW', 1, ValueOf(FLD_NOW_ID), ValueOf(FLD_NOW_NM));
1608 end else
1609 begin
1610 x := OutpatientSig; Responses.Update('SIG', 1, TX_WPTYPE, x);
1611 end;
1612 memOrder.Text := Responses.OrderText;
1613end;
1614
1615{ complex dose ------------------------------------------------------------------------------ }
1616
1617{ General Functions - get & set cell values}
1618
1619procedure FindInCombo(const x: string; AComboBox: TORComboBox);
1620var
1621 i, Found: Integer;
1622begin
1623 with AComboBox do
1624 begin
1625 i := 0;
1626 Found := -1;
1627 while (i < Items.Count) and (Found < 0) do
1628 begin
1629 if CompareText(Copy(DisplayText[i], 1, Length(x)), x) = 0 then Found := i;
1630 Inc(i);
1631 end; {while}
1632 if Found > -1 then
1633 begin
1634 ItemIndex := Found;
1635 Application.ProcessMessages;
1636 SelStart := 1;
1637 SelLength := Length(Items[Found]);
1638 end else
1639 begin
1640 Text := x;
1641 SelStart := Length(x);
1642 end;
1643 end; {with AComboBox}
1644end;
1645
1646procedure TfrmODMedNVA.grdDosesExit(Sender: TObject);
1647begin
1648 inherited;
1649 UpdateRelated(FALSE);
1650 RestoreDefaultButton;
1651 RestoreCancelButton;
1652end;
1653
1654function TfrmODMedNVA.ValueOf(FieldID: Integer; ARow: Integer = -1): string;
1655var
1656 y: string;
1657 stmt: Integer;
1658{ Contents of cboDosage
1659 DrugName^Strength^NF^TDose&Units&U/D&Noun&LDose&Drug^DoseText^CostText^MaxRefills
1660 Contents of grid cells (Only the first tab piece for each cell is drawn)
1661 Dosage <TAB> DosageFields
1662 RouteText <TAB> IEN^RouteName^Abbreviation
1663 Schedule <TAB> (nothing)
1664 Duration <TAB> Duration^Units }
1665begin
1666 Result := '';
1667 if ARow < 0 then // use single dose controls
1668 begin
1669 case FieldID of
1670 FLD_DOSETEXT : with cboDosage do
1671 if ItemIndex > -1 then Result := Uppercase(Piece(Items[ItemIndex], U, 5))
1672 else Result := Uppercase(Text);
1673 FLD_LOCALDOSE : with cboDosage do
1674 if ItemIndex > -1 then Result := Piece(Piece(Items[ItemIndex], U, 4), '&', 5)
1675 else Result := Uppercase(Text);
1676 FLD_STRENGTH : with cboDosage do
1677 if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 2);
1678 FLD_DRUG_ID : with cboDosage do
1679 if ItemIndex > -1 then Result := Piece(Piece(Items[ItemIndex], U, 4), '&', 6);
1680 FLD_DRUG_NM : with cboDosage do
1681 if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 1);
1682 FLD_DOSEFLDS : with cboDosage do
1683 if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 4);
1684 FLD_TOTALDOSE : with cboDosage do
1685 if ItemIndex > -1 then Result := Piece(Piece(Items[ItemIndex], U, 4), '&', 1);
1686 FLD_UNITNOUN : with cboDosage do
1687 if ItemIndex > -1 then Result := Piece(Piece(Items[ItemIndex], U, 4), '&', 3) + ' '
1688 + Piece(Piece(Items[ItemIndex], U, 4), '&', 4);
1689 FLD_ROUTE_ID : with cboRoute do
1690 if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 1);
1691 FLD_ROUTE_NM : with cboRoute do
1692 if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 2)
1693 else Result := Text;
1694 FLD_ROUTE_AB : with cboRoute do
1695 if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 3);
1696 FLD_ROUTE_EX : with cboRoute do
1697 if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 4);
1698 FLD_SCHEDULE : begin
1699 Result := cboSchedule.Text;
1700 if chkPRN.Checked then Result := Result + ' PRN';
1701 if UpperCase(Copy(Result, Length(Result) - 6, Length(Result))) = 'PRN PRN'
1702 then Result := Copy(Result, 1, Length(Result) - 4);
1703 end;
1704 FLD_SCHED_EX : begin
1705 with cboSchedule do
1706 if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 2);
1707 if (Length(Result) > 0) and chkPRN.Checked then Result := Result + ' AS NEEDED';
1708 if UpperCase(Copy(Result, Length(Result) - 18, Length(Result))) = 'AS NEEDED AS NEEDED'
1709 then Result := Copy(Result, 1, Length(Result) - 10);
1710 end;
1711 FLD_SCHED_TYP : with cboSchedule do
1712 if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 3);
1713 FLD_QTYDISP : with cboDosage do
1714 begin
1715 if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 8);
1716 if (Result = '') and (Items.Count > 0) then Result := Piece(Items[0], U, 8);
1717 if Result <> ''
1718 then Result := 'Qty (' + Result + ')'
1719 else Result := 'Quantity';
1720 end;
1721
1722 FLD_COMMENT : Result := memComment.Text;
1723
1724 FLD_START : Result := FormatFMDateTime('mmm dd,yy',calStart.FMDateTime);
1725
1726 FLD_STATEMENTS : with lbStatements do
1727 for stmt := 0 to lbStatements.Items.Count-1 do
1728 if(lbStatements.Checked[stmt]) then
1729 begin
1730 y := #13#10 + lbStatements.Items.Strings[stmt] + ' ';
1731 Result := Result + y;
1732 end;
1733
1734 end; {case FieldID}
1735 end; // use complex dose controls
1736end;
1737
1738function TfrmODMedNVA.ValueOfResponse(FieldID: Integer; AnInstance: Integer = 1): string;
1739var
1740 x: string;
1741begin
1742 case FieldID of
1743 FLD_SCHEDULE : Result := Responses.IValueFor('SCHEDULE', AnInstance);
1744 FLD_UNITNOUN : begin
1745 x := Responses.IValueFor('DOSE', AnInstance);
1746 Result := Piece(x, '&', 3) + ' ' + Piece(x, '&', 4);
1747 end;
1748 FLD_DOSEUNIT : begin
1749 x := Responses.IValueFor('DOSE', AnInstance);
1750 Result := Piece(x, '&', 3);
1751 end;
1752 FLD_DRUG_ID : Result := Responses.IValueFor('DRUG', AnInstance);
1753 FLD_INSTRUCT : Result := Responses.IValueFor('INSTR', AnInstance);
1754 FLD_SUPPLY : Result := Responses.IValueFor('SUPPLY', AnInstance);
1755 FLD_QUANTITY : Result := Responses.IValueFor('QTY', AnInstance);
1756 FLD_ROUTE_ID : Result := Responses.IValueFor('ROUTE', AnInstance);
1757 FLD_EXPIRE : Result := Responses.IValueFor('DAYS', AnInstance);
1758 FLD_ANDTHEN : Result := Responses.IValueFor('CONJ', AnInstance);
1759 end;
1760end;
1761
1762procedure TfrmODMedNVA.UpdateStartExpires(const CurSchedule: string);
1763var
1764 ShowText, Duration, ASchedule: string;
1765 AdminTime: TFMDateTime;
1766 Interval, PrnPos: Integer;
1767begin
1768 if Length(CurSchedule)=0 then Exit;
1769 ASchedule := Trim(CurSchedule);
1770 if (Pos('^',ASchedule)=0) then
1771 begin
1772 PrnPos := Pos('PRN',ASchedule);
1773 if (PrnPos > 1) and (CharAt(ASchedule,PrnPos-1) <> ';') then
1774 Delete(ASchedule, PrnPos, Length(ASchedule));
1775 end
1776 else if (Pos('^',ASchedule)>0) then
1777 begin
1778 PrnPos := Pos('PRN',ASchedule);
1779 if (PrnPos > 1) and (CharAt(ASchedule,PrnPos-1)=' ') then
1780 Delete(ASchedule, PrnPos-1, 4);
1781 end;
1782 ASchedule := Trim(ASchedule);
1783 if Length(ASchedule)>0 then
1784 LoadAdminInfo(ASchedule, txtMed.Tag, ShowText, AdminTime, Duration)
1785 else Exit;
1786 if AdminTime > 0 then
1787 begin
1788 ShowText := 'Expected First Dose: ';
1789 Interval := Trunc(FMDateTimeToDateTime(AdminTime) - FMDateTimeToDateTime(FMToday));
1790 case Interval of
1791 0: ShowText := ShowText + 'TODAY ' + FormatFMDateTime('(mmm dd, yy) at hh:nn', AdminTime);
1792 1: ShowText := ShowText + 'TOMORROW ' + FormatFMDateTime('(mmm dd, yy) at hh:nn', AdminTime);
1793 else ShowText := ShowText + FormatFMDateTime('mmm dd, yy at hh:nn', AdminTime);
1794 end;
1795 lblAdminTime.Caption := ShowText;
1796 FAdminTimeLbl := lblAdminTime.Caption;
1797 end
1798 else lblAdminTime.Caption := '';
1799end;
1800
1801procedure TfrmODMedNVA.UpdateRelated(DelayUpdate: Boolean = TRUE);
1802begin
1803 timCheckChanges.Enabled := False; // turn off timer
1804 if DelayUpdate
1805 then timCheckChanges.Enabled := True // restart timer
1806 else timCheckChangesTimer(Self); // otherwise call directly
1807end;
1808
1809procedure TfrmODMedNVA.timCheckChangesTimer(Sender: TObject);
1810const
1811 UPD_NONE = 0;
1812 UPD_QUANTITY = 1;
1813 UPD_SUPPLY = 2;
1814var
1815 CurUnits, CurSchedule, CurInstruct, CurDispDrug, CurDuration, TmpSchedule, x, x1: string;
1816 CurScheduleIN, CurScheduleOut: string;
1817 CurQuantity, CurSupply, i, pNum, j: Integer;
1818 { LackQtyInfo,} SaveChanging: Boolean;
1819begin
1820 inherited;
1821 timCheckChanges.Enabled := False;
1822 ControlChange(Self);
1823 SaveChanging := Changing;
1824 Changing := TRUE;
1825 // don't allow Exit procedure so Changing gets reset appropriately
1826 CurUnits := '';
1827 CurSchedule := '';
1828 CurDuration := '';
1829 // LackQtyInfo := False;
1830 i := Responses.NextInstance('DOSE', 0);
1831 while i > 0 do
1832 begin
1833 x := ValueOfResponse(FLD_DOSEUNIT, i);
1834 // if x = '' then LackQtyInfo := TRUE; //StrToIntDef(x, 0) = 0
1835 CurUnits := CurUnits + x + U;
1836 x := ValueOfResponse(FLD_SCHEDULE, i);
1837 // if Length(x) = 0 then LackQtyInfo := TRUE;
1838 CurScheduleOut := CurScheduleOut + x + U;
1839 x1 := ValueOf(FLD_SEQUENCE,i);
1840 if Length(x1)>0 then
1841 begin
1842 X1 := CharAt(X1,1);
1843 CurScheduleIn := CurScheduleIn + x1 + ';' + x + U;
1844 end
1845 else
1846 CurScheduleIn := CurScheduleIn + ';' + x + U;
1847 x := ValueOfResponse(FLD_EXPIRE, i);
1848 CurDuration := CurDuration + x + '~';
1849 x := ValueOfResponse(FLD_ANDTHEN, i);
1850 CurDuration := CurDuration + x + U;
1851 x := ValueOfResponse(FLD_DRUG_ID, i);
1852 CurDispDrug := CurDispDrug + x + U;
1853 x := ValueOfResponse(FLD_INSTRUCT, i);
1854 CurInstruct := CurInstruct + x + U;
1855 i := Responses.NextInstance('DOSE', i);
1856 end;
1857
1858 pNum := 1;
1859 while Length( Piece(CurScheduleIn,U,pNum)) > 0 do
1860 pNum := pNum + 1;
1861 if Length(Piece(CurScheduleIn,U,pNum)) < 1 then
1862 for j := 1 to pNum - 1 do
1863 begin
1864 if j = pNum -1 then
1865 TmpSchedule := TmpSchedule + ';' + Piece(Piece(CurScheduleIn,U,j),';',2)
1866 else
1867 TmpSchedule := TmpSchedule + Piece(CurScheduleIn,U,j) + U
1868 end;
1869 CurScheduleIn := TmpSchedule;
1870 CurQuantity := StrToIntDef(ValueOfResponse(FLD_QUANTITY) ,0);
1871 CurSupply := StrToIntDef(ValueOfResponse(FLD_SUPPLY) ,0);
1872 if FInptDlg then
1873 begin
1874 CurSchedule := CurScheduleIn;
1875 if Pos('^',CurSchedule)>0 then
1876 begin
1877 if Pos('PRN',Piece(CurSchedule,'^',1))>0 then
1878 if lblAdminTime.Visible then
1879 lblAdminTime.Caption := '';
1880 end;
1881 if CurSchedule <> FLastSchedule then UpdateStartExpires(CurSchedule);
1882 if Responses.EventType in ['A','D','T','M','O'] then lblAdminTime.Visible := False;
1883 end;
1884 if not FInptDlg then
1885 begin
1886 CurSchedule := CurScheduleOut;
1887 end;
1888
1889 FLastUnits := CurUnits;
1890 FLastSchedule := CurSchedule;
1891 FLastDispDrug := CurDispDrug;
1892 FLastQuantity := CurQuantity;
1893 FLastSupply := CurSupply;
1894 if (ActiveControl <> nil) and (ActiveControl.Parent <> cboDosage)
1895 then cboDosage.Text := Piece(cboDosage.Text, TAB, 1);
1896 Changing := SaveChanging;
1897 if FUpdated then ControlChange(Self);
1898end;
1899
1900procedure TfrmODMedNVA.cmdAcceptClick(Sender: TObject);
1901begin
1902 cmdAccept.SetFocus;
1903 inherited;
1904end;
1905procedure TfrmODMedNVA.CheckDecimal(var AStr: string);
1906var
1907 Number: double;
1908 DUName,TabletNum,tempStr: string;
1909 ToWord: string;
1910 ie,code: integer;
1911begin
1912 ToWord := '';
1913 tempStr := AStr;
1914 TabletNum := Piece(AStr,' ',1);
1915 if CharAt(TabletNum,1)='.' then
1916 begin
1917 if CharAt(TabletNum,2) in ['0','1','2','3','4','5','6','7','8','9'] then
1918 begin
1919 TabletNum := '0' + TabletNum;
1920 AStr := '0' + AStr;
1921 end;
1922 end;
1923 DUName := Piece(AStr,' ',2);
1924 if Pos('TABLET',upperCase(DUName))= 0 then
1925 Exit;
1926 if (Length(TabletNum)>0) and (Length(DUName)>0) then
1927 begin
1928 if CharAt(TabletNum,1) <> '0' then
1929 begin
1930 Val(TabletNum, ie, code);
1931 if code <> 0 then
1932 Exit;
1933 end;
1934 try
1935 begin
1936 Number := StrToFloat(TabletNum);
1937 if Number = 0.5 then
1938 ToWord := 'ONE-HALF';
1939 if ( Number >= 0.333 ) and ( Number <= 0.334 ) then
1940 ToWord := 'ONE-THIRD';
1941 if Number = 0.25 then
1942 ToWord := 'ONE-FOURTH';
1943 if ( Number >= 0.66 ) and ( Number <= 0.67 ) then
1944 ToWord := 'TWO-THIRDS';
1945 if Number = 0.75 then
1946 ToWord := 'THREE-FOURTHS';
1947 if Number = 1 then
1948 ToWord := 'ONE';
1949 if Number = 2 then
1950 ToWord := 'TWO';
1951 if Number = 3 then
1952 ToWord := 'THREE';
1953 if Number = 4 then
1954 ToWord := 'FOUR';
1955 if Number = 5 then
1956 ToWord := 'FIVE';
1957 if Number = 6 then
1958 ToWord := 'SIX';
1959 if (Length(ToWord) > 0) then
1960 AStr := ToWord + ' ' + DUName;
1961 end
1962 except
1963 on EConvertError do AStr := tempStr;
1964 end;
1965 end;
1966end;
1967
1968procedure TfrmODMedNVA.chkPRNClick(Sender: TObject);
1969begin
1970 inherited;
1971 if chkPRN.Checked then lblAdminTime.Caption := ''
1972 else
1973 begin
1974 lblAdminTime.Caption := FAdminTimeLbl;
1975 end;
1976 ControlChange(Self);
1977end;
1978
1979procedure TfrmODMedNVA.grdDosesKeyDown(Sender: TObject; var Key: Word;
1980 Shift: TShiftState);
1981begin
1982 inherited;
1983 case Key of
1984 VK_ESCAPE:
1985 begin
1986 ActiveControl := FindNextControl(Sender as TWinControl, False, True, False); //Previous control
1987 Key := 0;
1988 end;
1989 VK_TAB:
1990 begin
1991 if ssShift in Shift then
1992 begin
1993 ActiveControl := tabDose; //Previeous control
1994 Key := 0;
1995 end
1996 else if ssCtrl in Shift then
1997 begin
1998 ActiveControl := memComment;
1999 Key := 0;
2000 end;
2001 end;
2002 end;
2003end;
2004
2005procedure TfrmODMedNVA.grdDosesEnter(Sender: TObject);
2006begin
2007 inherited;
2008 DisableDefaultButton(self);
2009 DisableCancelButton(self);
2010end;
2011
2012function TfrmODMedNVA.DisableCancelButton(Control: TWinControl): boolean;
2013var
2014 i: integer;
2015begin
2016 if (Control is TButton) and TButton(Control).Cancel then begin
2017 result := True;
2018 FDisabledCancelButton := TButton(Control);
2019 TButton(Control).Cancel := False;
2020 end else begin
2021 result := False;
2022 for i := 0 to Control.ControlCount-1 do
2023 if (Control.Controls[i] is TWinControl) then
2024 if DisableCancelButton(TWinControl(Control.Controls[i])) then begin
2025 result := True;
2026 break;
2027 end;
2028 end;
2029end;
2030
2031function TfrmODMedNVA.DisableDefaultButton(Control: TWinControl): boolean;
2032var
2033 i: integer;
2034begin
2035 if (Control is TButton) and TButton(Control).Default then begin
2036 result := True;
2037 FDisabledDefaultButton := TButton(Control);
2038 TButton(Control).Default := False;
2039 end else begin
2040 result := False;
2041 for i := 0 to Control.ControlCount-1 do
2042 if (Control.Controls[i] is TWinControl) then
2043 if DisableDefaultButton(TWinControl(Control.Controls[i])) then begin
2044 result := True;
2045 break;
2046 end;
2047 end;
2048end;
2049
2050procedure TfrmODMedNVA.RestoreCancelButton;
2051begin
2052 if Assigned(FDisabledCancelButton) then begin
2053 FDisabledCancelButton.Cancel := True;
2054 FDisabledCancelButton := nil;
2055 end;
2056end;
2057
2058procedure TfrmODMedNVA.RestoreDefaultButton;
2059begin
2060 if Assigned(FDisabledDefaultButton) then begin
2061 FDisabledDefaultButton.Default := True;
2062 FDisabledDefaultButton := nil;
2063 end;
2064end;
2065
2066procedure TfrmODMedNVA.pnlMessageEnter(Sender: TObject);
2067begin
2068 inherited;
2069 DisableDefaultButton(self);
2070 DisableCancelButton(self);
2071end;
2072
2073procedure TfrmODMedNVA.pnlMessageExit(Sender: TObject);
2074begin
2075 inherited;
2076 RestoreDefaultButton;
2077 RestoreCancelButton;
2078end;
2079
2080procedure TfrmODMedNVA.memMessageKeyDown(Sender: TObject; var Key: Word;
2081 Shift: TShiftState);
2082begin
2083 inherited;
2084 if (Key = VK_RETURN) or (Key = VK_ESCAPE) then
2085 begin
2086 Perform(WM_NEXTDLGCTL, 0, 0);
2087 Key := 0;
2088 end;
2089end;
2090
2091procedure TfrmODMedNVA.FormResize(Sender: TObject);
2092begin
2093 inherited;
2094 pnlFields.Height := cmdAccept.Top - 4 - pnlFields.Top;
2095end;
2096
2097procedure TfrmODMedNVA.lstQuickData(Sender: TObject; Item: TListItem);
2098var
2099 x: string;
2100begin
2101 x := FQuickItems[Item.Index];
2102 Item.Caption := Piece(x, U, 2);
2103 Item.Data := Pointer(StrToIntDef(Piece(x, U, 1), 0));
2104end;
2105
2106procedure TfrmODMedNVA.LoadOTCStatements(Dest: TStrings);
2107var tmplst: TStringList;
2108 s: string;
2109 i :Integer;
2110begin
2111 tmplst := TStringList.Create;
2112 tmplst.Clear;
2113 tCallV(tmplst, 'ORWPS REASON', [nil]);
2114 if tmplst.Count > 0 then
2115 begin
2116 // sort := tmplst.Strings[0];
2117 for i := 0 to tmplst.Count-1 do
2118 begin
2119 s:= tmplst.Strings[i];
2120 tmplst.Strings[i] := Piece(s,U,2);
2121 end;
2122 Dest.Assign(tmplst);
2123 end;
2124 end;
2125
2126function TfrmODMedNVA.FindQuickOrder(const x: string): Integer;
2127var
2128 i: Integer;
2129begin
2130 Result := -1;
2131 if x = '' then Exit;
2132 for i := 0 to Pred(FQuickItems.Count) do
2133 begin
2134 if (Result > -1) or (FQuickItems[i] = '') then Break;
2135 if AnsiCompareText(x, Copy(Piece(FQuickItems[i],'^',2), 1, Length(x))) = 0 then Result := i;
2136 end;
2137end;
2138procedure TfrmODMedNVA.lbStatementsClickCheck(Sender: TObject;
2139 Index: Integer);
2140begin
2141 inherited;
2142 ControlChange(self);
2143end;
2144
2145procedure TfrmODMedNVA.lstChange(Sender: TObject; Item: TListItem;
2146 Change: TItemChange);
2147begin
2148 inherited;
2149 btnSelect.Enabled := (lstAll.ItemIndex > -1) or
2150 ((lstQuick.ItemIndex > -1) and
2151 (Assigned(lstQuick.Items[lstQuick.ItemIndex].Data)) and
2152 (Integer(lstQuick.Selected.Data) > 0)) ;
2153 if (btnSelect.Enabled) and (FRemoveText) then
2154 txtMed.Text := '';
2155end;
2156
2157procedure TfrmODMedNVA.FormKeyPress(Sender: TObject; var Key: Char);
2158begin
2159 if (Key = #13) and (ActiveControl = txtMed) then
2160 Key := #0 //Don't let the base class turn it into a forward tab!
2161 else
2162 inherited;
2163end;
2164
2165function OIForNVA(AnIEN: Integer; ForNonVAMed: Boolean; HavePI: Boolean; PKIActive: Boolean): TStrings;
2166var
2167 PtType: Char;
2168 NeedPI: Char;
2169 IsPKIActive: Char;
2170begin
2171 if HavePI then NeedPI := 'Y' else NeedPI := 'N';
2172 if ForNonVAMed then PtType := 'X' else PtType := 'O';
2173 if PKIActive then IsPKIActive := 'Y' else IsPKIActive := 'N';
2174 CallV('ORWDPS2 OISLCT', [AnIEN, PtType, Patient.DFN, NeedPI, IsPKIActive]);
2175 Result := RPCBrokerV.Results;
2176end;
2177
2178procedure CheckAuthForNVAMeds(var x: string);
2179begin
2180 x := Piece(sCallV('ORWDPS32 AUTHNVA', [Encounter.Provider]), U, 2);
2181end;
2182
2183function TfrmODMedNVA.isUniqueQuickOrder(iText: string): Boolean;
2184var
2185 counter,i: Integer;
2186begin
2187 counter := 0;
2188 Result := False;
2189 if iText = '' then Exit;
2190 for i := 0 to FQuickItems.Count-1 do
2191 if AnsiCompareText(iText, Copy(Piece(FQuickItems[i],'^',2), 1, Length(iText))) = 0 then
2192 Inc(counter); //Found a Match
2193 Result := counter = 1;
2194end;
2195
2196end.
Note: See TracBrowser for help on using the repository browser.