Context Navigation

fODMeds.pas@ 1722

Last change on this file since 1722 was 1693, checked in by healthsevak, 9 years ago
Committing the files for first time to this new branch
File size: 200.8 KB

Line
1	unit fODMeds;
2
3	{$OPTIMIZATION OFF} // REMOVE AFTER UNIT IS DEBUGGED
4
5	interface
6
7	uses
8	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
9	fODBase, StdCtrls, ComCtrls, ExtCtrls, ORCtrls, Grids, Buttons, uConst, ORDtTm,
10	Menus, XUDIGSIGSC_TLB, VA508AccessibilityManager, VAUtils, Contnrs;
11
12	const
13	UM_DELAYCLICK = 11037; // temporary for listview click event
14
15	type
16	TfrmODMeds = class(TfrmODBase)
17	txtMed: TEdit;
18	pnlMeds: TPanel;
19	btnSelect: TButton;
20	pnlFields: TPanel;
21	lstQuick: TCaptionListView;
22	sptSelect: TSplitter;
23	lstAll: TCaptionListView;
24	dlgStart: TORDateTimeDlg;
25	cboXDosage: TORComboBox;
26	cboXRoute: TORComboBox;
27	pnlXDuration: TPanel;
28	timCheckChanges: TTimer;
29	popDuration: TPopupMenu;
30	popDays: TMenuItem;
31	popBlank: TMenuItem;
32	hours1: TMenuItem;
33	minutes1: TMenuItem;
34	months1: TMenuItem;
35	weeks1: TMenuItem;
36	pnlXSchedule: TPanel;
37	cboXSchedule: TORComboBox;
38	chkXPRN: TCheckBox;
39	txtXDuration: TCaptionEdit;
40	spnXDuration: TUpDown;
41	pnlXDurationButton: TKeyClickPanel;
42	btnXDuration: TSpeedButton;
43	pnlTop: TPanel;
44	lblRoute: TLabel;
45	lblSchedule: TLabel;
46	grdDoses: TCaptionStringGrid;
47	lblGuideline: TStaticText;
48	tabDose: TTabControl;
49	cboDosage: TORComboBox;
50	cboRoute: TORComboBox;
51	cboSchedule: TORComboBox;
52	chkPRN: TCheckBox;
53	btnXInsert: TButton;
54	btnXRemove: TButton;
55	pnlBottom: TPanel;
56	lblComment: TLabel;
57	lblDays: TLabel;
58	lblQuantity: TLabel;
59	lblRefills: TLabel;
60	lblPriority: TLabel;
61	chkDoseNow: TCheckBox;
62	memComment: TCaptionMemo;
63	lblQtyMsg: TStaticText;
64	txtSupply: TCaptionEdit;
65	spnSupply: TUpDown;
66	txtQuantity: TCaptionEdit;
67	spnQuantity: TUpDown;
68	txtRefills: TCaptionEdit;
69	spnRefills: TUpDown;
70	grpPickup: TGroupBox;
71	radPickWindow: TRadioButton;
72	radPickMail: TRadioButton;
73	radPickClinic: TRadioButton;
74	cboPriority: TORComboBox;
75	stcPI: TStaticText;
76	chkPtInstruct: TCheckBox;
77	memPI: TMemo;
78	Image1: TImage;
79	memDrugMsg: TMemo;
80	txtNSS: TLabel;
81	pnlXAdminTime: TPanel;
82	cboXSequence: TORComboBox;
83	lblAdminSch: TMemo;
84	lblAdminTime: TVA508StaticText;
85	procedure FormCreate(Sender: TObject);
86	procedure btnSelectClick(Sender: TObject);
87	procedure tabDoseChange(Sender: TObject);
88	procedure FormDestroy(Sender: TObject);
89	procedure txtMedKeyDown(Sender: TObject; var Key: Word;
90	Shift: TShiftState);
91	procedure txtMedKeyUp(Sender: TObject; var Key: Word;
92	Shift: TShiftState);
93	procedure txtMedChange(Sender: TObject);
94	procedure txtMedExit(Sender: TObject);
95	procedure ListViewEditing(Sender: TObject; Item: TListItem;
96	var AllowEdit: Boolean);
97	procedure ListViewKeyUp(Sender: TObject; var Key: Word;
98	Shift: TShiftState);
99	procedure ListViewResize(Sender: TObject);
100	procedure lstQuickData(Sender: TObject; Item: TListItem);
101	procedure lstQuickDataHint(Sender: TObject; StartIndex,
102	EndIndex: Integer);
103	procedure lstAllDataHint(Sender: TObject; StartIndex,
104	EndIndex: Integer);
105	procedure lstAllData(Sender: TObject; Item: TListItem);
106	procedure lblGuidelineClick(Sender: TObject);
107	procedure ListViewClick(Sender: TObject);
108	procedure cboScheduleChange(Sender: TObject);
109	procedure cboRouteChange(Sender: TObject);
110	procedure ControlChange(Sender: TObject);
111	procedure cboDosageClick(Sender: TObject);
112	procedure cboDosageChange(Sender: TObject);
113	procedure cboScheduleClick(Sender: TObject);
114	procedure txtSupplyChange(Sender: TObject);
115	procedure txtQuantityChange(Sender: TObject);
116	procedure cboRouteExit(Sender: TObject);
117	procedure grdDosesMouseDown(Sender: TObject; Button: TMouseButton;
118	Shift: TShiftState; X, Y: Integer);
119	procedure grdDosesKeyPress(Sender: TObject; var Key: Char);
120	procedure grdDosesMouseUp(Sender: TObject; Button: TMouseButton;
121	Shift: TShiftState; X, Y: Integer);
122	procedure grdDosesDrawCell(Sender: TObject; ACol, ARow: Integer;
123	Rect: TRect; State: TGridDrawState);
124	procedure cboXDosageClick(Sender: TObject);
125	procedure cboXDosageExit(Sender: TObject);
126	procedure cboXRouteClick(Sender: TObject);
127	procedure cboXRouteExit(Sender: TObject);
128	procedure cboXScheduleClick(Sender: TObject);
129	procedure pnlXDurationEnter(Sender: TObject);
130	procedure pnlXDurationExit(Sender: TObject);
131	procedure txtXDurationChange(Sender: TObject);
132	procedure cboXDosageEnter(Sender: TObject);
133	procedure cboXDosageChange(Sender: TObject);
134	procedure cboXRouteChange(Sender: TObject);
135	procedure cboXScheduleChange(Sender: TObject);
136	procedure grdDosesExit(Sender: TObject);
137	procedure ListViewEnter(Sender: TObject);
138	procedure timCheckChangesTimer(Sender: TObject);
139	procedure popDurationClick(Sender: TObject);
140	procedure cmdAcceptClick(Sender: TObject);
141	procedure btnXInsertClick(Sender: TObject);
142	procedure btnXRemoveClick(Sender: TObject);
143	procedure pnlXScheduleEnter(Sender: TObject);
144	procedure pnlXScheduleExit(Sender: TObject);
145	procedure chkPtInstructClick(Sender: TObject);
146	procedure pnlFieldsResize(Sender: TObject);
147	procedure chkDoseNowClick(Sender: TObject);
148	procedure cboDosageExit(Sender: TObject);
149	procedure chkXPRNClick(Sender: TObject);
150	procedure memCommentClick(Sender: TObject);
151	procedure btnXDurationClick(Sender: TObject);
152	procedure chkPRNClick(Sender: TObject);
153	procedure grdDosesKeyDown(Sender: TObject; var Key: Word;
154	Shift: TShiftState);
155	procedure grdDosesEnter(Sender: TObject);
156	procedure FormKeyPress(Sender: TObject; var Key: Char);
157	procedure FormKeyDown(Sender: TObject; var Key: Word;
158	Shift: TShiftState);
159	procedure cboXRouteEnter(Sender: TObject);
160	procedure pnlMessageEnter(Sender: TObject);
161	procedure pnlMessageExit(Sender: TObject);
162	procedure memMessageKeyDown(Sender: TObject; var Key: Word;
163	Shift: TShiftState);
164	procedure memPIClick(Sender: TObject);
165	procedure FormResize(Sender: TObject);
166	procedure memPIKeyDown(Sender: TObject; var Key: Word;
167	Shift: TShiftState);
168	procedure lstChange(Sender: TObject; Item: TListItem;
169	Change: TItemChange);
170	procedure FormClose(Sender: TObject; var Action: TCloseAction);
171	procedure txtNSSClick(Sender: TObject);
172	procedure cboScheduleEnter(Sender: TObject);
173	procedure FormShow(Sender: TObject);
174	procedure cboScheduleExit(Sender: TObject);
175	procedure cboXScheduleExit(Sender: TObject);
176	procedure cboDosageKeyUp(Sender: TObject; var Key: Word;
177	Shift: TShiftState);
178	procedure cboXDosageKeyUp(Sender: TObject; var Key: Word;
179	Shift: TShiftState);
180	procedure txtSupplyClick(Sender: TObject);
181	procedure txtQuantityClick(Sender: TObject);
182	procedure txtRefillsClick(Sender: TObject);
183	procedure WMClose(var Msg : TWMClose); message WM_CLOSE;
184	procedure cboXScheduleEnter(Sender: TObject);
185	procedure pnlXAdminTimeClick(Sender: TObject);
186	procedure cboXSequenceChange(Sender: TObject);
187	procedure cboXSequence1Exit(Sender: TObject);
188	procedure cboXSequenceExit(Sender: TObject);
189	procedure cboXSequenceEnter(Sender: TObject);
190	procedure txtRefillsChange(Sender: TObject);
191	procedure QuantityMessageCheck(Tag: integer) ;
192	procedure pnlXDurationButtonEnter(Sender: TObject);
193	procedure cboRouteKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
194	procedure cboScheduleKeyUp(Sender: TObject; var Key: Word;
195	Shift: TShiftState);
196	procedure cboXScheduleKeyUp(Sender: TObject; var Key: Word;
197	Shift: TShiftState);
198	procedure cboXSequenceKeyUp(Sender: TObject; var Key: Word;
199	Shift: TShiftState);
200	procedure cboPriorityKeyUp(Sender: TObject; var Key: Word;
201	Shift: TShiftState);
202	//procedure btnNSSClick(Sender: TObject);
203	private
204	FCloseCalled : Boolean;
205	FScheduleChanged : Boolean;
206	{selection}
207	FMedCache: TObjectList;
208	FCacheIEN: Integer;
209	FQuickList: Integer;
210	FQuickItems: TStringList;
211	FChangePending: Boolean;
212	FKeyTimerActive: Boolean;
213	FActiveMedList: TListView;
214	FRowHeight: Integer;
215	FFromSelf: Boolean;
216	{edit}
217	FAllDoses: TStringList;
218	FAllDrugs: TStringList;
219	FGuideline: TStringList;
220	FLastUnits: string;
221	FLastSchedule: string;
222	FLastDuration: string;
223	FLastInstruct: string;
224	FLastDispDrug: string;
225	FLastQuantity: Double;
226	FLastSupply: Integer;
227	FLastPickup: string;
228	FSIGVerb: string;
229	FSIGPrep: string;
230	FDropColumn: Integer;
231	FDrugID: string;
232	FInptDlg: Boolean;
233	FUpdated: Boolean;
234	FSuppressMsg: Boolean;
235	FPtInstruct: string;
236	FAltChecked: Boolean;
237	FOutptIV: Boolean;
238	FQOQuantity: Double;
239	FQODosage: string;
240	FNoZERO: boolean;
241	FIsQuickOrder: boolean;
242	FDisabledDefaultButton: TButton;
243	FDisabledCancelButton: TButton;
244	FShrinked: boolean;
245	FShrinkDrugMsg: boolean;
246	FResizedAlready: boolean;
247	FQOInitial: boolean;
248	FOrigiMsgDisp: boolean;
249	FNSSOther: boolean;
250	{selection}
251	FShowPnlXScheduleOk : boolean;
252	FRemoveText : Boolean;
253	FSmplPRNChkd: Boolean;
254	{Admin Time}
255	FAdminTimeLbl: string;
256	FMedName: String;
257	FNSSAdminTime: string;
258	FNSSScheduleType: string;
259	FAdminTimeText: string;
260	//FOriginalAdminTime: string;
261	//FOriginalScheduleIndex: integer;
262	FOrderAction: integer;
263	JAWSON: boolean;
264	procedure ChangeDelayed;
265	function FindQuickOrder(const x: string): Integer;
266	function isUniqueQuickOrder(iText: string): Boolean;
267	function GetCacheChunkIndex(idx: integer): integer;
268	procedure LoadMedCache(First, Last: Integer);
269	procedure ScrollToVisible(AListView: TListView);
270	procedure StartKeyTimer;
271	procedure StopKeyTimer;
272	procedure WMTimer(var Message: TWMTimer); message WM_TIMER;
273	{edit}
274	procedure ResetOnMedChange;
275	procedure ResetOnTabChange;
276	procedure SetControlsInpatient;
277	procedure SetControlsOutpatient;
278	procedure SetOnMedSelect;
279	procedure SetOnQuickOrder;
280	procedure SetVisibleCommentRows( Rows: integer );
281	procedure ShowMedSelect;
282	procedure ShowMedFields;
283	procedure ShowControlsSimple;
284	procedure ShowControlsComplex;
285	procedure SetDosage(const x: string);
286	procedure SetPickup(const x: string);
287	procedure SetSchedule(const x: string);
288	procedure CheckFormAltDose(DispDrug: Integer);
289	function DurationToDays: Integer;
290	function ConstructedDoseFields(const ADose: string; PrependName: Boolean = FALSE): string;
291	function FieldsForDose(ARow: Integer): string;
292	function FieldsForDrug(const DrugID: string): string;
293	function FindCommonDrug(DoseList: TStringList): string;
294	function FindDoseFields(const Drug, ADose: string): string;
295	function InpatientSig: string;
296	function OutpatientSig: string;
297	procedure UpdateRelated(DelayUpdate: Boolean = TRUE);
298	procedure UpdateRefills(const CurDispDrug: string; CurSupply: Integer);
299	procedure UpdateStartExpires(const CurSchedule: string);
300	procedure UpdateDefaultSupply(const CurUnits, CurSchedule, CurDuration, CurDispDrug: string;
301	var CurSupply: Integer; var CurQuantity: double; var SkipQtyCheck: Boolean);
302	procedure UpdateSupplyQuantity(const CurUnits, CurSchedule, CurDuration, CurDispDrug, CurInstruct: string;
303	var CurSupply: Integer; var CurQuantity: double);
304	procedure UpdateDurationControls( FreeText: boolean);
305	function DisableDefaultButton(Control: TWinControl): boolean;
306	function DisableCancelButton(Control: TWinControl): boolean;
307	procedure RestoreDefaultButton;
308	procedure RestoreCancelButton;
309	function ValueOf(FieldID: Integer; ARow: Integer = -1): string;
310	function ValueOfResponse(FieldID: Integer; AnInstance: Integer = 1): string;
311	function ValFor(FieldID, ARow: Integer): string;
312	function TextDosage(ADosage: string): string;
313	//NSS
314	function CreateOtherScheduel: string;
315	function CreateOtherScheduelComplex: string;
316	procedure ShowEditor(ACol, ARow: Integer; AChar: Char);
317	procedure DropLastSequence(ASign: integer = 0);
318	procedure DispOrderMessage(const AMessage: string);
319	procedure UMDelayClick(var Message: TMessage); message UM_DELAYCLICK;
320	procedure UMDelayEvent(var Message: TMessage); message UM_DELAYEVENT;
321	procedure UMShowNSSBuilder(var Message: TMessage); message UM_NSSOTHER;
322	function IfIsIMODialog: boolean;
323	procedure ValidateInpatientSchedule(ScheduleCombo: TORComboBox);
324	// function ValidateRoute(RouteCombo: TORComboBox) : Boolean; Removed based on Site feeback. See CQ: 7518
325	function IsSupplyAndOutPatient : boolean;
326	function GetSchedListIndex(SchedCombo: TORComboBox; pSchedule: String):integer;
327	procedure DisplayDoseNow(Status: boolean);
328	function lblAdminSchGetText: string;
329	procedure lblAdminSchSetText(str: string);
330	protected
331	procedure Loaded; override;
332	procedure InitDialog; override;
333	procedure Validate(var AnErrMsg: string); override;
334	procedure updateSig; override;
335	public
336	ARow1: integer;
337	procedure SetupDialog(OrderAction: Integer; const ID: string); override;
338	procedure CheckDecimal(var AStr: string);
339	property MedName: string read FMedName write FMedName;
340	property NSSAdminTime: string read FNSSAdminTime write FNSSAdminTime;
341	property NSSScheduleType: string read FNSSScheduleType write FNSSScheduleType;
342	end;
343
344	var
345	frmODMeds: TfrmODMeds;
346	crypto: IXuDigSigS;
347
348	implementation
349
350	{$R *.DFM}
351
352	uses rCore, uCore, ORFn, rODMeds, rODBase, rOrders, fRptBox, fODMedOIFA,
353	uOrders, fOtherSchedule, StrUtils, fFrame, VA508AccessibilityRouter;
354
355	const
356	{grid columns for complex dosing}
357	COL_SELECT = 0;
358	COL_DOSAGE = 1;
359	COL_ROUTE = 2;
360	COL_SCHEDULE = 3;
361	COL_DURATION = 4;
362	COL_ADMINTIME = 5;
363	COL_SEQUENCE = 6;
364	COL_CHKXPRN = 7;
365	VAL_DOSAGE = 10;
366	VAL_ROUTE = 20;
367	VAL_SCHEDULE = 30;
368	VAL_DURATION = 40;
369	VAL_ADMINTIME = 50;
370	VAL_SEQUENCE = 60;
371	VAL_CHKXPRN = 70;
372	TAB = #9;
373	{field identifiers}
374	FLD_LOCALDOSE = 1;
375	FLD_STRENGTH = 2;
376	FLD_DRUG_ID = 3;
377	FLD_DRUG_NM = 4;
378	FLD_DOSEFLDS = 5;
379	FLD_UNITNOUN = 6;
380	FLD_TOTALDOSE = 7;
381	FLD_DOSETEXT = 8;
382	FLD_INSTRUCT = 10;
383	FLD_DOSEUNIT = 11;
384	FLD_ROUTE_ID = 15;
385	FLD_ROUTE_NM = 16;
386	FLD_ROUTE_AB = 17;
387	FLD_ROUTE_EX = 18;
388	FLD_SCHEDULE = 20;
389	FLD_SCHED_EX = 21;
390	FLD_SCHED_TYP = 22;
391	FLD_DURATION = 30;
392	FLD_SEQUENCE = 31;
393	FLD_MISC_FLDS = 50;
394	FLD_SUPPLY = 51;
395	FLD_QUANTITY = 52;
396	FLD_REFILLS = 53;
397	FLD_PICKUP = 55;
398	FLD_QTYDISP = 56;
399	FLD_SC = 58;
400	FLD_PRIOR_ID = 60;
401	FLD_PRIOR_NM = 61;
402	FLD_START_ID = 70;
403	FLD_START_NM = 71;
404	FLD_EXPIRE = 72;
405	FLD_ANDTHEN = 73;
406	FLD_NOW_ID = 75;
407	FLD_NOW_NM = 76;
408	FLD_COMMENT = 80;
409	FLD_PTINSTR = 85;
410	FLD_DRUG_ID_INT = 90;
411	{dosage type tab index values}
412	TI_DOSE = 0;
413	TI_RATE = 99;
414	TI_COMPLEX = 1;
415	{misc constants}
416	TIMER_ID = 6902; // arbitrary number
417	TIMER_DELAY = 500; // 500 millisecond delay
418	TIMER_FROM_DAYS = 1;
419	TIMER_FROM_QTY = 2;
420
421	MED_CACHE_CHUNK_SIZE = 100;
422	{text constants}
423	TX_ADMIN = 'Requested Start: ';
424	TX_TAKE = '';
425	TX_NO_DEA = 'Provider must have a DEA# or VA# to order this medication';
426	TC_NO_DEA = 'DEA# Required';
427	TX_NO_MED = 'Medication must be selected.';
428	TX_NO_SEQ = 'Missing one or more conjunction.';
429	TX_NO_DOSE = 'Dosage must be entered.';
430	TX_DOSE_NUM = 'Dosage may not be numeric only';
431	TX_DOSE_LEN = 'Dosage may not exceed 60 characters';
432	TX_NO_ROUTE = 'Route must be entered.';
433	TX_NF_ROUTE = 'Route not found in the Medication Routes file.';
434	TX_NO_SCHED = 'Schedule must be entered.';
435	TX_NO_PICK = 'A method for picking up the medication must be entered.';
436	TX_RNG_REFILL = 'The number of refills must be in the range of 0 through ';
437	TX_SCH_QUOTE = 'Schedule must not have quotemarks in it.';
438	TX_SCH_MINUS = 'Schedule must not have a dash at the beginning.';
439	TX_SCH_SPACE = 'Schedule must have only one space in it.';
440	TX_SCH_LEN = 'Schedule must be less than 70 characters.';
441	TX_SCH_PRN = 'Schedule cannot include PRN - use Comments to enter PRN.';
442	TX_SCH_ZERO = 'Schedule cannot be Q0';
443	TX_SCH_LSP = 'Schedule may not have leading spaces.';
444	TX_SCH_NS = 'Unable to resolve non-standard schedule.';
445	TX_MAX_STOP = 'The maximum expiration for this order is ';
446	TX_OUTPT_IV = 'This patient has not been admitted. Only IV orders may be entered.';
447	TX_QTY_NV = 'Unable to validate quantity.';
448	TX_QTY_MAIL = 'Quantity for mailed items must be a whole number.';
449	TX_SUPPLY_LIM = 'Days Supply may not be greater than 90.';
450	TX_SUPPLY_LIM1 = 'Days Supply may not be less than 1.';
451	TX_SUPPLY_NINT= 'Days Supply is an invalid number.';
452	TC_RESTRICT = 'Ordering Restrictions';
453	TC_GUIDELINE = 'Restrictions/Guidelines';
454	TX_QTY_PRE = '>> Quantity Dispensed: ';
455	TX_QTY_POST = ' <<';
456
457	{ procedures inherited from fODBase --------------------------------------------------------- }
458
459	procedure TfrmODMeds.FormCreate(Sender: TObject);
460	var
461	ListCount: Integer;
462	x: string;
463	begin
464	frmFrame.pnlVisit.Enabled := false;
465	AutoSizeDisabled := True;
466	inherited;
467	FAdminTimeText := '';
468	btnXDuration.Align := alClient;
469	AllowQuickOrder := True;
470	FSmplPRNChkd := False; // GE CQ7585
471	CheckAuthForMeds(x);
472	if Length(x) > 0 then
473	begin
474	InfoBox(x, TC_RESTRICT, MB_OK);
475	Close;
476	Exit;
477	end;
478	if DlgFormID = OD_MEDINPT then FInptDlg := TRUE;
479	if DlgFormID = OD_MEDOUTPT then FInptDlg := FALSE;
480	if DlgFormID = OD_MEDNONVA then FInptDlg := FALSE;
481	if DlgFormID = OD_MEDS then FInptDlg := OrderForInpatient;
482	if XfInToOutNow then
483	FInptDlg := False;
484	if XferOuttoInOnMeds then
485	FInptDlg := True;
486	if ImmdCopyAct and isUDGroup and (Patient.Inpatient) then
487	FInptDlg := True;
488	if ImmdcopyAct and (not isUDGroup) then
489	FInptDlg := False;
490	if FInptDlg then FillerID := 'PSI' else FillerID := 'PSO';
491	FGuideline := TStringList.Create;
492	FAllDoses := TStringList.Create;
493	FAllDrugs := TStringList.Create;
494	StatusText('Loading Dialog Definition');
495	if DlgFormID = OD_MEDINPT then Responses.Dialog := 'PSJ OR PAT OE'
496	else if DlgFormID = OD_MEDOUTPT then Responses.Dialog := 'PSO OERR'
497	else if DlgFormID = OD_MEDNONVA then Responses.Dialog := 'PSH OERR'
498	else Responses.Dialog := 'PS MEDS'; // loads formatting info
499	{if not FInptDlg then } Responses.SetPromptFormat('INSTR', '@');
500	StatusText('Loading Schedules');
501	//if (Self.EvtID > 0) then LoadSchedules(cboSchedule.Items)
502	//else LoadSchedules(cboSchedule.Items, FInptDlg);
503	LoadSchedules(cboSchedule.Items, FInptDlg);
504	StatusText('');
505	if FInptDlg then SetControlsInpatient else SetControlsOutpatient;
506	CtrlInits.SetControl(cboPriority, 'Priority');
507	FSuppressMsg := CtrlInits.DefaultText('DispMsg') = '1';
508	FOrigiMsgDisp := FSuppressMsg;
509	InitDialog;
510	isIMO := IfisIMODialog;
511	if (isIMO) or ((FInptDlg) and (encounter.Location <> patient.Location)) then
512	FAdminTimeText := 'Not defined for Clinic Locations';
513	if FInptDlg then
514	begin
515	txtNss.Visible := True;
516	//cboSchedule.ListItemsOnly := True;
517	//cboXSchedule.ListItemsOnly := True;
518	end;
519	with grdDoses do
520	begin
521	ColWidths[0] := 8; // select
522	ColWidths[1] := 160; // dosage
523	ColWidths[2] := 82; // route
524	ColWidths[3] := 102; // schedule
525	ColWidths[4] := 70; // duration
526	if (FInptDlg) and (FAdminTimeText <> 'Not defined for Clinic Locations') then
527	begin
528	ColWidths[5] := 102; // administration times
529	ColWidths[6] := 58; // and/then
530	end
531	else
532	ColWidths[5] := 0;
533	ColWidths[6] := 58;
534	Cells[1, 0] := 'Dosage';
535	Cells[2, 0] := 'Route';
536	Cells[3, 0] := 'Schedule';
537	Cells[4, 0] := 'Duration (optional)';
538	Cells[5, 0] := 'Admin. Times';
539	Cells[6, 0] := 'then/and';
540	end;
541
542	// medication selection
543	FRowHeight := MainFontHeight + 1;
544
545	//IsIMO := IfIsIMODialog; //IMO
546	if (Self.EvtID > 0) then IsIMO := False; // event order can not be IMO order.
547	if FInptDlg then x := 'UD RX'
548	else if (not FInptDlg) and (DlgFormID = OD_MEDNONVA) then x := 'NV RX'
549	else x := 'O RX';
550	if FInptDlg and (not OrderForInpatient) and (not IsIMO) then //IMO
551	begin
552	FOutptIV := TRUE;
553	x := 'IVM RX';
554	end;
555	if self.EvtID > 0 then FAdminTimeText := 'To Be Determined';
556	if (isIMO = True) then self.Caption := 'Clinic Orders Medications'
557	else if FInptDlg = True then self.Caption := 'Inpatient Medications'
558	else if DlgFormID = OD_MEDOUTPT then self.Caption := 'Outpatient Medications'
559	else self.Caption := 'Medications Orders';
560	ListForOrderable(FCacheIEN, ListCount, x);
561	lstAll.Items.Count := ListCount;
562	FMedCache := TObjectList.Create;
563	FQuickItems := TStringList.Create;
564	ListForQuickOrders(FQuickList, ListCount, x);
565	if ListCount > 0 then
566	begin
567	lstQuick.Items.Count := ListCount;
568	SubsetOfQuickOrders(FQuickItems, FQuickList, 0, 0);
569	FActiveMedList := lstQuick;
570	end else
571	begin
572	lstQuick.Items.Count := 1;
573	ListCount := 1;
574	FQuickItems.Add('0^(No quick orders available)');
575	FActiveMedList := lstAll;
576	end;
577	// set the height based on user parameter here
578	with lstQuick do if ListCount < VisibleRowCount
579	then Height := (((Height - 6) div VisibleRowCount) * ListCount) + 6;
580	pnlFields.Height := memOrder.Top - 4 - pnlFields.Top;
581	FNoZero := False;
582	FShrinked := False;
583	FShrinkDrugMsg := False;
584	FResizedAlready := False;
585	FShowPnlXScheduleOk := True;
586	FRemoveText := True;
587	JAWSON := True;
588	if ScreenReaderActive = false then
589	begin
590	lblAdminTime.TabStop := false;
591	lblAdminSch.TabStop := false;
592	memOrder.TabStop := false;
593	JAWSON := false;
594	end;
595	end;
596
597	procedure TfrmODMeds.FormDestroy(Sender: TObject);
598	begin
599	{selection}
600	FQuickItems.Free;
601	FMedCache.Free;
602	{edit}
603	FGuideline.Free;
604	FAllDoses.Free;
605	FAllDrugs.Free;
606	frmFrame.pnlVisit.Enabled := true;
607	inherited;
608	end;
609
610	procedure TfrmODMeds.InitDialog;
611	{ Executed each time dialog is reset after pressing accept. Clears controls & responses }
612	begin
613	inherited;
614	FLastPickup := ValueOf(FLD_PICKUP);
615	Changing := True;
616	ResetOnMedChange;
617	txtMed.Text := '';
618	txtMed.Tag := 0;
619	lstQuick.Selected := nil;
620	lstAll.Selected := nil;
621	if Visible then ShowMedSelect;
622	Changing := False;
623	FIsQuickOrder := False;
624	FQOQuantity := 0 ;
625	FQODosage := '';
626	FQOInitial := False;
627	FNSSOther := False;
628	end;
629
630	procedure TfrmODMeds.SetupDialog(OrderAction: Integer; const ID: string);
631	var
632	AnInstr, OrderID, nsSch, Text, tempOrder, tempSchString, tempSchType, AdminTime, x: string;
633	i, ix: integer;
634	LocChange: boolean;
635	AResponse: TResponse;
636
637	begin
638	inherited;
639	FOrderAction := OrderAction;
640	if self.EvtID > 0 then DisplayDoseNow(false);
641	if XfInToOutNow then DisplayGroup := DisplayGroupByName('O RX');
642	if (CharAt(ID,1)='X') or (CharAt(ID,1)='C') then
643	begin
644	OrderID := Copy(Piece(ID, ';', 1), 2, Length(ID));
645	CheckExistingPI(OrderID, FPtInstruct);
646	end;
647	//AGP 27.72 Order Action behave similar to QO this is why Edit and Copy are setting FIsQuickOrder to true
648	//this is not the best approach but this should fix the problem with order edit losing the quantity value.
649	if ((OrderAction = ORDER_QUICK) or (OrderAction = ORDER_EDIT) or (OrderAction = ORDER_COPY)) then
650	begin
651	FIsQuickOrder := True;
652	FQOInitial := True;
653	end
654	else
655	begin
656	FIsQuickOrder := False;
657	FQOInitial := False;
658	end;
659	if lblDays.Visible then SetVisibleCommentRows(2) else SetVisibleCommentRows(4);
660	if OrderAction in [ORDER_COPY, ORDER_EDIT] then Responses.Remove('START', 1);
661	if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then
662	begin
663	Changing := True;
664	txtMed.Tag := StrToIntDef(Responses.IValueFor('ORDERABLE', 1), 0);
665	if OrderAction = ORDER_QUICK then
666	begin
667	if DEACheckFailed(txtMed.Tag, FInptDlg) then
668	begin
669	//btnSelect.Visible := False;
670	btnSelect.Enabled := False;
671	InfoBox(TX_NO_DEA, TC_NO_DEA, MB_OK);
672	AbortOrder := True;
673	Exit;
674	end;
675	end;
676	if (OrderAction = ORDER_QUICK) and (uOrders.PassDrugTstCall = False) and
677	(uOrders.OutptDisp = OutptDisp) and (PassDrugTest(txtMed.Tag, 'Q', false) = False) then Exit;
678	if (OrderAction = ORDER_QUICK) and (uOrders.PassDrugTstCall = False) and
679	((uOrders.ClinDisp = ClinDisp) or (uOrders.InptDisp = InptDisp)) and (PassDrugTest(txtMed.Tag, 'Q', true) = False) then Exit;
680	(* if (OrderAction = ORDER_QUICK) then
681	begin
682	tempAltIEN := GetQOAltOI;
683	if tempAltIEN > 0 then txtMed.Tag := tempAltIEN;
684	end; *)
685	SetOnMedSelect; // set up for this medication
686	SetOnQuickOrder; // insert quick order responses
687	ShowMedFields;
688	if (OrderAction = ORDER_EDIT) and OrderIsReleased(Responses.EditOrder)
689	then btnSelect.Enabled := False;
690	if (OrderAction in [ORDER_COPY, ORDER_EDIT]) and (self.EvtID <= 0) then //nss
691	begin
692	if NSSchedule then
693	begin
694	for ix := 0 to Responses.TheList.Count - 1 do
695	begin
696	if TResponse(Responses.TheList[ix]).promptid = 'SCHEDULE' then
697	begin
698	nsSch := TResponse(Responses.theList[ix]).EVALUE;
699	if length(nsSch) > 0 then
700	begin
701	SetSchedule(UpperCase(nsSch));
702	{cboSchedule.SelectByID(nsSch);
703	if cboSchedule.ItemIndex < 0 then
704	begin
705	cboSchedule.Items.Add(nsSch);
706	cboSchedule.ItemIndex := cboSchedule.Items.IndexOf(nsSch);
707	end;}
708	end;
709	end;
710	end;
711	end;
712	end; //nss
713	//if (FInptDlg) and (self.tabDose.TabIndex = TI_DOSE) and (OrderAction in [ORDER_COPY, ORDER_EDIT]) then
714	if (FInptDlg) and (OrderAction in [ORDER_COPY, ORDER_EDIT]) then
715	begin
716	TempOrder := Piece(id,';',1);
717	TempOrder := Copy(tempOrder, 2, Length(tempOrder));
718	LocChange := DifferentOrderLocations(tempOrder, Patient.Location);
719	if LocChange = false then
720	begin
721	AResponse := Responses.FindResponseByName('ADMIN', 1);
722	if AResponse <> nil then AdminTime := AResponse.EValue;
723	if (self.cboSchedule.ItemIndex > -1) and (AdminTime <> '') then
724	begin
725	tempSchString := self.cboSchedule.Items.Strings[cboSchedule.itemindex];
726	SetPiece(tempSchString,U,4,AdminTime);
727	self.cboSchedule.Items.strings[cboSchedule.ItemIndex] := tempSchString;
728	end;
729	if (self.tabDose.TabIndex = TI_COMPLEX) and (Responses.InstanceCount('INSTR') = 1) and (AdminTime <> '') then
730	begin
731	if self.cboXSchedule.ItemIndex > -1 then
732	begin
733	tempSchString := self.cboXSchedule.Items.Strings[cboXSchedule.itemindex];
734	SetPiece(tempSchString,U,4,AdminTime);
735	self.cboXSchedule.Items.strings[cboXSchedule.ItemIndex] := tempSchString;
736	end;
737	end;
738	AResponse := Responses.FindResponseByName('SCHTYPE', 1);
739	if AResponse <> nil then tempSchType := AResponse.EValue;
740	if self.cboSchedule.ItemIndex > -1 then
741	begin
742	if (Piece(self.cboSchedule.Items.Strings[self.cboSchedule.itemIndex], U, 3) = 'C') and (tempSchType = 'P') then
743	self.chkPRN.Checked := True
744	else
745	begin
746	tempSchString := self.cboSchedule.Items.Strings[cboSchedule.itemindex];
747	SetPiece(tempSchString,U,3,tempSchType);
748	self.cboSchedule.Items.strings[cboSchedule.ItemIndex] := tempSchString;
749	end;
750	end;
751	if (self.tabDose.TabIndex = TI_COMPLEX) and (Responses.InstanceCount('INSTR') = 1) then
752	begin
753	if self.cboXSchedule.ItemIndex > -1 then
754	begin
755	if (Piece(self.cboXSchedule.Items.Strings[self.cboXSchedule.itemIndex], U, 3) = 'C') and (tempSchType = 'P') then
756	self.chkXPRN.Checked := True
757	else
758	begin
759	tempSchString := self.cboXSchedule.Items.Strings[cboXSchedule.itemindex];
760	SetPiece(tempSchString,U,3,tempSchType);
761	self.cboXSchedule.Items.strings[cboXSchedule.ItemIndex] := tempSchString;
762	end;
763	end;
764	end;
765	end;
766	if (FAdminTimeText <> 'Not defined for Clinic Locations') and (self.tabDose.TabIndex = TI_COMPLEX) then
767	lblAdminSchSetText('');
768	if (FAdminTimeText <> '') and (self.tabDose.TabIndex = TI_DOSE) then lblAdminSchSetText('Admin. Time: ' + FAdminTimeText);
769	end;
770	if ((OrderAction <> Order_COPY) and (OrderAction <> Order_EDIT)) or
771	(XfInToOutNow = true) or (FIsQuickOrder) then
772	begin
773	UpdateRelated(FALSE); //AGP Change
774	//Need to do the following code to reset the FLastUnits and FLastSchedule in case a free text Dose is found. If the following
775	//code is not done than the quantity will reset to zero
776	if not FInptDlg then
777	begin
778	FLastUnits := '';
779	FLastSchedule := '';
780	FLastInstruct := '';
781	//Lasti := Responses.InstanceCount('INSTR');
782	//Lasti := Responses.NextInstance('DOSE', 0);
783	for I := 1 to Responses.InstanceCount('INSTR') do
784	begin
785	x := ValueOfResponse(FLD_DOSEUNIT, i);
786	FLastUnits := FLastUnits + x + U;
787	x := Responses.IValueFor('INSTR', i);
788	FLastInstruct := FLastInstruct + x + U;
789	x := ValueOfResponse(FLD_SCHEDULE, i);
790	FLastSchedule := FLastSchedule + x + U;
791	end;
792	end;
793	end;
794	Changing := False;
795	if ((OrderAction = Order_Copy) or (OrderAction = Order_Edit)) and
796	(self.cboSchedule.ItemIndex > -1) then
797	UpdateStartExpires(Piece(self.cboSchedule.items.strings[self.cboSchedule.itemindex], U, 1));
798	end;
799	{ prevent the SIG from being part of the comments on pre-CPRS prescriptions }
800	if (OrderAction in [ORDER_COPY, ORDER_EDIT]) and (cboDosage.Text = '') then
801	begin
802	OrderID := Copy(Piece(ID, ';', 1), 2, Length(ID));
803	AnInstr := TextForOrder(OrderID);
804	pnlMessage.TabOrder := 0;
805	DispOrderMessage(AnInstr);
806	if OrderAction = ORDER_COPY
807	then AnInstr := 'Copy: ' + AnInstr
808	else AnInstr := 'Change: ' + AnInstr;
809	Text := AnsiReplaceText(AnInstr,CRLF,'');
810	Caption := Text;
811	memComment.Clear; // sometimes the sig is in the comment
812	end;
813	FQOInitial := False;
814	ControlChange(Self);
815	if Self.IsSupply then
816	btnSelect.Enabled := False;
817	end;
818
819	procedure TfrmODMeds.Validate(var AnErrMsg: string);
820	var
821	i,ie,code, curSupply, tempRefills: Integer;
822	curDispDrug, tmpError, temp, x: string;
823
824	procedure SetError(const x: string);
825	begin
826	if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
827	AnErrMsg := AnErrMsg + x;
828	end;
829
830	procedure ValidateDosage(const x: string);
831	begin
832	if Length(x) = 0 then SetError(TX_NO_DOSE);
833	end;
834
835	procedure ValidateRoute(const x: string; NeedLookup: Boolean; AnInstance: Integer);
836	var
837	RouteID, RouteAbbr: string;
838	begin
839	//if order does not have route, and is not a supply order,
840	// and is not an outpaitent order, then display error text to require route
841	if (Length(x) = 0) and (Not IsSupplyAndOutPatient) then
842	begin
843	if cboRoute.Showing = true then cboRoute.SetFocus; //CQ: 7467
844	SetError(TX_NO_ROUTE);
845	end;
846	if (Length(x) > 0) and NeedLookup then
847	begin
848	LookupRoute(x, RouteID, RouteAbbr);
849	if RouteID = '0'
850	then
851	begin
852	if cboRoute.Showing = true then cboRoute.SetFocus; //CQ: 7467
853	SetError(TX_NF_ROUTE);
854	end
855	else Responses.Update('ROUTE', AnInstance, RouteID, RouteAbbr);
856	end;
857	end;
858
859	procedure ValidateSchedule(const x: string; AnInstance: Integer);
860	const
861	SCH_BAD = 0;
862	SCH_NO_RTN = -1;
863	var
864	ValidLevel: Integer;
865	ARoute, ADrug, tmpX: string;
866	begin
867	ARoute := ValueOfResponse(FLD_ROUTE_ID, AnInstance);
868	ADrug := ValueOfResponse(FLD_DRUG_ID, AnInstance);
869	tmpX := x; //Changed for CQ: 7370 - it was tmpX := Trim(x);
870	if Pos(CRLF, tmpX)> 0 then
871	begin
872	SetError('Schedule cannot contains control characters');
873	Exit;
874	end;
875	if (Length(tmpX) = 0) and (not FInptDlg) then SetError(TX_NO_SCHED)
876	else if (Length(tmpX) = 0) and FInptDlg and ScheduleRequired(txtMed.Tag, ARoute, ADrug)
877	then SetError(TX_NO_SCHED);
878	if Length(tmpX) > 0 then
879	begin
880	if FInptDlg then ValidLevel := ValidSchedule(tmpX) else ValidLevel := ValidSchedule(tmpX, 'O');
881	(* if FInptDlg and (tmpX <> '') and (cboSchedule.ItemIndex = -1) and
882	(self.tabDose.TabIndex = TI_DOSE) then
883	//SetError('Unique Schedule Selection Required');
884	SetError('More than one schedule starts with "'+tmpX+'". Please select a schedule from the list.'); *)
885	if ValidLevel = SCH_NO_RTN then
886	begin
887	if Pos('"', tmpX) > 0 then SetError(TX_SCH_QUOTE);
888	if Copy(tmpX, 1, 1) = '-' then SetError(TX_SCH_MINUS);
889	if Pos(' ', Copy(tmpX, Pos(' ', tmpX) + 1, 999)) > 0 then SetError(TX_SCH_SPACE);
890	if Length(tmpX) > 70 then SetError(TX_SCH_LEN);
891	if (Pos('P RN', tmpX) > 0) or (Pos('PR N', tmpX) > 0) then SetError(TX_SCH_PRN);
892	if Pos('Q0', tmpX) > 0 then SetError(TX_SCH_ZERO);
893	if TrimLeft(tmpX) <> tmpX then SetError(TX_SCH_LSP);
894	end;
895	if ValidLevel = SCH_BAD then SetError(TX_SCH_NS);
896	end;
897	end;
898
899	begin
900	inherited;
901	ControlChange(Self); // make sure everything is updated
902	if txtMed.Tag = 0 then SetError(TX_NO_MED);
903	if Responses.InstanceCount('INSTR') < 1 then SetError(TX_NO_DOSE);
904	if Pos(U, self.memComment.Text) > 0 then SetError('Comments cannot contain a "^".');
905	i := Responses.NextInstance('INSTR', 0);
906	while i > 0 do
907	begin
908	if (ValueOfResponse(FLD_DRUG_ID, i) = '') then
909	begin
910	if not ContainsAlpha(Responses.IValueFor('INSTR', i)) then
911	begin
912	SetError(TX_DOSE_NUM);
913	if tabDose.TabIndex = TI_DOSE then
914	cboDosage.SetFocus; //CQ: 7467
915	end;
916	if Length(Responses.IValueFor('INSTR', i)) > 60 then
917	begin
918	if self.tabDose.TabIndex = TI_COMPLEX then
919	begin
920	SetError('Dosage: ' + Responses.IValueFor('INSTR', i) + CRLF + TX_DOSE_LEN);
921	end
922	else
923	begin
924	SetError(TX_DOSE_LEN);
925	cboDosage.SetFocus; //CQ: 7467
926	end;
927	end;
928	end;
929	ValidateRoute(Responses.EValueFor('ROUTE', i), Responses.IValueFor('ROUTE', i) = '', i);
930	ValidateSchedule(ValueOfResponse(FLD_SCHEDULE, i), i);
931	i := Responses.NextInstance('INSTR', i);
932	end;
933	if self.tabDose.TabIndex = TI_DOSE then
934	begin
935	if (LeftStr(cboDosage.Text,1)='.') then
936	begin
937	SetError('Dosage must have a leading numeric value');
938	Exit;
939	end;
940	end;
941	//AGP Change 26.45 Fix for then/and conjucntion PSI-04-069
942	if self.tabDose.TabIndex = TI_COMPLEX then
943	begin
944	for i := 1 to self.grdDoses.RowCount do
945	begin
946	temp := ValFor(COL_DOSAGE, i);
947	if (LeftStr(temp,1) = '.') then
948	begin
949	SetError('All dosage must have a leading numeric value');
950	Exit;
951	end;
952	if (i > 1) and ((ValFor(COL_DOSAGE, i-1) <> '') and (ValFor(COL_DOSAGE, i) <> '')) and (ValFor(COL_SEQUENCE,i-1) = '') then
953	begin
954	SetError(TX_NO_SEQ);
955	Exit;
956	end;
957	if Uppercase(ValFor(Col_Sequence, i)) = 'THEN' then
958	begin
959	if ValFor(Col_Duration,i) = '' then
960	begin
961	SetError('A duration is required when using "Then" as a sequence.');
962	Exit;
963	end;
964	end;
965	end;
966	end;
967	if not FInptDlg then // outpatient stuff
968	begin
969	if Responses.IValueFor('PICKUP', 1) = '' then SetError(TX_NO_PICK);
970	temp := Responses.IValueFor('REFILLS', 1);
971	for i := 1 to Length(temp) do if not (temp[i] in ['0'..'9']) then
972	begin
973	SetError('Refills can only be a number');
974	Exit;
975	end;
976	tempRefills := StrToIntDef(temp, 0);
977	if (spnRefills.Max > 0) and (tempRefills > 0) then
978	begin
979	i := Responses.NextInstance('DOSE', 0);
980	while i > 0 do
981	begin
982	x := ValueOfResponse(FLD_DRUG_ID, i);
983	CurDispDrug := CurDispDrug + x + U;
984	i := Responses.NextInstance('DOSE', i);
985	end;
986	CurSupply := StrToIntDef(ValueOfResponse(FLD_SUPPLY) ,0);
987	UpdateRefills(CurDispDrug, CurSupply);
988	end;
989	if tempRefills > spnRefills.Max
990	then SetError(TX_RNG_REFILL + IntToStr(spnRefills.Max));
991	with txtQuantity do
992	begin
993	if not ValidQuantity(Responses.IValueFor('QTY', 1)) then
994	SetError(TX_QTY_NV);
995	(* else
996	begin
997	Quantity := ValidateQuantityErrorMsg(StrtoIntDef(Responses.IValueFor('QTY', 1), 0));
998	if Quantity <> '' then SetError(Quantity);
999	end; *)
1000	end;
1001	with txtSupply do
1002	begin
1003	txtSupply.Text := Trim(txtSupply.Text);
1004	Val( txtSupply.Text, ie, code);
1005	if (code <> 0) and (ie = 0)then
1006	begin
1007	SetError(TX_SUPPLY_NINT);
1008	Exit;
1009	end;
1010	if (StrToIntDef(Responses.IValueFor('SUPPLY', 1), 0) > 90) then SetError(TX_SUPPLY_LIM);
1011	if (StrToIntDef(Responses.IValueFor('SUPPLY', 1), 0) < 1) then SetError(TX_SUPPLY_LIM1);
1012	//Supply := ValidateDaySupplyandQuantityErrorMsg(strtoInt(Responses.IValueFor('SUPPLY',1)));
1013	//if Supply <> '' then SetError(Supply);
1014	end;
1015	tmpError := ValidateDaySupplyandQuantityErrorMsg(strtoInt(Responses.IValueFor('SUPPLY',1)),StrtoIntDef(Responses.IValueFor('QTY', 1), 0));
1016	if tmpError <> '' then SetError(tmpError)
1017	else ClearMaxData;
1018	end;
1019	end;
1020
1021	procedure TfrmODMeds.SetVisibleCommentRows( Rows: integer);
1022	begin
1023	memComment.Height := (Abs(Font.Height)+2)*Rows+8;
1024	end;
1025
1026	procedure TfrmODMeds.SetControlsInpatient;
1027	begin
1028	FillerID := 'PSI';
1029	CtrlInits.LoadDefaults(ODForMedsIn);
1030	lblPriority.Top := pnlFields.Height - cboPriority.Height - lblPriority.Height - 1;
1031	cboPriority.Top := pnlFields.Height - cboPriority.Height;
1032	lblDays.Visible := False;
1033	txtSupply.Visible := False;
1034	spnSupply.Visible := False;
1035	lblQuantity.Visible := False;
1036	txtQuantity.Visible := False;
1037	spnQuantity.Visible := False;
1038	lblQtyMsg.Visible := False;
1039	lblRefills.Visible := False;
1040	txtRefills.Visible := False;
1041	spnRefills.Visible := False;
1042	grpPickup.Visible := False;
1043	lblPriority.Visible := True;
1044	cboPriority.Visible := True;
1045	chkDoseNow.Visible := True;
1046	lblAdminTime.Visible := True;
1047	lblAdminSch.Visible := True;
1048	lblAdminSch.Hint := AdminTimeHelpText;
1049	if cboXSequence.Items.IndexOf('except') > -1 then cboXSequence.Items.Delete(cboXSequence.Items.IndexOf('except'));
1050	end;
1051
1052	procedure TfrmODMeds.SetControlsOutpatient;
1053	begin
1054	FillerID := 'PSO';
1055	CtrlInits.LoadDefaults(ODForMedsOut);
1056	lblPriority.Top := lblQuantity.Top;
1057	cboPriority.Top := txtQuantity.Top;
1058	lblDays.Visible := True;
1059	txtSupply.Visible := True;
1060	spnSupply.Visible := True;
1061	lblQuantity.Visible := True;
1062	txtQuantity.Visible := True;
1063	//if IsClozapineOrder = True then txtQuantity.Enabled := false;
1064	spnQuantity.Visible := True;
1065	lblQtyMsg.Visible := True;
1066	lblRefills.Visible := True;
1067	txtRefills.Visible := True;
1068	spnRefills.Visible := True;
1069	grpPickup.Visible := True;
1070	lblPriority.Visible := True;
1071	cboPriority.Visible := True;
1072	chkDoseNow.Visible := False;
1073	lblAdminTime.Visible := False;
1074	lblAdminSch.Visible := False;
1075	if cboXSequence.Items.IndexOf('except') = -1 then cboXSequence.Items.Add('except');
1076
1077	end;
1078
1079	{ Navigate medication selection lists ------------------------------------------------------- }
1080
1081	{ txtMed methods (including timers) }
1082
1083	procedure TfrmODMeds.WMTimer(var Message: TWMTimer);
1084	begin
1085	inherited;
1086	if (Message.TimerID = TIMER_ID) then
1087	begin
1088	StopKeyTimer;
1089	ChangeDelayed;
1090	end;
1091	end;
1092
1093	procedure TfrmODMeds.StartKeyTimer;
1094	{ start (or restart) a timer (done on keyup to delay before calling OnKeyPause) }
1095	var
1096	ATimerID: Integer;
1097	begin
1098	StopKeyTimer;
1099	ATimerID := SetTimer(Handle, TIMER_ID, TIMER_DELAY, nil);
1100	FKeyTimerActive := ATimerID > 0;
1101	// if can't get a timer, just call the event immediately F
1102	if not FKeyTimerActive then Perform(WM_TIMER, TIMER_ID, 0);
1103	end;
1104
1105	procedure TfrmODMeds.StopKeyTimer;
1106	{ stop the timer (done whenever a key is pressed or the combobox no longer has focus) }
1107	begin
1108	if FKeyTimerActive then
1109	begin
1110	KillTimer(Handle, TIMER_ID);
1111	FKeyTimerActive := False;
1112	end;
1113	end;
1114
1115	function TfrmODMeds.FindQuickOrder(const x: string): Integer;
1116	var
1117	i: Integer;
1118	begin
1119	Result := -1;
1120	if x = '' then Exit;
1121	for i := 0 to Pred(FQuickItems.Count) do
1122	begin
1123	if (Result > -1) or (FQuickItems[i] = '') then Break;
1124	if AnsiCompareText(x, Copy(Piece(FQuickItems[i],'^',2), 1, Length(x))) = 0 then Result := i;
1125	end;
1126	end;
1127
1128	procedure TfrmODMeds.txtMedKeyDown(Sender: TObject; var Key: Word;
1129	Shift: TShiftState);
1130	var
1131	i: Integer;
1132	x: string;
1133	begin
1134	if txtMed.ReadOnly then // v27.50 - RV - CQ #15365
1135	begin
1136	if not (Key in [VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN, VK_HOME, VK_END]) then // navigation
1137	begin
1138	Key := 0;
1139	Exit;
1140	end;
1141	end
1142	else if (Key in [VK_PRIOR, VK_NEXT, VK_UP, VK_DOWN]) then // navigation
1143	begin
1144	FActiveMedList.Perform(WM_KEYDOWN, Key, 0);
1145	FFromSelf := True;
1146	//txtMed.Text := FActiveMedList.Selected.Caption;
1147	txtMed.SelectAll;
1148	FFromSelf := False;
1149	Key := 0;
1150	end
1151	else if Key = VK_BACK then
1152	begin
1153	FFromSelf := True;
1154	x := txtMed.Text;
1155	i := txtMed.SelStart;
1156	if i > 1 then Delete(x, i + 1, Length(x)) else x := '';
1157	txtMed.Text := x;
1158	if i > 1 then txtMed.SelStart := i;
1159	FFromSelf := False;
1160	end
1161	else {StartKeyTimer};
1162	end;
1163
1164	procedure TfrmODMeds.txtMedKeyUp(Sender: TObject; var Key: Word;
1165	Shift: TShiftState);
1166	begin
1167	if txtMed.ReadOnly then exit; // v27.50 - RV - CQ #15365
1168	if not (Key in [VK_PRIOR, VK_NEXT, VK_LEFT, VK_RIGHT, VK_UP, VK_DOWN, VK_HOME, VK_END]) then StartKeyTimer;
1169	end;
1170
1171
1172	procedure TfrmODMeds.txtMedChange(Sender: TObject);
1173	begin
1174	if FFromSelf then Exit;
1175	FChangePending := True;
1176	end;
1177
1178	procedure TfrmODMeds.ScrollToVisible(AListView: TListView);
1179	var
1180	Offset: Integer;
1181	SelRect: TRect;
1182	begin
1183	AListView.Selected.MakeVisible(FALSE);
1184	SelRect := AListView.Selected.DisplayRect(drBounds);
1185	FRowHeight := SelRect.Bottom - SelRect.Top;
1186	Offset := AListView.Selected.Index - AListView.TopItem.Index;
1187	Application.ProcessMessages;
1188	if Offset > 0 then AListView.Scroll(0, (Offset * FRowHeight));
1189	Application.ProcessMessages;
1190	end;
1191
1192	procedure TfrmODMeds.ChangeDelayed;
1193	var
1194	QuickIndex, AllIndex: Integer;
1195	NewText, OldText, UserText: string;
1196	UniqueText: Boolean;
1197	begin
1198	FRemoveText := False;
1199	UniqueText := False;
1200	FChangePending := False;
1201	if (Length(txtMed.Text) > 0) and (txtMed.SelStart = 0) then Exit; // don't lookup null
1202	// lookup item in appropriate list box
1203	NewText := '';
1204	UserText := Copy(txtMed.Text, 1, txtMed.SelStart);
1205	QuickIndex := FindQuickOrder(UserText); // look in quick list first
1206	AllIndex := IndexOfOrderable(FCacheIEN, UserText); // but always synch the full list
1207	if UserText <> Copy(txtMed.Text, 1, txtMed.SelStart) then Exit; // if typing during lookup
1208	if AllIndex > -1 then
1209	begin
1210	lstAll.Selected := lstAll.Items[AllIndex];
1211	FActiveMedList := lstAll;
1212	end;
1213	if QuickIndex > -1 then
1214	begin
1215	try
1216	lstQuick.Selected := lstQuick.Items[QuickIndex];
1217	lstQuick.ItemFocused := lstQuick.Selected;
1218	NewText := lstQuick.Selected.Caption;
1219	FActiveMedList := lstQuick;
1220	//Search Quick List for Uniqueness
1221	UniqueText := isUniqueQuickOrder(UserText);
1222	except
1223	//doing nothing short term solution related to 117
1224	end;
1225	end
1226	else if AllIndex > -1 then
1227	begin
1228	lstAll.Selected := lstAll.Items[AllIndex];
1229	lstAll.ItemFocused := lstAll.Selected;
1230	NewText := lstAll.Selected.Caption;
1231	lstQuick.Selected := nil;
1232	FActiveMedList := lstAll;
1233	//List is alphabetical, So compare next Item in list to establish uniqueness.
1234	if CompareText(UserText, Copy(lstAll.Items[AllIndex+1].Caption, 1, Length(UserText))) <> 0 then
1235	UniqueText := True;
1236	end
1237	else
1238	begin
1239	lstQuick.Selected := nil;
1240	lstAll.Selected := nil;
1241	FActiveMedList := lstAll;
1242	NewText := txtMed.Text;
1243	end;
1244	if (AllIndex > -1) and (QuickIndex > -1) then //Not Unique Between Lists
1245	UniqueText := False;
1246	FFromSelf := True;
1247	{AutoSelection is only based upon uniquely matching characters.
1248	Several CQs have been resolved relating to this issue:
1249	See CQ:
1250	7326 - Auto complete does not work correctly if user has quick orders in Medication list
1251	7328 - PSI-05-016: TAM-0205-31170 Med Error due to pre-populated med screen
1252	6715 PSI-04-044 Orders: NJH-0804-20315 Physician unable to enter medication order
1253	}
1254	if UniqueText then
1255	begin
1256	OldText := Copy(txtMed.Text, 1, txtMed.SelStart);
1257	txtMed.Text := NewText;
1258	//txtMed.SelStart := Length(OldText); // v24.14 RV
1259	txtMed.SelStart := Length(UserText); // v24.14 RV
1260	txtMed.SelLength := Length(NewText);
1261	end
1262	else begin
1263	txtMed.Text := UserText;
1264	txtMed.SelStart := Length(txtMed.Text);
1265	end;
1266	FFromSelf := False;
1267	if lstAll.Selected <> nil then
1268	ScrollToVisible(lstAll);
1269	if lstQuick.Selected <> nil then
1270	ScrollToVisible(lstQuick);
1271	if Not UniqueText then
1272	begin
1273	lstQuick.ItemIndex := -1;
1274	lstAll.ItemIndex := -1;
1275	end;
1276	FRemoveText := True;
1277	end;
1278
1279	procedure TfrmODMeds.txtMedExit(Sender: TObject);
1280	begin
1281	StopKeyTimer;
1282	if txtMed.ReadOnly then exit; // v27.50 - RV - CQ #15365
1283	if not ((ActiveControl = lstAll) or (ActiveControl = lstQuick)) then ChangeDelayed;
1284	end;
1285
1286	{ lstAll & lstQuick methods }
1287
1288	procedure TfrmODMeds.ListViewEnter(Sender: TObject);
1289	begin
1290	inherited;
1291	FActiveMedList := TListView(Sender);
1292	with Sender as TListView do
1293	begin
1294	if Selected = nil then Selected := TopItem;
1295	if Name = 'lstQuick' then lstAll.Selected := nil else lstQuick.Selected := nil;
1296	ItemFocused := Selected;
1297	//ScrollToVisible(TListView(Sender));
1298	end;
1299	end;
1300
1301	procedure TfrmODMeds.ListViewClick(Sender: TObject);
1302	begin
1303	inherited;
1304	btnSelect.Visible := True;
1305	btnSelect.Enabled := True;
1306	//txtMed.Text := FActiveMedList.Selected.Caption;
1307	PostMessage(Handle, UM_DELAYCLICK, 0, 0);
1308	end;
1309
1310	procedure TfrmODMeds.UMDelayClick(var Message: TMessage);
1311	begin
1312	btnSelectClick(Self);
1313	end;
1314
1315	procedure TfrmODMeds.ListViewEditing(Sender: TObject; Item: TListItem;
1316	var AllowEdit: Boolean);
1317	begin
1318	AllowEdit := FALSE;
1319	end;
1320
1321	procedure TfrmODMeds.ListViewKeyUp(Sender: TObject; var Key: Word;
1322	Shift: TShiftState);
1323	begin
1324	//This code emulates combo-box behavior on the quick view and all meds view.
1325	//I think this is a really bad idea because it cannot automatically be undone.
1326	//Example: pull up a valid medication. Press change button. Press tab. Valid
1327	//medication is gone, replaced by first quick order entry. Not good behavior
1328	//when tabbing through page.
1329	//If we are going to use an edit box to play combo box, I emphatically suggest
1330	//that we use a different edit box.
1331	(*
1332	with Sender as TListView do
1333	begin
1334	if txtMed.Text = Selected.Caption then Exit; // for tabs, arrows, etc.
1335	FFromSelf := True;
1336	txtMed.Text := Selected.Caption;
1337	txtMed.SelectAll;
1338	FFromSelf := False;
1339	Key := 0;
1340	end;
1341	*)
1342	end;
1343
1344	procedure TfrmODMeds.ListViewResize(Sender: TObject);
1345	begin
1346	with Sender as TListView do Columns.Items[0].Width := ClientWidth - 20;
1347	end;
1348
1349	{ lstAll Methods (lstAll is TListView) }
1350
1351	procedure TfrmODMeds.Loaded;
1352	begin
1353	inherited;
1354	if ScreenReaderSystemActive then
1355	tabDose.TabStop := TRUE;
1356	end;
1357
1358	// Cache is a list of 100 string lists, starting at idx 0
1359	procedure TfrmODMeds.LoadMedCache(First, Last: Integer);
1360	var
1361	firstChunk, lastchunk, i: integer;
1362	list: TStringList;
1363	firstMed, LastMed: integer;
1364
1365	begin
1366	firstChunk := GetCacheChunkIndex(First);
1367	lastChunk := GetCacheChunkIndex(Last);
1368	for i := firstChunk to lastChunk do
1369	begin
1370	if (FMedCache.Count <= i) or (not assigned(FMedCache[i])) then
1371	begin
1372	while FMedCache.Count <= i do
1373	FMedCache.add(nil);
1374	list := TStringList.Create;
1375	FMedCache[i] := list;
1376	firstMed := i * MED_CACHE_CHUNK_SIZE;
1377	LastMed := firstMed + MED_CACHE_CHUNK_SIZE - 1;
1378	if LastMed >= lstAll.Items.Count then
1379	LastMed := lstAll.Items.Count - 1;
1380	SubsetOfOrderable(list, false, FCacheIEN, firstMed, lastMed);
1381	end;
1382	end;
1383	end;
1384
1385	procedure TfrmODMeds.lstAllData(Sender: TObject; Item: TListItem);
1386	var
1387	x: string;
1388	chunk: integer;
1389	list: TStringList;
1390	begin
1391	LoadMedCache(Item.Index, Item.Index);
1392	chunk := GetCacheChunkIndex(Item.Index);
1393	list := TStringList(FMedCache[chunk]);
1394	//This is to make sure that the index that is being used is not outside of the stringlist
1395	If Item.Index mod MED_CACHE_CHUNK_SIZE < list.Count then begin
1396	x := list[Item.Index mod MED_CACHE_CHUNK_SIZE];
1397	Item.Caption := Piece(x, U, 2);
1398	Item.Data := Pointer(StrToIntDef(Piece(x, U, 1), 0));
1399	end;
1400	end;
1401
1402	procedure TfrmODMeds.lstAllDataHint(Sender: TObject; StartIndex,
1403	EndIndex: Integer);
1404	begin
1405	LoadMedCache(StartIndex, EndIndex);
1406	end;
1407
1408	{ lstQuick methods (lstQuick is TListView) }
1409
1410	procedure TfrmODMeds.lstQuickData(Sender: TObject; Item: TListItem);
1411	var
1412	x: string;
1413	begin
1414	{ try
1415	if FQuickItems[Item.Index] = '' then
1416	SubsetOfQuickOrders(FQuickItems, FQuickList, Item.Index, Item.Index);}
1417	x := FQuickItems[Item.Index];
1418	Item.Caption := Piece(x, U, 2);
1419	Item.Data := Pointer(StrToIntDef(Piece(x, U, 1), 0));
1420	{ except
1421	// doing nothing
1422	end;}
1423	end;
1424
1425	procedure TfrmODMeds.lstQuickDataHint(Sender: TObject; StartIndex,
1426	EndIndex: Integer);
1427	begin
1428
1429	end;
1430
1431	{ Medication is now selected ---------------------------------------------------------------- }
1432
1433	procedure TfrmODMeds.btnSelectClick(Sender: TObject);
1434	var
1435	MedIEN: Integer;
1436	//MedName: string;
1437	QOQuantityStr: string;
1438	ErrMsg, Temp: string;
1439	begin
1440	inherited;
1441	QOQuantityStr := '';
1442	btnSelect.SetFocus; // let the exit events finish
1443	self.MedName := '';
1444	if pnlMeds.Visible then // display the medication fields
1445	begin
1446	Changing := True;
1447	ResetOnMedChange;
1448	if (FActiveMedList = lstQuick) and (lstQuick.Selected <> nil) then // quick order
1449	begin
1450	ErrMsg := '';
1451	FIsQuickOrder := True;
1452	FQOInitial := True;
1453	Responses.QuickOrder := Integer(lstQuick.Selected.Data);
1454	txtMed.Tag := StrToIntDef(Responses.IValueFor('ORDERABLE', 1), 0);
1455	if (not FInptDLG) and (PassDrugTest(TXTmED.Tag, 'N', false) = false) then exit;
1456	if (FInptDLG) and (PassDrugTest(TXTmED.Tag, 'N', true) = false) then exit;
1457	IsActivateOI(ErrMsg, txtMed.Tag);
1458	if Length(ErrMsg)>0 then
1459	begin
1460	//btnSelect.Visible := False;
1461	btnSelect.Enabled := False;
1462	ShowMsg(ErrMsg);
1463	Exit;
1464	end;
1465	if DEACheckFailed(txtMed.Tag, FInptDlg) then
1466	begin
1467	//btnSelect.Visible := False;
1468	btnSelect.Enabled := False;
1469	InfoBox(TX_NO_DEA, TC_NO_DEA, MB_OK);
1470	txtMed.Tag := 0;
1471	txtMed.SetFocus;
1472	Exit;
1473	end;
1474	if txtMed.Tag = 0 then
1475	begin
1476	//btnSelect.Visible := False;
1477	btnSelect.Enabled := False;
1478	txtMed.SetFocus;
1479	Exit;
1480	end;
1481	(* temp := self.MedName;
1482	tempIEN := txtMed.Tag;
1483	QOIEN := GetQOOrderableItem(InttoStr(Responses.QuickOrder));
1484	if QOIEN > 0 then
1485	begin
1486	CheckFormularyOI(tempIEN, temp, FInptDlg);
1487	if tempIEN <> txtMed.Tag then
1488	begin
1489	txtMed.Tag := tempIEN;
1490	txtMed.Text := temp;
1491	end;
1492	end; *)
1493	FAltChecked := True;
1494	SetOnMedSelect; // set up for this medication
1495	SetOnQuickOrder; // insert quick order responses
1496	if Length(txtQuantity.Text)>0 then
1497	QOQuantityStr := txtQuantity.Text;
1498	ShowMedFields;
1499	if self.tabDose.TabIndex = TI_COMPLEX then self.lblAdminSch.Visible := false;
1500	if (txtQuantity.Text = '0') and (Length(QOQuantityStr)>0) then
1501	txtQuantity.Text := QOQuantityStr;
1502	//FQOInitial := False;
1503	end
1504	else if (FActiveMedList = lstAll) and (lstAll.Selected <> nil) then // orderable item
1505	begin
1506	MedIEN := Integer(lstAll.Selected.Data);
1507	self.MedName := lstAll.Selected.Caption;
1508	if (not FInptDLG) and (PassDrugTest(MedIEN, 'N', false) = false) then exit;
1509	if (FInptDLG) and (PassDrugTest(MedIEN, 'N', true) = false) then exit;
1510	txtMed.Tag := MedIEN;
1511	ErrMsg := '';
1512	IsActivateOI(ErrMsg, txtMed.Tag);
1513	if Length(ErrMsg)>0 then
1514	begin
1515	//btnSelect.Visible := False;
1516	btnSelect.Enabled := False;
1517	ShowMsg(ErrMsg);
1518	Exit;
1519	end;
1520	if DEACheckFailed(txtMed.Tag, FInptDlg) then
1521	begin
1522	//btnSelect.Visible := False;
1523	btnSelect.Enabled := False;
1524	InfoBox(TX_NO_DEA, TC_NO_DEA, MB_OK);
1525	txtMed.Tag := 0;
1526	txtMed.SetFocus;
1527	Exit;
1528	end;
1529	if Pos(' NF', self.MedName) > 0 then
1530	begin
1531	temp := self.MedName;
1532	CheckFormularyOI(medIEN, temp, FInptDlg);
1533	FAltChecked := True;
1534	txtMed.Text := '';
1535	end;
1536	if MedIEN <> txtMed.Tag then
1537	begin
1538	txtMed.Tag := MedIEN;
1539	temp := self.MedName;
1540	self.MedName := txtMed.Text;
1541	txtMed.Text := Temp;
1542	end;
1543	SetOnMedSelect;
1544	ShowMedFields;
1545	end
1546	else // no selection
1547	begin
1548	//btnSelect.Visible := False;
1549	btnSelect.Enabled := False;
1550	MessageBeep(0);
1551	//btnSelect.Visible := False;
1552	btnSelect.Enabled := False;
1553	Exit;
1554	end;
1555	UpdateRelated(False);
1556	Changing := False;
1557	ControlChange(Self);
1558	end
1559	else ShowMedSelect; // show the selection fields
1560	FNoZERO := False;
1561	if FQOInitial = True then FQOInitial := False;
1562
1563	end;
1564
1565	procedure TfrmODMeds.ResetOnMedChange;
1566	var
1567	i: Integer;
1568	begin
1569	Responses.Clear;
1570	// clear dialog controls individually, since they are on panels
1571	with grdDoses do for i := 1 to Pred(RowCount) do Rows[i].Clear;
1572	cboDosage.Items.Clear;
1573	cboDosage.Text := '';
1574	cboRoute.Items.Clear;
1575	cboRoute.Text := '';
1576	cboRoute.Hint := cboRoute.Text;
1577	cboSchedule.ItemIndex := -1;
1578	cboSchedule.Text := ''; // leave items intact
1579	chkPRN.Checked := False;
1580	memComment.Lines.Clear;
1581	txtSupply.Text := '';
1582	txtQuantity.Text := '';
1583	txtRefills.Text := '0';
1584	lblQtyMsg.Caption := '';
1585	lblQuantity.Caption := 'Quantity';
1586	chkDoseNow.Checked := FALSE;
1587	lblAdminTime.Caption := '';
1588	chkPtInstruct.Checked := False;
1589	chkPtInstruct.Visible := False;
1590	memPI.Visible := False;
1591	stcPI.Visible := False;
1592	image1.Visible := False;
1593	memDrugMsg.Visible := False;
1594	FLastUnits := '';
1595	FLastSchedule := '';
1596	FLastDuration := '';
1597	FLastInstruct := '';
1598	FLastDispDrug := '-1';
1599	FLastQuantity := 0;
1600	FLastSupply := 0;
1601	FAltChecked := False;
1602	FPtInstruct := '';
1603	end;
1604
1605	procedure TfrmODMeds.ResetOnTabChange;
1606	var
1607	i: Integer;
1608	begin
1609	with grdDoses do for i := 1 to Pred(RowCount) do Rows[i].Clear;
1610	Responses.Clear('STRENGTH');
1611	Responses.Clear('NAME');
1612	Responses.Clear('INSTR');
1613	Responses.Clear('DOSE');
1614	Responses.Clear('DRUG');
1615	Responses.Clear('DAYS');
1616	Responses.Clear('ROUTE');
1617	Responses.Clear('SCHEDULE');
1618	Responses.Clear('START', 1);
1619	Responses.Clear('SIG');
1620	Responses.Clear('SUPPLY');
1621	Responses.Clear('QTY');
1622	cboDosage.ItemIndex := -1;
1623	cboDosage.Text := '';
1624	cboRoute.ItemIndex := -1;
1625	cboRoute.Text := '';
1626	cboSchedule.ItemIndex := -1;
1627	cboSchedule.Text := ''; // leave items intact
1628	if FAdminTimeText <> 'Not defined for Clinic Locations' then lblAdminSchSetText('');
1629	txtSupply.Text := '';
1630	txtSupply.Tag := 0;
1631	txtQuantity.Text := '';
1632	txtQuantity.Tag := 0;
1633	lblQtyMsg.Caption := '';
1634	lblQuantity.Caption := 'Quantity';
1635	FSmplPRNChkd := chkPRN.Checked; // GE CQ7585
1636	chkPRN.Checked := False;
1637	FLastUnits := '';
1638	FLastSchedule := '';
1639	FLastDuration := '';
1640	FLastInstruct := '';
1641	FLastDispDrug := '';
1642	FDrugID := '';
1643	end;
1644
1645	procedure TfrmODMeds.SetOnMedSelect;
1646	var
1647	i,j: Integer;
1648	temp,x: string;
1649	QOPiUnChk: boolean;
1650	PKIEnviron: boolean;
1651	AResponse: TResponse;
1652	begin
1653	// clear controls?
1654	cboDosage.Tag := -1;
1655	txtSupply.Tag := 0;
1656	txtQuantity.Tag := 0;
1657	spnQuantity.Tag := 0;
1658	QOPiUnChk := False;
1659	PKIEnviron := False;
1660	if GetPKISite then PKIEnviron := True;
1661	with CtrlInits do
1662	begin
1663	// set up CtrlInits for orderable item
1664	LoadOrderItem(OIForMed(txtMed.Tag, FInptDlg, IncludeOIPI, PKIEnviron));
1665	// set up lists & initial values based on orderable item
1666	SetControl(txtMed, 'Medication');
1667	if (self.MedName <> '') then
1668	begin
1669	if (txtMed.Text <> self.MedName) then
1670	begin
1671	temp := self.MedName;
1672	self.MedName := txtMed.Text;
1673	txtMed.Text := temp;
1674	end
1675	else MedName := '';
1676	end;
1677	SetControl(cboDosage, 'Dosage');
1678	SetControl(cboRoute, 'Route');
1679	if cboRoute.Items.Count = 1 then cboRoute.ItemIndex := 0;
1680	cboRouteChange(Self);
1681	x := DefaultText('Schedule');
1682	//AGP Change 27.72 trying to centralized the schedule setting code
1683	AResponse := Responses.FindResponseByName('SCHEDULE',1);
1684	if (AResponse <> nil) and (AResponse.EValue <> '') then x := AResponse.EValue;
1685	SetSchedule(UpperCase(x));
1686	(* if x <> '' then
1687	begin
1688	cboSchedule.SelectByID(x);
1689	if cboSchedule.ItemIndex > -1 then
1690	AdminTime := Piece(cboSchedule.Items.Strings[cboSchedule.itemindex],U,4);
1691	if (cboSchedule.ItemIndex < 0) and (RightStr(x,3) = 'PRN') then
1692	begin
1693	self.chkPRN.Checked := true;
1694	x := Copy(x,1,(Length(x)-3));
1695	if RightStr(X,1) = ' ' then x := Copy(x,1,(Length(x)-1))
1696	end;
1697	cboSchedule.Text := x;
1698	end; *)
1699	if Length(ValueOf(FLD_QTYDISP))>10 then
1700	begin
1701	lblQuantity.Caption := Copy(ValueOf(FLD_QTYDISP),0,7) + '...';
1702	lblQuantity.Hint := ValueOf(FLD_QTYDISP);
1703	end;
1704	FAllDoses.Text := TextOf('AllDoses');
1705	FAllDrugs.Text := TextOf('Dispense');
1706	FGuideline.Text := TextOf('Guideline');
1707	case FGuideline.Count of
1708	0: lblGuideline.Visible := False;
1709	1: begin
1710	lblGuideline.Caption := FGuideline[0];
1711	lblGuideline.Visible := TRUE;
1712	end;
1713	else begin
1714	lblGuideline.Caption := 'Display Restrictions/Guidelines';
1715	lblGuideline.Visible := TRUE;
1716	end;
1717	end;
1718	if FInptDlg then
1719	begin
1720	if not FResizedAlready then
1721	begin
1722	pnlBottom.Height := pnlBottom.Height - lblDays.Height - txtSupply.Height
1723	- stcPi.Height - memPi.Height + 6;
1724	FResizedAlready := True;
1725	end;
1726	pnlTop.Height := pnlFields.Height - pnlBottom.Height;
1727	chkDoseNow.Top := memComment.Top + memComment.Height + 1;
1728	lblPriority.Top := memcomment.Top + memComment.Height + 1;
1729	cboPriority.Top := lblPriority.Top + lblPriority.Height;
1730	lblAdminSch.Left := chkDoseNow.Left;
1731	lblAdminSch.Top := chkDoseNow.Top + chkDoseNow.Height - 1;
1732	lblAdminSch.Height := (MainFontHeight * 3) + 3;
1733	lblAdminSch.Width := cboPriority.Left - lblAdminSch.Left - 5;
1734	lblAdminTime.Left := lblAdminSch.Left;
1735	lblAdminTime.top := lblAdminSch.Top + lblAdminSch.Height -1;
1736	if self.tabDose.TabIndex = TI_Dose then lblAdminSchSetText('')
1737	else
1738	begin
1739	if FAdminTimeText = 'Not defined for Clinic Locations' then lblAdminSchSetText('Admin. Time: ' + FAdminTimeText)
1740	else self.lblAdminSch.Visible := False;
1741	end;
1742	end else
1743	begin
1744	DEASig := '';
1745	if GetPKISite then DEASig := DefaultText('DEASchedule');
1746	FSIGVerb := DefaultText('Verb');
1747	if Length(FSIGVerb) = 0 then FSIGVerb := TX_TAKE;
1748	FSIGPrep := DefaultText('Preposition');
1749	if FLastPickup <> '' then SetPickup(FLastPickup) else SetPickup(DefaultText('Pickup'));
1750	SetControl(txtRefills, 'Refills');
1751	for j := 0 to Responses.TheList.Count - 1 do
1752	begin
1753	if (TResponse(Responses.theList[j]).PromptID = 'PI') and (TResponse(Responses.theList[j]).EValue = ' ') then
1754	QOPiUnChk := True;
1755	end;
1756	//if Length(FPtInstruct) = 0 then
1757	if FPtInstruct = '' then FPtInstruct := TextOf('PtInstr');
1758	for i := 1 to Length(FPtInstruct) do if Ord(FPtInstruct[i]) < 32 then FPtInstruct[i] := ' ';
1759	FPtInstruct := TrimRight(FPtInstruct);
1760	if Length(FPtInstruct) > 0 then
1761	begin
1762	//chkPtInstruct.Caption := FPtInstruct;
1763	if memPI.Lines.Count > 0 then
1764	memPI.Lines.Clear;
1765	memPI.Lines.Add(FPtInstruct);
1766	chkPtInstruct.Visible := True;
1767	chkPtInstruct.Checked := True;
1768	stcPI.Visible := True;
1769	memPI.Visible := True;
1770	if FShrinked then
1771	begin
1772	pnlBottom.Height := pnlBottom.Height + memPi.Height + stcPI.Height + 2;
1773	FShrinked := False;
1774	end;
1775	if QOPiUnChk then
1776	chkPtInstruct.Checked := False;
1777	end else
1778	begin
1779	chkPtInstruct.Visible := False;
1780	chkPtInstruct.Checked := False;
1781	stcPI.Visible := False;
1782	memPI.Visible := False;
1783	if not FShrinked then
1784	begin
1785	pnlBottom.Height := pnlBottom.Height - stcPI.Height - memPI.Height - 2;
1786	FShrinked := True;
1787	end;
1788	end;
1789	end;
1790	pnlMessage.TabOrder := cboDosage.TabOrder + 1;
1791	DispOrderMessage(TextOf('Message'));
1792	end;
1793	end;
1794
1795	procedure TfrmODMeds.SetOnQuickOrder;
1796	var
1797	AResponse: TResponse;
1798	x,LocRoute,TempSch,DispGrp, SchType: string;
1799	i, DispDrug: Integer;
1800	begin
1801	// txtMed already set by SetOnMedSelect
1802	with Responses do
1803	begin
1804	if (InstanceCount('INSTR') > 1) or (InstanceCount('DAYS') > 0) then // complex dose
1805	begin
1806	grdDoses.RowCount := HigherOf(InstanceCount('INSTR')+2, 4);
1807	i := Responses.NextInstance('INSTR', 0);
1808	while i > 0 do
1809	begin
1810	SetDosage(IValueFor('INSTR', i));
1811	with cboDosage do
1812	//agp change QO code to populate the Grid with the same fields after selection CQ 15933
1813	//if ItemIndex > -1 then x := Text + TAB + Items[ItemIndex]
1814	if ItemIndex > -1 then x := Piece(Text, TAB, 1) + TAB + Items[ItemIndex]
1815	else x := IValueFor('INSTR',i); //AGP Change 26.41 for CQ 9102 PSI-05-015 affect copy and edit functionality
1816	grdDoses.Cells[COL_DOSAGE, i] := x;
1817	SetControl(cboRoute, 'ROUTE', i);
1818	with cboRoute do
1819	if ItemIndex > -1 then x := Text + TAB + Items[ItemIndex] else x := Text;
1820	grdDoses.Cells[COL_ROUTE, i] := x;
1821	SetSchedule(UpperCase(IValueFor('SCHEDULE', i)));
1822	if (cboSchedule.Text = '') and (FIsQuickOrder) and (NSSchedule = True) then cboSchedule.ItemIndex := -1;
1823	x := cboSchedule.Text;
1824	if chkPRN.Checked then x := x + ' PRN';
1825	with cboSchedule do
1826	if ItemIndex > -1 then x := x + TAB + Items[ItemIndex];
1827	grdDoses.Cells[COL_SCHEDULE, i] := x;
1828	if chkPRN.Checked = True then grdDoses.Cells[COL_CHKXPRN,i] := '1';
1829	grdDoses.Cells[COL_DURATION, i] := IValueFor('DAYS', i);
1830	if FInptDlg then
1831	begin
1832	if IValueFor('ADMIN', i) <> '' then grdDoses.Cells[COL_ADMINTIME, i] := IValueFor('ADMIN', i)
1833	else if (cboSchedule.ItemIndex > -1) and (chkPRN.Checked = false) then
1834	grdDoses.Cells[COL_ADMINTIME, i] := Piece(cboSchedule.Items.Strings[cboSchedule.itemIndex],U,4)
1835	else grdDoses.Cells[COL_ADMINTIME, i] := '';
1836	if grdDoses.Cells[COL_ADMINTIME, i] = '' then grdDoses.Cells[COL_ADMINTIME, i] := 'Not Defined';
1837	if FAdminTimeText <> '' then grdDoses.Cells[COL_ADMINTIME, i] := FAdminTimeText;
1838	//done to prevent admin time showing up in schedules that should not have admin times. Also remove Not Defined for schedule
1839	//should not show the admin time
1840	if (cboSchedule.ItemIndex > -1) or (chkPRN.Checked = True) then
1841	begin
1842	SchType := '';
1843	if (cboSchedule.ItemIndex > -1) then SchType := Piece(cboSchedule.Items.Strings[cboSchedule.itemIndex],U,3);
1844	if (SchType = 'P') or (SchType = 'O') or (SchType = 'OC') or (ChkPRN.Checked = True) then
1845	grdDoses.Cells[COL_ADMINTIME, i] := '';
1846	end;
1847	end;
1848	chkPRN.Checked := false;
1849	if IValueFor('CONJ', i) = 'A' then x := 'AND'
1850	else if IValueFor('CONJ', i) = 'T' then x := 'THEN'
1851	else if IValueFor('CONJ', i) = 'X' then x := 'EXCEPT'
1852	else x := '';
1853	grdDoses.Cells[COL_SEQUENCE, i] := x;
1854	i := Responses.NextInstance('INSTR', i);
1855	end; {while}
1856	end else // single dose
1857	begin
1858	if FIsQuickOrder then
1859	begin
1860	FQODosage := IValueFor('INSTR', 1);
1861	SetDosage(FQODosage);
1862	TempSch := cboSchedule.Text;
1863	end
1864	else
1865	SetDosage(IValueFor('INSTR', 1));
1866	SetControl(cboRoute, 'ROUTE', 1);
1867	SetSchedule(UpperCase(IValueFor('SCHEDULE', 1)));
1868	if (cboSchedule.Text = '') and (FIsQuickOrder) and (NSSchedule = False) then
1869	begin
1870	cboSchedule.SelectByID(TempSch);
1871	cboSchedule.Text := TempSch;
1872	end;
1873	if (cboSchedule.Text = '') and (FIsQuickOrder) and (NSSchedule = True) then cboSchedule.ItemIndex := -1;
1874	if ((cboSchedule.Text = 'OTHER') and FIsQuickOrder) then
1875	FNSSOther := True;
1876	DispDrug := StrToIntDef(ValueOf(FLD_DRUG_ID), 0);
1877	if Length(ValueOf(FLD_QTYDISP))>10 then
1878	begin
1879	lblQuantity.Caption := Copy(ValueOf(FLD_QTYDISP),0,7) + '...';
1880	lblQuantity.Hint := ValueOf(FLD_QTYDISP);
1881	end;
1882	if DispDrug > 0 then
1883	begin
1884	DispOrderMessage(DispenseMessage(DispDrug));
1885	x := QuantityMessage(DispDrug);
1886	end;
1887	if Length(x) > 0
1888	then lblQtyMsg.Caption := TX_QTY_PRE + x + TX_QTY_POST
1889	else lblQtyMsg.Caption := '';
1890	end;
1891	SetControl(memComment , 'COMMENT', 1);
1892	SetControl(cboPriority, 'URGENCY', 1);
1893	if FInptDlg then
1894	begin
1895	SetControl(chkDoseNow, 'NOW', 1);
1896	chkDoseNowClick(Self);
1897	end else
1898	begin
1899	SetControl(txtSupply, 'SUPPLY', 1);
1900	txtSupply.Text := Trim(txtSupply.Text);
1901	spnSupply.Position := StrToIntDef(txtSupply.Text, 0);
1902	{ setting .Tag=1 was commented out because xfer & change were not auto-calculating }
1903	//if spnSupply.Position <> 0 then txtSupply.Tag := 1;
1904	if Length(IValueFor('QTY',1))>0 then
1905	begin
1906	FQOQuantity := StrToFloat(IValueFor('QTY',1));
1907	txtQuantity.Text := FloatToStr(FQOQuantity);
1908	end;
1909	SetControl(txtQuantity, 'QTY', 1);
1910	SetControl(txtRefills, 'REFILLS', 1);
1911	spnRefills.Position := StrToIntDef(txtRefills.Text, 0);
1912	AResponse := Responses.FindResponseByName('PICKUP', 1);
1913	if AResponse <> nil then SetPickup(AResponse.IValue);
1914	if (FIsQuickOrder) and (FOrderAction = ORDER_QUICK) then
1915	begin
1916	if not QOHasRouteDefined(Responses.QuickOrder) then
1917	begin
1918	LocRoute := GetPickupForLocation(IntToStr(Encounter.Location));
1919	SetPickup(LocRoute);
1920	end;
1921	end;
1922	DispGrp := NameOfDGroup(Responses.DisplayGroup);
1923	if (AResponse = nil) or ((StrToIntDef(Piece(Responses.CopyOrder,';',1),0)>0) and AnsiSameText('Out. Meds',DispGrp)) then
1924	begin
1925	LocRoute := GetPickupForLocation(IntToStr(Encounter.Location));
1926	SetPickup(LocRoute);
1927	end;
1928	if ValueOf(FLD_PICKUP) = '' then SetPickup(FLastPickup);
1929	// AResponse := Responses.FindResponseByName('SC', 1);
1930	Responses.FindResponseByName('SC', 1);
1931	end; {if FInptDlg..else}
1932	end; {with}
1933	if (FInptDlg) then
1934	begin
1935	x := ValueOfResponse(FLD_SCHEDULE, 1);
1936	if Length(x) > 0 then UpdateStartExpires(x);
1937	end;
1938	end;
1939
1940	procedure TfrmODMeds.ShowMedSelect;
1941	begin
1942	txtMed.SelStart := Length(txtMed.Text);
1943	ChangeDelayed; // synch the listboxes with display
1944	pnlFields.Enabled := False;
1945	pnlFields.Visible := False;
1946	pnlMeds.Enabled := True;
1947	pnlMeds.Visible := True;
1948	pnlFields.Height := MemOrder.Top - 4 - pnlFields.Top;
1949	if btnSelect.Caption = 'Change' then
1950	begin
1951	btnSelect.Caption := 'OK';
1952	//btnSelect.Visible := false;
1953	btnSelect.Enabled := false;
1954	end;
1955	btnSelect.Top := memOrder.Top;
1956	btnSelect.Anchors := [akRight, akBottom];
1957	btnSelect.BringToFront;
1958	cmdAccept.Visible := False;
1959	cmdAccept.Default := False;
1960	btnSelect.Default := True;
1961	cmdAccept.Left := cmdQuit.Left;
1962	cmdAccept.Top := MemOrder.Top;
1963	btnSelect.TabOrder := cmdAccept.TabOrder;
1964	cmdAccept.TabStop := False;
1965	txtMed.Width := grdDoses.Width;
1966	txtMed.Font.Color := clWindowText;
1967	txtMed.Color := clWindow;
1968	txtMed.ReadOnly := False;
1969	txtMed.SelectAll;
1970	txtMed.SetFocus;
1971	FDrugID := '';
1972	//ShowOrderMessage( False );
1973	end;
1974
1975	procedure TfrmODMeds.ShowMedFields;
1976	begin
1977	pnlMeds.Enabled := False;
1978	pnlMeds.Visible := False;
1979	pnlFields.Enabled := True;
1980	pnlFields.Visible := True;
1981	pnlFields.Height := MemOrder.Top - 4 - pnlFields.Top;
1982	btnSelect.Caption := 'Change';
1983	btnSelect.Visible := True;
1984	btnSelect.Enabled := True;
1985	btnSelect.Top := txtMed.Top;
1986	btnSelect.Anchors := [akRight, akTop];
1987	btnSelect.Default := False;
1988	cmdAccept.Visible := True;
1989	cmdAccept.Default := False;
1990	cmdAccept.Left := cmdQuit.Left;
1991	cmdAccept.Top := MemOrder.Top;
1992	btnSelect.TabOrder := txtMed.TabOrder + 1;
1993	cmdAccept.TabStop := True;
1994	txtMed.Width := memOrder.Width;
1995	txtMed.Font.Color := clInfoText;
1996	txtMed.Color := clInfoBk;
1997	txtMed.ReadOnly := True;
1998	if (Responses.InstanceCount('INSTR') > 1) or (Responses.InstanceCount('DAYS') > 0)
1999	then ShowControlsComplex else ShowControlsSimple;
2000	end;
2001
2002	procedure TfrmODMeds.ShowControlsSimple;
2003	//var
2004	//dosagetxt: string;
2005	begin
2006	//Commented out, no longer using CharsNeedMatch Property
2007	{ NumCharsForMatch := 0;
2008	for i := 0 to cboDosage.Items.Count - 1 do //find the shortest unit dose text on fifth piece
2009	begin
2010	dosagetxt := Piece(cboDosage.Items[i],'^',5);
2011	if Length(dosagetxt) < 1 then break;
2012	if NumCharsForMatch = 0 then
2013	NumCharsForMatch := Length(dosagetxt);
2014	if (NumCharsForMatch > Length(dosagetxt)) then
2015	NumCharsForMatch := Length(dosagetxt);
2016	end;
2017	if NumCharsForMatch > 1 then
2018	cboDosage.CharsNeedMatch := NumCharsForMatch - 1;
2019	if NumCharsForMatch > 5 then
2020	cboDosage.CharsNeedMatch := 5;}
2021	tabDose.TabIndex := TI_DOSE;
2022	grdDoses.Visible := False;
2023	btnXInsert.Visible := False;
2024	btnXRemove.Visible := False;
2025	cboDosage.Visible := True;
2026	lblRoute.Visible := True;
2027	cboRoute.Visible := True;
2028	lblSchedule.Visible := True;
2029	cboSchedule.Visible := True;
2030	if FInptDlg = True then lblAdminSch.Visible := True
2031	else lblAdminSch.Visible := false;
2032	chkPRN.Visible := True;
2033	ActiveControl := cboDosage;
2034	end;
2035
2036	procedure TfrmODMeds.ShowControlsComplex;
2037
2038	procedure MoveCombo(SrcCombo, DestCombo: TORComboBox; CompSch: boolean = false); //AGP Changes 26.12 PSI-04-63
2039	var
2040	cnt,i,index: integer;
2041	node,text: string;
2042	begin
2043	if (CompSch = false) or not (FInptDlg)then
2044	begin
2045	DestCombo.Items.Clear;
2046	FastAssign(SrcCombo.Items, DestCombo.Items);
2047	DestCombo.ItemIndex := SrcCombo.ItemIndex;
2048	DestCombo.Text := Piece(SrcCombo.Text, TAB, 1);
2049	end;
2050	if (CompSch = true) and (FInptDlg) then // AGP Changes 26.12 PSI-04-63
2051	begin
2052	//AGP change 26.34 CQ 7201,6902 fix the problem with one time schedule still showing for inpatient complex orders
2053	DestCombo.ItemIndex := -1;
2054	Text := SrcCombo.Text;
2055	index := SrcCombo.ItemIndex;
2056	cnt := 0;
2057	for i := 0 to SrcCombo.Items.Count - 1 do
2058	begin
2059	node := SrcCombo.Items.Strings[i];
2060	if piece(node,U,3) <> 'O' then
2061	begin
2062	DestCombo.Items.Add(SrcCombo.Items.Strings[i]);
2063	if Piece(node,U,1) = text then DestCombo.ItemIndex := index - cnt;
2064	end
2065	else cnt := cnt+1;
2066	end;
2067	if (index = -1) and (Text <> '') then
2068	begin
2069	for I := 0 to DestCombo.Items.Count - 1 do
2070	if Piece(DestCombo.Items.Strings[i],U,1) = Text then
2071	begin
2072	DestCombo.ItemIndex := i;
2073	DestCombo.Text := Text;
2074	Exit;
2075	end;
2076	end;
2077	end;
2078	end;
2079
2080	//var
2081	//dosagetxt: string;
2082	begin
2083	tabDose.TabIndex := TI_COMPLEX;
2084	lblAdminSchSetTexT('');
2085	MoveCombo(cboDosage, cboXDosage);
2086	MoveCombo(cboRoute, cboXRoute);
2087	MoveCombo(cboSchedule, cboXSchedule, true); //AGP Changes 26.12 PSI-04-063
2088	grdDoses.Visible := True;
2089	btnXInsert.Visible := True;
2090	btnXRemove.Visible := True;
2091	cboDosage.Visible := False;
2092	lblRoute.Visible := False;
2093	cboRoute.Visible := False;
2094	lblSchedule.Visible := False;
2095	cboSchedule.Visible := False;
2096	chkPRN.Visible := False;
2097	FDropColumn := -1;
2098	pnlFieldsResize(Self);
2099	ActiveControl := grdDoses;
2100	//Commented out, no longer using CharsNeedMatch Property
2101	{ NumCharsForMatch := 0;
2102	for i := 0 to cboXDosage.Items.Count - 1 do //find the shortest unit dose text on fifth piece
2103	begin
2104	dosagetxt := Piece(cboXDosage.Items[i],'^',5);
2105	if Length(dosagetxt) < 1 then break;
2106	if NumCharsForMatch = 0 then
2107	NumCharsForMatch := Length(dosagetxt);
2108	if (NumCharsForMatch > Length(dosagetxt)) then
2109	NumCharsForMatch := Length(dosagetxt);
2110	end;
2111	if NumCharsForMatch > 1 then
2112	cboXDosage.CharsNeedMatch := NumCharsForMatch - 1;
2113	if NumCharsForMatch > 5 then
2114	cboDosage.CharsNeedMatch := 5;}
2115	end;
2116
2117	procedure TfrmODMeds.SetDosage(const x: string);
2118	var
2119	i, DoseIndex: Integer;
2120	begin
2121	DoseIndex := -1;
2122	with cboDosage do
2123	begin
2124	ItemIndex := -1;
2125	for i := 0 to Pred(Items.Count) do
2126	if Piece(Items[i], U, 5) = x then
2127	begin
2128	DoseIndex := i;
2129	Break;
2130	end;
2131	if DoseIndex <0 then Text := x
2132	(* if ((DoseIndex < 0) and (not IsTransferAction)) then Text := x
2133	else if ((DoseIndex < 0) and IsTransferAction) and (DosageTab = False) then Text := ''
2134	else if ((DoseIndex < 0) and IsTransferAction) and (DosageTab = True) then Text := x *)
2135	else ItemIndex := DoseIndex;
2136	end;
2137	end;
2138
2139	procedure TfrmODMeds.SetPickup(const x: string);
2140	begin
2141	radPickClinic.Checked := FALSE;
2142	radPickMail.Checked := FALSE;
2143	radPickWindow.Checked := FALSE;
2144	case CharAt(x, 1) of
2145	'C': radPickClinic.Checked := TRUE;
2146	'M': radPickMail.Checked := TRUE;
2147	'W': radPickWindow.Checked := TRUE;
2148	else {leave all unchecked}
2149	end;
2150	end;
2151
2152	procedure TfrmODMeds.SetSchedule(const x: string);
2153	var
2154	NonPRNPart,tempSch, tempText: string;
2155	begin
2156	//AGP Change 27.72 if schedule matches why goes through and reprocess the same info?
2157	if cboSchedule.ItemIndex > -1 then
2158	begin
2159	tempText := Piece(cboSchedule.Items.Strings[cboSchedule.itemindex], U, 1);
2160	if tempText = x then exit;
2161	if (Pos('PRN',x)>0) and (chkPRN.Checked = true) then
2162	begin
2163	NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1));
2164	if nonPRNPart = tempText then exit;
2165	end;
2166	end;
2167	cboSchedule.ItemIndex := -1;
2168	cboSchedule.Text := '';
2169	if chkPRN.Checked = True then chkPRN.Checked := False;
2170	cboSchedule.SelectByID(x);
2171	if cboSchedule.ItemIndex > -1 then exit;
2172	if (X = ' PRN') or (X = 'PRN') then
2173	begin
2174	chkPRN.Checked := True;
2175	Exit;
2176	end;
2177	// if cboSchedule.ItemIndex < 0 then
2178	//begin
2179	//if NSSchedule then
2180	//begin
2181	// cboSchedule.Text := '';
2182	//end
2183	if FInptDlg then
2184	begin
2185	if (Pos('@', x) > 0) then
2186	begin
2187	tempSch := Piece(x, '@', 2);
2188	cboSchedule.SelectByID(tempSch);
2189	if cboSchedule.ItemIndex > -1 then
2190	begin
2191	tempSch := Piece(x, '@', 1) + '@' + cboSchedule.Items.Strings[cboSchedule.itemindex];
2192	cboSchedule.Items.Add(tempSch);
2193	cboSchedule.Text := (Piece(tempSch,U,1));
2194	cboSchedule.SelectByID(Piece(tempSch,u,1));
2195	EXIT;
2196	end;
2197	if Pos('PRN', tempSch) > 0 then
2198	begin
2199	NonPRNPart := Trim(Copy(tempSch, 1, Pos('PRN', tempSch) - 1));
2200	cboSchedule.SelectByID(NonPRNPart);
2201	if cboSchedule.ItemIndex > -1 then
2202	begin
2203	tempSch := Piece(x, '@', 1) + '@' + cboSchedule.Items.Strings[cboSchedule.itemindex];
2204	cboSchedule.Items.Add(tempSch);
2205	cboSchedule.Text := (Piece(tempSch,U,1));
2206	cboSchedule.SelectByID(Piece(tempSch,u,1));
2207	chkPRN.Checked := True;
2208	EXIT;
2209	end
2210	else
2211	begin
2212	NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1));
2213	chkPRN.Checked := true;
2214	tempSch := NonPRNPart + U + U + U + Piece(NonPRNPart, '@', 2);
2215	cboSchedule.Items.Add(tempSch);
2216	cboSchedule.SelectByID(Piece(tempSch, U, 1));
2217	EXIT;
2218	end;
2219	end;
2220	cboSchedule.Items.Add(X + U + U + U + Piece(x, '@', 2));
2221	cboSchedule.Text := x;
2222	cboSchedule.SelectByID(x);
2223	EXIT;
2224	end
2225	else if Pos('PRN', x) > 0 then
2226	begin
2227	NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1));
2228	chkPRN.Checked := True;
2229	cboSchedule.SelectByID(NonPRNPart);
2230	if cboSchedule.ItemIndex > -1 then EXIT;
2231	end;
2232	end
2233	else if Pos('PRN', x) > 0 then
2234	begin
2235	NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1));
2236	chkPRN.Checked := True;
2237	cboSchedule.SelectByID(NonPRNPart);
2238	if cboSchedule.ItemIndex > -1 then EXIT;
2239	cboSchedule.Items.Add(NonPRNPart);
2240	cboSchedule.Text := NonPRNPart;
2241	cboSchedule.SelectByID(NonPRNPart);
2242	EXIT;
2243	end;
2244	cboSchedule.Items.Add(x);
2245	cboSchedule.Text := x;
2246	cboSchedule.SelectByID(x);
2247	end;
2248
2249	{ Medication edit --------------------------------------------------------------------------- }
2250	procedure TfrmODMeds.tabDoseChange(Sender: TObject);
2251	var
2252	//text,x, tmpsch: string;
2253	text, tmpAdmin, x: string;
2254	reset: integer;
2255	begin
2256	inherited;
2257	reset := 0;
2258	//AGP change for CQ 6521 added warning message
2259	//AGP Change for CQ 7508 added tab information
2260	//GE Change warning message functionality show only cq 7590
2261	// when tab changes from complex to simple.
2262	//AGP Change for CQ 7834 and 7832 change text and added check to see if some values have been completed in row 1
2263	if (tabDose.TabIndex = 0) and ((ValFor(COL_DOSAGE, 1)<>'') or (ValFor(COL_SCHEDULE, 1)<>'') or (ValFor(COL_DURATION, 1)<>'') or
2264	(ValFor(COL_SEQUENCE, 1)<>'')) then
2265	begin
2266	text := 'By switching to the Dosage Tab, ' ;
2267	if (InfoBox(text +'you will lose all data on this screen. Click OK to continue or Cancel','Warning',MB_OKCANCEL)=IDCANCEL) then
2268	begin
2269	if tabDose.TabIndex = 1 then tabDose.TabIndex := 0
2270	else tabDose.TabIndex := 1;
2271	reset := 1;
2272	end;
2273	end;
2274	case tabDose.TabIndex of
2275	TI_DOSE: begin
2276	cboXSchedule.Clear; // Added to Fix CQ: 9603
2277	cboXDosage.Clear;
2278	// clean up responses?
2279	FSuppressMsg := FOrigiMsgDisp;
2280	ShowControlsSimple;
2281	if reset = 0 then ResetOnTabChange;
2282	txtNss.Left := lblSchedule.Left + lblSchedule.Width + 2;
2283	if (FInptDlg) then txtNss.Visible := True
2284	else txtNss.Visible := False;
2285	cboXRoute.Hide; // Added to Fix CQ: 7640
2286	ControlChange(Self);
2287	end;
2288	TI_RATE: begin
2289	// for future use...
2290	end;
2291	TI_COMPLEX: begin
2292	FSuppressMsg := FOrigiMsgDisp;
2293	if reset = 1 then exit;
2294	(* AGP Change admin wrap 27.73
2295	tmpAdmin := Piece(self.lblAdminSch.text, ':', 2);
2296	tmpAdmin := Copy(tmpAdmin,2,Length(tmpAdmin)); *)
2297	tmpAdmin := lblAdminSchGetText;
2298	if FAdminTimeText <> '' then
2299	begin
2300	tmpAdmin := FAdminTimeText;
2301	if FAdminTimeText <> 'Not defined for Clinic Locations' then self.lblAdminSch.Visible := False;
2302	end;
2303	ShowControlsComplex;
2304	ResetOnTabChange;
2305	txtNss.Left := grdDoses.Left + grdDoses.ColWidths[0] + grdDoses.ColWidths[1] + grdDoses.ColWidths[2] + 3;
2306	txtNss.Visible := False;
2307	x := cboXDosage.Text + TAB;
2308	if LeftStr(x,1) = '.' then x := '';
2309	with cboXDosage do if ItemIndex > -1 then x := x + Items[ItemIndex];
2310	grdDoses.Cells[COL_DOSAGE, 1] := x;
2311	x := cboXRoute.Text + TAB;
2312	with cboXRoute do if ItemIndex > -1 then x := x + Items[ItemIndex];
2313	grdDoses.Cells[COL_ROUTE, 1] := x;
2314	x := cboXSchedule.Text + TAB;
2315	with cboXSchedule do if ItemIndex > -1 then x := x + Items[ItemIndex];
2316	grdDoses.Cells[COL_SCHEDULE, 1] := x;
2317	//AGP Change 27.1 handle PRN not showing in schedule panel if a dose is not selected.
2318	if FSmplPRNChkd then
2319	begin
2320	pnlXSchedule.Tag := 1;
2321	self.chkXPRN.Checked := True;
2322	end;
2323	if FInptDLG then UpdateStartExpires(ValFor(VAL_SCHEDULE,1));
2324	ControlChange(Self);
2325	end; {TI_COMPLEX}
2326	end; {case}
2327	if ScreenReaderSystemActive then
2328	GetScreenReader.Speak(tabDose.Tabs[tabDose.TabIndex] + ' tab');
2329	end;
2330
2331
2332	function TfrmODMeds.lblAdminSchGetText: string;
2333	var
2334	tempstr: string;
2335	i: integer;
2336	begin
2337	result := '';
2338	if self.lblAdminSch.Text = '' then exit;
2339	tempstr := '';
2340	if self.lblAdminSch.Lines.Count > 1 then
2341	begin
2342	for i := 0 to self.lblAdminSch.Lines.Count - 1 do
2343	tempstr := tempStr + self.lblAdminSch.Lines.Strings[i];
2344	end
2345	else if self.lblAdminSch.Lines.Count = 1 then
2346	begin
2347	tempstr := self.lblAdminSch.Text;
2348	end;
2349	Result := Piece(tempStr,':',2);
2350	Result := Copy(Result,2,Length(Result));
2351	end;
2352
2353	procedure TfrmODMeds.lblAdminSchSetText(str: string);
2354	var
2355	cutoff: integer;
2356	begin
2357	cutoff := lblAdminSch.width div MainFontWidth;
2358	if Length(str) > cutoff then self.lblAdminSch.Text := Copy(str, 1, cutoff) + CRLF +
2359	Copy(str, cutoff + 1, Length(str))
2360	else self.lblAdminSch.Text := str;
2361	end;
2362
2363	procedure TfrmODMeds.lblGuidelineClick(Sender: TObject);
2364	var
2365	TextStrings: TStringList;
2366	begin
2367	inherited;
2368	TextStrings := TStringList.Create;
2369	try
2370	TextStrings.Text := FGuideline.Text;
2371	ReportBox(TextStrings, TC_GUIDELINE, TRUE);
2372	finally
2373	TextStrings.Free;
2374	end;
2375	//if FGuideline.Count > 0 then InfoBox(FGuideline.Text, 'Restrictions/Guidelines', MB_OK);
2376	end;
2377
2378	{ cboDosage ------------------------------------- }
2379
2380	procedure TfrmODMeds.CheckFormAltDose(DispDrug: Integer);
2381	var
2382	OI: Integer;
2383	OIName: string;
2384	begin
2385	if FAltChecked or (DispDrug = 0) then Exit;
2386	OI := txtMed.Tag;
2387	OIName := txtMed.Text;
2388	CheckFormularyDose(DispDrug, OI, OIName, FInptDlg);
2389	if OI <> txtMed.Tag then
2390	begin
2391	ResetOnMedChange;
2392	txtMed.Tag := OI;
2393	txtMed.Text := OIName;
2394	SetOnMedSelect;
2395	end;
2396	end;
2397
2398	procedure TfrmODMeds.cboDosageClick(Sender: TObject);
2399	var
2400	DispDrug: Integer;
2401	x: string;
2402	begin
2403	inherited;
2404	if FSuppressMsg then
2405	begin
2406	if PnlMessage.Visible = true then
2407	begin
2408	memMessage.SendToBack;
2409	PnlMessage.Visible := False;
2410	end;
2411	end;
2412	UpdateRelated(False);
2413	DispDrug := StrToIntDef(ValueOf(FLD_DRUG_ID), 0);
2414	if DispDrug > 0 then
2415	begin
2416	if not FSuppressMsg then
2417	begin
2418	DispOrderMessage(DispenseMessage(DispDrug));
2419	end;
2420	x := QuantityMessage(DispDrug);
2421	end
2422	else x := '';
2423	if Length(ValueOf(FLD_QTYDISP))>10 then
2424	begin
2425	lblQuantity.Caption := Copy(ValueOf(FLD_QTYDISP),0,7) + '...';
2426	lblQuantity.Hint := ValueOf(FLD_QTYDISP);
2427	end else
2428	begin
2429	lblQuantity.Caption := ValueOf(FLD_QTYDISP);
2430	lblQuantity.Hint := '';
2431	end;
2432	if Length(x) > 0
2433	then lblQtyMsg.Caption := TX_QTY_PRE + x + TX_QTY_POST
2434	else lblQtyMsg.Caption := '';
2435	with cboDosage do
2436	if (ItemIndex > -1) and (Piece(Items[ItemIndex], U, 3) = 'NF')
2437	then CheckFormAltDose(DispDrug);
2438	end;
2439
2440	procedure TfrmODMeds.cboDosageChange(Sender: TObject);
2441	var
2442	temp1,temp2: string;
2443	Count: integer;
2444	begin
2445	inherited;
2446	Count := Pos(U,cboDosage.Text);
2447	if Count > 0 then
2448	begin
2449	temp1 := copy(cboDosage.Text,0,count-1);
2450	temp2 := copy(cboDosage.Text,count+1,Length(cboDosage.text));
2451	infoBox('An ^ is not allowed in the dosage value', 'Dosage Warning', MB_OK);
2452	cboDosage.Text := temp1 + temp2;
2453	end;
2454	UpdateRelated;
2455	end;
2456
2457	procedure TfrmODMeds.cboDosageExit(Sender: TObject);
2458	var
2459	str: string;
2460	begin
2461	inherited;
2462	str := cboDosage.Text;
2463	if (length(cboDosage.Text)<1) then
2464	cboDosage.ItemIndex := -1;
2465	(* Probably not needed here since this on validation check on accept
2466	if (LeftStr(cboDosage.Text,1)='.') then
2467	begin
2468	infoBox('Dosage must have a leading numeric value','Invalid Dosage',MB_OK);
2469	if self.tabDose.TabIndex = TI_DOSE then cboDosage.SetFocus;
2470	Exit;
2471	end; *)
2472	if (length(cbodosage.Text)>0) and (cboDosage.ItemIndex > -1) and
2473	(Piece(cboDosage.Items.Strings[cboDosage.ItemIndex],U,5) <> Piece(cboDosage.Text,tab,1)) then
2474	begin
2475	cboDosage.ItemIndex := -1;
2476	cboDosage.Text := Piece(str, tab, 1);
2477	UpdateRelated(false);
2478	end;
2479	if ActiveControl = memMessage then
2480	begin
2481	memMessage.SendToBack;
2482	PnlMessage.Visible := False;
2483	Exit;
2484	end;
2485	if ActiveControl = memComment then
2486	begin
2487	if PnlMessage.Visible = true then
2488	begin
2489	memMessage.SendToBack;
2490	PnlMessage.Visible := False;
2491	end;
2492	end
2493	else if (ActiveControl <> btnSelect) and (ActiveControl <> memComment) then
2494	begin
2495	if PnlMessage.Visible = true then
2496	begin
2497	memMessage.SendToBack;
2498	PnlMessage.Visible := False;
2499	end;
2500	//cboDosageClick(Self);
2501	end;
2502	end;
2503
2504	{ cboRoute -------------------------------------- }
2505
2506	procedure TfrmODMeds.cboRouteChange(Sender: TObject);
2507	begin
2508	inherited;
2509	with cboRoute do
2510	if ItemIndex > -1 then
2511	begin
2512	if Piece(Items[ItemIndex], U, 5) = '1'
2513	then tabDose.Tabs[0] := 'Dosage / Rate'
2514	else tabDose.Tabs[0] := 'Dosage';
2515	end;
2516	cboDosage.Caption := tabDose.Tabs[0];
2517	if Sender <> Self then ControlChange(Sender);
2518	end;
2519
2520	procedure TfrmODMeds.cboRouteExit(Sender: TObject);
2521	begin
2522	if Trim(cboRoute.Text) = '' then
2523	cboRoute.ItemIndex := -1;
2524	// ValidateRoute(cboRoute); Removed based on Site feeback. See CQ: 7518
2525	inherited;
2526	end;
2527
2528	procedure TfrmODMeds.cboRouteKeyUp(Sender: TObject; var Key: Word;
2529	Shift: TShiftState);
2530	begin
2531	inherited;
2532	if (Key = VK_BACK) and (cboRoute.Text = '') then cboRoute.ItemIndex := -1;
2533	end;
2534
2535	{ cboSchedule ----------------------------------- }
2536
2537	procedure TfrmODMeds.cboScheduleClick(Sender: TObject);
2538	var
2539	othSch: string;
2540	idx : integer;
2541	begin
2542	inherited;
2543	if (FInptDlg) and (cboSchedule.Text = 'OTHER') then
2544	begin
2545	othSch := CreateOtherScheduel;
2546	if length(trim(othSch)) > 1 then
2547	begin
2548	othSch := othSch + U + U + NSSScheduleType + U + NSSAdminTime;
2549	cboSchedule.Items.Add(othSch);
2550	idx := cboSchedule.Items.IndexOf(Piece(OthSch, U, 1));
2551	cboSchedule.ItemIndex := idx;
2552	end;
2553	end
2554	else
2555	begin
2556	NSSAdminTime := '';
2557	FNSSScheduleType := '';
2558	end;
2559	UpdateRelated(False);
2560	end;
2561
2562
2563	procedure TfrmODMeds.cboScheduleChange(Sender: TObject);
2564	var
2565	othSch: string;
2566	idx : integer;
2567	begin
2568	inherited;
2569	if (FInptDlg) and (cboSchedule.Text = 'OTHER') then
2570	begin
2571	othSch := CreateOtherScheduel;
2572	if length(trim(othSch)) > 1 then
2573	begin
2574	othSch := othSch + U + U + NSSScheduleType + U + NSSAdminTime;
2575	cboSchedule.Items.Add(othSch);
2576	idx := cboSchedule.Items.IndexOf(Piece(OthSch, U, 1));
2577	cboSchedule.ItemIndex := idx;
2578	end;
2579	end;
2580	FScheduleChanged := true;
2581	UpdateRelated;
2582	end;
2583
2584
2585	{ Duration ----------------------------- }
2586	procedure TfrmODMeds.UpdateDurationControls( FreeText: boolean);
2587	begin
2588	if FreeText then
2589	begin
2590	pnlXDurationButton.Width := 8;
2591	pnlXDurationButton.Align := alRight;
2592	spnXDuration.Visible := False;
2593	txtXduration.Align := alClient;
2594	end
2595	else
2596	begin
2597	txtXduration.Align := alNone;
2598	txtXduration.Width := pnlXDuration.Width - (pnlXDuration.Width div 2) - spnXDuration.Width + 2;
2599	pnlXDurationButton.Width := pnlXDuration.Width div 2;
2600	pnlXDurationButton.Align := alRight;
2601	spnXDuration.Visible := True;
2602	spnXDuration.AlignButton := udRight;
2603	end;
2604	end;
2605
2606	procedure TfrmODMeds.popDurationClick(Sender: TObject);
2607	var
2608	x: string;
2609	begin
2610	inherited;
2611	with TMenuItem(Sender) do
2612	begin
2613	if Tag > 0 then
2614	begin
2615	x := LowerCase(Caption);
2616	//Make sure duration is integer
2617	txtXDuration.Text := IntToStr(StrToIntDef(txtXDuration.Text,0));
2618	UpdateDurationControls(False);
2619	end
2620	else begin
2621	x := '';
2622	txtXDuration.Text := '';
2623	UpdateDurationControls(True);
2624	end;
2625	end;
2626	btnXDuration.Caption := x;
2627	txtXDurationChange(Sender);
2628	ControlChange(Sender);
2629	end;
2630
2631	procedure TfrmODMeds.QuantityMessageCheck(tag: integer);
2632	var
2633	DispDrug: integer;
2634	x: string;
2635
2636	begin
2637	if FInptDlg then Exit;
2638	DispDrug := StrToIntDef(ValueOf(FLD_DRUG_ID, tag), 0);
2639	if DispDrug > 0 then
2640	begin
2641	if not FSuppressMsg then
2642	begin
2643	DispOrderMessage(DispenseMessage(DispDrug));
2644	FSuppressMsg := False;
2645	end;
2646	x := QuantityMessage(DispDrug);
2647	end
2648	else x := '';
2649	if Length(x) > 0
2650	then lblQtyMsg.Caption := TX_QTY_PRE + x + TX_QTY_POST
2651	else lblQtyMsg.Caption := '';
2652	end;
2653
2654	{ txtSupply, txtQuantity -------------------------- }
2655
2656	procedure TfrmODMeds.txtSupplyChange(Sender: TObject);
2657	begin
2658	inherited;
2659	if Changing then Exit;
2660	if not Showing then Exit;
2661	if FNoZERO = False then FNoZERO := True;
2662
2663	// if value = 0, change probably caused by the spin button
2664	if txtSupply.Text <> '0' then txtSupply.Tag := 1;
2665	UpdateRelated;
2666	end;
2667
2668	procedure TfrmODMeds.txtQuantityChange(Sender: TObject);
2669	begin
2670	inherited;
2671	if Changing then Exit;
2672	if not Showing then
2673	begin
2674	if (FISQuickOrder = true) and (txtQuantity.Text = '0') and (FLastQuantity > 0) and (FLastQuantity <> StrtoInt64(txtQuantity.text)) then
2675	begin
2676	Changing := True;
2677	txtQuantity.Text := FloattoStr(FLastQuantity);
2678	Changing := False;
2679	end;
2680	Exit;
2681	end;
2682	if FNoZERO = False then FNoZERO := True;
2683	// if value = 0, change probably caused by the spin button
2684	if txtQuantity.Text <> '0' then txtQuantity.Tag := 1;
2685	UpdateRelated;
2686	end;
2687
2688	{ values changing }
2689
2690	function TfrmODMeds.OutpatientSig: string;
2691	var
2692	Dose, Route, Schedule, Duration, x: string;
2693	i: Integer;
2694	begin
2695	case tabDose.TabIndex of
2696	TI_DOSE:
2697	begin
2698	if ValueOf(FLD_TOTALDOSE) = ''
2699	then Dose := ValueOf(FLD_LOCALDOSE)
2700	else Dose := ValueOf(FLD_UNITNOUN);
2701	CheckDecimal(Dose);
2702	Route := ValueOf(FLD_ROUTE_EX);
2703	if (Length(Route) > 0) and (Length(FSigPrep) > 0) then Route := FSigPrep + ' ' + Route;
2704	if Length(Route) = 0 then Route := ValueOf(FLD_ROUTE_NM);
2705	Schedule := ValueOf(FLD_SCHED_EX);
2706	(* Schedule := Piece(Temp,U,1);
2707	if Piece(Temp,U,3) = '1' then Schedule := Schedule + ' AS NEEDED';
2708	if UpperCase(Copy(Schedule, Length(Schedule) - 18, Length(Schedule))) = 'AS NEEDED AS NEEDED'
2709	then Schedule := Copy(Schedule, 1, Length(Schedule) - 10); *)
2710	if Length(Schedule) = 0 then
2711	begin
2712	Schedule := ValueOf(FLD_SCHEDULE);
2713	if RightStr(Schedule,3) = 'PRN' then
2714	begin
2715	Schedule := Copy(Schedule,1,Length(Schedule)-3); //Remove the Trailing PRN
2716	if (RightStr(Schedule,1) = ' ') or (RightStr(Schedule,1) = '-') then
2717	Schedule := Copy(Schedule,1,Length(Schedule)-1);
2718	Schedule := Schedule + ' AS NEEDED'
2719	end;
2720	end;
2721	Result := FSIGVerb + ' ' + Dose + ' ' + Route + ' ' + Schedule;
2722	end;
2723	TI_COMPLEX:
2724	begin
2725	with grdDoses do for i := 1 to Pred(RowCount) do
2726	begin
2727	if Length(ValueOf(FLD_LOCALDOSE, i)) = 0 then Continue;
2728	if FDrugID = '' then
2729	begin
2730	Dose := ValueOf(FLD_DOSETEXT, i);
2731	CheckDecimal(Dose);
2732	end
2733	else
2734	begin
2735	if ValueOf(FLD_TOTALDOSE, i) = ''
2736	then Dose := ValueOf(FLD_LOCALDOSE, i)
2737	else Dose := ValueOf(FLD_UNITNOUN, i);
2738	CheckDecimal(Dose);
2739	end;
2740	Route := ValueOf(FLD_ROUTE_EX, i);
2741	if (Length(Route) > 0) and (Length(FSigPrep) > 0) then Route := FSigPrep + ' ' + Route;
2742	if Length(Route) = 0 then Route := ValueOf(FLD_ROUTE_NM, i);
2743	Schedule := ValueOf(FLD_SCHED_EX, i);
2744	//if Length(Schedule) = 0 then Schedule := ValueOf(FLD_SCHEDULE, i);
2745	if Length(Schedule) = 0 then
2746	begin
2747	Schedule := ValueOf(FLD_SCHEDULE);
2748	if RightStr(Schedule,3) = 'PRN' then
2749	begin
2750	Schedule := Copy(Schedule,1,Length(Schedule)-3); //Remove the Trailing PRN
2751	if (RightStr(Schedule,1) = ' ') or (RightStr(Schedule,1) = '-') then
2752	Schedule := Copy(Schedule,1,Length(Schedule)-1);
2753	Schedule := Schedule + ' AS NEEDED'
2754	end;
2755	end;
2756	Duration := ValueOf(FLD_DURATION, i);
2757	if Length(Duration) > 0 then Duration := 'FOR ' + Duration;
2758	x := FSIGVerb + ' ' + Dose + ' ' + Route + ' ' + Schedule + ' ' + Duration;
2759	if i > 1
2760	then Result := Result + ' ' + ValueOf(FLD_SEQUENCE, i-1) + ' ' + x
2761	else Result := x;
2762	end; {with grdDoses}
2763	end; {TI__COMPLEX}
2764	end; {case}
2765	end;
2766
2767	function TfrmODMeds.InpatientSig: string;
2768	var
2769	Dose, Route, Schedule, Duration, x: string;
2770	i: Integer;
2771	begin
2772	case tabDose.TabIndex of
2773	TI_DOSE:
2774	begin
2775	Dose := ValueOf(FLD_LOCALDOSE);
2776	CheckDecimal(Dose);
2777	Route := ValueOf(FLD_ROUTE_AB);
2778	if Route = '' then Route := ValueOf(FLD_ROUTE_NM);
2779	Schedule := ValueOf(FLD_SCHEDULE);
2780	Result := Dose + ' ' + Route + ' ' + Schedule;
2781	end;
2782	TI_COMPLEX:
2783	begin
2784	with grdDoses do for i := 1 to Pred(RowCount) do
2785	begin
2786	if Length(ValueOf(FLD_LOCALDOSE, i)) = 0 then Continue;
2787	if FDrugID = ''
2788	then Dose := ValueOf(FLD_DOSETEXT, i)
2789	else Dose := ValueOf(FLD_LOCALDOSE, i);
2790	CheckDecimal(Dose);
2791	Route := ValueOf(FLD_ROUTE_AB, i);
2792	if Route = '' then Route := ValueOf(FLD_ROUTE_NM, i);
2793	Schedule := ValueOf(FLD_SCHEDULE, i);
2794	Duration := ValueOf(FLD_DURATION, i);
2795	if Length(Duration) > 0 then Duration := 'FOR ' + Duration;
2796	x := Dose + ' ' + Route + ' ' + Schedule + ' ' + Duration;
2797	if i > 1
2798	then Result := Result + ' ' + ValueOf(FLD_SEQUENCE, i-1) + ' ' + x
2799	else Result := x;
2800	end; {with grdDoses}
2801	end; {TI__COMPLEX}
2802	end; {case}
2803	end;
2804
2805
2806	function TfrmODMeds.ConstructedDoseFields(const ADose: string; PrependName: Boolean = FALSE): string;
2807	var
2808	i, DrugIndex: Integer;
2809	UnitsPerDose, Strength: Extended;
2810	Units, Noun, AName: string;
2811	begin
2812	DrugIndex := -1;
2813	for i := 0 to Pred(FAllDrugs.Count) do
2814	if AnsiSameText(Piece(FAllDrugs[i], U, 1), FDrugID) then
2815	begin
2816	DrugIndex := i;
2817	Break;
2818	end;
2819	Strength := StrToFloatDef(Piece(FAllDrugs[DrugIndex], U, 2), 0);
2820	Units := Piece(FAllDrugs[DrugIndex], U, 3);
2821	AName := Piece(FAllDrugs[DrugIndex], U, 4);
2822	if FAllDoses.Count > 0
2823	then Noun := Piece(Piece(FAllDoses[0], U, 3), '&', 4)
2824	else Noun := '';
2825	if Strength > 0
2826	then UnitsPerDose := ExtractFloat(ADose) / Strength
2827	else UnitsPerDose := 0;
2828	if (UnitsPerDose > 1) and (Noun <> '') and (CharAt(Noun, Length(Noun)) <> 'S')
2829	then Noun := Noun + 'S';
2830	Result := FloatToStr(ExtractFloat(ADose)) + '&' + Units + '&' + FloatToStr(UnitsPerDose)
2831	+ '&' + Noun + '&' + ADose + '&' + FDrugID + '&' + FloatToStr(Strength) + '&'
2832	+ Units;
2833	if PrependName then Result := AName + U + FloatToStr(Strength) + Units + U + U +
2834	Result + U + ADose;
2835	Result := UpperCase(Result);
2836	end;
2837
2838	function TfrmODMeds.FieldsForDrug(const DrugID: string): string;
2839	var
2840	i, DrugIndex: Integer;
2841	begin
2842	Result := '';
2843	DrugIndex := -1;
2844	for i := 0 to Pred(FAllDrugs.Count) do
2845	begin
2846	if AnsiSameText(Piece(FAllDrugs[i], U, 1), DrugID) then DrugIndex := i;
2847	end;
2848	if DrugIndex > -1 then Result := FAllDrugs[DrugIndex];
2849	end;
2850
2851	function TfrmODMeds.FieldsForDose(ARow: Integer): string;
2852	var
2853	i: Integer;
2854	DoseDrug: string;
2855	begin
2856	Result := Piece(Piece(grdDoses.Cells[COL_DOSAGE, ARow], TAB, 2), U, 4);
2857	//AGP CHANGE 26.33 change for Remedy ticket 87476 fix for quick orders for complex
2858	//inpatient orders not displaying the correct unit dose in Pharmacy
2859	//if (not FInptDlg) and (Length(FDrugID) > 0) then
2860	if Length(FDrugID) > 0 then
2861	begin
2862	Result := '';
2863	DoseDrug := Piece(Piece(grdDoses.Cells[COL_DOSAGE, ARow], TAB, 2), U, 5);
2864	if DoseDrug = '' then DoseDrug := Piece(grdDoses.Cells[COL_DOSAGE, ARow], TAB, 1);
2865	DoseDrug := DoseDrug + U + FDrugID;
2866	for i := 0 to Pred(FAllDoses.Count) do
2867	begin
2868	// CQ #16957 - Corrected code that would potentially mis-match drugs - JCS
2869	//if AnsiSameText(DoseDrug, Copy(FAllDoses[i], 1, Length(DoseDrug))) then
2870	if AnsiSameText(DoseDrug, Pieces(FAllDoses[i],U,1,2)) then
2871	begin
2872	Result := Piece(FAllDoses[i], U, 3);
2873	Break;
2874	end; {if AnsiSameText}
2875	end; {for i}
2876	if Result = '' then Result := ConstructedDoseFields(Piece(DoseDrug, U, 1));
2877	end;
2878	end;
2879
2880	function TfrmODMeds.FindDoseFields(const Drug, ADose: string): string;
2881	var
2882	i: Integer;
2883	x: string;
2884	begin
2885	Result := '';
2886	x := ADose + U + Drug + U;
2887	for i := 0 to Pred(FAllDoses.Count) do
2888	begin
2889	if AnsiSameText(x, Copy(FAllDoses[i], 1, Length(x))) then
2890	begin
2891	Result := Piece(FAllDoses[i], U, 3);
2892	Break;
2893	end;
2894	end;
2895	end;
2896
2897	function TfrmODMeds.FindCommonDrug(DoseList: TStringList): string;
2898	// DoseList[n] = DoseText ^ Dispense Drug Pointer
2899	var
2900	i, j, UnitIndex: Integer;
2901	DrugStrength, DoseValue, UnitsPerDose: Extended;
2902	DrugOK, PossibleDoses, SplitTab: Boolean;
2903	ADrug, ADose, DoseFields, DoseUnits, DrugUnits: string;
2904	FoundDrugs: TStringList;
2905
2906	procedure SaveDrug(const ADrug: string; UnitsPerDose: Extended);
2907	var
2908	i, DrugIndex: Integer;
2909	CurUnits: Extended;
2910	begin
2911	DrugIndex := -1;
2912	for i := 0 to Pred(FoundDrugs.Count) do
2913	if AnsiSameText(Piece(FoundDrugs[i], U, 1), ADrug) then DrugIndex := i;
2914	if DrugIndex = -1 then FoundDrugs.Add(ADrug + U + FloatToStr(UnitsPerDose)) else
2915	begin
2916	CurUnits := StrToFloatDef(Piece(FoundDrugs[DrugIndex], U, 2), 0);
2917	if UnitsPerDose > CurUnits
2918	then FoundDrugs[DrugIndex] := ADrug + U + FloatToStr(UnitsPerDose);
2919	end;
2920	end;
2921
2922	procedure KillDrug(const ADrug: string);
2923	var
2924	i, DrugIndex: Integer;
2925	begin
2926	DrugIndex := -1;
2927	for i := 0 to Pred(FoundDrugs.Count) do
2928	if AnsiSameText(Piece(FoundDrugs[i], U, 1), ADrug) then DrugIndex := i;
2929	if DrugIndex > -1 then FoundDrugs.Delete(DrugIndex);
2930	end;
2931
2932	begin
2933	Result := '';
2934	if FInptDlg then // inpatient dialog
2935	begin
2936	DrugOK := True;
2937	for i := 0 to Pred(DoseList.Count) do
2938	begin
2939	ADrug := Piece(DoseList[i], U, 2);
2940	if ADrug = '' then DrugOK := False;
2941	if Result = '' then Result := ADrug;
2942	if not AnsiSameText(ADrug, Result) then DrugOK := False;
2943	if not DrugOK then Break;
2944	end;
2945	if not DrugOK then Result :='';
2946	end else // outpatient dialog
2947	begin
2948	// check the dose combinations for each dispense drug
2949	FoundDrugs := TStringList.Create;
2950	try
2951	if FAllDoses.Count > 0
2952	then PossibleDoses := Length(Piece(Piece(FAllDoses[0], U, 3), '&', 1)) > 0
2953	else PossibleDoses := False;
2954	for i := 0 to Pred(FAllDrugs.Count) do
2955	begin
2956	ADrug := Piece(FAllDrugs[i], U, 1);
2957	DrugOK := True;
2958	DrugStrength := StrToFloatDef(Piece(FAllDrugs[i], U, 2), 0);
2959	DrugUnits := Piece(FAllDrugs[i], U, 3);
2960	SplitTab := Piece(FAllDrugs[i], U, 5) = '1';
2961	for j := 0 to Pred(DoseList.Count) do
2962	begin
2963	ADose:= Piece(DoseList[j], U, 1);
2964	DoseFields := FindDoseFields(ADrug, ADose); // get the idnode for the dose/drug combination
2965	if not PossibleDoses then
2966	begin
2967	if DoseFields = '' then DrugOK := False else SaveDrug(ADrug, 0);
2968	end else
2969	begin
2970	DoseValue := StrToFloatDef(Piece(DoseFields, '&', 1), 0);
2971	if DoseValue = 0 then DoseValue := ExtractFloat(ADose);
2972	UnitsPerDose := DoseValue / DrugStrength;
2973	if (Frac(UnitsPerDose) = 0) or (SplitTab and (Frac(UnitsPerDose) = 0.5))
2974	then SaveDrug(ADrug, UnitsPerDose)
2975	else DrugOK := False;
2976	// make sure this dose is using the same units as the drug
2977	if DoseFields = '' then
2978	begin
2979	for UnitIndex := 1 to Length(ADose) do
2980	if not (ADose[UnitIndex] in ['0'..'9','.']) then Break;
2981	DoseUnits := Copy(ADose, UnitIndex, Length(ADose));
2982	end
2983	else DoseUnits := Piece(DoseFields, '&', 2);
2984	if (not AnsiSameText(DoseUnits, DrugUnits)) then DrugOK := False;
2985	end;
2986	if not DrugOK then
2987	begin
2988	KillDrug(ADrug);
2989	Break;
2990	end; {if not DrugOK}
2991	end; {with..for j}
2992	end; {for i}
2993	if FoundDrugs.Count > 0 then
2994	begin
2995	if not PossibleDoses then Result := Piece(FoundDrugs[0], U, 1) else
2996	begin
2997	UnitsPerDose := 99999999;
2998	for i := 0 to Pred(FoundDrugs.Count) do
2999	begin
3000	if StrToFloatDef(Piece(FoundDrugs[i], U, 2), 99999999) < UnitsPerDose then
3001	begin
3002	Result := Piece(FoundDrugs[i], U, 1);
3003	UnitsPerDose := StrToFloatDef(Piece(FoundDrugs[i], U, 2), 99999999);
3004	end; {if StrToFloatDef}
3005	end; {for i..FoundDrugs}
3006	end; {if not..else PossibleDoses}
3007	end; {if FoundDrugs}
3008	finally
3009	FoundDrugs.Free;
3010	end; {try}
3011	end; {if..else FInptDlg}
3012	end; {FindCommonDrug}
3013
3014	procedure TfrmODMeds.ControlChange(Sender: TObject);
3015	var
3016	x,ADose,AUnit,ADosageText: string;
3017	i, LastDose: Integer;
3018	DoseList: TStringList;
3019	begin
3020	inherited;
3021	if csLoading in ComponentState then Exit; // to prevent error caused by txtRefills
3022	if Changing then Exit;
3023	if txtMed.Tag = 0 then Exit;
3024	ADose := '';
3025	AUnit := '';
3026	ADosageText := '';
3027	FUpdated := FALSE;
3028	Responses.Clear;
3029	if self.MedName = '' then Responses.Update('ORDERABLE', 1, IntToStr(txtMed.Tag), txtMed.Text)
3030	else Responses.Update('ORDERABLE', 1, IntToStr(txtMed.Tag), self.MedName);
3031	DoseList := TStringList.Create;
3032	case tabDose.TabIndex of
3033	TI_DOSE:
3034	begin
3035	if (cboDosage.ItemIndex < 0) and (Length(cboDosage.Text) > 0) then
3036	begin
3037	// try to resolve freetext dose and add it as a new item to the combobox
3038	ADosageText := cboDosage.Text;
3039	ADose := Piece(ADosageText,' ',1);
3040	Delete(ADosageText,1,Length(ADose)+1);
3041	ADosageText := ADose + Trim(ADosageText);
3042	DoseList.Add(ADosageText);
3043	FDrugID := FindCommonDrug(DoseList);
3044	if FDrugID <> '' then
3045	begin
3046	if ExtractFloat(cboDosage.Text) > 0 then
3047	begin
3048	x := ConstructedDoseFields(cboDosage.Text, TRUE);
3049	FDrugID := '';
3050	with cboDosage do ItemIndex := cboDosage.Items.Add(x);
3051	end;
3052	end;
3053	end;
3054	x := ValueOf(FLD_DOSETEXT); Responses.Update('INSTR', 1, x, x);
3055	x := ValueOf(FLD_DRUG_ID); Responses.Update('DRUG', 1, x, '');
3056	x := ValueOf(FLD_DOSEFLDS); Responses.Update('DOSE', 1, x, '');
3057	x := ValueOf(FLD_STRENGTH);
3058	// if outpt or inpt order with no total dose (i.e., topical)
3059	if (not FInptDlg) or (ValueOf(FLD_TOTALDOSE) = '')
3060	then Responses.Update('STRENGTH', 1, x, x);
3061	// if no strength for dosage, use dispense drug name
3062	if Length(x) = 0 then
3063	begin
3064	x := ValueOf(FLD_DRUG_NM);
3065	if Length(x) > 0 then Responses.Update('NAME', 1, x, x);
3066	end;
3067	x := ValueOf(FLD_ROUTE_AB);
3068	if Length(x) = 0 then x := ValueOf(FLD_ROUTE_NM);
3069	if Length(ValueOf(FLD_ROUTE_ID)) > 0
3070	then Responses.Update('ROUTE', 1, ValueOf(FLD_ROUTE_ID), x)
3071	else Responses.Update('ROUTE', 1, '', x);
3072	x := ValueOf(FLD_SCHEDULE); Responses.Update('SCHEDULE', 1, x, x);
3073	if FInptDlg then
3074	begin
3075	(* AGP Change Admin Time Wrap 27.73
3076	x := Piece(self.lblAdminSch.text,':',2);
3077	x := Copy(x,2,Length(x)); *)
3078	x := lblAdminSchGetText;
3079	if FAdminTimeText <> '' then x := '';
3080	if x = 'Not Defined' then x := '';
3081	Responses.Update('ADMIN',1,x,x);
3082	X := Valueof(FLD_SCHED_TYP);
3083	if self.chkPRN.Checked = true then x := 'P';
3084	Responses.Update('SCHTYPE',1,x,x);
3085	end;
3086	end;
3087	TI_COMPLEX:
3088	begin
3089	//if txtNss.Visible then txtNss.Visible := False;
3090	with grdDoses do for i := 1 to Pred(RowCount) do
3091	begin
3092	x := Piece(Piece(grdDoses.Cells[COL_DOSAGE, i], TAB, 2), U, 5);
3093	if x = '' then x := Piece(grdDoses.Cells[COL_DOSAGE, i], TAB, 1);
3094	if x = '' then Continue;
3095	x := x + U + Piece(Piece(grdDoses.Cells[COL_DOSAGE, i], U, 4), '&', 6);
3096	DoseList.Add(x);
3097	end;
3098	FDrugID := FindCommonDrug(DoseList);
3099	if FDrugID <> '' then // common drug found
3100	begin
3101	x := ValueOf(FLD_STRENGTH, 1);
3102	if (not FInptDlg) or (ValueOf(FLD_TOTALDOSE, 1) = '')
3103	then Responses.Update('STRENGTH', 1, x, x);
3104	// if no strength, use dispense drug
3105	if Length(x) = 0 then
3106	begin
3107	x := ValueOf(FLD_DRUG_NM, 1);
3108	if Length(x) > 0 then Responses.Update('NAME', 1, x, x);
3109	end;
3110	Responses.Update('DRUG', 1, FDrugID, '');
3111	end; {if FDrugID}
3112	LastDose := 0;
3113	with grdDoses do for i := 1 to Pred(RowCount) do
3114	if Length(ValueOf(FLD_DOSETEXT, i)) > 0 then LastDose := i;
3115	with grdDoses do for i := 1 to Pred(RowCount) do
3116	begin
3117	if Length(ValueOf(FLD_DOSETEXT, i)) = 0 then Continue;
3118	x := ValueOf(FLD_DOSETEXT, i); Responses.Update('INSTR', i, x, x);
3119	x := ValueOf(FLD_DOSEFLDS, i); Responses.Update('DOSE', i, x, '');
3120	x := ValueOf(FLD_ROUTE_AB, i);
3121	if Length(x) = 0 then x := ValueOf(FLD_ROUTE_NM, i);
3122	if Length(ValueOf(FLD_ROUTE_ID, i)) > 0
3123	then Responses.Update('ROUTE', i, ValueOf(FLD_ROUTE_ID, i), x)
3124	else Responses.Update('ROUTE', i, '', x);
3125	x := ValueOf(FLD_SCHEDULE, i); Responses.Update('SCHEDULE', i, x, x);
3126	if FSmplPRNChkd then // GE CQ7585 Carry PRN checked from simple to complex tab
3127	begin
3128	pnlXSchedule.Tag := 1;
3129	chkXPRN.Checked := True;
3130	//cboXScheduleClick(Self);// force onclick to fire when complex tab is entered
3131	FSmplPRNChkd := False;
3132	end;
3133	x := ValueOf(FLD_DURATION, i); Responses.Update('DAYS', i, UpperCase(x), x);
3134	if FInptDlg then
3135	begin
3136	x := ValFor(VAL_ADMINTIME,i);
3137	if FAdminTimeText <> '' then x := '';
3138	if x = 'Not Defined' then x := '';
3139	Responses.Update('ADMIN',i,x,x);
3140	x := Valueof(FLD_SCHED_TYP, i);
3141	if ValFor(VAL_CHKXPRN, i) = '1' then x := 'P';
3142	Responses.Update('SCHTYPE', i, x, x);
3143	end;
3144	x := ValueOf(FLD_SEQUENCE, i);
3145	if Uppercase(x) = 'THEN' then x := 'T'
3146	else if Uppercase(x) = 'AND' then x := 'A'
3147	else if Uppercase(x) = 'EXCEPT' then x := 'X'
3148	else x := '';
3149	if i = LastDose then x := ''; // no conjunction for last dose
3150	Responses.Update('CONJ', i, x, x);
3151	end; {with grdDoses}
3152	end; {TI_COMPLEX}
3153	end; {case TabDose.TabIndex}
3154	DoseList.Free;
3155	Responses.Update('URGENCY', 1, ValueOf(FLD_PRIOR_ID), '');
3156	Responses.Update('COMMENT', 1, TX_WPTYPE, ValueOf(FLD_COMMENT));
3157	if FInptDlg then // inpatient orders
3158	begin
3159	Responses.Update('NOW', 1, ValueOf(FLD_NOW_ID), ValueOf(FLD_NOW_NM));
3160	x := InpatientSig;
3161	Responses.Update('SIG', 1, TX_WPTYPE, x);
3162	end else // outpatient orders
3163	begin
3164	x := ValueOf(FLD_SUPPLY); Responses.Update('SUPPLY', 1, x, x);
3165	x := ValueOf(FLD_QUANTITY); Responses.Update('QTY', 1, x, x);
3166	x := ValueOf(FLD_REFILLS); Responses.Update('REFILLS', 1, x, x);
3167	x := ValueOf(FLD_SC); Responses.Update('SC', 1, x, '');
3168	x := ValueOf(FLD_PICKUP); Responses.Update('PICKUP', 1, x, '');
3169	x := ValueOf(FLD_PTINSTR); Responses.Update('PI', 1, TX_WPTYPE, x);
3170	x := '';
3171	x := OutpatientSig; Responses.Update('SIG', 1, TX_WPTYPE, x);
3172	end;
3173	memOrder.Text := Responses.OrderText;
3174	end;
3175
3176	{ complex dose ------------------------------------------------------------------------------ }
3177
3178	{ General Functions - get & set cell values}
3179
3180	function TfrmODMeds.ValFor(FieldID, ARow: Integer): string;
3181	{ Contents of grid cells (Only the first tab piece for each cell is drawn)
3182	Dosage <TAB> DosageFields
3183	RouteText <TAB> IEN^RouteName^Abbreviation
3184	Schedule <TAB> (nothing)
3185	Duration <TAB> Duration^Units }
3186	begin
3187	Result := '';
3188	if (ARow < 1) or (ARow >= grdDoses.RowCount) then Exit;
3189	with grdDoses do
3190	case FieldID of
3191	COL_DOSAGE : Result := Piece(Cells[COL_DOSAGE, ARow], TAB, 1);
3192	COL_ROUTE : Result := Piece(Cells[COL_ROUTE, ARow], TAB, 1);
3193	COL_SCHEDULE : Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
3194	COL_DURATION : Result := Piece(Cells[COL_DURATION, ARow], TAB, 1);
3195	COL_SEQUENCE : Result := Piece(Cells[COL_SEQUENCE, ARow], TAB, 1);
3196	VAL_DOSAGE : Result := Piece(Cells[COL_DOSAGE, ARow], TAB, 2);
3197	VAL_ROUTE : Result := Piece(Cells[COL_ROUTE, ARow], TAB, 2);
3198	VAL_SCHEDULE : Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
3199	VAL_DURATION : Result := Piece(Cells[COL_DURATION, ARow], TAB, 1);
3200	VAL_ADMINTIME : Result := Piece(Cells[COL_ADMINTIME, ARow], TAB, 1);
3201	VAL_SEQUENCE : Result := Piece(Cells[COL_SEQUENCE, ARow], TAB, 1);
3202	VAL_CHKXPRN : Result := Cells[COL_CHKXPRN, ARow];
3203	end;
3204	end;
3205
3206	procedure FindInCombo(const x: string; AComboBox: TORComboBox);
3207	begin
3208	AComboBox.SetTextAutoComplete(x);
3209	end;
3210
3211	(*
3212	procedure TfrmODMeds.DurationToDays;
3213	var
3214	i, DoseHours, TotalHours: Integer;
3215	AllRows: Boolean;
3216	Days: Extended;
3217	x: string;
3218	begin
3219	Exit; // don't try to figure out days supply from duration for now
3220	if txtSupply.Tag = 1 then Exit;
3221	AllRows := True;
3222	with grdDoses do for i := 1 to Pred(RowCount) do
3223	if (Length(ValFor(COL_DOSAGE, i)) > 0) and (Length(ValFor(VAL_DURATION, i)) = 0)
3224	then AllRows := False;
3225	if not AllRows then Exit;
3226	Changing := True;
3227	TotalHours := 0;
3228	with grdDoses do for i := 1 to Pred(RowCount) do
3229	if Length(ValFor(COL_DOSAGE, i)) > 0 then
3230	begin
3231	x := ValFor(VAL_DURATION, i);
3232	if Piece(x, U, 2) = 'D'
3233	then DoseHours := ExtractInteger(x) * 24
3234	else DoseHours := ExtractInteger(x);
3235	TotalHours := TotalHours + DoseHours;
3236	end;
3237	Days := TotalHours / 24;
3238	if Days > Int(Days) then Days := Days + 1;
3239	txtSupply.Text := IntToStr(Trunc(Days));
3240	//timDayQty.Tag := TIMER_FROM_DAYS;
3241	//timDayQtyTimer(Self);
3242	Changing := False;
3243	end;
3244	*)
3245
3246	function TfrmODMeds.DurationToDays: Integer;
3247	var
3248	i, DoseMinutes, AndMinutes, TotalMinutes: Integer;
3249	AllRows: Boolean;
3250	Days: Extended;
3251	x: string;
3252	begin
3253	Result := 0;
3254	// make sure a duration exists for all rows with a dose
3255	AllRows := True;
3256	with grdDoses do for i := 1 to Pred(RowCount) do
3257	if (Length(ValFor(COL_DOSAGE, i)) > 0) and (Length(ValFor(VAL_DURATION, i)) = 0)
3258	then AllRows := False;
3259	if not AllRows then Exit;
3260
3261	AndMinutes := 0;
3262	TotalMinutes := 0;
3263	with grdDoses do for i := 1 to Pred(RowCount) do
3264	if Length(ValFor(COL_DOSAGE, i)) > 0 then
3265	begin
3266	x := ValFor(VAL_DURATION, i);
3267	DoseMinutes := 0;
3268	if Piece(x, ' ', 2) = 'MONTHS' then DoseMinutes := ExtractInteger(x) * 43200;
3269	if Piece(x, ' ', 2) = 'WEEKS' then DoseMinutes := ExtractInteger(x) * 10080;
3270	if Pos('DAY',Piece(x, ' ', 2))>0 then DoseMinutes := ExtractInteger(x) * 1440;
3271	if Piece(x, ' ', 2) = 'HOURS' then DoseMinutes := ExtractInteger(x) * 60;
3272	if Piece(x, ' ', 2) = 'MINUTES' then DoseMinutes := ExtractInteger(x);
3273	// Determine how TotalMinutes should be calculated based on conjunction
3274	if ValFor(COL_SEQUENCE, i) <> 'AND' then // 'THEN', 'EXCEPT', or ''
3275	begin
3276	if AndMinutes = 0 then TotalMinutes := TotalMinutes + DoseMinutes;
3277	if AndMinutes > 0 then
3278	begin
3279	if AndMinutes < DoseMinutes then AndMinutes := DoseMinutes;
3280	TotalMinutes := TotalMinutes + AndMinutes;
3281	AndMinutes := 0;
3282	end;
3283	if ValFor(COL_SEQUENCE, i) = 'EXCEPT' then break; //quit out of For Loop to stop counting TotalMinutes
3284	end;
3285	if (ValFor(COL_SEQUENCE, i) = 'AND') then
3286	if AndMinutes < DoseMinutes then AndMinutes := DoseMinutes;
3287	end;
3288	if AndMinutes > 0 then TotalMinutes := TotalMinutes + AndMinutes;
3289
3290	Days := TotalMinutes / 1440;
3291	if Days > Int(Days) then Days := Days + 1;
3292	Result := Trunc(Days);
3293	end;
3294
3295	procedure TfrmODMeds.pnlFieldsResize(Sender: TObject);
3296	const
3297	REL_DOSAGE = 0.38;
3298	REL_ROUTE = 0.17;
3299	REL_SCHEDULE = 0.19;
3300	REL_DURATION = 0.16;
3301	REL_ANDTHEN = 0.10;
3302	REL_ADMINTIME = 0.16;
3303	var
3304	i, ht, RowCountShowing: Integer;
3305	ColControl: TWinControl;
3306	begin
3307	inherited;
3308	with grdDoses do
3309	begin
3310	i := grdDoses.Width - 20; // 20 = 12 pixel margin + 8 pixel column 0
3311	i := i - GetSystemMetrics(SM_CXVSCROLL); // compensate for appearance of scroll bar
3312	if (not FinptDlg) or (FAdminTimeText = 'Not defined for Clinic Locations') then
3313	begin
3314	ColWidths[1] := Round(REL_DOSAGE * i); // dosage
3315	ColWidths[2] := Round(REL_ROUTE * i); // route
3316	ColWidths[3] := Round(REL_SCHEDULE * i); // schedule
3317	ColWidths[4] := Round(REL_DURATION * i); // duration
3318	ColWidths[5] := Round(0 * i); // administration time
3319	grdDoses.TabStops[5] := False;
3320	ColWidths[6] := Round(REL_ANDTHEN * i); // and/then
3321	end
3322	else
3323	begin
3324	ColWidths[1] := Round(0.35 * i); // dosage
3325	ColWidths[2] := Round(0.10 * i); // route
3326	ColWidths[3] := Round(0.19 * i); // schedule
3327	ColWidths[4] := Round(0.12 * i); // duration
3328	ColWidths[5] := Round(0.16 * i); // administration time
3329	grdDoses.TabStops[5] := True;
3330	ColWidths[6] := Round(0.08 * i); // and/then
3331	end;
3332	// adjust height of grid to not show partial rows
3333	ht := pnlBottom.Top - Top - 6;
3334
3335	ht := ht div (DefaultRowHeight+1);
3336	ht := ht * (DefaultRowHeight+1);
3337	Inc(ht, 3);
3338	Height := ht;
3339	// Move a column control if it is showing
3340	ColControl := nil;
3341	case grdDoses.Col of
3342	COL_DOSAGE:ColControl := cboXDosage;
3343	COL_ROUTE:ColControl := cboXRoute;
3344	COL_SCHEDULE:ColControl := pnlXSchedule;
3345	COL_DURATION:ColControl := pnlXDuration;
3346	COL_ADMINTIME:ColControl := pnlXAdminTime;
3347	COL_SEQUENCE:ColControl := cboXSequence;
3348	end; {case}
3349
3350	if assigned(ColControl) and ColControl.Showing then
3351	begin
3352	RowCountShowing := (Height - 25) div (DefaultRowHeight+1);
3353	if (grdDoses.Row <= RowCountShowing) then
3354	ShowEditor(grdDoses.col, grdDoses.row, #0)
3355	else
3356	ColControl.Hide;
3357	end;
3358
3359	end;
3360	end;
3361
3362	procedure TfrmODMeds.grdDosesMouseDown(Sender: TObject; Button: TMouseButton;
3363	Shift: TShiftState; X, Y: Integer);
3364	var
3365	ACol, ARow: Integer;
3366	begin
3367	inherited;
3368	grdDoses.MouseToCell(X, Y, ACol, ARow);
3369	if (ARow < 0) or (ACol < 0) then Exit;
3370	if ACol > COL_SELECT then ShowEditor(ACol, ARow, #0) else
3371	begin
3372	grdDoses.Col := COL_DOSAGE;
3373	grdDoses.Row := ARow;
3374	end;
3375	if grdDoses.Col <> COL_DOSAGE then
3376	DropLastSequence;
3377	end;
3378
3379	procedure TfrmODMeds.grdDosesKeyPress(Sender: TObject; var Key: Char);
3380	begin
3381	inherited;
3382	if Key in [#32..#127] then ShowEditor(grdDoses.Col, grdDoses.Row, Key);
3383	if grdDoses.Col <> COL_DOSAGE then
3384	DropLastSequence;
3385	end;
3386
3387	procedure TfrmODMeds.grdDosesMouseUp(Sender: TObject; Button: TMouseButton;
3388	Shift: TShiftState; X, Y: Integer);
3389	begin
3390	inherited;
3391	case FDropColumn of
3392	COL_DOSAGE: with cboXDosage do if Items.Count > 0 then DroppedDown := True;
3393	COL_ROUTE: with cboXRoute do if Items.Count > 0 then DroppedDown := True;
3394	COL_SCHEDULE: with cboXSchedule do if Items.Count > 0 then DroppedDown := True;
3395	COL_SEQUENCE: with cboXSequence do if Items.Count > 0 then DroppedDown := True;
3396
3397	end;
3398	FDropColumn := -1;
3399	end;
3400
3401	procedure TfrmODMeds.grdDosesDrawCell(Sender: TObject; ACol, ARow: Integer;
3402	Rect: TRect; State: TGridDrawState);
3403	begin
3404	inherited;
3405	grdDoses.Canvas.TextRect(Rect, Rect.Left+2, Rect.Top+2,
3406	Piece(grdDoses.Cells[ACol, ARow], TAB, 1));
3407	end;
3408
3409	procedure TfrmODMeds.grdDosesExit(Sender: TObject);
3410	begin
3411	inherited;
3412	UpdateRelated(FALSE);
3413	RestoreDefaultButton;
3414	RestoreCancelButton;
3415	end;
3416
3417	procedure TfrmODMeds.ShowEditor(ACol, ARow: Integer; AChar: Char);
3418	var
3419	x,tmpText: string;
3420
3421	procedure PlaceControl(AControl: TWinControl);
3422	var
3423	ARect: TRect;
3424	begin
3425	with AControl do
3426	begin
3427	ARect := grdDoses.CellRect(ACol, ARow);
3428	SetBounds(ARect.Left + grdDoses.Left + 1, ARect.Top + grdDoses.Top + 1,
3429	ARect.Right - ARect.Left + 1, ARect.Bottom - ARect.Top + 1);
3430	Tag := ARow;
3431	BringToFront;
3432	Show;
3433	SetFocus;
3434	end;
3435	end;
3436
3437	procedure SynchCombo(ACombo: TORComboBox; const ItemText, EditText: string);
3438	var
3439	i: Integer;
3440	begin
3441	ACombo.ItemIndex := -1;
3442	for i := 0 to Pred(ACombo.Items.Count) do
3443	if ACombo.Items[i] = ItemText then ACombo.ItemIndex := i;
3444	if ACombo.ItemIndex < 0 then ACombo.Text := EditText;
3445	end;
3446
3447	begin
3448	inherited;
3449	txtNSS.Visible := False;
3450	//Make space just select editor. This blows up as soon as some joker makes a
3451	//dosage starting with a space.
3452	if AChar = ' ' then
3453	AChar := #0;
3454	if ARow = 0 then Exit; // header row
3455	// require initial instruction entry when in last row
3456	with grdDoses do if {(ARow = Pred(RowCount)) and} (ACol > COL_DOSAGE) and
3457	(ValFor(COL_DOSAGE, ARow) = '') then Exit;
3458	// require that initial instructions for rows get entered from top to bottom
3459	//(this does not include behaivor of row insertion button.)
3460	if (ACol = COL_DOSAGE) and (ARow > 1) and (ValFor(COL_DOSAGE, ARow-1) = '') then
3461	Exit;
3462	// display appropriate editor for row & column
3463	case ACol of
3464	COL_DOSAGE: begin
3465	// default route & schedule to previous row
3466	if (ARow > 1) then
3467	begin
3468	if (grdDoses.Cells[COL_ROUTE, ARow] = '') and
3469	(grdDoses.Cells[COL_SCHEDULE, ARow] = '') then
3470	begin
3471	grdDoses.Cells[COL_ROUTE, ARow] := grdDoses.Cells[COL_ROUTE, Pred(ARow)];
3472	{ don't default schedule - recommended by Martin Lowe }
3473	//grdDoses.Cells[COL_SCHEDULE, ARow] := grdDoses.Cells[COL_SCHEDULE, Pred(ARow)];
3474	end;
3475	//AGP Change 26.45 remove auto-populate of the sequence field
3476	{* if grdDoses.Cells[COL_SEQUENCE, Pred(ARow)] = '' then
3477	begin
3478	if StrToIntDef(Piece(grdDoses.Cells[COL_DURATION, Pred(ARow)], ' ', 1), 0) > 0
3479	then grdDoses.Cells[COL_SEQUENCE, Pred(ARow)] := 'THEN'
3480	else grdDoses.Cells[COL_SEQUENCE, Pred(ARow)] := 'AND';
3481	end; *}
3482	end;
3483	// set appropriate value for cboDosage
3484	SynchCombo(cboXDosage, ValFor(VAL_DOSAGE, ARow), ValFor(COL_DOSAGE, ARow));
3485	PlaceControl(cboXDosage);
3486	FDropColumn := COL_DOSAGE;
3487	if AChar <> #0 then PostMessage(Handle, UM_DELAYEVENT, Ord(AChar), COL_DOSAGE);
3488	end;
3489	COL_ROUTE: begin
3490	// set appropriate value for cboRoute
3491	SynchCombo(cboXRoute, ValFor(VAL_ROUTE, ARow), ValFor(COL_ROUTE, ARow));
3492	PlaceControl(cboXRoute);
3493	FDropColumn := COL_ROUTE;
3494	if AChar <> #0 then PostMessage(Handle, UM_DELAYEVENT, Ord(AChar), COL_ROUTE);
3495	end;
3496	COL_SCHEDULE: begin
3497	// set appropriate value for cboSchedule
3498	if FInptDlg then txtNSS.Visible := True;
3499	x := Piece(grdDoses.Cells[COL_SCHEDULE, ARow], TAB, 1);
3500	Changing := TRUE;
3501	if ValFor(VAL_CHKXPRN,Arow)='1' then chkXPRN.Checked := true
3502	else chkXPRN.Checked := False;
3503	if Pos('PRN',x)>0 then
3504	begin
3505	cboXSchedule.SelectByID(x);
3506	if cboXSchedule.ItemIndex <0 then
3507	begin
3508	x := Trim(Copy(x, 1, Pos('PRN', x) - 1));
3509	chkXPRN.Checked := true;
3510	end;
3511	end;
3512	if Length(x) > 0 then
3513	begin
3514	cboXSchedule.SelectByID(x);
3515	cboXSchedule.Text := x;
3516	end
3517	else cboXSchedule.ItemIndex := -1;
3518	(* if Pos('PRN', x) > 0 then
3519	begin
3520	NonPRNPart := Trim(Copy(x, 1, Pos('PRN', x) - 1));
3521	cboXSchedule.SelectByID(NonPRNPart);
3522	if cboXSchedule.ItemIndex > -1 then chkXPRN.Checked := True else
3523	begin
3524	chkXPRN.Checked := False;
3525	cboXSchedule.SelectByID(x);
3526	if cboXSchedule.ItemIndex < 0 then cboXSchedule.Text := x;
3527	end;
3528	end; *)
3529	Changing := FALSE;
3530	cboXSequence.Tag := ARow;
3531	PlaceControl(pnlXSchedule);
3532	FDropColumn := COL_SCHEDULE;
3533	if AChar <> #0 then PostMessage(Handle, UM_DELAYEVENT, Ord(AChar), COL_SCHEDULE);
3534	end;
3535	COL_DURATION: begin
3536	// set appropriate value for pnlDuration
3537	x := ValFor(VAL_DURATION, ARow);
3538	Changing := TRUE;
3539	txtXDuration.Text := Piece(x, ' ', 1);
3540	x := Piece(x, ' ', 2);
3541	if Length(x) > 0 then btnXDuration.Caption := LowerCase(x)
3542	else begin
3543	txtXDuration.Text := '0';
3544	btnXDuration.Caption := 'days';
3545	end;
3546	tmpText := txtXDuration.Text; //Fix for CQ: 8107 - Kloogy but works.
3547	UpdateDurationControls(False);
3548	Changing := FALSE;
3549	pnlXDuration.Tag := ARow;
3550	PlaceControl(pnlXDuration);
3551	txtXDuration.SetFocus;
3552	ARow1 := ARow;
3553	txtXDuration.Text := tmpText; //Fix for CQ: 8107 - Kloogy but works.
3554	if AChar <> #0 then PostMessage(Handle, UM_DELAYEVENT, Ord(AChar), COL_DURATION);
3555	end;
3556	COL_SEQUENCE: begin
3557	SynchCombo(cboXSequence, ValFor(VAL_SEQUENCE, ARow), ValFor(COL_SEQUENCE, ARow));
3558	cboXSequence.Tag := ARow;
3559	ARow1 := ARow;
3560	PlaceControl(cboXSequence);
3561	FDropColumn := COL_SEQUENCE;
3562	if AChar <> #0 then PostMessage(Handle, UM_DELAYEVENT, Ord(AChar), COL_SEQUENCE);
3563	end;
3564	COL_ADMINTIME: BEGIN
3565	pnlXAdminTime.OnClick(pnlXAdminTime);
3566	end;
3567	end; {case ACol}
3568	end;
3569
3570	procedure TfrmODMeds.UMDelayEvent(var Message: TMessage);
3571	{ after focusing events are completed for a combobox, set the key the user typed }
3572	begin
3573	case Message.LParam of
3574	COL_DOSAGE : FindInCombo(Chr(Message.WParam), cboXDosage);
3575	COL_ROUTE : FindInCombo(Chr(Message.WParam), cboXRoute);
3576	COL_SCHEDULE : FindInCombo(Chr(Message.WParam), cboXSchedule);
3577	COL_DURATION : begin
3578	txtXDuration.Text := Chr(Message.WParam);
3579	txtXDuration.SelStart := 1;
3580	end;
3581	COL_SEQUENCE : FindInCombo(Chr(Message.WParam), cboXSequence);
3582	end;
3583	end;
3584
3585	procedure TfrmODMeds.cboXDosageEnter(Sender: TObject);
3586	begin
3587	inherited;
3588	// if this was the last row, create a new last row
3589	if grdDoses.Row = Pred(grdDoses.RowCount) then grdDoses.RowCount := grdDoses.RowCount + 1;
3590	DisableDefaultButton(self);
3591	DisableCancelButton(self);
3592	QuantityMessageCheck(cboXDosage.Tag);
3593	end;
3594
3595	procedure TfrmODMeds.cboXDosageChange(Sender: TObject);
3596	var
3597	temp1,temp2: string;
3598	count: integer;
3599	begin
3600	inherited;
3601	if not Changing and (cboXDosage.ItemIndex < 0) then
3602	begin
3603	Count := Pos(U,cboXDosage.Text);
3604	if Count > 0 then
3605	begin
3606	temp1 := copy(cboXDosage.Text,0,count-1);
3607	temp2 := copy(cboXDosage.Text,count+1,Length(cboXDosage.text));
3608	infoBox('An ^ is not allowed in the dosage value', 'Dosage Warning', MB_OK);
3609	cboXDosage.Text := temp1 + temp2;
3610	end;
3611	grdDoses.Cells[COL_DOSAGE, cboXDosage.Tag] := cboXDosage.Text;
3612	UpdateRelated;
3613	end;
3614	end;
3615
3616	procedure TfrmODMeds.cboXDosageClick(Sender: TObject);
3617	var
3618	DispDrug: Integer;
3619	x: string;
3620	begin
3621	inherited;
3622	if FSuppressMsg then
3623	begin
3624	if PnlMessage.Visible = true then
3625	begin
3626	memMessage.SendToBack;
3627	PnlMessage.Visible := False;
3628	end;
3629	end;
3630
3631	with cboXDosage do if ItemIndex > -1 then x := Text + TAB + Items[ItemIndex] else x := Text;
3632	grdDoses.Cells[COL_DOSAGE, cboXDosage.Tag] := x;
3633	UpdateRelated(FALSE);
3634	DispDrug := StrToIntDef(ValueOf(FLD_DRUG_ID, cboXDosage.Tag), 0);
3635	if DispDrug > 0 then
3636	begin
3637	if not FSuppressMsg then
3638	begin
3639	DispOrderMessage(DispenseMessage(DispDrug));
3640	FSuppressMsg := False;
3641	end;
3642	x := QuantityMessage(DispDrug);
3643	end
3644	else x := '';
3645	if Length(x) > 0
3646	then lblQtyMsg.Caption := TX_QTY_PRE + x + TX_QTY_POST
3647	else lblQtyMsg.Caption := '';
3648	end;
3649
3650	procedure TfrmODMeds.cboXDosageExit(Sender: TObject);
3651	var
3652	//tempTag: integer;
3653	str: string;
3654	begin
3655	inherited;
3656	if cboXDosage.Showing then
3657	begin
3658	cboXDosageClick(Self);
3659	str := cboXDosage.Text;
3660	//tempTag := cboXDosage.Tag;
3661	//cboXDosage.Tag := -1;
3662	cboXDosage.Hide;
3663	UpdateRelated;
3664	RestoreDefaultButton;
3665	RestoreCancelButton;
3666	(*Probably not needed here since on validation check on accept
3667	if (LeftStr(cboXDosage.Text,1)='.') and (self.tabDose.TabIndex = TI_COMPLEX) then
3668	begin
3669	infoBox('Dosage must have a leading numeric value','Invalid Dosage',MB_OK);
3670	//cboXDosage.Tag := tempTag;
3671	cboXDosage.Show;
3672	cboXDosage.SetFocus;
3673	Exit;
3674	end; *)
3675	if (length(cboxdosage.Text)>0) and (cboxDosage.ItemIndex > -1) and
3676	(Piece(cboxDosage.Items.Strings[cboxDosage.ItemIndex],U,5) <> Piece(cboxDosage.Text,'#',1)) then
3677	begin
3678	cboXDosage.ItemIndex := -1;
3679	cboXDosage.Text := Piece(str, '#', 1);
3680	self.grdDoses.Cells[COL_DOSAGE,self.grdDoses.row] := cboXDosage.Text;
3681	UpdateRelated(false);
3682	end;
3683	if (pnlMessage.Visible) and (memMessage.TabStop) then
3684	begin
3685	pnlMessage.Parent := grdDoses.Parent;
3686	pnlMessage.TabOrder := grdDoses.TabOrder;
3687	ActiveControl := memMessage;
3688	end
3689	else if grdDoses.Showing then
3690	ActiveControl := grdDoses
3691	else
3692	ActiveControl := cboDosage;
3693	end
3694	else
3695	cmdQuit.Click;
3696	end;
3697
3698	procedure TfrmODMeds.cboXRouteChange(Sender: TObject);
3699	begin
3700	inherited;
3701	//Commented out to fix CQ: 7280
3702	// if cboXRoute.Text = '' then cboXRoute.ItemIndex := -1;
3703	if not Changing and (cboXRoute.ItemIndex < 0) then
3704	begin
3705	grdDoses.Cells[COL_ROUTE, cboXRoute.Tag] := cboXRoute.Text;
3706	ControlChange(Self);
3707	end;
3708	end;
3709
3710	procedure TfrmODMeds.cboXRouteClick(Sender: TObject);
3711	var
3712	x: string;
3713	begin
3714	inherited;
3715	with cboXRoute do if ItemIndex > -1 then x := Text + TAB + Items[ItemIndex] else x := Text;
3716	grdDoses.Cells[COL_ROUTE, cboXRoute.Tag] := x;
3717	ControlChange(Self);
3718	end;
3719
3720	procedure TfrmODMeds.cboXRouteExit(Sender: TObject);
3721	begin
3722	inherited;
3723	//Removed based on Site feeback. See CQ: 7518
3724	{ if Not ValidateRoute(cboXRoute) then
3725	Exit; }
3726	if Trim(cboXRoute.Text) = '' then
3727	begin
3728	cboXRoute.ItemIndex := -1;
3729	Exit;
3730	end;
3731	cboXRouteClick(Self);
3732	cboXRoute.Tag := -1;
3733	cboXRoute.Hide;
3734	RestoreDefaultButton;
3735	RestoreCancelButton;
3736	if (pnlMessage.Visible) and (memMessage.TabStop) then
3737	begin
3738	pnlMessage.Parent := grdDoses.Parent;
3739	pnlMessage.TabOrder := grdDoses.TabOrder;
3740	ActiveControl := memMessage;
3741	end
3742	else if grdDoses.Showing then
3743	ActiveControl := grdDoses
3744	else
3745	ActiveControl := cboDosage;
3746	end;
3747
3748	procedure TfrmODMeds.pnlXScheduleEnter(Sender: TObject);
3749	begin
3750	inherited;
3751	cboXSchedule.SetFocus;
3752	DisableDefaultButton(self);
3753	DisableCancelButton(self);
3754	end;
3755
3756	procedure TfrmODMeds.cboXScheduleChange(Sender: TObject);
3757	var
3758	othSch, x: string;
3759	idx : integer;
3760	begin
3761	inherited;
3762	//Commented out to fix CQ: 7280
3763	// if cboXSchedule.Text = '' then cboXSchedule.ItemIndex := -1;
3764	if not Changing {and (cboXSchedule.ItemIndex < 0)} then
3765	begin
3766	if (FInptDlg) and (cboXSchedule.Text = 'OTHER') then
3767	begin
3768	cboXSchedule.SelectByID('OTHER');
3769	othSch := CreateOtherScheduelComplex;
3770	if length(trim(othSch)) > 1 then
3771	begin
3772	othSch := othSch + U + U + NSSScheduleType + U + NSSAdminTime;
3773	cboXSchedule.Items.Add(othSch);
3774	idx := cboXSchedule.Items.IndexOf(Piece(OthSch, U, 1));
3775	cboXSchedule.ItemIndex := idx;
3776	end;
3777	end;
3778	if pnlXSchedule.Tag = -1 then pnlXSchedule.Tag := self.grdDoses.Row;
3779	//if pnlXSchedule.Tag = -1 then pnlXSchedule.Tag := self.grdDoses.Row;
3780	with cboXSchedule do if ItemIndex > -1
3781	then x := Text + TAB + Items[ItemIndex]
3782	else x := Text;
3783	grdDoses.Cells[COL_SCHEDULE, pnlXSchedule.Tag] := x;
3784	self.cboSchedule.Text := x;
3785	//AGP Start Expired uncommented out the line
3786	if FInptDlg then UpdateStartExpires(Piece(x, tab, 1));
3787	UpdateRelated;
3788	end;
3789	end;
3790
3791	procedure TfrmODMeds.cboXScheduleClick(Sender: TObject);
3792	var
3793	PRN,x: string;
3794	begin
3795	inherited;
3796	//agp change CQ 11015
3797	if (chkXPRN.Checked) then PRN := ' PRN' else PRN := '';
3798	with cboXSchedule do
3799	begin
3800	if RightStr(Text,3) = 'PRN' then PRN := '';
3801	if ItemIndex > -1 then x := Text + PRN + TAB + Items[ItemIndex]
3802	else x := Text + PRN;
3803	end;
3804	(* with cboXSchedule do if ItemIndex > -1
3805	then x := Text + TAB + Items[ItemIndex]
3806	else x := Text; *)
3807	grdDoses.Cells[COL_SCHEDULE, pnlXSchedule.Tag] := x;
3808	//AGP Start Expired uncommented out the line
3809	UpdateStartExpires(Piece(x, tab, 1));
3810	UpdateRelated;
3811	end;
3812
3813	procedure TfrmODMeds.chkXPRNClick(Sender: TObject);
3814	var
3815	check: string;
3816	begin
3817	inherited;
3818	if self.chkXPRN.Checked = True then check := '1'
3819	else check := '0';
3820	self.grdDoses.Cells[COL_CHKXPRN, self.grdDoses.Row] := check;
3821	if not Changing then cboXScheduleClick(Self);
3822	end;
3823
3824	procedure TfrmODMeds.pnlXScheduleExit(Sender: TObject);
3825	begin
3826	inherited;
3827	if Not FShowPnlXScheduleOk then //Added for CQ: 7370
3828	Exit;
3829	cboXScheduleClick(Self);
3830	pnlXSchedule.Tag := -1;
3831	pnlXSchedule.Hide;
3832	UpdateRelated;
3833	RestoreDefaultButton;
3834	RestoreCancelButton;
3835	if (pnlMessage.Visible) and (memMessage.TabStop) then
3836	begin
3837	pnlMessage.Parent := grdDoses.Parent;
3838	pnlMessage.TabOrder := grdDoses.TabOrder;
3839	ActiveControl := memMessage;
3840	end
3841	else if grdDoses.Showing then
3842	ActiveControl := grdDoses
3843	else
3844	ActiveControl := cboDosage;
3845	//AGP Start Expired commented out the line
3846	//updateStartExpires(valFor(COL_SCHEDULE,self.grdDoses.Row));
3847	end;
3848
3849	procedure TfrmODMeds.pnlXAdminTimeClick(Sender: TObject);
3850	var
3851	Str: string;
3852	begin
3853	inherited;
3854	if not FInptDlg then Exit;
3855
3856	str := 'The Administration Times for this dose are: ' + CRLF + CRLF + VALFOR(VAL_ADMINTIME,grddoses.Row);
3857	str := str + CRLF + CRLF + AdminTimeHelpText;
3858	infoBox(str,'Administration Time Information',MB_OK);
3859	end;
3860
3861	procedure TfrmODMeds.pnlXDurationButtonEnter(Sender: TObject);
3862	begin
3863	inherited;
3864	QuantityMessageCheck(self.grdDoses.Row);
3865	end;
3866
3867	procedure TfrmODMeds.pnlXDurationEnter(Sender: TObject);
3868	begin
3869	inherited;
3870	txtXDuration.SetFocus;
3871	DisableDefaultButton(self);
3872	DisableCancelButton(self);
3873	end;
3874
3875	procedure TfrmODMeds.txtXDurationChange(Sender: TObject);
3876	var
3877	I, Code: Integer;
3878	OrgValue: string;
3879	begin
3880	inherited;
3881	if Changing then Exit;
3882	if (txtXDuration.Text <> '0') and (txtXDuration.Text <> '') then
3883	begin
3884	Val(txtXDuration.Text, I, Code);
3885	UpdateDurationControls(Code <> 0);
3886	//Commented out the "and" to resolve CQ: 7557
3887	if (Code <> 0) {and (I=0)} then
3888	begin
3889	ShowMsg('Please use numeric characters only.');
3890	with txtXDuration do
3891	begin
3892	Text := IntToStr(I);
3893	SelStart := Length(Text);
3894	end;
3895	Exit;
3896	btnXDuration.Width := 8;
3897	btnXDuration.Align := alRight;
3898	spnXDuration.Visible := False;
3899	txtXduration.Align := alClient;
3900	PopDuration.Items.Tag := 0;
3901	btnXDuration.Caption := '';
3902	end;
3903	{AGP change 26.19 for PSI-05-018 cq #7322
3904	else if PopDuration.Items.Tag = 0 then
3905	begin
3906	PopDuration.Items.Tag := 3; //Days selection
3907	btnXDuration.Caption := 'days';
3908	end; }
3909	grdDoses.Cells[COL_DURATION, pnlXDuration.Tag] := txtXDuration.Text + ' ' + Uppercase(btnXDuration.Caption);
3910	end else //AGP CHANGE ORDER
3911	begin
3912	if not(FInptDlg) then grdDoses.Cells[COL_DURATION, pnlXDuration.Tag] := '';
3913	OrgValue := ValFor(COL_DURATION, pnlxDuration.tag);
3914	//if ((txtXDuration.Text = '0') or (txtXDuration.Text = '')) and ((ValFor(COL_SEQUENCE, ARow1) = 'THEN') and (FInptDlg)) then //AGP CHANGE ORDER
3915	//AGP change 26.33 Then/And conjunction requiring a duration to include outpatient orders also
3916	if ((txtXDuration.Text = '0') or (txtXDuration.Text = '')) and (ValFor(COL_SEQUENCE, ARow1) = 'THEN') then //AGP CHANGE ORDER
3917	begin
3918	if (InfoBox('A duration is required when using "Then" as a sequence.'+CRLF+'"Then" will be remove from the sequence field if you continue'+
3919	CRLF+'Click "OK" to continue or click "Cancel"','Duration Warning', MB_OKCANCEL)=1) then
3920	begin
3921	grdDoses.Cells[COL_DURATION, pnlXDuration.Tag] := '';
3922	cboXSequence.Tag := ARow1;
3923	grdDoses.Cells[COL_SEQUENCE, cboXSequence.Tag] := '';
3924	cboXSequence.Text := '';
3925	cboXSequence.ItemIndex := -1;
3926	end
3927	else
3928	grdDoses.Cells[COL_DURATION, pnlXDuration.Tag] := OrgValue;
3929	end
3930	else grdDoses.Cells[COL_DURATION, pnlXDuration.Tag] := txtXDuration.Text;
3931	end;
3932	// end;
3933	ControlChange(Self);
3934	UpdateRelated;
3935	end;
3936
3937	procedure TfrmODMeds.pnlXDurationExit(Sender: TObject);
3938	begin
3939	inherited;
3940	pnlXDuration.Tag := -1;
3941	pnlXDuration.Hide;
3942	UpdateRelated;
3943	RestoreDefaultButton;
3944	RestoreCancelButton;
3945	if (pnlMessage.Visible) and (memMessage.TabStop) then
3946	begin
3947	pnlMessage.Parent := grdDoses.Parent;
3948	pnlMessage.TabOrder := grdDoses.TabOrder;
3949	ActiveControl := memMessage;
3950	end
3951	else if grdDoses.Showing then
3952	ActiveControl := grdDoses
3953	else
3954	ActiveControl := cboDosage;
3955	end;
3956
3957
3958	procedure TfrmODMeds.btnXInsertClick(Sender: TObject);
3959	var
3960	i: Integer;
3961	x1, x2: string;
3962	begin
3963	inherited;
3964	grdDoses.SetFocus; // make sure exit events for editors fire
3965	with grdDoses do
3966	begin
3967	if Row < 1 then Exit;
3968	x1 := grdDoses.Cells[COL_ROUTE, Row];
3969	x2 := grdDoses.Cells[COL_SCHEDULE, Row];
3970	RowCount := RowCount + 1;
3971	{ move rows down }
3972	for i := Pred(RowCount) downto Succ(Row) do Rows[i] := Rows[i-1];
3973	Rows[Row].Clear;
3974	Cells[COL_ROUTE, Row] := x1;
3975	Cells[COL_SCHEDULE, Row] := x2;
3976	Col := COL_DOSAGE;
3977	ShowEditor(COL_DOSAGE, Row, #0);
3978	end;
3979	DropLastSequence;
3980	end;
3981
3982	procedure TfrmODMeds.btnXRemoveClick(Sender: TObject);
3983	var
3984	i: Integer;
3985	begin
3986	inherited;
3987	grdDoses.SetFocus; // make sure exit events for editors fire
3988	with grdDoses do if (Row > 0) and (RowCount > 2) then
3989	begin
3990	{ move rows up }
3991	for i := Row to RowCount - 2 do Rows[i] := Rows[i+1];
3992	RowCount := RowCount - 1;
3993	Rows[RowCount].Clear;
3994	end;
3995	DropLastSequence;
3996	ControlChange(Self);
3997	end;
3998
3999	function TfrmODMeds.ValueOf(FieldID: Integer; ARow: Integer = -1): string;
4000	var
4001	x: string;
4002	{ Contents of cboDosage
4003	DrugName^Strength^NF^TDose&Units&U/D&Noun&LDose&Drug^DoseText^CostText^MaxRefills
4004	Contents of grid cells (Only the first tab piece for each cell is drawn)
4005	Dosage <TAB> DosageFields
4006	RouteText <TAB> IEN^RouteName^Abbreviation
4007	Schedule <TAB> (nothing)
4008	Duration <TAB> Duration^Units }
4009
4010	// the following functions were created to get rid of a compile warning saying the
4011	// return value may be undefined - too much branching logic in the case statements
4012	// for the compiler to handle
4013
4014	function GetSingleDoseSchedule: string;
4015	begin
4016	Result := UpperCase(Trim(cboSchedule.Text));
4017	if chkPRN.Checked then Result := Result + ' PRN';
4018	if UpperCase(Copy(Result, Length(Result) - 6, Length(Result))) = 'PRN PRN'
4019	then Result := Copy(Result, 1, Length(Result) - 4);
4020	end;
4021
4022	function GetSingleDoseScheduleEX: string;
4023	begin
4024	Result := '';
4025	with cboSchedule do
4026	begin
4027	if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 2);
4028	(* if (Length(Result)=0) and (ItemIndex > -1) then
4029	begin
4030	Result := Piece(Items[ItemIndex], U, 1);
4031	if Piece(Items[ItemIndex], U, 3) = 'P' then
4032	begin
4033	if RightStr(Result,3) = 'PRN' then
4034	begin
4035	Result := Copy(Result,1,Length(Result)-3); //Remove the Trailing PRN
4036	if (RightStr(Result,1) = ' ') or (RightStr(Result,1) = '-') then
4037	Result := Copy(Result,1,Length(Result)-1);
4038	end;
4039	Result := Result + ' AS NEEDED';
4040	end;
4041	end;
4042	end; *)
4043	if RightStr(Result,3) = 'PRN' then
4044	begin
4045	Result := Copy(Result,1,Length(Result)-3); //Remove the Trailing PRN
4046	if (RightStr(Result,1) = ' ') or (RightStr(Result,1) = '-') then
4047	Result := Copy(Result,1,Length(Result)-1);
4048	Result := Result + ' AS NEEDED'
4049	end;
4050	if (Length(Result) > 0) and chkPRN.Checked then
4051	Result := Result + ' AS NEEDED';
4052	if UpperCase(Copy(Result, Length(Result) - 18, Length(Result))) = 'AS NEEDED AS NEEDED' then
4053	Result := Copy(Result, 1, Length(Result) - 10);
4054	if UpperCase(Copy(Result, Length(Result) - 12, Length(Result))) = 'PRN AS NEEDED' then
4055	begin
4056	Result := Copy(Result, 1, Length(Result) - 13);
4057	if RightStr(Result,1)=' ' then
4058	Result := Result + 'AS NEEDED'
4059	else
4060	Result := Result + ' AS NEEDED';
4061	end;
4062	end;
4063	end;
4064
4065	function GetComplexDoseSchedule: string;
4066	begin
4067	with grdDoses do
4068	begin
4069	Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 1);
4070	if Result = '' then Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
4071	if valFor(VAL_CHKXPRN,ARow)='1' then Result := Result + ' PRN';
4072	if UpperCase(Copy(Result, Length(Result) - 6, Length(Result))) = 'PRN PRN' then
4073	Result := Copy(Result, 1, Length(Result) - 4);
4074	end;
4075	end;
4076
4077	function GetComplexDoseScheduleEX: string;
4078	begin
4079	with grdDoses do
4080	begin
4081	(*Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 2);
4082	if Result = '' then //Added for CQ: 7639
4083	begin
4084	Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
4085	if RightStr(Result,4) = ' PRN' then
4086	Result := Copy(Result,1,Length(Result)-4); //Remove the Trailing PRN
4087	end;
4088	if (Piece(Cells[COL_SCHEDULE, ARow], TAB, 1) <>
4089	Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 1)) and
4090	(Pos('PRN', Piece(Cells[COL_SCHEDULE, ARow], TAB, 1)) > 0)
4091	then Result := Result + ' AS NEEDED';
4092	end;*)
4093	Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2),U,2);
4094	if Result = '' then Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2),U,1); //Added for CQ: 7639
4095	if Result = '' then Result := Piece(Cells[COL_SCHEDULE, ARow], TAB, 1);
4096	if RightStr(Result,3) = 'PRN' then
4097	begin
4098	Result := Copy(Result,1,Length(Result)-3); //Remove the Trailing PRN
4099	if (RightStr(Result,1) = ' ') or (RightStr(Result,1) = '-') then
4100	Result := Copy(Result,1,Length(Result)-1);
4101	Result := Result + ' AS NEEDED';
4102	end;
4103	if valFor(VAL_CHKXPRN,ARow)='1' then Result := Result + ' AS NEEDED';
4104	if UpperCase(Copy(Result, Length(Result) - 18, Length(Result))) = 'AS NEEDED AS NEEDED'
4105	then Result := Copy(Result, 1, Length(Result) - 10);
4106	if UpperCase(Copy(Result, Length(Result) - 12, Length(Result))) = 'PRN AS NEEDED' then
4107	begin
4108	Result := Copy(Result, 1, Length(Result) - 13);
4109	if RightStr(Result,1)=' ' then Result := Result + 'AS NEEDED'
4110	else Result := Result + ' AS NEEDED';
4111	end;
4112	end;
4113	end;
4114
4115	begin
4116	Result := '';
4117	if ARow < 0 then // use single dose controls
4118	begin
4119	case FieldID of
4120	FLD_DOSETEXT : with cboDosage do
4121	if ItemIndex > -1 then Result := Uppercase(Piece(Items[ItemIndex], U, 5))
4122	else Result := Uppercase(Text);
4123	FLD_LOCALDOSE : with cboDosage do
4124	if ItemIndex > -1 then Result := Piece(Piece(Items[ItemIndex], U, 4), '&', 5)
4125	else Result := Uppercase(Text);
4126	FLD_STRENGTH : with cboDosage do
4127	if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 2);
4128	FLD_DRUG_ID : with cboDosage do
4129	if ItemIndex > -1 then Result := Piece(Piece(Items[ItemIndex], U, 4), '&', 6);
4130	FLD_DRUG_NM : with cboDosage do
4131	if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 1);
4132	FLD_DOSEFLDS : with cboDosage do
4133	if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 4);
4134	FLD_TOTALDOSE : with cboDosage do
4135	if ItemIndex > -1 then Result := Piece(Piece(Items[ItemIndex], U, 4), '&', 1);
4136	FLD_UNITNOUN : with cboDosage do
4137	if ItemIndex > -1 then Result := Piece(Piece(Items[ItemIndex], U, 4), '&', 3) + ' '
4138	+ Piece(Piece(Items[ItemIndex], U, 4), '&', 4);
4139	FLD_ROUTE_ID : with cboRoute do
4140	if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 1);
4141	FLD_ROUTE_NM : with cboRoute do
4142	if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 2)
4143	else Result := Text;
4144	FLD_ROUTE_AB : with cboRoute do
4145	if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 3);
4146	FLD_ROUTE_EX : with cboRoute do
4147	if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 4);
4148	FLD_SCHEDULE : begin
4149	Result := GetSingleDoseSchedule;
4150	end;
4151	FLD_SCHED_EX : begin
4152	Result := GetSingleDoseScheduleEX;
4153	end;
4154	FLD_SCHED_TYP : with cboSchedule do
4155	if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 3);
4156	FLD_QTYDISP : with cboDosage do
4157	begin
4158	if ItemIndex > -1 then Result := Piece(Items[ItemIndex], U, 8);
4159	if (Result = '') and (Items.Count > 0) then Result := Piece(Items[0], U, 8);
4160	if Result <> ''
4161	then Result := 'Qty (' + Result + ')'
4162	else Result := 'Quantity';
4163	end;
4164	end; {case FieldID} // use complex dose controls
4165	end else
4166	begin
4167	if (ARow < 1) or (ARow >= grdDoses.RowCount) then Exit;
4168	if Length(FDrugID) > 0
4169	then x := FieldsForDose(ARow)
4170	else x := Piece(Piece(grdDoses.Cells[COL_DOSAGE, ARow], TAB, 2), U, 4);
4171	with grdDoses do
4172	case FieldID of
4173	FLD_DOSETEXT : Result := Uppercase(Piece(Cells[COL_DOSAGE, ARow], TAB, 1));
4174	FLD_LOCALDOSE : begin
4175	if (Length(x) > 0) and (Length(FDrugID) > 0)
4176	then Result := Piece(x, '&', 5)
4177	else Result := Uppercase(Piece(Cells[COL_DOSAGE, ARow], TAB, 1));
4178	end;
4179	FLD_STRENGTH : Result := Piece(x, '&', 7) + Piece(x, '&', 8);
4180	FLD_DRUG_ID : Result := Piece(x, '&', 6);
4181	FLD_DRUG_NM : Result := Piece(FieldsForDrug(Piece(x, '&', 6)), U, 4);
4182	FLD_DOSEFLDS : Result := x;
4183	FLD_TOTALDOSE : Result := Piece(x, '&', 1);
4184	FLD_UNITNOUN : Result := Piece(x, '&', 3) + ' ' + Piece(x, '&', 4);
4185	FLD_ROUTE_ID : Result := Piece(Piece(Cells[COL_ROUTE, ARow], TAB, 2), U, 1);
4186	FLD_ROUTE_NM : begin
4187	Result := Piece(Piece(Cells[COL_ROUTE, ARow], TAB, 2), U, 2);
4188	if Result = '' then Result := Piece(Cells[COL_ROUTE, ARow], TAB, 1);
4189	end;
4190	FLD_ROUTE_AB : Result := Piece(Piece(Cells[COL_ROUTE, ARow], TAB, 2), U, 3);
4191	FLD_ROUTE_EX : Result := Piece(Piece(Cells[COL_ROUTE, ARow], TAB, 2), U, 4);
4192	FLD_SCHEDULE : begin
4193	Result := GetComplexDoseSchedule;
4194	end;
4195	FLD_SCHED_EX : begin
4196	Result := GetComplexDoseScheduleEX;
4197	end;
4198	FLD_SCHED_TYP : Result := Piece(Piece(Cells[COL_SCHEDULE, ARow], TAB, 2), U, 3);
4199	FLD_DURATION : Result := Piece(Cells[COL_DURATION, ARow], TAB, 1);
4200	FLD_SEQUENCE : Result := Piece(Cells[COL_SEQUENCE, ARow], TAB, 1);
4201	end; {case FieldID}
4202	end; {if ARow}
4203	if FieldID > FLD_MISC_FLDS then // still need to process 'non-sig' fields
4204	begin
4205	case FieldID of
4206	FLD_SUPPLY : Result := Trim(txtSupply.Text);
4207	FLD_QUANTITY :
4208	begin
4209	if Pos(',', txtQuantity.Text)>0 then
4210	Result := Piece(txtQuantity.Text,',',1) + Piece(txtQuantity.Text,',',2)
4211	else
4212	Result := Trim(txtQuantity.Text);
4213	end;
4214	FLD_REFILLS : Result := txtRefills.Text;
4215	FLD_PICKUP : if radPickWindow.Checked then Result := 'W'
4216	else if radPickMail.Checked then Result := 'M'
4217	else if radPickClinic.Checked then Result := 'C'
4218	else Result := '';
4219	FLD_PRIOR_ID : Result := cboPriority.ItemID;
4220	FLD_PRIOR_NM : Result := cboPriority.Text;
4221	FLD_COMMENT : Result := memComment.Text;
4222
4223	FLD_NOW_ID : if chkDoseNow.Visible and chkDoseNow.Checked then Result := '1' else Result := '';
4224	FLD_NOW_NM : if chkDoseNow.Visible and chkDoseNow.Checked then Result := 'NOW' else Result := '';
4225	FLD_PTINSTR : if chkPtInstruct.Visible and chkPtInstruct.Checked
4226	then Result := FPtInstruct
4227	else Result := ' ';
4228	end; {case FieldID}
4229	end; {if FieldID}
4230	end;
4231
4232	function TfrmODMeds.ValueOfResponse(FieldID: Integer; AnInstance: Integer = 1): string;
4233	var
4234	x: string;
4235	begin
4236	case FieldID of
4237	FLD_SCHEDULE : Result := Responses.IValueFor('SCHEDULE', AnInstance);
4238	FLD_UNITNOUN : begin
4239	x := Responses.IValueFor('DOSE', AnInstance);
4240	Result := Piece(x, '&', 3) + ' ' + Piece(x, '&', 4);
4241	end;
4242	FLD_DOSEUNIT : begin
4243	x := Responses.IValueFor('DOSE', AnInstance);
4244	Result := Piece(x, '&', 3);
4245	end;
4246	FLD_DRUG_ID : Result := Responses.IValueFor('DRUG', AnInstance);
4247	FLD_INSTRUCT : Result := Responses.IValueFor('INSTR', AnInstance);
4248	FLD_SUPPLY : Result := Responses.IValueFor('SUPPLY', AnInstance);
4249	FLD_QUANTITY : Result := Responses.IValueFor('QTY', AnInstance);
4250	FLD_ROUTE_ID : Result := Responses.IValueFor('ROUTE', AnInstance);
4251	FLD_EXPIRE : Result := Responses.IValueFor('DAYS', AnInstance);
4252	FLD_ANDTHEN : Result := Responses.IValueFor('CONJ', AnInstance);
4253	end;
4254	end;
4255
4256	procedure TfrmODMeds.UpdateDefaultSupply(const CurUnits, CurSchedule, CurDuration, CurDispDrug: string;
4257	var CurSupply: Integer; var CurQuantity: double; var SkipQtyCheck: Boolean);
4258	var
4259	ADrug: string;
4260	Checked: boolean;
4261	tmpSupply: integer;
4262	begin
4263	Checked := false;
4264	if ((StrToFloatDef(txtQuantity.Text, 0) = 0) and (StrToIntDef(txtSupply.Text, 0) = 0) and
4265	(txtQuantity.Tag = 0) and (txtSupply.Tag = 0) and (cboDosage.Text <> ''))
4266	or ((cboDosage.ItemIndex < 0) and (not FIsQuickOrder)) or
4267	((IsClozapineOrder = true) and (FISQuickOrder) and (FQOInitial)) then
4268	begin
4269	Checked := True;
4270	ADrug := Piece(CurDispDrug, U, 1);
4271	CurSupply := DefaultDays(ADrug, CurUnits, CurSchedule);
4272	if CurSupply > 0 then
4273	begin
4274	spnSupply.Position := CurSupply;
4275	if (txtSupply.Text = '') or (StrToInt(txtSupply.Text)<>CurSupply) then
4276	txtSupply.Text := IntToStr(CurSupply);
4277	if (FIsQuickOrder) and (FQOInitial) and (IsClozapineOrder = false) then
4278	begin
4279	if StrToFloatDef(txtSupply.Text,0) > 0 then
4280	begin
4281	Exit;
4282	end;
4283	end;
4284	CurQuantity := DaysToQty(CurSupply, CurUnits, CurSchedule, CurDuration, ADrug);
4285	if CurQuantity >= 0 then
4286	begin
4287	//spnQuantity.Position := CurQuantity;
4288	if txtQuantity.Text <> '' then
4289	txtQuantity.Text := FloatToStr(CurQuantity);
4290	if (txtQuantity.Text = '') or (StrToInt(txtQuantity.Text) <> CurQuantity) then
4291	txtQuantity.Text := FloatToStr(CurQuantity);
4292	end;
4293	SkipQtyCheck := TRUE;
4294	end;
4295	//if FQOInitial = true then FQOInitial := False;
4296	end;
4297	if (IsClozapineOrder = true) and (CurDispDrug <> '') and (CurDispDrug <> U)and (Checked = false) then
4298	begin
4299	ADrug := Piece(CurDispDrug, U, 1);
4300	tmpSupply := DefaultDays(ADrug, CurUnits, CurSchedule);
4301	if (tmpSupply > 0) and (CurSupply > tmpSupply) then
4302	begin
4303	CurSupply := tmpSupply;
4304	spnSupply.Position := CurSupply;
4305	if (txtSupply.Text = '') or (StrToInt(txtSupply.Text)<>CurSupply) then
4306	txtSupply.Text := IntToStr(CurSupply);
4307	end;
4308	CurQuantity := DaysToQty(CurSupply, CurUnits, CurSchedule, CurDuration, ADrug);
4309	if CurQuantity >= 0 then
4310	begin
4311	//spnQuantity.Position := CurQuantity;
4312	if (txtQuantity.Text <> '') and (CurQuantity > 0) then
4313	txtQuantity.Text := FloatToStr(CurQuantity);
4314	if (txtQuantity.Text = '') or (StrToInt(txtQuantity.Text) <> CurQuantity) and (CurQuantity > 0) then
4315	txtQuantity.Text := FloatToStr(CurQuantity);
4316	end;
4317	end;
4318	end;
4319
4320	//add CURInstrcut to this procedure. This address a problem with an user starting with a free-text dosage and changing
4321	//to another free-text dose and the quantity value not updating.
4322	procedure TfrmODMeds.UpdateSupplyQuantity(const CurUnits, CurSchedule, CurDuration, CurDispDrug, CurInstruct: string;
4323	var CurSupply: Integer; var CurQuantity: double);
4324	const
4325	UPD_NONE = 0;
4326	UPD_QUANTITY = 1;
4327	UPD_SUPPLY = 2;
4328	UPD_COMPLEX = 3;
4329	UPD_BOTH = 4;
4330	var
4331	UpdateControl, NewSupply: Integer;
4332	ADrug: string;
4333	SaveChanging: Boolean;
4334	tmpQuantity: double;
4335	begin
4336	if (tabDose.TabIndex = TI_COMPLEX) and (txtSupply.Tag = 0) and (txtQuantity.Tag = 0) then
4337	begin
4338	// set days supply based on durations
4339	NewSupply := DurationToDays;
4340	if NewSupply > 0 then
4341	begin
4342	SaveChanging := Changing;
4343	Changing := TRUE;
4344	txtSupply.Text := IntToStr(NewSupply);
4345	CurSupply := NewSupply;
4346	Changing := SaveChanging;
4347	end;
4348	end;
4349	// exit if not enough fields to calculation supply or quantity
4350	if (CurQuantity = 0) and (CurSupply = 0) then Exit;
4351	// exit if nothing has changed
4352	if (CurUnits = FLastUnits) and
4353	(CurSchedule = FLastSchedule) and
4354	(CurDuration = FLastDuration) and
4355	(CurQuantity = FLastQuantity) and
4356	(CurSupply = FLastSupply) and
4357	(CurInstruct = FLastInstruct) then Exit;
4358	// exit if supply & quantity have both been directly edited
4359	if (txtSupply.Tag > 0) and (txtQuantity.Tag > 0) then Exit;
4360	// figure out which control to update
4361	UpdateControl := UPD_NONE;
4362
4363	if (CurSupply <> FLastSupply) and (txtQuantity.Tag = 0) and (CurQuantity <> FLastQuantity) and (txtSupply.Tag = 0) and Changing then UpdateControl := UPD_BOTH
4364	else if (CurSupply <> FLastSupply) and (txtQuantity.Tag = 0) then UpdateControl := UPD_QUANTITY
4365	else if (CurQuantity <> FLastQuantity) and (txtSupply.Tag = 0) then UpdateControl := UPD_SUPPLY;
4366	if (UpdateControl = UPD_NONE) and (((CurUnits <> FLastUnits) or (CurInstruct <> FLastInstruct)) or (CurSchedule <> FLastSchedule)) then
4367	begin
4368	if txtQuantity.Tag = 0 then UpdateControl := UPD_QUANTITY
4369	else if txtSupply.Tag = 0 then UpdateControl := UPD_SUPPLY;
4370	end;
4371	ADrug := Piece(CurDispDrug, U, 1); // just use the first dispense drug (for clozapine chk)
4372	case UpdateControl of
4373	UPD_QUANTITY : begin
4374	if FIsQuickOrder and (CurQuantity > 0) and FQOInitial then
4375	begin
4376	txtQuantity.Text := FloatToStr(CurQuantity);
4377	Exit;
4378	end;
4379	CurQuantity := DaysToQty(CurSupply, CurUnits, CurSchedule, CurDuration, ADrug);
4380	if (CurQuantity >= 0) then
4381	txtQuantity.Text := FloatToStr(CurQuantity);
4382	end;
4383	UPD_SUPPLY : begin
4384	CurSupply := QtyToDays(CurQuantity, CurUnits, CurSchedule, CurDuration, ADrug);
4385	if CurSupply > 0 then txtSupply.Text := IntToStr(CurSupply);
4386	end;
4387	UPD_BOTH : begin
4388	txtSupply.Text := IntToStr(CurSupply);
4389	spnSupply.Position := StrToIntDef(txtSupply.Text, 0);
4390	tmpQuantity := DaysToQty(CurSupply, CurUnits, CurSchedule, CurDuration, ADrug);
4391	if FIsQuickOrder and (CurQuantity > 0) and FQOInitial then
4392	begin
4393	txtQuantity.Text := FloatToStr(CurQuantity);
4394	Exit;
4395	end;
4396	(* if FIsQuickOrder and (CurQuantity > 0) and (tmpQuantity = 0) and FQOInitial then
4397	begin
4398	txtQuantity.Text := FloatToStr(CurQuantity);
4399	Exit;
4400	end; *)
4401	//CurQuantity := DaysToQty(CurSupply, CurUnits, CurSchedule, CurDuration, ADrug);
4402	CurQuantity := tmpQuantity;
4403	if CurQuantity >= 0 then
4404	txtQuantity.Text := FloatToStr(CurQuantity);
4405	end;
4406	end;
4407	if UpdateControl > UPD_NONE then FUpdated := True;
4408	end;
4409
4410	procedure TfrmODMeds.updateSig;
4411	begin
4412	inherited;
4413	if self.tabDose.TabIndex = TI_DOSE then self.cboDosage.OnExit(cboDosage);
4414	if self.tabDose.TabIndex = TI_COMPLEX then self.cboxDosage.OnExit(cboxDosage);
4415	end;
4416
4417	procedure TfrmODMeds.UpdateStartExpires(const CurSchedule: string);
4418	var
4419	CompSch, CompDose, LastSch, ShowText, Duration, ASchedule, TempSch, schType, Admin, tempAdmin: string;
4420	AdminTime: TFMDateTime;
4421	j, r, Interval, PrnPos, SchID: Integer;
4422	EndCheck, rowCheck, DoseNow: boolean;
4423	begin
4424	if not FInptDlg then Exit;
4425	if Length(CurSchedule)=0 then Exit;
4426	ASchedule := Trim(CurSchedule);
4427	DoseNow := True;
4428	if self.EvtID > 0 then DoseNow := false;
4429	if (Pos('^',ASchedule)>0) then
4430	begin
4431	PrnPos := Pos('PRN',ASchedule);
4432	if (PrnPos > 1) and (CharAt(ASchedule,PrnPos-1)=' ') then
4433	Delete(ASchedule, PrnPos-1, 4);
4434	end;
4435	if (FAdminTimeText = '') and (self.EvtID > 0) then FAdminTimeText := 'To Be Determined';
4436	AdminTime := 0;
4437	ASchedule := Trim(ASchedule);
4438	//AGP Change for CQ 9906
4439	EndCheck := False;
4440	lastSch := '';
4441	if self.tabDose.TabIndex = TI_COMPLEX then
4442	begin
4443	tempSch := ASchedule;
4444	ASchedule := '';
4445	for r := 1 to self.grdDoses.RowCount-1 do
4446	begin
4447	CompSch := valFor(VAL_SCHEDULE,r);
4448	CompDose := valFor(VAL_DOSAGE,r);
4449	RowCheck := valFor(VAL_CHKXPRN,r)='1';
4450	if (RowCheck = True) then
4451	begin
4452	if EndCheck = false then AdminTime := -1;
4453	if FAdminTimeText = '' then self.grdDoses.cells[COL_ADMINTIME, r] := ''
4454	else Self.grdDoses.Cells[COL_ADMINTIME, r] := FAdminTimeText;
4455	end
4456	else
4457	begin
4458	if CompSch <> '' then
4459	begin
4460	//cboXSchedule.Items.IndexOfName(CompSch);
4461	//cboXSchedule.SelectByID(CompSch);
4462	SchID := -1;
4463	for j := 0 to cboXSchedule.Items.Count - 1 do
4464	begin
4465	if Piece(cboXSchedule.Items.Strings[j], U, 1) = CompSch then
4466	begin
4467	schID := j;
4468	break;
4469	end;
4470	end;
4471	//if cboXSchedule.ItemIndex > -1 then
4472	if SchID > -1 then
4473	begin
4474	//SchID := cboXSchedule.ItemIndex;
4475	if (Piece(self.cboXSchedule.Items.Strings[SchID],U,1) = CompSch) then
4476	begin
4477	SchType := Piece(self.cboXSchedule.Items.Strings[SchID],U,3);
4478	if (SchType = 'P') or (SchType = 'O') or (SchType = 'OC') then
4479	self.grdDoses.Cells[COL_ADMINTIME, r] := ''
4480	else if FAdminTimeText <> '' then self.grdDoses.Cells[COL_ADMINTIME, r] := FAdminTimeText
4481	else
4482	begin
4483	self.grdDoses.Cells[COL_ADMINTIME, r] := Piece(self.cboXSchedule.Items.Strings[SchID],U,4);
4484	if self.grdDoses.Cells[COL_ADMINTIME, r] = '' then self.grdDoses.Cells[COL_ADMINTIME, r] := 'Not Defined';
4485
4486	end;
4487	if CompDose <> '' then
4488	begin
4489	lastSch := CompSch;
4490	if (EndCheck = False) and ((SchType = 'P') or (SchType = 'O')) then AdminTime := -1
4491	//else Aschedule := ';' + CompSch;
4492	end;
4493	end;
4494
4495	end;
4496	end;
4497	end;
4498	if ((valFor(VAL_SEQUENCE,r) = 'AND') or (valFor(VAL_SEQUENCE,r) = '')) and (AdminTime > -1) and (EndCheck = false) then
4499	begin
4500	//if (CompSch = '') and (LastSch <> '') and (Aschedule <> '') then CompSch := LastSch;
4501	if (ASchedule <> '') and (CompSch <> '') and (RowCheck = False) then ASchedule := ASchedule + ';' + CompSch;
4502	if (ASchedule = '') and (CompSch <> '') and (RowCheck = False) then ASchedule := ';' + CompSch;
4503	end
4504	else if ValFor(VAL_SEQUENCE, r) = 'THEN' then
4505	begin
4506	// if (CompSch = '') and (LastSch <> '') and (Aschedule <> '') then CompSch := LastSch;
4507	if (ASchedule <> '') and (CompSch <> '') and (RowCheck = False) then ASchedule := ASchedule + ';' + CompSch;
4508	if (ASchedule = '') and (CompSch <> '') and (RowCheck = False) then ASchedule := ';' + CompSch;
4509	EndCheck := True;
4510	end
4511	end;
4512	end;
4513	if self.tabDose.TabIndex = TI_DOSE then
4514	begin
4515	if LeftStr(ASchedule, 1) = ';' then tempSch := Piece(ASchedule, ';', 2)
4516	else tempSch := ASchedule;
4517	if self.chkPRN.Checked = True then
4518	begin
4519	AdminTime := -1;
4520	lblAdminSchSetText('');
4521	if (cboSchedule.ItemIndex > -1) and (Piece(self.cboSchedule.Items.Strings[cboSchedule.itemIndex], U, 3) = 'O') then
4522	DoseNow := false;
4523	end
4524	else begin
4525	//cboSchedule.SelectByID(tempSch);
4526	SchID := -1;
4527	for j := 0 to cboSchedule.Items.Count - 1 do
4528	begin
4529	if Piece(cboSchedule.Items.Strings[j], U, 1) = tempSch then
4530	begin
4531	schID := j;
4532	break;
4533	end;
4534	end;
4535	if schID > -1 then
4536	begin
4537	SchType := Piece(self.cboSchedule.Items.Strings[schID], U, 3);
4538	if (SchType = 'P') or (SchType = 'OC') or (SchType = 'O') then
4539	begin
4540	lblAdminSchSetText('');
4541	if (SchType = 'P') or (SchType = 'OC') or (SchType = 'O') then AdminTime := -1;
4542	if SchType = 'O' then DoseNow := false;
4543	end
4544	else
4545	begin
4546	if FAdminTimeText <> '' then tempAdmin := 'Admin. Time: ' + FAdminTimeText
4547	else
4548	begin
4549	if Piece(self.cboSchedule.Items.Strings[schID], U, 4) <> '' then
4550	tempAdmin := 'Admin. Time: ' + Piece(self.cboSchedule.Items.Strings[schID], U, 4)
4551	else tempAdmin := 'Admin. Time: Not Defined';
4552	end;
4553	lblAdminSchSetText(tempAdmin);
4554	(* if FAdminTimeText <> '' then self.lblAdminSch.text := 'Admin. Time: ' + FAdminTimeText
4555	else
4556	begin
4557	if Piece(self.cboSchedule.Items.Strings[schID], U, 4) <> '' then
4558	self.lblAdminSch.text := 'Admin. Time: ' + Piece(self.cboSchedule.Items.Strings[schID], U, 4)
4559	else self.lblAdminSch.text := 'Admin. Time: Not Defined';
4560	end; *)
4561
4562	end;
4563	end;
4564	end;
4565	end;
4566	if (Length(ASchedule)>0) and (AdminTime > -1) then
4567	begin
4568	if LeftStr(Aschedule, 1) <> ';' then ASchedule := ';'+ASchedule;
4569	Admin := '';
4570	if (self.lblAdminSch.visible = True) and (self.lblAdminSch.text <> '') and (self.tabDose.TabIndex = TI_DOSE) then
4571	begin
4572	//AGP Change Admin Time Wrap 27.73
4573	//Admin := Copy(self.lblAdminSch.text, 14, (Length(self.lblAdminSch.text)-1));
4574	Admin := lblAdminSchGetText;
4575	if (Admin <> '') and (not (Admin[1] in ['0'..'9'])) then Admin := '';
4576	end
4577	else if self.tabDose.TabIndex = TI_COMPLEX then
4578	begin
4579	Admin := Self.grdDoses.Cells[COL_ADMINTIME, 1];
4580	if (Admin <> '') and (not (Admin[1] in ['0'..'9'])) then Admin := '';
4581	end;
4582	LoadAdminInfo(ASchedule, txtMed.Tag, ShowText, AdminTime, Duration, Admin);
4583	end;
4584	if AdminTime > 0 then
4585	begin
4586	ShowText := 'Expected First Dose: ';
4587	Interval := Trunc(FMDateTimeToDateTime(AdminTime) - FMDateTimeToDateTime(FMToday));
4588	case Interval of
4589	0: ShowText := ShowText + 'TODAY ' + FormatFMDateTime('(mmm dd, yy) at hh:nn', AdminTime);
4590	1: ShowText := ShowText + 'TOMORROW ' + FormatFMDateTime('(mmm dd, yy) at hh:nn', AdminTime);
4591	else ShowText := ShowText + FormatFMDateTime('mmm dd, yy at hh:nn', AdminTime);
4592	end;
4593
4594	if (Pos('PRN',Piece(CurSchedule,'^',1))>0) and ((pnlXSchedule.Tag = 1) or chkPrn.Checked ) then
4595	begin
4596	if lblAdmintime.visible then
4597	begin
4598	lblAdmintime.Caption := '';
4599	FAdminTimeLbl := lblAdminTime.Caption;
4600	end;
4601	end else
4602	lblAdminTime.Caption := ShowText;
4603	FAdminTimeLbl := lblAdminTime.Caption;
4604	end
4605	else lblAdminTime.Caption := '';
4606	if (lblAdminTime.Caption <> '') and (lblAdminTime.Visible = True) and (JAWSON = true) then lblAdminTime.TabStop := true
4607	else lblAdminTime.TabStop := false;
4608	if (lblAdminSch.text <> '') and (lblAdminSch.Visible = True) and (JAWSON = true) then lblAdminSch.TabStop := true
4609	else lblAdminSch.TabStop := false;
4610	DisplayDoseNow(DoseNow);
4611	end;
4612
4613	procedure TfrmODMeds.UpdateRefills(const CurDispDrug: string; CurSupply: Integer);
4614	begin
4615	if EvtForPassDischarge = 'D' then
4616	spnRefills.Max := CalcMaxRefills(CurDispDrug, CurSupply, txtMed.Tag, True)
4617	else
4618	spnRefills.Max := CalcMaxRefills(CurDispDrug, CurSupply, txtMed.Tag, Responses.EventType = 'D');
4619	if (StrToIntDef(txtRefills.Text, 0) > spnRefills.Max) then
4620	begin
4621	txtRefills.Text := IntToStr(spnRefills.Max);
4622	spnRefills.Position := spnRefills.Max;
4623	FUpdated := True;
4624	end;
4625	end;
4626
4627	procedure TfrmODMeds.UpdateRelated(DelayUpdate: Boolean = TRUE);
4628	begin
4629	timCheckChanges.Enabled := False; // turn off timer
4630	if DelayUpdate
4631	then timCheckChanges.Enabled := True // restart timer
4632	else timCheckChangesTimer(Self); // otherwise call directly
4633	end;
4634
4635	procedure TfrmODMeds.timCheckChangesTimer(Sender: TObject);
4636	const
4637	UPD_NONE = 0;
4638	UPD_QUANTITY = 1;
4639	UPD_SUPPLY = 2;
4640	var
4641	CurUnits, CurSchedule, CurInstruct, CurDispDrug, CurDuration, TmpSchedule, x, x1: string;
4642	CurScheduleIN, CurScheduleOut: string;
4643	CurSupply, i, pNum, j: Integer;
4644	CurQuantity: double;
4645	LackQtyInfo, SaveChanging: Boolean;
4646	begin
4647	inherited;
4648	timCheckChanges.Enabled := False;
4649	ControlChange(Self);
4650	SaveChanging := Changing;
4651	Changing := TRUE;
4652	// don't allow Exit procedure so Changing gets reset appropriately
4653	CurUnits := '';
4654	CurSchedule := '';
4655	CurDuration := '';
4656	LackQtyInfo := False;
4657	i := Responses.NextInstance('DOSE', 0);
4658	while i > 0 do
4659	begin
4660	x := ValueOfResponse(FLD_DOSEUNIT, i);
4661	if (x = '') and (not FIsQuickOrder) then LackQtyInfo := TRUE //StrToIntDef(x, 0) = 0
4662	else if (x = '') and FIsQuickOrder and (Length(txtQuantity.Text)>0) then
4663	LackQtyInfo := false;
4664	CurUnits := CurUnits + x + U;
4665	x := ValueOfResponse(FLD_SCHEDULE, i);
4666	if Length(x) = 0 then LackQtyInfo := TRUE;
4667	CurScheduleOut := CurScheduleOut + x + U;
4668	x1 := ValueOf(FLD_SEQUENCE,i);
4669	if Length(x1)>0 then
4670	begin
4671	X1 := CharAt(X1,1);
4672	CurScheduleIn := CurScheduleIn + x1 + ';' + x + U;
4673	end
4674	else
4675	CurScheduleIn := CurScheduleIn + ';' + x + U;
4676	x := ValueOfResponse(FLD_EXPIRE, i);
4677	CurDuration := CurDuration + x + '~';
4678	x := ValueOfResponse(FLD_ANDTHEN, i);
4679	CurDuration := CurDuration + x + U;
4680	x := ValueOfResponse(FLD_DRUG_ID, i);
4681	CurDispDrug := CurDispDrug + x + U;
4682	x := ValueOfResponse(FLD_INSTRUCT, i);
4683	CurInstruct := CurInstruct + x + U; //AGP CHANGE 26.19 FOR CQ 7465
4684	i := Responses.NextInstance('DOSE', i);
4685	end;
4686
4687	pNum := 1;
4688	while Length( Piece(CurScheduleIn,U,pNum)) > 0 do
4689	pNum := pNum + 1;
4690	if Length(Piece(CurScheduleIn,U,pNum)) < 1 then
4691	for j := 1 to pNum - 1 do
4692	begin
4693	if j = pNum -1 then
4694	TmpSchedule := TmpSchedule + ';' + Piece(Piece(CurScheduleIn,U,j),';',2)
4695	else
4696	TmpSchedule := TmpSchedule + Piece(CurScheduleIn,U,j) + U
4697	end;
4698	CurScheduleIn := TmpSchedule;
4699	CurQuantity := StrToFloatDef(ValueOfResponse(FLD_QUANTITY), 0);
4700	CurSupply := StrToIntDef(ValueOfResponse(FLD_SUPPLY) ,0);
4701	//CurRefill := StrToIntDef(ValueOfResponse(FLD_REFILLS) , 0);
4702	if FInptDlg then
4703	begin
4704	CurSchedule := CurScheduleIn;
4705	if Pos('^',CurSchedule)>0 then
4706	begin
4707	if Pos('PRN',Piece(CurSchedule,'^',1))>0 then
4708	if lblAdminTime.Visible then
4709	lblAdminTime.Caption := '';
4710	end;
4711	if (self.tabDose.TabIndex = TI_DOSE) and (CurSchedule <> FLastSchedule) then
4712	UpdateStartExpires(CurSchedule);
4713	if Responses.EventType in ['A','D','T','M','O'] then lblAdminTime.Visible := False;
4714	end;
4715	if not FInptDlg then
4716	begin
4717	CurSchedule := CurScheduleOut;
4718	if ((CurInstruct <> FLastInstruct) and (CurUnits <> U)) or ((IsClozapineOrder = true) and (CurDispDrug <> '') and (CurDispDrug <> U)) //AGP Change 26.48 Do not update quantity and day supply if no matching dose on the server
4719	//if ((CurInstruct <> FLastInstruct) and (CurUnits <> U))
4720	then UpdateDefaultSupply(CurUnits, CurSchedule, CurDuration, CurDispDrug, CurSupply, CurQuantity,
4721	LackQtyInfo);
4722	if LackQtyInfo then begin
4723	if FScheduleChanged then
4724	txtQuantity.Text := '0';
4725	end
4726	else
4727	UpdateSupplyQuantity(CurUnits, CurSchedule, CurDuration, CurDispDrug, CurInstruct, CurSupply, CurQuantity);
4728	// if (CurDispDrug <> FLastDispDrug) then UpdateSC(CurDispDrug);
4729	if ((CurDispDrug <> FLastDispDrug) or (CurSupply <> FLastSupply)) and ((CurDispDrug <> '') and (CurSupply > 0)) then
4730	UpdateRefills(CurDispDrug, CurSupply);
4731	end;
4732
4733	FLastUnits := CurUnits;
4734	FLastSchedule := CurSchedule;
4735	FLastDuration := CurDuration;
4736	FLastInstruct := CurInstruct;
4737	FLastDispDrug := CurDispDrug;
4738	FLastQuantity := CurQuantity;
4739	FLastSupply := CurSupply;
4740	if (not FNoZERO) and (txtQuantity.Text = '') and (FLastQuantity = 0) then
4741	txtQuantity.Text := FloatToStr(FLastQuantity);
4742	if (not FNoZERO) and (txtSupply.Text = '') and (FLastSupply = 0) then
4743	txtSupply.Text := IntToStr(FLastSupply);
4744	if (ActiveControl <> nil) and (ActiveControl.Parent <> cboDosage)
4745	then cboDosage.Text := Piece(cboDosage.Text, TAB, 1);
4746	Changing := SaveChanging;
4747	if FUpdated then ControlChange(Self);
4748	FScheduleChanged := false;
4749	//FQOInitial := False;
4750	end;
4751
4752	procedure TfrmODMeds.cmdAcceptClick(Sender: TObject);
4753	var
4754	i: integer;
4755	begin
4756	if (FInptDlg) and (cboSchedule.Text = 'OTHER') then
4757	begin
4758	cboScheduleClick(Self);
4759	Exit;
4760	end;
4761	if timCheckChanges.Enabled = True then sleep(1500);
4762	//AGP Change for 26.45 PSI-04-069
4763	if self.tabDose.TabIndex = 1 then
4764	begin
4765	for i := 2 to self.grdDoses.RowCount do
4766	begin
4767	if ((ValFor(COL_DOSAGE, i-1) <> '') and (ValFor(COL_DOSAGE, i) <> '')) and (ValFor(COL_SEQUENCE,i-1) = '') then
4768	begin
4769	infoBox('To be able to complete a complex order every row except for the last row must have a conjunction defined. ' + CRLF
4770	+ CRLF + 'Verify that all rows have a conjunction defined.','Sequence Error',MB_OK);
4771	Exit;
4772	end;
4773	//text := Self.cboXDosage.Items.Strings[i];
4774	end;
4775	end;
4776	if FInptDlg and (not FOutptIV)
4777	then DisplayGroup := DisplayGroupByName('UD RX')
4778	else DisplayGroup := DisplayGroupByName('O RX');
4779	(* if (Not FInptDlg) then
4780	begin
4781	if (ValidateDaySupplyandQuantity(strtoInt(txtSupply.Text), strtoInt(txtQuantity.text)) = false) then Exit
4782	else ClearMaxData;
4783	end; *)
4784	//if (Not FInptDlg) and (ValidateMaxQuantity(strtoInt(txtQuantity.Text)) = false) then Exit;
4785
4786
4787	//timCheckChangesTimer(Self);
4788	DropLastSequence;
4789	cmdAccept.SetFocus;
4790	inherited;
4791	(*if self.Responses.Cancel = true then
4792	begin
4793	self.Destroy;
4794	exit;
4795	end; *)
4796	end;
4797
4798	procedure TfrmODMeds.chkPtInstructClick(Sender: TObject);
4799	begin
4800	inherited;
4801	ControlChange(Self);
4802	end;
4803
4804	procedure TfrmODMeds.chkDoseNowClick(Sender: TObject);
4805	const
4806	T = '"';
4807	T1 = 'By checking the "Give additional dose now" box, you have actually entered two orders for the same medication "';
4808	T2 = #13#13'The "Give additional dose now" order has an administration schedule of "';
4809	T3 = #13'The "Ongoing" order has an administration schedule of "';
4810	T4 = #13#13'Do you want to continue?';
4811	T5 = '" and a priority of "';
4812	T1A = 'By checking the "Give additional dose now" box, you have actually entered a new order with the schedule "NOW"';
4813	T2A = ' in addition to the one you are placing for the same medication "';
4814	var
4815	medNm: string;
4816	theSch: string;
4817	ordPriority: string;
4818	begin
4819	inherited;
4820	if (chkDoseNow.Checked) and (tabDose.TabIndex <> TI_COMPLEX) then
4821	begin
4822	medNm := txtMed.Text;
4823	theSch := cboSchedule.Text;
4824	ordPriority := cboPriority.SelText;
4825	if length(theSch)>0 then
4826	begin
4827	//if ( (ValueOf(FLD_SCHED_TYP) <> 'O') and (InfoBox(T1+medNm+T+T2+theSch+T+T3+'NOW"'+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL) )then
4828	//if InfoBox(T1+medNm+T+T2+theSch+T+T3+'NOW"'+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL then
4829	if InfoBox(T1+medNm+T+T2+'NOW'+T5+ordPriority+T+T3+theSch+T5+ordPriority+T+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL then
4830	begin
4831	chkDoseNow.Checked := False;
4832	Exit;
4833	end;
4834	end else
4835	begin
4836	if InfoBox(T1A+T2A+medNm+T+T4, 'Warning', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL then
4837	begin
4838	chkDoseNow.Checked := False;
4839	Exit;
4840	end;
4841	end;
4842	end;
4843	lblAdminTime.Visible := not chkDoseNow.Checked;
4844	if (tabDose.TabIndex = TI_COMPLEX) and chkDoseNow.Checked then
4845	begin
4846	if (InfoBox('Give Additional Dose Now is in addition to those listed in the table.' + CRLF +
4847	'Please adjust the duration of the first row, if necessary.',
4848	'Give Additional Dose Now for Complex Order', MB_OKCANCEL or MB_ICONWARNING) = IDCANCEL) then
4849	begin
4850	chkDoseNow.Checked := False;
4851	Exit;
4852	end;
4853	end;
4854	ControlChange(Self);
4855	end;
4856
4857
4858	procedure TfrmODMeds.CheckDecimal(var AStr: string);
4859	var
4860	DUName,UnitNum,tempStr: string;
4861	ToWord: string;
4862	ie,code: integer;
4863	begin
4864	ToWord := '';
4865	tempStr := AStr;
4866	UnitNum := Piece(AStr,' ',1);
4867	DUName := Copy(tempStr,Length(UnitNum)+1,Length(tempStr));
4868	DUName := Trim(DUName);
4869	if CharAt(UnitNum,1)='.' then
4870	begin
4871	if CharAt(UnitNum,2) in ['0','1','2','3','4','5','6','7','8','9'] then
4872	begin
4873	UnitNum := '0' + UnitNum;
4874	AStr := '0' + AStr;
4875	end;
4876	end;
4877	if ((Pos('TABLET',upperCase(DUName))= 0)) and ( Pos('DROP',upperCase(DUName))= 0 )then
4878	Exit;
4879	if (Length(UnitNum)>0) and (Length(DUName)>0) then
4880	begin
4881	if CharAt(UnitNum,1) <> '0' then
4882	begin
4883	Val(UnitNum, ie, code);
4884	if (code <> 0) and (ie=0) then
4885	Exit;
4886	end;
4887	AStr := TextDosage(UnitNum) + ' ' + DUName;
4888	end;
4889	end;
4890
4891	procedure TfrmODMeds.DropLastSequence(ASign: integer);
4892	const
4893	TXT_CONJUNCTIONWARNING = 'is not associated with the comment field, and has been deleted.';
4894	var
4895	i :integer;
4896	StrConjunc: string;
4897	begin
4898	for i := 1 to grdDoses.RowCount - 1 do
4899	begin
4900	if (i = 1) and (grdDoses.Cells[COL_DOSAGE,i] = '' ) then
4901	Exit
4902	else if (i>1) and (grdDoses.Cells[COL_DOSAGE,i] = '') and (grdDoses.Cells[COL_ROUTE,i] = '') then
4903	begin
4904	if Length(grdDoses.Cells[COL_SEQUENCE, i-1])>0 then
4905	begin
4906	StrConjunc := grdDoses.Cells[COL_SEQUENCE, i-1];
4907	if ASign = 1 then
4908	begin
4909	if InfoBox('The "' + StrConjunc + '" ' + TXT_CONJUNCTIONWARNING, 'Warning', MB_OK or MB_ICONWARNING) = IDOK then
4910	begin
4911	grdDoses.Cells[COL_SEQUENCE, i-1] := '';
4912	ActiveControl := memOrder;
4913	end
4914	end
4915	else
4916	begin
4917	grdDoses.Cells[COL_SEQUENCE, i-1] := '';
4918	end;
4919	end;
4920	Exit;
4921	end;
4922	end;
4923	end;
4924
4925	procedure TfrmODMeds.memCommentClick(Sender: TObject);
4926	var
4927	theSign : integer;
4928	begin
4929	inherited;
4930	theSign := 1;
4931	DropLastSequence(theSign);
4932	end;
4933
4934	procedure TfrmODMeds.btnXDurationClick(Sender: TObject);
4935	var
4936	APoint: TPoint;
4937	begin
4938	inherited;
4939	with TSpeedButton(Sender) do APoint := ClientToScreen(Point(0, Height));
4940	popDuration.Popup(APoint.X, APoint.Y);
4941	end;
4942
4943	procedure TfrmODMeds.chkPRNClick(Sender: TObject);
4944	var
4945	tempSch: string;
4946	PRNPos: integer;
4947	begin
4948	inherited;
4949	//GE CQ 7552
4950	if chkPRN.Checked then
4951	begin
4952	lblAdminTime.Caption := '';
4953	PrnPos := Pos('PRN',cboSchedule.Text);
4954	if (PrnPos < 1) and (FQOInitial = false) then
4955	UpdateStartExpires(cboSchedule.Text + ' PRN');
4956	end
4957	else
4958	begin
4959	if Length(Trim(cboSchedule.Text))>0 then
4960	begin
4961	tempSch := ';'+Trim(cboSchedule.Text);
4962	if FQOInitial = false then UpdateStartExpires(tempSch);
4963	end;
4964	//lblAdminTime.Caption := FAdminTimeLbl;
4965	if txtQuantity.visible then
4966	cboScheduleClick(Self);
4967	end;
4968	if FQOInitial = false then updateRelated(False);
4969	//updateRelated(False);
4970	ControlChange(Self);
4971	end;
4972
4973	procedure TfrmODMeds.grdDosesKeyDown(Sender: TObject; var Key: Word;
4974	Shift: TShiftState);
4975	begin
4976	inherited;
4977	case Key of
4978	// VK_RETURN: //moved to form key press
4979	VK_RIGHT:
4980	begin
4981	if (not FInptDlg) and (self.grdDoses.Col = COL_DURATION) then
4982	begin
4983	self.grdDoses.Col := COL_SEQUENCE;
4984	Key := 0;
4985	end;
4986	end;
4987	VK_LEFT:
4988	begin
4989	if (not FInptDlg) and (self.grdDoses.Col = COL_SEQUENCE) then
4990	begin
4991	self.grdDoses.Col := COL_DURATION;
4992	Key := 0;
4993	end;
4994	end;
4995	VK_ESCAPE:
4996	begin
4997	ActiveControl := FindNextControl(Sender as TWinControl, False, True, False); //Previous control
4998	Key := 0;
4999	end;
5000	VK_INSERT:
5001	begin
5002	btnXInsertClick(self);
5003	Key := 0;
5004	end;
5005	VK_DELETE:
5006	begin
5007	btnXRemoveClick(self);
5008	Key := 0;
5009	end;
5010	VK_TAB:
5011	begin
5012	if ssShift in Shift then
5013	begin
5014	ActiveControl := tabDose; //Previeous control
5015	Key := 0;
5016	end
5017	else if ssCtrl in Shift then
5018	begin
5019	ActiveControl := memComment;
5020	Key := 0;
5021	end;
5022	end;
5023	end;
5024	end;
5025
5026	procedure TfrmODMeds.grdDosesEnter(Sender: TObject);
5027	begin
5028	inherited;
5029	DisableDefaultButton(self);
5030	DisableCancelButton(self);
5031	end;
5032
5033	function TfrmODMeds.DisableCancelButton(Control: TWinControl): boolean;
5034	var
5035	i: integer;
5036	begin
5037	if (Control is TButton) and TButton(Control).Cancel then begin
5038	result := True;
5039	FDisabledCancelButton := TButton(Control);
5040	TButton(Control).Cancel := False;
5041	end else begin
5042	result := False;
5043	for i := 0 to Control.ControlCount-1 do
5044	if (Control.Controls[i] is TWinControl) then
5045	if DisableCancelButton(TWinControl(Control.Controls[i])) then begin
5046	result := True;
5047	break;
5048	end;
5049	end;
5050	end;
5051
5052	function TfrmODMeds.DisableDefaultButton(Control: TWinControl): boolean;
5053	var
5054	i: integer;
5055	begin
5056	if (Control is TButton) and TButton(Control).Default then begin
5057	result := True;
5058	FDisabledDefaultButton := TButton(Control);
5059	TButton(Control).Default := False;
5060	end else begin
5061	result := False;
5062	for i := 0 to Control.ControlCount-1 do
5063	if (Control.Controls[i] is TWinControl) then
5064	if DisableDefaultButton(TWinControl(Control.Controls[i])) then begin
5065	result := True;
5066	break;
5067	end;
5068	end;
5069	end;
5070
5071	procedure TfrmODMeds.RestoreCancelButton;
5072	begin
5073	if Assigned(FDisabledCancelButton) then begin
5074	FDisabledCancelButton.Cancel := True;
5075	FDisabledCancelButton := nil;
5076	end;
5077	end;
5078
5079	procedure TfrmODMeds.RestoreDefaultButton;
5080	begin
5081	if Assigned(FDisabledDefaultButton) then begin
5082	FDisabledDefaultButton.Default := True;
5083	FDisabledDefaultButton := nil;
5084	end;
5085	end;
5086
5087	procedure TfrmODMeds.FormKeyPress(Sender: TObject; var Key: Char);
5088	begin
5089	if (Key = #13) and (ActiveControl = txtMed) then
5090	Key := #0 //Don't let the base class turn it into a forward tab!
5091	else if (Key = #13) and (self.tabDose.TabIndex = TI_Complex) then
5092	Key := #0
5093	else
5094	inherited;
5095	end;
5096
5097	procedure TfrmODMeds.FormKeyDown(Sender: TObject; var Key: Word;
5098	Shift: TShiftState);
5099	begin
5100	inherited;
5101	if (Key = VK_TAB) and (ssCtrl in Shift) and (ActiveControl <> grdDoses) then
5102	begin
5103	//Back-tab works the same as forward-tab because there are only two tabs.
5104	tabDose.TabIndex := (tabDose.TabIndex + 1) mod tabDose.Tabs.Count;
5105	Key := 0;
5106	tabDoseChange(tabDose);
5107	end;
5108	end;
5109
5110	procedure TfrmODMeds.cboXRouteEnter(Sender: TObject);
5111	begin
5112	inherited;
5113	DisableDefaultButton(self);
5114	DisableCancelButton(self);
5115	QuantityMessageCheck(self.grdDoses.Row);
5116	end;
5117
5118	procedure TfrmODMeds.pnlMessageEnter(Sender: TObject);
5119	begin
5120	inherited;
5121	DisableDefaultButton(self);
5122	DisableCancelButton(self);
5123	end;
5124
5125	procedure TfrmODMeds.pnlMessageExit(Sender: TObject);
5126	begin
5127	inherited;
5128	RestoreDefaultButton;
5129	RestoreCancelButton;
5130	end;
5131
5132	procedure TfrmODMeds.memMessageKeyDown(Sender: TObject; var Key: Word;
5133	Shift: TShiftState);
5134	begin
5135	inherited;
5136	if (Key = VK_RETURN) or (Key = VK_ESCAPE) then
5137	begin
5138	Perform(WM_NEXTDLGCTL, 0, 0);
5139	Key := 0;
5140	end;
5141	end;
5142
5143	procedure TfrmODMeds.memPIClick(Sender: TObject);
5144	begin
5145	inherited;
5146	ShowMsg('The patient instruction field may not be edited.');
5147	chkPtInstruct.SetFocus;
5148	end;
5149
5150	procedure TfrmODMeds.FormResize(Sender: TObject);
5151	var
5152	aftHeight: integer;
5153	tempAdmin: string;
5154	begin
5155	inherited;
5156	pnlFields.Height := memOrder.Top - 4 - pnlFields.Top;
5157	aftHeight := pnlFields.Top + pnlFields.Height + memOrder.Height;
5158	if aftHeight > Height then
5159	Height := aftHeight;
5160	if pnlMessage.Visible then
5161	pnlMessage.Top := pnlFields.Top + pnlTop.Height + 8;
5162	tempAdmin := lblAdminSchGetText;
5163	if tempAdmin <> '' then lblAdminSchSetText('Admin Time: ' + tempAdmin);
5164	if not (FInptDLG) then
5165	begin
5166	if self.cboPriority.Left < (self.grpPickup.Left + self.grpPickup.Width) then
5167	begin
5168	self.cboPriority.Left := self.grpPickup.Left + self.grpPickup.Width + 2;
5169	if self.Width < (self.cboPriority.Left + self.cboPriority.Width) then
5170	begin
5171	self.Width := self.cboPriority.Left + self.cboPriority.Width + 9;
5172	self.cboPriority.Left := self.pnlBottom.Width - self.cboPriority.Width - 2;
5173	end;
5174	self.lblPriority.Left := self.cboPriority.Left;
5175	end;
5176	end;
5177	end;
5178
5179	procedure TfrmODMeds.memPIKeyDown(Sender: TObject; var Key: Word;
5180	Shift: TShiftState);
5181	begin
5182	inherited;
5183	ShowMsg('The patient instruction field may not be edited.');
5184	chkPtInstruct.SetFocus;
5185	end;
5186
5187	function TfrmODMeds.TextDosage(ADosage: string): string;
5188	var
5189	intS, fltS: string;
5190	iNum: integer;
5191	fNum: double;
5192	begin
5193	intS := '';
5194	fltS := '';
5195	Result := intS + fltS;
5196	try
5197	begin
5198	iNum := StrToIntDef(Piece(ADosage,'.',1),0);
5199	fNum := StrToFloatDef('0.'+Piece(ADosage,'.',2),0);
5200	if fNum = 0.5 then
5201	fltS := 'ONE-HALF';
5202	if ( fNum >= 0.3 ) and ( fNum <= 0.4 ) then
5203	fltS := 'ONE-THIRD';
5204	if fNum = 0.25 then
5205	fltS := 'ONE-FOURTH';
5206	if ( fNum >= 0.6 ) and ( fNum <= 0.7 ) then
5207	fltS := 'TWO-THIRDS';
5208	if fNum = 0.75 then
5209	fltS := 'THREE-FOURTHS';
5210	if iNum = 1 then
5211	intS := 'ONE';
5212	if iNum = 2 then
5213	intS := 'TWO';
5214	if iNum = 3 then
5215	intS := 'THREE';
5216	if iNum = 4 then
5217	intS := 'FOUR';
5218	if iNum = 5 then
5219	intS := 'FIVE';
5220	if iNum = 6 then
5221	intS := 'SIX';
5222	if iNum = 7 then
5223	intS := 'SEVEN';
5224	if iNum = 8 then
5225	intS := 'EIGHT';
5226	if iNum = 9 then
5227	intS := 'NINE';
5228	if iNum = 10 then
5229	intS := 'TEN';
5230	if Length(intS) > 0 then
5231	begin
5232	if Length(fltS)>1 then
5233	fltS :=' AND ' + fltS;
5234	end;
5235	Result := intS + fltS;
5236	if Result = '' then
5237	Result := ADosage;
5238	end
5239	except
5240	on EConvertError do Result := '';
5241	end;
5242	end;
5243
5244	function TfrmODMeds.CreateOtherScheduel: string; //NSS
5245	var
5246	aSchedule: string;
5247	begin
5248	aSchedule := '';
5249	if not ShowOtherSchedule(aSchedule) then
5250	begin
5251	cboSchedule.ItemIndex := -1;
5252	cboSchedule.Text := '';
5253	end
5254	else
5255	begin
5256	Result := Piece(aSchedule,U,1);
5257	NSSAdminTime := Piece(aschedule,u,2);
5258	NSSScheduleType := Piece(aSchedule, U, 3);
5259	if FAdminTimeText <> '' then NSSAdminTime := FAdminTimeText;
5260	end;
5261	end;
5262
5263	function TfrmODMeds.IfIsIMODialog: boolean;
5264	var
5265	IsInptDlg, IsIMOLocation: boolean;
5266	Td: TFMDateTime;
5267	begin
5268	result := False;
5269	IsInptDlg := False;
5270	// CQ #15188 - changed to use function to determine Td value - TDP
5271	//Td := FMToday;
5272	Td := IMOTimeFrame;
5273	if DlgFormID = MedsInDlgFormId then IsInptDlg := TRUE;
5274	IsIMOLocation := IsValidIMOLoc(Encounter.Location,Patient.DFN);
5275
5276	// CQ #15188 - allow IMO functionality 23 hours after encounter date/time - JCS
5277	// CQ #15188 - changed to use function to set Td. Reverted this line back to original - TDP
5278	{if (IsInptDlg) and (not Patient.Inpatient) and IsIMOLocation and
5279	(Encounter.DateTime > DateTimeToFMDateTime(FMDateTimeToDateTime(FMNow) - (23/24))) then}
5280	if (IsInptDlg) and (not Patient.Inpatient) and IsIMOLocation and (Encounter.DateTime > Td) then
5281	result := True;
5282	end;
5283
5284	procedure TfrmODMeds.lstChange(Sender: TObject; Item: TListItem;
5285	Change: TItemChange);
5286	begin
5287	inherited;
5288	btnSelect.Enabled := (lstAll.ItemIndex > -1) or
5289	((lstQuick.ItemIndex > -1) and
5290	(Assigned(lstQuick.Items[lstQuick.ItemIndex].Data)) and
5291	(Integer(lstQuick.Selected.Data) > 0)) ;
5292	if (btnSelect.Enabled) and (FOrderAction = ORDER_EDIT) then btnSelect.Enabled := false;
5293	if (btnSelect.Enabled) and (FRemoveText) then
5294	txtMed.Text := '';
5295	end;
5296
5297
5298	procedure TfrmODMeds.DisplayDoseNow(Status: boolean);
5299	begin
5300	if not FinptDlg then Status := False;
5301	if Status = false then
5302	begin
5303	if (self.chkDoseNow.Visible = true) and (self.chkDoseNow.Checked = true) then self.chkDoseNow.Checked := false;
5304	self.chkDoseNow.Visible := false;
5305	end;
5306	if status = true then self.chkDoseNow.Visible := true;
5307	end;
5308
5309	procedure TfrmODMeds.DispOrderMessage(const AMessage: string);
5310	begin
5311	if ContainsVisibleChar(AMessage) then
5312	begin
5313	image1.Visible := True;
5314	memDrugMsg.Visible := True;
5315	image1.Picture.Icon.Handle := LoadIcon(0, IDI_ASTERISK);
5316	memDrugMsg.Lines.Clear;
5317	memDrugMsg.Lines.SetText(PChar(AMessage));
5318	if fShrinkDrugMsg then
5319	begin
5320	pnlBottom.Height := pnlBottom.Height + memDrugMsg.Height + 2;
5321	fShrinkDrugMsg := False;
5322	end;
5323	end else
5324	begin
5325	image1.Visible := False;
5326	memDrugMsg.Visible := False;
5327	if not fShrinkDrugMsg then
5328	begin
5329	pnlBottom.Height := pnlBottom.Height - memDrugMsg.Height - 2;
5330	fShrinkDrugMsg := True;
5331	end;
5332	end;
5333	end;
5334
5335
5336	procedure TfrmODMeds.FormClose(Sender: TObject; var Action: TCloseAction);
5337	begin
5338	if FCloseCalled then Exit; //Temporary Hack: Close is called 2x for some reason & errors out
5339	FCloseCalled := true;
5340	FResizedAlready := False;
5341	inherited;
5342	end;
5343
5344	function TfrmODMeds.CreateOtherScheduelComplex: string;
5345	var
5346	aSchedule: string;
5347	begin
5348	aSchedule := '';
5349	if not ShowOtherSchedule(aSchedule) then
5350	begin
5351	cboXSchedule.ItemIndex := -1;
5352	cboXSchedule.Text := '';
5353	end
5354	else
5355	begin
5356	Result := Piece(aSchedule,U,1);
5357	NSSAdminTime := Piece(aschedule,u,2);
5358	NSSScheduleType := Piece(ASchedule, U, 3);
5359	if FAdminTimeText <> '' then NSSAdminTime := FAdminTimeText;
5360	end;
5361	end;
5362
5363	procedure TfrmODMeds.txtNSSClick(Sender: TObject);
5364	begin
5365	inherited;
5366	if MessageDlg('You can also select ' + '"' + 'Other' + '"' + ' from the schedule list'
5367	+ ' to create a day-of-week schedule.'
5368	+ #13#10 + 'Click OK to launch schedule builder',
5369	mtInformation, [mbOK, mbCancel],0) = mrOK then
5370	begin
5371	if (tabDose.TabIndex = TI_DOSE) then
5372	begin
5373	cboSchedule.SelectByID('OTHER');
5374	cboScheduleClick(Self);
5375	end;
5376	if (tabDose.TabIndex = TI_COMPLEX) then
5377	begin
5378	cboXSchedule.SelectByID('OTHER');
5379	CBOXScheduleChange(Self);
5380	end;
5381	end;
5382	end;
5383
5384	procedure TfrmODMeds.cboScheduleEnter(Sender: TObject);
5385	begin
5386	inherited;
5387	if (FInptDlg) and (cboSchedule.Text = 'OTHER') then
5388	cboScheduleClick(Self);
5389	end;
5390
5391	procedure TfrmODMeds.FormShow(Sender: TObject);
5392	begin
5393	FCloseCalled := false;
5394	inherited;
5395	if ( (cboSchedule.Text = 'OTHER') and FNSSOther and FInptDlg )then
5396	PostMessage(Handle, UM_NSSOTHER, 0, 0);
5397
5398	//I was using btnSelect.Top for the following, but it gets moved around
5399	Constraints.MinHeight := Constraints.MinHeight + ((Self.Height - cmdQuit.Top) * 2);
5400	end;
5401
5402	procedure TfrmODMeds.UMShowNSSBuilder(var Message: TMessage);
5403	begin
5404	Sleep(1000);
5405	cboScheduleClick(Self);
5406	end;
5407
5408	procedure TfrmODMeds.cboScheduleExit(Sender: TObject);
5409	begin
5410	inherited;
5411	if Trim(cboSchedule.Text) = '' then
5412	cboSchedule.ItemIndex := -1;
5413	ValidateInpatientSchedule(cboSchedule);
5414	updateRelated(False);
5415	end;
5416
5417
5418	procedure TfrmODMeds.cboScheduleKeyUp(Sender: TObject; var Key: Word;
5419	Shift: TShiftState);
5420	begin
5421	inherited;
5422	if (Key = VK_BACK) and (cboSchedule.Text = '') then cboSchedule.itemindex:= -1;
5423	end;
5424
5425	procedure TfrmODMeds.ValidateInpatientSchedule(ScheduleCombo: TORComboBox);
5426	var
5427	tmpIndex : Integer;
5428	begin
5429
5430	{CQ: 6690 - Orders - autopopulation of schedule field - overtyping only 1 character
5431	CQ: 7280 - PTM 32-34, 42 Meds: NJH-0205-20901 MED DIALOG DROPPING FIRST LETTER (schedule)}
5432
5433	//CQ 7575 Schedule coming across lower-case, change all schedules to Upper-Case.
5434	if (Length(ScheduleCombo.Text) > 0) then
5435	ScheduleCombo.Text := TrimLeft(UpperCase(ScheduleCombo.Text));
5436	{if user entered schedule verify it is in list}
5437	if (ScheduleCombo.ItemIndex < 0) and (not FInptDlg) then // CQ: 7397 and CQ 17934
5438	begin //Fix for CQ: 9299 - Outpatient Med orders will not accept free text schedule
5439	tmpIndex := GetSchedListIndex(ScheduleCombo,ScheduleCombo.Text);
5440	if tmpIndex > -1 then
5441	ScheduleCombo.ItemIndex := tmpIndex;
5442	end;
5443	if (Length(ScheduleCombo.Text) > 0) and (ScheduleCombo.ItemIndex < 0) and FInptDlg then
5444	begin
5445	FShowPnlXScheduleOk := False; //Added for CQ: 7370
5446	Application.MessageBox('Please select a valid schedule from the list.'+#13+#13+
5447	'If you would like to create a Day-of-Week schedule please'+
5448	' select ''OTHER'' from the list.',
5449	'Incorrect Schedule.');
5450	ScheduleCombo.ItemIndex := -1;
5451	ScheduleCombo.Text := '';
5452	FShowPnlXScheduleOk := True; //Added for CQ: 7370
5453	if ScheduleCombo.CanFocus then
5454	ScheduleCombo.SetFocus;
5455	//ScheduleCombo.SelStart := Length(ScheduleCombo.Text);
5456	end;
5457	end;
5458
5459	//Removed based on Site feeback. See CQ: 7518
5460	(*function TfrmODMeds.ValidateRoute(RouteCombo: TORComboBox) : Boolean;
5461	begin
5462	{CQ: 7331 - Medications - Route - Can not enter any route not listed in Route field in window}
5463	Result := True;
5464	if (Length(RouteCombo.Text) > 0) and (RouteCombo.ItemIndex < 0) and (Not IsSupplyAndOutPatient) then
5465	begin
5466	Application.MessageBox('Please select a correct route from the list.',
5467	'Incorrect Route.');
5468	if RouteCombo.CanFocus then
5469	RouteCombo.SetFocus;
5470	RouteCombo.SelStart := Length(RouteCombo.Text);
5471	Result := False;
5472	end;
5473	end;*)
5474
5475	function TfrmODMeds.isUniqueQuickOrder(iText: string): Boolean;
5476	var
5477	counter,i: Integer;
5478	begin
5479	counter := 0;
5480	Result := False;
5481	if iText = '' then Exit;
5482	for i := 0 to FQuickItems.Count-1 do
5483	if AnsiCompareText(iText, Copy(Piece(FQuickItems[i],'^',2), 1, Length(iText))) = 0 then
5484	Inc(counter); //Found a Match
5485	Result := counter = 1;
5486	end;
5487
5488	function TfrmODMeds.IsSupplyAndOutPatient: boolean;
5489	begin
5490	{CQ: 7331 - Medications - Route - Can not enter any route not listed in Route field in window}
5491	Result := False;
5492	if (MedIsSupply(txtMed.Tag)) and (not FInptDlg) then
5493	Result := True;
5494	end;
5495
5496	// CQ: 7397 - Inpatient med orders with PRN cancel due to invalid schedule.
5497	function TfrmODMeds.GetCacheChunkIndex(idx: integer): integer;
5498	begin
5499	Result := idx div MED_CACHE_CHUNK_SIZE;
5500	end;
5501
5502	function TfrmODMeds.GetSchedListIndex(SchedCombo: TORComboBox; pSchedule: String):integer;
5503	var i: integer;
5504	begin
5505	result := -1;
5506	for i := 0 to SchedCombo.items.Count-1 do
5507	begin
5508	if pSchedule = SchedCombo.DisplayText[i] then
5509	begin
5510	result := i; // match found
5511	break;
5512	end;
5513	end;
5514	end;
5515
5516
5517	procedure TfrmODMeds.cboXScheduleExit(Sender: TObject);
5518	begin
5519	inherited;
5520	{CQ: 7344 - Inconsistency with Schedule box: Allows free-text entry for Complex orders,
5521	doesn't for simple orders }
5522	ValidateInpatientSchedule(cboXSchedule);
5523	end;
5524
5525
5526	procedure TfrmODMeds.cboXScheduleKeyUp(Sender: TObject; var Key: Word;
5527	Shift: TShiftState);
5528	begin
5529	inherited;
5530	if (Key = VK_BACK) and (cboXSchedule.Text = '') then cboXSchedule.ItemIndex := -1;
5531	end;
5532
5533	procedure TfrmODMeds.cboXSequenceChange(Sender: TObject);
5534	var
5535	x: string;
5536	begin
5537	inherited;
5538	x := cboXSequence.Text;
5539	if (x = 'then') and ((ValFor(COL_DURATION, ARow1) = '') or (ValFor(COL_DURATION, ARow1) = '0')) then
5540	begin
5541	InfoBox('A duration is required when using "Then" as a conjunction' + CRLF + CRLF+
5542	'The patient will be instructed to take these doses consecutively, not concurrently.','Duration Warning',MB_OK);
5543	x := '';
5544	end;
5545	cboXSequence.text := x;
5546	cboXSequence.ItemIndex := cboXSequence.Items.IndexOf(x);
5547	grdDoses.Cells[COL_SEQUENCE, cboXSequence.Tag] := Uppercase(x);
5548	//AGP Start Expire add line
5549	UpdateStartExpires(valFor(COL_SCHEDULE,self.grdDoses.Row));
5550	ControlChange(Sender);
5551	end;
5552
5553	procedure TfrmODMeds.cboXSequenceEnter(Sender: TObject);
5554	begin
5555	inherited;
5556	DisableDefaultButton(self);
5557	DisableCancelButton(self);
5558	QuantityMessageCheck(self.grdDoses.Row);
5559	end;
5560
5561	procedure TfrmODMeds.cboXSequenceExit(Sender: TObject);
5562	begin
5563	inherited;
5564	grdDoses.Cells[COL_SEQUENCE, cboXSequence.Tag] := Uppercase(cboXSequence.Text);
5565	if ActiveControl = grdDoses then
5566	begin
5567	//This next condition seldom occurs, since entering the dosage on the last
5568	// row adds another row
5569	if grdDoses.Row = grdDoses.RowCount - 1 then
5570	grdDoses.RowCount := grdDoses.RowCount + 1;
5571	end;
5572	cboXSequence.Tag := -1;
5573	cboXSequence.Hide;
5574	RestoreDefaultButton;
5575	RestoreCancelButton;
5576	if (pnlMessage.Visible) and (memMessage.TabStop) then
5577	begin
5578	pnlMessage.Parent := grdDoses.Parent;
5579	pnlMessage.TabOrder := grdDoses.TabOrder;
5580	ActiveControl := memMessage;
5581	end
5582	else if grdDoses.Showing then
5583	ActiveControl := grdDoses
5584	else
5585	ActiveControl := cboDosage;
5586	//AGP Start Expire commented out line
5587	//UpdateStartExpires(valFor(COL_SCHEDULE,self.grdDoses.Row));
5588	end;
5589
5590
5591	procedure TfrmODMeds.cboXSequenceKeyUp(Sender: TObject; var Key: Word;
5592	Shift: TShiftState);
5593	begin
5594	inherited;
5595	if (Key = VK_BACK) and (cboXSequence.Text = '') then cboXSequence.ItemIndex := -1;
5596	end;
5597
5598	procedure TfrmODMeds.cboXSequence1Exit(Sender: TObject);
5599	begin
5600	inherited;
5601	cboxSequence.Hide;
5602	end;
5603
5604	procedure TfrmODMeds.cboDosageKeyUp(Sender: TObject; var Key: Word;
5605	Shift: TShiftState);
5606	begin
5607	inherited;
5608	if (Key = VK_BACK) and (cboDosage.Text = '') then cboDosage.ItemIndex := -1;
5609	//Fix for CQ: 7545
5610	if cboDosage.ItemIndex > -1 then
5611	cboDosageClick(Sender)
5612	else
5613	UpdateRelated;
5614	end;
5615
5616
5617	procedure TfrmODMeds.cboPriorityKeyUp(Sender: TObject; var Key: Word;
5618	Shift: TShiftState);
5619	begin
5620	inherited;
5621	if (Key = VK_BACK) and (cboPriority.Text = '') then cboPriority.ItemIndex := -1;
5622	end;
5623
5624	procedure TfrmODMeds.cboXDosageKeyUp(Sender: TObject; var Key: Word;
5625	Shift: TShiftState);
5626	begin
5627	inherited;
5628	if (Key = VK_BACK) and (cboXDosage.Text = '') then cboXDosage.itemindex := -1;
5629	//Fix for CQ: 7545
5630	if cboXDosage.ItemIndex > -1 then
5631	cboXDosageClick(Sender)
5632	else
5633	begin
5634	grdDoses.Cells[COL_DOSAGE, cboXDosage.Tag] := cboXDosage.Text;
5635	UpdateRelated;
5636	end;
5637	end;
5638
5639	procedure TfrmODMeds.txtSupplyClick(Sender: TObject);
5640	begin
5641	inherited;
5642	Self.txtSupply.SelectAll;
5643	end;
5644
5645	procedure TfrmODMeds.txtQuantityClick(Sender: TObject);
5646	begin
5647	inherited;
5648	self.txtQuantity.SelectAll;
5649	end;
5650
5651	procedure TfrmODMeds.txtRefillsChange(Sender: TObject);
5652	begin
5653	inherited;
5654	ControlChange(sender);
5655	end;
5656
5657	procedure TfrmODMeds.txtRefillsClick(Sender: TObject);
5658	begin
5659	inherited;
5660	self.txtRefills.SelectAll;
5661	end;
5662
5663	procedure TfrmODMeds.WMClose(var Msg: TWMClose);
5664	begin
5665	if self <> nil then
5666	begin
5667	if (self.tabDose.TabIndex = TI_Dose) then
5668	begin
5669	if Trim(cboSchedule.Text) = '' then cboSchedule.ItemIndex := -1;
5670	ValidateInpatientSchedule(cboSchedule);
5671	if self.cboSchedule.Focused = true then exit;
5672	end;
5673	if (self.tabDose.TabIndex = TI_Complex) then
5674	begin
5675	ValidateInpatientSchedule(cboXSchedule);
5676	if self.cboXSchedule.Focused = true then exit;
5677	end;
5678	end;
5679	inherited
5680	end;
5681
5682	procedure TfrmODMeds.cboXScheduleEnter(Sender: TObject);
5683	begin
5684	inherited;
5685	//agp Change CQ 10719
5686	self.chkXPRN.OnClick(self.chkXPRN);
5687	QuantityMessageCheck(self.grdDoses.Row);
5688	end;
5689
5690
5691	end.

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/Orders/fODMeds.pas@ 1722

Download in other formats: