Context Navigation

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

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

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

Download in other formats: