Context Navigation

source: cprs/trunk/CPRS-Chart/Orders/fODLab.pas@ 908

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

Rev	Line
[456]	1	unit fODLab;
	2
	3	interface
	4
	5	uses
	6	SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
	7	Forms, Dialogs, StdCtrls, ORCtrls, ORfn, fODBase, ExtCtrls, ComCtrls, uConst,
[829]	8	ORDtTm, Buttons, Menus, VA508AccessibilityManager;
[456]	9
	10	type
	11	TfrmODLab = class(TfrmODBase)
	12	lblAvailTests: TLabel;
	13	cboAvailTest: TORComboBox;
	14	lblCollTime: TLabel;
	15	cboFrequency: TORComboBox;
	16	lblTestName: TLabel;
	17	lblCollSamp: TLabel;
	18	cboCollSamp: TORComboBox;
	19	lblSpecimen: TLabel;
	20	cboSpecimen: TORComboBox;
	21	lblUrgency: TLabel;
	22	cboUrgency: TORComboBox;
	23	lblAddlComment: TLabel;
	24	txtAddlComment: TCaptionEdit;
	25	txtDays: TCaptionEdit;
	26	bvlTestName: TBevel;
	27	lblFrequency: TLabel;
	28	pnlHide: TORAutoPanel;
	29	pnlOrderComment: TORAutoPanel;
	30	lblOrderComment: TOROffsetLabel;
	31	pnlAntiCoagulation: TORAutoPanel;
	32	lblAntiCoagulant: TOROffsetLabel;
	33	txtAntiCoagulant: TCaptionEdit;
	34	pnlUrineVolume: TORAutoPanel;
	35	lblUrineVolume: TOROffsetLabel;
	36	txtUrineVolume: TCaptionEdit;
	37	pnlPeakTrough: TORAutoPanel;
	38	lblPeakTrough: TOROffsetLabel;
	39	grpPeakTrough: TRadioGroup;
	40	lblReqComment: TOROffsetLabel;
	41	pnlDoseDraw: TORAutoPanel;
	42	lblDose: TOROffsetLabel;
	43	lblDraw: TOROffsetLabel;
	44	txtDoseTime: TCaptionEdit;
	45	txtDrawTime: TCaptionEdit;
	46	txtOrderComment: TCaptionEdit;
	47	FLabCommonCombo: TORListBox;
	48	lblHowManyDays: TLabel;
	49	cboCollTime: TORComboBox;
	50	lblCollType: TLabel;
	51	pnlCollTimeButton: TKeyClickPanel;
	52	cboCollType: TORComboBox;
	53	calCollTime: TORDateBox;
	54	dlgLabCollTime: TORDateTimeDlg;
	55	txtImmedColl: TCaptionEdit;
	56	cmdImmedColl: TSpeedButton;
	57	MessagePopup: TPopupMenu;
	58	ViewinReportWindow1: TMenuItem;
	59	procedure FormCreate(Sender: TObject);
	60	procedure ControlChange(Sender: TObject);
	61	procedure cboAvailTestNeedData(Sender: TObject;
	62	const StartFrom: string; Direction, InsertAt: Integer);
	63	procedure cboAvailTestSelect(Sender: TObject);
	64	procedure cboCollSampChange(Sender: TObject);
	65	procedure cboUrgencyChange(Sender: TObject);
	66	procedure cboSpecimenChange(Sender: TObject);
	67	procedure txtAddlCommentExit(Sender: TObject);
	68	procedure cboCollTimeChange(Sender: TObject);
	69	procedure cboFrequencyChange(Sender: TObject);
	70	procedure cboCollTypeChange(Sender: TObject);
	71	procedure FormClose(Sender: TObject; var Action: TCloseAction);
	72	procedure txtOrderCommentExit(Sender: TObject);
	73	procedure txtAntiCoagulantExit(Sender: TObject);
	74	procedure txtUrineVolumeExit(Sender: TObject);
	75	procedure grpPeakTroughClick(Sender: TObject);
	76	procedure txtDoseTimeExit(Sender: TObject);
	77	procedure txtDrawTimeExit(Sender: TObject);
	78	procedure DisableCommentPanels;
	79	procedure cboAvailTestExit(Sender: TObject);
	80	procedure cboCollSampKeyPause(Sender: TObject);
	81	procedure cboCollSampMouseClick(Sender: TObject);
	82	procedure cboCollTimeExit(Sender: TObject);
	83	procedure cboSpecimenMouseClick(Sender: TObject);
	84	procedure cboSpecimenKeyPause(Sender: TObject);
	85	procedure cmdImmedCollClick(Sender: TObject);
	86	procedure pnlCollTimeButtonEnter(Sender: TObject);
	87	procedure pnlCollTimeButtonExit(Sender: TObject);
	88	procedure ViewinReportWindow1Click(Sender: TObject);
	89	protected
	90	FCmtTypes: TStringList ;
	91	procedure InitDialog; override;
	92	procedure Validate(var AnErrMsg: string); override;
	93	function ValidCollTime(UserEntry: string): string;
	94	procedure DoseDrawComment;
	95	procedure GetAllCollSamples(AComboBox: TORComboBox);
	96	procedure GetAllSpecimens(AComboBox: TORComboBox);
	97	procedure SetupCollTimes(CollType: string);
	98	procedure LoadCollType(AComboBox:TORComboBox);
	99	private
	100	FLastCollType: string;
	101	FLastCollTime: string;
	102	FLastLabCollTime: string;
	103	FLastLabID: string;
	104	FLastItemID: string;
	105	FEvtDelayLoc: integer;
	106	FEvtDivision: integer;
	107	procedure ReadServerVariables;
[829]	108	procedure DisplayChangedOrders(ACollType: string);
[456]	109	public
	110	procedure SetupDialog(OrderAction: Integer; const ID: string); override;
	111	procedure LoadRequiredComment(CmtType: integer);
	112	procedure DetermineCollectionDefaults(Responses: TResponses);
	113	property EvtDelayLoc: integer read FEvtDelayLoc write FEvtDelayLoc;
	114	property EvtDivision: integer read FEvtDivision write FEvtDivision;
	115	end;
	116
	117	type
	118	TCollSamp = class(TObject)
	119	CollSampID: Integer; { IEN of CollSamp }
	120	CollSampName: string; { Name of CollSamp }
	121	SpecimenID: Integer; { IEN of default specimen }
	122	SpecimenName: string; { Name of the specimen }
	123	TubeColor: string; { TubeColor (text) }
	124	MinInterval: Integer; { Minimum days between orders }
	125	MaxPerDay: Integer; { Maximum orders per day }
	126	LabCanCollect: Boolean; { True if lab can collect }
	127	SampReqComment: string; { Name of required comment }
	128	WardComment: TStringList; { CollSamp specific comment }
	129	end;
	130
	131	TLabTest = class(TObject)
	132	TestID: Integer; { IEN of Lab Test }
	133	TestName: string; { Name of Lab Test }
	134	LabSubscript: string ; { which section of Lab? }
	135	CollSamp: Integer; { index into CollSampList }
	136	Specimen: Integer; { IEN of specimen }
	137	Urgency: Integer; { IEN of urgency }
	138	Comment: TStringList; { text of comment }
	139	TestReqComment: string; { Name of required comment }
	140	CurReqComment: string; { name of required comment }
	141	CurWardComment: TStringList; { WP of Ward Comment }
	142	UniqueCollSamp: Boolean; { true if not prompt CollSamp }
	143	CollSampList: TList; { collection sample objects }
	144	CollSampCount: integer; { count of original contents of CollSampList}
	145	SpecimenList: TStringList; { Strings: IEN^Specimen Name }
	146	SpecListCount: integer; { count of original contents of SpecimenList}
	147	UrgencyList: TStringList; { Strings: IEN^Urgency Name }
	148	ForceUrgency: Boolean; { true if not prompt Urgency }
	149	QuickOrderResponses: TResponses; { if created as a result of a quick order selection}
	150	{ functions & procedures }
	151	constructor Create(const LabTestIEN: string; Responses: TResponses);
	152	destructor Destroy; override ;
	153	function IndexOfCollSamp(CollSampIEN: Integer): Integer;
	154	procedure FillCollSampList(LoadData: TStringList; DfltCollSamp: Integer);
	155	procedure LoadAllSamples;
	156	procedure SetCollSampDflts;
	157	procedure ChangeCollSamp(CollSampIEN: Integer);
	158	procedure ChangeSpecimen(const SpecimenIEN: string);
	159	procedure ChangeUrgency(const UrgencyIEN: string);
	160	procedure ChangeComment(const CommentText: string);
	161	function LabCanCollect: Boolean;
	162	procedure LoadCollSamp(AComboBox: TORComboBox);
	163	procedure LoadSpecimen(AComboBox: TORComboBox);
	164	procedure LoadUrgency(CollType: string; AComboBox:TORComboBox);
	165	function NameOfCollSamp: string;
	166	function NameOfSpecimen: string;
	167	function NameOfUrgency: string;
	168	function ObtainCollSamp: Boolean;
	169	function ObtainSpecimen: Boolean;
	170	function ObtainUrgency: Boolean;
	171	function ObtainComment: Boolean;
	172	end;
	173
	174	const
	175	CmtType: array[0..6] of string = ('ANTICOAGULATION','DOSE/DRAW TIMES','ORDER COMMENT',
	176	'ORDER COMMENT MODIFIED','TDM (PEAK-TROUGH)',
	177	'TRANSFUSION','URINE VOLUME');
	178
	179	implementation
	180
	181	{$R *.DFM}
	182
	183	uses rODBase, rODLab, uCore, rCore, fODLabOthCollSamp, fODLabOthSpec, fODLabImmedColl, fLabCollTimes,
	184	rOrders, uODBase, fRptBox, fFrame;
	185
	186
	187	var
	188	uDfltUrgency: Integer;
	189	uDfltCollType: string;
	190	ALabTest: TLabTest;
	191	UserHasLRLABKey: boolean;
	192	LRFZX : string; //the default collection type (LC,WC,SP,I)
	193	LRFSAMP : string; //the default sample (ptr)
	194	LRFSPEC : string; //the default specimen (ptr)
	195	LRFDATE : string; //the default collection time (NOW,NEXT,AM,PM,T...)
	196	LRFURG : string; //the default urgency (number) TRY '2'
	197	LRFSCH : string; //the default schedule? (ONE TIME, QD, ...)
	198
	199	const
	200	TX_NO_TEST = 'A Lab Test must be specified.' ;
	201	TX_NO_IMMED = 'Immediate collect is not available for this test/sample';
	202	TX_NO_IMMED_CAP = 'Invalid Collection Type';
	203
	204	{ base form procedures shared by all dialogs ------------------------------------------------ }
	205
	206	procedure TfrmODLab.FormCreate(Sender: TObject);
	207	var
	208	i, n: integer;
	209	AList: TStringList;
	210	begin
	211	frmFrame.pnlVisit.Enabled := false;
	212	AutoSizeDisabled := True;
	213	inherited;
	214	AList := TStringList.Create;
	215	try
	216	LRFZX := '';
	217	LRFSAMP := '';
	218	LRFSPEC := '';
	219	LRFDATE := '';
	220	LRFURG := '';
	221	LRFSCH := '';
	222	FLastColltime := '';
	223	FLastLabCollTime := '';
	224	FLastItemID := '';
	225	uDfltCollType := '';
	226	FillerID := 'LR';
	227	FEvtDelayLoc := 0;
	228	FEvtDivision := 0;
	229	UserHasLRLABKey := User.HasKey('LRLAB');
	230	AllowQuickOrder := True;
	231	StatusText('Loading Dialog Definition');
	232	pnlHide.BringToFront;
	233	lblReqComment.Visible := False ;
	234	FCmtTypes := TStringList.Create;
	235	for i := 0 to 6 do FCmtTypes.Add(CmtType[i]) ;
	236	Responses.Dialog := 'LR OTHER LAB TESTS'; // loads formatting info
	237	StatusText('Loading Default Values');
	238	if Self.EvtID > 0 then
	239	begin
	240	EvtDelayLoc := StrToIntDef(GetEventLoc1(IntToStr(Self.EvtID)),0);
	241	EvtDivision := StrToIntDef(GetEventDiv1(IntToStr(Self.EvtID)),0);
	242	if EvtDelayLoc>0 then
[829]	243	FastAssign(ODForLab(EvtDelayLoc, EvtDivision), AList)
[456]	244	else
[829]	245	FastAssign(ODForLab(Encounter.Location, EvtDivision), AList);
[456]	246	end else
[829]	247	FastAssign(ODForLab(Encounter.Location), AList); // ODForLab returns TStrings with defaults
[456]	248	CtrlInits.LoadDefaults(AList);
	249	InitDialog;
	250	with CtrlInits do
	251	begin
	252	SetControl(cboCollType, 'Collection Types');
	253	uDfltCollType := ExtractDefault(AList, 'Collection Types');
	254	if uDfltCollType <> '' then
	255	cboCollType.SelectByID(uDfltCollType)
	256	else if OrderForInpatient then
	257	cboCollType.SelectByID('LC')
	258	else
	259	cboCollType.SelectByID('SP');
	260	SetupCollTimes(cboCollType.ItemID);
	261	StatusText('Initializing List of Tests');
	262	SetControl(cboAvailTest, 'ShortList');
	263	if cboAvailTest.Items.Count > 0 then cboAvailTest.InsertSeparator;
	264	cboAvailTest.InitLongList('');
	265	SetControl(cboFrequency, 'Schedules');
	266	with cboFrequency do
	267	begin
	268	if ItemIndex < 0 then ItemIndex := Items.IndexOf('ONE TIME');
	269	if ItemIndex < 0 then ItemIndex := Items.IndexOf('ONCE');
	270	end;
	271	lblHowManyDays.Enabled := False; { have this call change event in case }
	272	txtDays.Enabled := False; { the default is not 'one time'? }
	273	end;
	274	if EvTDelayLoc>0 then
	275	n := MaxDays(EvtDelayLoc, 0)
	276	else
	277	n := MaxDays(Encounter.Location, 0);
	278	if n < 0 then with cboFrequency do
	279	begin
	280	ItemIndex := Items.IndexOf('ONE TIME');
	281	if ItemIndex = -1 then ItemIndex := Items.IndexOf('ONCE');
	282	Enabled := False;
	283	Font.Color := clGrayText;
	284	lblFrequency.Enabled := False;
	285	end;
	286	PreserveControl(cboAvailTest);
	287	PreserveControl(cboCollType);
	288	PreserveControl(cboCollTime);
	289	PreserveControl(calCollTime);
	290	PreserveControl(cboFrequency);
	291	PreserveControl(txtDays);
	292	StatusText('');
	293	finally
	294	AList.Free;
	295	end;
	296	end;
	297
	298	procedure TfrmODLab.InitDialog;
	299	begin
	300	inherited;
	301	Changing := True;
	302	if ALabTest <> nil then
	303	begin
	304	ALabTest.Destroy;
	305	ALabTest := nil;
	306	end;
	307	with CtrlInits do
	308	begin
	309	SetControl(cboUrgency, 'Default Urgency') ;
	310	uDfltUrgency := StrToInt(Piece(cboUrgency.Items[0],U,1));
	311	end;
	312	lblTestName.Caption := '';
	313	DisableCommentPanels;
	314	cboAvailTest.SelectByID(FLastItemID);
	315	ActiveControl := cboAvailTest;
	316	cboAvailTest.ItemIndex := -1;
	317	StatusText('');
	318	Changing := False ;
	319	end;
	320
	321	procedure TfrmODLab.SetupDialog(OrderAction: Integer; const ID: string);
	322	var
	323	tmpResp: TResponse;
	324	i: integer;
	325	begin
	326	inherited;
	327	ReadServerVariables;
	328	if LRFZX <> '' then
	329	begin
	330	cboCollType.SelectByID(LRFZX);
	331	if cboCollType.ItemIndex > -1 then SetupCollTimes(LRFZX);
	332	end;
	333	if (LRFSCH <> '') and (cboFrequency.Enabled) then
	334	begin
	335	cboFrequency.ItemIndex := cboFrequency.Items.IndexOf(LRFSCH);
	336	cboFrequencyChange(Self);
	337	end;
	338	if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses, ALabTest do
	339	begin
	340	SetControl(cboAvailTest, 'ORDERABLE', 1);
	341	cboAvailTestSelect(Self);
	342	if ALabTest = nil then Exit; // Causes access violation in FillCollSampleList
	343	Changing := True;
	344	SetControl(cboFrequency, 'SCHEDULE', 1);
	345	SetControl(txtDays, 'DAYS', 1);
	346	tmpResp := FindResponseByName('SAMPLE' ,1);
	347	if (tmpResp <> nil) and (tmpResp.IValue <> '') then with cboCollSamp do
	348	begin
	349	SelectByID(tmpResp.IValue);
	350	if ItemIndex < 0 then
	351	begin
	352	LoadAllSamples;
	353	Items.Insert(0, tmpResp.IValue + U + tmpResp.EValue);
	354	ItemIndex := 0 ;
	355	end;
	356	end;
	357	cboCollSampChange(Self);
	358	DetermineCollectionDefaults(Responses);
	359	tmpResp := FindResponseByName('SPECIMEN' ,1);
	360	if (tmpResp <> nil) and (tmpResp.IValue <> '') then with cboSpecimen do
	361	begin
	362	SelectByID(tmpResp.IValue);
	363	if ItemIndex < 0 then
	364	begin
	365	if ALabTest <> nil then
	366	ALabTest.SpecimenList.Add(tmpResp.IValue + U + tmpResp.EValue);
	367	Items.Insert(0, tmpResp.IValue + U + tmpResp.EValue);
	368	ItemIndex := 0 ;
	369	end;
	370	end
	371	else
	372	if (LRFSPEC <> '') then cboSpecimen.SelectByID(LRFSPEC);
	373	if ALabTest <> nil then Specimen := cboSpecimen.ItemIEN;
	374	if ALabTest <> nil then AlabTest.LoadUrgency(cboCollType.ItemID, cboUrgency);
	375	SetControl(cboUrgency, 'URGENCY', 1);
	376	if cboUrgency.ItemIEN = 0 then
	377	begin
	378	if StrToIntDef(LRFURG, 0) > 0 then
	379	cboUrgency.SelectByID(LRFURG)
	380	else if (ALabTest <> nil) and (Urgency = 0) and (cboUrgency.Items.Count = 1) then
	381	cboUrgency.ItemIndex := 0;
	382	end;
	383	if ALabTest <> nil then Urgency := cboUrgency.ItemIEN;
	384	i := 1 ;
	385	tmpResp := Responses.FindResponseByName('COMMENT',i);
	386	while tmpResp <> nil do
	387	begin
	388	Comment.Add(tmpResp.EValue);
	389	Inc(i);
	390	tmpResp := Responses.FindResponseByName('COMMENT',i);
	391	end ;
	392	with cboFrequency do
	393	if not Enabled then
	394	begin
	395	ItemIndex := Items.IndexOf('ONE TIME');
	396	if ItemIndex = -1 then ItemIndex := Items.IndexOf('ONCE');
	397	end;
	398	cboFrequencyChange(Self);
	399	Changing := False;
	400	ControlChange(Self);
	401	end;
	402	end;
	403
	404	{ dialog specific event procedures follow here ---------------------------------------------- }
	405
	406	constructor TLabTest.Create(const LabTestIEN: string; Responses: TResponses);
	407	var
	408	LoadData, OneSamp: TStringList;
	409	DfltCollSamp: Integer;
	410	x: string;
	411	tmpResp: TResponse;
	412	begin
	413	LoadData := TStringList.Create;
	414	try
	415	LoadLabTestData(LoadData, LabTestIEN) ;
	416	with LoadData do
	417	begin
	418	QuickOrderResponses := Responses;
	419	TestID := StrToInt(LabTestIEN);
	420	TestName := Piece(ExtractDefault(LoadData, 'Test Name'),U,1);
	421	LabSubscript := Piece(ExtractDefault(LoadData, 'Item ID'),U,2);
	422	TestReqComment := ExtractDefault(LoadData, 'ReqCom');
	423	if Length(ExtractDefault(LoadData, 'Unique CollSamp')) > 0 then UniqueCollSamp := True;
	424	x := ExtractDefault(LoadData, 'Unique CollSamp');
	425	if Length(x) = 0 then x := ExtractDefault(LoadData, 'Lab CollSamp');
	426	if Length(x) = 0 then x := ExtractDefault(LoadData, 'Default CollSamp');
	427	if Length(x) = 0 then x := '-1';
	428	DfltCollSamp := StrToInt(x);
	429	SpecimenList := TStringList.Create;
	430	ExtractItems(SpecimenList, LoadData, 'Specimens');
	431	if LRFSPEC <> '' then SpecimenList.Add(GetOneSpecimen(StrToInt(LRFSPEC)));
	432	UrgencyList := TStringList.Create;
	433	if Length(ExtractDefault(LoadData, 'Default Urgency')) > 0 then { forced urgency }
	434	begin
	435	ForceUrgency := True;
	436	UrgencyList.Add(ExtractDefault(LoadData, 'Default Urgency'));
	437	Urgency := StrToInt(Piece(ExtractDefault(LoadData, 'Default Urgency'), '^', 1));
	438	uDfltUrgency := Urgency;
	439	end
	440	else
	441	begin { list of urgencies }
	442	ExtractItems(UrgencyList, LoadData, 'Urgencies');
	443	if StrToIntDef(LRFURG, 0) > 0 then
	444	Urgency := StrToInt(LRFURG)
	445	else
	446	Urgency := uDfltUrgency;
	447	end;
	448	Comment := TStringList.Create ;
	449	CurWardComment := TStringList.Create;
	450	ExtractText(CurWardComment, LoadData, 'GenWardInstructions');
	451	CollSamp := 0;
	452	CollSampList := TList.Create;
	453	FillCollSampList(LoadData, DfltCollSamp);
	454	with QuickOrderResponses do tmpResp := FindResponseByName('SAMPLE' ,1);
	455	if (LRFSAMP <> '') and (IndexOfCollSamp(StrToInt(LRFSAMP)) < 0) and
	456	(not UniqueCollSamp) and (tmpResp = nil) then
	457	begin
	458	OneSamp := TStringList.Create;
	459	try
[829]	460	FastAssign(GetOneCollSamp(StrToInt(LRFSAMP)), OneSamp);
[456]	461	FillCollSampList(OneSamp, CollSampList.Count);
	462	finally
	463	OneSamp.Free;
	464	end;
	465	end;
	466	if (not UniqueCollSamp) and (CollSampList.Count = 0) then LoadAllSamples;
	467	CollSampCount := CollSampList.Count;
	468	end;
	469	finally
	470	LoadData.Free;
	471	end;
	472	SetCollSampDflts;
	473	end;
	474
	475	destructor TLabTest.Destroy;
	476	var
	477	i: Integer;
	478	begin
	479	if CollSampList <> nil then
	480	with CollSampList do for i := 0 to Count - 1 do
	481	with TCollSamp(Items[i]) do
	482	begin
	483	WardComment.Free;
	484	Free;
	485	end;
	486	CollSampList.Free;
	487	SpecimenList.Free;
	488	UrgencyList.Free;
	489	CurWardComment.Free;
	490	Comment.Free;
	491	inherited Destroy;
	492	end;
	493
	494	function TLabTest.IndexOfCollSamp(CollSampIEN: Integer): Integer;
	495	var
	496	i: Integer;
	497	begin
	498	Result := -1;
	499	with CollSampList do for i := 0 to Count - 1 do with TCollSamp(Items[i]) do
	500	if CollSampIEN = CollSampID then
	501	begin
	502	Result := i;
	503	break;
	504	end;
	505	end;
	506
	507	procedure TLabTest.LoadAllSamples;
	508	var
	509	LoadList, SpecList: TStringList;
	510	i: Integer;
	511	begin
	512	LoadList := TStringList.Create;
	513	SpecList := TStringList.Create;
	514	try
	515	LoadSamples(LoadList) ;
	516	FillCollSampList(LoadList, 0);
	517	ExtractItems(SpecList, LoadList, 'Specimens');
	518	with SpecList do for i := 0 to Count - 1 do
	519	if SpecimenList.IndexOf(Strings[i]) = -1 then SpecimenList.Add(Strings[i]);
	520	finally
	521	LoadList.Free;
	522	SpecList.Free;
	523	end;
	524	end;
	525
	526	procedure TLabTest.FillCollSampList(LoadData: TStringList; DfltCollSamp: Integer);
	527	{1 2 3 4 5 6 7 8 9 10 }
	528	{n^IEN^CollSampName^SpecIEN^TubeTop^MinInterval^MaxPerDay^LabCollect^SampReqCommentIEN;name^SpecName}
	529	var
	530	i, LastListItem, AnIndex: Integer;
	531	ACollSamp: TCollSamp;
	532	LabCollSamp: Integer;
	533	begin
	534	i := -1;
	535	if CollSampList = nil then CollSampList := TList.Create;
	536	LastListItem := CollSampList.Count ;
	537	LabCollSamp := StrToIntDef(ExtractDefault(LoadData, 'Lab CollSamp'), 0);
	538	repeat Inc(i) until (i = LoadData.Count) or (LoadData[i] = '~CollSamp');
	539	Inc(i);
	540	if i < LoadData.Count then repeat
	541	if LoadData[i][1] = 'i' then
	542	begin
	543	ACollSamp := TCollSamp.Create;
	544	with ACollSamp do
	545	begin
	546	AnIndex := StrToIntDef(Copy(Piece(LoadData[i], '^', 1), 2, 999), -1);
	547	CollSampID := StrToInt(Piece(LoadData[i], '^', 2));
	548	CollSampName := Piece(LoadData[i], '^', 3);
	549	SpecimenID := StrToIntDef(Piece(LoadData[i], '^', 4), 0);
	550	SpecimenName := Piece(LoadData[i], '^', 10);
	551	TubeColor := Piece(LoadData[i], '^', 5);
	552	MinInterval := StrToIntDef(Piece(LoadData[i], '^', 6), 0);
	553	MaxPerDay := StrToIntDef(Piece(LoadData[i], '^', 7), 0);
	554	LabCanCollect := AnIndex = LabCollSamp;
	555	SampReqComment := Piece(LoadData[i], '^', 9);
	556	WardComment := TStringList.Create;
	557	if CollSampID = StrToIntDef(LRFSAMP, 0) then
	558	CollSamp := CollSampID
	559	else if AnIndex = DfltCollSamp then
	560	CollSamp := CollSampID;
	561	end; {with}
	562	LastListItem := CollSampList.Add(ACollSamp);
	563	end; {if}
	564	if (LoadData[i][1] = 't') then
	565	TCollSamp(CollSampList.Items[LastListItem]).WardComment.Add(Copy(LoadData[i], 2, 255));
	566	Inc(i);
	567	until (i = LoadData.Count) or (LoadData[i][1] = '~');
	568	end;
	569
	570	procedure TLabTest.SetCollSampDflts;
	571	var
	572	tmpResp: TResponse;
	573	begin
	574	Specimen := 0;
	575	Comment.Clear;
	576	CurReqComment := TestReqComment;
	577	if CollSamp = 0 then Exit;
	578	with QuickOrderResponses do tmpResp := FindResponseByName('SPECIMEN' ,1);
	579	if (LRFSPEC <> '') and (tmpResp = nil) then
	580	ChangeSpecimen(LRFSPEC)
	581	else with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
	582	begin
	583	Specimen := SpecimenID;
	584	if SampReqcomment <> '' then CurReqComment := SampReqComment;
	585	end;
	586	end;
	587
	588	procedure TLabTest.ChangeCollSamp(CollSampIEN: Integer);
	589	begin
	590	CollSamp := CollSampIEN;
	591	SetCollSampDflts;
	592	end;
	593
	594	procedure TLabTest.ChangeSpecimen(const SpecimenIEN: string);
	595	begin
	596	Specimen := StrToIntDef(SpecimenIEN,0);
	597	end;
	598
	599	procedure TLabTest.ChangeUrgency(const UrgencyIEN: string);
	600	begin
	601	Urgency := StrToIntDef(UrgencyIEN,0);
	602	end;
	603
	604	procedure TLabTest.ChangeComment(const CommentText: string);
	605	begin
	606	Comment.Add(CommentText);
	607	end;
	608
	609	function TLabTest.LabCanCollect: Boolean;
	610	var
	611	i: Integer;
	612	begin
	613	Result := False;
	614	i := IndexOfCollSamp(CollSamp);
	615	if i > -1 then with TCollSamp(CollSampList.Items[i]) do Result := LabCanCollect;
	616	end;
	617
	618	procedure TLabTest.LoadCollSamp(AComboBox: TORComboBox);
	619	{ loads the collection sample combo box, expects CollSamp to already be set to default }
	620	var
	621	i: Integer;
	622	x: string;
	623	begin
	624	AComboBox.Clear;
	625	with CollSampList do for i := 0 to Count - 1 do with TCollSamp(Items[i]) do
	626	begin
	627	x := IntToStr(CollSampID) + '^' + CollSampName;
	628	if Length(TubeColor) <> 0 then x := x + ' (' + TubeColor + ')';
	629	AComboBox.Items.Add(x);
	630	if CollSamp = CollSampID then AComboBox.ItemIndex := i;
	631	end;
	632	if ((ALabTest.LabSubscript = 'CH') and (not UserHasLRLABKey)) then
	633	begin
	634	// do not add 'Other' (coded this way for clarity)
	635	end
	636	else
	637	with AComboBox do
	638	begin
	639	Items.Add('0^Other...');
	640	if ItemIndex < 0 then ItemIndex := Items.IndexOf('Other...');
	641	end;
	642	end;
	643
	644	procedure TLabTest.LoadSpecimen(AComboBox: TORComboBox);
	645	{ loads specimen combo box, if SpecimenList is empty, use 'E' xref on 61 ?? }
	646	var
	647	i: Integer;
	648	tmpResp: TResponse;
	649	begin
	650	AComboBox.Clear;
	651	if ObtainSpecimen then
	652	begin
	653	if SpecimenList.Count = 0 then LoadSpecimens(SpecimenList) ;
[829]	654	FastAssign(SpecimenList, AComboBox.Items);
[456]	655	AComboBox.Items.Add('0^Other...');
	656	with QuickOrderResponses do tmpResp := FindResponseByName('SPECIMEN' ,1);
	657	if (LRFSPEC <> '') and (tmpResp = nil) then
	658	AComboBox.SelectByID(LRFSPEC)
	659	else if Specimen > 0 then
	660	AComboBox.SelectByIEN(Specimen)
	661	else
	662	AComboBox.ItemIndex := AComboBox.Items.IndexOf('Other...');
	663	end
	664	else
	665	begin
	666	i := IndexOfCollSamp(CollSamp);
	667	if i < CollSampList.Count then with TCollSamp(CollSampList.Items[i]) do
	668	begin
	669	AComboBox.Items.Add(IntToStr(SpecimenID) + '^' + SpecimenName);
	670	AComboBox.ItemIndex := 0;
	671	end;
	672	with QuickOrderResponses do tmpResp := FindResponseByName('SPECIMEN' ,1);
	673	if (LRFSPEC <> '') and (tmpResp = nil) then
	674	begin
	675	AComboBox.Items.Add(GetOneSpecimen(StrToInt(LRFSPEC)));
	676	AComboBox.SelectByID(LRFSPEC);
	677	end;
	678	end;
	679	ChangeSpecimen(AComboBox.ItemID);
	680	end;
	681
	682	procedure TfrmODLab.LoadCollType(AComboBox:TORComboBox);
	683	var
	684	i: integer;
	685	begin
	686	with CtrlInits, cboCollType do
	687	begin
	688	SetControl(cboCollType, 'Collection Types');
	689	if not ALabTest.LabCanCollect then
	690	begin
	691	i := SelectByID('LC');
	692	if i > -1 then Items.Delete(i);
	693	i := SelectByID('I');
	694	if i > -1 then Items.Delete(i);
	695	end ;
	696	if LRFZX <> '' then
	697	begin
	698	if (LRFZX = 'LC') or (LRFZX = 'I') then
	699	begin
	700	if ALabTest.LabCanCollect then
	701	cboCollType.SelectByID(LRFZX)
	702	else
	703	cboCollType.SelectByID('WC');
	704	end
	705	else
	706	cboCollType.SelectByID(LRFZX);
	707	end
	708	else if FLastCollType <> '' then
	709	begin
	710	if (FLastCollType = 'LC') or (FLastCollType = 'I') then
	711	begin
	712	if ALabTest.LabCanCollect then
	713	cboCollType.SelectByID(FLastCollType)
	714	else
	715	cboCollType.SelectByID('WC');
	716	end
	717	else
	718	cboCollType.SelectByID(FLastCollType);
	719	end
	720	else if uDfltCollType <> '' then
	721	begin
	722	if (uDfltCollType = 'LC') or (uDfltCollType = 'I') then
	723	begin
	724	if ALabTest.LabCanCollect then
	725	cboCollType.SelectByID(uDfltCollType)
	726	else
	727	cboCollType.SelectByID('WC');
	728	end
	729	else
	730	cboCollType.SelectByID(uDfltCollType);
	731	end
	732	else if OrderForInpatient then
	733	begin
	734	if ALabTest.LabCanCollect then
	735	cboCollType.SelectByID('LC')
	736	else
	737	SelectByID('WC');
	738	end
	739	else
	740	cboCollType.SelectByID('SP');
	741	end;
	742	SetupCollTimes(cboCollType.ItemID);
	743	end;
	744
	745	procedure TLabTest.LoadUrgency(CollType: string; AComboBox:TORComboBox);
	746	var
	747	i: integer;
	748	begin
	749	with AComboBox do
	750	begin
	751	Clear;
	752	for i := 0 to UrgencyList.Count - 1 do
	753	if (CollType = 'LC') and (Piece(UrgencyList[i], U, 3) = '') then
	754	Continue
	755	else
	756	Items.Add(UrgencyList[i]);
	757	if (LRFURG <> '') and (ALabTest.ObtainUrgency) then
	758	SelectByID(LRFURG)
	759	else
	760	SelectByIEN(uDfltUrgency);
	761	Urgency := AComboBox.ItemIEN;
	762	end;
	763	end;
	764
	765	function TLabTest.NameOfCollSamp: string;
	766	var
	767	i: Integer;
	768	begin
	769	Result := '';
	770	i := IndexOfCollSamp(CollSamp);
	771	if i > -1 then with TCollSamp(CollSampList.Items[i]) do Result := CollSampName;
	772	end;
	773
	774	function TLabTest.NameOfSpecimen: string;
	775	var
	776	i: Integer;
	777	begin
	778	Result := '';
	779	if CollSamp > 0 then with TCollSamp(CollSampList[IndexOfCollSamp(CollSamp)]) do
	780	if (Specimen > 0) and (Specimen = SpecimenID) then Result := SpecimenName;
	781	if (Length(Result) = 0) and (Specimen > 0) then with SpecimenList do
	782	for i := 0 to Count - 1 do if Specimen = StrToInt(Piece(Strings[i], '^', 1)) then
	783	begin
	784	Result := Piece(Strings[i], '^', 2);
	785	break;
	786	end;
	787	end;
	788
	789	function TLabTest.NameOfUrgency: string;
	790	var
	791	i: Integer;
	792	begin
	793	Result := '';
	794	with UrgencyList do for i := 0 to Count - 1 do
	795	begin
	796	if StrToInt(Piece(Strings[i], '^', 1)) = Urgency
	797	then Result := Piece(Strings[i], '^', 2);
	798	break;
	799	end;
	800	end;
	801
	802	function TLabTest.ObtainCollSamp: Boolean;
	803	begin
	804	Result := (not UniqueCollSamp);
	805	end;
	806
	807	function TLabTest.ObtainSpecimen: Boolean;
	808	var
	809	i: Integer;
	810	begin
	811	Result := True;
	812	i := IndexOfCollSamp(CollSamp);
	813	if (i > -1) and (i < CollSampList.Count) then with TCollSamp(CollSampList.Items[i]) do
	814	if SpecimenID > 0 then Result := False;
	815	end;
	816
	817	function TLabTest.ObtainUrgency: Boolean;
	818	begin
	819	Result := not ForceUrgency;
	820	end;
	821
	822	function TLabTest.ObtainComment: Boolean;
	823	begin
	824	Result := Length(CurReqComment) > 0;
	825	end;
	826
	827	{ end of TLabTest object }
	828
	829	procedure TfrmODLab.ControlChange(Sender: TObject);
	830	var
	831	AResponse: TResponse;
	832	AVisitStr: string;
	833	begin
	834	inherited;
	835	if Changing or (ALabTest = nil) then Exit;
	836	AResponse := Responses.FindResponseByName('VISITSTR', 1);
	837	if AResponse <> nil then
	838	AVisitStr := AResponse.EValue;
	839	Responses.Clear;
	840	with ALabTest do
	841	begin
	842	if TestID > 0 then Responses.Update('ORDERABLE', 1, IntToStr(TestID), TestName);
	843	if CollSamp > 0 then Responses.Update('SAMPLE', 1, IntToStr(CollSamp), NameOfCollSamp)
	844	else Responses.Update('SAMPLE', 1, '', '');
	845	if Specimen > 0 then Responses.Update('SPECIMEN', 1, IntToStr(Specimen), NameOfSpecimen)
	846	else Responses.Update('SPECIMEN', 1, '', '');
	847	if Urgency > 0 then Responses.Update('URGENCY', 1, IntToStr(Urgency), NameOfUrgency);
	848	if Length(Comment.Text) > 0 then Responses.Update('COMMENT', 1, TX_WPTYPE, Comment.Text);
	849	with cboCollType do if Length(ItemID) > 0 then
	850	begin
	851	Responses.Update('COLLECT', 1, ItemID, ItemID) ;
	852	FLastCollType := ItemID;
	853	end;
	854	end;
	855	if cboCollType.ItemID = 'LC' then
	856	begin
	857	with cboCollTime do
	858	if Length(ItemID) > 0 then
	859	begin
	860	Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
	861	FLastLabCollTime := ItemID + U + Text;
	862	end
	863	else if Length(Text) > 0 then
	864	begin
	865	Responses.Update('START', 1, ValidCollTime(Text), Text) ;
	866	FLastLabCollTime := ValidCollTime(Text);
	867	end;
	868	end
	869	else
	870	begin
	871	with calCollTime do
	872	if FMDateTime > 0 then
	873	begin
	874	Responses.Update('START', 1, ValidCollTime(Text), Text);
	875	FLastColltime := ValidCollTime(Text);
	876	end
	877	else
	878	begin
	879	Responses.Update('START', 1, '', '') ;
	880	FLastCollTime := '';
	881	end;
	882	end;
	883	with cboFrequency do if Length(ItemID) > 0
	884	then Responses.Update('SCHEDULE', 1, ItemID, Text);
	885	with txtDays do if Enabled then Responses.Update('DAYS', 1, Text, Text);
	886	{ worry about stop date later }
	887	if AVisitStr <> '' then Responses.Update('VISITSTR', 1, AVisitStr, AVisitStr);
	888	memOrder.Text := Responses.OrderText;
	889	end;
	890
	891	procedure TfrmODLab.Validate(var AnErrMsg: string);
	892
	893	procedure SetError(const x: string);
	894	begin
	895	if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
	896	AnErrMsg := AnErrMsg + x;
	897	end;
	898
	899	var
	900	CmtType,DaysofFuturePast, y: integer;
	901	(Hours, )DayMax, (Daily, )NoOfTimes, (DayFreq,) Minutes: integer;
	902	d1, d2: TDateTime;
	903	Days, MsgTxt: Double;
	904	x: string;
[829]	905	ACollType: string;
[456]	906	const
	907	TX_NO_TIME = 'Collection Time is required.' ;
	908	TX_NO_TCOLLTYPE = 'Collection Type is required.' ;
	909	TX_NO_TESTS = 'A Lab Test or tests must be selected.' ;
	910	TX_BAD_TIME = 'Collection times must be chosen from the drop down list or entered as valid' +
	911	' Fileman date/times (T@1700, T+1@0800, etc.).' ;
	912	TX_PAST_TIME = 'Collection times in the past are not allowed.';
	913	TX_NO_DAYS = 'A number of days must be entered for continuous orders.';
	914	TX_NO_TIMES = 'A number of times must be entered for continuous orders.';
	915	TX_NO_STOP_DATE = 'Could not calculate the stop date for the order. Check "for n Days".';
	916	TX_TOO_MANY_DAYS = 'Maximum number of days allowed is ';
	917	TX_TOO_MANY_TIMES = 'For this frequency, the maximum number of times allowed is: X';
	918	//TX_NO_COMMENT = 'A comment is required for this test and collection sample.';
	919	TX_NUMERIC_REQD = 'A numeric value is required for urine volume.';
	920	TX_DOSEDRAW_REQD = 'Both DOSE and DRAW times are required for this order.';
	921	TX_TDM_REQD = 'A value for LEVEL is required for this order.';
	922	//TX_ANTICOAG_REQD = 'You must specify an anticoagulant on this order.' ;
	923	TX_NO_COLLSAMPLE = 'A collection sample MUST be specified.';
	924	TX_NO_SPECIMEN = 'A specimen MUST be specified.';
	925	TX_NO_URGENCY = 'An urgency MUST be specified.';
	926	TX_NO_FREQUENCY = 'A collection frequency MUST be specified.';
	927	TX_NOT_LAB_COLL_TIME = ' is not a routine lab collection time.';
	928	TX_NO_ALPHA = 'For continuous orders, enter a number of days, or an "X" followed by a number of times.';
	929	TX_BADTIME_CAP = 'Invalid Immediate Collect Time';
	930
	931	begin
	932	inherited;
	933	{ need to go thru list and make sure everything is filled in }
	934	with cboAvailTest do if ItemIEN <= 0 then SetError(TX_NO_TESTS);
	935
	936	if ALabTest <> nil then
	937	if (cboCollType.ItemID = 'I') and (not ALabTest.LabCanCollect) then
	938	begin
	939	SetError(TX_NO_IMMED);
	940	cboCollType.ItemIndex := -1;
	941	end;
	942
	943	if cboCollType.ItemID = '' then
	944	SetError(TX_NO_TCOLLTYPE)
	945	else if cboCollType.ItemID = 'LC' then
	946	begin
	947	if Length(cboCollTime.Text) = 0 then SetError(TX_NO_TIME);
	948	with cboCollTime do if (Length(Text) > 0) and (ItemIndex = -1) then
	949	begin
	950	if StrToFMDateTime(Text) < 0 then
	951	SetError(TX_BAD_TIME)
	952	else if StrToFMDateTime(Text) < FMNow then
	953	SetError(TX_PAST_TIME)
	954	else if OrderForInpatient then
	955	begin
	956	d1 := FMDateTimeToDateTime(Trunc(StrToFMDateTime(cboColltime.Text)));
	957	d2 := FMDateTimeToDateTime(FMToday);
	958	if EvtDelayLoc > 0 then
	959	DaysofFuturePast := LabCollectFutureDays(EvtDelayLoc,EvtDivision)
	960	else
	961	DaysofFuturePast := LabCollectFutureDays(Encounter.Location);
	962	if DaysofFuturePast = 0 then DaysofFuturePast := 7;
	963	if ((d1 - d2) > DaysofFuturePast) then
	964	SetError('A lab collection cannot be ordered more than '
	965	+ IntToStr(DaysofFuturePast) + ' days in advance');
	966	end
	967	else if EvtDelayLoc > 0 then
	968	begin
	969	if (not IsLabCollectTime(StrToFMDateTime(cboCollTime.Text), EvtDelayLoc)) then
	970	SetError(cboCollTime.Text + TX_NOT_LAB_COLL_TIME);
	971	end
	972	else if EvtDelayLoc <= 0 then
	973	begin
	974	if (not IsLabCollectTime(StrToFMDateTime(cboCollTime.Text), Encounter.Location)) then
	975	SetError(cboCollTime.Text + TX_NOT_LAB_COLL_TIME);
	976	end;
	977	end;
	978	end
	979	else
	980	begin
	981	if cboCollType.ItemID = 'I' then
	982	begin
	983	calCollTime.Text := txtImmedColl.Text;
	984	x := ValidImmCollTime(calCollTime.FMDateTime);
	985	if (Piece(x, U, 1) <> '1') then
	986	SetError(Piece(x, U, 2));
	987	end;
	988
	989	with calColltime do
	990	begin
	991	if FMDateTime = 0 then SetError(TX_BAD_TIME)
	992	else
	993	begin
	994	// date only was entered
	995	if (FMDateTime - Trunc(FMDateTime) = 0) then
	996	begin
	997	if (Trunc(FMDateTime) < FMToday) then SetError(TX_PAST_TIME);
	998	end
	999	// date/time was entered
	1000	else
	1001	begin
	1002	if (UpperCase(Text) <> 'NOW') and (FMDateTime < FMNow) then SetError(TX_PAST_TIME);
	1003	end;
	1004	end;
	1005	end;
	1006	end;
	1007
	1008	with cboCollSamp do
	1009	if ItemIndex < 0 then
	1010	SetError(TX_NO_COLLSAMPLE)
	1011	else if (ItemIndex >= 0) and (ItemIEN = 0) then
	1012	begin
	1013	if ALabTest <> nil then
	1014	GetAllCollSamples(cboCollSamp);
	1015	if ItemIEN = 0 then SetError(TX_NO_COLLSAMPLE);
	1016	end;
	1017
	1018	with cboSpecimen do
	1019	if ItemIndex < 0 then
	1020	SetError(TX_NO_SPECIMEN)
	1021	else if (ItemIndex >= 0) and (ItemIEN = 0) then
	1022	begin
	1023	if (ALabTest <> nil) and (cboCollSamp.ItemIEN > 0) then
	1024	GetAllSpecimens(cboSpecimen);
	1025	if ItemIEN = 0 then SetError(TX_NO_SPECIMEN);
	1026	end;
	1027
	1028	with cboUrgency do if ItemIEN <= 0 then SetError(TX_NO_URGENCY);
	1029	with cboFrequency do if ItemIEN <= 0 then SetError(TX_NO_FREQUENCY);
	1030
	1031	if ALabTest <> nil then
	1032	begin
	1033	CmtType := FCmtTypes.IndexOf(ALabTest.CurReqComment) ;
	1034	with ALabTest do
	1035	case CmtType of
	1036	0 : {ANTICOAGULATION} {if (Pos('ANTICOAGULANT',Comment.Text)=0) then
	1037	SetError(TX_ANTICOAG_REQD)};
	1038	1 : {DOSE/DRAW TIMES} if (Pos('Last dose:',Comment.Text)=0) or
	1039	(Pos('draw time:',Comment.Text)=0) then
	1040	SetError(TX_DOSEDRAW_REQD);
	1041	2 : {ORDER COMMENT} {if (Length(Comment.Text)=0) then
	1042	SetError(TX_NO_COMMENT)};
	1043	3 : {ORDER COMMENT MODIFIED} {if (Length(Comment.Text)=0) then
	1044	SetError(TX_NO_COMMENT)};
	1045	4 : {TDM (PEAK-TROUGH} if (Pos('Dose is expected',Comment.Text)=0) then
	1046	SetError(TX_TDM_REQD);
	1047	5 : {TRANSFUSION} {if (Length(Comment.Text)=0) then
	1048	SetError(TX_NO_COMMENT)};
	1049	6 : {URINE VOLUME} if (Length(Comment.Text)>0) and
	1050	(ExtractInteger(Comment.Text)<=0) then
	1051	Comment.Text := '?';
	1052	{SetError(TX_NUMERIC_REQD);}
	1053	{ else
	1054	if (Length(CurReqComment)>0) and (Length(Comment.Text)=0) then
	1055	SetError(TX_NO_COMMENT); }
	1056	end;
	1057	end;
	1058
	1059	with txtDays do if Enabled then
	1060	begin
	1061	DayMax := 0;
	1062	if (cboCollType.ItemID = 'LC') or (cboCollType.ItemID = 'I') then
	1063	begin
	1064	if EvtDelayLoc > 0 then
	1065	DayMax := LabCollectFutureDays(EvtDelayLoc,EvtDivision)
	1066	else
	1067	DayMax := LabCollectFutureDays(Encounter.Location);
	1068	end;
	1069	if DayMax = 0 then
	1070	begin
	1071	if EvtDelayLoc > 0 then
	1072	DayMax := MaxDays(EvtDelayLoc, cboFrequency.ItemIEN)
	1073	else
	1074	DayMax := MaxDays(Encounter.Location, cboFrequency.ItemIEN);
	1075	end;
	1076	x := Piece(cboFrequency.Items[cboFrequency.ItemIndex], U, 3);
	1077	if (x = 'C') or (x = 'D') then
	1078	begin
	1079	Minutes := StrToIntDef(Piece(cboFrequency.Items[cboFrequency.ItemIndex], U, 4), 0);
	1080	Days := Minutes / 1440;
	1081	if (Days = 0) then Days := 1;
	1082	if Pos('X', UpperCase(txtDays.Text)) > 0 then
	1083	begin
	1084	x := Trim(Copy(txtDays.Text, 1, Pos('X', UpperCase(txtDays.Text)) - 1)) +
	1085	Trim(Copy(txtDays.Text, Pos('X', UpperCase(txtDays.Text)) + 1, 99));
	1086	NoOfTimes := ExtractInteger(x);
	1087	Days := NoOfTimes * Days; // # days requested
	1088	if FloatToStr(NoOfTimes) <> x then
	1089	SetError(TX_NO_ALPHA)
	1090	else if NoOfTimes = 0 then
	1091	SetError(TX_NO_TIMES)
	1092	else if (Days > DayMax) then
	1093	begin
	1094	MsgTxt := Minutes / 60;
	1095	x := ' hour';
	1096	if MsgTxt > 24 then
	1097	begin
	1098	MsgTxt := MsgTxt / 24;
	1099	x := ' day';
	1100	end;
	1101	if MsgTxt > 1 then x := x + 's';
	1102	y := 0;
	1103	if Minutes > 0 then y := (DayMax * 1440) div Minutes;
	1104	if y = 0 then y := 1;
	1105	//if y > 0 then
	1106	SetError(TX_TOO_MANY_TIMES + IntToStr(y) + CRLF +
	1107	' (Every ' + FloatToStr(MsgTxt) + x + ' for a maximum of ' + IntToStr(DayMax) + ' days.)')
	1108	//else
	1109	// Responses.Update('DAYS', 1, 'X1', 'X1');
	1110	end
	1111	else
	1112	begin
	1113	x := 'X' + IntToStr(NoOfTimes);
	1114	Responses.Update('DAYS', 1, x, x);
	1115	end;
	1116	end
	1117	else
	1118	begin
	1119	Days := ExtractInteger(txtDays.Text);
	1120	if FloatToStr(Days) <> Trim(txtDays.Text) then
	1121	SetError(TX_NO_ALPHA)
	1122	//SetError(TX_NO_DAYS) v18.6 (RV)
	1123	else if (Days > DayMax) then
	1124	SetError(TX_TOO_MANY_DAYS + IntToStr(DayMax))
	1125	else
	1126	Responses.Update('DAYS', 1, txtDays.Text, txtDays.Text);
	1127	end;
	1128	end;
	1129	end;
[829]	1130
	1131	if (AnErrMsg <> '') or (Self.EvtID > 0) then exit;
	1132
	1133	// add check and display for auto-change from LC to WC - v27.1 - CQ #10226
	1134	ACollType := Responses.FindResponseByName('COLLECT', 1).EValue;
	1135	if ((ACollType = 'LC') or (ACollType = 'I')) then DisplayChangedOrders(ACollType);
[456]	1136	end;
	1137
[829]	1138	procedure TfrmODLab.DisplayChangedOrders(ACollType: string);
	1139	var
	1140	AStartDate, ASchedule, ADuration: string;
	1141	ChangedOrdersList, AList: TStringlist;
	1142	i, j, k: integer;
	1143	begin
	1144	ChangedOrdersList := TStringList.Create;
	1145	try
	1146	AStartDate := Responses.FindResponseByName('START', 1).IValue;
	1147	ASchedule := Responses.FindResponseByName('SCHEDULE', 1).IValue;
	1148	if txtDays.Enabled then ADuration := Responses.FindResponseByName('DAYS', 1).EValue else ADuration := '';
	1149	CheckForChangeFromLCtoWCOnAccept(ChangedOrdersList, Encounter.Location, AStartDate, ACollType, ASchedule, ADuration);
	1150	if ChangedOrdersList.Text <> '' then
	1151	begin
	1152	AList := TStringList.Create;
	1153	try
	1154	AList.Text := Responses.OrderText;
	1155	with ChangedOrdersList do
	1156	begin
	1157	Insert(5, 'Order :' + #9 + AList[0]);
	1158	k := Length(ChangedOrdersList[5]);
	1159	i := 0;
	1160	if AList.Count > 1 then
	1161	for j := 1 to AList.Count - 1 do
	1162	begin
	1163	Insert(5 + j, StringOfChar(' ', 9) + #9 + AList[j]);
	1164	k := HigherOf(k, Length(ChangedOrdersList[5 + j]));
	1165	i := j;
	1166	end;
	1167	Insert(5 + i + 1, StringOfChar('-', k + 4));
	1168	end;
	1169	ReportBox(ChangedOrdersList, 'Changed Orders', TRUE);
	1170	finally
	1171	AList.Free;
	1172	end;
	1173	end;
	1174	finally
	1175	ChangedOrdersList.Free;
	1176	end;
	1177	end;
	1178
[456]	1179	procedure TfrmODLab.cboAvailTestNeedData(Sender: TObject;
	1180	const StartFrom: string; Direction, InsertAt: Integer);
	1181	begin
	1182	cboAvailTest.ForDataUse(SubsetOfOrderItems(StartFrom, Direction, 'S.LAB'));
	1183	end;
	1184
	1185	procedure TfrmODLab.cboAvailTestExit(Sender: TObject);
	1186	begin
	1187	inherited;
	1188	if (Length(cboAvailTest.ItemID) = 0) or (cboAvailTest.ItemID = '0') then Exit;
	1189	if cboAvailTest.ItemID = FLastLabID then Exit;
	1190	cboAvailTestSelect(cboAvailTest);
	1191	cboAvailTest.SetFocus;
	1192	PostMessage(Handle, WM_NEXTDLGCTL, 0, 0);
	1193	end;
	1194
	1195	procedure TfrmODLab.cboAvailTestSelect(Sender: TObject);
	1196	var
	1197	x: string;
	1198	i: integer;
	1199	tmpResp: TResponse;
	1200	begin
	1201	with cboAvailTest do
	1202	begin
	1203	if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
	1204	FLastLabID := ItemID ;
	1205	FLastItemID := ItemID;
	1206	Changing := True;
	1207	if Sender <> Self then
	1208	Responses.Clear; // Sender=Self when called from SetupDialog
	1209	if CharAt(ItemID, 1) = 'Q' then
	1210	with Responses do
	1211	begin
	1212	FLastItemID := ItemID;
	1213	QuickOrder := ExtractInteger(ItemID);
	1214	SetControl(cboAvailTest, 'ORDERABLE', 1);
	1215	if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
	1216	FLastLabID := ItemID;
	1217	end;
	1218	ALabTest := TLabTest.Create(ItemID, Responses);
	1219	end;
	1220	with ALabTest do
	1221	begin
	1222	lblTestName.Caption := TestName;
	1223	LoadCollSamp(cboCollSamp);
	1224	cboCollSampChange(Self);
	1225	LoadSpecimen(cboSpecimen);
	1226	LoadUrgency(cboCollType.ItemID, cboUrgency);
	1227	with Responses do if QuickOrder > 0 then
	1228	begin
	1229	StatusText('Initializing Quick Order');
	1230	Changing := True;
	1231	SetControl(cboAvailTest, 'ORDERABLE', 1);
	1232	SetControl(cboFrequency, 'SCHEDULE', 1);
	1233	SetControl(txtDays, 'DAYS', 1);
	1234	tmpResp := FindResponseByName('SAMPLE' ,1);
	1235	if (tmpResp <> nil) and (tmpResp.IValue <> '') then with cboCollSamp do
	1236	begin
	1237	SelectByID(tmpResp.IValue);
	1238	if ItemIndex < 0 then
	1239	begin
	1240	LoadAllSamples;
	1241	Items.Insert(0, tmpResp.IValue + U + tmpResp.EValue);
	1242	ItemIndex := 0 ;
	1243	end;
	1244	end
	1245	else if LRFSAMP <> '' then
	1246	cboCollSamp.SelectByID(LRFSAMP);
	1247	if (cboCollSamp.ItemIndex < 0) and (cboCollSamp.Items.IndexOf('Other...') >= 0) then cboCollSamp.SelectByID('0');
	1248	cboCollSampChange(Self);
	1249	DetermineCollectionDefaults(Responses);
	1250	LoadUrgency(cboCollType.ItemID, cboUrgency);
	1251	SetControl(cboUrgency, 'URGENCY', 1);
	1252	Urgency := cboUrgency.ItemIEN;
	1253	if (Urgency = 0) and (cboUrgency.Items.Count = 1) then
	1254	begin
	1255	cboUrgency.ItemIndex := 0;
	1256	Urgency := cboUrgency.ItemIEN;
	1257	end;
	1258	tmpResp := FindResponseByName('SPECIMEN' ,1);
	1259	if (tmpResp <> nil) and (tmpResp.IValue <> '') then with cboSpecimen do
	1260	begin
	1261	SelectByID(tmpResp.IValue);
	1262	if ItemIndex < 0 then
	1263	begin
	1264	if ALabTest <> nil then
	1265	ALabTest.SpecimenList.Add(tmpResp.IValue + U + tmpResp.EValue);
	1266	Items.Insert(0, tmpResp.IValue + U + tmpResp.EValue);
	1267	ItemIndex := 0 ;
	1268	end;
	1269	end
	1270	else if LRFSPEC <> '' then
	1271	cboSpecimen.SelectByID(LRFSPEC);
	1272	if (cboSpecimen.ItemIndex < 0) and (cboSpecimen.Items.IndexOf('Other...') >= 0) then cboSpecimen.SelectByID('0');
	1273	Specimen := cboSpecimen.ItemIEN;
	1274	i := 1 ;
	1275	tmpResp := Responses.FindResponseByName('COMMENT',i);
	1276	while tmpResp <> nil do
	1277	begin
	1278	Comment.Add(tmpResp.EValue);
	1279	Inc(i);
	1280	tmpResp := Responses.FindResponseByName('COMMENT',i);
	1281	end ;
	1282	with cboFrequency do
	1283	if not Enabled then
	1284	begin
	1285	ItemIndex := Items.IndexOf('ONE TIME');
	1286	if ItemIndex = -1 then ItemIndex := Items.IndexOf('ONCE');
	1287	end;
	1288	cboFrequencyChange(Self);
	1289	end; // Quick Order
	1290	if ObtainCollSamp then
	1291	begin
	1292	lblCollSamp.Enabled := True;
	1293	cboCollSamp.Enabled := True;
	1294	end
	1295	else
	1296	begin
	1297	with ALabTest do
	1298	with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
	1299	begin
	1300	x := '' ;
	1301	for i := 0 to WardComment.Count-1 do
	1302	x := x + WardComment.strings[i]+#13#10 ;
	1303	pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
	1304	OrderMessage(x) ;
	1305	end ;
	1306	lblCollSamp.Enabled := False;
	1307	cboCollSamp.Enabled := False;
	1308	end;
	1309	if ObtainSpecimen then
	1310	begin
	1311	lblSpecimen.Enabled:= True;
	1312	cboSpecimen.Enabled:= True;
	1313	end else
	1314	begin
	1315	lblSpecimen.Enabled:= False;
	1316	cboSpecimen.Enabled:= False;
	1317	end;
	1318	if ObtainUrgency then
	1319	begin
	1320	lblUrgency.Enabled := True;
	1321	cboUrgency.Enabled := True;
	1322	end else
	1323	begin
	1324	lblUrgency.Enabled := False;
	1325	cboUrgency.Enabled := False;
	1326	end;
	1327	if ObtainComment then
	1328	LoadRequiredComment(FCmtTypes.IndexOf(CurReqComment))
	1329	else
	1330	DisableCommentPanels;
	1331	x := '' ;
	1332	for i := 0 to CurWardComment.Count-1 do
	1333	x := x + CurWardComment.strings[i]+#13#10 ;
	1334	i := IndexOfCollSamp(CollSamp);
	1335	if i > -1 then with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
	1336	for i := 0 to WardComment.Count-1 do
	1337	x := x + WardComment.strings[i]+#13#10 ;
	1338	pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
	1339	OrderMessage(x) ;
	1340	end; { with }
	1341	StatusText('');
	1342	Changing := False;
	1343	if Sender <> Self then ControlChange(Self);
	1344	end;
	1345
	1346	procedure TfrmODLab.cboCollSampChange(Sender: TObject);
	1347	var
	1348	i: integer;
	1349	x: string;
	1350	begin
	1351	if (ALabTest = nil) or (cboCollSamp.ItemIEN = 0) then exit;
	1352	with ALabTest do
	1353	begin
	1354	ChangeCollSamp(cboCollSamp.ItemIEN);
	1355	LoadSpecimen(cboSpecimen);
	1356	LoadCollType(cbocollType);
	1357	LoadUrgency(cboCollType.ItemID, cboUrgency);
	1358	if ObtainSpecimen then
	1359	begin
	1360	lblSpecimen.Enabled:= True;
	1361	cboSpecimen.Enabled:= True;
	1362	end else
	1363	begin
	1364	lblSpecimen.Enabled:= False;
	1365	cboSpecimen.Enabled:= False;
	1366	end;
	1367	if ObtainComment then
	1368	LoadRequiredComment(FCmtTypes.IndexOf(CurReqComment))
	1369	else
	1370	DisableCommentPanels;
	1371	if not Changing then with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
	1372	begin
	1373	x := '' ;
	1374	for i := 0 to WardComment.Count-1 do
	1375	x := x + WardComment.strings[i]+#13#10 ;
	1376	pnlMessage.TabOrder := cboCollSamp.TabOrder + 1;
	1377	OrderMessage(x) ;
	1378	end ;
	1379	end;
	1380	ControlChange(Self);
	1381	end;
	1382
	1383	procedure TfrmODLab.cboUrgencyChange(Sender: TObject);
	1384	begin
	1385	if ALabTest = nil then exit;
	1386	with ALabTest do
	1387	ChangeUrgency(cboUrgency.ItemID);
	1388	ControlChange(Self);
	1389	end;
	1390
	1391	procedure TfrmODLab.cboSpecimenChange(Sender: TObject);
	1392	begin
	1393	if ALabTest = nil then exit;
	1394	with cboSpecimen do if Text = 'Other...' then
	1395	if (ItemIndex >= 0) and (ItemIEN = 0) then
	1396	GetAllSpecimens(cboSpecimen);
	1397	with ALabTest do
	1398	ChangeSpecimen(cboSpecimen.ItemID);
	1399	ControlChange(Self);
	1400	end;
	1401
	1402	procedure TfrmODLab.cboCollTimeChange(Sender: TObject);
	1403	var
	1404	CollType: string;
	1405	const
	1406	TX_BAD_TIME = ' is not a routine lab collection time.' ;
	1407	TX_BAD_TIME_CAP = 'Invalid Time';
	1408	begin
	1409	CollType := 'LC';
	1410	with cboCollTime do if ItemID = 'LO' then
	1411	begin
	1412	ItemIndex := -1;
	1413	Text := GetFutureLabTime(FMToday);
	1414	end;
	1415	//cboCollType.SelectByID(CollType);
	1416	ControlChange(Self);
	1417	end;
	1418
	1419	procedure TfrmODLab.cboFrequencyChange(Sender: TObject);
	1420	var
	1421	x: string;
	1422	const
	1423	HINT_TEXT1 = 'Enter a number of days';
	1424	HINT_TEXT2 = ', or an "X" followed by a number of times.';
	1425	begin
	1426	with cboFrequency do if ItemIndex > -1 then x := Items[ItemIndex];
	1427	with cboFrequency do
	1428	if (ItemIndex > -1) and (Piece(Items[ItemIndex], U, 3) <> 'O') then
	1429	begin
	1430	lblHowManyDays.Enabled := True;
	1431	if Piece(Items[ItemIndex], U, 3) = 'C' then
	1432	txtDays.Hint := HINT_TEXT1 + HINT_TEXT2
	1433	else
	1434	txtDays.Hint := '';
	1435	txtDays.Enabled := True;
	1436	txtDays.Showhint := True;
	1437	end
	1438	else
	1439	begin
	1440	txtDays.Text := '';
	1441	lblHowManyDays.Enabled := False;
	1442	txtDays.Enabled := False;
	1443	txtDays.ShowHint := False;
	1444	end;
	1445	ControlChange(Self);
	1446	end;
	1447
	1448	procedure TfrmODLab.cboCollTypeChange(Sender: TObject);
	1449	begin
	1450	if (ALabTest = nil) or Changing or (cboCollType.ItemID = '') then exit;
	1451	if (cboCollType.ItemID = 'I') and (not ALabTest.LabCanCollect) then
	1452	begin
	1453	InfoBox(TX_NO_IMMED, TX_NO_IMMED_CAP, MB_OK or MB_ICONWARNING);
	1454	cboCollType.ItemIndex := -1;
	1455	Exit;
	1456	end;
	1457	SetupCollTimes(cboCollType.ItemID);
	1458	ALabTest.LoadUrgency(cboCollType.ItemID, cboUrgency);
	1459	ControlChange(Self);
	1460	end;
	1461
	1462	procedure TfrmODLab.SetupCollTimes(CollType: string);
	1463	var
	1464	tmpImmTime, tmpTime: TFMDateTime;
	1465	x, tmpORECALLType, tmpORECALLTime: string;
	1466	begin
	1467	x := GetLastCollectionTime;
	1468	tmpORECALLType := Piece(x, U, 1);
	1469	tmpORECALLTime := Piece(x, U, 2);
	1470	if CollType = 'SP' then
	1471	begin
	1472	cboColltime.Visible := False;
	1473	txtImmedColl.Visible := False;
	1474	pnlCollTimeButton.Visible := False;
	1475	pnlCollTimeButton.TabStop := False;
	1476	calCollTime.Visible := True;
	1477	calColltime.Enabled := True;
	1478	if FLastCollTime <> '' then
	1479	begin
	1480	calCollTime.Text := ValidCollTime(FLastColltime);
	1481	if IsFMDateTime(calCollTime.Text) then
	1482	begin
	1483	calCollTime.Text := FormatFMDateTime('mmm dd,yy@hh:nn', StrToFMDateTime(calColltime.Text));
	1484	calColltime.FMDateTime := StrToFMDateTime(FLastCollTime);
	1485	end;
	1486	end
	1487	else if tmpORECALLTime <> '' then
	1488	begin
	1489	calCollTime.Text := ValidCollTime(tmpORECALLTime);
	1490	if IsFMDateTime(calCollTime.Text) then
	1491	begin
	1492	calCollTime.Text := FormatFMDateTime('mmm dd,yy@hh:nn', StrToFMDateTime(calColltime.Text));
	1493	calColltime.FMDateTime := StrToFMDateTime(tmpORECALLTime);
	1494	end;
	1495	end
	1496	else if LRFDATE <> '' then
	1497	calCollTime.Text := LRFDATE
	1498	else
	1499	calCollTime.Text := 'TODAY';
	1500	end
	1501	else if CollType = 'WC' then
	1502	begin
	1503	cboColltime.Visible := False;
	1504	txtImmedColl.Visible := False;
	1505	pnlCollTimeButton.Visible := False;
	1506	pnlCollTimeButton.TabStop := False;
	1507	calCollTime.Visible := True;
	1508	calColltime.Enabled := True;
	1509	if FLastCollTime <> '' then
	1510	begin
	1511	calCollTime.Text := ValidColltime(FLastColltime);
	1512	if IsFMDateTime(calCollTime.Text) then
	1513	begin
	1514	calCollTime.Text := FormatFMDateTime('mmm dd,yy@hh:nn', StrToFMDateTime(calColltime.Text));
	1515	calColltime.FMDateTime := StrToFMDateTime(FLastCollTime);
	1516	end;
	1517	end
	1518	else if tmpORECALLTime <> '' then
	1519	begin
	1520	calCollTime.Text := ValidColltime(tmpORECALLTime);
	1521	if IsFMDateTime(calCollTime.Text) then
	1522	begin
	1523	calCollTime.Text := FormatFMDateTime('mmm dd,yy@hh:nn', StrToFMDateTime(calColltime.Text));
	1524	calColltime.FMDateTime := StrToFMDateTime(tmpORECALLTime);
	1525	end;
	1526	end
	1527	else if LRFDATE <> '' then
	1528	calCollTime.Text := LRFDATE
	1529	else
	1530	calCollTime.Text := 'NOW';
	1531	end
	1532	else if CollType = 'LC' then
	1533	begin
	1534	cboColltime.Visible := True;
	1535	calCollTime.Visible := False;
	1536	calColltime.Enabled := False;
	1537	txtImmedColl.Visible := False;
	1538	pnlCollTimeButton.Visible := False;
	1539	pnlCollTimeButton.TabStop := False;
	1540	with CtrlInits do SetControl(cboCollTime, 'Lab Collection Times');
	1541	if Pos(U, FLastLabCollTime) > 0 then
	1542	cboColltime.SelectByID(Piece(FLastLabCollTime, U, 1))
	1543	else if FLastLabCollTime <> '' then
	1544	cboCollTime.Text := FLastLabCollTime
	1545	else if (tmpORECALLTime <> '') and (tmpORECALLType = 'LC') then
	1546	cboCollTime.Text := MakeRelativeDateTime(StrToFMDateTime(tmpORECALLTime))
	1547	else if LRFDATE <> '' then
	1548	cboCollTime.Text := LRFDATE
	1549	else
	1550	cboCollTime.ItemIndex := 0;
	1551	end
	1552	else if CollType = 'I' then
	1553	begin
	1554	cboColltime.Visible := False;
	1555	calCollTime.Visible := False;
	1556	calColltime.Enabled := False;
	1557	txtImmedColl.Visible := True;
	1558	pnlCollTimeButton.Visible := True;
	1559	pnlCollTimeButton.TabStop := True;
	1560	tmpImmTime := GetDefaultImmCollTime;
	1561	tmpTime := 0;
	1562	if (FLastColltime <> '') then
	1563	tmpTime := StrToFMDateTime(FLastColltime)
	1564	else if (tmpORECALLTime <> '') then
	1565	tmpTime := StrToFMDateTime(tmpORECALLTime)
	1566	else if LRFDATE <> '' then
	1567	tmpTime := StrToFMDateTime(LRFDATE);
	1568
	1569	if tmpTime > tmpImmTime then
	1570	begin
	1571	calCollTime.FMDateTime := tmpTime;
	1572	txtImmedColl.Text := FormatFMDateTime('mmm dd,yy@hh:nn', tmpTime);
	1573	end
	1574	else
	1575	begin
	1576	calCollTime.FMDateTime := GetDefaultImmCollTime;
	1577	txtImmedColl.Text := FormatFMDateTime('mmm dd,yy@hh:nn', calCollTime.FMDateTime);
	1578	end;
	1579	end;
	1580	end;
	1581
	1582	procedure TfrmODLab.FormClose(Sender: TObject; var Action: TCloseAction);
	1583	begin
	1584	inherited;
	1585	if FCmtTypes <> nil then FCmtTypes.Free;
	1586	frmFrame.pnlVisit.Enabled := true;
	1587	end;
	1588
	1589	procedure TfrmODLab.LoadRequiredComment(CmtType: integer);
	1590	begin
	1591	DisableCommentPanels;
	1592	pnlHide.SendToBack;
	1593	lblReqComment.Visible := True ;
	1594	case CmtType of
	1595	0 : {ANTICOAGULATION} pnlAntiCoagulation.Show ;
	1596	1 : {DOSE/DRAW TIMES} pnlDoseDraw.Show ;
	1597	2 : {ORDER COMMENT} pnlOrderComment.Show ;
	1598	3 : {ORDER COMMENT MODIFIED} pnlOrderComment.Show ; // DIFFERENT ???
	1599	4 : {TDM (PEAK-TROUGH} begin
	1600	pnlPeakTrough.Show ;
	1601	grpPeakTrough.ItemIndex := -1;
	1602	txtAddlComment.Show;
	1603	lblAddlComment.Show;
	1604	end;
	1605	5 : {TRANSFUSION} pnlOrderComment.Show ;
	1606	6 : {URINE VOLUME} pnlUrineVolume.Show ;
	1607	else
	1608	pnlOrderComment.Show ;
	1609	end;
	1610	end;
	1611
	1612	procedure TfrmODLab.txtOrderCommentExit(Sender: TObject);
	1613	begin
	1614	inherited;
	1615	if (not pnlOrderComment.Visible) or (ALabTest = nil) then exit;
	1616	with ALabTest do
	1617	if Length(txtOrderComment.Text)>0 then
	1618	begin
	1619	Comment.Clear;
	1620	ChangeComment('~For Test: ' + TestName);
	1621	ChangeComment('~' + txtOrderComment.Text) ;
	1622	end
	1623	else
	1624	Comment.Clear;
	1625	ControlChange(Self);
	1626	end;
	1627
	1628	procedure TfrmODLab.txtAntiCoagulantExit(Sender: TObject);
	1629	begin
	1630	inherited;
	1631	if (not pnlAntiCoagulation.Visible) or (ALabTest = nil) then exit;
	1632	with ALabTest do
	1633	if Length(txtAntiCoagulant.Text)>0 then
	1634	begin
	1635	Comment.Clear;
	1636	ChangeComment('~For Test: ' + TestName);
	1637	ChangeComment('~ANTICOAGULANT: ' + txtAntiCoagulant.Text);
	1638	end
	1639	else
	1640	Comment.Clear;
	1641	ControlChange(Self);
	1642	end;
	1643
	1644	procedure TfrmODLab.txtUrineVolumeExit(Sender: TObject);
	1645	begin
	1646	inherited;
	1647	if (not pnlUrineVolume.Visible) or (ALabTest = nil) then exit;
	1648	with ALabTest do
	1649	begin
	1650	Comment.Clear;
	1651	ChangeComment(txtUrineVolume.Text) ;
	1652	end;
	1653	ControlChange(Self);
	1654	end;
	1655
	1656	procedure TfrmODLab.grpPeakTroughClick(Sender: TObject);
	1657	begin
	1658	inherited;
	1659	if (not pnlPeakTrough.Visible) or (ALabTest = nil) then exit;
	1660	with ALabTest,grpPeakTrough do
	1661	if ItemIndex > -1 then
	1662	begin
	1663	Comment.Clear;
	1664	ChangeComment('~For Test: ' + TestName);
	1665	ChangeComment('~Dose is expected to be at ' + UpperCase(Items[ItemIndex]) + ' level.');
	1666	ChangeComment(txtAddlComment.Text) ;
	1667	end
	1668	else
	1669	Comment.Clear;
	1670	ControlChange(Self);
	1671	end;
	1672
	1673	procedure TfrmODLab.txtDoseTimeExit(Sender: TObject);
	1674	begin
	1675	inherited;
	1676	if (not pnlDoseDraw.Visible) or (ALabTest = nil) then exit;
	1677	with txtDoseTime do
	1678	if Length(Text)>0 then
	1679	Text := FormatFMDateTime('mm/dd/yy hh:nn', StrToFMDateTime(Text))
	1680	else
	1681	Text := 'UNKNOWN';
	1682	DoseDrawComment;
	1683	ControlChange(Self);
	1684	end;
	1685
	1686	procedure TfrmODLab.txtDrawTimeExit(Sender: TObject);
	1687	begin
	1688	inherited;
	1689	if (not pnlDoseDraw.Visible) or (ALabTest = nil) then exit;
	1690	with txtDrawTime do
	1691	if Length(Text)>0 then
	1692	Text := FormatFMDateTime('mm/dd/yy hh:nn', StrToFMDateTime(Text))
	1693	else
	1694	Text := 'UNKNOWN';
	1695	DoseDrawComment;
	1696	ControlChange(Self);
	1697	end;
	1698
	1699	procedure TfrmODLab.DoseDrawComment;
	1700	begin
	1701	if ALabTest = nil then exit;
	1702	with ALabTest do
	1703	begin
	1704	Comment.Clear;
	1705	ChangeComment('~For Test: ' + TestName);
	1706	ChangeComment('~Last dose: ' + txtDoseTime.Text +
	1707	' draw time: '+txtDrawTime.Text);
	1708	end;
	1709	end;
	1710
	1711	procedure TfrmODLab.txtAddlCommentExit(Sender: TObject);
	1712	begin
	1713	if (not pnlPeakTrough.Visible) or (ALabTest = nil) then exit;
	1714	grpPeakTroughClick(Sender);
	1715	end;
	1716
	1717	procedure TfrmODLab.DisableCommentPanels;
	1718	begin
	1719	pnlHide.BringToFront;
	1720	lblReqComment.Visible := False;
	1721	pnlAntiCoagulation.Visible := False;
	1722	pnlOrderComment.Visible := False;
	1723	pnlDoseDraw.Visible := False;
	1724	pnlPeakTrough.Visible := False;
	1725	pnlUrineVolume.Visible := False;
	1726	lblAddlComment.Visible := False;
	1727	txtAddlComment.Visible := False;
	1728	//pnlTransfusion.Visible := False;
	1729	end;
	1730
	1731	procedure TfrmODLab.cboCollSampKeyPause(Sender: TObject);
	1732	begin
	1733	inherited;
	1734	if ALabTest = nil then exit;
	1735	with cboCollSamp do
	1736	if (ItemIndex >= 0) and (ItemIEN = 0) then GetAllCollSamples(cboCollSamp);
	1737	if (cboCollSamp.ItemIEN = 0) then
	1738	begin
	1739	ALabTest.Specimen := 0;
	1740	ALabTest.CollSamp := 0;
	1741	cboCollSamp.ItemIndex := -1;
	1742	cboSpecimen.ItemIndex := -1;
	1743	end
	1744	else
	1745	ALabTest.LoadSpecimen(cboSpecimen);
	1746	ControlChange(Self);
	1747	end;
	1748
	1749	procedure TfrmODLab.cboCollSampMouseClick(Sender: TObject);
	1750	begin
	1751	inherited;
	1752	if ALabTest = nil then exit;
	1753	with cboCollSamp do
	1754	begin
	1755	if (ItemIndex >= 0) and (ItemIEN = 0) then
	1756	GetAllCollSamples(cboCollSamp);
	1757	if (ItemIEN = 0) then
	1758	begin
	1759	ALabTest.Specimen := 0;
	1760	ALabTest.CollSamp := 0;
	1761	ItemIndex := -1;
	1762	cboSpecimen.ItemIndex := -1;
	1763	end
	1764	else
	1765	ALabTest.LoadSpecimen(cboSpecimen);
	1766	end;
	1767	ControlChange(Self);
	1768	end;
	1769
	1770	function TfrmODLab.ValidCollTime(UserEntry: string): string;
	1771	var
	1772	i: integer;
	1773	const
	1774	FMDateResponses: array[0..3] of string = ('TODAY','NOW','NOON','MID');
	1775	begin
	1776	Result := '';
	1777	UserEntry := UpperCase(UserEntry);
	1778	if StrToFMDateTime(UserEntry) < 0 then exit;
	1779	if (UserEntry = 'T') or
	1780	(UserEntry = 'N') or
	1781	(Copy(UserEntry,1,2)='T+') or
	1782	(Copy(UserEntry,1,2)='T@') or
	1783	(Copy(UserEntry,1,2)='T-') or
	1784	(Copy(UserEntry,1,2)='N+') then Result := UserEntry
	1785	else
	1786	for i := 0 to 3 do if Pos(FMDateResponses[i],UserEntry)>0 then Result := UserEntry ;
	1787	if Result = '' then Result := FloatToStr(StrToFMDateTime(UserEntry));
	1788	end;
	1789
	1790	procedure TfrmODLab.cboCollTimeExit(Sender: TObject);
	1791	var
	1792	ADateTime: TFMDateTime;
	1793	CollType: string;
	1794	isTrue: boolean;
	1795	const
	1796	TX_BAD_TIME = ' is not a routine lab collection time.' ;
	1797	TX_BAD_TIME_CAP = 'Invalid Time';
	1798	begin
	1799	inherited;
	1800	if (ALabTest = nil) or (cboColltime.Text = '') then Exit;
	1801	Changing := True;
	1802	CollType := 'LC';
	1803	with cboCollTime do if (ItemIndex < 0) or (ITEMID = 'LO') then
	1804	if ALabTest.LabCanCollect then
	1805	begin
	1806	ADateTime := StrToFMDateTime(cboCollTime.Text);
	1807	if EvtDelayLoc > 0 then
	1808	isTrue := IsLabCollectTime(ADateTime, EvtDelayLoc)
	1809	else
	1810	isTrue := IsLabCollectTime(ADateTime, Encounter.Location);
	1811	if isTrue then
	1812	begin
	1813	calCollTime.Clear;
	1814	cboCollTime.Visible := True;
	1815	calCollTime.Visible := False;
	1816	calCollTime.Enabled := False;
	1817	end {if IsLabCollectTime}
	1818	else
	1819	begin
	1820	InfoBox(cboCollTime.Text + TX_BAD_TIME, TX_BAD_TIME_CAP, MB_OK or MB_ICONWARNING) ;
	1821	ItemIndex := -1;
	1822	Text := GetFutureLabTime(ADateTime);
	1823	end ;
	1824	end {if (LabCanCollect...}
	1825	else
	1826	begin
	1827	if OrderForInpatient then CollType := 'WC' else CollType := 'SP';
	1828	calCollTime.Text := cboCollTime.Text;
	1829	cboCollTime.Clear;
	1830	cboCollTime.Visible := False;
	1831	calCollTime.Visible := True;
	1832	calCollTime.Enabled := True;
	1833	end;
	1834	cboCollType.SelectByID(CollType);
	1835	Changing := False; //v16.3 RV
	1836	ControlChange(Self); //v16.3 RV
	1837	//Responses.Update('COLLECT', 1, CollType, CollType) ; //v16.3 RV
	1838	//memOrder.Text := Responses.OrderText; //v16.3 RV
	1839	end;
	1840
	1841	procedure TfrmODLab.cboSpecimenMouseClick(Sender: TObject);
	1842	begin
	1843	inherited;
	1844	if ALabTest = nil then exit;
	1845	with cboSpecimen do
	1846	begin
	1847	if (ItemIndex >= 0) and (ItemIEN = 0) then
	1848	GetAllSpecimens(cboSpecimen);
	1849	if (ItemIEN = 0) then
	1850	begin
	1851	ALabTest.Specimen := 0;
	1852	ItemIndex := -1;
	1853	end;
	1854	end;
	1855	ControlChange(Self);
	1856	end;
	1857
	1858	procedure TfrmODLab.GetAllCollSamples(AComboBox: TORComboBox);
	1859	var
	1860	OtherSamp: string;
	1861	begin
	1862	with ALabTest, AComboBox do
	1863	begin
	1864	if ((CollSampList.Count + 1) <= AComboBox.Items.Count) then LoadAllSamples;
	1865	OtherSamp := SelectOtherCollSample(Font.Size, CollSampCount, CollSampList);
	1866	if OtherSamp = '-1' then exit;
	1867	if SelectByID(Piece(OtherSamp, U, 1)) = -1 then
	1868	if Items.Count > CollSampCount + 1 then
	1869	Items[0] := OtherSamp
	1870	else
	1871	Items.Insert(0, OtherSamp) ;
	1872	SelectByID(Piece(OtherSamp, U, 1));
	1873	AComboBox.OnChange(Self);
	1874	ActiveControl := cmdAccept;
	1875	end;
	1876	end;
	1877
	1878	procedure TfrmODLab.GetAllSpecimens(AComboBox: TORComboBox);
	1879	var
	1880	OtherSpec: string;
	1881	begin
	1882	inherited;
	1883	if ALabTest <> nil then
	1884	with ALabTest, AComboBox do
	1885	begin
	1886	AComboBox.DroppedDown := False;
	1887	OtherSpec := SelectOtherSpecimen(Font.Size, SpecimenList);
	1888	if OtherSpec = '-1' then exit;
	1889	if SelectByID(Piece(OtherSpec, U, 1)) = -1 then
	1890	if Items.Count > SpecListCount + 1 then
	1891	Items[0] := OtherSpec
	1892	else
	1893	Items.Insert(0, OtherSpec) ;
	1894	SpecimenList.Add(OtherSpec);
	1895	SelectByID(Piece(OtherSpec, U, 1));
	1896	AComboBox.OnChange(Self);
	1897	end;
	1898	end;
	1899
	1900	procedure TfrmODLab.cboSpecimenKeyPause(Sender: TObject);
	1901	begin
	1902	inherited;
	1903	if ALabTest = nil then exit;
	1904	with cboSpecimen do
	1905	if (ItemIndex >= 0) and (ItemIEN = 0) then
	1906	GetAllSpecimens(cboSpecimen);
	1907	if (cboSpecimen.ItemIEN = 0) then
	1908	begin
	1909	ALabTest.Specimen := 0;
	1910	cboSpecimen.ItemIndex := -1;
	1911	end ;
	1912	ControlChange(Self);
	1913	end;
	1914
	1915	procedure TfrmODLab.cmdImmedCollClick(Sender: TObject);
	1916	var
	1917	ImmedCollTime: string;
	1918	begin
	1919	inherited;
	1920	ImmedCollTime := SelectImmediateCollectTime(Font.Size, txtImmedColl.Text);
	1921	if ImmedCollTime <> '-1' then
	1922	begin
	1923	txtImmedColl.Text := ImmedCollTime;
	1924	calCollTime.FMDateTime := StrToFMDateTime(ImmedCollTime);
	1925	end
	1926	else
	1927	begin
	1928	txtImmedColl.Clear;
	1929	calCollTime.Clear;
	1930	end;
	1931	end;
	1932
	1933	procedure TfrmODLab.ReadServerVariables;
	1934	begin
	1935	LRFZX := KeyVariable['LRFZX'];
	1936	LRFSAMP := KeyVariable['LRFSAMP'];
	1937	LRFSPEC := KeyVariable['LRFSPEC'];
	1938	LRFDATE := KeyVariable['LRFDATE'];
	1939	LRFURG := KeyVariable['LRFURG'];
	1940	LRFSCH := KeyVariable['LRFSCH'];
	1941	end;
	1942
	1943	procedure TfrmODLab.DetermineCollectionDefaults(Responses: TResponses);
	1944	var
	1945	RespCollect, RespStart: TResponse;
	1946	//i: integer;
	1947	begin
	1948	if ALabTest = nil then exit;
	1949	calCollTime.Clear;
	1950	cboCollTime.Clear;
	1951	calCollTime.Enabled := True;
	1952	lblCollTime.Enabled := True;
	1953	cboColltime.Enabled := True;
	1954	with Responses, ALabTest do
	1955	begin
	1956	RespCollect := FindResponseByName('COLLECT',1);
	1957	RespStart := FindResponseByName('START' ,1);
	1958	if (RespCollect <> nil) then with RespCollect do
	1959	begin
	1960	if IValue = 'LC' then
	1961	begin
	1962	if not LabCanCollect then
	1963	begin
	1964	cboCollType.SelectByID('WC');
	1965	SetupCollTimes('WC');
	1966	end
	1967	else // if LabCanCollect
	1968	begin
	1969	cboCollType.SelectByID('LC');
	1970	SetupCollTimes('LC');
	1971	CtrlInits.SetControl(cboCollTime, 'Lab Collection Times') ;
	1972	if RespStart <> nil then
	1973	begin
	1974	cboCollTime.SelectByID('L' + RespStart.IValue);
	1975	if cboCollTime.ItemIndex < 0 then
	1976	cboCollTime.Text := RespStart.IValue;
	1977	end;
	1978	end;
	1979	end
	1980	else // if IValue <> 'LC'
	1981	begin
	1982	cboCollType.SelectByID(IValue) ;
	1983	SetupCollTimes(IValue);
	1984	if RespStart <> nil then
	1985	begin
	1986	if ContainsAlpha(RespStart.IValue) then
	1987	calColltime.Text := RespStart.IValue
	1988	else
	1989	calColltime.FMDateTime := StrToFMDateTime(RespStart.IValue);
	1990	end;
	1991	end ;
	1992	if IValue = 'I' then
	1993	if not LabCanCollect then
	1994	begin
	1995	cboCollType.SelectByID('WC');
	1996	SetupCollTimes('WC');
	1997	end
	1998	else
	1999	begin
	2000	calCollTime.Enabled := False;
	2001	if RespStart <> nil then txtImmedColl.Text := RespStart.EValue;
	2002	end;
	2003	end
	2004	else // if (RespCollect = nil)
	2005	LoadCollType(cbocollType);
	2006	end;
	2007	end;
	2008	procedure TfrmODLab.pnlCollTimeButtonEnter(Sender: TObject);
	2009	begin
	2010	inherited;
	2011	(Sender as TPanel).BevelOuter := bvRaised;
	2012	end;
	2013
	2014	procedure TfrmODLab.pnlCollTimeButtonExit(Sender: TObject);
	2015	begin
	2016	inherited;
	2017	(Sender as TPanel).BevelOuter := bvNone;
	2018	end;
	2019
	2020	procedure TfrmODLab.ViewinReportWindow1Click(Sender: TObject);
	2021	begin
	2022	inherited;
	2023	ReportBox(memMessage.Lines, 'Lab Procedure', True);
	2024	end;
	2025
	2026	end.
	2027
	2028

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

Download in other formats: