source: cprs/trunk/CPRS-Chart/Orders/fODMedNVA.pas@ 730

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

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