Context Navigation

fODMeds.pas@ 1414

Last change on this file since 1414 was 460, checked in by Kevin Toppenberg, 17 years ago
Uploading from OR_30_258
File size: 165.0 KB

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

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

Context Navigation

source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fODMeds.pas@ 1414

Download in other formats: