Context Navigation

fODMedNVA.pas@ 1716

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

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

Context Navigation

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

Download in other formats: