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.