Context Navigation

source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/Orders/fODBBank.pas@ 1691

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

Line
1	unit fODBBank;
2	interface
3
4	uses
5	SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
6	Forms, Dialogs, StdCtrls, ORCtrls, ORfn, fODBase, ExtCtrls, ComCtrls, uConst,
7	ORDtTm, Buttons, Menus, ImgList, VA508AccessibilityManager, VAUtils;
8
9	type
10	TfrmODBBank = class(TfrmODBase)
11	dlgLabCollTime: TORDateTimeDlg;
12	ORWanted: TORDateTimeDlg;
13	pnlComments: TPanel;
14	btnUpdateComments: TButton;
15	btnCancelComment: TButton;
16	lblOrdComment: TLabel;
17	pgeProduct: TPageControl;
18	TabInfo: TTabSheet;
19	edtInfo: TCaptionRichEdit;
20	TabDiag: TTabSheet;
21	lblReqComment: TOROffsetLabel;
22	TabResults: TTabSheet;
23	edtResults: TCaptionRichEdit;
24	pnlFields: TPanel;
25	lblDiagComment: TOROffsetLabel;
26	lblUrgency: TLabel;
27	lblReason: TLabel;
28	lblSurgery: TLabel;
29	cboUrgency: TORComboBox;
30	chkConsent: TCheckBox;
31	cboSurgery: TORComboBox;
32	pnlSelect: TPanel;
33	pnlDiagnosticTests: TGroupBox;
34	cboAvailTest: TORComboBox;
35	pnlBloodComponents: TGroupBox;
36	lblQuantity: TLabel;
37	lblModifiers: TLabel;
38	cboAvailComp: TORComboBox;
39	tQuantity: TEdit;
40	cboModifiers: TORComboBox;
41	GroupBox1: TGroupBox;
42	cboQuick: TORComboBox;
43	pnlSelectedTests: TGroupBox;
44	lvSelectionList: TCaptionListView;
45	btnRemove: TButton;
46	btnRemoveAll: TButton;
47	cboReasons: TORComboBox;
48	lblRequiredField: TLabel;
49	memDiagComment: TRichEdit;
50	lblCollType: TLabel;
51	cboCollType: TORComboBox;
52	lblCollTime: TLabel;
53	cboCollTime: TORComboBox;
54	calWantTime: TORDateBox;
55	lblWanted: TLabel;
56	calCollTime: TORDateBox;
57	txtImmedColl: TCaptionEdit;
58	pnlCollTimeButton: TKeyClickPanel;
59	cmdImmedColl: TSpeedButton;
60	lblTNS: TLabel;
61	procedure FormCreate(Sender: TObject);
62	procedure cboAvailTestSelect(Sender: TObject);
63	procedure cboAvailCompSelect(Sender: TObject);
64	procedure DisableCommentPanels;
65	procedure DisableComponentControls;
66	procedure DisableDiagTestControls;
67	procedure EnableComponentControls;
68	procedure EnableDiagTestControls;
69	procedure cboAvailTestExit(Sender: TObject);
70	procedure cboAvailCompExit(Sender: TObject);
71	procedure cboAvailTestNeedData(Sender: TObject;
72	const StartFrom: String; Direction, InsertAt: Integer);
73	procedure cboAvailCompNeedData(Sender: TObject;
74	const StartFrom: String; Direction, InsertAt: Integer);
75	procedure cmdImmedCollClick(Sender: TObject);
76	procedure pgeProductChange(Sender: TObject);
77	procedure cboCollTypeChange(Sender: TObject);
78	procedure FormDestroy(Sender: TObject);
79	procedure btnRemoveClick(Sender: TObject);
80	procedure btnRemoveAllClick(Sender: TObject);
81	procedure cmdAcceptClick(Sender: TObject);
82	procedure calWantTimeChange(Sender: TObject);
83	procedure chkConsentClick(Sender: TObject);
84	procedure cboUrgencyChange(Sender: TObject);
85	procedure cboSurgeryChange(Sender: TObject);
86	procedure calCollTimeChange(Sender: TObject);
87	procedure cboQuickClick(Sender: TObject);
88	procedure tQuantityEnter(Sender: TObject);
89	procedure btnUpdateCommentsClick(Sender: TObject);
90	procedure btnCancelCommentClick(Sender: TObject);
91	procedure cboSurgeryClick(Sender: TObject);
92	procedure cboReasonsEnter(Sender: TObject);
93	procedure cboReasonsExit(Sender: TObject);
94	procedure tQuantityClick(Sender: TObject);
95	procedure tQuantityChange(Sender: TObject);
96	procedure cboReasonsChange(Sender: TObject);
97	procedure cboModifiersChange(Sender: TObject);
98	procedure lvSelectionListClick(Sender: TObject);
99	procedure cboAvailCompChange(Sender: TObject);
100	procedure cboCollTimeChange(Sender: TObject);
101	procedure memDiagCommentChange(Sender: TObject);
102	procedure cboUrgencyExit(Sender: TObject);
103	protected
104	FCmtTypes: TStringList ;
105	procedure InitDialog; override;
106	function ValidCollTime(UserEntry: string): string;
107	procedure GetAllCollSamples(AComboBox: TORComboBox);
108	procedure GetAllSpecimens(AComboBox: TORComboBox);
109	procedure SetupCollTimes(CollType: string);
110	procedure LoadCollType(AComboBox:TORComboBox);
111	function ValidAdd: Boolean;
112	procedure ValidateAdd(var AnErrMsg: string);
113	procedure Validate(var AnErrMsg: string); override;
114	procedure ExtractMSBOS(OutList:TStrings; AList:TStrings);
115	procedure ExtractTests(OutList:TStrings; AList:TStrings);
116	procedure ExtractSurgeries(OutList:TStrings; AList:TStrings);
117	procedure ExtractUrgencies(OutList:TStrings; AList:TStrings);
118	procedure ExtractTNSOrders(OutList:TStrings; AList:TStrings);
119	procedure ExtractModifiers(OutList:TStrings; AList:TStrings);
120	procedure ExtractReasons(OutList:TStrings; AList:TStrings);
121	procedure ExtractSpecimens(OutList:TStrings; AList:TStrings);
122	procedure ExtractTypeScreen(OutList:TStrings; AList:TStrings);
123	procedure ExtractOther(OutList:TStrings; AList:TStrings);
124	procedure ExtractPatientInfo(OutList:TStrings; AList:TStrings);
125	procedure ExtractSpecimen(OutList:TStrings; AList:TStrings);
126	function SpecimenNeeded(OutList:TStrings; AList:TStrings; CompID:integer): Boolean;
127	procedure LoadUrgencies(AComboBox:TORComboBox);
128	procedure LoadModifiers(AComboBox:TORComboBox);
129	procedure LoadReasons(AComboBox:TORComboBox);
130
131	private
132	FLastCollType: string;
133	FLastCollTime: string;
134	FLastLabCollTime: string;
135	FLastLabID: string;
136	FLastItemID: string;
137	FEvtDelayLoc: integer;
138	FEvtDivision: integer;
139	FVbecLookup: string;
140	FQuickList: Integer;
141	FQuickItems: TStringList;
142	FOrderAction: Integer;
143	procedure ReadServerVariables;
144	procedure SetOnQuickOrder;
145	public
146	procedure SetupDialog(OrderAction: Integer; const ID: string); override;
147	procedure LoadRequiredComment(CmtType: integer);
148	procedure DetermineCollectionDefaults(Responses: TResponses);
149	property EvtDelayLoc: integer read FEvtDelayLoc write FEvtDelayLoc;
150	property EvtDivision: integer read FEvtDivision write FEvtDivision;
151	end;
152
153	type
154	TCollSamp = class(TObject)
155	CollSampID: Integer; { IEN of CollSamp }
156	CollSampName: string; { Name of CollSamp }
157	SpecimenID: Integer; { IEN of default specimen }
158	SpecimenName: string; { Name of the specimen }
159	TubeColor: string; { TubeColor (text) }
160	MinInterval: Integer; { Minimum days between orders }
161	MaxPerDay: Integer; { Maximum orders per day }
162	LabCanCollect: Boolean; { True if lab can collect }
163	SampReqComment: string; { Name of required comment }
164	WardComment: TStringList; { CollSamp specific comment }
165	end;
166
167	TLabTest = class(TObject)
168	TestID: Integer; { IEN of Lab Test }
169	TestName: string; { Name of Lab Test }
170	ItemID: Integer; { Orderable Item ID }
171	LabSubscript: string ; { which section of Lab? }
172	CollSamp: Integer; { index into CollSampList }
173	Specimen: Integer; { IEN of specimen }
174	Urgency: Integer; { IEN of urgency }
175	Comment: TStringList; { text of comment }
176	TestReqComment: string; { Name of required comment }
177	CurReqComment: string; { name of required comment }
178	CurWardComment: TStringList; { WP of Ward Comment }
179	UniqueCollSamp: Boolean; { true if not prompt CollSamp }
180	CollSampList: TList; { collection sample objects }
181	CollSampCount: integer; { count of original contents of CollSampList}
182	SpecimenList: TStringList; { Strings: IEN^Specimen Name }
183	SpecListCount: integer; { count of original contents of SpecimenList}
184	UrgencyList: TStringList; { Strings: IEN^Urgency Name }
185	ForceUrgency: Boolean; { true if not prompt Urgency }
186	SurgeryList: TStringList; { Strings: Surgeries}
187	PatientInfo: TStringList; { Text of Patient Information}
188	ResultsDisplay: TStringList; { Text of Test Results}
189	QuickOrderResponses: TResponses; { if created as a result of a quick order selection}
190	{ functions & procedures }
191	constructor Create(const LabTestIEN: string; Responses: TResponses);
192	destructor Destroy; override ;
193	function IndexOfCollSamp(CollSampIEN: Integer): Integer;
194	procedure FillCollSampList(LoadData: TStringList; DfltCollSamp: Integer);
195	procedure LoadAllSamples;
196	procedure SetCollSampDflts;
197	procedure ChangeCollSamp(CollSampIEN: Integer);
198	procedure ChangeSpecimen(const SpecimenIEN: string);
199	procedure ChangeComment(const CommentText: string);
200	function LabCanCollect: Boolean;
201	procedure LoadCollSamp(AComboBox: TORComboBox);
202	procedure LoadSpecimen(AComboBox: TORComboBox);
203	procedure LoadUrgency(CollType: string; AComboBox:TORComboBox);
204	function NameOfCollSamp: string;
205	function NameOfSpecimen: string;
206	function NameOfUrgency: string;
207	function ObtainCollSamp: Boolean;
208	function ObtainSpecimen: Boolean;
209	function ObtainUrgency: Boolean;
210	function ObtainComment: Boolean;
211
212	end;
213
214	const
215	CmtType: array[0..6] of string = ('ANTICOAGULATION','DOSE/DRAW TIMES','ORDER COMMENT',
216	'ORDER COMMENT MODIFIED','TDM (PEAK-TROUGH)',
217	'TRANSFUSION','URINE VOLUME');
218	var
219	frmODBBank: TfrmODBBank;
220
221	implementation
222
223	{$R *.dfm}
224
225	uses rODBase, rODLab, uCore, rCore, fODLabOthCollSamp, fODLabOthSpec, fODLabImmedColl, fLabCollTimes,
226	rOrders, uODBase, fRptBox;
227
228	var
229	uSelectedItems: TStringList; //Selected Items in ListView- if TestYes =1 then test else component
230	//TestYes(1)^Test-Component(2)^Qty(3)^Modifier(4)^Specimen(5,6)^CollTime(7)^CollType(8)
231	uVBECList: TStringList; //List of items from VBEC api
232	uTestsForResults: TStringList; //List of tests to show results
233	uUrgencyList: TStringList; //List of Urgencies
234	uTNSOrders: TStringList; //List of Current orders for Type & Screen
235	uModifierList: TStringList; //List of Modifiers
236	uReasonsList: TStringList; //List of Reasons for Request
237	uRaw: TStringList; //Results Array
238	uTestSelected, uComponentSelected: Boolean; //Used on Validate
239	uDfltUrgency: Integer; //Default Urgency
240	uSelUrgency: String; //Previously Selected Urgency - Used when components have been added for specific urgency
241	uSelSurgery: Integer; //Selected Surgery for Blood order
242	uSpecimen, uGetTnS: Integer; //Set to 1 if a specimen for test is already in lab... no need to collect
243	uDfltCollType, uReason: string;
244	ALabTest: TLabTest;
245	UserHasLRLABKey: boolean;
246	LRFZX : string; //the default collection type (LC,WC,SP,I)
247	LRFSAMP : string; //the default sample (ptr)
248	LRFSPEC : string; //the default specimen (ptr)
249	LRFDATE : string; //the default collection time (NOW,NEXT,AM,PM,T...)
250	LRFURG : string; //the default urgency (number) TRY '2'
251	LRFSCH : string; //the default schedule? (ONE TIME, QD, ...)
252	LRORDERMODE : Integer; //the mode being used to order (component or diagnostic test)
253
254	const
255	TX_NO_TEST = 'A Lab Test must be specified.' ;
256	TX_NO_IMMED = 'Immediate collect is not available for this test/sample';
257	TX_NO_IMMED_CAP = 'Invalid Collection Type';
258
259	TI_INFO = 0; //Corresponds with pgeProduct TabIndex
260	TI_COMPONENT = 1;
261	TI_RESULTS = 2;
262
263	TORDER_MODE_INFO = 0;
264	TORDER_MODE_DIAG = 1;
265	TORDER_MODE_COMP = 2;
266
267	procedure TfrmODBBank.FormCreate(Sender: TObject);
268	var
269	i: integer;
270	AList, ATests: TStringList;
271	ListCount: Integer;
272	x: string;
273	begin
274	AutoSizeDisabled := True;
275	inherited;
276	AList := TStringList.Create;
277	ATests := TStringList.Create;
278	uSelectedItems := TStringList.Create;
279	uVBECList := TStringList.Create;
280	uTestsForResults := TStringList.Create;
281	uUrgencyList := TStringList.Create;
282	uTNSOrders := TStringList.Create;
283	uModifierList := TStringList.Create;
284	uReasonsList := TStringList.Create;
285	uRaw := TStringList.Create;
286	uSpecimen := 0;
287	uGetTnS := 0;
288	uReason := '';
289	lblTNS.Caption := '';
290	lblTNS.Visible := false;
291	pnlMessage.Visible := false;
292	uDfltUrgency := 9;
293	uSelUrgency := '';
294	uSelSurgery := 0;
295	TabResults.Caption := 'Lab Results';
296	edtResults.Lines.Clear;
297	edtResults.Lines.Add('Lab results are ONLY available after selecting/adding a component on the Blood Bank Orders tab that has been designated for results retrieval.');
298	Responses.Clear;
299	try
300	LRFZX := '';
301	LRFSAMP := '';
302	LRFSPEC := '';
303	LRFDATE := '';
304	LRFURG := '';
305	LRFSCH := '';
306	LRORDERMODE := TORDER_MODE_INFO;
307	FLastColltime := '';
308	FLastLabCollTime := '';
309	FLastItemID := '';
310	uDfltCollType := '';
311	FillerID := 'LR';
312	FEvtDelayLoc := 0;
313	FEvtDivision := 0;
314	UserHasLRLABKey := User.HasKey('LRLAB');
315	AllowQuickOrder := True;
316	StatusText('Loading Dialog Definition');
317	FCmtTypes := TStringList.Create;
318	for i := 0 to 6 do FCmtTypes.Add(CmtType[i]) ;
319	Responses.Dialog := 'VBEC BLOOD BANK'; // loads formatting info
320	StatusText('Loading Default Values');
321	if Self.EvtID > 0 then
322	begin
323	EvtDelayLoc := StrToIntDef(GetEventLoc1(IntToStr(Self.EvtID)),0);
324	EvtDivision := StrToIntDef(GetEventDiv1(IntToStr(Self.EvtID)),0);
325	if EvtDelayLoc>0 then
326	FastAssign(ODForLab(EvtDelayLoc,EvtDivision), AList)
327	else
328	FastAssign(ODForLab(Encounter.Location,EvtDivision), AList);
329	end else
330	FastAssign(ODForLab(Encounter.Location), AList); // ODForLab returns TStrings with defaults
331	CtrlInits.LoadDefaults(AList);
332	InitDialog;
333	GroupBox1.Visible := True;
334	with CtrlInits do
335	begin
336	SetControl(cboCollType, 'Collection Types');
337	uDfltCollType := ExtractDefault(AList, 'Collection Types');
338	if uDfltCollType <> '' then
339	cboCollType.SelectByID(uDfltCollType)
340	else if OrderForInpatient then
341	cboCollType.SelectByID('LC')
342	else
343	cboCollType.SelectByID('SP');
344	SetupCollTimes(cboCollType.ItemID);
345	StatusText('Initializing List of Tests');
346	FVbecLookup := 'S.VBT';
347	cboAvailTest.InitLongList(''); //Populates cboAvailTest control based on S.VBT xref
348	end;
349	cboAvailComp.Clear;
350	aList.Clear;
351	GetBloodComponents(aList); //Get Components in right order
352	for i := 0 to aList.Count - 1 do
353	cboAvailComp.Items.Add(aList[i]);
354	uVBECList.Clear;
355	edtInfo.Clear;
356	cboSurgery.Clear;
357	GetPatientBBInfo(uVBECList, Patient.DFN, Encounter.Location);
358	aList.Clear;
359	ExtractPatientInfo(AList, uVBECList);
360	QuickCopy(AList, edtInfo);
361	AList.Clear;
362	ExtractSurgeries(AList, uVBECList);
363	for i := 0 to AList.Count - 1 do
364	cboSurgery.Items.Add(AList[i]);
365	AList.Clear;
366	ExtractUrgencies(uUrgencyList, uVBECList);
367	ExtractTNSOrders(uTNSOrders, uVBECList);
368	LoadUrgencies(cboUrgency);
369	ExtractModifiers(uModifierList, uVBECList);
370	ExtractReasons(uReasonsList, uVBECList);
371	LoadModifiers(cboModifiers);
372	LoadReasons(cboReasons);
373	calWantTime.Text := 'NOW'; //FormatFMDateTime('mmm dd,yyyy@hh:nn',DateTimeToFMDateTime(Now));
374	pgeProduct.TabIndex := TI_INFO;
375	lvSelectionList.Column[0].Width := 240;
376	lvSelectionList.Column[1].Width := 30;
377	lvSelectionList.Column[2].Width := 100;
378	DisableComponentControls;
379	DisableDiagTestControls;
380	pgeProduct.ActivePageIndex := TI_INFO;
381	StatusText('');
382	x := 'VBEC';
383	FQuickItems := TStringList.Create;
384	ListForQuickOrders(FQuickList, ListCount, x);
385	if ListCount > 0 then
386	begin
387	SubsetOfQuickOrders(FQuickItems, FQuickList, 0, 0);
388	end else
389	begin
390	ListCount := 1;
391	FQuickItems.Add('0^(No quick orders available)');
392	end;
393
394	FastAssign(FQuickItems, cboQuick.Items);
395	if lvSelectionList.Items.Count > 0 then
396	begin
397	memOrder.Visible := true;
398	cmdAccept.Visible := true;
399	end;
400	finally
401	AList.Free;
402	ATests.Free;
403	end;
404	end;
405
406	procedure TfrmODBBank.InitDialog;
407	begin
408	inherited;
409	Changing := True;
410	if ALabTest <> nil then
411	begin
412	ALabTest.Destroy;
413	ALabTest := nil;
414	end;
415	DisableCommentPanels;
416	cboAvailTest.SelectByID(FLastItemID);
417	cboAvailComp.SelectByID(FLastItemID);
418	cboAvailTest.ItemIndex := -1;
419	StatusText('');
420	Changing := False ;
421	end;
422
423	procedure TfrmODBBank.SetupDialog(OrderAction: Integer; const ID: string);
424	var
425	AnInstance, CurAdd: Integer;
426	AResponse: TResponse;
427	i, j, k, aTNS, aTNSDays, getTest, TestAdded: integer;
428	aStr, aTestYes, aName, aTypeScreen, aSpecimen, aModifier, sub, sub1, x, aTNSString: string;
429	ListItem: TListItem;
430	aList: TStringList;
431	aTests: TStringList;
432	begin
433	inherited;
434	aList := TStringList.Create;
435	aTests:= TStringList.Create;
436	try
437	FOrderAction := OrderAction;
438	ReadServerVariables;
439	sub1 := '';
440	aTypeScreen := '';
441	aSpecimen := '^';
442	aModifier := '';
443	if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses, ALabTest do
444	begin
445	AnInstance := NextInstance('ORDERABLE', 0);
446	while AnInstance > 0 do
447	begin
448	AResponse := FindResponseByName('ORDERABLE', AnInstance);
449	if AResponse <> nil then
450	begin
451	sub := GetSubtype(AResponse.EValue);
452	if sub = 't' then
453	begin
454	SetControl(cboAvailTest, 'ORDERABLE', AnInstance);
455	ALabTest := TLabTest.Create(cboAvailTest.ItemID, Responses);
456	end
457	else
458	begin
459	SetControl(cboAvailComp, 'ORDERABLE', AnInstance);
460	ALabTest := TLabTest.Create(cboAvailComp.ItemID, Responses);
461	end;
462	if ALabTest = nil then Exit; // Causes access violation
463	if AnInstance = 1 then
464	begin
465	SetControl(cboReasons, 'REASON' , AnInstance);
466	SetControl(calWantTime, 'DATETIME', AnInstance);
467	SetControl(memDiagComment, 'COMMENT', AnInstance);
468	SetControl(chkConsent, 'YN', AnInstance);
469	//DetermineCollectionDefaults(Responses);
470	SetControl(cboCollType, 'COLLECT', AnInstance);
471	SetControl(cboCollTime, 'START', AnInstance);
472	SetupCollTimes(cboCollType.ItemID);
473	SetControl(cboUrgency, 'URGENCY', AnInstance);
474	SetControl(cboSurgery, 'MISC', AnInstance);
475	Urgency := cboUrgency.ItemIEN;
476	if (Urgency = 0) and (cboUrgency.Items.Count = 1) then
477	begin
478	cboUrgency.ItemIndex := 0;
479	Urgency := cboUrgency.ItemIEN;
480	end;
481	i := 1 ;
482	AResponse := Responses.FindResponseByName('COMMENT',i);
483	while AResponse <> nil do
484	begin
485	Comment.Add(AResponse.EValue);
486	Inc(i);
487	AResponse := Responses.FindResponseByName('COMMENT',i);
488	end ;
489	end;
490	if sub = 't' then with ALabTest do //DIAGNOSTIC TEST
491	begin
492	Changing := True;
493	DisableComponentControls;
494	EnableDiagTestControls;
495	LRORDERMODE := TORDER_MODE_DIAG;
496	aList.Clear;
497	aTestYes := '1';
498	ExtractTypeScreen(aList, uVBECList);
499	if aList.Count > 0 then aTypeScreen := aList[0];
500	aList.Clear;
501	with lvSelectionList do
502	begin
503	ListItem := Items.Add;
504	ListItem.Caption := piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',2);
505	ListItem.SubItems.Add('');
506	ListItem.SubItems.Add('');
507	ListItem.SubItems.Add('');
508	ListItem.SubItems.Add(piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1));
509	if piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1) = aTypeScreen then
510	begin
511	lblTNS.Caption := '';
512	lblTNS.Visible := false;
513	memMessage.Text := '';
514	pnlMessage.Visible := false;
515	uGetTnS := 0;
516	pnlDiagnosticTests.Caption := 'Diagnostic Tests';
517	end;
518	end;
519	aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + IntToStr(aLabTest.ItemID); //aSpecimen has 2 pieces additional pieces added for Tests
520	uSelectedItems.Add(aStr);
521	if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
522	{with cboCollType do if Length(ItemID) > 0 then
523	begin
524	Responses.Update('COLLECT', 1, ItemID, ItemID) ;
525	FLastCollType := ItemID;
526	end; }
527	if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
528	if Length(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
529	if Length(cboReasons.Text) > 0 then Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text);
530	LoadCollType(cboCollType);
531	if (cboCollType.ItemID = 'LC') or (cboCollType.ItemID = 'I') then
532	if not(ALabTest.LabCanCollect) and OrderForInpatient then
533	cboCollType.SelectByID('WC')
534	else if not(ALabTest.LabCanCollect) then
535	cboCollType.SelectByID('SP');
536	SetupCollTimes(cboCollType.ItemID);
537	if cboCollType.ItemID = 'LC' then
538	begin
539	with cboCollTime do
540	if Length(ItemID) > 0 then
541	begin
542	Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
543	FLastLabCollTime := ItemID + U + Text;
544	end
545	else if Length(Text) > 0 then
546	begin
547	Responses.Update('START', 1, ValidCollTime(Text), Text) ;
548	FLastLabCollTime := ValidCollTime(Text);
549	end;
550	end
551	else
552	begin
553	with calCollTime do
554	if FMDateTime > 0 then
555	begin
556	Responses.Update('START', 1, ValidCollTime(Text), Text);
557	FLastColltime := ValidCollTime(Text);
558	end
559	else
560	begin
561	Responses.Update('START', 1, '', '') ;
562	FLastCollTime := '';
563	end;
564	end;
565	with cboCollType do if Length(ItemID) > 0 then
566	begin
567	Responses.Update('COLLECT', 1, ItemID, ItemID) ;
568	FLastCollType := ItemID;
569	end;
570	//if Length(cboCollType.Text) > 0 then Responses.Update('COLLECT',1,cboCollType.ItemID,cboCollType.ItemID);
571	memOrder.Text := Responses.OrderText;
572	Changing := False;
573	if ObtainCollSamp then
574	begin
575	//For BloodBank orders, this condition should never occur
576	end
577	else
578	begin
579	with ALabTest do
580	with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
581	begin
582	x := '' ;
583	for i := 0 to WardComment.Count-1 do
584	x := x + WardComment.strings[i]+#13#10 ;
585	pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
586	OrderMessage(x) ;
587	end ;
588	end;
589	end;
590	if sub = 'c' then with ALabTest do //COMPONENT
591	begin
592	Changing := True;
593	DisableDiagTestControls;
594	EnableComponentControls;
595	aTestYes := '0';
596	LRORDERMODE := TORDER_MODE_COMP;
597	SetControl(cboModifiers, 'MODIFIER', AnInstance);
598	SetControl(tQuantity, 'QTY', AnInstance);
599	uComponentSelected := true;
600	aList.Clear;
601	TestAdded := 0;
602	getTest := 0;
603	ExtractTests(aList, uVBECList); //Get Results associated with ordered components
604	for j := 0 to aList.Count - 1 do
605	begin
606	if StrToInt(piece(aList[j],'^',1)) = aLabTest.ItemID then
607	begin
608	if uTestsForResults.Count < 1 then getTest := 1;
609	for k := 0 to uTestsForResults.Count - 1 do
610	begin
611	if piece(uTestsForResults[k],'^',1) = piece(aList[j],'^',3) then
612	begin
613	getTest := 0;
614	break;
615	end
616	else getTest := 1;
617	end;
618	if getTest = 1 then
619	begin
620	uTestsForResults.Add(piece(aList[j],'^',3));
621	TestAdded := 1;
622	end;
623	end;
624	end;
625	if TestAdded = 1 then
626	begin
627	edtResults.Clear;
628	aTests.Clear;
629	GetPatientBloodResults(aTests, Patient.DFN, uTestsForResults);
630	QuickCopy(ATests,edtResults);
631	if edtResults.Lines.Count > 0 then TabResults.Caption := 'Lab Results Available'; //TabResults.ImageIndex := 1;
632	uRaw.Clear;
633	GetPatientBloodResultsRaw(uRaw, Patient.DFN, uTestsForResults);
634	end;
635	CurAdd := 1;
636	if uRaw.Count > 0 then
637	for j := 0 to uRaw.Count - 1 do
638	begin
639	if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));
640	Inc(CurAdd);
641	end;
642	with lvSelectionList do
643	begin
644	ListItem := Items.Add;
645	ListItem.Caption := piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2);
646	ListItem.SubItems.Add(tQuantity.Text);
647	if length(cboModifiers.ItemID) > 0 then
648	begin
649	ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]);
650	ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex));
651	end
652	else
653	begin
654	ListItem.SubItems.Add('');
655	ListItem.SubItems.Add('');
656	end;
657	ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
658	end;
659	aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + IntToStr(aLabTest.ItemID); //aSpecimen has 2 pieces additional pieces added for Tests
660	uSelectedItems.Add(aStr);
661	memOrder.Text := Responses.OrderText;
662	Changing := False;
663	end;
664	end;
665	StatusText('');
666	AnInstance := NextInstance('ORDERABLE', AnInstance);
667	end; //while AnInstance - ORDERABLE
668	DisableComponentControls;
669	DisableDiagTestControls;
670	end;
671	CurAdd := 1;
672	for i := 0 to uSelectedItems.Count - 1 do
673	begin
674	aName := lvSelectionList.Items[i].Caption;
675	x := uSelectedItems[i];
676	if piece(x,'^',1) = '1' then //Diagnostic Test related fields
677	begin
678	if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
679	end
680	else
681	begin
682	if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
683	if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3));
684	if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), piece(x,'^',4));
685	if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5));
686	if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
687	if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
688	if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text)
689	else
690	begin
691	cboUrgency.ItemIndex := 1;
692	Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
693	cboUrgencyChange(self);
694	end;
695	end;
696	Inc(CurAdd);
697	end;
698	for i := 0 to lvSelectionList.Items.Count - 1 do
699	begin
700	if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then
701	begin
702	if uTNSOrders.Count > 0 then
703	begin
704	for j := 0 to uTNSOrders.Count - 1 do
705	aTNSString := aTNSString + CRLF + uTNSOrders[j];
706	with Application do
707	begin
708	NormalizeTopMosts;
709	aTNSDays := TNSDaysBack;
710	aTNS :=
711	MessageBox(PChar(aTNSString + CRLF + CRLF +
712	'Do you wish to continue with this request for Type & Screen?'),
713	PChar('Type & Screen Entered in Past ' + IntToStr(TNSDaysBack) + ' Days'),
714	MB_YESNO);
715	RestoreTopMosts;
716	if aTNS = 7 then
717	begin
718	lvSelectionList.ItemIndex := i;
719	lvSelectionListClick(self);
720	btnRemoveClick(self);
721	break;
722	end;
723	end;
724	end;
725	break;
726	end;
727	end;
728	{if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses, ALabTest do
729	begin
730	if OrderAction in [ORDER_QUICK, ORDER_EDIT] then uQuickInProcess := 1;
731	AnInstance := NextInstance('ORDERABLE', 0);
732	while AnInstance > 0 do
733	begin
734	AResponse := FindResponseByName('ORDERABLE', AnInstance);
735	if AResponse <> nil then
736	begin
737	sub := GetSubtype(AResponse.EValue);
738	if sub = 't' then
739	begin
740	SetControl(cboAvailTest, 'ORDERABLE', AnInstance);
741	ALabTest := TLabTest.Create(cboAvailTest.ItemID, Responses);
742	end
743	else
744	begin
745	SetControl(cboAvailComp, 'ORDERABLE', AnInstance);
746	ALabTest := TLabTest.Create(cboAvailComp.ItemID, Responses);
747	end;
748	//SetControl(cboTests, 'ORDERABLE', AnInstance);
749	//ALabTest := TLabTest.Create(cboTests.ItemID, Responses);
750	if ALabTest = nil then Exit; // Causes access violation
751	//sub := GetSubtype(ALabTest.TestName);
752	if AnInstance = 1 then
753	begin
754	DetermineCollectionDefaults(Responses);
755	SetControl(cboReasons, 'REASON', AnInstance);
756	SetControl(chkConsent, 'YN', AnInstance);
757	SetControl(cboSurgery, 'MISC', AnInstance);
758	//SetControl(cboCollType, 'COLLECT', AnInstance);
759	//SetControl(cboCollTime, 'START', AnInstance);
760	SetControl(calWantTime, 'DATETIME', AnInstance);
761	//LoadUrgency(cboCollType.ItemID, cboUrgency);
762	SetControl(cboUrgency, 'URGENCY', AnInstance);
763	Urgency := cboUrgency.ItemIEN;
764	if (Urgency = 0) and (cboUrgency.Items.Count = AnInstance) then
765	begin
766	cboUrgency.ItemIndex := 0;
767	Urgency := cboUrgency.ItemIEN;
768	end;
769	i := 1 ;
770	AResponse := Responses.FindResponseByName('COMMENT',i);
771	while AResponse <> nil do
772	begin
773	if Length(AResponse.Evalue) > 0 then
774	Comment.Add(AResponse.EValue);
775	Inc(i);
776	AResponse := Responses.FindResponseByName('COMMENT',i);
777	end ;
778	end;
779	if sub = 't' then with ALabTest do //DIAGNOSTIC TEST
780	begin
781	Changing := True;
782	DisableComponentControls;
783	EnableDiagTestControls;
784	LRORDERMODE := TORDER_MODE_DIAG;
785	with Responses do
786	begin
787	StatusText('Initializing Order');
788	AResponse := FindResponseByName('ORDERABLE', AnInstance);
789	if AResponse <> nil then
790	sub1 := GetSubtype(AResponse.EValue);
791	if sub1 = 't' then
792	begin
793	SetControl(cboAvailTest, 'ORDERABLE', AnInstance);
794	//SetControl(cboTests, 'ORDERABLE', AnInstance);
795	//DetermineCollectionDefaults(Responses); //cboCollType = COLLECT , calCollTime = START
796	cboAvailTestSelect(self);
797	end;
798	end;
799	Changing := False;
800	if ObtainCollSamp then
801	begin
802	//For BloodBank orders, this condition should never occur
803	end
804	else
805	begin
806	with ALabTest do
807	with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
808	begin
809	x := '' ;
810	for i := 0 to WardComment.Count-1 do
811	x := x + WardComment.strings[i]+#13#10 ;
812	pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
813	OrderMessage(x) ;
814	end ;
815	end;
816	end;
817	if sub = 'c' then with ALabTest do //COMPONENT
818	begin
819	Changing := True;
820	DisableDiagTestControls;
821	EnableComponentControls;
822	LRORDERMODE := TORDER_MODE_COMP;
823	with Responses do
824	begin
825	StatusText('Initializing Order');
826	AResponse := FindResponseByName('ORDERABLE', AnInstance);
827	if AResponse <> nil then
828	sub1 := GetSubtype(AResponse.EValue);
829	if sub1 = 'c' then
830	begin
831	SetControl(cboAvailComp, 'ORDERABLE', AnInstance);
832	//SetControl(cboTests, 'ORDERABLE', AnInstance);
833	SetControl(cboModifiers, 'MODIFIER', AnInstance);
834	SetControl(tQuantity, 'QTY', AnInstance);
835	//DetermineCollectionDefaults(Responses);
836	cboAvailCompSelect(self);
837	end;
838	end;
839	Changing := False;
840	end;
841	with ALabTest do
842	begin
843	if ObtainComment then
844	LoadRequiredComment(FCmtTypes.IndexOf(CurReqComment))
845	else
846	DisableCommentPanels;
847	x := '' ;
848	for i := 0 to CurWardComment.Count-1 do
849	x := x + CurWardComment.strings[i]+#13#10 ;
850	i := IndexOfCollSamp(CollSamp);
851	if i > -1 then with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
852	for i := 0 to WardComment.Count-1 do
853	x := x + WardComment.strings[i]+#13#10 ;
854	pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
855	if Length(x) > 0 then
856	begin
857	OrderMessage(x) ;
858	end;
859	end;
860	StatusText('');
861	Changing := True;
862	//if not(FOrderAction = ORDER_EDIT) then DetermineCollectionDefaults(Responses);
863	Changing := False;
864	end;
865	AnInstance := NextInstance('ORDERABLE', AnInstance);
866	end; //while AnInstance - ORDERABLE
867	DisableComponentControls;
868	DisableDiagTestControls;
869	uQuickInProcess := 0;
870	end; }
871	finally
872	aList.Free;
873	aTests.Free;
874	end;
875	edtResults.Height := 247;
876	edtInfo.Height := 247;
877	if lvSelectionList.Items.Count > 0 then
878	begin
879	pnlSelectedTests.Visible := True;
880	cmdAccept.Visible := True;
881	memOrder.Visible := True;
882	GroupBox1.Visible := False;
883	end;
884	end;
885
886	procedure TfrmODBBank.SetOnQuickOrder;
887	var
888	AnInstance: Integer;
889	AResponse: TResponse;
890	i: integer;
891	x,sub,sub1,aTNSString: string;
892	aList: TStringList;
893	aGotIt: boolean;
894	aTests: TStringList;
895	ListItem: TListItem;
896	aName, aMsg, aStr, aModifier, aReason, aSurgery, aCollTime, aTestYes, aSpecimen, aTypeScreen: String;
897	CurAdd, j, k, getTest, TestAdded, aMSBOS, aMSBOSContinue, aTNS, aTNSDays: Integer;
898	begin
899	inherited;
900	aList := TStringList.Create;
901	aTests := TStringList.Create;
902	try
903	aModifier := '';
904	aReason := '';
905	aSurgery := '';
906	aCollTime := '';
907	aTestYes := '0';
908	aTypeScreen := '';
909	aSpecimen := '';
910	sub1 := '';
911	ExtractTypeScreen(aList, uVBECList);
912	if aList.Count > 0 then aTypeScreen := aList[0];
913	aList.Clear;
914	Extractspecimen(aList, uVBECList);
915	if aList.Count > 0 then aSpecimen := aList[0];
916	with Responses, ALabTest do
917	begin
918	Changing := True;
919	aGotIt := False;
920	FLastItemID := cboQuick.ItemID;
921	QuickOrder := ExtractInteger(cboQuick.ItemID);
922	with Responses do
923	begin
924	StatusText('Initializing Quick Order');
925	AnInstance := NextInstance('ORDERABLE', 0);
926	while AnInstance > 0 do
927	begin
928	AResponse := FindResponseByName('ORDERABLE', AnInstance);
929	sub := GetSubtype(AResponse.EValue);
930	if sub = 't' then
931	begin
932	SetControl(cboAvailTest, 'ORDERABLE', AnInstance);
933	ALabTest := TLabTest.Create(cboAvailTest.ItemID, Responses);
934	end
935	else
936	begin
937	SetControl(cboAvailComp, 'ORDERABLE', AnInstance);
938	ALabTest := TLabTest.Create(cboAvailComp.ItemID, Responses);
939	end;
940	for i := 0 to aList.Count - 1 do
941	if aList[i] = ALabTest.TestName then
942	begin
943	aGotIt := true;
944	break;
945	end;
946	if aGotIt = true then
947	begin
948	aGotIt := false;
949	AnInstance := NextInstance('ORDERABLE', AnInstance);
950	Continue;
951	end
952	else
953	begin
954	aList.Add(ALabTest.TestName);
955	end;
956	if AResponse <> nil then
957	sub1 := GetSubtype(AResponse.EValue);
958	if AnInstance = 1 then
959	begin
960	SetControl(cboReasons, 'REASON', AnInstance);
961	SetControl(calWantTime, 'DATETIME', AnInstance);
962	SetControl(memDiagComment, 'COMMENT', AnInstance);
963	SetControl(chkConsent, 'YN', AnInstance);
964	//DetermineCollectionDefaults(Responses);
965	SetControl(cboCollType, 'COLLECT', AnInstance);
966	SetupCollTimes(cboCollType.ItemID);
967	//SetControl(cboCollTime, 'START', AnInstance);
968	//LoadUrgency(cboCollType.ItemID, cboUrgency);
969	SetControl(cboUrgency, 'URGENCY', AnInstance);
970	Urgency := cboUrgency.ItemIEN;
971	if (Urgency = 0) and (cboUrgency.Items.Count = AnInstance) then
972	begin
973	cboUrgency.ItemIndex := 0;
974	Urgency := cboUrgency.ItemIEN;
975	cboUrgencyChange(self);
976	end;
977	SetControl(cboSurgery, 'MISC', AnInstance);
978	if not(ALabTest = nil) then
979	begin
980	Urgency := cboUrgency.ItemIEN;
981	if (Urgency = 0) and (cboUrgency.Items.Count = 1) then
982	begin
983	cboUrgency.ItemIndex := 0;
984	Urgency := cboUrgency.ItemIEN;
985	end;
986	i := 1 ;
987	AResponse := Responses.FindResponseByName('COMMENT',i);
988	while AResponse <> nil do
989	begin
990	Comment.Add(AResponse.EValue);
991	Inc(i);
992	AResponse := Responses.FindResponseByName('COMMENT',i);
993	end ;
994	end;
995	if not(cboCollType.ItemID = 'LC') then
996	begin
997	if Length(cboCollTime.Text) > 0 then
998	begin
999	calCollTime.FMDateTime := StrToFMDateTime(cboCollTime.Text);
1000	FLastCollTime := cboCollTime.Text;
1001	end
1002	else
1003	begin
1004	FLastCollTime := '';
1005	end;
1006	end;
1007	end;
1008	if sub1 = 'c' then
1009	begin
1010	DisableDiagTestControls;
1011	EnableComponentControls;
1012	LRORDERMODE := TORDER_MODE_COMP;
1013	SetControl(cboAvailComp, 'ORDERABLE', AnInstance);
1014	SetControl(cboModifiers, 'MODIFIER', AnInstance);
1015	SetControl(tQuantity, 'QTY', AnInstance);
1016	//DetermineCollectionDefaults(Responses);
1017	//Check for and display any associated Lab Results
1018	aList.Clear;
1019	TestAdded := 0;
1020	getTest := 0;
1021	ExtractTests(aList, uVBECList); //Get Results associated with ordered components
1022	for j := 0 to aList.Count - 1 do
1023	begin
1024	if StrToInt(piece(aList[j],'^',1)) = aLabTest.ItemID then
1025	begin
1026	if uTestsForResults.Count < 1 then getTest := 1;
1027	for k := 0 to uTestsForResults.Count - 1 do
1028	begin
1029	if piece(uTestsForResults[k],'^',1) = piece(aList[j],'^',3) then
1030	begin
1031	getTest := 0;
1032	break;
1033	end
1034	else getTest := 1;
1035	end;
1036	if getTest = 1 then
1037	begin
1038	uTestsForResults.Add(piece(aList[j],'^',3));
1039	TestAdded := 1;
1040	end;
1041	end;
1042	end;
1043	if TestAdded = 1 then
1044	begin
1045	edtResults.Clear;
1046	aTests.Clear;
1047	GetPatientBloodResults(aTests, Patient.DFN, uTestsForResults);
1048	QuickCopy(ATests,edtResults);
1049	if edtResults.Lines.Count > 0 then TabResults.Caption := 'Lab Results Available'; //TabResults.ImageIndex := 1;
1050	uRaw.Clear;
1051	GetPatientBloodResultsRaw(uRaw, Patient.DFN, uTestsForResults);
1052	end;
1053	CurAdd := 1;
1054	if uRaw.Count > 0 then
1055	for j := 0 to uRaw.Count - 1 do
1056	begin
1057	if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));
1058	Inc(CurAdd);
1059	end;
1060	aSpecimen := '^';
1061	aTestYes := '0';
1062	aReason := '';
1063	aSurgery := '';
1064	aCollTime := '';
1065	ExtractSpecimen(aList, uVBECList);
1066	if aList.Count > 0 then aSpecimen := aList[0];
1067	if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex];
1068	if length(cboReasons.ItemID) > 0 then aReason := cboReasons.Items[cboReasons.ItemIndex];
1069	if length(cboSurgery.ItemID) > 0 then aSurgery := cboSurgery.Items[cboSurgery.ItemIndex];
1070	if length(cboCollTime.ItemID) > 0 then aCollTime := cboCollTime.Items[cboCollTime.ItemIndex];
1071	if Length(cboSurgery.ItemID) > 0 then
1072	begin
1073	aList.Clear;
1074	ExtractMSBOS(aList, uVBECList); //Get maximum units for selected Surgey
1075	for i := 0 to aList.Count - 1 do
1076	begin
1077	if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
1078	and (piece(aList[i],'^',3) = cboSurgery.Text) then
1079	begin
1080	aMSBOS := StrToInt(piece(aList[i],'^',4));
1081	if (aMSBOS > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then
1082	begin
1083	with Application do
1084	begin
1085	NormalizeTopMosts;
1086	aMSBOSContinue :=
1087	MessageBox(PChar('The number of units ordered (' + tQuantity.Text +
1088	') for ' + aLabTest.TestName + ' exceeds the maximum number of units ('
1089	+ IntToStr(aMSBOS) +
1090	') for the ' + cboSurgery.text +
1091	' surgical procedure selected.' + CRLF + CRLF + 'Do you wish to continue?'),
1092	PChar('Maximum Number of Units Exceeded'),
1093	MB_YESNO);
1094	RestoreTopMosts;
1095	end;
1096	if aMSBOSContinue = 7 then
1097	begin
1098	ShowMsg(cboAvailComp.Text + ' has NOT been added to this request.');
1099	exit;
1100	end;
1101	end;
1102	end;
1103	end;
1104	end;
1105	if (uTNSOrders.Count < 1) then //SpecimenNeeded(aList, uVBECList, aLabTest.ItemID) then //check to see if type and screen is needed
1106	begin
1107	uGetTnS := 1;
1108	end;
1109	aList.Clear;
1110	ExtractSpecimens(aList, uVBECList); //Get specimen values to pass back to Server
1111	for i := 0 to aList.Count - 1 do
1112	begin
1113	if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) then
1114	begin
1115	aSpecimen := piece(aList[i],'^',2) + '^' + aSpecimen;
1116	break;
1117	end;
1118	end;
1119	uComponentSelected := true;
1120	with lvSelectionList do
1121	begin
1122	ListItem := Items.Add;
1123	ListItem.Caption := piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2);
1124	ListItem.SubItems.Add(tQuantity.Text);
1125	if length(cboModifiers.ItemID) > 0 then
1126	begin
1127	ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]);
1128	ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex));
1129	end
1130	else
1131	begin
1132	ListItem.SubItems.Add('');
1133	ListItem.SubItems.Add('');
1134	end;
1135	ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
1136	end;
1137	CurAdd := 1;
1138	aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + IntToStr(aLabTest.ItemID); //aSpecimen has 2 pieces additional pieces added for Tests
1139	uSelectedItems.Add(aStr);
1140	for i := 0 to uSelectedItems.Count - 1 do
1141	begin
1142	aName := lvSelectionList.Items[i].Caption;
1143	x := uSelectedItems[i];
1144	if piece(x,'^',1) = '1' then //Diagnostic Test related fields
1145	begin
1146	if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
1147	end
1148	else
1149	begin
1150	if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
1151	if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3));
1152	if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), aModifier);
1153	if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5));
1154	if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
1155	end;
1156	Inc(CurAdd);
1157	end;
1158	memOrder.Text := Responses.OrderText;
1159	GroupBox1.Visible := False;
1160	aMsg := '';
1161	LRORDERMODE := TORDER_MODE_INFO;
1162	{if uGetTnS = 1 then
1163	begin
1164	lblTNS.Caption := 'TYPE + SCREEN must be added to order';
1165	lblTNS.Visible := true;
1166	memMessage.Text := 'TYPE + SCREEN must be added to order';
1167	memMessage.Visible := false;
1168	pnlMessage.Visible := true;
1169	pnlDiagnosticTests.Caption := 'Diagnostic Tests*';
1170	end; }
1171	{if uGetTnS = 1 then
1172	begin
1173	if responses.QuickOrder < 1 then
1174	begin
1175	for i := 1 to cboAvailTest.Items.Count - 1 do
1176	begin
1177	if piece(cboAvailTest.Items[i],'^',1) = aTypeScreen then
1178	begin
1179	if piece(aSpecimen,'^',1) = '1' then
1180	begin
1181	cboCollTime.Text := calWantTime.Text;
1182	aCollSave := cboCollTime.Text + '^' + cboCollTime.ItemID + '^' + cboCollType.Text + '^' + cboCollType.ItemID;
1183	cboCollTime.Text := '';
1184	cboCollType.Text := '';
1185	uSpecimen := 1;
1186	end;
1187	cboModifiers.Text := '';
1188	cboAvailTest.SelectByID(aTypeScreen);
1189	cboTests.SelectByID(aTypeScreen);
1190	cboTestsClick(self);
1191	//cboAvailTestSelect(Self);
1192	uSpecimen := 0;
1193	cboCollTime.Text := piece(aCollSave,'^',1);
1194	cboCollType.Text := piece(aCollSave,'^',3);
1195	aCollSave := '';
1196	break;
1197	end;
1198	end;
1199	aMsg := 'An order for Type and Screen has been added to this request' + '.';
1200	end
1201	else
1202	begin
1203	lblTNS.Caption := 'TYPE + SCREEN must be added to order';
1204	lblTNS.Visible := true;
1205	memMessage.Text := 'TYPE + SCREEN must be added to order';
1206	memMessage.Visible := false;
1207	pnlMessage.Visible := true;
1208	end;
1209	end;
1210	if (uGetTnS = 1) then
1211	begin
1212	if length(aMsg) > 0 then aMsg := aMsg + crlf + crlf;
1213	ShowMsg(aMsg);
1214	end; }
1215
1216	//cboModifiers.Text := '';
1217	edtResults.Height := 247;
1218	edtInfo.Height := 247;
1219	if lvSelectionList.Items.Count > 0 then
1220	begin
1221	pnlSelectedTests.Visible := True;
1222	cmdAccept.Visible := True;
1223	memOrder.Visible := True;
1224	GroupBox1.Visible := False;
1225	end;
1226	end
1227	else
1228	begin
1229	if sub1 = 't' then
1230	begin
1231	DisableComponentControls;
1232	EnableDiagTestControls;
1233	LRORDERMODE := TORDER_MODE_DIAG;
1234	aTestYes := '1';
1235	SetControl(cboAvailTest, 'ORDERABLE', AnInstance);
1236	//DetermineCollectionDefaults(Responses); //cboCollType = COLLECT , calCollTime = START
1237	i := 1 ;
1238	AResponse := Responses.FindResponseByName('COMMENT',i);
1239	while AResponse <> nil do
1240	begin
1241	Comment.Add(AResponse.EValue);
1242	Inc(i);
1243	AResponse := Responses.FindResponseByName('COMMENT',i);
1244	end ;
1245	if ObtainCollSamp then
1246	begin
1247	//For BloodBank orders, this condition should never occur
1248	end
1249	else
1250	begin
1251	with ALabTest do
1252	with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
1253	begin
1254	x := '' ;
1255	for i := 0 to WardComment.Count-1 do
1256	x := x + WardComment.strings[i]+#13#10 ;
1257	pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
1258	OrderMessage(x) ;
1259	end ;
1260	end;
1261	if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
1262	with cboCollType do if Length(ItemID) > 0 then
1263	begin
1264	Responses.Update('COLLECT', 1, ItemID, ItemID) ;
1265	FLastCollType := ItemID;
1266	end;
1267	if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text)
1268	else
1269	begin
1270	cboUrgency.ItemIndex := 1;
1271	Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
1272	cboUrgencyChange(self);
1273	end;
1274	if Length(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
1275	if Length(cboReasons.Text) > 0 then Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text);
1276	LoadCollType(cboCollType);
1277	if (cboCollType.ItemID = 'LC') or (cboCollType.ItemID = 'I') then
1278	if not(ALabTest.LabCanCollect) and OrderForInpatient then
1279	cboCollType.SelectByID('WC')
1280	else if not(ALabTest.LabCanCollect) then
1281	cboCollType.SelectByID('SP');
1282	SetupCollTimes(cboCollType.ItemID);
1283	if cboCollType.ItemID = 'LC' then
1284	begin
1285	with cboCollTime do
1286	if Length(ItemID) > 0 then
1287	begin
1288	Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
1289	FLastLabCollTime := ItemID + U + Text;
1290	end
1291	else if Length(Text) > 0 then
1292	begin
1293	Responses.Update('START', 1, ValidCollTime(Text), Text) ;
1294	FLastLabCollTime := ValidCollTime(Text);
1295	end;
1296	end
1297	else
1298	begin
1299	with calCollTime do
1300	if FMDateTime > 0 then
1301	begin
1302	Responses.Update('START', 1, ValidCollTime(Text), Text);
1303	FLastColltime := ValidCollTime(Text);
1304	end
1305	else
1306	begin
1307	Responses.Update('START', 1, '', '') ;
1308	FLastCollTime := '';
1309	end;
1310	end;
1311	if length(cboCollTime.ItemID) > 0 then aCollTime := cboCollTime.Items[cboCollTime.ItemIndex];
1312	with cboCollType do if Length(ItemID) > 0 then
1313	begin
1314	Responses.Update('COLLECT', 1, ItemID, ItemID) ;
1315	FLastCollType := ItemID;
1316	end;
1317	uTestSelected := true;
1318	with lvSelectionList do
1319	begin
1320	ListItem := Items.Add;
1321	ListItem.Caption := piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',2);
1322	ListItem.SubItems.Add('');
1323	ListItem.SubItems.Add('');
1324	ListItem.SubItems.Add('');
1325	ListItem.SubItems.Add(piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1));
1326	end;
1327	CurAdd := 1;
1328	aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + aCollTime + '^' + cboCollType.Text + '^' + IntToStr(aLabTest.ItemID); //aSpecimen has 2 pieces
1329	uSelectedItems.Add(aStr);
1330	for i := 0 to uSelectedItems.Count - 1 do
1331	begin
1332	aName := lvSelectionList.Items[i].Caption;
1333	x := uSelectedItems[i];
1334	if piece(x,'^',1) = '1' then //Diagnostic Test related fields
1335	begin
1336	if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
1337	end;
1338	Inc(CurAdd);
1339	end;
1340	memOrder.Text := Responses.OrderText;
1341	edtResults.Height := 247;
1342	edtInfo.Height := 247;
1343	if lvSelectionList.Items.Count > 0 then
1344	begin
1345	pnlSelectedTests.Visible := True;
1346	cmdAccept.Visible := True;
1347	memOrder.Visible := True;
1348	GroupBox1.Visible := False;
1349	end;
1350	end;
1351	end;
1352	AnInstance := NextInstance('ORDERABLE', AnInstance);
1353	end;
1354	//Quick Order
1355	end;
1356	for i := 0 to lvSelectionList.Items.Count - 1 do
1357	begin
1358	if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then
1359	begin
1360	uGetTnS := 0;
1361	uDfltUrgency := cboUrgency.ItemID;
1362	lblTNS.Caption := '';
1363	lblTNS.Visible := false;
1364	memMessage.Text := '';
1365	pnlMessage.Visible := false;
1366	pnlDiagnosticTests.Caption := 'Diagnostic Tests';
1367	if uTNSOrders.Count > 0 then
1368	begin
1369	for j := 0 to uTNSOrders.Count - 1 do
1370	aTNSString := aTNSString + CRLF + uTNSOrders[j];
1371	with Application do
1372	begin
1373	NormalizeTopMosts;
1374	aTNSDays := TNSDaysBack;
1375	aTNS :=
1376	MessageBox(PChar(aTNSString + CRLF + CRLF +
1377	'Do you wish to continue with this request for Type & Screen?'),
1378	PChar('Type & Screen Entered in Past ' + IntToStr(TNSDaysBack) + ' Days'),
1379	MB_YESNO);
1380	RestoreTopMosts;
1381	if aTNS = 7 then
1382	begin
1383	lvSelectionList.ItemIndex := i;
1384	lvSelectionListClick(self);
1385	btnRemoveClick(self);
1386	break;
1387	end;
1388	end;
1389	end;
1390	break;
1391	end;
1392	end;
1393	if uGetTnS = 1 then
1394	begin
1395	lblTNS.Caption := 'TYPE + SCREEN must be added to order';
1396	lblTNS.Visible := true;
1397	memMessage.Text := 'TYPE + SCREEN must be added to order';
1398	pnlMessage.Visible := true;
1399	pnlDiagnosticTests.Caption := 'Diagnostic Tests*';
1400	end;
1401	if ALabTest <> nil then
1402	begin
1403	if ObtainCollSamp then
1404	begin
1405	//For BloodBank orders, this condition should never occur
1406	end
1407	else
1408	begin
1409	with ALabTest do
1410	with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
1411	begin
1412	x := '' ;
1413	for i := 0 to WardComment.Count-1 do
1414	x := x + WardComment.strings[i]+#13#10 ;
1415	pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
1416	OrderMessage(x) ;
1417	end ;
1418	end;
1419	with ALabTest do
1420	begin
1421	if ObtainComment then
1422	LoadRequiredComment(FCmtTypes.IndexOf(CurReqComment))
1423	else
1424	DisableCommentPanels;
1425	x := '' ;
1426	for i := 0 to CurWardComment.Count-1 do
1427	x := x + CurWardComment.strings[i]+#13#10 ;
1428	i := IndexOfCollSamp(CollSamp);
1429	if i > -1 then with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
1430	for i := 0 to WardComment.Count-1 do
1431	x := x + WardComment.strings[i]+#13#10 ;
1432	pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
1433	OrderMessage(x) ;
1434	end;
1435	GroupBox1.Visible := False;
1436	end;
1437	StatusText('');
1438	Changing := False;
1439	end;
1440	finally //**SubTest
1441	alist.Free;
1442	aTests.Free;
1443	end;
1444	end;
1445
1446	constructor TLabTest.Create(const LabTestIEN: string; Responses: TResponses);
1447	var
1448	LoadData, OneSamp: TStringList;
1449	DfltCollSamp: Integer;
1450	x: string;
1451	tmpResp: TResponse;
1452	begin
1453	LoadData := TStringList.Create;
1454	try
1455	LoadLabTestData(LoadData, LabTestIEN) ;
1456	with LoadData do
1457	begin
1458	QuickOrderResponses := Responses;
1459	TestID := StrToInt(LabTestIEN);
1460	TestName := Piece(ExtractDefault(LoadData, 'Test Name'),U,1);
1461	ItemID := StrToInt(Piece(ExtractDefault(LoadData, 'Item ID'),U,1));
1462	LabSubscript := Piece(ExtractDefault(LoadData, 'Item ID'),U,2);
1463	TestReqComment := ExtractDefault(LoadData, 'ReqCom');
1464	UniqueCollSamp := false;
1465	if Length(ExtractDefault(LoadData, 'Unique CollSamp')) > 0 then UniqueCollSamp := True;
1466	x := ExtractDefault(LoadData, 'Unique CollSamp');
1467	if Length(x) = 0 then x := ExtractDefault(LoadData, 'Lab CollSamp');
1468	if Length(x) = 0 then x := ExtractDefault(LoadData, 'Default CollSamp');
1469	if Length(x) = 0 then x := '-1';
1470	DfltCollSamp := StrToInt(x);
1471	SpecimenList := TStringList.Create;
1472	ExtractItems(SpecimenList, LoadData, 'Specimens');
1473	if LRFSPEC <> '' then SpecimenList.Add(GetOneSpecimen(StrToInt(LRFSPEC)));
1474	UrgencyList := TStringList.Create;
1475	if Length(ExtractDefault(LoadData, 'Default Urgency')) > 0 then { forced urgency }
1476	begin
1477	ForceUrgency := True;
1478	UrgencyList.Add(ExtractDefault(LoadData, 'Default Urgency'));
1479	Urgency := StrToInt(Piece(ExtractDefault(LoadData, 'Default Urgency'), '^', 1));
1480	uDfltUrgency := Urgency;
1481	end
1482	else
1483	begin { list of urgencies }
1484	ExtractItems(UrgencyList, LoadData, 'Urgencies');
1485	if StrToIntDef(LRFURG, 0) > 0 then
1486	Urgency := StrToInt(LRFURG)
1487	else
1488	Urgency := uDfltUrgency;
1489	end;
1490	Comment := TStringList.Create ;
1491	CurWardComment := TStringList.Create;
1492	ExtractText(CurWardComment, LoadData, 'GenWardInstructions');
1493	CollSamp := 0;
1494	CollSampList := TList.Create;
1495	FillCollSampList(LoadData, DfltCollSamp);
1496	with QuickOrderResponses do tmpResp := FindResponseByName('SAMPLE' ,1);
1497	if (LRFSAMP <> '') and (IndexOfCollSamp(StrToInt(LRFSAMP)) < 0) and
1498	(not UniqueCollSamp) and (tmpResp = nil) then
1499	begin
1500	OneSamp := TStringList.Create;
1501	try
1502	FastAssign(GetOneCollSamp(StrToInt(LRFSAMP)), OneSamp);
1503	FillCollSampList(OneSamp, CollSampList.Count);
1504	finally
1505	OneSamp.Free;
1506	end;
1507	end;
1508	if (not UniqueCollSamp) and (CollSampList.Count = 0) then LoadAllSamples;
1509	CollSampCount := CollSampList.Count;
1510	end;
1511	finally
1512	LoadData.Free;
1513	end;
1514	SetCollSampDflts;
1515	end;
1516
1517	destructor TLabTest.Destroy;
1518	var
1519	i: Integer;
1520	begin
1521	if CollSampList <> nil then
1522	with CollSampList do for i := 0 to Count - 1 do
1523	with TCollSamp(Items[i]) do
1524	begin
1525	WardComment.Free;
1526	Free;
1527	end;
1528	CollSampList.Free;
1529	SpecimenList.Free;
1530	UrgencyList.Free;
1531	CurWardComment.Free;
1532	Comment.Free;
1533	inherited Destroy;
1534	end;
1535
1536	function TLabTest.IndexOfCollSamp(CollSampIEN: Integer): Integer;
1537	var
1538	i: Integer;
1539	begin
1540	Result := -1;
1541	with CollSampList do for i := 0 to Count - 1 do with TCollSamp(Items[i]) do
1542	if CollSampIEN = CollSampID then
1543	begin
1544	Result := i;
1545	break;
1546	end;
1547	end;
1548
1549	procedure TLabTest.LoadAllSamples;
1550	var
1551	LoadList, SpecList: TStringList;
1552	i: Integer;
1553	begin
1554	LoadList := TStringList.Create;
1555	SpecList := TStringList.Create;
1556	try
1557	LoadSamples(LoadList) ;
1558	FillCollSampList(LoadList, 0);
1559	ExtractItems(SpecList, LoadList, 'Specimens');
1560	with SpecList do for i := 0 to Count - 1 do
1561	if SpecimenList.IndexOf(Strings[i]) = -1 then SpecimenList.Add(Strings[i]);
1562	finally
1563	LoadList.Free;
1564	SpecList.Free;
1565	end;
1566	end;
1567
1568	procedure TLabTest.FillCollSampList(LoadData: TStringList; DfltCollSamp: Integer);
1569	{1 2 3 4 5 6 7 8 9 10 }
1570	{n^IEN^CollSampName^SpecIEN^TubeTop^MinInterval^MaxPerDay^LabCollect^SampReqCommentIEN;name^SpecName}
1571	var
1572	i, LastListItem, AnIndex: Integer;
1573	ACollSamp: TCollSamp;
1574	LabCollSamp: Integer;
1575	begin
1576	i := -1;
1577	if CollSampList = nil then CollSampList := TList.Create;
1578	LastListItem := CollSampList.Count ;
1579	LabCollSamp := StrToIntDef(ExtractDefault(LoadData, 'Lab CollSamp'), 0);
1580	repeat Inc(i) until (i = LoadData.Count) or (LoadData[i] = '~CollSamp');
1581	Inc(i);
1582	if i < LoadData.Count then repeat
1583	if LoadData[i][1] = 'i' then
1584	begin
1585	ACollSamp := TCollSamp.Create;
1586	with ACollSamp do
1587	begin
1588	AnIndex := StrToIntDef(Copy(Piece(LoadData[i], '^', 1), 2, 999), -1);
1589	CollSampID := StrToInt(Piece(LoadData[i], '^', 2));
1590	CollSampName := Piece(LoadData[i], '^', 3);
1591	SpecimenID := StrToIntDef(Piece(LoadData[i], '^', 4), 0);
1592	SpecimenName := Piece(LoadData[i], '^', 10);
1593	TubeColor := Piece(LoadData[i], '^', 5);
1594	MinInterval := StrToIntDef(Piece(LoadData[i], '^', 6), 0);
1595	MaxPerDay := StrToIntDef(Piece(LoadData[i], '^', 7), 0);
1596	LabCanCollect := AnIndex = LabCollSamp;
1597	SampReqComment := Piece(LoadData[i], '^', 9);
1598	WardComment := TStringList.Create;
1599	if CollSampID = StrToIntDef(LRFSAMP, 0) then
1600	CollSamp := CollSampID
1601	else if AnIndex = DfltCollSamp then
1602	CollSamp := CollSampID;
1603	end; {with}
1604	LastListItem := CollSampList.Add(ACollSamp);
1605	end; {if}
1606	if (LoadData[i][1] = 't') then
1607	TCollSamp(CollSampList.Items[LastListItem]).WardComment.Add(Copy(LoadData[i], 2, 255));
1608	Inc(i);
1609	until (i = LoadData.Count) or (LoadData[i][1] = '~');
1610	end;
1611
1612	procedure TLabTest.SetCollSampDflts;
1613	var
1614	tmpResp: TResponse;
1615	begin
1616	Specimen := 0;
1617	Comment.Clear;
1618	CurReqComment := TestReqComment;
1619	if CollSamp = 0 then Exit;
1620	with QuickOrderResponses do tmpResp := FindResponseByName('SPECIMEN' ,1);
1621	if (LRFSPEC <> '') and (tmpResp = nil) then
1622	ChangeSpecimen(LRFSPEC)
1623	else with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
1624	begin
1625	Specimen := SpecimenID;
1626	if SampReqcomment <> '' then CurReqComment := SampReqComment;
1627	end;
1628	end;
1629
1630	procedure TLabTest.ChangeCollSamp(CollSampIEN: Integer);
1631	begin
1632	CollSamp := CollSampIEN;
1633	SetCollSampDflts;
1634	end;
1635
1636	procedure TLabTest.ChangeSpecimen(const SpecimenIEN: string);
1637	begin
1638	Specimen := StrToIntDef(SpecimenIEN,0);
1639	end;
1640
1641	procedure TLabTest.ChangeComment(const CommentText: string);
1642	begin
1643	Comment.Add(CommentText);
1644	end;
1645
1646	function TLabTest.LabCanCollect: Boolean;
1647	var
1648	i: Integer;
1649	begin
1650	Result := False;
1651	i := IndexOfCollSamp(CollSamp);
1652	if i > -1 then with TCollSamp(CollSampList.Items[i]) do Result := LabCanCollect;
1653	end;
1654
1655	procedure TLabTest.LoadCollSamp(AComboBox: TORComboBox);
1656	{ loads the collection sample combo box, expects CollSamp to already be set to default }
1657	var
1658	i: Integer;
1659	x: string;
1660	begin
1661	AComboBox.Clear;
1662	with CollSampList do for i := 0 to Count - 1 do with TCollSamp(Items[i]) do
1663	begin
1664	x := IntToStr(CollSampID) + '^' + CollSampName;
1665	if Length(TubeColor) <> 0 then x := x + ' (' + TubeColor + ')';
1666	AComboBox.Items.Add(x);
1667	if CollSamp = CollSampID then AComboBox.ItemIndex := i;
1668	end;
1669	if ((ALabTest.LabSubscript = 'CH') and (not UserHasLRLABKey)) then
1670	begin
1671	// do not add 'Other' (coded this way for clarity)
1672	end
1673	else
1674	with AComboBox do
1675	begin
1676	Items.Add('0^Other...');
1677	if ItemIndex < 0 then ItemIndex := Items.IndexOf('Other...');
1678	end;
1679	end;
1680
1681	procedure TLabTest.LoadSpecimen(AComboBox: TORComboBox);
1682	{ loads specimen combo box, if SpecimenList is empty, use 'E' xref on 61 ?? }
1683	var
1684	i: Integer;
1685	tmpResp: TResponse;
1686	begin
1687	AComboBox.Clear;
1688	if ObtainSpecimen then
1689	begin
1690	if SpecimenList.Count = 0 then LoadSpecimens(SpecimenList) ;
1691	FastAssign(SpecimenList, AComboBox.Items);
1692	AComboBox.Items.Add('0^Other...');
1693	with QuickOrderResponses do tmpResp := FindResponseByName('SPECIMEN' ,1);
1694	if (LRFSPEC <> '') and (tmpResp = nil) then
1695	AComboBox.SelectByID(LRFSPEC)
1696	else if Specimen > 0 then
1697	AComboBox.SelectByIEN(Specimen)
1698	else
1699	AComboBox.ItemIndex := AComboBox.Items.IndexOf('Other...');
1700	end
1701	else
1702	begin
1703	i := IndexOfCollSamp(CollSamp);
1704	if i < CollSampList.Count then with TCollSamp(CollSampList.Items[i]) do
1705	begin
1706	AComboBox.Items.Add(IntToStr(SpecimenID) + '^' + SpecimenName);
1707	AComboBox.ItemIndex := 0;
1708	end;
1709	with QuickOrderResponses do tmpResp := FindResponseByName('SPECIMEN' ,1);
1710	if (LRFSPEC <> '') and (tmpResp = nil) then
1711	begin
1712	AComboBox.Items.Add(GetOneSpecimen(StrToInt(LRFSPEC)));
1713	AComboBox.SelectByID(LRFSPEC);
1714	end;
1715	end;
1716	ChangeSpecimen(AComboBox.ItemID);
1717	end;
1718
1719	procedure TLabTest.LoadUrgency(CollType: string; AComboBox:TORComboBox);
1720	var
1721	i: integer;
1722	begin
1723	if UrgencyList.Count < 1 then Exit;
1724	with AComboBox do
1725	begin
1726	Clear;
1727	for i := 0 to UrgencyList.Count - 1 do
1728	if (CollType = 'LC') and (Piece(UrgencyList[i], U, 3) = '') then
1729	Continue
1730	else
1731	Items.Add(UrgencyList[i]);
1732	if (LRFURG <> '') and (ALabTest.ObtainUrgency) then
1733	SelectByID(LRFURG)
1734	else
1735	SelectByIEN(uDfltUrgency);
1736	Urgency := AComboBox.ItemIEN;
1737	end;
1738	end;
1739
1740	function TLabTest.NameOfCollSamp: string;
1741	var
1742	i: Integer;
1743	begin
1744	Result := '';
1745	i := IndexOfCollSamp(CollSamp);
1746	if i > -1 then with TCollSamp(CollSampList.Items[i]) do Result := CollSampName;
1747	end;
1748
1749	function TLabTest.NameOfSpecimen: string;
1750	var
1751	i: Integer;
1752	begin
1753	Result := '';
1754	if CollSamp > 0 then with TCollSamp(CollSampList[IndexOfCollSamp(CollSamp)]) do
1755	if (Specimen > 0) and (Specimen = SpecimenID) then Result := SpecimenName;
1756	if (Length(Result) = 0) and (Specimen > 0) then with SpecimenList do
1757	for i := 0 to Count - 1 do if Specimen = StrToInt(Piece(Strings[i], '^', 1)) then
1758	begin
1759	Result := Piece(Strings[i], '^', 2);
1760	break;
1761	end;
1762	end;
1763
1764	function TLabTest.NameOfUrgency: string;
1765	var
1766	i: Integer;
1767	begin
1768	Result := '';
1769	with UrgencyList do for i := 0 to Count - 1 do
1770	begin
1771	if StrToInt(Piece(Strings[i], '^', 1)) = Urgency
1772	then Result := Piece(Strings[i], '^', 2);
1773	break;
1774	end;
1775	end;
1776
1777	function TLabTest.ObtainCollSamp: Boolean;
1778	begin
1779	Result := (not UniqueCollSamp);
1780	end;
1781
1782	function TLabTest.ObtainSpecimen: Boolean;
1783	var
1784	i: Integer;
1785	begin
1786	Result := True;
1787	i := IndexOfCollSamp(CollSamp);
1788	if (i > -1) and (i < CollSampList.Count) then with TCollSamp(CollSampList.Items[i]) do
1789	if SpecimenID > 0 then Result := False;
1790	end;
1791
1792	function TLabTest.ObtainUrgency: Boolean;
1793	begin
1794	Result := not ForceUrgency;
1795	end;
1796
1797	function TLabTest.ObtainComment: Boolean;
1798	begin
1799	Result := Length(CurReqComment) > 0;
1800	end;
1801
1802	procedure TfrmODBBank.ExtractModifiers(OutList:TStrings; AList:TStrings);
1803	begin
1804	ExtractItems(Outlist, AList,'MODIFIERS');
1805	end;
1806
1807	procedure TfrmODBBank.ExtractReasons(OutList:TStrings; AList:TStrings);
1808	begin
1809	ExtractItems(Outlist, AList,'REASONS');
1810	end;
1811
1812	procedure TfrmODBBank.ExtractUrgencies(OutList:TStrings; AList:TStrings);
1813	begin
1814	ExtractItems(Outlist, AList,'URGENCIES');
1815	end;
1816
1817	procedure TfrmODBBank.ExtractTNSOrders(OutList:TStrings; AList:TStrings);
1818	begin
1819	ExtractItems(Outlist, AList,'TNS ORDERS');
1820	end;
1821
1822	procedure TfrmODBBank.ExtractSurgeries(OutList:TStrings; AList:TStrings);
1823	begin
1824	ExtractItems(OutList, AList,'SURGERIES');
1825	end;
1826
1827	procedure TfrmODBBank.ExtractSpecimens(OutList:TStrings; AList:TStrings);
1828	begin
1829	ExtractItems(OutList, AList,'SPECIMENS');
1830	end;
1831
1832	procedure TfrmODBBank.ExtractTypeScreen(OutList:TStrings; AList:TStrings);
1833	begin
1834	ExtractItems(OutList, AList, 'TYPE AND SCREEN');
1835	end;
1836
1837	procedure TfrmODBBank.ExtractOther(OutList:TStrings; AList:TStrings);
1838	begin
1839	ExtractItems(OutList, AList, 'OTHER');
1840	end;
1841
1842	procedure TfrmODBBank.ExtractSpecimen(OutList:TStrings; AList:TStrings);
1843	begin
1844	ExtractItems(OutList, AList, 'SPECIMEN');
1845	end;
1846
1847	procedure TfrmODBBank.ExtractPatientInfo(OutList:TStrings; AList:TStrings);
1848	begin
1849	ExtractItems(OutList, AList, 'INFO');
1850	end;
1851
1852	procedure TfrmODBBank.ExtractTests(OutList:TStrings; AList:TStrings);
1853	begin
1854	ExtractItems(OutList, AList, 'TESTS');
1855	end;
1856
1857	procedure TfrmODBBank.ExtractMSBOS(OutList:TStrings; AList:TStrings);
1858	begin
1859	ExtractItems(OutList, AList, 'MSBOS');
1860	end;
1861
1862	function TfrmODBBank.SpecimenNeeded(OutList:TStrings; AList:TStrings; CompID:integer): Boolean;
1863	var
1864	i:integer;
1865	aborh: boolean;
1866	aSpecimen, aSpecimenDate: string;
1867	aWantDateTime, aExpiredSpecimenDate: TFMDateTime;
1868	begin
1869	result := false;
1870	aborh := false;
1871	aSpecimen := '';
1872	OutList.Clear;
1873	ExtractItems(OutList,Alist,'ABORH');
1874	for i := 0 to OutList.Count - 1 do
1875	begin
1876	if Length(OutList[i])>1 then
1877	begin
1878	aborh := true;
1879	end;
1880	end;
1881	if aborh = false then
1882	begin
1883	result := true;
1884	exit;
1885	end;
1886	OutList.Clear;
1887	ExtractSpecimen(OutList, uVBECList);
1888	if OutList.Count > 0 then aSpecimen := OutList[0];
1889	OutList.Clear;
1890	ExtractItems(OutList,AList,'SPECIMENS');
1891	aWantDateTime := calWantTime.FMDateTime;
1892	aSpecimenDate := piece(aSpecimen,'^',1);
1893	aExpiredSpecimenDate := 0;
1894	if Length(aSpecimenDate) > 0 then aExpiredSpecimenDate := StrToFloat(aSpecimenDate);
1895
1896	for i := 0 to OutList.Count - 1 do
1897	begin
1898	if (IntToStr(aLabTest.ItemID) = piece(OutList[i],'^',1)) and (piece(OutList[i],'^',2) = '1') then
1899	if aSpecimen = '' then
1900	begin
1901	result := true;
1902	exit;
1903	end
1904	else if (Length(calWantTime.Text) > 0) and (aExpiredSpecimenDate < aWantDateTime) then
1905	begin
1906	result := true;
1907	exit;
1908	end;
1909	end;
1910	end;
1911
1912	procedure TfrmODBBank.Validate(var AnErrMsg: string);
1913
1914	procedure SetError(const x: string);
1915	begin
1916	if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
1917	AnErrMsg := AnErrMsg + x;
1918	end;
1919
1920	const
1921	TX_NO_TESTS = 'No Tests or Components selected' ;
1922	TX_TNS_REQUIRED = 'An order for TYPE and SCREEN must be created for this order set' ;
1923
1924	begin
1925	inherited;
1926	if uSelectedItems.Count < 1 then
1927	begin
1928	SetError(TX_NO_TESTS);
1929	Exit;
1930	end;
1931	if uGetTns = 1 then
1932	begin
1933	SetError(TX_TNS_REQUIRED);
1934	Exit;
1935	end;
1936	ValidateAdd(AnErrMsg);
1937	end;
1938
1939	procedure TfrmODBBank.ValidateAdd(var AnErrMsg: string);
1940
1941	procedure SetError(const x: string);
1942	begin
1943	if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
1944	AnErrMsg := AnErrMsg + x;
1945	end;
1946
1947	var
1948	aList: TStringList;
1949	i, DaysofFuturePast: integer;
1950	d1, d2: TDateTime;
1951	x,test,aOther: string;
1952	const
1953	{Diagnostic Test Errors}
1954	TX_NO_TIME = 'Collection Time is required' ;
1955	TX_NO_TCOLLTYPE = 'Collection Type is required' ;
1956	TX_NO_TESTS = 'A Lab Test or tests must be selected' ;
1957	TX_BAD_TIME = 'Collection times must be chosen from the drop down list or entered as valid' +
1958	' Fileman date/times (T@1700, T+1@0800, etc.)' ;
1959	TX_PAST_TIME = 'Collection times in the past are not allowed';
1960	TX_NO_DAYS = 'A number of days must be entered for continuous orders';
1961	TX_NO_TIMES = 'A number of times must be entered for continuous orders';
1962	TX_NO_STOP_DATE = 'Could not calculate the stop date for the order. Check "for n Days"';
1963	TX_TOO_MANY_DAYS = 'Maximum number of days allowed is ';
1964	TX_TOO_MANY_TIMES = 'For this frequency, the maximum number of times allowed is: X';
1965	//TX_NO_COMMENT = 'A comment is required for this test and collection sample.';
1966	TX_NUMERIC_REQD = 'A numeric value is required for urine volume';
1967	TX_DOSEDRAW_REQD = 'Both DOSE and DRAW times are required for this order';
1968	TX_TDM_REQD = 'A value for LEVEL is required for this order';
1969	//TX_ANTICOAG_REQD = 'You must specify an anticoagulant on this order.' ;
1970	TX_NO_COLLSAMPLE = 'A collection sample MUST be specified';
1971	TX_NO_SPECIMEN = 'A specimen MUST be specified';
1972	TX_NO_URGENCY = 'An urgency MUST be specified';
1973	TX_NO_FREQUENCY = 'A collection frequency MUST be specified';
1974	TX_NOT_LAB_COLL_TIME = ' is not a routine lab collection time';
1975	TX_NO_ALPHA = 'For continuous orders, enter a number of days, or an "X" followed by a number of times';
1976	TX_BADTIME_CAP = 'Invalid Immediate Collect Time';
1977	{Component/Type & Screen Errors}
1978	TX_NO_COMPONENTS = 'A Blood Product MUST be selected';
1979	TX_NO_QUANTITY = 'The number of units MUST be specified under "Quantity"';
1980	TX_HIGH_QUANTITY = 'Quantity too high';
1981	TX_NO_DATEMODIFIED= 'A Date/time Wanted MUST be specified';
1982	TX_NO_SURGERY = 'A Surgery MUST be specified for Pre-Op orders'; //only if Pre-op selected
1983	TX_NO_REASON = 'A Reason for Request MUST be entered';
1984	TX_REASON_TOO_LONG= 'Reason for Request MUST be less than 76 characters long';
1985	TX_MODIFIER_TOO_LONG = 'Modifer text MUST be less than 51 characters long';
1986	TX_NO_COMMENT = 'A Comment MUST be entered for this Component';
1987	TX_DUPLICATE = 'Duplicate Test/Component not allowed';
1988	TX_NO_TEST_SELECTED = 'No Test/Component selected';
1989
1990	begin
1991	inherited;
1992	AnErrMsg := '';
1993	aList := TStringList.Create;
1994	try
1995	ExtractOther(aList, uVBECList);
1996	if aList.Count > 0 then aOther := aList[0];
1997	aList.Clear;
1998	if uSelectedItems.Count < 1 then
1999	begin
2000	AnErrMsg := TX_NO_TEST_SELECTED;
2001	Exit;
2002	end;
2003	for i := 0 to uSelectedItems.Count - 1 do
2004	begin
2005	x := uSelectedItems[i];
2006	test := lvSelectionList.Items[i].Caption;
2007	if piece(x,'^',1) = '1' then //Diagnostic Test
2008	begin
2009	if uSpecimen = 0 then
2010	if cboCollType.ItemID = '' then
2011	SetError(TX_NO_TCOLLTYPE + ' (' + test + ')')
2012	else if cboCollType.ItemID = 'LC' then
2013	begin
2014	if Length(cboCollTime.Text) = 0 then SetError(TX_NO_TIME + ' (' + test + ')');
2015	with cboCollTime do if (Length(Text) > 0) and (ItemIndex = -1) then
2016	begin
2017	if StrToFMDateTime(Text) < 0 then
2018	SetError(TX_BAD_TIME + ' (' + test + ')')
2019	else if StrToFMDateTime(Text) < FMNow then
2020	SetError(TX_PAST_TIME + ' (' + test + ')')
2021	else if OrderForInpatient then
2022	begin
2023	d1 := FMDateTimeToDateTime(Trunc(StrToFMDateTime(cboColltime.Text)));
2024	d2 := FMDateTimeToDateTime(FMToday);
2025	if EvtDelayLoc > 0 then
2026	DaysofFuturePast := LabCollectFutureDays(EvtDelayLoc,EvtDivision)
2027	else
2028	DaysofFuturePast := LabCollectFutureDays(Encounter.Location);
2029	if DaysofFuturePast = 0 then DaysofFuturePast := 7;
2030	if ((d1 - d2) > DaysofFuturePast) then
2031	SetError('A lab collection cannot be ordered more than '
2032	+ IntToStr(DaysofFuturePast) + ' days in advance');
2033	end
2034	else if EvtDelayLoc > 0 then
2035	begin
2036	if (not IsLabCollectTime(StrToFMDateTime(cboCollTime.Text), EvtDelayLoc)) then
2037	SetError(cboCollTime.Text + TX_NOT_LAB_COLL_TIME + ' (' + test + ')');
2038	end
2039	else if EvtDelayLoc <= 0 then
2040	begin
2041	if (not IsLabCollectTime(StrToFMDateTime(cboCollTime.Text), Encounter.Location)) then
2042	SetError(cboCollTime.Text + TX_NOT_LAB_COLL_TIME + ' (' + test + ')');
2043	end;
2044	end;
2045	end
2046	else
2047	begin
2048	if cboCollType.ItemID = 'I' then
2049	begin
2050	calCollTime.Text := txtImmedColl.Text;
2051	x := ValidImmCollTime(calCollTime.FMDateTime);
2052	if (Piece(x, U, 1) <> '1') then
2053	SetError(Piece(x, U, 2));
2054	end;
2055
2056	with calColltime do
2057	begin
2058	if FMDateTime = 0 then SetError(TX_BAD_TIME + ' (' + test + ')')
2059	else
2060	begin
2061	// date only was entered
2062	if (FMDateTime - Trunc(FMDateTime) = 0) then
2063	begin
2064	if (Trunc(FMDateTime) < FMToday) then SetError(TX_PAST_TIME + ' (' + test + ')');
2065	end
2066	// date/time was entered
2067	else
2068	begin
2069	if (UpperCase(Text) <> 'NOW') and (FMDateTime < FMNow) then SetError(TX_PAST_TIME + ' (' + test + ')');
2070	end;
2071	end;
2072	end;
2073	end;
2074
2075	with cboUrgency do if ItemIEN <= 0 then SetError(TX_NO_URGENCY + ' (' + test + ')');
2076	end
2077	else //Component
2078	begin
2079	if piece(x,'^',3) ='' then SetError(TX_NO_QUANTITY + ' (' + test + ')')
2080	else
2081	begin
2082	if StrToInt(piece(x,'^',3)) < 1 then SetError(TX_NO_QUANTITY + ' (' + test + ')');
2083	if StrToInt(piece(x,'^',3)) > 100 then SetError(TX_HIGH_QUANTITY + ' (' + test + ')');
2084	end;
2085	if calWantTime.Text = '' then SetError(TX_NO_DATEMODIFIED + ' (' + test + ')');
2086	if (cboReasons.Text = '') and not(uReason = '') then
2087	begin
2088	SetError(TX_NO_REASON + ' (' + test + ').' + ' Previously entered ''Reason for Request'' will be retained.');
2089	cboReasons.Text := uReason; //reset reason back to previous value
2090	end;
2091	if (cboReasons.Text = '') then
2092	begin
2093	SetError(TX_NO_REASON + ' (' + test + ').');
2094	end;
2095	if (memDiagComment.Text = '') and (piece(x,'^',2) = aOther) then SetError(TX_NO_COMMENT + ' (' + test + ')');
2096	if (cboUrgency.Text = 'PRE-OP') and (length(cboSurgery.Text) < 1) then SetError(TX_NO_SURGERY + ' (' + test + ')');
2097	if (length(cboReasons.Text) > 75) then SetError(TX_REASON_TOO_LONG);
2098	if (length(cboModifiers.Text) > 50) then SetError(TX_MODIFIER_TOO_LONG);
2099	end;
2100	end;
2101	finally
2102	aList.Free;
2103	end;
2104	end;
2105
2106	function TfrmODBBank.ValidAdd: Boolean;
2107	const
2108	TX_NO_SAVE = 'This item cannot be added for the following reason(s):' + CRLF + CRLF;
2109	TX_NO_SAVE_CAP = 'Unable to Add item';
2110	TX_SAVE_ERR = 'Unexpected error - it was not possible to Add this item.';
2111	var
2112	ErrMsg: string;
2113
2114	begin
2115	Result := True;
2116	ValidateAdd(ErrMsg);
2117	if Length(ErrMsg) > 0 then
2118	begin
2119	InfoBox(TX_NO_SAVE + ErrMsg, TX_NO_SAVE_CAP, MB_OK);
2120	Result := False;
2121	Exit;
2122	end;
2123	end;
2124
2125	function TfrmODBBank.ValidCollTime(UserEntry: string): string;
2126	var
2127	i: integer;
2128	const
2129	FMDateResponses: array[0..3] of string = ('TODAY','NOW','NOON','MID');
2130	begin
2131	Result := '';
2132	UserEntry := UpperCase(UserEntry);
2133	if StrToFMDateTime(UserEntry) < 0 then exit;
2134	if (UserEntry = 'T') or
2135	(UserEntry = 'N') or
2136	(Copy(UserEntry,1,2)='T+') or
2137	(Copy(UserEntry,1,2)='T@') or
2138	(Copy(UserEntry,1,2)='T-') or
2139	(Copy(UserEntry,1,2)='N+') then Result := UserEntry
2140	else
2141	for i := 0 to 3 do if Pos(FMDateResponses[i],UserEntry)>0 then Result := UserEntry ;
2142	if Result = '' then Result := FloatToStr(StrToFMDateTime(UserEntry));
2143	end;
2144
2145	procedure TfrmODBBank.GetAllCollSamples(AComboBox: TORComboBox);
2146	var
2147	OtherSamp: string;
2148	begin
2149	with ALabTest, AComboBox do
2150	begin
2151	if ((CollSampList.Count + 1) <= AComboBox.Items.Count) then LoadAllSamples;
2152	OtherSamp := SelectOtherCollSample(Font.Size, CollSampCount, CollSampList);
2153	if OtherSamp = '-1' then exit;
2154	if SelectByID(Piece(OtherSamp, U, 1)) = -1 then
2155	if Items.Count > CollSampCount + 1 then
2156	Items[0] := OtherSamp
2157	else
2158	Items.Insert(0, OtherSamp) ;
2159	SelectByID(Piece(OtherSamp, U, 1));
2160	AComboBox.OnChange(Self);
2161	ActiveControl := cmdAccept;
2162	end;
2163	end;
2164
2165	procedure TfrmODBBank.GetAllSpecimens(AComboBox: TORComboBox);
2166	var
2167	OtherSpec: string;
2168	begin
2169	inherited;
2170	if ALabTest <> nil then
2171	with ALabTest, AComboBox do
2172	begin
2173	AComboBox.DroppedDown := False;
2174	OtherSpec := SelectOtherSpecimen(Font.Size, SpecimenList);
2175	if OtherSpec = '-1' then exit;
2176	if SelectByID(Piece(OtherSpec, U, 1)) = -1 then
2177	if Items.Count > SpecListCount + 1 then
2178	Items[0] := OtherSpec
2179	else
2180	Items.Insert(0, OtherSpec) ;
2181	SpecimenList.Add(OtherSpec);
2182	SelectByID(Piece(OtherSpec, U, 1));
2183	AComboBox.OnChange(Self);
2184	end;
2185	end;
2186
2187	procedure TfrmODBBank.SetupCollTimes(CollType: string);
2188	var
2189	tmpImmTime, tmpTime: TFMDateTime;
2190	x, tmpORECALLType, tmpORECALLTime: string;
2191	begin
2192	x := GetLastCollectionTime;
2193	tmpORECALLType := Piece(x, U, 1);
2194	tmpORECALLTime := Piece(x, U, 2);
2195	if CollType = 'SP' then
2196	begin
2197	cboColltime.Visible := False;
2198	txtImmedColl.Visible := False;
2199	pnlCollTimeButton.Visible := False;
2200	pnlCollTimeButton.TabStop := False;
2201	calCollTime.Visible := True;
2202	calColltime.Enabled := True;
2203	if FLastCollTime <> '' then
2204	begin
2205	calCollTime.Text := ValidCollTime(FLastColltime);
2206	if IsFMDateTime(calCollTime.Text) then
2207	begin
2208	calCollTime.Text := FormatFMDateTime('mmm dd,yy@hh:nn', StrToFMDateTime(calColltime.Text));
2209	calColltime.FMDateTime := StrToFMDateTime(FLastCollTime);
2210	end;
2211	end
2212	else if tmpORECALLTime <> '' then
2213	begin
2214	calCollTime.Text := ValidCollTime(tmpORECALLTime);
2215	if IsFMDateTime(calCollTime.Text) then
2216	begin
2217	calCollTime.Text := FormatFMDateTime('mmm dd,yy@hh:nn', StrToFMDateTime(calColltime.Text));
2218	calColltime.FMDateTime := StrToFMDateTime(tmpORECALLTime);
2219	end;
2220	end
2221	else if LRFDATE <> '' then
2222	calCollTime.Text := LRFDATE
2223	else
2224	calCollTime.Text := 'TODAY';
2225	end
2226	else if CollType = 'WC' then
2227	begin
2228	cboColltime.Visible := False;
2229	txtImmedColl.Visible := False;
2230	pnlCollTimeButton.Visible := False;
2231	pnlCollTimeButton.TabStop := False;
2232	calCollTime.Visible := True;
2233	calColltime.Enabled := True;
2234	if FLastCollTime <> '' then
2235	begin
2236	calCollTime.Text := ValidColltime(FLastColltime);
2237	if IsFMDateTime(calCollTime.Text) then
2238	begin
2239	calCollTime.Text := FormatFMDateTime('mmm dd,yy@hh:nn', StrToFMDateTime(calColltime.Text));
2240	calColltime.FMDateTime := StrToFMDateTime(FLastCollTime);
2241	end;
2242	end
2243	else if tmpORECALLTime <> '' then
2244	begin
2245	calCollTime.Text := ValidColltime(tmpORECALLTime);
2246	if IsFMDateTime(calCollTime.Text) then
2247	begin
2248	calCollTime.Text := FormatFMDateTime('mmm dd,yy@hh:nn', StrToFMDateTime(calColltime.Text));
2249	calColltime.FMDateTime := StrToFMDateTime(tmpORECALLTime);
2250	end;
2251	end
2252	else if LRFDATE <> '' then
2253	calCollTime.Text := LRFDATE
2254	else
2255	calCollTime.Text := 'NOW';
2256	end
2257	else if CollType = 'LC' then
2258	begin
2259	cboColltime.Visible := True;
2260	calCollTime.Visible := False;
2261	calColltime.Enabled := False;
2262	txtImmedColl.Visible := False;
2263	pnlCollTimeButton.Visible := False;
2264	pnlCollTimeButton.TabStop := False;
2265	with CtrlInits do SetControl(cboCollTime, 'Lab Collection Times');
2266	if Pos(U, FLastLabCollTime) > 0 then
2267	cboColltime.SelectByID(Piece(FLastLabCollTime, U, 1))
2268	else if FLastLabCollTime <> '' then
2269	cboCollTime.Text := FLastLabCollTime
2270	else if (tmpORECALLTime <> '') and (tmpORECALLType = 'LC') then
2271	cboCollTime.Text := MakeRelativeDateTime(StrToFMDateTime(tmpORECALLTime))
2272	else if LRFDATE <> '' then
2273	cboCollTime.Text := LRFDATE
2274	else
2275	cboCollTime.ItemIndex := 0;
2276	end
2277	else if CollType = 'I' then
2278	begin
2279	cboColltime.Visible := False;
2280	calCollTime.Visible := False;
2281	calColltime.Enabled := False;
2282	txtImmedColl.Visible := True;
2283	pnlCollTimeButton.Visible := True;
2284	pnlCollTimeButton.TabStop := True;
2285	tmpImmTime := GetDefaultImmCollTime;
2286	tmpTime := 0;
2287	if (FLastColltime <> '') then
2288	tmpTime := StrToFMDateTime(FLastColltime)
2289	else if (tmpORECALLTime <> '') then
2290	tmpTime := StrToFMDateTime(tmpORECALLTime)
2291	else if LRFDATE <> '' then
2292	tmpTime := StrToFMDateTime(LRFDATE);
2293
2294	if tmpTime > tmpImmTime then
2295	begin
2296	calCollTime.FMDateTime := tmpTime;
2297	txtImmedColl.Text := FormatFMDateTime('mmm dd,yy@hh:nn', tmpTime);
2298	end
2299	else
2300	begin
2301	calCollTime.FMDateTime := GetDefaultImmCollTime;
2302	txtImmedColl.Text := FormatFMDateTime('mmm dd,yy@hh:nn', calCollTime.FMDateTime);
2303	end;
2304	end;
2305	end;
2306
2307	procedure TfrmODBBank.LoadCollType(AComboBox:TORComboBox);
2308	var
2309	i: integer;
2310	begin
2311	with CtrlInits, cboCollType do
2312	begin
2313	SetControl(cboCollType, 'Collection Types');
2314	if not ALabTest.LabCanCollect then
2315	begin
2316	i := SelectByID('LC');
2317	if i > -1 then Items.Delete(i);
2318	i := SelectByID('I');
2319	if i > -1 then Items.Delete(i);
2320	end ;
2321	if LRFZX <> '' then
2322	begin
2323	if (LRFZX = 'LC') or (LRFZX = 'I') then
2324	begin
2325	if ALabTest.LabCanCollect then
2326	cboCollType.SelectByID(LRFZX)
2327	else
2328	cboCollType.SelectByID('WC');
2329	end
2330	else
2331	cboCollType.SelectByID(LRFZX);
2332	end
2333	else if FLastCollType <> '' then
2334	begin
2335	if (FLastCollType = 'LC') or (FLastCollType = 'I') then
2336	begin
2337	if ALabTest.LabCanCollect then
2338	cboCollType.SelectByID(FLastCollType)
2339	else
2340	cboCollType.SelectByID('WC');
2341	end
2342	else
2343	cboCollType.SelectByID(FLastCollType);
2344	end
2345	else if uDfltCollType <> '' then
2346	begin
2347	if (uDfltCollType = 'LC') or (uDfltCollType = 'I') then
2348	begin
2349	if ALabTest.LabCanCollect then
2350	cboCollType.SelectByID(uDfltCollType)
2351	else
2352	cboCollType.SelectByID('WC');
2353	end
2354	else
2355	cboCollType.SelectByID(uDfltCollType);
2356	end
2357	else if OrderForInpatient then
2358	begin
2359	if ALabTest.LabCanCollect then
2360	cboCollType.SelectByID('LC')
2361	else
2362	SelectByID('WC');
2363	end
2364	else
2365	cboCollType.SelectByID('SP');
2366	end;
2367	SetupCollTimes(cboCollType.ItemID);
2368	end;
2369
2370	procedure TfrmODBBank.ReadServerVariables;
2371	begin
2372	LRFZX := KeyVariable['LRFZX'];
2373	LRFSAMP := KeyVariable['LRFSAMP'];
2374	LRFSPEC := KeyVariable['LRFSPEC'];
2375	LRFDATE := KeyVariable['LRFDATE'];
2376	LRFURG := KeyVariable['LRFURG'];
2377	LRFSCH := KeyVariable['LRFSCH'];
2378	end;
2379
2380	procedure TfrmODBBank.cboQuickClick(Sender: TObject);
2381	begin
2382	inherited;
2383	SetOnQuickOrder;
2384	end;
2385
2386	procedure TfrmODBBank.cboReasonsChange(Sender: TObject);
2387	begin
2388	inherited;
2389	if (length(cboReasons.Text) > 75) then
2390	begin
2391	ShowMsg('REASON FOR REQUEST cannot be longer than 75 characters');
2392	cboReasons.Text := Copy(cboReasons.Text,0,75);
2393	Exit;
2394	end;
2395	if Length(cboReasons.Text) > 0 then Responses.Update('REASON', 1, cboReasons.Text, cboReasons.Text);
2396	memOrder.Text := Responses.OrderText;
2397	end;
2398
2399	procedure TfrmODBBank.cboReasonsEnter(Sender: TObject);
2400	begin
2401	inherited;
2402	if Length(cboReasons.Text) > 0 then
2403	uReason := cboReasons.Text;
2404	end;
2405
2406	procedure TfrmODBBank.cboReasonsExit(Sender: TObject);
2407	begin
2408	inherited;
2409	if Length(cboReasons.Text) > 0 then
2410	uReason := cboReasons.Text;
2411	end;
2412
2413	procedure TfrmODBBank.cboAvailTestSelect(Sender: TObject);
2414	var
2415	i: integer;
2416	text : string;
2417	ListItem: TListItem;
2418	aCollTime,aTypeScreen,aStr,aModifier,aSpecimen,aTestYes,x,aName,aTNSString: string;
2419	aList: TStringList;
2420	curAdd,AnInstance,aTNS,aTNSDays: Integer;
2421	sub,sub1: string;
2422	AResponse: TResponse;
2423	begin
2424	if cboAvailTest.ItemID = '' then Exit;
2425	aList := TStringList.Create;
2426	try
2427	ALabTest := nil;
2428	aTypeScreen := '';
2429	aSpecimen := '^';
2430	aTestYes := '1';
2431	aModifier := '';
2432	changing := true;
2433	tQuantity.Text := '';
2434	sub1 := '';
2435	cboModifiers.ItemIndex := -1;
2436	DisableComponentControls;
2437	EnableDiagTestControls;
2438	LRORDERMODE := TORDER_MODE_DIAG;
2439	ALabTest := TLabTest.Create(cboAvailTest.ItemID, Responses);
2440	sub := GetSubtype(ALabTest.TestName);
2441	with CtrlInits do
2442	begin
2443	SetControl(cboCollType, 'Collection Types');
2444	LoadCollType(cboCollType);
2445	if FLastCollType <> '' then
2446	cboCollType.SelectByID(FLastCollType)
2447	else if uDfltCollType <> '' then
2448	cboCollType.SelectByID(uDfltCollType)
2449	else if OrderForInpatient then
2450	if (ALabTest.LabCanCollect) then
2451	cboCollType.SelectByID('LC')
2452	else
2453	cboCollType.SelectByID('WC')
2454	else
2455	cboCollType.SelectByID('SP');
2456	SetupCollTimes(cboCollType.ItemID);
2457	end;
2458	with cboAvailTest do
2459	begin
2460	if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
2461	FLastLabID := ItemID ;
2462	FLastItemID := ItemID;
2463	for i := 0 to uSelectedItems.Count - 1 do
2464	if ItemID = piece(uSelectedItems[i],'^',2) then
2465	begin
2466	ItemIndex := -1;
2467	lvSelectionList.Items[i].Selected := true;
2468	lvSelectionListClick(self);
2469	Exit;
2470	end;
2471	Changing := True;
2472	Changing := False;
2473	ExtractTypeScreen(aList, uVBECList);
2474	if aList.Count > 0 then aTypeScreen := aList[0];
2475	aList.Clear;
2476	aTNSString := '';
2477	if (StrToInt(aTypeScreen) = cboAvailTest.ItemID) and (uTNSOrders.Count > 0) then
2478	begin
2479	for i := 0 to uTNSOrders.Count - 1 do
2480	aTNSString := aTNSString + CRLF + uTNSOrders[i];
2481	with Application do
2482	begin
2483	NormalizeTopMosts;
2484	aTNSDays := TNSDaysBack;
2485	aTNS :=
2486	MessageBox(PChar(aTNSString + CRLF + CRLF +
2487	'Do you wish to continue?'),
2488	PChar('Type & Screen Entered in Past ' + IntToStr(TNSDaysBack) + ' Days'),
2489	MB_YESNO);
2490	RestoreTopMosts;
2491	if aTNS = 7 then
2492	begin
2493	cboAvailTest.ItemIndex := -1;
2494	exit;
2495	end;
2496	end;
2497	end;
2498	if sub = 't' then with ALabTest do //DIAGNOSTIC TEST
2499	begin
2500	if ObtainCollSamp then
2501	begin
2502	//For BloodBank orders, this condition should never occur
2503	end
2504	else
2505	begin
2506	with ALabTest do
2507	with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
2508	begin
2509	x := '' ;
2510	for i := 0 to WardComment.Count-1 do
2511	x := x + WardComment.strings[i]+#13#10 ;
2512	pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
2513	OrderMessage(x) ;
2514	end ;
2515	end;
2516	end;
2517	Changing := False;
2518	end;
2519	if LRORDERMODE = TORDER_MODE_DIAG then
2520	begin
2521	if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
2522	with cboCollType do if Length(ItemID) > 0 then
2523	begin
2524	Responses.Update('COLLECT', 1, ItemID, ItemID) ;
2525	FLastCollType := ItemID;
2526	end;
2527	if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text)
2528	else
2529	begin
2530	cboUrgency.ItemIndex := 1;
2531	Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
2532	end;
2533	if Length(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
2534	if Length(cboReasons.Text) > 0 then Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text);
2535	if cboCollType.ItemID = 'LC' then
2536	begin
2537	with cboCollTime do
2538	if Length(ItemID) > 0 then
2539	begin
2540	Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
2541	FLastLabCollTime := ItemID + U + Text;
2542	end
2543	else if Length(Text) > 0 then
2544	begin
2545	Responses.Update('START', 1, ValidCollTime(Text), Text) ;
2546	FLastLabCollTime := ValidCollTime(Text);
2547	end;
2548	end
2549	else
2550	begin
2551	with calCollTime do
2552	if FMDateTime > 0 then
2553	begin
2554	Responses.Update('START', 1, ValidCollTime(Text), Text);
2555	FLastColltime := ValidCollTime(Text);
2556	end
2557	else
2558	begin
2559	Responses.Update('START', 1, '', '') ;
2560	FLastCollTime := '';
2561	end;
2562	end;
2563	if Length(cboCollType.Text) > 0 then Responses.Update('COLLECT',1,cboCollType.ItemID,cboCollType.ItemID);
2564	end;
2565	if length(cboCollTime.ItemID) > 0 then aCollTime := cboCollTime.Items[cboCollTime.ItemIndex];
2566	uTestSelected := true;
2567	with lvSelectionList do
2568	begin
2569	ListItem := Items.Add;
2570	ListItem.Caption := piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',2);
2571	ListItem.SubItems.Add('');
2572	ListItem.SubItems.Add('');
2573	ListItem.SubItems.Add('');
2574	ListItem.SubItems.Add(piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1));
2575	if piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1) = aTypeScreen then
2576	begin
2577	lblTNS.Caption := '';
2578	lblTNS.Visible := false;
2579	memMessage.Text := '';
2580	pnlMessage.Visible := false;
2581	uGetTnS := 0;
2582	pnlDiagnosticTests.Caption := 'Diagnostic Tests';
2583	end;
2584	end;
2585	aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + aCollTime + '^' + cboCollType.Text + '^' + IntToStr(aLabTest.ItemID); //aSpecimen has 2 pieces
2586	uSelectedItems.Add(aStr);
2587	CurAdd := 1;
2588	for i := 0 to uSelectedItems.Count - 1 do
2589	begin
2590	aName := lvSelectionList.Items[i].Caption;
2591	x := uSelectedItems[i];
2592	if piece(x,'^',1) = '1' then //Diagnostic Test related fields
2593	begin
2594	if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
2595	end;
2596	Inc(CurAdd);
2597	end;
2598	memOrder.Text := Responses.OrderText;
2599	finally
2600	aList.Free;
2601	end;
2602	edtResults.Height := 247;
2603	edtInfo.Height := 247;
2604	if lvSelectionList.Items.Count > 0 then
2605	begin
2606	pnlSelectedTests.Visible := True;
2607	cmdAccept.Visible := True;
2608	memOrder.Visible := True;
2609	GroupBox1.Visible := False;
2610	end;
2611	end;
2612
2613	procedure TfrmODBBank.cboAvailCompSelect(Sender: TObject);
2614	var
2615	aList,aTests: TStringList;
2616	i,j,k,getTest,TestAdded: integer;
2617	text : string;
2618	aMSBOS,aMSBOSContinue,curAdd,AnInstance: integer;
2619	sub,sub1: string;
2620	AResponse: TResponse;
2621	ListItem: TListItem;
2622	aTypeScreen,aSpecimen,aTestYes,aStr,aMsg,aModifier,x,x1,aReason,aSurgery,aCollTime,aCollSave,aName: String;
2623	begin
2624	if cboAvailComp.ItemID = '' then Exit;
2625	aList := TStringList.Create;
2626	aTests := TStringList.Create;
2627	sub1 := '';
2628	try
2629	DisableDiagTestControls;
2630	EnableComponentControls;
2631	if not(changing = true) then
2632	begin
2633	changing := true;
2634	tQuantity.Text := '';
2635	cboModifiers.ItemIndex := -1;
2636	changing := false;
2637	end;
2638	LRORDERMODE := TORDER_MODE_COMP;
2639	with cboAvailComp do
2640	begin
2641	if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
2642	FLastLabID := ItemID ;
2643	FLastItemID := ItemID;
2644	for i := 0 to uSelectedItems.Count - 1 do
2645	if ItemID = piece(uSelectedItems[i],'^',2) then
2646	begin
2647	ItemIndex := -1;
2648	lvSelectionList.Items[i].Selected := true;
2649	lvSelectionListClick(self);
2650	Exit;
2651	end;
2652	ALabTest := TLabTest.Create(ItemID, Responses);
2653	sub := GetSubtype(ALabTest.TestName);
2654	Changing := False;
2655	StatusText('');
2656	end;
2657	//Check for and display any associated Lab Results
2658	aList.Clear;
2659	TestAdded := 0;
2660	getTest := 0;
2661	ExtractTests(aList, uVBECList); //Get Results associated with ordered components
2662	for j := 0 to aList.Count - 1 do
2663	begin
2664	if StrToInt(piece(aList[j],'^',1)) = aLabTest.ItemID then
2665	begin
2666	if uTestsForResults.Count < 1 then getTest := 1;
2667	for k := 0 to uTestsForResults.Count - 1 do
2668	begin
2669	if piece(uTestsForResults[k],'^',1) = piece(aList[j],'^',3) then
2670	begin
2671	getTest := 0;
2672	break;
2673	end
2674	else getTest := 1;
2675	end;
2676	if getTest = 1 then
2677	begin
2678	uTestsForResults.Add(piece(aList[j],'^',3));
2679	TestAdded := 1;
2680	end;
2681	end;
2682	end;
2683	if TestAdded = 1 then
2684	begin
2685	edtResults.Clear;
2686	aTests.Clear;
2687	GetPatientBloodResults(aTests, Patient.DFN, uTestsForResults);
2688	QuickCopy(ATests,edtResults);
2689	if edtResults.Lines.Count > 0 then TabResults.Caption := 'Lab Results Available';
2690	uRaw.Clear;
2691	GetPatientBloodResultsRaw(uRaw, Patient.DFN, uTestsForResults);
2692	end;
2693	CurAdd := 1;
2694	if uRaw.Count > 0 then
2695	for j := 0 to uRaw.Count - 1 do
2696	begin
2697	if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));
2698	Inc(CurAdd);
2699	end;
2700	aTypeScreen := '';
2701	aSpecimen := '^';
2702	aTestYes := '0';
2703	aReason := '';
2704	aSurgery := '';
2705	aCollTime := '';
2706	aList.Clear;
2707	ExtractTypeScreen(aList, uVBECList);
2708	if aList.Count > 0 then aTypeScreen := aList[0];
2709	aList.Clear;
2710	ExtractSpecimen(aList, uVBECList);
2711	if aList.Count > 0 then aSpecimen := aList[0];
2712	if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex];
2713	if length(cboReasons.ItemID) > 0 then aReason := cboReasons.Items[cboReasons.ItemIndex];
2714	if length(cboSurgery.ItemID) > 0 then aSurgery := cboSurgery.Items[cboSurgery.ItemIndex];
2715	if length(cboCollTime.ItemID) > 0 then aCollTime := cboCollTime.Items[cboCollTime.ItemIndex];
2716	if Length(cboSurgery.ItemID) > 0 then
2717	begin
2718	aList.Clear;
2719	ExtractMSBOS(aList, uVBECList); //Get maximum units for selected Surgey
2720	for i := 0 to aList.Count - 1 do
2721	begin
2722	if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
2723	and (piece(aList[i],'^',3) = cboSurgery.Text) then
2724	begin
2725	aMSBOS := StrToInt(piece(aList[i],'^',4));
2726	if (aMSBOS > 0) and (Length(tQuantity.Text) > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then
2727	begin
2728	with Application do
2729	begin
2730	NormalizeTopMosts;
2731	aMSBOSContinue :=
2732	MessageBox(PChar('The number of units ordered (' + tQuantity.Text +
2733	') for ' + aLabTest.TestName + ' exceeds the maximum number of units ('
2734	+ IntToStr(aMSBOS) +
2735	') for the ' + cboSurgery.text +
2736	' surgical procedure selected.' + CRLF + CRLF + 'Do you wish to continue?'),
2737	PChar('Maximum Number of Units Exceeded'),
2738	MB_YESNO);
2739	RestoreTopMosts;
2740	end;
2741	if aMSBOSContinue = 7 then
2742	begin
2743	ShowMsg(cboAvailComp.Text + ' has NOT been added to this request.');
2744	exit;
2745	end;
2746	end;
2747	end;
2748	end;
2749	end;
2750	if (uTNSOrders.Count < 1) then // SpecimenNeeded(aList, uVBECList, aLabTest.ItemID) then //check to see if type and screen is needed
2751	begin
2752	uGetTnS := 1;
2753	for i := 0 to lvSelectionList.Items.Count - 1 do
2754	begin
2755	if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then
2756	begin
2757	uGetTnS := 0;
2758	if length(cboUrgency.ItemID) > 0 then uDfltUrgency := cboUrgency.ItemID;
2759	lblTNS.Caption := '';
2760	lblTNS.Visible := false;
2761	memMessage.Text := '';
2762	pnlMessage.Visible := false;
2763	pnlDiagnosticTests.Caption := 'Diagnostic Tests';
2764	break;
2765	end;
2766	end;
2767	end;
2768	aList.Clear;
2769	ExtractSpecimens(aList, uVBECList); //Get specimen values to pass back to Server
2770	for i := 0 to aList.Count - 1 do
2771	begin
2772	if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) then
2773	begin
2774	aSpecimen := piece(aList[i],'^',2) + '^' + aSpecimen;
2775	break;
2776	end;
2777	end;
2778	uComponentSelected := true;
2779	with lvSelectionList do
2780	begin
2781	ListItem := Items.Add;
2782	ListItem.Caption := piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2);
2783	ListItem.SubItems.Add(tQuantity.Text);
2784	if length(cboModifiers.ItemID) > 0 then
2785	begin
2786	ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]);
2787	ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex));
2788	end
2789	else
2790	begin
2791	ListItem.SubItems.Add('');
2792	ListItem.SubItems.Add('');
2793	end;
2794	ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
2795	end;
2796	aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + IntToStr(aLabTest.ItemID); //aSpecimen has 2 pieces additional pieces added for Tests
2797	uSelectedItems.Add(aStr);
2798	CurAdd := 1;
2799	for i := 0 to uSelectedItems.Count - 1 do
2800	begin
2801	aName := lvSelectionList.Items[i].Caption;
2802	x := uSelectedItems[i];
2803	if piece(x,'^',1) = '1' then //Diagnostic Test related fields
2804	begin
2805	if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
2806	end
2807	else
2808	begin
2809	if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
2810	if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3));
2811	if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), piece(x,'^',4));
2812	if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5));
2813	if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
2814	if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
2815	if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text)
2816	else
2817	begin
2818	cboUrgency.ItemIndex := 1;
2819	Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
2820	end;
2821	end;
2822	Inc(CurAdd);
2823	end;
2824	memOrder.Text := Responses.OrderText;
2825	finally
2826	alist.Free;
2827	aTests.Free;
2828	end;
2829	aMsg := '';
2830	LRORDERMODE := TORDER_MODE_INFO;
2831	if uGetTnS = 1 then
2832	begin
2833	lblTNS.Caption := 'TYPE + SCREEN must be added to order';
2834	lblTNS.Visible := true;
2835	memMessage.Text := 'TYPE + SCREEN must be added to order';
2836	pnlMessage.Visible := true;
2837	pnlDiagnosticTests.Caption := 'Diagnostic Tests*';
2838	end;
2839	{if uGetTnS = 1 then
2840	begin
2841	if responses.QuickOrder < 1 then
2842	begin
2843	for i := 1 to cboAvailTest.Items.Count - 1 do
2844	begin
2845	if piece(cboAvailTest.Items[i],'^',1) = aTypeScreen then
2846	begin
2847	if piece(aSpecimen,'^',1) = '1' then
2848	begin
2849	cboCollTime.Text := calWantTime.Text;
2850	aCollSave := cboCollTime.Text + '^' + cboCollTime.ItemID + '^' + cboCollType.Text + '^' + cboCollType.ItemID;
2851	cboCollTime.Text := '';
2852	cboCollType.Text := '';
2853	uSpecimen := 1;
2854	end;
2855	cboModifiers.Text := '';
2856	cboAvailTest.SelectByID(aTypeScreen);
2857	cboTests.SelectByID(aTypeScreen);
2858	cboTestsClick(self);
2859	//cboAvailTestSelect(Self);
2860	uSpecimen := 0;
2861	cboCollTime.Text := piece(aCollSave,'^',1);
2862	cboCollType.Text := piece(aCollSave,'^',3);
2863	aCollSave := '';
2864	break;
2865	end;
2866	end;
2867	aMsg := 'An order for Type and Screen has been added to this request' + '.';
2868	end
2869	else
2870	begin
2871	lblTNS.Caption := 'TYPE + SCREEN must be added to order';
2872	lblTNS.Visible := true;
2873	memMessage.Text := 'TYPE + SCREEN must be added to order';
2874	memMessage.Visible := false;
2875	pnlMessage.Visible := true;
2876	end;
2877	end;
2878	if (uGetTnS = 1) then
2879	begin
2880	if length(aMsg) > 0 then aMsg := aMsg + crlf + crlf;
2881	ShowMsg(aMsg);
2882	end; }
2883	edtResults.Height := 247;
2884	edtInfo.Height := 247;
2885	if lvSelectionList.Items.Count > 0 then
2886	begin
2887	pnlSelectedTests.Visible := True;
2888	cmdAccept.Visible := True;
2889	memOrder.Visible := True;
2890	GroupBox1.Visible := False;
2891	end;
2892	if tQuantity.CanFocus = true then tQuantity.SetFocus;
2893	end;
2894
2895	procedure TfrmODBBank.DisableCommentPanels;
2896	begin
2897	lblReqComment.Visible := False;
2898	end;
2899
2900	procedure TfrmODBBank.DisableComponentControls;
2901	begin
2902	lblQuantity.Enabled := false;
2903	tQuantity.Enabled := false;
2904	lblModifiers.Enabled := false;
2905	cboModifiers.Enabled := false;
2906	cboAvailComp.ItemIndex := -1;
2907	end;
2908
2909	procedure TfrmODBBank.EnableComponentControls;
2910	begin
2911	lblQuantity.Enabled := true;
2912	tQuantity.Enabled := true;
2913	lblModifiers.Enabled := true;
2914	cboModifiers.Enabled := true;
2915	if not(changing) then
2916	if not(uSelUrgency = 'PRE-OP') then
2917	if uSelUrgency = '' then
2918	if lvSelectionList.Items.Count < 1 then
2919	cboUrgency.SelectByID(IntToStr(uDfltUrgency));
2920	if cboUrgency.Text = 'PRE-OP' then
2921	begin
2922	lblSurgery.Enabled := true;
2923	cboSurgery.Enabled := true;
2924	lblSurgery.Caption := 'Surgery*';
2925	end
2926	else
2927	begin
2928	lblSurgery.Enabled := false;
2929	cboSurgery.Enabled := false;
2930	lblSurgery.Caption := 'Surgery';
2931	end;
2932	lblDiagComment.Enabled := true;
2933	end;
2934
2935	procedure TfrmODBBank.DisableDiagTestControls;
2936	begin
2937	lblCollTime.Enabled := false;
2938	calCollTime.Enabled := false;
2939	cboCollTime.Enabled := false;
2940	lblCollType.Enabled := false;
2941	cboCollType.Enabled := false;
2942	cmdImmedColl.Enabled := false;
2943	cboAvailTest.ItemIndex := -1;
2944	cboAvailTest.InitLongList('');
2945	end;
2946
2947	procedure TfrmODBBank.EnableDiagTestControls;
2948	begin
2949	lblCollTime.Enabled := true;
2950	calCollTime.Enabled := true;
2951	cboCollTime.Enabled := true;
2952	lblCollType.Enabled := true;
2953	cboCollType.Enabled := true;
2954	cmdImmedColl.Enabled := true;
2955	if not(changing) then
2956	if not(uSelUrgency = 'PRE-OP') then
2957	if uSelUrgency = '' then
2958	if lvSelectionList.Items.Count < 1 then
2959	cboUrgency.SelectByID(IntToStr(uDfltUrgency));
2960	end;
2961
2962	procedure TfrmODBBank.LoadRequiredComment(CmtType: integer);
2963	begin
2964	DisableCommentPanels;
2965	lblReqComment.Visible := True ;
2966	end;
2967
2968	procedure TfrmODBBank.DetermineCollectionDefaults(Responses: TResponses);
2969	var
2970	RespCollect, RespStart: TResponse;
2971	begin
2972	if ALabTest = nil then exit;
2973	if ALabTest.LabSubscript = 'BB' then exit;
2974	calCollTime.Clear;
2975	cboCollTime.Clear;
2976	calCollTime.Enabled := True;
2977	lblCollTime.Enabled := True;
2978	cboColltime.Enabled := True;
2979	with Responses, ALabTest do
2980	begin
2981	RespCollect := FindResponseByName('COLLECT',1);
2982	RespStart := FindResponseByName('START' ,1);
2983	if (RespCollect <> nil) then with RespCollect do
2984	begin
2985	if IValue = 'LC' then
2986	begin
2987	if not LabCanCollect then
2988	begin
2989	cboCollType.SelectByID('WC');
2990	SetupCollTimes('WC');
2991	end
2992	else // if LabCanCollect
2993	begin
2994	cboCollType.SelectByID('LC');
2995	SetupCollTimes('LC');
2996	CtrlInits.SetControl(cboCollTime, 'Lab Collection Times') ;
2997	if RespStart <> nil then
2998	begin
2999	cboCollTime.SelectByID('L' + RespStart.IValue);
3000	if cboCollTime.ItemIndex < 0 then
3001	cboCollTime.Text := RespStart.IValue;
3002	end;
3003	end;
3004	end
3005	else // if IValue <> 'LC'
3006	begin
3007	cboCollType.SelectByID(IValue) ;
3008	SetupCollTimes(IValue);
3009	if RespStart <> nil then
3010	begin
3011	if ContainsAlpha(RespStart.IValue) then
3012	calColltime.Text := RespStart.IValue
3013	else
3014	calColltime.FMDateTime := StrToFMDateTime(RespStart.IValue);
3015	end;
3016	end ;
3017	if IValue = 'I' then
3018	if not LabCanCollect then
3019	begin
3020	cboCollType.SelectByID('WC');
3021	SetupCollTimes('WC');
3022	end
3023	else
3024	begin
3025	calCollTime.Enabled := False;
3026	if RespStart <> nil then txtImmedColl.Text := RespStart.EValue;
3027	end;
3028	end
3029	else // if (RespCollect = nil)
3030	LoadCollType(cbocollType);
3031	end;
3032	end;
3033
3034	procedure TfrmODBBank.cboAvailTestExit(Sender: TObject);
3035	begin
3036	inherited;
3037	if (Length(cboAvailTest.ItemID) = 0) or (cboAvailTest.ItemID = '0') then Exit;
3038	if cboAvailTest.ItemID = FLastLabID then Exit;
3039	cboAvailTestSelect(cboAvailTest);
3040	cboAvailTest.SetFocus;
3041	PostMessage(Handle, WM_NEXTDLGCTL, 0, 0);
3042	end;
3043
3044	procedure TfrmODBBank.cboAvailCompChange(Sender: TObject);
3045	begin
3046	inherited;
3047	changing := true;
3048	changing := false;
3049	end;
3050
3051	procedure TfrmODBBank.cboAvailCompExit(Sender: TObject);
3052	begin
3053	inherited;
3054	if (Length(cboAvailComp.ItemID) = 0) or (cboAvailComp.ItemID = '0') then Exit;
3055	if cboAvailComp.ItemID = FLastLabID then Exit;
3056	cboAvailCompSelect(cboAvailComp);
3057	cboAvailComp.SetFocus;
3058	PostMessage(Handle, WM_NEXTDLGCTL, 0, 0);
3059	end;
3060
3061	procedure TfrmODBBank.cboAvailTestNeedData(Sender: TObject;
3062	const StartFrom: String; Direction, InsertAt: Integer);
3063	begin
3064	cboAvailTest.ForDataUse(SubsetOfOrderItems(StartFrom, Direction, FVbecLookup));
3065	end;
3066
3067	procedure TfrmODBBank.cboAvailCompNeedData(Sender: TObject;
3068	const StartFrom: String; Direction, InsertAt: Integer);
3069	begin
3070	cboAvailComp.ForDataUse(SubsetOfOrderItems(StartFrom, Direction, FVbecLookup));
3071	end;
3072
3073	procedure TfrmODBBank.cmdImmedCollClick(Sender: TObject);
3074	var
3075	ImmedCollTime: string;
3076	begin
3077	inherited;
3078	ImmedCollTime := SelectImmediateCollectTime(Font.Size, txtImmedColl.Text);
3079	if ImmedCollTime <> '-1' then
3080	begin
3081	txtImmedColl.Text := ImmedCollTime;
3082	calCollTime.FMDateTime := StrToFMDateTime(ImmedCollTime);
3083	end
3084	else
3085	begin
3086	txtImmedColl.Clear;
3087	calCollTime.Clear;
3088	end;
3089	end;
3090
3091	procedure TfrmODBBank.pgeProductChange(Sender: TObject);
3092	begin
3093	inherited;
3094	case pgeProduct.TabIndex of
3095	TI_COMPONENT : begin
3096	memOrder.Visible := true;
3097	cmdAccept.Visible := true;
3098	pnlSelectedTests.Visible := true;
3099	lvSelectionList.Width := lvSelectionList.Width + 1; //added to fix font resize issue - funky column display
3100	end;
3101	TI_INFO : begin
3102	if lvSelectionList.Items.Count > 0 then
3103	begin
3104	memOrder.Visible := true;
3105	cmdAccept.Visible := true;
3106	pnlSelectedTests.Visible := true;
3107	end
3108	else
3109	begin
3110	memOrder.Visible := false;
3111	cmdAccept.Visible := false;
3112	pnlSelectedTests.Visible := false;
3113	end;
3114	end;
3115	TI_RESULTS : begin
3116	if lvSelectionList.Items.Count > 0 then
3117	begin
3118	memOrder.Visible := true;
3119	cmdAccept.Visible := true;
3120	pnlSelectedTests.Visible := true;
3121	end
3122	else
3123	begin
3124	memOrder.Visible := false;
3125	cmdAccept.Visible := false;
3126	pnlSelectedTests.Visible := false;
3127	end;
3128	end;
3129	end; {case}
3130	end;
3131
3132	procedure TfrmODBBank.cboCollTimeChange(Sender: TObject);
3133	var
3134	CollType: string;
3135	const
3136	TX_BAD_TIME = ' is not a routine lab collection time.' ;
3137	TX_BAD_TIME_CAP = 'Invalid Time';
3138	begin
3139	CollType := 'LC';
3140	with cboCollTime do
3141	begin
3142	if ItemID = 'LO' then
3143	begin
3144	ItemIndex := -1;
3145	Text := GetFutureLabTime(FMToday);
3146	end;
3147	end;
3148	cboCollType.SelectByID(CollType);
3149	if uSelectedItems.Count > 0 then
3150	begin
3151	with cboCollTime do
3152	if Length(ItemID) > 0 then
3153	begin
3154	Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
3155	FLastLabCollTime := ItemID + U + Text;
3156	end
3157	else if Length(Text) > 0 then
3158	begin
3159	Responses.Update('START', 1, ValidCollTime(Text), Text) ;
3160	FLastLabCollTime := ValidCollTime(Text);
3161	end;
3162	end;
3163	end;
3164
3165	procedure TfrmODBBank.cboCollTypeChange(Sender: TObject);
3166	begin
3167	if (ALabTest = nil) or Changing or (cboCollType.ItemID = '') then exit;
3168	if (cboCollType.ItemID = 'I') and (not ALabTest.LabCanCollect) then
3169	begin
3170	InfoBox(TX_NO_IMMED, TX_NO_IMMED_CAP, MB_OK or MB_ICONWARNING);
3171	cboCollType.ItemIndex := -1;
3172	Exit;
3173	end;
3174	if cboCollType.ItemID = 'I' then
3175	begin
3176	cboCollTime.ItemIndex := -1;
3177	cboCollTime.Text := 'NOW';
3178	calCollTime.Text := 'NOW';
3179	end;
3180	SetupCollTimes(cboCollType.ItemID);
3181	if Length(cboCollType.Text) > 0 then Responses.Update('COLLECT',1,cboCollType.ItemID,cboCollType.ItemID);
3182	FLastCollType := cboCollType.ItemID;
3183	calCollTimeChange(self);
3184	end;
3185
3186	procedure TfrmODBBank.cboModifiersChange(Sender: TObject);
3187	var
3188	i: integer;
3189	ListItem: TListItem;
3190	x,q,m: string;
3191	begin
3192	inherited;
3193	if changing = true then Exit;
3194	if (cboAvailComp.ItemIndex <> -1) and (uSelectedItems.Count > 0) then
3195	begin
3196	for i := 0 to lvSelectionList.Items.Count - 1 do
3197	begin
3198	x := uSelectedItems[i];
3199	m := piece(x,'^',4);
3200	q := piece(x,'^',3);
3201	if lvSelectionList.Items[i].Caption = piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2) then
3202	begin
3203	ListItem := lvSelectionList.Items[i];
3204	ListItem.SubItems.Clear;
3205	ListItem.SubItems.Add(q);
3206	if length(cboModifiers.ItemID) > 0 then
3207	begin
3208	ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]);
3209	ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex));
3210	end
3211	else
3212	begin
3213	ListItem.SubItems.Add('');
3214	ListItem.SubItems.Add('');
3215	end;
3216	ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
3217	Responses.Update('MODIFIER', (i+1), cboModifiers.Text, cboModifiers.Text);
3218	Break;
3219	end;
3220	end;
3221	end;
3222	if Length(cboModifiers.Text) > 0 then
3223	begin
3224	memOrder.Text := Responses.OrderText;
3225	end;
3226	end;
3227
3228	procedure TfrmODBBank.LoadModifiers(AComboBox:TORComboBox);
3229	var
3230	i: integer;
3231	begin
3232	with AComboBox do
3233	begin
3234	Clear;
3235	for i := 0 to uModifierList.Count - 1 do
3236	Items.Add(uModifierList[i]);
3237	end;
3238	end;
3239
3240	procedure TfrmODBBank.LoadReasons(AComboBox:TORComboBox);
3241	var
3242	i: integer;
3243	begin
3244	with AComboBox do
3245	begin
3246	Clear;
3247	for i := 0 to uReasonsList.Count - 1 do
3248	Items.Add(uReasonsList[i]);
3249	end;
3250	end;
3251
3252	procedure TfrmODBBank.LoadUrgencies(AComboBox:TORComboBox);
3253	var
3254	i: integer;
3255	begin
3256	with AComboBox do
3257	begin
3258	Clear;
3259	for i := 0 to uUrgencyList.Count - 1 do
3260	if (piece(uUrgencyList[i],'^',2) = 'STAT') and (StatAllowed(Patient.DFN) = false) then
3261	Continue
3262	else
3263	Items.Add(uUrgencyList[i]);
3264	end;
3265	end;
3266
3267	procedure TfrmODBBank.lvSelectionListClick(Sender: TObject);
3268	var
3269	ListItem: TListItem;
3270	x,y: string;
3271	i,j: integer;
3272	begin
3273	inherited;
3274	if lvSelectionList.Selected = nil then Exit;
3275	ListItem := lvSelectionList.Selected;
3276	changing := true;
3277	tQuantity.Text := '';
3278	cboModifiers.ItemIndex := -1;
3279	i := lvSelectionList.ItemIndex;
3280	j := 0;
3281	if cboCollType.ItemID = 'LC' then
3282	begin
3283	if FLastLabCollTime <> '' then
3284	cboCollTime.SelectByID(piece(FLastLabCollTime,'^',1));
3285	end
3286	else
3287	begin
3288	if FLastCollTime = 'TODAY' then
3289	calCollTime.Text := FLastCollTime
3290	else if FLastCollTime = 'NOW' then
3291	calCollTime.Text := FLastCollTime
3292	else if FLastCollTime <> '' then
3293	calCollTime.Text := FormatFMDateTime('mmm dd,yyyy@hh:nn',StrToFMDateTime(FLastCollTime));
3294	end;
3295	if FLastCollType <> '' then
3296	cboCollType.SelectByID(FLastCollType);
3297	if uSelectedItems.Count > 0 then
3298	begin
3299	x := uSelectedItems[i];
3300	ALabTest := TLabTest.Create(piece(uSelectedItems[i],'^',2), Responses);
3301	if not(piece(x,'^',2) = '') then j := StrToInt(piece(x,'^',2));
3302	if not(piece(x,'^',1) = '1') and (j > 0) then //Components
3303	begin
3304	DisableDiagTestControls;
3305	EnableComponentControls;
3306	y := ListItem.SubItems[2];
3307	changing := true;
3308	cboModifiers.Text := '';
3309	cboAvailComp.SelectByIEN(j);
3310	tQuantity.Text := ListItem.SubItems[0];
3311	changing := false;
3312	if y <> '' then cboModifiers.ItemIndex := StrToInt(y);
3313	end
3314	else //Diagnostic Tests
3315	begin
3316	DisableComponentControls;
3317	EnableDiagTestControls;
3318	cboAvailTest.SelectByIEN(j);
3319	end;
3320	end;
3321	changing := false;
3322	end;
3323
3324	procedure TfrmODBBank.memDiagCommentChange(Sender: TObject);
3325	begin
3326	inherited;
3327	if (length(memDiagComment.Text) > 250) then
3328	begin
3329	ShowMsg('COMMENT cannot be longer than 250 characters');
3330	memDiagComment.Text := Copy(memDiagComment.Text,0,250);
3331	Exit;
3332	end;
3333	if lvSelectionList.Items.Count < 1 then Exit;
3334
3335	if uSelectedItems = nil then Exit;
3336
3337	if uSelectedItems.Count > 0 then
3338	Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
3339	memOrder.Text := Responses.OrderText;
3340	end;
3341
3342	procedure TfrmODBBank.FormDestroy(Sender: TObject);
3343	begin
3344	inherited;
3345	uSelectedItems.Free;
3346	uVBECList.Free;
3347	uTestsForResults.Free;
3348	uUrgencyList.Free;
3349	uTNSOrders.Free;
3350	uModifierList.Free;
3351	uReasonsList.Free;
3352	uRaw.Free;
3353	end;
3354
3355	procedure TfrmODBBank.btnRemoveClick(Sender: TObject);
3356	var
3357	i,j,curAdd: integer;
3358	x, aName, aModifier, aReason, aTypeScreen: string;
3359	aList: TStringList;
3360	aSel, aSelTst : boolean;
3361	begin
3362	inherited;
3363	aList := TStringList.Create;
3364	try
3365	curAdd := 1;
3366	aModifier := '';
3367	aReason := '';
3368	aTypeScreen := '';
3369	aSel := false;
3370	aSelTst := false;
3371	ExtractTypeScreen(aList, uVBECList);
3372	if aList.Count > 0 then aTypeScreen := aList[0];
3373	aList.Clear;
3374	if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex];
3375	if length(cboReasons.ItemID) > 0 then aReason := cboReasons.Items[cboReasons.ItemIndex];
3376	if lvSelectionList.Items.Count < 1 then
3377	begin
3378	ShowMsg('There is nothing in the list to remove.');
3379	exit;
3380	end;
3381	cboAvailComp.ItemIndex := -1;
3382	tQuantity.Text := '';
3383	cboAvailTest.ItemIndex := -1;
3384	uGetTnS := 0;
3385	lblTNS.Caption := '';
3386	lblTNS.Visible := false;
3387	memMessage.Text := '';
3388	pnlMessage.Visible := false;
3389	pnlDiagnosticTests.Caption := 'Diagnostic Tests';
3390	with lvSelectionList do
3391	begin
3392	for i := lvSelectionList.Items.Count - 1 downto 0 do
3393	begin
3394	if lvSelectionList.Items[i].Selected = true then
3395	begin
3396	aSel := true;
3397	for j := uSelectedItems.Count - 1 downto 0 do
3398	if lvSelectionList.Items[i].SubItems[3] = piece(uSelectedItems[j],'^',2) then
3399	begin
3400	{if (uGetTnS = 1) and (lvSelectionList.Items[i].SubItems[3] = aTypeScreen) then
3401	begin
3402	uGetTnS := 1;
3403	lblTNS.Caption := 'TYPE+SCREEN must be added to order';
3404	lblTNS.Visible := true;
3405	memMessage.Text := 'TYPE + SCREEN must be added to order';
3406	//memMessage.Visible := true;
3407	pnlMessage.Visible := true;
3408	pnlDiagnosticTests.Caption := 'Diagnostic Tests*';
3409	end; }
3410	uSelectedItems.Delete(j);
3411	lvSelectionList.Items[i].Delete;
3412	break;
3413	end;
3414	end;
3415	end;
3416	end;
3417	for i := uSelectedItems.Count - 1 downto 0 do
3418	begin
3419	if (not(piece(uSelectedItems[i],'^',1) = '1')) and (uTNSOrders.Count < 1) then // and (SpecimenNeeded(aList, uVBECList, StrToInt(piece(uSelectedItems[i],'^',9)))) then
3420	begin
3421	uGetTnS := 1;
3422	lblTNS.Caption := 'TYPE+SCREEN must be added to order';
3423	lblTNS.Visible := true;
3424	memMessage.Text := 'TYPE + SCREEN must be added to order';
3425	//memMessage.Visible := true;
3426	pnlMessage.Visible := true;
3427	pnlDiagnosticTests.Caption := 'Diagnostic Tests*';
3428	break;
3429	end;
3430	end;
3431
3432	if (aSel = false) and (lvSelectionList.Items.Count > 0) then
3433	begin
3434	ShowMsg('Please select an item from the list to be removed.');
3435	exit;
3436	end;
3437	Responses.Clear;
3438	if lvSelectionList.Items.Count < 1 then
3439	begin
3440	cboReasons.ItemIndex := -1;
3441	memDiagComment.Text := '';
3442	cboSurgery.ItemIndex := -1;
3443	cboUrgency.ItemIndex := -1;
3444	cboCollType.ItemIndex := -1;
3445	cboCollTime.ItemIndex := -1;
3446	cboQuick.ItemIndex := -1;
3447	calCollTime.Text := '';
3448	end;
3449	for i := 0 to uSelectedItems.Count - 1 do
3450	begin
3451	aName := lvSelectionList.Items[i].Caption;
3452	x := uSelectedItems[i];
3453	if piece(x,'^',1) = '1' then //Diagnostic Test related fields
3454	begin
3455	if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
3456	aSelTst := true;
3457	end
3458	else
3459	begin
3460	if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
3461	if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3));
3462	if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), aModifier);
3463	if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5));
3464	cboModifiers.ItemIndex := -1;
3465	cboAvailComp.ItemIndex := -1;
3466	tQuantity.Text := '';
3467	end;
3468	Inc(CurAdd);
3469	end;
3470	if aSelTst = false then
3471	begin
3472	cboCollType.ItemIndex := -1;
3473	cboCollTime.ItemIndex := -1;
3474	calCollTime.Text := '';
3475	end;
3476	if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
3477	if cboCollType.ItemID = 'LC' then
3478	begin
3479	with cboCollTime do
3480	if Length(ItemID) > 0 then
3481	begin
3482	Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
3483	FLastLabCollTime := ItemID + U + Text;
3484	end
3485	else if Length(Text) > 0 then
3486	begin
3487	Responses.Update('START', 1, ValidCollTime(Text), Text) ;
3488	FLastLabCollTime := ValidCollTime(Text);
3489	end;
3490	end
3491	else
3492	begin
3493	with calCollTime do
3494	if FMDateTime > 0 then
3495	begin
3496	Responses.Update('START', 1, ValidCollTime(Text), Text);
3497	FLastColltime := ValidCollTime(Text);
3498	end
3499	else
3500	begin
3501	Responses.Update('START', 1, '', '') ;
3502	FLastCollTime := '';
3503	end;
3504	end;
3505	with cboCollType do if Length(ItemID) > 0 then
3506	begin
3507	Responses.Update('COLLECT', 1, ItemID, ItemID) ;
3508	FLastCollType := ItemID;
3509	end;
3510	if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
3511	if Length(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
3512	if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
3513	if Length(cboReasons.Text) > 0 then Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text);
3514	if chkConsent.Checked = true then Responses.Update('YN',1,'1','Yes');
3515	memOrder.Text := Responses.OrderText;
3516	CurAdd := 1;
3517	if uRaw.Count > 0 then
3518	for j := 0 to uRaw.Count - 1 do
3519	begin
3520	if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));
3521	Inc(CurAdd);
3522	end;
3523	if uSelectedItems.Count < 1 then
3524	begin
3525	uGetTnS := 0;
3526	lblTNS.Caption := '';
3527	lblTNS.Visible := false;
3528	memMessage.Text := '';
3529	pnlMessage.Visible := false;
3530	GroupBox1.Visible := true;
3531	pnlDiagnosticTests.Caption := 'Diagnostic Tests';
3532	end;
3533	finally
3534	aList.Free;
3535	end;
3536	end;
3537
3538	procedure TfrmODBBank.btnUpdateCommentsClick(Sender: TObject);
3539	begin
3540	inherited;
3541	pnlComments.Visible := false;
3542	pnlComments.SendToBack;
3543	Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
3544	memOrder.Text := Responses.OrderText;
3545	end;
3546
3547	procedure TfrmODBBank.btnCancelCommentClick(Sender: TObject);
3548	begin
3549	inherited;
3550	pnlComments.Visible := false;
3551	pnlComments.SendToBack;
3552	end;
3553
3554	procedure TfrmODBBank.btnRemoveAllClick(Sender: TObject);
3555	begin
3556	inherited;
3557	if lvSelectionList.Items.Count < 1 then
3558	begin
3559	ShowMsg('There is nothing in the list to remove.');
3560	exit;
3561	end;
3562	lvSelectionList.Clear;
3563	uSelectedItems.Clear;
3564	uTestsForResults.Clear;
3565	uRaw.Clear;
3566	uGetTnS := 0;
3567	lblTNS.Caption := '';
3568	lblTNS.Visible := false;
3569	memMessage.Text := '';
3570	pnlMessage.Visible := false;
3571	InitDialog;
3572	cboModifiers.ItemIndex := -1;
3573	cboAvailTest.ItemIndex := -1;
3574	cboAvailComp.ItemIndex := -1;
3575	cboSurgery.ItemIndex := -1;
3576	cboUrgency.ItemIndex := -1;
3577	cboReasons.ItemIndex := -1;
3578	cboCollType.ItemIndex := -1;
3579	cboCollTime.ItemIndex := -1;
3580	cboQuick.ItemIndex := -1;
3581	calWantTime.Text := '';
3582	memDiagComment.Text := '';
3583	GroupBox1.Visible := true;
3584	tQuantity.Text := '';
3585	FLastCollType := '';
3586	FLastCollTime := '';
3587	FLastLabCollTime := '';
3588	txtImmedColl.Text := '';
3589	end;
3590
3591	procedure TfrmODBBank.cmdAcceptClick(Sender: TObject);
3592	var
3593	i: integer;
3594	Comp: boolean;
3595	const
3596	Txt1 = 'This order can not be saved for the following reason(s):';
3597	Txt2 = #13+#13+'An order for TYPE and SCREEN must be created with this order set.';
3598	begin
3599	if not ValidAdd then Exit;
3600	if uGetTnS = 1 then
3601	begin
3602	MessageDlg(Txt1+Txt2, mtWarning,[mbOK],0);
3603	Exit;
3604	end;
3605	Comp := false;
3606	if uSelectedItems.Count > 0 then
3607	begin
3608	for i := 0 to uSelectedItems.Count - 1 do
3609	if not (piece(uSelectedItems[i],'^',1) = '1') then
3610	begin
3611	Comp := true;
3612	Break;
3613	end;
3614	end;
3615	if Comp = true then
3616	begin
3617	if NursAdminSuppress = true then
3618	ShowMsg('The nursing blood administration order must be entered separately' + '.');
3619	end;
3620	inherited;
3621	end;
3622
3623	procedure TfrmODBBank.calWantTimeChange(Sender: TObject);
3624	begin
3625	inherited;
3626	if uSelectedItems.Count > 0 then
3627	begin
3628	with calWantTime do if not Changing then
3629	begin
3630	if FMDateTime = 0 then
3631	begin
3632	ShowMsg('Invalid Date/Time entered');
3633	Changing := true;
3634	calWantTime.Text := '';
3635	Changing := false;
3636	Exit;
3637	end
3638	else
3639	begin
3640	// date/time was entered
3641	if (UpperCase(Text) <> 'NOW') and not(Trunc(FMNow) = Trunc(FMDateTime)) and (FMDateTime < FMNow) then
3642	begin
3643	ShowMsg('Date/Time Wanted must be a future Date/Time');
3644	Changing := true;
3645	calWantTime.Text := '';
3646	Changing := false;
3647	Exit;
3648	end;
3649	end;
3650	end;
3651	if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
3652	memOrder.Text := Responses.OrderText;
3653	end;
3654	end;
3655
3656	procedure TfrmODBBank.chkConsentClick(Sender: TObject);
3657	begin
3658	inherited;
3659	if uSelectedItems.Count > 0 then
3660	begin
3661	if chkConsent.Checked = true then Responses.Update('YN',1,'1','Yes');
3662	memOrder.Text := Responses.OrderText;
3663	end;
3664	end;
3665
3666	procedure TfrmODBBank.cboUrgencyChange(Sender: TObject);
3667	begin
3668	inherited;
3669	if Length(cboUrgency.Text) > 0 then
3670	begin
3671	Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
3672	uSelUrgency := cboUrgency.Text;
3673	if cboUrgency.Text = 'PRE-OP' then
3674	begin
3675	lblSurgery.Enabled := true;
3676	cboSurgery.Enabled := true;
3677	lblSurgery.Caption := 'Surgery*';
3678	end
3679	else
3680	begin
3681	lblSurgery.Enabled := false;
3682	cboSurgery.Enabled := false;
3683	lblSurgery.Caption := 'Surgery';
3684	cboSurgery.ItemIndex := -1;
3685	Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
3686	end;
3687	end
3688	else
3689	cboUrgency.SelectByID(IntToStr(uDfltUrgency));
3690	memOrder.Text := Responses.OrderText;
3691	end;
3692
3693	procedure TfrmODBBank.cboUrgencyExit(Sender: TObject);
3694	begin
3695	inherited;
3696	if Length(cboUrgency.Text) < 1 then
3697	cboUrgency.SelectByID(IntToStr(uDfltUrgency));
3698	end;
3699
3700	procedure TfrmODBBank.cboSurgeryChange(Sender: TObject);
3701	var
3702	aList: TStringList;
3703	i,j,aMSBOS,aMSBOSContinue: integer;
3704	x: string;
3705	handled: boolean;
3706	begin
3707	inherited;
3708	aList := TStringList.Create;
3709	handled := false;
3710	try
3711	if (Length(cboSurgery.ItemID) > 0) and (Length(tQuantity.Text) > 0) then
3712	begin
3713	aList.Clear;
3714	ExtractMSBOS(aList, uVBECList); //Get maximum units for selected Surgey
3715	for i := 0 to aList.Count - 1 do
3716	begin
3717	if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
3718	and (piece(aList[i],'^',3) = cboSurgery.Text) then
3719	begin
3720	aMSBOS := StrToInt(piece(aList[i],'^',4));
3721	if (aMSBOS > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then
3722	begin
3723	with Application do
3724	begin
3725	NormalizeTopMosts;
3726	aMSBOSContinue :=
3727	MessageBox(PChar('The number of unit Quantity selected (' + tQuantity.Text +
3728	') for ' + aLabTest.TestName + ' exceeds the maximum number of units ('
3729	+ IntToStr(aMSBOS) +
3730	') for the ' + cboSurgery.text +
3731	' surgical procedure selected.' + CRLF + CRLF + 'Continue to order ' + tQuantity.Text + ' units?'),
3732	PChar('Maximum Number of Units Exceeded'),
3733	MB_YESNO);
3734	RestoreTopMosts;
3735	end;
3736	if aMSBOSContinue = 7 then
3737	begin
3738	ShowMsg('Please enter a new quantity for ' + cboAvailComp.Text);
3739	tQuantity.Text := '0';
3740	tQuantity.SelLength := 2;
3741	tQuantity.SelectAll;
3742	break;
3743	end;
3744	end;
3745	handled := true;
3746	break;
3747	end;
3748	end;
3749	end;
3750	if (handled = false) and (Length(cboSurgery.ItemID) > 0) and (uSelectedItems.Count > 0) then
3751	begin
3752	aList.Clear;
3753	ExtractMSBOS(aList, uVBECList); //Get maximum units for selected Surgey
3754	for j := 0 to uSelectedItems.Count - 1 do
3755	begin
3756	ALabTest := TLabTest.Create(piece(uSelectedItems[j],'^',2), Responses);
3757	for i := 0 to aList.Count - 1 do
3758	begin
3759	if (piece(uSelectedItems[j],'^',1) = '0')
3760	and (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
3761	and (piece(aList[i],'^',3) = cboSurgery.Text) then
3762	begin
3763	aMSBOS := StrToInt(piece(aList[i],'^',4));
3764	if (aMSBOS > 0) and (length(piece(uSelectedItems[j],'^',3)) > 0) and (StrToInt(piece(uSelectedItems[j],'^',3)) > aMSBOS) then
3765	begin
3766	with Application do
3767	begin
3768	NormalizeTopMosts;
3769	aMSBOSContinue :=
3770	MessageBox(PChar('The number of unit Quantity selected (' + piece(uSelectedItems[j],'^',3) +
3771	') for ' + lvSelectionList.Items[j].Caption + ' exceeds the maximum number of units ('
3772	+ IntToStr(aMSBOS) +
3773	') for the ' + cboSurgery.text +
3774	' surgical procedure selected.' + CRLF + CRLF + 'Continue to order ' + piece(uSelectedItems[j],'^',3) + ' units?'),
3775	PChar('Maximum Number of Units Exceeded'),
3776	MB_YESNO);
3777	RestoreTopMosts;
3778	end;
3779	if aMSBOSContinue = 7 then
3780	begin
3781	ShowMsg('Please enter a new quantity for ' + lvSelectionList.Items[j].Caption);
3782	tQuantity.Text := '0';
3783	tQuantity.SelLength := 2;
3784	tQuantity.SelectAll;
3785	x := uSelectedItems[j];
3786	SetPiece(x,U,3,'');
3787	uSelectedItems[j] := x;
3788	lvSelectionList.Items[j].SubItems[0] := '';
3789	RePaint;
3790	break;
3791	end;
3792	end;
3793	break;
3794	end;
3795	end;
3796	end;
3797	end;
3798	if uSelectedItems.Count > 0 then
3799	if Length(cboSurgery.Text) > 0 then
3800	Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
3801	uSelSurgery := 0;
3802	if Length(cboSurgery.Text) > 0 then
3803	begin
3804	if length(cboSurgery.ItemID) > 0 then uSelSurgery := cboSurgery.ItemID;
3805	cboReasons.Text := cboSurgery.Text;
3806	Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text);
3807	end;
3808	memOrder.Text := Responses.OrderText;
3809	finally
3810	aList.Free;
3811	end;
3812	end;
3813
3814	procedure TfrmODBBank.cboSurgeryClick(Sender: TObject);
3815	begin
3816	inherited;
3817	if Length(cboSurgery.Text) > 0 then uSelSurgery := cboSurgery.ItemID;
3818	end;
3819
3820	procedure TfrmODBBank.tQuantityChange(Sender: TObject);
3821	var
3822	aList: TStringList;
3823	i,aMSBOS,aMSBOSContinue: integer;
3824	ListItem: TListItem;
3825	x,m: string;
3826	begin
3827	inherited;
3828	if changing = true then Exit;
3829	aList := TStringList.Create;
3830	if Length(tQuantity.Text) > 0 then
3831	begin
3832	if Length(tQuantity.Text) > 2 then
3833	begin
3834	ShowMsg('Invalid entry. Please select a numeric value <100');
3835	tQuantity.Text := '';
3836	Exit;
3837	end;
3838	if StrToInt(tQuantity.Text) > 100 then
3839	begin
3840	ShowMsg('Quantity too high. Please select a value <100');
3841	tQuantity.Text := Copy(tQuantity.Text,0,1);
3842	Exit;
3843	end;
3844	end;
3845	try
3846	if (Length(cboSurgery.ItemID) > 0) and (Length(tQuantity.Text) > 0) then
3847	begin
3848	aList.Clear;
3849	ExtractMSBOS(aList, uVBECList); //Get maximum units for selected Surgery
3850	for i := 0 to aList.Count - 1 do
3851	begin
3852	if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
3853	and (piece(aList[i],'^',3) = cboSurgery.Text) then
3854	begin
3855	aMSBOS := StrToInt(piece(aList[i],'^',4));
3856	if (aMSBOS > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then
3857	begin
3858	with Application do
3859	begin
3860	NormalizeTopMosts;
3861	aMSBOSContinue :=
3862	MessageBox(PChar('The number of units ordered (' + tQuantity.Text +
3863	') for ' + aLabTest.TestName + ' exceeds the maximum number of units ('
3864	+ IntToStr(aMSBOS) +
3865	') for the ' + cboSurgery.text +
3866	' surgical procedure selected.' + CRLF + CRLF + 'Do you wish to continue?'),
3867	PChar('Maximum Number of Units Exceeded'),
3868	MB_YESNO);
3869	RestoreTopMosts;
3870	end;
3871	if aMSBOSContinue = 7 then
3872	begin
3873	ShowMsg('Please enter a new quantity for ' + cboAvailComp.Text);
3874	tQuantity.Text := '0';
3875	tQuantity.SelLength := 2;
3876	tQuantity.SelectAll;
3877	break;
3878	end;
3879	end;
3880	break;
3881	end;
3882	end;
3883	end;
3884	if (cboAvailComp.ItemIndex <> -1) and (uSelectedItems.Count > 0) then
3885	for i := 0 to lvSelectionList.Items.Count - 1 do
3886	begin
3887	if lvSelectionList.Items[i].Caption = piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2) then
3888	begin
3889	x := uSelectedItems[i];
3890	m := piece(x,'^',4);
3891	ListItem := lvSelectionList.Items[i];
3892	ListItem.SubItems.Clear;
3893	ListItem.SubItems.Add(tQuantity.Text);
3894	SetPiece(x,U,3,tQuantity.Text);
3895	Responses.Update('QTY', (i+1), tQuantity.Text, tQuantity.Text);
3896	uSelectedItems[i] := x;
3897	if length(cboModifiers.ItemID) > 0 then
3898	begin
3899	ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]);
3900	ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex));
3901	end
3902	else
3903	begin
3904	ListItem.SubItems.Add('');
3905	ListItem.SubItems.Add('');
3906	end;
3907
3908	ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
3909	Break;
3910	end;
3911	end;
3912	if Length(tQuantity.Text) > 0 then
3913	begin
3914	memOrder.Text := Responses.OrderText;
3915	end;
3916	finally
3917	aList.Free;
3918	end;
3919	end;
3920
3921	procedure TfrmODBBank.tQuantityClick(Sender: TObject);
3922	begin
3923	inherited;
3924	tQuantity.SelLength := 2;
3925	tQuantity.SelectAll;
3926	end;
3927
3928	procedure TfrmODBBank.tQuantityEnter(Sender: TObject);
3929	begin
3930	inherited;
3931	tQuantity.SelLength := 2;
3932	tQuantity.SelectAll;
3933	end;
3934
3935	procedure TfrmODBBank.calCollTimeChange(Sender: TObject);
3936	begin
3937	inherited;
3938	if uSelectedItems.Count > 0 then
3939	begin
3940	if cboCollType.ItemID = 'LC' then
3941	begin
3942	with cboCollTime do
3943	if Length(ItemID) > 0 then
3944	begin
3945	Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
3946	FLastLabCollTime := ItemID + U + Text;
3947	end
3948	else if Length(Text) > 0 then
3949	begin
3950	Responses.Update('START', 1, ValidCollTime(Text), Text) ;
3951	FLastLabCollTime := ValidCollTime(Text);
3952	end;
3953	end
3954	else
3955	begin
3956	with calCollTime do
3957	if FMDateTime > 0 then
3958	begin
3959	Responses.Update('START', 1, ValidCollTime(Text), Text);
3960	FLastColltime := ValidCollTime(Text);
3961	end
3962	else
3963	begin
3964	Responses.Update('START', 1, '', '') ;
3965	FLastCollTime := '';
3966	end;
3967	end;
3968	memOrder.Text := Responses.OrderText;
3969	end;
3970	end;
3971
3972	end.

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

Download in other formats: