Context Navigation

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

Last change on this file since 929 was 829, checked in by Kevin Toppenberg, 14 years ago
Upgrade to version 27
File size: 73.3 KB

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

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

Download in other formats: