Context Navigation

fODLab.pas@ 1797

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

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

Context Navigation

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

Download in other formats: