Context Navigation

fODBBank.pas@ 1722

Last change on this file since 1722 was 1679, checked in by healthsevak, 10 years ago
Updating the working copy to CPRS version 28
File size: 166.4 KB

Rev	Line
[456]	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,
[829]	7	ORDtTm, Buttons, Menus, ImgList, VA508AccessibilityManager, VAUtils;
[456]	8
	9	type
	10	TfrmODBBank = class(TfrmODBase)
[829]	11	dlgLabCollTime: TORDateTimeDlg;
	12	ORWanted: TORDateTimeDlg;
	13	pnlComments: TPanel;
	14	btnUpdateComments: TButton;
	15	btnCancelComment: TButton;
	16	lblOrdComment: TLabel;
[456]	17	pgeProduct: TPageControl;
[829]	18	TabInfo: TTabSheet;
[456]	19	edtInfo: TCaptionRichEdit;
	20	TabDiag: TTabSheet;
	21	lblReqComment: TOROffsetLabel;
[829]	22	TabResults: TTabSheet;
	23	edtResults: TCaptionRichEdit;
[456]	24	pnlFields: TPanel;
	25	lblDiagComment: TOROffsetLabel;
	26	lblUrgency: TLabel;
[829]	27	lblReason: TLabel;
	28	lblSurgery: TLabel;
[456]	29	cboUrgency: TORComboBox;
	30	chkConsent: TCheckBox;
	31	cboSurgery: TORComboBox;
	32	pnlSelect: TPanel;
[829]	33	pnlDiagnosticTests: TGroupBox;
[456]	34	cboAvailTest: TORComboBox;
	35	pnlBloodComponents: TGroupBox;
	36	lblQuantity: TLabel;
[829]	37	lblModifiers: TLabel;
[456]	38	cboAvailComp: TORComboBox;
	39	tQuantity: TEdit;
	40	cboModifiers: TORComboBox;
[829]	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;
[1679]	59	lblTNS: TLabel;
	60	lblNoBloodReq: TLabel;
[829]	61	cmdImmedColl: TSpeedButton;
[1679]	62	Splitter1: TSplitter;
[456]	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);
[829]	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);
[1679]	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);
[456]	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);
[829]	135	procedure ExtractTNSOrders(OutList:TStrings; AList:TStrings);
[456]	136	procedure ExtractModifiers(OutList:TStrings; AList:TStrings);
[829]	137	procedure ExtractReasons(OutList:TStrings; AList:TStrings);
[456]	138	procedure ExtractSpecimens(OutList:TStrings; AList:TStrings);
	139	procedure ExtractTypeScreen(OutList:TStrings; AList:TStrings);
[829]	140	procedure ExtractOther(OutList:TStrings; AList:TStrings);
[456]	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);
[829]	146	procedure LoadReasons(AComboBox:TORComboBox);
	147
[456]	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;
[829]	157	FQuickList: Integer;
	158	FQuickItems: TStringList;
	159	FOrderAction: Integer;
[456]	160	procedure ReadServerVariables;
[829]	161	procedure SetOnQuickOrder;
[456]	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 }
[829]	191	Urgency: Integer; { IEN of urgency }
[456]	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}
[829]	201	UrgencyList: TStringList; { Strings: IEN^Urgency Name }
	202	ForceUrgency: Boolean; { true if not prompt Urgency }
[456]	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);
[829]	220	procedure LoadUrgency(CollType: string; AComboBox:TORComboBox);
[456]	221	function NameOfCollSamp: string;
	222	function NameOfSpecimen: string;
[829]	223	function NameOfUrgency: string;
[456]	224	function ObtainCollSamp: Boolean;
	225	function ObtainSpecimen: Boolean;
[829]	226	function ObtainUrgency: Boolean;
[456]	227	function ObtainComment: Boolean;
[829]	228
[456]	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
[829]	247	//TestYes(1)^Test-Component(2)^Qty(3)^Modifier(4)^Specimen(5,6)^CollTime(7)^CollType(8)
[456]	248	uVBECList: TStringList; //List of items from VBEC api
	249	uTestsForResults: TStringList; //List of tests to show results
	250	uUrgencyList: TStringList; //List of Urgencies
[829]	251	uTNSOrders: TStringList; //List of Current orders for Type & Screen
[456]	252	uModifierList: TStringList; //List of Modifiers
[829]	253	uReasonsList: TStringList; //List of Reasons for Request
[456]	254	uRaw: TStringList; //Results Array
	255	uTestSelected, uComponentSelected: Boolean; //Used on Validate
[829]	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
[456]	259	uSpecimen, uGetTnS: Integer; //Set to 1 if a specimen for test is already in lab... no need to collect
[829]	260	uDfltCollType, uReason: string;
[456]	261	ALabTest: TLabTest;
	262	UserHasLRLABKey: boolean;
[1679]	263	uChangingMSBOS: boolean;
[456]	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
[829]	278	TI_COMPONENT = 1;
[456]	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;
[829]	289	ListCount: Integer;
	290	x: string;
[456]	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;
[829]	300	uTNSOrders := TStringList.Create;
[456]	301	uModifierList := TStringList.Create;
[829]	302	uReasonsList := TStringList.Create;
[456]	303	uRaw := TStringList.Create;
	304	uSpecimen := 0;
	305	uGetTnS := 0;
[829]	306	uReason := '';
[456]	307	lblTNS.Caption := '';
	308	lblTNS.Visible := false;
[829]	309	pnlMessage.Visible := false;
[456]	310	uDfltUrgency := 9;
[829]	311	uSelUrgency := '';
	312	uSelSurgery := 0;
[1679]	313	uChangingMSBOS := false;
[829]	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.');
[456]	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;
[1679]	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;
[456]	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
[829]	359	FastAssign(ODForLab(EvtDelayLoc,EvtDivision), AList)
[456]	360	else
[829]	361	FastAssign(ODForLab(Encounter.Location,EvtDivision), AList);
[456]	362	end else
[829]	363	FastAssign(ODForLab(Encounter.Location), AList); // ODForLab returns TStrings with defaults
[456]	364	CtrlInits.LoadDefaults(AList);
	365	InitDialog;
[829]	366	GroupBox1.Visible := True;
[456]	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');
[1679]	377	//SetupCollTimes(cboCollType.ItemID);
[456]	378	end;
[1679]	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]);
[456]	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);
[1679]	402	if not(self.EvtID > 0) then ExtractTNSOrders(uTNSOrders, uVBECList);
[456]	403	LoadUrgencies(cboUrgency);
	404	ExtractModifiers(uModifierList, uVBECList);
[829]	405	ExtractReasons(uReasonsList, uVBECList);
[456]	406	LoadModifiers(cboModifiers);
[829]	407	LoadReasons(cboReasons);
[456]	408	pgeProduct.TabIndex := TI_INFO;
[829]	409	lvSelectionList.Column[0].Width := 240;
	410	lvSelectionList.Column[1].Width := 30;
	411	lvSelectionList.Column[2].Width := 100;
	412	DisableComponentControls;
	413	DisableDiagTestControls;
[1679]	414	pnlDiagnosticTests.Caption := 'Diagnostic Tests';
[456]	415	pgeProduct.ActivePageIndex := TI_INFO;
	416	StatusText('');
[829]	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;
[456]	428
[829]	429	FastAssign(FQuickItems, cboQuick.Items);
	430	if lvSelectionList.Items.Count > 0 then
	431	begin
	432	memOrder.Visible := true;
	433	cmdAccept.Visible := true;
	434	end;
[456]	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
[829]	460	AnInstance, CurAdd: Integer;
	461	AResponse: TResponse;
[1679]	462	i, j, k, aTNS, getTest, TestAdded, aMSBOSContinue: integer;
	463	aStr, aTestYes, aName, aTypeScreen, aSpecimen, aSpecimenUID, aSpecimenReq, aModifier, sub, sub1, x, aTNSString, aUrgText: string;
[829]	464	ListItem: TListItem;
[1679]	465	aList, cList: TStringList;
[829]	466	aTests: TStringList;
[1679]	467	xLabTest: TLabTest;
	468	aGotTNS : Boolean;
[456]	469	begin
	470	inherited;
[829]	471	aList := TStringList.Create;
[1679]	472	cList := TStringList.Create;
[829]	473	aTests:= TStringList.Create;
[1679]	474	aGotTNS := false;
[829]	475	try
	476	FOrderAction := OrderAction;
[456]	477	ReadServerVariables;
[829]	478	sub1 := '';
	479	aTypeScreen := '';
[1679]	480	aSpecimen := '';
	481	aSpecimenUID := '';
	482	aSpecimenReq := '';
[829]	483	aModifier := '';
	484	if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses, ALabTest do
[456]	485	begin
[1679]	486	pgeProduct.ActivePageIndex := TI_COMPONENT;
[829]	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);
[1679]	497	changing := true;
	498	cboAvailTestSelect(Self);
	499	changing := false;
[829]	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);
[1679]	514	SetControl(cboSurgery, 'MISC', AnInstance);
[829]	515	SetControl(cboUrgency, 'URGENCY', AnInstance);
[1679]	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;
[829]	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 ;
[1679]	537	cboUrgencyChange(self);
[829]	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;
[1679]	545	//DetermineCollectionDefaults(Responses);
[829]	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);
[1679]	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;
[829]	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);
[1679]	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;
[829]	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;
[1679]	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;
[829]	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;
[1679]	690	aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimenReq + '^' + aSpecimen + '^' + aSpecimenUID + '^' + IntToStr(aLabTest.ItemID);
[829]	691	uSelectedItems.Add(aStr);
	692	memOrder.Text := Responses.OrderText;
	693	Changing := False;
[1679]	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;
[829]	704	end;
	705	end;
	706	StatusText('');
	707	AnInstance := NextInstance('ORDERABLE', AnInstance);
	708	end; //while AnInstance - ORDERABLE
	709	DisableComponentControls;
	710	DisableDiagTestControls;
[456]	711	end;
[1679]	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
[829]	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
[1679]	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;
[829]	842	Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
	843	cboUrgencyChange(self);
	844	end;
	845	end;
	846	Inc(CurAdd);
	847	end;
[1679]	848	if uGetTnS = 1 then
[829]	849	begin
[1679]	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';
[829]	857	finally
	858	aList.Free;
[1679]	859	cList.Free;
[829]	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;
[1679]	868	lvSelectionList.Items[0].Selected := true;
	869	lvSelectionListClick(self);
[829]	870	end;
[456]	871	end;
	872
[829]	873	procedure TfrmODBBank.SetOnQuickOrder;
	874	var
	875	AnInstance: Integer;
	876	AResponse: TResponse;
	877	i: integer;
	878	x,sub,sub1,aTNSString: string;
[1679]	879	aList, cList: TStringList;
	880	aGotIt, aGotTNS: boolean;
[829]	881	aTests: TStringList;
	882	ListItem: TListItem;
[1679]	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;
[829]	886	begin
	887	inherited;
	888	aList := TStringList.Create;
[1679]	889	cList := TStringList.Create;
[829]	890	aTests := TStringList.Create;
[1679]	891	pgeProduct.ActivePageIndex := TI_COMPONENT;
[829]	892	try
	893	aModifier := '';
	894	aReason := '';
	895	aSurgery := '';
	896	aCollTime := '';
	897	aTestYes := '0';
	898	aTypeScreen := '';
	899	aSpecimen := '';
[1679]	900	aSpecimenUID := '';
	901	aSpecimenReq := '';
[829]	902	sub1 := '';
[1679]	903	aGotTNS := false;
[829]	904	ExtractTypeScreen(aList, uVBECList);
	905	if aList.Count > 0 then aTypeScreen := aList[0];
	906	aList.Clear;
[1679]	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;
[829]	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);
[1679]	963	if cboUrgency.ItemIEN = 0 then
[829]	964	begin
[1679]	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;
[829]	969	end;
	970	SetControl(cboSurgery, 'MISC', AnInstance);
[1679]	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;
[829]	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);
[1679]	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;
[829]	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;
[1679]	1046	aSpecimen := '';
	1047	aSpecimenUID := '';
	1048	aSpecimenReq := '';
[829]	1049	aTestYes := '0';
	1050	aReason := '';
	1051	aSurgery := '';
	1052	aCollTime := '';
	1053	ExtractSpecimen(aList, uVBECList);
[1679]	1054	if aList.Count > 0 then
	1055	begin
	1056	aSpecimen := piece(aList[0], '^', 1);
	1057	aSpecimenUID := piece(aList[0], '^', 2);
	1058	end;
[829]	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)
[1679]	1069	and (uppercase((piece(aList[i],'^',3))) = uppercase(cboSurgery.Text)) then
[829]	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 +
[1679]	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);
[829]	1087	RestoreTopMosts;
	1088	end;
[1679]	1089	if aMSBOSContinue = 6 then
[829]	1090	begin
	1091	ShowMsg(cboAvailComp.Text + ' has NOT been added to this request.');
[1679]	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 := '';
[829]	1121	exit;
	1122	end;
	1123	end;
	1124	end;
	1125	end;
	1126	end;
[1679]	1127	for i := lvSelectionList.Items.Count - 1 downto 0 do
[829]	1128	begin
[1679]	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
[829]	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
[1679]	1145	aSpecimenReq := piece(aList[i],'^',2);
	1146	if (SpecimenNeeded(aList, uVBECList, aLabTest.ItemID)) then
	1147	aSpecimenUID := '';
[829]	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;
[1679]	1170	aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimenReq + '^' + aSpecimen + '^' + aSpecimenUID + '^' + IntToStr(aLabTest.ItemID);
[829]	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);
[1679]	1211	//DetermineCollectionDefaults(Responses); //cboCollType = COLLECT , calCollTime = START
[829]	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
[1679]	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;
[829]	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;
[1679]	1266	aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimenReq + '^' + aSpecimen + '^' + aSpecimenUID + '^' + IntToStr(aLabTest.ItemID);
[829]	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;
[1679]	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;
[829]	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 +
[1679]	1364	'Do you wish to cancel this request for Type & Screen?'),
	1365	PChar('Type & Screen Entered in Past ' + IntToStr(TNSDaysBack) + ' Days'),
	1366	MB_YESNO);
[829]	1367	RestoreTopMosts;
[1679]	1368	if aTNS = 6 then
[829]	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*';
[1679]	1387	end
	1388	else pnlDiagnosticTests.Caption := 'Diagnostic Tests';
[829]	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;
[1679]	1430	cList.Free;
[829]	1431	aTests.Free;
	1432	end;
	1433	end;
	1434
[456]	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');
[829]	1453	UniqueCollSamp := false;
[456]	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)));
[829]	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;
[456]	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
[829]	1491	FastAssign(GetOneCollSamp(StrToInt(LRFSAMP)), OneSamp);
[456]	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;
[829]	1519	UrgencyList.Free;
[456]	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) ;
[829]	1680	FastAssign(SpecimenList, AComboBox.Items);
[456]	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
[829]	1708	procedure TLabTest.LoadUrgency(CollType: string; AComboBox:TORComboBox);
	1709	var
[1679]	1710	i, PreviousSelectionIndex: integer;
	1711	PreviousSelectionString: String;
[829]	1712	begin
	1713	if UrgencyList.Count < 1 then Exit;
	1714	with AComboBox do
	1715	begin
[1679]	1716	PreviousSelectionIndex := -1;
	1717	PreviousSelectionString := SelText;
[829]	1718	Clear;
	1719	for i := 0 to UrgencyList.Count - 1 do
[1679]	1720	begin
[829]	1721	if (CollType = 'LC') and (Piece(UrgencyList[i], U, 3) = '') then
	1722	Continue
	1723	else
	1724	Items.Add(UrgencyList[i]);
[1679]	1725	if (PreviousSelectionString <> '') and (PreviousSelectionString = Piece(UrgencyList[i], U, 2)) then
	1726	PreviousSelectionIndex := i;
	1727	end;
[829]	1728	if (LRFURG <> '') and (ALabTest.ObtainUrgency) then
	1729	SelectByID(LRFURG)
[1679]	1730	else if PreviousSelectionIndex > -1 then
	1731	ItemIndex := PreviousSelectionIndex
[829]	1732	else
	1733	SelectByIEN(uDfltUrgency);
	1734	Urgency := AComboBox.ItemIEN;
	1735	end;
	1736	end;
	1737
[456]	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
[829]	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
[456]	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
[829]	1790	function TLabTest.ObtainUrgency: Boolean;
	1791	begin
	1792	Result := not ForceUrgency;
	1793	end;
	1794
[456]	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
[829]	1805	procedure TfrmODBBank.ExtractReasons(OutList:TStrings; AList:TStrings);
	1806	begin
	1807	ExtractItems(Outlist, AList,'REASONS');
	1808	end;
	1809
[456]	1810	procedure TfrmODBBank.ExtractUrgencies(OutList:TStrings; AList:TStrings);
	1811	begin
	1812	ExtractItems(Outlist, AList,'URGENCIES');
	1813	end;
	1814
[829]	1815	procedure TfrmODBBank.ExtractTNSOrders(OutList:TStrings; AList:TStrings);
	1816	begin
	1817	ExtractItems(Outlist, AList,'TNS ORDERS');
	1818	end;
	1819
[456]	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
[829]	1835	procedure TfrmODBBank.ExtractOther(OutList:TStrings; AList:TStrings);
	1836	begin
	1837	ExtractItems(OutList, AList, 'OTHER');
	1838	end;
	1839
[456]	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;
[1679]	1864	aSpecimen, aSpecimenUID, aSpecimenDate: string;
[456]	1865	aWantDateTime, aExpiredSpecimenDate: TFMDateTime;
	1866	begin
	1867	result := false;
	1868	aborh := false;
	1869	aSpecimen := '';
[1679]	1870	aSpecimenUID := '';
[456]	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);
[1679]	1887	if OutList.Count > 0 then
	1888	begin
	1889	aSpecimen := Piece(OutList[0], '^',1);
	1890	aSpecimenUID := Piece(OutList[0], '^',2);
	1891	end;
[456]	1892	OutList.Clear;
	1893	ExtractItems(OutList,AList,'SPECIMENS');
	1894	aWantDateTime := calWantTime.FMDateTime;
[1679]	1895	aSpecimenDate := aSpecimen;
[456]	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
[1679]	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;
[456]	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
[829]	1936	begin
	1937	SetError(TX_NO_TESTS);
	1938	Exit;
	1939	end;
[456]	1940	if uGetTns = 1 then
[829]	1941	begin
	1942	SetError(TX_TNS_REQUIRED);
	1943	Exit;
	1944	end;
	1945	ValidateAdd(AnErrMsg);
[456]	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
[829]	1957	aList: TStringList;
	1958	i, DaysofFuturePast: integer;
[456]	1959	d1, d2: TDateTime;
[829]	1960	x,test,aOther: string;
[456]	1961	const
	1962	{Diagnostic Test Errors}
[829]	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' ;
[456]	1966	TX_BAD_TIME = 'Collection times must be chosen from the drop down list or entered as valid' +
[829]	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"';
[456]	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';
[829]	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';
[456]	1983	TX_BADTIME_CAP = 'Invalid Immediate Collect Time';
	1984	{Component/Type & Screen Errors}
[829]	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';
[456]	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';
[829]	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';
[456]	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 := '';
[829]	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
[456]	2006	begin
[829]	2007	AnErrMsg := TX_NO_TEST_SELECTED;
[456]	2008	Exit;
	2009	end;
[829]	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;
[456]	2062
[829]	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 + ')');
[456]	2083	end
[829]	2084	else //Component
[456]	2085	begin
[829]	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
[456]	2094	begin
[829]	2095	SetError(TX_NO_REASON + ' (' + test + ').' + ' Previously entered ''Reason for Request'' will be retained.');
	2096	cboReasons.Text := uReason; //reset reason back to previous value
[456]	2097	end;
[829]	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);
[456]	2106	end;
[829]	2107	end;
	2108	finally
	2109	aList.Free;
	2110	end;
[456]	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;
[1679]	2198	j: integer;
	2199	havetest: boolean;
[456]	2200	begin
[1679]	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;
[456]	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;
[1679]	2221	calCollTime.Enabled := True;
[456]	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));
[1679]	2228	calCollTime.FMDateTime := StrToFMDateTime(FLastCollTime);
[456]	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));
[1679]	2237	calCollTime.FMDateTime := StrToFMDateTime(tmpORECALLTime);
[456]	2238	end;
	2239	end
	2240	else if LRFDATE <> '' then
	2241	calCollTime.Text := LRFDATE
[1679]	2242	else if not(FOrderAction in [ORDER_EDIT]) then
	2243	calCollTime.Text := 'TODAY'
	2244	else if (havetest = false) then
[456]	2245	calCollTime.Text := 'TODAY';
[1679]	2246	if (havetest = false) and (RemoveCollTimeDefault = True) then
	2247	begin
	2248	calCollTime.Text := '';
	2249	calCollTime.FMDateTime := 0;
	2250	end;
[456]	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));
[1679]	2266	calCollTime.FMDateTime := StrToFMDateTime(FLastCollTime);
[456]	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));
[1679]	2275	calCollTime.FMDateTime := StrToFMDateTime(tmpORECALLTime);
[456]	2276	end;
	2277	end
	2278	else if LRFDATE <> '' then
	2279	calCollTime.Text := LRFDATE
[1679]	2280	else if not(FOrderAction in [ORDER_EDIT]) then
[456]	2281	calCollTime.Text := 'NOW';
[1679]	2282	if (havetest = false) and (RemoveCollTimeDefault = True) then
	2283	begin
	2284	calCollTime.Text := '';
	2285	calCollTime.FMDateTime := 0;
	2286	end;
[456]	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;
[1679]	2307	if (havetest = false) and (RemoveCollTimeDefault = True) then
	2308	begin
	2309	cboCollTime.Text := '';
	2310	end;
[456]	2311	end
	2312	else if CollType = 'I' then
	2313	begin
	2314	cboColltime.Visible := False;
	2315	calCollTime.Visible := False;
[1679]	2316	calCollTime.Enabled := False;
[456]	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;
[1679]	2338	if (havetest = false) and (RemoveCollTimeDefault = True) then
	2339	begin
	2340	calCollTime.Text := '';
	2341	calCollTime.FMDateTime := 0;
	2342	txtImmedColl.Text := '';
	2343	end;
[456]	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
[829]	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;
[1679]	2429	cboReasons.Text := StringReplace(cboReasons.Text,CRLF,' ',[rfReplaceAll]);
[829]	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
[456]	2454	procedure TfrmODBBank.cboAvailTestSelect(Sender: TObject);
	2455	var
	2456	i: integer;
[829]	2457	ListItem: TListItem;
[1679]	2458	aCollTime,aTypeScreen,aStr,aModifier,aSpecimen,aSpecimenUID,aSpecimenReq,aTestYes,x,aName,aTNSString, aUrgText: string;
[829]	2459	aList: TStringList;
[1679]	2460	curAdd,aTNS: Integer;
[829]	2461	sub,sub1: string;
[1679]	2462	aChanging: Boolean;
[456]	2463	begin
[829]	2464	if cboAvailTest.ItemID = '' then Exit;
	2465	aList := TStringList.Create;
[1679]	2466	aChanging := changing;
[829]	2467	try
	2468	ALabTest := nil;
	2469	aTypeScreen := '';
[1679]	2470	aSpecimen := '';
	2471	aSpecimenUID := '';
	2472	aSpecimenReq := '';
[829]	2473	aTestYes := '1';
	2474	aModifier := '';
	2475	changing := true;
	2476	tQuantity.Text := '';
[1679]	2477	changing := aChanging;
[829]	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);
[1679]	2485	{if not(FOrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK]) then
	2486	DetermineCollectionDefaults(Responses); }
	2487	DetermineCollectionDefaults(Responses);
[829]	2488	with cboAvailTest do
	2489	begin
[1679]	2490	if (Length(ItemID) = 0) or (ItemID = '0') then
	2491	begin
	2492	changing := aChanging;
	2493	Exit;
	2494	end;
[829]	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);
[1679]	2503	changing := aChanging;
[829]	2504	Exit;
	2505	end;
	2506	ExtractTypeScreen(aList, uVBECList);
	2507	if aList.Count > 0 then aTypeScreen := aList[0];
	2508	aList.Clear;
	2509	aTNSString := '';
[1679]	2510	if (Changing = false) and (StrToInt(aTypeScreen) = cboAvailTest.ItemID) and (uTNSOrders.Count > 0) then
[456]	2511	begin
[829]	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 +
[1679]	2519	'Do you wish to cancel this request for Type & Screen?'),
	2520	PChar('Type & Screen Entered in Past ' + IntToStr(TNSDaysBack) + ' Days'),
	2521	MB_YESNO);
[829]	2522	RestoreTopMosts;
[1679]	2523	if aTNS = 6 then
[829]	2524	begin
	2525	cboAvailTest.ItemIndex := -1;
	2526	exit;
	2527	end;
	2528	end;
[456]	2529	end;
[829]	2530	if sub = 't' then with ALabTest do //DIAGNOSTIC TEST
[456]	2531	begin
[829]	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;
[456]	2548	end;
[829]	2549	end;
	2550	if LRORDERMODE = TORDER_MODE_DIAG then
[456]	2551	begin
[829]	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)
[1679]	2554	else if changing = false then
[829]	2555	begin
[1679]	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;
[829]	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);
[1679]	2569	with cboCollTime do
	2570
[829]	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
[1679]	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);
[456]	2600	end;
[829]	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
[456]	2611	begin
[829]	2612	lblTNS.Caption := '';
	2613	lblTNS.Visible := false;
	2614	memMessage.Text := '';
	2615	pnlMessage.Visible := false;
	2616	uGetTnS := 0;
	2617	pnlDiagnosticTests.Caption := 'Diagnostic Tests';
[456]	2618	end;
[829]	2619	end;
[1679]	2620	aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimenReq + '^' + aSpecimen + '^' + aSpecimenUID + '^' + IntToStr(aLabTest.ItemID);
[829]	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
[456]	2628	begin
[829]	2629	if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
[456]	2630	end;
[829]	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;
[456]	2643	end;
[829]	2644	end;
[456]	2645
[829]	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;
[1679]	2654	aTypeScreen,aSpecimen,aSpecimenUID,aSpecimenReq,aTestYes,aStr,aMsg,aModifier,x,x1,aReason,aSurgery,aCollTime,aCollSave,aName,aUrgText: String;
	2655	aChanging: Boolean;
[829]	2656	begin
	2657	if cboAvailComp.ItemID = '' then Exit;
	2658	aList := TStringList.Create;
	2659	aTests := TStringList.Create;
	2660	sub1 := '';
[1679]	2661	aChanging := changing;
[829]	2662	try
	2663	DisableDiagTestControls;
	2664	EnableComponentControls;
	2665	if not(changing = true) then
	2666	begin
	2667	changing := true;
	2668	tQuantity.Text := '';
	2669	cboModifiers.ItemIndex := -1;
[1679]	2670	changing := aChanging;
[829]	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);
[1679]	2688	changing := aChanging;
[829]	2689	StatusText('');
	2690	end;
	2691	aList.Clear;
	2692	TestAdded := 0;
	2693	getTest := 0;
[1679]	2694	ExtractTests(aList, uVBECList); //Get Lab Results associated with ordered components
[829]	2695	for j := 0 to aList.Count - 1 do
[456]	2696	begin
[829]	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;
[456]	2715	end;
[829]	2716	if TestAdded = 1 then
[456]	2717	begin
[829]	2718	aTests.Clear;
	2719	GetPatientBloodResults(aTests, Patient.DFN, uTestsForResults);
[1679]	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;
[829]	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 := '';
[1679]	2737	aSpecimen := '';
	2738	aSpecimenUID := '';
	2739	aSpecimenReq := '';
[829]	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);
[1679]	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;
[829]	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];
[1679]	2766	if (Length(cboSurgery.ItemID) > 0) and (length(tQuantity.Text) > 0) and (strToInt(tQuantity.Text) > 0) then
[456]	2767	begin
[1679]	2768	uChangingMSBOS := true;
	2769	cboSurgeryChange(self);
	2770	uChangingMSBOS := false;
	2771	if cboAvailComp.ItemIndex = -1 then Exit;
[829]	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)
[1679]	2777	and (uppercase((piece(aList[i],'^',3))) = uppercase(cboSurgery.Text)) then
[829]	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 +
[1679]	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);
[829]	2795	RestoreTopMosts;
	2796	end;
[1679]	2797	if aMSBOSContinue = 6 then
[829]	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;
[1679]	2806	if (uTNSOrders.Count < 1) and (SpecimenNeeded(aList, uVBECList, aLabTest.ItemID)) then //check to see if type and screen is needed CQ 17349
[456]	2807	begin
[829]	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
[1679]	2830	aSpecimenReq := piece(aList[i],'^',2);
	2831	if (SpecimenNeeded(aList, uVBECList, aLabTest.ItemID)) then
	2832	aSpecimenUID := '';
[829]	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
[456]	2848	begin
[829]	2849	ListItem.SubItems.Add('');
	2850	ListItem.SubItems.Add('');
	2851	end;
	2852	ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
[456]	2853	end;
[1679]	2854	aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimenReq + '^' + aSpecimen + '^' + aSpecimenUID + '^' + IntToStr(aLabTest.ItemID);
[829]	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
[1679]	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;
[829]	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*';
[1679]	2905	end
	2906	else pnlDiagnosticTests.Caption := 'Diagnostic Tests';
[829]	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;
[456]	2915	end;
	2916
	2917	procedure TfrmODBBank.DisableCommentPanels;
	2918	begin
	2919	lblReqComment.Visible := False;
	2920	end;
	2921
	2922	procedure TfrmODBBank.DisableComponentControls;
[1679]	2923	var
	2924	j: integer;
[456]	2925	begin
[829]	2926	lblQuantity.Enabled := false;
	2927	tQuantity.Enabled := false;
[456]	2928	lblModifiers.Enabled := false;
	2929	cboModifiers.Enabled := false;
[1679]	2930	lblQuantity.Caption := 'Quantity';
	2931	lblWanted.Caption := 'Date/Time Wanted';
	2932	lblReason.Caption := 'Reason for Request';
[456]	2933	cboAvailComp.ItemIndex := -1;
[1679]	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;
[456]	2943	end;
	2944
	2945	procedure TfrmODBBank.EnableComponentControls;
	2946	begin
[829]	2947	lblQuantity.Enabled := true;
	2948	tQuantity.Enabled := true;
[456]	2949	lblModifiers.Enabled := true;
	2950	cboModifiers.Enabled := true;
[1679]	2951	lblQuantity.Caption := 'Quantity*';
	2952	lblWanted.Caption := 'Date/Time Wanted*';
	2953	lblReason.Caption := 'Reason for Request*';
[829]	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));
[456]	2959	if cboUrgency.Text = 'PRE-OP' then
[1679]	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
[456]	2983	lblDiagComment.Enabled := true;
	2984	end;
	2985
	2986	procedure TfrmODBBank.DisableDiagTestControls;
[1679]	2987	var
	2988	i,j: integer;
	2989	diagflg: boolean;
[456]	2990	begin
[1679]	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';
[829]	3011	cboAvailTest.ItemIndex := -1;
[1679]	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;
[456]	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;
[1679]	3031	lblCollTime.Caption := 'Collection Date/Time*';
	3032	lblCollType.Caption := 'Collection Type*';
[829]	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));
[456]	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;
[1679]	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;
[456]	3109	end;
	3110	end
	3111	else // if (RespCollect = nil)
	3112	LoadCollType(cbocollType);
	3113	end;
	3114	end;
	3115
[1679]	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
[456]	3133	procedure TfrmODBBank.cboAvailTestExit(Sender: TObject);
	3134	begin
	3135	inherited;
[1679]	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;
[456]	3143	if cboAvailTest.ItemID = FLastLabID then Exit;
[1679]	3144	if not (Length(cboAvailTest.ItemID) = 0) then cboAvailTestSelect(cboAvailTest);
[456]	3145	end;
	3146
[1679]	3147	procedure TfrmODBBank.cboAvailCompEnter(Sender: TObject);
	3148	var
	3149	j: integer;
[829]	3150	begin
	3151	inherited;
[1679]	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;
[829]	3162	end;
	3163
[456]	3164	procedure TfrmODBBank.cboAvailCompExit(Sender: TObject);
	3165	begin
	3166	inherited;
[1679]	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;
[456]	3174	if cboAvailComp.ItemID = FLastLabID then Exit;
[1679]	3175	if not (Length(cboAvailComp.ItemID) = 0) then cboAvailCompSelect(cboAvailComp);
[456]	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
[829]	3212	TI_COMPONENT : begin
[456]	3213	memOrder.Visible := true;
	3214	cmdAccept.Visible := true;
	3215	pnlSelectedTests.Visible := true;
[829]	3216	lvSelectionList.Width := lvSelectionList.Width + 1; //added to fix font resize issue - funky column display
[456]	3217	end;
	3218	TI_INFO : begin
[829]	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;
[456]	3231	end;
	3232	TI_RESULTS : begin
[829]	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;
[456]	3245	end;
	3246	end; {case}
	3247	end;
	3248
[1679]	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
[829]	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
[1679]	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
[456]	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;
[829]	3344	if cboCollType.ItemID = 'I' then
	3345	begin
	3346	cboCollTime.ItemIndex := -1;
	3347	cboCollTime.Text := 'NOW';
	3348	calCollTime.Text := 'NOW';
	3349	end;
[456]	3350	SetupCollTimes(cboCollType.ItemID);
[829]	3351	if Length(cboCollType.Text) > 0 then Responses.Update('COLLECT',1,cboCollType.ItemID,cboCollType.ItemID);
	3352	calCollTimeChange(self);
[456]	3353	end;
	3354
[1679]	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
[829]	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
[1679]	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
[456]	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
[829]	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
[456]	3461	procedure TfrmODBBank.LoadUrgencies(AComboBox:TORComboBox);
	3462	var
	3463	i: integer;
	3464	begin
	3465	with AComboBox do
	3466	begin
	3467	Clear;
[1679]	3468	{for i := 0 to uUrgencyList.Count - 1 do
[456]	3469	if (piece(uUrgencyList[i],'^',2) = 'STAT') and (StatAllowed(Patient.DFN) = false) then
	3470	Continue
	3471	else
[1679]	3472	Items.Add(uUrgencyList[i]); }
	3473	for i := 0 to uUrgencyList.Count - 1 do
	3474	Items.Add(uUrgencyList[i]);
[456]	3475	end;
	3476	end;
	3477
[829]	3478	procedure TfrmODBBank.lvSelectionListClick(Sender: TObject);
[456]	3479	var
	3480	ListItem: TListItem;
[829]	3481	x,y: string;
	3482	i,j: integer;
[456]	3483	begin
[829]	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
[1679]	3494	if (FLastLabCollTime <> '') and (length(cboCollTime.Text) < 1) then
[829]	3495	cboCollTime.SelectByID(piece(FLastLabCollTime,'^',1));
	3496	end
[1679]	3497	else if length(calcollTime.Text) < 1 then
[829]	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;
[1679]	3506	if (FLastCollType <> '') and (length(cboCollType.Text) < 1) then
[829]	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;
[1679]	3538	memDiagComment.Text := StringReplace(memDiagComment.Text,CRLF,' ',[rfReplaceAll]);
[829]	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
[1679]	3567	procedure TfrmODBBank.FormShow(Sender: TObject);
	3568	begin
	3569	inherited;
	3570	pgeProduct.SetFocus;
	3571	end;
	3572
[829]	3573	procedure TfrmODBBank.btnRemoveClick(Sender: TObject);
	3574	var
	3575	i,j,curAdd: integer;
	3576	x, aName, aModifier, aReason, aTypeScreen: string;
	3577	aList: TStringList;
[1679]	3578	aSel, aSelTst, aSelComp, aGotTNS : boolean;
[829]	3579	begin
	3580	inherited;
[456]	3581	aList := TStringList.Create;
	3582	try
[829]	3583	curAdd := 1;
[456]	3584	aModifier := '';
[829]	3585	aReason := '';
[456]	3586	aTypeScreen := '';
[829]	3587	aSel := false;
	3588	aSelTst := false;
[1679]	3589	aSelComp := false;
	3590	aGotTNS := false;
[456]	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];
[829]	3595	if length(cboReasons.ItemID) > 0 then aReason := cboReasons.Items[cboReasons.ItemIndex];
	3596	if lvSelectionList.Items.Count < 1 then
[456]	3597	begin
[829]	3598	ShowMsg('There is nothing in the list to remove.');
	3599	exit;
[456]	3600	end;
[829]	3601	cboAvailComp.ItemIndex := -1;
	3602	tQuantity.Text := '';
[1679]	3603	tQuantity.Enabled := false;
	3604	lblQuantity.Enabled := false;
[829]	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
[456]	3613	begin
[829]	3614	for i := lvSelectionList.Items.Count - 1 downto 0 do
[456]	3615	begin
[829]	3616	if lvSelectionList.Items[i].Selected = true then
[456]	3617	begin
[829]	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;
[456]	3626	end;
	3627	end;
[829]	3628	end;
[1679]	3629	for i := lvSelectionList.Items.Count - 1 downto 0 do
[829]	3630	begin
[1679]	3631	if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then
[456]	3632	begin
[1679]	3633	aGotTNS := true;
[829]	3634	break;
[456]	3635	end;
	3636	end;
[1679]	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;
[829]	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;
[1679]	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';
[829]	3666	if lvSelectionList.Items.Count < 1 then
	3667	begin
[1679]	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;
[829]	3678	cboCollType.ItemIndex := -1;
	3679	cboCollTime.ItemIndex := -1;
	3680	cboQuick.ItemIndex := -1;
[1679]	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;
[829]	3690	end;
[456]	3691	for i := 0 to uSelectedItems.Count - 1 do
	3692	begin
[829]	3693	aName := lvSelectionList.Items[i].Caption;
[456]	3694	x := uSelectedItems[i];
	3695	if piece(x,'^',1) = '1' then //Diagnostic Test related fields
	3696	begin
[829]	3697	if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
[1679]	3698	lblCollTime.Caption := 'Collection Date/Time*';
	3699	lblCollType.Caption := 'Collection Type*';
[829]	3700	aSelTst := true;
[456]	3701	end
	3702	else
	3703	begin
[829]	3704	if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
[456]	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));
[829]	3708	cboModifiers.ItemIndex := -1;
	3709	cboAvailComp.ItemIndex := -1;
	3710	tQuantity.Text := '';
[1679]	3711	lblQuantity.Caption := 'Quantity*';
	3712	lblWanted.Caption := 'Date/Time Wanted*';
	3713	lblReason.Caption := 'Reason for Request*';
	3714	//aSelComp := true;
[456]	3715	end;
	3716	Inc(CurAdd);
	3717	end;
[829]	3718	if aSelTst = false then
[456]	3719	begin
[829]	3720	cboCollType.ItemIndex := -1;
	3721	cboCollTime.ItemIndex := -1;
	3722	calCollTime.Text := '';
[456]	3723	end;
[1679]	3724	{if aSelcomp = false then
	3725	lblNoBloodReq.Visible := false
	3726	else
	3727	lblNoBloodReq.Visible := true; }
[829]	3728	if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
	3729	if cboCollType.ItemID = 'LC' then
[456]	3730	begin
[829]	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;
[456]	3756	end;
[829]	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');
[456]	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;
[829]	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;
[456]	3785	finally
	3786	aList.Free;
	3787	end;
	3788	end;
	3789
[829]	3790	procedure TfrmODBBank.btnUpdateCommentsClick(Sender: TObject);
[456]	3791	begin
	3792	inherited;
[829]	3793	pnlComments.Visible := false;
	3794	pnlComments.SendToBack;
	3795	Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
	3796	memOrder.Text := Responses.OrderText;
[456]	3797	end;
	3798
[829]	3799	procedure TfrmODBBank.btnCancelCommentClick(Sender: TObject);
[456]	3800	begin
	3801	inherited;
[829]	3802	pnlComments.Visible := false;
	3803	pnlComments.SendToBack;
[456]	3804	end;
	3805
	3806	procedure TfrmODBBank.btnRemoveAllClick(Sender: TObject);
	3807	begin
	3808	inherited;
[829]	3809	if lvSelectionList.Items.Count < 1 then
	3810	begin
	3811	ShowMsg('There is nothing in the list to remove.');
	3812	exit;
	3813	end;
[456]	3814	lvSelectionList.Clear;
	3815	uSelectedItems.Clear;
	3816	uTestsForResults.Clear;
	3817	uRaw.Clear;
	3818	uGetTnS := 0;
	3819	lblTNS.Caption := '';
	3820	lblTNS.Visible := false;
[829]	3821	memMessage.Text := '';
	3822	pnlMessage.Visible := false;
[1679]	3823	FLastItemID := '';
[456]	3824	InitDialog;
[829]	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 := '';
[1679]	3838	tQuantity.Enabled := false;
	3839	lblQuantity.Enabled := false;
[829]	3840	FLastCollType := '';
	3841	FLastCollTime := '';
	3842	FLastLabCollTime := '';
	3843	txtImmedColl.Text := '';
[1679]	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';
[456]	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
[829]	3862	if not ValidAdd then Exit;
[456]	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
[829]	3879	begin
	3880	if NursAdminSuppress = true then
	3881	ShowMsg('The nursing blood administration order must be entered separately' + '.');
	3882	end;
[456]	3883	inherited;
	3884	end;
	3885
	3886	procedure TfrmODBBank.calWantTimeChange(Sender: TObject);
[1679]	3887	var
	3888	i: integer;
	3889	aList: TStringList;
	3890	aSpecimen, aSpecimenUID, aSpecimenReq: string;
	3891	aChanging: Boolean;
[456]	3892	begin
	3893	inherited;
[1679]	3894	aList := TStringList.Create;
	3895	aChanging := changing;
	3896	try
	3897	aSpecimen := '';
	3898	aSpecimenUID := '';
	3899	aSpecimenReq := '';
