Context Navigation

fODMedNVA.pas@ 1681

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

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

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

Context Navigation

source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fODMedNVA.pas@ 1681

Download in other formats: