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

Last change on this file was 1679, checked in by healthsevak, 9 years ago

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