[456]	3900	if uSelectedItems.Count > 0 then
[829]	3901	begin
[1679]	3902	with calWantTime do if not changing then
[829]	3903	begin
	3904	if FMDateTime = 0 then
	3905	begin
	3906	ShowMsg('Invalid Date/Time entered');
[1679]	3907	changing := true;
[829]	3908	calWantTime.Text := '';
[1679]	3909	changing := aChanging;
[829]	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');
[1679]	3918	changing := true;
[829]	3919	calWantTime.Text := '';
[1679]	3920	changing := aChanging;
[829]	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;
[1679]	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);
[829]	3947	end;
[1679]	3948	finally
	3949	aList.Free;
	3950	end;
[456]	3951	end;
	3952
[1679]	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
[456]	3970	procedure TfrmODBBank.chkConsentClick(Sender: TObject);
	3971	begin
	3972	inherited;
	3973	if uSelectedItems.Count > 0 then
	3974	begin
[829]	3975	if chkConsent.Checked = true then Responses.Update('YN',1,'1','Yes');
	3976	memOrder.Text := Responses.OrderText;
[456]	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);
[829]	3986	uSelUrgency := cboUrgency.Text;
[456]	3987	if cboUrgency.Text = 'PRE-OP' then
	3988	begin
	3989	lblSurgery.Enabled := true;
	3990	cboSurgery.Enabled := true;
[829]	3991	lblSurgery.Caption := 'Surgery*';
[456]	3992	end
	3993	else
	3994	begin
[1679]	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;
[456]	4009	end;
[829]	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
[1679]	4025	aList, bList, cList: TStringList;
[829]	4026	i,j,aMSBOS,aMSBOSContinue: integer;
[1679]	4027	x,aTypeScreen: string;
	4028	handled,aGotTNS: boolean;
	4029	xLabTest: TLabTest;
[829]	4030	begin
	4031	inherited;
[1679]	4032	cboSurgery.Text := StringReplace(cboSurgery.Text,CRLF,' ',[rfReplaceAll]);
[829]	4033	aList := TStringList.Create;
[1679]	4034	bList := TStringList.Create;
	4035	cList := TStringList.Create;
[829]	4036	handled := false;
[1679]	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;
[829]	4044	try
[1679]	4045	cboSurgery.DroppedDown := false;
	4046	if (Length(cboSurgery.ItemID) > 0) then
[829]	4047	begin
[1679]	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
[829]	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)
[1679]	4065	and (uppercase((piece(aList[i],'^',3))) = uppercase(cboSurgery.Text)) then
[829]	4066	begin
	4067	aMSBOS := StrToInt(piece(aList[i],'^',4));
	4068	if (aMSBOS > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then
	4069	begin
[1679]	4070	bList.Add(aLabTest.TestName + '^' + tQuantity.Text + '^' + IntToStr(aMSBOS));
[829]	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
[1679]	4083	xLabTest := TLabTest.Create(piece(uSelectedItems[j],'^',2), Responses);
[829]	4084	for i := 0 to aList.Count - 1 do
	4085	begin
	4086	if (piece(uSelectedItems[j],'^',1) = '0')
[1679]	4087	and (StrToInt(piece(aList[i],'^',1)) = xLabTest.ItemID)
	4088	and (uppercase((piece(aList[i],'^',3))) = uppercase(cboSurgery.Text)) then
[829]	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
[1679]	4093	bList.Add(xLabTest.TestName + '^' + piece(uSelectedItems[j],'^',3) + '^' + IntToStr(aMSBOS));
[829]	4094	end;
	4095	break;
	4096	end;
	4097	end;
[1679]	4098	xLabTest.Free;
[829]	4099	end;
	4100	end;
[1679]	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;
[829]	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;
[1679]	4200	memOrder.Text := Responses.OrderText;
[829]	4201	finally
	4202	aList.Free;
[1679]	4203	bList.Free;
	4204	cList.Free;
[456]	4205	end;
	4206	end;
	4207
[829]	4208	procedure TfrmODBBank.cboSurgeryClick(Sender: TObject);
[456]	4209	begin
	4210	inherited;
[829]	4211	if Length(cboSurgery.Text) > 0 then uSelSurgery := cboSurgery.ItemID;
[456]	4212	end;
	4213
[829]	4214	procedure TfrmODBBank.tQuantityChange(Sender: TObject);
	4215	var
	4216	aList: TStringList;
	4217	i,aMSBOS,aMSBOSContinue: integer;
	4218	ListItem: TListItem;
	4219	x,m: string;
[456]	4220	begin
	4221	inherited;
[829]	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
[1679]	4240	if not(aLabTest = nil) and (Length(cboSurgery.ItemID) > 0) and (Length(tQuantity.Text) > 0) then
[829]	4241	begin
[1679]	4242	uChangingMSBOS := true;
	4243	cboSurgeryChange(self);
	4244	uChangingMSBOS := false;
[829]	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)
[1679]	4250	and (uppercase((piece(aList[i],'^',3))) = uppercase(cboSurgery.Text)) and (Length(tQuantity.Text) > 0) then
[829]	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 +
[1679]	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
[829]	4269	RestoreTopMosts;
	4270	end;
[1679]	4271	if aMSBOSContinue = 6 then
[829]	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;
[456]	4319	end;
	4320
[829]	4321	procedure TfrmODBBank.tQuantityClick(Sender: TObject);
[456]	4322	begin
	4323	inherited;
[829]	4324	tQuantity.SelLength := 2;
	4325	tQuantity.SelectAll;
[456]	4326	end;
	4327
[829]	4328	procedure TfrmODBBank.tQuantityEnter(Sender: TObject);
[1679]	4329	var
	4330	j: integer;
[456]	4331	begin
	4332	inherited;
[829]	4333	tQuantity.SelLength := 2;
	4334	tQuantity.SelectAll;
[1679]	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;
[456]	4345	end;
	4346
[1679]	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
[456]	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;
[829]	4397	memOrder.Text := Responses.OrderText;
[456]	4398	end;
	4399	end;
	4400
[1679]	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
[456]	4418	end.

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

Context Navigation

source: cprs/trunk/CPRS-Chart/Orders/fODBBank.pas@ 1722

Download in other formats: