2305 lines
81 KiB
Plaintext
2305 lines
81 KiB
Plaintext
unit fODBBank;
|
|
|
|
interface
|
|
|
|
uses
|
|
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
|
|
Forms, Dialogs, StdCtrls, ORCtrls, ORfn, fODBase, ExtCtrls, ComCtrls, uConst,
|
|
ORDtTm, Buttons, Menus, ImgList;
|
|
|
|
type
|
|
TfrmODBBank = class(TfrmODBase)
|
|
pnlBB: TPanel;
|
|
pnlFull: TPanel;
|
|
pgeProduct: TPageControl;
|
|
tabInfo: TTabSheet;
|
|
edtInfo: TCaptionRichEdit;
|
|
TabDiag: TTabSheet;
|
|
lblReqComment: TOROffsetLabel;
|
|
pnlFields: TPanel;
|
|
dlgLabCollTime: TORDateTimeDlg;
|
|
ORWanted: TORDateTimeDlg;
|
|
lblDiagComment: TOROffsetLabel;
|
|
txtDiagComment: TCaptionEdit;
|
|
pnlSelectedTests: TGroupBox;
|
|
lvSelectionList: TCaptionListView;
|
|
lblUrgency: TLabel;
|
|
cboUrgency: TORComboBox;
|
|
lblCollType: TLabel;
|
|
cboCollType: TORComboBox;
|
|
chkConsent: TCheckBox;
|
|
lblPreparation: TLabel;
|
|
calWantTime: TORDateBox;
|
|
lblWanted: TLabel;
|
|
tReason: TEdit;
|
|
lblReason: TLabel;
|
|
cboSurgery: TORComboBox;
|
|
lblSurgery: TLabel;
|
|
txtImmedColl: TCaptionEdit;
|
|
cboCollTime: TORComboBox;
|
|
lblCollTime: TLabel;
|
|
cmdImmedColl: TSpeedButton;
|
|
pnlCollTimeButton: TKeyClickPanel;
|
|
calCollTime: TORDateBox;
|
|
cboPreparation: TORComboBox;
|
|
btnRemove: TButton;
|
|
btnRemoveAll: TButton;
|
|
pnlTop: TPanel;
|
|
pnlSelect: TPanel;
|
|
pnlDiagTests: TGroupBox;
|
|
cboAvailTest: TORComboBox;
|
|
pnlBloodComponents: TGroupBox;
|
|
lblQuantity: TLabel;
|
|
cboAvailComp: TORComboBox;
|
|
tQuantity: TEdit;
|
|
upQuantity: TUpDown;
|
|
TabResults: TTabSheet;
|
|
edtResults: TCaptionRichEdit;
|
|
btnAddTests: TORAlignSpeedButton;
|
|
ImageList1: TImageList;
|
|
lblModifiers: TLabel;
|
|
cboModifiers: TORComboBox;
|
|
lblTNS: TLabel;
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure cboAvailTestSelect(Sender: TObject);
|
|
procedure cboAvailCompSelect(Sender: TObject);
|
|
procedure DisableCommentPanels;
|
|
procedure DisableComponentControls;
|
|
procedure DisableDiagTestControls;
|
|
procedure EnableComponentControls;
|
|
procedure EnableDiagTestControls;
|
|
procedure cboAvailTestExit(Sender: TObject);
|
|
procedure cboAvailCompExit(Sender: TObject);
|
|
procedure cboAvailTestNeedData(Sender: TObject;
|
|
const StartFrom: String; Direction, InsertAt: Integer);
|
|
procedure cboAvailCompNeedData(Sender: TObject;
|
|
const StartFrom: String; Direction, InsertAt: Integer);
|
|
procedure cmdImmedCollClick(Sender: TObject);
|
|
procedure pgeProductChange(Sender: TObject);
|
|
procedure cboCollTypeChange(Sender: TObject);
|
|
procedure btnAddTestsClick(Sender: TObject);
|
|
procedure FormDestroy(Sender: TObject);
|
|
procedure btnRemoveClick(Sender: TObject);
|
|
procedure btnRemoveAllClick(Sender: TObject);
|
|
procedure cmdAcceptClick(Sender: TObject);
|
|
procedure calWantTimeChange(Sender: TObject);
|
|
procedure chkConsentClick(Sender: TObject);
|
|
procedure cboUrgencyChange(Sender: TObject);
|
|
procedure txtDiagCommentChange(Sender: TObject);
|
|
procedure cboPreparationChange(Sender: TObject);
|
|
procedure cboSurgeryChange(Sender: TObject);
|
|
procedure tReasonChange(Sender: TObject);
|
|
procedure calCollTimeChange(Sender: TObject);
|
|
protected
|
|
FCmtTypes: TStringList ;
|
|
procedure InitDialog; override;
|
|
function ValidCollTime(UserEntry: string): string;
|
|
procedure GetAllCollSamples(AComboBox: TORComboBox);
|
|
procedure GetAllSpecimens(AComboBox: TORComboBox);
|
|
procedure SetupCollTimes(CollType: string);
|
|
procedure LoadCollType(AComboBox:TORComboBox);
|
|
function ValidAdd: Boolean;
|
|
procedure ValidateAdd(var AnErrMsg: string);
|
|
procedure Validate(var AnErrMsg: string); override;
|
|
procedure ExtractMSBOS(OutList:TStrings; AList:TStrings);
|
|
procedure ExtractTests(OutList:TStrings; AList:TStrings);
|
|
procedure ExtractSurgeries(OutList:TStrings; AList:TStrings);
|
|
procedure ExtractUrgencies(OutList:TStrings; AList:TStrings);
|
|
procedure ExtractModifiers(OutList:TStrings; AList:TStrings);
|
|
procedure ExtractSpecimens(OutList:TStrings; AList:TStrings);
|
|
procedure ExtractTypeScreen(OutList:TStrings; AList:TStrings);
|
|
procedure ExtractPatientInfo(OutList:TStrings; AList:TStrings);
|
|
procedure ExtractSpecimen(OutList:TStrings; AList:TStrings);
|
|
function SpecimenNeeded(OutList:TStrings; AList:TStrings; CompID:integer): Boolean;
|
|
procedure LoadUrgencies(AComboBox:TORComboBox);
|
|
procedure LoadModifiers(AComboBox:TORComboBox);
|
|
private
|
|
FLastCollType: string;
|
|
FLastCollTime: string;
|
|
FLastLabCollTime: string;
|
|
FLastLabID: string;
|
|
FLastItemID: string;
|
|
FEvtDelayLoc: integer;
|
|
FEvtDivision: integer;
|
|
FVbecLookup: string;
|
|
procedure ReadServerVariables;
|
|
public
|
|
procedure SetupDialog(OrderAction: Integer; const ID: string); override;
|
|
procedure LoadRequiredComment(CmtType: integer);
|
|
procedure DetermineCollectionDefaults(Responses: TResponses);
|
|
property EvtDelayLoc: integer read FEvtDelayLoc write FEvtDelayLoc;
|
|
property EvtDivision: integer read FEvtDivision write FEvtDivision;
|
|
end;
|
|
|
|
type
|
|
TCollSamp = class(TObject)
|
|
CollSampID: Integer; { IEN of CollSamp }
|
|
CollSampName: string; { Name of CollSamp }
|
|
SpecimenID: Integer; { IEN of default specimen }
|
|
SpecimenName: string; { Name of the specimen }
|
|
TubeColor: string; { TubeColor (text) }
|
|
MinInterval: Integer; { Minimum days between orders }
|
|
MaxPerDay: Integer; { Maximum orders per day }
|
|
LabCanCollect: Boolean; { True if lab can collect }
|
|
SampReqComment: string; { Name of required comment }
|
|
WardComment: TStringList; { CollSamp specific comment }
|
|
end;
|
|
|
|
TLabTest = class(TObject)
|
|
TestID: Integer; { IEN of Lab Test }
|
|
TestName: string; { Name of Lab Test }
|
|
ItemID: Integer; { Orderable Item ID }
|
|
LabSubscript: string ; { which section of Lab? }
|
|
CollSamp: Integer; { index into CollSampList }
|
|
Specimen: Integer; { IEN of specimen }
|
|
Comment: TStringList; { text of comment }
|
|
TestReqComment: string; { Name of required comment }
|
|
CurReqComment: string; { name of required comment }
|
|
CurWardComment: TStringList; { WP of Ward Comment }
|
|
UniqueCollSamp: Boolean; { true if not prompt CollSamp }
|
|
CollSampList: TList; { collection sample objects }
|
|
CollSampCount: integer; { count of original contents of CollSampList}
|
|
SpecimenList: TStringList; { Strings: IEN^Specimen Name }
|
|
SpecListCount: integer; { count of original contents of SpecimenList}
|
|
SurgeryList: TStringList; { Strings: Surgeries}
|
|
PatientInfo: TStringList; { Text of Patient Information}
|
|
ResultsDisplay: TStringList; { Text of Test Results}
|
|
QuickOrderResponses: TResponses; { if created as a result of a quick order selection}
|
|
{ functions & procedures }
|
|
constructor Create(const LabTestIEN: string; Responses: TResponses);
|
|
destructor Destroy; override ;
|
|
function IndexOfCollSamp(CollSampIEN: Integer): Integer;
|
|
procedure FillCollSampList(LoadData: TStringList; DfltCollSamp: Integer);
|
|
procedure LoadAllSamples;
|
|
procedure SetCollSampDflts;
|
|
procedure ChangeCollSamp(CollSampIEN: Integer);
|
|
procedure ChangeSpecimen(const SpecimenIEN: string);
|
|
procedure ChangeComment(const CommentText: string);
|
|
function LabCanCollect: Boolean;
|
|
procedure LoadCollSamp(AComboBox: TORComboBox);
|
|
procedure LoadSpecimen(AComboBox: TORComboBox);
|
|
function NameOfCollSamp: string;
|
|
function NameOfSpecimen: string;
|
|
function ObtainCollSamp: Boolean;
|
|
function ObtainSpecimen: Boolean;
|
|
function ObtainComment: Boolean;
|
|
end;
|
|
|
|
const
|
|
CmtType: array[0..6] of string = ('ANTICOAGULATION','DOSE/DRAW TIMES','ORDER COMMENT',
|
|
'ORDER COMMENT MODIFIED','TDM (PEAK-TROUGH)',
|
|
'TRANSFUSION','URINE VOLUME');
|
|
var
|
|
frmODBBank: TfrmODBBank;
|
|
|
|
implementation
|
|
|
|
{$R *.dfm}
|
|
|
|
uses rODBase, rODLab, uCore, rCore, fODLabOthCollSamp, fODLabOthSpec, fODLabImmedColl, fLabCollTimes,
|
|
rOrders, uODBase, fRptBox;
|
|
|
|
var
|
|
uSelectedItems: TStringList; //Selected Items in ListView- if TestYes =1 then test else component
|
|
//TestYes(1)^Test-Component(2)^Qty(3)^Sample(4,5)^Specimen(6,7)^Modifier(8)
|
|
uVBECList: TStringList; //List of items from VBEC api
|
|
uTestsForResults: TStringList; //List of tests to show results
|
|
uUrgencyList: TStringList; //List of Urgencies
|
|
uModifierList: TStringList; //List of Modifiers
|
|
uRaw: TStringList; //Results Array
|
|
uTestSelected, uComponentSelected: Boolean; //Used on Validate
|
|
uDfltUrgency: Integer;
|
|
uSpecimen, uGetTnS: Integer; //Set to 1 if a specimen for test is already in lab... no need to collect
|
|
uDfltCollType: string;
|
|
ALabTest: TLabTest;
|
|
UserHasLRLABKey: boolean;
|
|
LRFZX : string; //the default collection type (LC,WC,SP,I)
|
|
LRFSAMP : string; //the default sample (ptr)
|
|
LRFSPEC : string; //the default specimen (ptr)
|
|
LRFDATE : string; //the default collection time (NOW,NEXT,AM,PM,T...)
|
|
LRFURG : string; //the default urgency (number) TRY '2'
|
|
LRFSCH : string; //the default schedule? (ONE TIME, QD, ...)
|
|
LRORDERMODE : Integer; //the mode being used to order (component or diagnostic test)
|
|
|
|
const
|
|
TX_NO_TEST = 'A Lab Test must be specified.' ;
|
|
TX_NO_IMMED = 'Immediate collect is not available for this test/sample';
|
|
TX_NO_IMMED_CAP = 'Invalid Collection Type';
|
|
|
|
TI_INFO = 0; //Corresponds with pgeProduct TabIndex
|
|
TI_ORDER = 1;
|
|
TI_RESULTS = 2;
|
|
|
|
TORDER_MODE_INFO = 0;
|
|
TORDER_MODE_DIAG = 1;
|
|
TORDER_MODE_COMP = 2;
|
|
|
|
procedure TfrmODBBank.FormCreate(Sender: TObject);
|
|
var
|
|
i: integer;
|
|
AList, ATests: TStringList;
|
|
begin
|
|
AutoSizeDisabled := True;
|
|
inherited;
|
|
AList := TStringList.Create;
|
|
ATests := TStringList.Create;
|
|
uSelectedItems := TStringList.Create;
|
|
uVBECList := TStringList.Create;
|
|
uTestsForResults := TStringList.Create;
|
|
uUrgencyList := TStringList.Create;
|
|
uModifierList := TStringList.Create;
|
|
uRaw := TStringList.Create;
|
|
uSpecimen := 0;
|
|
uGetTnS := 0;
|
|
lblTNS.Caption := '';
|
|
lblTNS.Visible := false;
|
|
uDfltUrgency := 9;
|
|
TabResults.ImageIndex := 0;
|
|
Responses.Clear;
|
|
try
|
|
LRFZX := '';
|
|
LRFSAMP := '';
|
|
LRFSPEC := '';
|
|
LRFDATE := '';
|
|
LRFURG := '';
|
|
LRFSCH := '';
|
|
LRORDERMODE := TORDER_MODE_INFO;
|
|
DisableComponentControls;
|
|
DisableDiagTestControls;
|
|
FLastColltime := '';
|
|
FLastLabCollTime := '';
|
|
FLastItemID := '';
|
|
uDfltCollType := '';
|
|
FillerID := 'LR';
|
|
FEvtDelayLoc := 0;
|
|
FEvtDivision := 0;
|
|
UserHasLRLABKey := User.HasKey('LRLAB');
|
|
AllowQuickOrder := True;
|
|
StatusText('Loading Dialog Definition');
|
|
lblReqComment.Visible := False ;
|
|
lblModifiers.Enabled := False;
|
|
cboModifiers.Enabled := False;
|
|
FCmtTypes := TStringList.Create;
|
|
for i := 0 to 6 do FCmtTypes.Add(CmtType[i]) ;
|
|
Responses.Dialog := 'VBEC BLOOD BANK'; // loads formatting info
|
|
StatusText('Loading Default Values');
|
|
if Self.EvtID > 0 then
|
|
begin
|
|
EvtDelayLoc := StrToIntDef(GetEventLoc1(IntToStr(Self.EvtID)),0);
|
|
EvtDivision := StrToIntDef(GetEventDiv1(IntToStr(Self.EvtID)),0);
|
|
if EvtDelayLoc>0 then
|
|
AList.Assign(ODForLab(EvtDelayLoc,EvtDivision))
|
|
else
|
|
AList.Assign(ODForLab(Encounter.Location,EvtDivision));
|
|
end else
|
|
AList.Assign(ODForLab(Encounter.Location)); // ODForLab returns TStrings with defaults
|
|
CtrlInits.LoadDefaults(AList);
|
|
InitDialog;
|
|
with CtrlInits do
|
|
begin
|
|
SetControl(cboCollType, 'Collection Types');
|
|
uDfltCollType := ExtractDefault(AList, 'Collection Types');
|
|
if uDfltCollType <> '' then
|
|
cboCollType.SelectByID(uDfltCollType)
|
|
else if OrderForInpatient then
|
|
cboCollType.SelectByID('LC')
|
|
else
|
|
cboCollType.SelectByID('SP');
|
|
SetupCollTimes(cboCollType.ItemID);
|
|
StatusText('Initializing List of Tests');
|
|
FVbecLookup := 'S.VBT';
|
|
cboAvailTest.InitLongList('');
|
|
end;
|
|
cboAvailComp.Clear;
|
|
aList.Clear;
|
|
GetBloodComponents(aList); //Get Components in right order
|
|
for i := 0 to aList.Count - 1 do
|
|
cboAvailComp.Items.Add(aList[i]);
|
|
uVBECList.Clear;
|
|
edtInfo.Clear;
|
|
cboSurgery.Clear;
|
|
GetPatientBBInfo(uVBECList, Patient.DFN, Encounter.Location);
|
|
aList.Clear;
|
|
ExtractPatientInfo(AList, uVBECList);
|
|
QuickCopy(AList, edtInfo);
|
|
AList.Clear;
|
|
ExtractSurgeries(AList, uVBECList);
|
|
for i := 0 to AList.Count - 1 do
|
|
cboSurgery.Items.Add(AList[i]);
|
|
AList.Clear;
|
|
ExtractUrgencies(uUrgencyList, uVBECList);
|
|
LoadUrgencies(cboUrgency);
|
|
cboUrgency.SelectByID(IntToStr(uDfltUrgency));
|
|
ExtractModifiers(uModifierList, uVBECList);
|
|
LoadModifiers(cboModifiers);
|
|
calWantTime.Text := FormatFMDateTime('mmm dd,yyyy@hh:nn',DateTimeToFMDateTime(Now));
|
|
//cboPreparation.SelectByID('I');
|
|
memMessage.Visible := false;
|
|
memOrder.Visible := false;
|
|
cmdAccept.Visible := false;
|
|
pgeProduct.TabIndex := TI_INFO;
|
|
lvSelectionList.Column[0].Width := 200;
|
|
lvSelectionList.Column[1].Width := 40;
|
|
pgeProduct.ActivePageIndex := TI_INFO;
|
|
PreserveControl(cboAvailTest);
|
|
PreserveControl(cboAvailComp);
|
|
PreserveControl(cboCollType);
|
|
PreserveControl(cboCollTime);
|
|
PreserveControl(calCollTime);
|
|
PreserveControl(calWantTime);
|
|
StatusText('');
|
|
|
|
finally
|
|
AList.Free;
|
|
ATests.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmODBBank.InitDialog;
|
|
begin
|
|
inherited;
|
|
Changing := True;
|
|
if ALabTest <> nil then
|
|
begin
|
|
ALabTest.Destroy;
|
|
ALabTest := nil;
|
|
end;
|
|
DisableCommentPanels;
|
|
cboAvailTest.SelectByID(FLastItemID);
|
|
cboAvailComp.SelectByID(FLastItemID);
|
|
cboAvailTest.ItemIndex := -1;
|
|
StatusText('');
|
|
Changing := False ;
|
|
end;
|
|
|
|
procedure TfrmODBBank.SetupDialog(OrderAction: Integer; const ID: string);
|
|
var
|
|
tmpResp: TResponse;
|
|
i: integer;
|
|
begin
|
|
inherited;
|
|
ReadServerVariables;
|
|
if LRFZX <> '' then
|
|
begin
|
|
cboCollType.SelectByID(LRFZX);
|
|
if cboCollType.ItemIndex > -1 then SetupCollTimes(LRFZX);
|
|
end;
|
|
if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses, ALabTest do
|
|
begin
|
|
SetControl(cboAvailTest, 'ORDERABLE', 1);
|
|
cboAvailTestSelect(Self);
|
|
if ALabTest = nil then Exit; // Causes access violation in FillCollSampleList
|
|
Changing := True;
|
|
DetermineCollectionDefaults(Responses);
|
|
i := 1 ;
|
|
tmpResp := Responses.FindResponseByName('COMMENT',i);
|
|
while tmpResp <> nil do
|
|
begin
|
|
Comment.Add(tmpResp.EValue);
|
|
Inc(i);
|
|
tmpResp := Responses.FindResponseByName('COMMENT',i);
|
|
end ;
|
|
Changing := False;
|
|
end;
|
|
end;
|
|
|
|
constructor TLabTest.Create(const LabTestIEN: string; Responses: TResponses);
|
|
var
|
|
LoadData, OneSamp: TStringList;
|
|
DfltCollSamp: Integer;
|
|
x: string;
|
|
tmpResp: TResponse;
|
|
begin
|
|
LoadData := TStringList.Create;
|
|
try
|
|
LoadLabTestData(LoadData, LabTestIEN) ;
|
|
with LoadData do
|
|
begin
|
|
QuickOrderResponses := Responses;
|
|
TestID := StrToInt(LabTestIEN);
|
|
TestName := Piece(ExtractDefault(LoadData, 'Test Name'),U,1);
|
|
ItemID := StrToInt(Piece(ExtractDefault(LoadData, 'Item ID'),U,1));
|
|
LabSubscript := Piece(ExtractDefault(LoadData, 'Item ID'),U,2);
|
|
TestReqComment := ExtractDefault(LoadData, 'ReqCom');
|
|
if Length(ExtractDefault(LoadData, 'Unique CollSamp')) > 0 then UniqueCollSamp := True;
|
|
x := ExtractDefault(LoadData, 'Unique CollSamp');
|
|
if Length(x) = 0 then x := ExtractDefault(LoadData, 'Lab CollSamp');
|
|
if Length(x) = 0 then x := ExtractDefault(LoadData, 'Default CollSamp');
|
|
if Length(x) = 0 then x := '-1';
|
|
DfltCollSamp := StrToInt(x);
|
|
SpecimenList := TStringList.Create;
|
|
ExtractItems(SpecimenList, LoadData, 'Specimens');
|
|
if LRFSPEC <> '' then SpecimenList.Add(GetOneSpecimen(StrToInt(LRFSPEC)));
|
|
Comment := TStringList.Create ;
|
|
CurWardComment := TStringList.Create;
|
|
ExtractText(CurWardComment, LoadData, 'GenWardInstructions');
|
|
CollSamp := 0;
|
|
CollSampList := TList.Create;
|
|
FillCollSampList(LoadData, DfltCollSamp);
|
|
with QuickOrderResponses do tmpResp := FindResponseByName('SAMPLE' ,1);
|
|
if (LRFSAMP <> '') and (IndexOfCollSamp(StrToInt(LRFSAMP)) < 0) and
|
|
(not UniqueCollSamp) and (tmpResp = nil) then
|
|
begin
|
|
OneSamp := TStringList.Create;
|
|
try
|
|
OneSamp.Assign(GetOneCollSamp(StrToInt(LRFSAMP)));
|
|
FillCollSampList(OneSamp, CollSampList.Count);
|
|
finally
|
|
OneSamp.Free;
|
|
end;
|
|
end;
|
|
if (not UniqueCollSamp) and (CollSampList.Count = 0) then LoadAllSamples;
|
|
CollSampCount := CollSampList.Count;
|
|
end;
|
|
finally
|
|
LoadData.Free;
|
|
end;
|
|
SetCollSampDflts;
|
|
end;
|
|
|
|
destructor TLabTest.Destroy;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if CollSampList <> nil then
|
|
with CollSampList do for i := 0 to Count - 1 do
|
|
with TCollSamp(Items[i]) do
|
|
begin
|
|
WardComment.Free;
|
|
Free;
|
|
end;
|
|
CollSampList.Free;
|
|
SpecimenList.Free;
|
|
CurWardComment.Free;
|
|
Comment.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TLabTest.IndexOfCollSamp(CollSampIEN: Integer): Integer;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := -1;
|
|
with CollSampList do for i := 0 to Count - 1 do with TCollSamp(Items[i]) do
|
|
if CollSampIEN = CollSampID then
|
|
begin
|
|
Result := i;
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
procedure TLabTest.LoadAllSamples;
|
|
var
|
|
LoadList, SpecList: TStringList;
|
|
i: Integer;
|
|
begin
|
|
LoadList := TStringList.Create;
|
|
SpecList := TStringList.Create;
|
|
try
|
|
LoadSamples(LoadList) ;
|
|
FillCollSampList(LoadList, 0);
|
|
ExtractItems(SpecList, LoadList, 'Specimens');
|
|
with SpecList do for i := 0 to Count - 1 do
|
|
if SpecimenList.IndexOf(Strings[i]) = -1 then SpecimenList.Add(Strings[i]);
|
|
finally
|
|
LoadList.Free;
|
|
SpecList.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TLabTest.FillCollSampList(LoadData: TStringList; DfltCollSamp: Integer);
|
|
{1 2 3 4 5 6 7 8 9 10 }
|
|
{n^IEN^CollSampName^SpecIEN^TubeTop^MinInterval^MaxPerDay^LabCollect^SampReqCommentIEN;name^SpecName}
|
|
var
|
|
i, LastListItem, AnIndex: Integer;
|
|
ACollSamp: TCollSamp;
|
|
LabCollSamp: Integer;
|
|
begin
|
|
i := -1;
|
|
if CollSampList = nil then CollSampList := TList.Create;
|
|
LastListItem := CollSampList.Count ;
|
|
LabCollSamp := StrToIntDef(ExtractDefault(LoadData, 'Lab CollSamp'), 0);
|
|
repeat Inc(i) until (i = LoadData.Count) or (LoadData[i] = '~CollSamp');
|
|
Inc(i);
|
|
if i < LoadData.Count then repeat
|
|
if LoadData[i][1] = 'i' then
|
|
begin
|
|
ACollSamp := TCollSamp.Create;
|
|
with ACollSamp do
|
|
begin
|
|
AnIndex := StrToIntDef(Copy(Piece(LoadData[i], '^', 1), 2, 999), -1);
|
|
CollSampID := StrToInt(Piece(LoadData[i], '^', 2));
|
|
CollSampName := Piece(LoadData[i], '^', 3);
|
|
SpecimenID := StrToIntDef(Piece(LoadData[i], '^', 4), 0);
|
|
SpecimenName := Piece(LoadData[i], '^', 10);
|
|
TubeColor := Piece(LoadData[i], '^', 5);
|
|
MinInterval := StrToIntDef(Piece(LoadData[i], '^', 6), 0);
|
|
MaxPerDay := StrToIntDef(Piece(LoadData[i], '^', 7), 0);
|
|
LabCanCollect := AnIndex = LabCollSamp;
|
|
SampReqComment := Piece(LoadData[i], '^', 9);
|
|
WardComment := TStringList.Create;
|
|
if CollSampID = StrToIntDef(LRFSAMP, 0) then
|
|
CollSamp := CollSampID
|
|
else if AnIndex = DfltCollSamp then
|
|
CollSamp := CollSampID;
|
|
end; {with}
|
|
LastListItem := CollSampList.Add(ACollSamp);
|
|
end; {if}
|
|
if (LoadData[i][1] = 't') then
|
|
TCollSamp(CollSampList.Items[LastListItem]).WardComment.Add(Copy(LoadData[i], 2, 255));
|
|
Inc(i);
|
|
until (i = LoadData.Count) or (LoadData[i][1] = '~');
|
|
end;
|
|
|
|
procedure TLabTest.SetCollSampDflts;
|
|
var
|
|
tmpResp: TResponse;
|
|
begin
|
|
Specimen := 0;
|
|
Comment.Clear;
|
|
CurReqComment := TestReqComment;
|
|
if CollSamp = 0 then Exit;
|
|
with QuickOrderResponses do tmpResp := FindResponseByName('SPECIMEN' ,1);
|
|
if (LRFSPEC <> '') and (tmpResp = nil) then
|
|
ChangeSpecimen(LRFSPEC)
|
|
else with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
|
|
begin
|
|
Specimen := SpecimenID;
|
|
if SampReqcomment <> '' then CurReqComment := SampReqComment;
|
|
end;
|
|
end;
|
|
|
|
procedure TLabTest.ChangeCollSamp(CollSampIEN: Integer);
|
|
begin
|
|
CollSamp := CollSampIEN;
|
|
SetCollSampDflts;
|
|
end;
|
|
|
|
procedure TLabTest.ChangeSpecimen(const SpecimenIEN: string);
|
|
begin
|
|
Specimen := StrToIntDef(SpecimenIEN,0);
|
|
end;
|
|
|
|
procedure TLabTest.ChangeComment(const CommentText: string);
|
|
begin
|
|
Comment.Add(CommentText);
|
|
end;
|
|
|
|
function TLabTest.LabCanCollect: Boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := False;
|
|
i := IndexOfCollSamp(CollSamp);
|
|
if i > -1 then with TCollSamp(CollSampList.Items[i]) do Result := LabCanCollect;
|
|
end;
|
|
|
|
procedure TLabTest.LoadCollSamp(AComboBox: TORComboBox);
|
|
{ loads the collection sample combo box, expects CollSamp to already be set to default }
|
|
var
|
|
i: Integer;
|
|
x: string;
|
|
begin
|
|
AComboBox.Clear;
|
|
with CollSampList do for i := 0 to Count - 1 do with TCollSamp(Items[i]) do
|
|
begin
|
|
x := IntToStr(CollSampID) + '^' + CollSampName;
|
|
if Length(TubeColor) <> 0 then x := x + ' (' + TubeColor + ')';
|
|
AComboBox.Items.Add(x);
|
|
if CollSamp = CollSampID then AComboBox.ItemIndex := i;
|
|
end;
|
|
if ((ALabTest.LabSubscript = 'CH') and (not UserHasLRLABKey)) then
|
|
begin
|
|
// do not add 'Other' (coded this way for clarity)
|
|
end
|
|
else
|
|
with AComboBox do
|
|
begin
|
|
Items.Add('0^Other...');
|
|
if ItemIndex < 0 then ItemIndex := Items.IndexOf('Other...');
|
|
end;
|
|
end;
|
|
|
|
procedure TLabTest.LoadSpecimen(AComboBox: TORComboBox);
|
|
{ loads specimen combo box, if SpecimenList is empty, use 'E' xref on 61 ?? }
|
|
var
|
|
i: Integer;
|
|
tmpResp: TResponse;
|
|
begin
|
|
AComboBox.Clear;
|
|
if ObtainSpecimen then
|
|
begin
|
|
if SpecimenList.Count = 0 then LoadSpecimens(SpecimenList) ;
|
|
AComboBox.Items.Assign(SpecimenList);
|
|
AComboBox.Items.Add('0^Other...');
|
|
with QuickOrderResponses do tmpResp := FindResponseByName('SPECIMEN' ,1);
|
|
if (LRFSPEC <> '') and (tmpResp = nil) then
|
|
AComboBox.SelectByID(LRFSPEC)
|
|
else if Specimen > 0 then
|
|
AComboBox.SelectByIEN(Specimen)
|
|
else
|
|
AComboBox.ItemIndex := AComboBox.Items.IndexOf('Other...');
|
|
end
|
|
else
|
|
begin
|
|
i := IndexOfCollSamp(CollSamp);
|
|
if i < CollSampList.Count then with TCollSamp(CollSampList.Items[i]) do
|
|
begin
|
|
AComboBox.Items.Add(IntToStr(SpecimenID) + '^' + SpecimenName);
|
|
AComboBox.ItemIndex := 0;
|
|
end;
|
|
with QuickOrderResponses do tmpResp := FindResponseByName('SPECIMEN' ,1);
|
|
if (LRFSPEC <> '') and (tmpResp = nil) then
|
|
begin
|
|
AComboBox.Items.Add(GetOneSpecimen(StrToInt(LRFSPEC)));
|
|
AComboBox.SelectByID(LRFSPEC);
|
|
end;
|
|
end;
|
|
ChangeSpecimen(AComboBox.ItemID);
|
|
end;
|
|
|
|
function TLabTest.NameOfCollSamp: string;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := '';
|
|
i := IndexOfCollSamp(CollSamp);
|
|
if i > -1 then with TCollSamp(CollSampList.Items[i]) do Result := CollSampName;
|
|
end;
|
|
|
|
function TLabTest.NameOfSpecimen: string;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := '';
|
|
if CollSamp > 0 then with TCollSamp(CollSampList[IndexOfCollSamp(CollSamp)]) do
|
|
if (Specimen > 0) and (Specimen = SpecimenID) then Result := SpecimenName;
|
|
if (Length(Result) = 0) and (Specimen > 0) then with SpecimenList do
|
|
for i := 0 to Count - 1 do if Specimen = StrToInt(Piece(Strings[i], '^', 1)) then
|
|
begin
|
|
Result := Piece(Strings[i], '^', 2);
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
function TLabTest.ObtainCollSamp: Boolean;
|
|
begin
|
|
Result := (not UniqueCollSamp);
|
|
end;
|
|
|
|
function TLabTest.ObtainSpecimen: Boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := True;
|
|
i := IndexOfCollSamp(CollSamp);
|
|
if (i > -1) and (i < CollSampList.Count) then with TCollSamp(CollSampList.Items[i]) do
|
|
if SpecimenID > 0 then Result := False;
|
|
end;
|
|
|
|
function TLabTest.ObtainComment: Boolean;
|
|
begin
|
|
Result := Length(CurReqComment) > 0;
|
|
end;
|
|
|
|
procedure TfrmODBBank.ExtractModifiers(OutList:TStrings; AList:TStrings);
|
|
begin
|
|
ExtractItems(Outlist, AList,'MODIFIERS');
|
|
end;
|
|
|
|
procedure TfrmODBBank.ExtractUrgencies(OutList:TStrings; AList:TStrings);
|
|
begin
|
|
ExtractItems(Outlist, AList,'URGENCIES');
|
|
end;
|
|
|
|
procedure TfrmODBBank.ExtractSurgeries(OutList:TStrings; AList:TStrings);
|
|
begin
|
|
ExtractItems(OutList, AList,'SURGERIES');
|
|
end;
|
|
|
|
procedure TfrmODBBank.ExtractSpecimens(OutList:TStrings; AList:TStrings);
|
|
begin
|
|
ExtractItems(OutList, AList,'SPECIMENS');
|
|
end;
|
|
|
|
procedure TfrmODBBank.ExtractTypeScreen(OutList:TStrings; AList:TStrings);
|
|
begin
|
|
ExtractItems(OutList, AList, 'TYPE AND SCREEN');
|
|
end;
|
|
|
|
procedure TfrmODBBank.ExtractSpecimen(OutList:TStrings; AList:TStrings);
|
|
begin
|
|
ExtractItems(OutList, AList, 'SPECIMEN');
|
|
end;
|
|
|
|
procedure TfrmODBBank.ExtractPatientInfo(OutList:TStrings; AList:TStrings);
|
|
begin
|
|
ExtractItems(OutList, AList, 'INFO');
|
|
end;
|
|
|
|
procedure TfrmODBBank.ExtractTests(OutList:TStrings; AList:TStrings);
|
|
begin
|
|
ExtractItems(OutList, AList, 'TESTS');
|
|
end;
|
|
|
|
procedure TfrmODBBank.ExtractMSBOS(OutList:TStrings; AList:TStrings);
|
|
begin
|
|
ExtractItems(OutList, AList, 'MSBOS');
|
|
end;
|
|
|
|
function TfrmODBBank.SpecimenNeeded(OutList:TStrings; AList:TStrings; CompID:integer): Boolean;
|
|
var
|
|
i:integer;
|
|
aborh: boolean;
|
|
aSpecimen, aSpecimenDate: string;
|
|
aWantDateTime, aExpiredSpecimenDate: TFMDateTime;
|
|
begin
|
|
result := false;
|
|
aborh := false;
|
|
aSpecimen := '';
|
|
OutList.Clear;
|
|
ExtractItems(OutList,Alist,'ABORH');
|
|
for i := 0 to OutList.Count - 1 do
|
|
begin
|
|
if Length(OutList[i])>1 then
|
|
begin
|
|
aborh := true;
|
|
end;
|
|
end;
|
|
if aborh = false then
|
|
begin
|
|
result := true;
|
|
exit;
|
|
end;
|
|
OutList.Clear;
|
|
ExtractSpecimen(OutList, uVBECList);
|
|
if OutList.Count > 0 then aSpecimen := OutList[0];
|
|
OutList.Clear;
|
|
ExtractItems(OutList,AList,'SPECIMENS');
|
|
aWantDateTime := calWantTime.FMDateTime;
|
|
aSpecimenDate := piece(aSpecimen,'^',1);
|
|
aExpiredSpecimenDate := 0;
|
|
if Length(aSpecimenDate) > 0 then aExpiredSpecimenDate := StrToFloat(aSpecimenDate);
|
|
|
|
for i := 0 to OutList.Count - 1 do
|
|
begin
|
|
if (IntToStr(aLabTest.ItemID) = piece(OutList[i],'^',1)) and (piece(OutList[i],'^',2) = '1') then
|
|
if aSpecimen = '' then
|
|
begin
|
|
result := true;
|
|
exit;
|
|
end
|
|
else if (Length(calWantTime.Text) > 0) and (aExpiredSpecimenDate < aWantDateTime) then
|
|
begin
|
|
result := true;
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmODBBank.Validate(var AnErrMsg: string);
|
|
|
|
procedure SetError(const x: string);
|
|
begin
|
|
if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
|
|
AnErrMsg := AnErrMsg + x;
|
|
end;
|
|
|
|
const
|
|
TX_NO_TESTS = 'No Tests or Components selected' ;
|
|
TX_TNS_REQUIRED = 'An order for TYPE and SCREEN must be created for this order set' ;
|
|
|
|
begin
|
|
inherited;
|
|
if uSelectedItems.Count < 1 then
|
|
SetError(TX_NO_TESTS);
|
|
if uGetTns = 1 then
|
|
SetError(TX_TNS_REQUIRED);
|
|
end;
|
|
|
|
procedure TfrmODBBank.ValidateAdd(var AnErrMsg: string);
|
|
|
|
procedure SetError(const x: string);
|
|
begin
|
|
if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
|
|
AnErrMsg := AnErrMsg + x;
|
|
end;
|
|
|
|
var
|
|
i, CmtType, DaysofFuturePast: integer;
|
|
d1, d2: TDateTime;
|
|
x: string;
|
|
const
|
|
{Diagnostic Test Errors}
|
|
TX_NO_TIME = 'Collection Time is required.' ;
|
|
TX_NO_TCOLLTYPE = 'Collection Type is required.' ;
|
|
TX_NO_TESTS = 'A Lab Test or tests must be selected.' ;
|
|
TX_BAD_TIME = 'Collection times must be chosen from the drop down list or entered as valid' +
|
|
' Fileman date/times (T@1700, T+1@0800, etc.).' ;
|
|
TX_PAST_TIME = 'Collection times in the past are not allowed.';
|
|
TX_NO_DAYS = 'A number of days must be entered for continuous orders.';
|
|
TX_NO_TIMES = 'A number of times must be entered for continuous orders.';
|
|
TX_NO_STOP_DATE = 'Could not calculate the stop date for the order. Check "for n Days".';
|
|
TX_TOO_MANY_DAYS = 'Maximum number of days allowed is ';
|
|
TX_TOO_MANY_TIMES = 'For this frequency, the maximum number of times allowed is: X';
|
|
//TX_NO_COMMENT = 'A comment is required for this test and collection sample.';
|
|
TX_NUMERIC_REQD = 'A numeric value is required for urine volume.';
|
|
TX_DOSEDRAW_REQD = 'Both DOSE and DRAW times are required for this order.';
|
|
TX_TDM_REQD = 'A value for LEVEL is required for this order.';
|
|
//TX_ANTICOAG_REQD = 'You must specify an anticoagulant on this order.' ;
|
|
TX_NO_COLLSAMPLE = 'A collection sample MUST be specified.';
|
|
TX_NO_SPECIMEN = 'A specimen MUST be specified.';
|
|
TX_NO_URGENCY = 'An urgency MUST be specified.';
|
|
TX_NO_FREQUENCY = 'A collection frequency MUST be specified.';
|
|
TX_NOT_LAB_COLL_TIME = ' is not a routine lab collection time.';
|
|
TX_NO_ALPHA = 'For continuous orders, enter a number of days, or an "X" followed by a number of times.';
|
|
TX_BADTIME_CAP = 'Invalid Immediate Collect Time';
|
|
{Component/Type & Screen Errors}
|
|
TX_NO_COMPONENTS = 'A Blood Product MUST be selected.';
|
|
TX_NO_QUANTITY = 'The number of units MUST be specified under "Quantity".';
|
|
TX_HIGH_QUANTITY = 'Quantity too high.';
|
|
TX_NO_DATEMODIFIED= 'A Date/time Wanted MUST be specified';
|
|
//TX_NO_PREPARATION = 'Preparation MUST be specified - either "Hold" or "Immediate".';
|
|
TX_NO_SURGERY = 'A Surgery MUST be specified for Pre-Op orders'; //only if Pre-op selected
|
|
TX_NO_REASON = 'A Reason for Request MUST be entered';
|
|
TX_NO_COMMENT = 'A Comment MUST be entered for this Component';
|
|
TX_DUPLICATE = 'Duplicate Test/Component not allowed';
|
|
TX_NO_TEST_SELECTED = 'No Test/Component selected';
|
|
|
|
begin
|
|
inherited;
|
|
AnErrMsg := '';
|
|
if aLabTest = nil then
|
|
begin
|
|
AnErrMsg := TX_NO_TEST_SELECTED;
|
|
Exit;
|
|
end;
|
|
for i := 0 to uSelectedItems.Count - 1 do
|
|
if IntToStr(aLabTest.TestID) = piece(uSelectedItems[i],'^',2) then
|
|
begin
|
|
AnErrMsg := TX_DUPLICATE;
|
|
Exit;
|
|
end;
|
|
if LRORDERMODE = TORDER_MODE_DIAG then
|
|
begin
|
|
with cboAvailTest do if ItemIEN <= 0 then SetError(TX_NO_TESTS);
|
|
|
|
if ALabTest <> nil then
|
|
if (cboCollType.ItemID = 'I') and (not ALabTest.LabCanCollect) then
|
|
begin
|
|
SetError(TX_NO_IMMED);
|
|
cboCollType.ItemIndex := -1;
|
|
end;
|
|
if uSpecimen = 0 then
|
|
if cboCollType.ItemID = '' then
|
|
SetError(TX_NO_TCOLLTYPE)
|
|
else if cboCollType.ItemID = 'LC' then
|
|
begin
|
|
if Length(cboCollTime.Text) = 0 then SetError(TX_NO_TIME);
|
|
with cboCollTime do if (Length(Text) > 0) and (ItemIndex = -1) then
|
|
begin
|
|
if StrToFMDateTime(Text) < 0 then
|
|
SetError(TX_BAD_TIME)
|
|
else if StrToFMDateTime(Text) < FMNow then
|
|
SetError(TX_PAST_TIME)
|
|
else if OrderForInpatient then
|
|
begin
|
|
d1 := FMDateTimeToDateTime(Trunc(StrToFMDateTime(cboColltime.Text)));
|
|
d2 := FMDateTimeToDateTime(FMToday);
|
|
if EvtDelayLoc > 0 then
|
|
DaysofFuturePast := LabCollectFutureDays(EvtDelayLoc,EvtDivision)
|
|
else
|
|
DaysofFuturePast := LabCollectFutureDays(Encounter.Location);
|
|
if DaysofFuturePast = 0 then DaysofFuturePast := 7;
|
|
if ((d1 - d2) > DaysofFuturePast) then
|
|
SetError('A lab collection cannot be ordered more than '
|
|
+ IntToStr(DaysofFuturePast) + ' days in advance');
|
|
end
|
|
else if EvtDelayLoc > 0 then
|
|
begin
|
|
if (not IsLabCollectTime(StrToFMDateTime(cboCollTime.Text), EvtDelayLoc)) then
|
|
SetError(cboCollTime.Text + TX_NOT_LAB_COLL_TIME);
|
|
end
|
|
else if EvtDelayLoc <= 0 then
|
|
begin
|
|
if (not IsLabCollectTime(StrToFMDateTime(cboCollTime.Text), Encounter.Location)) then
|
|
SetError(cboCollTime.Text + TX_NOT_LAB_COLL_TIME);
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
if cboCollType.ItemID = 'I' then
|
|
begin
|
|
calCollTime.Text := txtImmedColl.Text;
|
|
x := ValidImmCollTime(calCollTime.FMDateTime);
|
|
if (Piece(x, U, 1) <> '1') then
|
|
SetError(Piece(x, U, 2));
|
|
end;
|
|
|
|
with calColltime do
|
|
begin
|
|
if FMDateTime = 0 then SetError(TX_BAD_TIME)
|
|
else
|
|
begin
|
|
// date only was entered
|
|
if (FMDateTime - Trunc(FMDateTime) = 0) then
|
|
begin
|
|
if (Trunc(FMDateTime) < FMToday) then SetError(TX_PAST_TIME);
|
|
end
|
|
// date/time was entered
|
|
else
|
|
begin
|
|
if (UpperCase(Text) <> 'NOW') and (FMDateTime < FMNow) then SetError(TX_PAST_TIME);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
with cboUrgency do if ItemIEN <= 0 then SetError(TX_NO_URGENCY);
|
|
if ALabTest <> nil then
|
|
begin
|
|
CmtType := FCmtTypes.IndexOf(ALabTest.CurReqComment) ;
|
|
with ALabTest do
|
|
case CmtType of
|
|
0 : {ANTICOAGULATION} {if (Pos('ANTICOAGULANT',Comment.Text)=0) then
|
|
SetError(TX_ANTICOAG_REQD)};
|
|
1 : {DOSE/DRAW TIMES} if (Pos('Last dose:',Comment.Text)=0) or
|
|
(Pos('draw time:',Comment.Text)=0) then
|
|
SetError(TX_DOSEDRAW_REQD);
|
|
2 : {ORDER COMMENT} {if (Length(Comment.Text)=0) then
|
|
SetError(TX_NO_COMMENT)};
|
|
3 : {ORDER COMMENT MODIFIED} {if (Length(Comment.Text)=0) then
|
|
SetError(TX_NO_COMMENT)};
|
|
4 : {TDM (PEAK-TROUGH} if (Pos('Dose is expected',Comment.Text)=0) then
|
|
SetError(TX_TDM_REQD);
|
|
5 : {TRANSFUSION} {if (Length(Comment.Text)=0) then
|
|
SetError(TX_NO_COMMENT)};
|
|
6 : {URINE VOLUME} if (Length(Comment.Text)>0) and
|
|
(ExtractInteger(Comment.Text)<=0) then
|
|
Comment.Text := '?';
|
|
{SetError(TX_NUMERIC_REQD);}
|
|
end;
|
|
end;
|
|
end
|
|
else if LRORDERMODE = TORDER_MODE_COMP then
|
|
begin
|
|
with cboAvailComp do
|
|
begin
|
|
if ItemIEN <= 0 then SetError(TX_NO_COMPONENTS);
|
|
end;
|
|
if StrToInt(tQuantity.Text) < 1 then SetError(TX_NO_QUANTITY);
|
|
if calWantTime.Text = '' then SetError(TX_NO_DATEMODIFIED);
|
|
//if cboPreparation.Text ='' then SetError(TX_NO_PREPARATION);
|
|
if StrToInt(tQuantity.Text) > 100 then SetError(TX_HIGH_QUANTITY);
|
|
if tReason.Text = '' then SetError(TX_NO_REASON);
|
|
if (txtDiagComment.Text = '') and (cboAvailComp.Text = 'OTHER') then SetError(TX_NO_COMMENT);
|
|
if (cboUrgency.Text = 'PRE-OP') and (length(cboSurgery.ItemID) < 1) then SetError(TX_NO_SURGERY);
|
|
end;
|
|
end;
|
|
|
|
function TfrmODBBank.ValidAdd: Boolean;
|
|
const
|
|
TX_NO_SAVE = 'This item cannot be added for the following reason(s):' + CRLF + CRLF;
|
|
TX_NO_SAVE_CAP = 'Unable to Add item';
|
|
TX_SAVE_ERR = 'Unexpected error - it was not possible to Add this item.';
|
|
var
|
|
ErrMsg: string;
|
|
|
|
begin
|
|
Result := True;
|
|
ValidateAdd(ErrMsg);
|
|
if Length(ErrMsg) > 0 then
|
|
begin
|
|
InfoBox(TX_NO_SAVE + ErrMsg, TX_NO_SAVE_CAP, MB_OK);
|
|
Result := False;
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
function TfrmODBBank.ValidCollTime(UserEntry: string): string;
|
|
var
|
|
i: integer;
|
|
const
|
|
FMDateResponses: array[0..3] of string = ('TODAY','NOW','NOON','MID');
|
|
begin
|
|
Result := '';
|
|
UserEntry := UpperCase(UserEntry);
|
|
if StrToFMDateTime(UserEntry) < 0 then exit;
|
|
if (UserEntry = 'T') or
|
|
(UserEntry = 'N') or
|
|
(Copy(UserEntry,1,2)='T+') or
|
|
(Copy(UserEntry,1,2)='T@') or
|
|
(Copy(UserEntry,1,2)='T-') or
|
|
(Copy(UserEntry,1,2)='N+') then Result := UserEntry
|
|
else
|
|
for i := 0 to 3 do if Pos(FMDateResponses[i],UserEntry)>0 then Result := UserEntry ;
|
|
if Result = '' then Result := FloatToStr(StrToFMDateTime(UserEntry));
|
|
end;
|
|
|
|
procedure TfrmODBBank.GetAllCollSamples(AComboBox: TORComboBox);
|
|
var
|
|
OtherSamp: string;
|
|
begin
|
|
with ALabTest, AComboBox do
|
|
begin
|
|
if ((CollSampList.Count + 1) <= AComboBox.Items.Count) then LoadAllSamples;
|
|
OtherSamp := SelectOtherCollSample(Font.Size, CollSampCount, CollSampList);
|
|
if OtherSamp = '-1' then exit;
|
|
if SelectByID(Piece(OtherSamp, U, 1)) = -1 then
|
|
if Items.Count > CollSampCount + 1 then
|
|
Items[0] := OtherSamp
|
|
else
|
|
Items.Insert(0, OtherSamp) ;
|
|
SelectByID(Piece(OtherSamp, U, 1));
|
|
AComboBox.OnChange(Self);
|
|
ActiveControl := cmdAccept;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmODBBank.GetAllSpecimens(AComboBox: TORComboBox);
|
|
var
|
|
OtherSpec: string;
|
|
begin
|
|
inherited;
|
|
if ALabTest <> nil then
|
|
with ALabTest, AComboBox do
|
|
begin
|
|
AComboBox.DroppedDown := False;
|
|
OtherSpec := SelectOtherSpecimen(Font.Size, SpecimenList);
|
|
if OtherSpec = '-1' then exit;
|
|
if SelectByID(Piece(OtherSpec, U, 1)) = -1 then
|
|
if Items.Count > SpecListCount + 1 then
|
|
Items[0] := OtherSpec
|
|
else
|
|
Items.Insert(0, OtherSpec) ;
|
|
SpecimenList.Add(OtherSpec);
|
|
SelectByID(Piece(OtherSpec, U, 1));
|
|
AComboBox.OnChange(Self);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmODBBank.SetupCollTimes(CollType: string);
|
|
var
|
|
tmpImmTime, tmpTime: TFMDateTime;
|
|
x, tmpORECALLType, tmpORECALLTime: string;
|
|
begin
|
|
x := GetLastCollectionTime;
|
|
tmpORECALLType := Piece(x, U, 1);
|
|
tmpORECALLTime := Piece(x, U, 2);
|
|
if CollType = 'SP' then
|
|
begin
|
|
cboColltime.Visible := False;
|
|
txtImmedColl.Visible := False;
|
|
pnlCollTimeButton.Visible := False;
|
|
pnlCollTimeButton.TabStop := False;
|
|
calCollTime.Visible := True;
|
|
calColltime.Enabled := True;
|
|
if FLastCollTime <> '' then
|
|
begin
|
|
calCollTime.Text := ValidCollTime(FLastColltime);
|
|
if IsFMDateTime(calCollTime.Text) then
|
|
begin
|
|
calCollTime.Text := FormatFMDateTime('mmm dd,yy@hh:nn', StrToFMDateTime(calColltime.Text));
|
|
calColltime.FMDateTime := StrToFMDateTime(FLastCollTime);
|
|
end;
|
|
end
|
|
else if tmpORECALLTime <> '' then
|
|
begin
|
|
calCollTime.Text := ValidCollTime(tmpORECALLTime);
|
|
if IsFMDateTime(calCollTime.Text) then
|
|
begin
|
|
calCollTime.Text := FormatFMDateTime('mmm dd,yy@hh:nn', StrToFMDateTime(calColltime.Text));
|
|
calColltime.FMDateTime := StrToFMDateTime(tmpORECALLTime);
|
|
end;
|
|
end
|
|
else if LRFDATE <> '' then
|
|
calCollTime.Text := LRFDATE
|
|
else
|
|
calCollTime.Text := 'TODAY';
|
|
end
|
|
else if CollType = 'WC' then
|
|
begin
|
|
cboColltime.Visible := False;
|
|
txtImmedColl.Visible := False;
|
|
pnlCollTimeButton.Visible := False;
|
|
pnlCollTimeButton.TabStop := False;
|
|
calCollTime.Visible := True;
|
|
calColltime.Enabled := True;
|
|
if FLastCollTime <> '' then
|
|
begin
|
|
calCollTime.Text := ValidColltime(FLastColltime);
|
|
if IsFMDateTime(calCollTime.Text) then
|
|
begin
|
|
calCollTime.Text := FormatFMDateTime('mmm dd,yy@hh:nn', StrToFMDateTime(calColltime.Text));
|
|
calColltime.FMDateTime := StrToFMDateTime(FLastCollTime);
|
|
end;
|
|
end
|
|
else if tmpORECALLTime <> '' then
|
|
begin
|
|
calCollTime.Text := ValidColltime(tmpORECALLTime);
|
|
if IsFMDateTime(calCollTime.Text) then
|
|
begin
|
|
calCollTime.Text := FormatFMDateTime('mmm dd,yy@hh:nn', StrToFMDateTime(calColltime.Text));
|
|
calColltime.FMDateTime := StrToFMDateTime(tmpORECALLTime);
|
|
end;
|
|
end
|
|
else if LRFDATE <> '' then
|
|
calCollTime.Text := LRFDATE
|
|
else
|
|
calCollTime.Text := 'NOW';
|
|
end
|
|
else if CollType = 'LC' then
|
|
begin
|
|
cboColltime.Visible := True;
|
|
calCollTime.Visible := False;
|
|
calColltime.Enabled := False;
|
|
txtImmedColl.Visible := False;
|
|
pnlCollTimeButton.Visible := False;
|
|
pnlCollTimeButton.TabStop := False;
|
|
with CtrlInits do SetControl(cboCollTime, 'Lab Collection Times');
|
|
if Pos(U, FLastLabCollTime) > 0 then
|
|
cboColltime.SelectByID(Piece(FLastLabCollTime, U, 1))
|
|
else if FLastLabCollTime <> '' then
|
|
cboCollTime.Text := FLastLabCollTime
|
|
else if (tmpORECALLTime <> '') and (tmpORECALLType = 'LC') then
|
|
cboCollTime.Text := MakeRelativeDateTime(StrToFMDateTime(tmpORECALLTime))
|
|
else if LRFDATE <> '' then
|
|
cboCollTime.Text := LRFDATE
|
|
else
|
|
cboCollTime.ItemIndex := 0;
|
|
end
|
|
else if CollType = 'I' then
|
|
begin
|
|
cboColltime.Visible := False;
|
|
calCollTime.Visible := False;
|
|
calColltime.Enabled := False;
|
|
txtImmedColl.Visible := True;
|
|
pnlCollTimeButton.Visible := True;
|
|
pnlCollTimeButton.TabStop := True;
|
|
tmpImmTime := GetDefaultImmCollTime;
|
|
tmpTime := 0;
|
|
if (FLastColltime <> '') then
|
|
tmpTime := StrToFMDateTime(FLastColltime)
|
|
else if (tmpORECALLTime <> '') then
|
|
tmpTime := StrToFMDateTime(tmpORECALLTime)
|
|
else if LRFDATE <> '' then
|
|
tmpTime := StrToFMDateTime(LRFDATE);
|
|
|
|
if tmpTime > tmpImmTime then
|
|
begin
|
|
calCollTime.FMDateTime := tmpTime;
|
|
txtImmedColl.Text := FormatFMDateTime('mmm dd,yy@hh:nn', tmpTime);
|
|
end
|
|
else
|
|
begin
|
|
calCollTime.FMDateTime := GetDefaultImmCollTime;
|
|
txtImmedColl.Text := FormatFMDateTime('mmm dd,yy@hh:nn', calCollTime.FMDateTime);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmODBBank.LoadCollType(AComboBox:TORComboBox);
|
|
var
|
|
i: integer;
|
|
begin
|
|
with CtrlInits, cboCollType do
|
|
begin
|
|
SetControl(cboCollType, 'Collection Types');
|
|
if not ALabTest.LabCanCollect then
|
|
begin
|
|
i := SelectByID('LC');
|
|
if i > -1 then Items.Delete(i);
|
|
i := SelectByID('I');
|
|
if i > -1 then Items.Delete(i);
|
|
end ;
|
|
if LRFZX <> '' then
|
|
begin
|
|
if (LRFZX = 'LC') or (LRFZX = 'I') then
|
|
begin
|
|
if ALabTest.LabCanCollect then
|
|
cboCollType.SelectByID(LRFZX)
|
|
else
|
|
cboCollType.SelectByID('WC');
|
|
end
|
|
else
|
|
cboCollType.SelectByID(LRFZX);
|
|
end
|
|
else if FLastCollType <> '' then
|
|
begin
|
|
if (FLastCollType = 'LC') or (FLastCollType = 'I') then
|
|
begin
|
|
if ALabTest.LabCanCollect then
|
|
cboCollType.SelectByID(FLastCollType)
|
|
else
|
|
cboCollType.SelectByID('WC');
|
|
end
|
|
else
|
|
cboCollType.SelectByID(FLastCollType);
|
|
end
|
|
else if uDfltCollType <> '' then
|
|
begin
|
|
if (uDfltCollType = 'LC') or (uDfltCollType = 'I') then
|
|
begin
|
|
if ALabTest.LabCanCollect then
|
|
cboCollType.SelectByID(uDfltCollType)
|
|
else
|
|
cboCollType.SelectByID('WC');
|
|
end
|
|
else
|
|
cboCollType.SelectByID(uDfltCollType);
|
|
end
|
|
else if OrderForInpatient then
|
|
begin
|
|
if ALabTest.LabCanCollect then
|
|
cboCollType.SelectByID('LC')
|
|
else
|
|
SelectByID('WC');
|
|
end
|
|
else
|
|
cboCollType.SelectByID('SP');
|
|
end;
|
|
SetupCollTimes(cboCollType.ItemID);
|
|
end;
|
|
|
|
procedure TfrmODBBank.ReadServerVariables;
|
|
begin
|
|
LRFZX := KeyVariable['LRFZX'];
|
|
LRFSAMP := KeyVariable['LRFSAMP'];
|
|
LRFSPEC := KeyVariable['LRFSPEC'];
|
|
LRFDATE := KeyVariable['LRFDATE'];
|
|
LRFURG := KeyVariable['LRFURG'];
|
|
LRFSCH := KeyVariable['LRFSCH'];
|
|
end;
|
|
|
|
procedure TfrmODBBank.cboAvailTestSelect(Sender: TObject);
|
|
var
|
|
x: string;
|
|
i: integer;
|
|
begin
|
|
DisableComponentControls;
|
|
EnableDiagTestControls;
|
|
LRORDERMODE := TORDER_MODE_DIAG;
|
|
with cboAvailTest do
|
|
begin
|
|
if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
|
|
for i := 0 to uSelectedItems.Count - 1 do
|
|
if ItemID = piece(uSelectedItems[i],'^',1) then
|
|
begin
|
|
ShowMessage('This test has already been selected!');
|
|
Exit;
|
|
end;
|
|
FLastLabID := ItemID ;
|
|
FLastItemID := ItemID;
|
|
Changing := True;
|
|
if Sender <> Self then
|
|
Responses.Clear; // Sender=Self when called from SetupDialog
|
|
if CharAt(ItemID, 1) = 'Q' then
|
|
with Responses do
|
|
begin
|
|
FLastItemID := ItemID;
|
|
QuickOrder := ExtractInteger(ItemID);
|
|
SetControl(cboAvailTest, 'ORDERABLE', 1);
|
|
if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
|
|
FLastLabID := ItemID;
|
|
end;
|
|
ALabTest := TLabTest.Create(ItemID, Responses);
|
|
end;
|
|
with ALabTest do
|
|
begin
|
|
|
|
{with Responses do if QuickOrder > 0 then
|
|
begin
|
|
StatusText('Initializing Quick Order');
|
|
Changing := True;
|
|
SetControl(cboAvailTest, 'ORDERABLE', 1);
|
|
DetermineCollectionDefaults(Responses);
|
|
LoadUrgency(cboCollType.ItemID, cboUrgency);
|
|
SetControl(cboUrgency, 'URGENCY', 1);
|
|
Urgency := cboUrgency.ItemIEN;
|
|
if (Urgency = 0) and (cboUrgency.Items.Count = 1) then
|
|
begin
|
|
cboUrgency.ItemIndex := 0;
|
|
Urgency := cboUrgency.ItemIEN;
|
|
end;
|
|
tmpResp := FindResponseByName('SPECIMEN' ,1);
|
|
i := 1 ;
|
|
tmpResp := Responses.FindResponseByName('COMMENT',i);
|
|
while tmpResp <> nil do
|
|
begin
|
|
Comment.Add(tmpResp.EValue);
|
|
Inc(i);
|
|
tmpResp := Responses.FindResponseByName('COMMENT',i);
|
|
end ;
|
|
end; // Quick Order}
|
|
if ObtainCollSamp then
|
|
begin
|
|
//For BloodBank orders, this condition should never occur
|
|
end
|
|
else
|
|
begin
|
|
with ALabTest do
|
|
with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
|
|
begin
|
|
x := '' ;
|
|
for i := 0 to WardComment.Count-1 do
|
|
x := x + WardComment.strings[i]+#13#10 ;
|
|
pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
|
|
OrderMessage(x) ;
|
|
end ;
|
|
end;
|
|
if ObtainComment then
|
|
LoadRequiredComment(FCmtTypes.IndexOf(CurReqComment))
|
|
else
|
|
DisableCommentPanels;
|
|
x := '' ;
|
|
for i := 0 to CurWardComment.Count-1 do
|
|
x := x + CurWardComment.strings[i]+#13#10 ;
|
|
i := IndexOfCollSamp(CollSamp);
|
|
if i > -1 then with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
|
|
for i := 0 to WardComment.Count-1 do
|
|
x := x + WardComment.strings[i]+#13#10 ;
|
|
pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
|
|
OrderMessage(x) ;
|
|
end; { with }
|
|
StatusText('');
|
|
Changing := False;
|
|
end;
|
|
|
|
procedure TfrmODBBank.cboAvailCompSelect(Sender: TObject);
|
|
var
|
|
x: string;
|
|
i: integer;
|
|
begin
|
|
DisableDiagTestControls;
|
|
EnableComponentControls;
|
|
LRORDERMODE := TORDER_MODE_COMP;
|
|
with cboAvailComp do
|
|
begin
|
|
if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
|
|
for i := 0 to uSelectedItems.Count - 1 do
|
|
if ItemID = piece(uSelectedItems[i],'^',1) then
|
|
begin
|
|
ShowMessage('This component has already been selected!');
|
|
Exit;
|
|
end;
|
|
FLastLabID := ItemID ;
|
|
FLastItemID := ItemID;
|
|
Changing := True;
|
|
if Sender <> Self then
|
|
Responses.Clear; // Sender=Self when called from SetupDialog
|
|
if CharAt(ItemID, 1) = 'Q' then
|
|
with Responses do
|
|
begin
|
|
FLastItemID := ItemID;
|
|
QuickOrder := ExtractInteger(ItemID);
|
|
SetControl(cboAvailComp, 'ORDERABLE', 1);
|
|
if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
|
|
FLastLabID := ItemID;
|
|
end;
|
|
ALabTest := TLabTest.Create(ItemID, Responses);
|
|
end;
|
|
with ALabTest do
|
|
begin
|
|
|
|
{with Responses do if QuickOrder > 0 then
|
|
begin
|
|
StatusText('Initializing Quick Order');
|
|
Changing := True;
|
|
SetControl(cboAvailTest, 'ORDERABLE', 1);
|
|
DetermineCollectionDefaults(Responses);
|
|
LoadUrgency(cboCollType.ItemID, cboUrgency);
|
|
SetControl(cboUrgency, 'URGENCY', 1);
|
|
Urgency := cboUrgency.ItemIEN;
|
|
if (Urgency = 0) and (cboUrgency.Items.Count = 1) then
|
|
begin
|
|
cboUrgency.ItemIndex := 0;
|
|
Urgency := cboUrgency.ItemIEN;
|
|
end;
|
|
tmpResp := FindResponseByName('SPECIMEN' ,1);
|
|
i := 1 ;
|
|
tmpResp := Responses.FindResponseByName('COMMENT',i);
|
|
while tmpResp <> nil do
|
|
begin
|
|
Comment.Add(tmpResp.EValue);
|
|
Inc(i);
|
|
tmpResp := Responses.FindResponseByName('COMMENT',i);
|
|
end ;
|
|
end; // Quick Order}
|
|
{if ObtainCollSamp then
|
|
begin
|
|
// should not occur with Blood orders
|
|
end
|
|
else
|
|
begin
|
|
with ALabTest do
|
|
with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
|
|
begin
|
|
x := '' ;
|
|
for i := 0 to WardComment.Count-1 do
|
|
x := x + WardComment.strings[i]+#13#10 ;
|
|
pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
|
|
OrderMessage(x) ;
|
|
end ;
|
|
end;
|
|
}
|
|
if ObtainComment then
|
|
LoadRequiredComment(FCmtTypes.IndexOf(CurReqComment))
|
|
else
|
|
DisableCommentPanels;
|
|
x := '' ;
|
|
for i := 0 to CurWardComment.Count-1 do
|
|
x := x + CurWardComment.strings[i]+#13#10 ;
|
|
i := IndexOfCollSamp(CollSamp);
|
|
if i > -1 then with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
|
|
for i := 0 to WardComment.Count-1 do
|
|
x := x + WardComment.strings[i]+#13#10 ;
|
|
pnlMessage.TabOrder := cboAvailComp.TabOrder + 1;
|
|
OrderMessage(x) ;
|
|
end; { with }
|
|
StatusText('');
|
|
Changing := False;
|
|
end;
|
|
|
|
procedure TfrmODBBank.DisableCommentPanels;
|
|
begin
|
|
lblReqComment.Visible := False;
|
|
end;
|
|
|
|
procedure TfrmODBBank.DisableComponentControls;
|
|
begin
|
|
lblModifiers.Enabled := false;
|
|
cboModifiers.Enabled := false;
|
|
lblWanted.Enabled := false;
|
|
calWantTime.Enabled := false;
|
|
//lblPreparation.Enabled := false;
|
|
//cboPreparation.Enabled := false;
|
|
lblSurgery.Enabled := false;
|
|
cboSurgery.Enabled := false;
|
|
lblReason.Enabled := false;
|
|
tReason.Enabled := false;
|
|
chkConsent.Enabled := false;
|
|
lblQuantity.Enabled := false;
|
|
tQuantity.Enabled := false;
|
|
upQuantity.Enabled := false;
|
|
cboAvailComp.ItemIndex := -1;
|
|
tQuantity.Text := '0';
|
|
end;
|
|
|
|
procedure TfrmODBBank.EnableComponentControls;
|
|
begin
|
|
lblModifiers.Enabled := true;
|
|
cboModifiers.Enabled := true;
|
|
lblWanted.Enabled := true;
|
|
calWantTime.Enabled := true;
|
|
//lblPreparation.Enabled := true;
|
|
//cboPreparation.Enabled := true;
|
|
if cboUrgency.Text = 'PRE-OP' then
|
|
begin
|
|
lblSurgery.Enabled := true;
|
|
cboSurgery.Enabled := true;
|
|
end;
|
|
lblReason.Enabled := true;
|
|
tReason.Enabled := true;
|
|
chkConsent.Enabled := true;
|
|
lblQuantity.Enabled := true;
|
|
tQuantity.Enabled := true;
|
|
upQuantity.Enabled := true;
|
|
txtDiagComment.Enabled := true;
|
|
lblDiagComment.Enabled := true;
|
|
end;
|
|
|
|
procedure TfrmODBBank.DisableDiagTestControls;
|
|
begin
|
|
lblCollTime.Enabled := false;
|
|
calCollTime.Enabled := false;
|
|
cboCollTime.Enabled := false;
|
|
cboAvailTest.ItemIndex := -1;
|
|
lblCollType.Enabled := false;
|
|
cboCollType.Enabled := false;
|
|
cmdImmedColl.Enabled := false;
|
|
end;
|
|
|
|
procedure TfrmODBBank.EnableDiagTestControls;
|
|
begin
|
|
calWantTime.Enabled := true;
|
|
lblWanted.Enabled := true;
|
|
lblCollTime.Enabled := true;
|
|
calCollTime.Enabled := true;
|
|
cboCollTime.Enabled := true;
|
|
lblCollType.Enabled := true;
|
|
cboCollType.Enabled := true;
|
|
lblUrgency.Enabled := true;
|
|
cboUrgency.Enabled := true;
|
|
txtDiagComment.Enabled := true;
|
|
lblDiagComment.Enabled := true;
|
|
cmdImmedColl.Enabled := true;
|
|
end;
|
|
|
|
procedure TfrmODBBank.LoadRequiredComment(CmtType: integer);
|
|
begin
|
|
DisableCommentPanels;
|
|
lblReqComment.Visible := True ;
|
|
end;
|
|
|
|
procedure TfrmODBBank.DetermineCollectionDefaults(Responses: TResponses);
|
|
var
|
|
RespCollect, RespStart: TResponse;
|
|
begin
|
|
if ALabTest = nil then exit;
|
|
calCollTime.Clear;
|
|
cboCollTime.Clear;
|
|
calCollTime.Enabled := True;
|
|
lblCollTime.Enabled := True;
|
|
cboColltime.Enabled := True;
|
|
with Responses, ALabTest do
|
|
begin
|
|
RespCollect := FindResponseByName('COLLECT',1);
|
|
RespStart := FindResponseByName('START' ,1);
|
|
if (RespCollect <> nil) then with RespCollect do
|
|
begin
|
|
if IValue = 'LC' then
|
|
begin
|
|
if not LabCanCollect then
|
|
begin
|
|
cboCollType.SelectByID('WC');
|
|
SetupCollTimes('WC');
|
|
end
|
|
else // if LabCanCollect
|
|
begin
|
|
cboCollType.SelectByID('LC');
|
|
SetupCollTimes('LC');
|
|
CtrlInits.SetControl(cboCollTime, 'Lab Collection Times') ;
|
|
if RespStart <> nil then
|
|
begin
|
|
cboCollTime.SelectByID('L' + RespStart.IValue);
|
|
if cboCollTime.ItemIndex < 0 then
|
|
cboCollTime.Text := RespStart.IValue;
|
|
end;
|
|
end;
|
|
end
|
|
else // if IValue <> 'LC'
|
|
begin
|
|
cboCollType.SelectByID(IValue) ;
|
|
SetupCollTimes(IValue);
|
|
if RespStart <> nil then
|
|
begin
|
|
if ContainsAlpha(RespStart.IValue) then
|
|
calColltime.Text := RespStart.IValue
|
|
else
|
|
calColltime.FMDateTime := StrToFMDateTime(RespStart.IValue);
|
|
end;
|
|
end ;
|
|
if IValue = 'I' then
|
|
if not LabCanCollect then
|
|
begin
|
|
cboCollType.SelectByID('WC');
|
|
SetupCollTimes('WC');
|
|
end
|
|
else
|
|
begin
|
|
calCollTime.Enabled := False;
|
|
if RespStart <> nil then txtImmedColl.Text := RespStart.EValue;
|
|
end;
|
|
end
|
|
else // if (RespCollect = nil)
|
|
LoadCollType(cbocollType);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmODBBank.cboAvailTestExit(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
if (Length(cboAvailTest.ItemID) = 0) or (cboAvailTest.ItemID = '0') then Exit;
|
|
if cboAvailTest.ItemID = FLastLabID then Exit;
|
|
cboAvailTestSelect(cboAvailTest);
|
|
cboAvailTest.SetFocus;
|
|
PostMessage(Handle, WM_NEXTDLGCTL, 0, 0);
|
|
end;
|
|
|
|
procedure TfrmODBBank.cboAvailCompExit(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
if (Length(cboAvailComp.ItemID) = 0) or (cboAvailComp.ItemID = '0') then Exit;
|
|
if cboAvailComp.ItemID = FLastLabID then Exit;
|
|
cboAvailCompSelect(cboAvailComp);
|
|
cboAvailComp.SetFocus;
|
|
PostMessage(Handle, WM_NEXTDLGCTL, 0, 0);
|
|
end;
|
|
|
|
procedure TfrmODBBank.cboAvailTestNeedData(Sender: TObject;
|
|
const StartFrom: String; Direction, InsertAt: Integer);
|
|
begin
|
|
cboAvailTest.ForDataUse(SubsetOfOrderItems(StartFrom, Direction, FVbecLookup));
|
|
end;
|
|
|
|
procedure TfrmODBBank.cboAvailCompNeedData(Sender: TObject;
|
|
const StartFrom: String; Direction, InsertAt: Integer);
|
|
begin
|
|
cboAvailComp.ForDataUse(SubsetOfOrderItems(StartFrom, Direction, FVbecLookup));
|
|
end;
|
|
|
|
procedure TfrmODBBank.cmdImmedCollClick(Sender: TObject);
|
|
var
|
|
ImmedCollTime: string;
|
|
begin
|
|
inherited;
|
|
ImmedCollTime := SelectImmediateCollectTime(Font.Size, txtImmedColl.Text);
|
|
if ImmedCollTime <> '-1' then
|
|
begin
|
|
txtImmedColl.Text := ImmedCollTime;
|
|
calCollTime.FMDateTime := StrToFMDateTime(ImmedCollTime);
|
|
end
|
|
else
|
|
begin
|
|
txtImmedColl.Clear;
|
|
calCollTime.Clear;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmODBBank.pgeProductChange(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
case pgeProduct.TabIndex of
|
|
TI_ORDER : begin
|
|
memMessage.Visible := true;
|
|
memOrder.Visible := true;
|
|
cmdAccept.Visible := true;
|
|
pnlSelectedTests.Visible := true;
|
|
pgeProduct.Height := 281;
|
|
end;
|
|
TI_INFO : begin
|
|
if lvSelectionList.Items.Count > 0 then exit;
|
|
LRORDERMODE := TORDER_MODE_INFO;
|
|
memMessage.Visible := false;
|
|
memOrder.Visible := false;
|
|
cmdAccept.Visible := false;
|
|
pnlSelectedTests.Visible := false;
|
|
pgeProduct.Height := 411;
|
|
end;
|
|
TI_RESULTS : begin
|
|
if lvSelectionList.Items.Count > 0 then exit;
|
|
memMessage.Visible := false;
|
|
memOrder.Visible := false;
|
|
cmdAccept.Visible := false;
|
|
pnlSelectedTests.Visible := false;
|
|
pgeProduct.Height := 411;
|
|
end;
|
|
end; {case}
|
|
end;
|
|
|
|
procedure TfrmODBBank.cboCollTypeChange(Sender: TObject);
|
|
begin
|
|
if (ALabTest = nil) or Changing or (cboCollType.ItemID = '') then exit;
|
|
if (cboCollType.ItemID = 'I') and (not ALabTest.LabCanCollect) then
|
|
begin
|
|
InfoBox(TX_NO_IMMED, TX_NO_IMMED_CAP, MB_OK or MB_ICONWARNING);
|
|
cboCollType.ItemIndex := -1;
|
|
Exit;
|
|
end;
|
|
SetupCollTimes(cboCollType.ItemID);
|
|
end;
|
|
|
|
procedure TfrmODBBank.LoadModifiers(AComboBox:TORComboBox);
|
|
var
|
|
i: integer;
|
|
begin
|
|
with AComboBox do
|
|
begin
|
|
Clear;
|
|
for i := 0 to uModifierList.Count - 1 do
|
|
Items.Add(uModifierList[i]);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmODBBank.LoadUrgencies(AComboBox:TORComboBox);
|
|
var
|
|
i: integer;
|
|
begin
|
|
with AComboBox do
|
|
begin
|
|
Clear;
|
|
for i := 0 to uUrgencyList.Count - 1 do
|
|
if (piece(uUrgencyList[i],'^',2) = 'STAT') and (StatAllowed(Patient.DFN) = false) then
|
|
Continue
|
|
else
|
|
Items.Add(uUrgencyList[i]);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmODBBank.btnAddTestsClick(Sender: TObject);
|
|
var
|
|
aList, aTests, aRaw: TStringList;
|
|
ListItem: TListItem;
|
|
aStr, aMsg: String; //add independent structures for components, Tests, and associated fields.
|
|
aCollType, aModifier, aPreparation, aSurgery, aCollTime, aTestYes, aSpecimen, aCollSave: String;
|
|
CurAdd, i, j, k, getTest, TestAdded, aMSBOS, aMSBOSContinue: Integer;
|
|
x, name, aTypeScreen: String;
|
|
begin
|
|
if not ValidAdd then Exit;
|
|
aList := TStringList.Create;
|
|
aTests := TStringList.Create;
|
|
aRaw := TStringList.Create;
|
|
try
|
|
aCollType := '';
|
|
aModifier := '';
|
|
aPreparation := '';
|
|
aSurgery := '';
|
|
aCollTime := '';
|
|
aTestYes := '0';
|
|
aTypeScreen := '';
|
|
uGetTnS := 0;
|
|
aSpecimen := '';
|
|
ExtractTypeScreen(aList, uVBECList);
|
|
if aList.Count > 0 then aTypeScreen := aList[0];
|
|
aList.Clear;
|
|
ExtractSpecimen(aList, uVBECList);
|
|
if aList.Count > 0 then aSpecimen := aList[0];
|
|
if LRORDERMODE = TORDER_MODE_DIAG then aTestYes := '1';
|
|
if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex];
|
|
//if length(cboPreparation.ItemID) > 0 then aPreparation := cboPreparation.Items[cboPreparation.ItemIndex];
|
|
if length(cboSurgery.ItemID) > 0 then aSurgery := cboSurgery.Items[cboSurgery.ItemIndex];
|
|
if length(cboCollTime.ItemID) > 0 then aCollTime := cboCollTime.Items[cboCollTime.ItemIndex];
|
|
if (LRORDERMODE = TORDER_MODE_DIAG) and (length(cboAvailTest.ItemID) > 0) then
|
|
begin
|
|
uTestSelected := true;
|
|
with lvSelectionList do
|
|
begin
|
|
ListItem := Items.Add;
|
|
ListItem.Caption := piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',2);
|
|
ListItem.SubItems.Add('');
|
|
if length(cboModifiers.ItemID) > 0 then ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex])
|
|
else ListItem.SubItems.Add('');
|
|
ListItem.SubItems.Add(piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1));
|
|
if piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1) = aTypeScreen then
|
|
begin
|
|
lblTNS.Caption := '';
|
|
lblTNS.Visible := false;
|
|
end;
|
|
end;
|
|
lblCollTime.Enabled := false;
|
|
calCollTime.Enabled := false;
|
|
cboCollTime.Enabled := false;
|
|
lblCollType.Enabled := false;
|
|
cboCollType.Enabled := false;
|
|
cboAvailTest.ItemIndex := -1;
|
|
end;
|
|
if (LRORDERMODE = TORDER_MODE_COMP) and (length(cboAvailComp.ItemID) > 0) then
|
|
begin
|
|
if Length(cboSurgery.ItemID) > 0 then
|
|
begin
|
|
aList.Clear;
|
|
ExtractMSBOS(aList, uVBECList); //Get maximum units for selected Surgey
|
|
for i := 0 to aList.Count - 1 do
|
|
begin
|
|
if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
|
|
and (StrToInt(piece(aList[i],'^',2)) = cboSurgery.ItemID) then
|
|
begin
|
|
aMSBOS := StrToInt(piece(aList[i],'^',4));
|
|
if (aMSBOS > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then
|
|
begin
|
|
with Application do
|
|
begin
|
|
NormalizeTopMosts;
|
|
aMSBOSContinue :=
|
|
MessageBox(PChar('The number of units ordered (' + tQuantity.Text +
|
|
') exceeds the maximum number of units (' + IntToStr(aMSBOS) +
|
|
') for the ' + cboSurgery.text +
|
|
' surgical procedure selected.' + CRLF + CRLF + 'Do you wish to continue?'),
|
|
PChar('Maximum Number of Units Exceeded'),
|
|
MB_YESNO);
|
|
RestoreTopMosts;
|
|
end;
|
|
if aMSBOSContinue = 7 then
|
|
begin
|
|
ShowMessage(cboAvailComp.Text + ' has NOT been added to this request.');
|
|
exit;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
if SpecimenNeeded(aList, uVBECList, aLabTest.ItemID) then //check to see if type and screen is needed
|
|
begin
|
|
uGetTnS := 1;
|
|
for i := 0 to lvSelectionList.Items.Count - 1 do
|
|
begin
|
|
if lvSelectionList.Items[i].SubItems[2] = aTypeScreen then
|
|
begin
|
|
uGetTnS := 0;
|
|
uDfltUrgency := cboUrgency.ItemID;
|
|
lblTNS.Caption := '';
|
|
lblTNS.Visible := false;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
aList.Clear;
|
|
ExtractSpecimens(aList, uVBECList); //Get specimen values to pass back to Server
|
|
for i := 0 to aList.Count - 1 do
|
|
begin
|
|
if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) then
|
|
begin
|
|
aSpecimen := piece(aList[i],'^',2) + '^' + aSpecimen;
|
|
break;
|
|
end;
|
|
end;
|
|
uComponentSelected := true;
|
|
with lvSelectionList do
|
|
begin
|
|
ListItem := Items.Add;
|
|
ListItem.Caption := piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2);
|
|
ListItem.SubItems.Add(tQuantity.Text);
|
|
if length(cboModifiers.ItemID) > 0 then ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex])
|
|
else ListItem.SubItems.Add('');
|
|
ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
|
|
end;
|
|
lblWanted.Enabled := false;
|
|
calWantTime.Enabled := false;
|
|
//lblPreparation.Enabled := false;
|
|
//cboPreparation.Enabled := false;
|
|
lblSurgery.Enabled := false;
|
|
cboSurgery.Enabled := false;
|
|
lblReason.Enabled := false;
|
|
tReason.Enabled := false;
|
|
chkConsent.Enabled := false;
|
|
cboAvailComp.ItemIndex := -1;
|
|
end;
|
|
if Sender <> Self then
|
|
Responses.Clear; // Sender=Self when called from SELF
|
|
CurAdd := 1;
|
|
aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen; //aSpecimen has 2 pieces
|
|
uSelectedItems.Add(aStr);
|
|
for i := 0 to uSelectedItems.Count - 1 do
|
|
begin
|
|
name := lvSelectionList.Items[i].Caption;
|
|
x := uSelectedItems[i];
|
|
if piece(x,'^',1) = '1' then //Diagnostic Test related fields
|
|
begin
|
|
if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), name);
|
|
end
|
|
else
|
|
begin
|
|
if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), name);
|
|
if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3));
|
|
if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), aModifier);
|
|
if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5));
|
|
if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
|
|
end;
|
|
Inc(CurAdd);
|
|
aList.Clear;
|
|
TestAdded := 0;
|
|
getTest := 0;
|
|
ExtractTests(aList, uVBECList); //Get Results associated with ordered components
|
|
for j := 0 to aList.Count - 1 do
|
|
begin
|
|
if StrToInt(piece(aList[j],'^',1)) = aLabTest.ItemID then
|
|
begin
|
|
if uTestsForResults.Count < 1 then getTest := 1;
|
|
for k := 0 to uTestsForResults.Count - 1 do
|
|
begin
|
|
if piece(uTestsForResults[k],'^',1) = piece(aList[j],'^',3) then
|
|
begin
|
|
getTest := 0;
|
|
break;
|
|
end
|
|
else getTest := 1;
|
|
end;
|
|
if getTest = 1 then
|
|
begin
|
|
uTestsForResults.Add(piece(aList[j],'^',3));
|
|
TestAdded := 1;
|
|
end;
|
|
end;
|
|
end;
|
|
if TestAdded = 1 then
|
|
begin
|
|
edtResults.Clear;
|
|
aTests.Clear;
|
|
GetPatientBloodResults(aTests, Patient.DFN, uTestsForResults);
|
|
QuickCopy(ATests,edtResults);
|
|
if edtResults.Lines.Count > 0 then TabResults.ImageIndex := 1;
|
|
uRaw.Clear;
|
|
GetPatientBloodResultsRaw(uRaw, Patient.DFN, uTestsForResults);
|
|
end;
|
|
end;
|
|
if LRORDERMODE = TORDER_MODE_DIAG then
|
|
begin
|
|
if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
|
|
with cboCollType do if Length(ItemID) > 0 then
|
|
begin
|
|
Responses.Update('COLLECT', 1, ItemID, ItemID) ;
|
|
FLastCollType := ItemID;
|
|
end;
|
|
if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
|
|
if Length(txtDiagComment.Text) > 0 then Responses.Update('COMMENT',1,txtDiagComment.Text,txtDiagComment.Text);
|
|
if cboCollType.ItemID = 'LC' then
|
|
begin
|
|
with cboCollTime do
|
|
if Length(ItemID) > 0 then
|
|
begin
|
|
Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
|
|
FLastLabCollTime := ItemID + U + Text;
|
|
end
|
|
else if Length(Text) > 0 then
|
|
begin
|
|
Responses.Update('START', 1, ValidCollTime(Text), Text) ;
|
|
FLastLabCollTime := ValidCollTime(Text);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
with calCollTime do
|
|
if FMDateTime > 0 then
|
|
begin
|
|
Responses.Update('START', 1, ValidCollTime(Text), Text);
|
|
FLastColltime := ValidCollTime(Text);
|
|
end
|
|
else
|
|
begin
|
|
Responses.Update('START', 1, '', '') ;
|
|
FLastCollTime := '';
|
|
end;
|
|
end;
|
|
end;
|
|
if LRORDERMODE = TORDER_MODE_COMP then
|
|
begin
|
|
if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
|
|
if Length(txtDiagComment.Text) > 0 then Responses.Update('COMMENT',1,txtDiagComment.Text,txtDiagComment.Text);
|
|
if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
|
|
//if Length(cboPreparation.Text) > 0 then Responses.Update('XFUSION',1,cboPreparation.ItemID,cboPreparation.Text);
|
|
if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
|
|
if Length(tReason.Text) > 0 then Responses.Update('REASON',1,tReason.Text,tReason.Text);
|
|
if chkConsent.Checked = true then Responses.Update('YN',1,'1','Yes');
|
|
end;
|
|
memOrder.Text := Responses.OrderText;
|
|
CurAdd := 1;
|
|
if uRaw.Count > 0 then
|
|
for j := 0 to uRaw.Count - 1 do
|
|
begin
|
|
if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));
|
|
Inc(CurAdd);
|
|
end;
|
|
tQuantity.Text := '0';
|
|
ALabTest := nil;
|
|
finally
|
|
aList.Free;
|
|
aTests.Free;
|
|
aRaw.Free;
|
|
end;
|
|
aMsg := '';
|
|
if UgetTnS = 1 then
|
|
begin
|
|
lblTNS.Caption := 'TYPE + SCREEN must be added to order';
|
|
lblTNS.Visible := true;
|
|
cboAvailTest.SelectByID(aTypeScreen);
|
|
cboAvailTestSelect(self);
|
|
end;
|
|
{if getTnS = 1 then
|
|
begin
|
|
for i := 1 to cboAvailTest.Items.Count - 1 do
|
|
begin
|
|
if piece(cboAvailTest.Items[i],'^',1) = aTypeScreen then
|
|
begin
|
|
if piece(aSpecimen,'^',1) = '1' then
|
|
begin
|
|
cboCollTime.Text := calWantTime.Text;
|
|
aCollSave := cboCollTime.Text + '^' + cboCollTime.ItemID + '^' + cboCollType.Text + '^' + cboCollType.ItemID;
|
|
cboCollTime.Text := '';
|
|
cboCollType.Text := '';
|
|
uSpecimen := 1;
|
|
end;
|
|
cboModifiers.Text := '';
|
|
cboAvailTest.SelectByID(aTypeScreen);
|
|
cboAvailTestSelect(Self);
|
|
btnAddTestsClick(Self);
|
|
uSpecimen := 0;
|
|
cboCollTime.Text := piece(aCollSave,'^',1);
|
|
cboCollType.Text := piece(aCollSave,'^',3);
|
|
aCollSave := '';
|
|
break;
|
|
end;
|
|
end;
|
|
aMsg := 'An order for Type and Screen has been added to this request' + '.';
|
|
end;
|
|
if (getTns = 1) then
|
|
begin
|
|
if length(aMsg) > 0 then aMsg := aMsg + crlf + crlf;
|
|
ShowMessage(aMsg);
|
|
end;}
|
|
cboModifiers.Text := '';
|
|
edtResults.Height := 247;
|
|
edtInfo.Height := 247;
|
|
end;
|
|
|
|
procedure TfrmODBBank.FormDestroy(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
uSelectedItems.Free;
|
|
uVBECList.Free;
|
|
uTestsForResults.Free;
|
|
uUrgencyList.Free;
|
|
uModifierList.Free;
|
|
uRaw.Free;
|
|
end;
|
|
|
|
procedure TfrmODBBank.btnRemoveClick(Sender: TObject);
|
|
var
|
|
i,j,curAdd: integer;
|
|
x, name, aModifier, aTypeScreen: string;
|
|
aList: TStringList;
|
|
begin
|
|
inherited;
|
|
aList := TStringList.Create;
|
|
curAdd := 1;
|
|
aModifier := '';
|
|
aTypeScreen := '';
|
|
ExtractTypeScreen(aList, uVBECList);
|
|
if aList.Count > 0 then aTypeScreen := aList[0];
|
|
aList.Clear;
|
|
if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex];
|
|
with lvSelectionList do
|
|
begin
|
|
for i := lvSelectionList.Items.Count - 1 downto 0 do
|
|
begin
|
|
if lvSelectionList.Items[i].Selected = true then
|
|
for j := uSelectedItems.Count - 1 downto 0 do
|
|
if lvSelectionList.Items[i].SubItems[2] = piece(uSelectedItems[j],'^',2) then
|
|
begin
|
|
if lvSelectionList.Items[i].SubItems[2] = aTypeScreen then
|
|
begin
|
|
uGetTnS := 1;
|
|
lblTNS.Caption := 'TYPE+SCREEN must be added to order';
|
|
lblTNS.Visible := true;
|
|
end;
|
|
uSelectedItems.Delete(j);
|
|
lvSelectionList.Items[i].Delete;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
Responses.Clear;
|
|
for i := 0 to uSelectedItems.Count - 1 do
|
|
begin
|
|
name := lvSelectionList.Items[i].Caption;
|
|
x := uSelectedItems[i];
|
|
if piece(x,'^',1) = '1' then //Diagnostic Test related fields
|
|
begin
|
|
if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), name);
|
|
end
|
|
else
|
|
begin
|
|
if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), name);
|
|
if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3));
|
|
if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), aModifier);
|
|
if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5));
|
|
end;
|
|
Inc(CurAdd);
|
|
end;
|
|
if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
|
|
if cboCollType.ItemID = 'LC' then
|
|
begin
|
|
with cboCollTime do
|
|
if Length(ItemID) > 0 then
|
|
begin
|
|
Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
|
|
FLastLabCollTime := ItemID + U + Text;
|
|
end
|
|
else if Length(Text) > 0 then
|
|
begin
|
|
Responses.Update('START', 1, ValidCollTime(Text), Text) ;
|
|
FLastLabCollTime := ValidCollTime(Text);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
with calCollTime do
|
|
if FMDateTime > 0 then
|
|
begin
|
|
Responses.Update('START', 1, ValidCollTime(Text), Text);
|
|
FLastColltime := ValidCollTime(Text);
|
|
end
|
|
else
|
|
begin
|
|
Responses.Update('START', 1, '', '') ;
|
|
FLastCollTime := '';
|
|
end;
|
|
end;
|
|
with cboCollType do if Length(ItemID) > 0 then
|
|
begin
|
|
Responses.Update('COLLECT', 1, ItemID, ItemID) ;
|
|
FLastCollType := ItemID;
|
|
end;
|
|
if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
|
|
if Length(txtDiagComment.Text) > 0 then Responses.Update('COMMENT',1,txtDiagComment.Text,txtDiagComment.Text);
|
|
//if Length(cboPreparation.Text) > 0 then Responses.Update('XFUSION',1,cboPreparation.ItemID,cboPreparation.Text);
|
|
if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
|
|
if Length(tReason.Text) > 0 then Responses.Update('REASON',1,tReason.Text,tReason.Text);
|
|
if chkConsent.Checked = true then Responses.Update('YN',1,'1','Yes');
|
|
memOrder.Text := Responses.OrderText;
|
|
CurAdd := 1;
|
|
if uRaw.Count > 0 then
|
|
for j := 0 to uRaw.Count - 1 do
|
|
begin
|
|
if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));
|
|
Inc(CurAdd);
|
|
end;
|
|
if uSelectedItems.Count < 1 then
|
|
begin
|
|
uGetTnS := 0;
|
|
lblTNS.Caption := '';
|
|
lblTNS.Visible := false;
|
|
end;
|
|
aList.Free;
|
|
end;
|
|
|
|
procedure TfrmODBBank.btnRemoveAllClick(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
lvSelectionList.Clear;
|
|
uSelectedItems.Clear;
|
|
uTestsForResults.Clear;
|
|
uRaw.Clear;
|
|
uGetTnS := 0;
|
|
lblTNS.Caption := '';
|
|
lblTNS.Visible := false;
|
|
InitDialog;
|
|
end;
|
|
|
|
procedure TfrmODBBank.cmdAcceptClick(Sender: TObject);
|
|
var
|
|
i: integer;
|
|
Comp: boolean;
|
|
const
|
|
Txt1 = 'This order can not be saved for the following reason(s):';
|
|
Txt2 = #13+#13+'An order for TYPE and SCREEN must be created with this order set.';
|
|
begin
|
|
if uGetTnS = 1 then
|
|
begin
|
|
MessageDlg(Txt1+Txt2, mtWarning,[mbOK],0);
|
|
Exit;
|
|
end;
|
|
Comp := false;
|
|
if uSelectedItems.Count > 0 then
|
|
begin
|
|
for i := 0 to uSelectedItems.Count - 1 do
|
|
if not (piece(uSelectedItems[i],'^',1) = '1') then
|
|
begin
|
|
Comp := true;
|
|
Break;
|
|
end;
|
|
end;
|
|
if Comp = true then
|
|
ShowMessage('The nursing blood administration order must be entered separately' + '.');
|
|
inherited;
|
|
end;
|
|
|
|
procedure TfrmODBBank.calWantTimeChange(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
if uSelectedItems.Count > 0 then
|
|
if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
|
|
end;
|
|
|
|
procedure TfrmODBBank.chkConsentClick(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
if uSelectedItems.Count > 0 then
|
|
begin
|
|
if chkConsent.Checked = true then Responses.Update('YN',1,'1','Yes')
|
|
else Responses.Update('YN',1,'0','No');
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmODBBank.cboUrgencyChange(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
if Length(cboUrgency.Text) > 0 then
|
|
begin
|
|
Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
|
|
if cboUrgency.Text = 'PRE-OP' then
|
|
begin
|
|
lblSurgery.Enabled := true;
|
|
cboSurgery.Enabled := true;
|
|
end
|
|
else
|
|
begin
|
|
lblSurgery.Enabled := false;
|
|
cboSurgery.Enabled := false;
|
|
cboSurgery.Text := '';
|
|
if uSelectedItems.Count > 0 then
|
|
Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrmODBBank.txtDiagCommentChange(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
if uSelectedItems.Count > 0 then
|
|
Responses.Update('COMMENT',1,txtDiagComment.Text,txtDiagComment.Text);
|
|
end;
|
|
|
|
procedure TfrmODBBank.cboPreparationChange(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
Exit; // disable Preparation, since it is no longer needed by VBECS
|
|
if uSelectedItems.Count > 0 then
|
|
if Length(cboPreparation.Text) > 0 then
|
|
Responses.Update('XFUSION',1,cboPreparation.ItemID,cboPreparation.Text);
|
|
end;
|
|
|
|
procedure TfrmODBBank.cboSurgeryChange(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
if uSelectedItems.Count > 0 then
|
|
if Length(cboSurgery.Text) > 0 then
|
|
Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
|
|
end;
|
|
|
|
procedure TfrmODBBank.tReasonChange(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
if uSelectedItems.Count > 0 then
|
|
if Length(tReason.Text) > 0 then
|
|
Responses.Update('REASON',1,tReason.Text,tReason.Text);
|
|
end;
|
|
|
|
procedure TfrmODBBank.calCollTimeChange(Sender: TObject);
|
|
begin
|
|
inherited;
|
|
if uSelectedItems.Count > 0 then
|
|
begin
|
|
if cboCollType.ItemID = 'LC' then
|
|
begin
|
|
with cboCollTime do
|
|
if Length(ItemID) > 0 then
|
|
begin
|
|
Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
|
|
FLastLabCollTime := ItemID + U + Text;
|
|
end
|
|
else if Length(Text) > 0 then
|
|
begin
|
|
Responses.Update('START', 1, ValidCollTime(Text), Text) ;
|
|
FLastLabCollTime := ValidCollTime(Text);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
with calCollTime do
|
|
if FMDateTime > 0 then
|
|
begin
|
|
Responses.Update('START', 1, ValidCollTime(Text), Text);
|
|
FLastColltime := ValidCollTime(Text);
|
|
end
|
|
else
|
|
begin
|
|
Responses.Update('START', 1, '', '') ;
|
|
FLastCollTime := '';
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
end.
|