Context Navigation

fODLab.pas@ 776

Last change on this file since 776 was 460, checked in by Kevin Toppenberg, 16 years ago
Uploading from OR_30_258
File size: 67.1 KB

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

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

Context Navigation

source: cprs/branches/foia-cprs/CPRS-Chart/Orders/fODLab.pas@ 776

Download in other formats: