source: cprs/branches/tmg-cprs/CPRS-Chart/Orders/fODMedNVA.pas@ 973

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

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