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

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

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