Context Navigation

fODBBank.pas@ 1768

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

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

Context Navigation

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

Download in other formats: