Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

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

Last change on this file since 473 was 456, checked in by Kevin Toppenberg, 16 years ago
Initial Upload of Official WV CPRS 1.0.26.76
File size: 67.1 KB

Line
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,
183	rOrders, uODBase, fRptBox, fFrame;
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
210	frmFrame.pnlVisit.Enabled := false;
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);
420	LabSubscript := Piece(ExtractDefault(LoadData, 'Item ID'),U,2);
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);
829	var
830	AResponse: TResponse;
831	AVisitStr: string;
832	begin
833	inherited;
834	if Changing or (ALabTest = nil) then Exit;
835	AResponse := Responses.FindResponseByName('VISITSTR', 1);
836	if AResponse <> nil then
837	AVisitStr := AResponse.EValue;
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 }
886	if AVisitStr <> '' then Responses.Update('VISITSTR', 1, AVisitStr, AVisitStr);
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;
1537	frmFrame.pnlVisit.Enabled := true;
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.

Download in other formats: