unit fODBBank; interface uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ORCtrls, ORfn, fODBase, ExtCtrls, ComCtrls, uConst, ORDtTm, Buttons, Menus, ImgList, VA508AccessibilityManager, VAUtils; type TfrmODBBank = class(TfrmODBase) dlgLabCollTime: TORDateTimeDlg; ORWanted: TORDateTimeDlg; pnlComments: TPanel; btnUpdateComments: TButton; btnCancelComment: TButton; lblOrdComment: TLabel; pgeProduct: TPageControl; TabInfo: TTabSheet; edtInfo: TCaptionRichEdit; TabDiag: TTabSheet; lblReqComment: TOROffsetLabel; TabResults: TTabSheet; edtResults: TCaptionRichEdit; pnlFields: TPanel; lblDiagComment: TOROffsetLabel; lblUrgency: TLabel; lblReason: TLabel; lblSurgery: TLabel; cboUrgency: TORComboBox; chkConsent: TCheckBox; cboSurgery: TORComboBox; pnlSelect: TPanel; pnlDiagnosticTests: TGroupBox; cboAvailTest: TORComboBox; pnlBloodComponents: TGroupBox; lblQuantity: TLabel; lblModifiers: TLabel; cboAvailComp: TORComboBox; tQuantity: TEdit; cboModifiers: TORComboBox; GroupBox1: TGroupBox; cboQuick: TORComboBox; pnlSelectedTests: TGroupBox; lvSelectionList: TCaptionListView; btnRemove: TButton; btnRemoveAll: TButton; cboReasons: TORComboBox; lblRequiredField: TLabel; memDiagComment: TRichEdit; lblCollType: TLabel; cboCollType: TORComboBox; lblCollTime: TLabel; cboCollTime: TORComboBox; calWantTime: TORDateBox; lblWanted: TLabel; calCollTime: TORDateBox; txtImmedColl: TCaptionEdit; pnlCollTimeButton: TKeyClickPanel; cmdImmedColl: TSpeedButton; 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 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 cboSurgeryChange(Sender: TObject); procedure calCollTimeChange(Sender: TObject); procedure cboQuickClick(Sender: TObject); procedure tQuantityEnter(Sender: TObject); procedure btnUpdateCommentsClick(Sender: TObject); procedure btnCancelCommentClick(Sender: TObject); procedure cboSurgeryClick(Sender: TObject); procedure cboReasonsEnter(Sender: TObject); procedure cboReasonsExit(Sender: TObject); procedure tQuantityClick(Sender: TObject); procedure tQuantityChange(Sender: TObject); procedure cboReasonsChange(Sender: TObject); procedure cboModifiersChange(Sender: TObject); procedure lvSelectionListClick(Sender: TObject); procedure cboAvailCompChange(Sender: TObject); procedure cboCollTimeChange(Sender: TObject); procedure memDiagCommentChange(Sender: TObject); procedure cboUrgencyExit(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 ExtractTNSOrders(OutList:TStrings; AList:TStrings); procedure ExtractModifiers(OutList:TStrings; AList:TStrings); procedure ExtractReasons(OutList:TStrings; AList:TStrings); procedure ExtractSpecimens(OutList:TStrings; AList:TStrings); procedure ExtractTypeScreen(OutList:TStrings; AList:TStrings); procedure ExtractOther(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); procedure LoadReasons(AComboBox:TORComboBox); private FLastCollType: string; FLastCollTime: string; FLastLabCollTime: string; FLastLabID: string; FLastItemID: string; FEvtDelayLoc: integer; FEvtDivision: integer; FVbecLookup: string; FQuickList: Integer; FQuickItems: TStringList; FOrderAction: Integer; procedure ReadServerVariables; procedure SetOnQuickOrder; 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 } Urgency: Integer; { IEN of urgency } 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} UrgencyList: TStringList; { Strings: IEN^Urgency Name } ForceUrgency: Boolean; { true if not prompt Urgency } 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); procedure LoadUrgency(CollType: string; AComboBox:TORComboBox); function NameOfCollSamp: string; function NameOfSpecimen: string; function NameOfUrgency: string; function ObtainCollSamp: Boolean; function ObtainSpecimen: Boolean; function ObtainUrgency: 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)^Modifier(4)^Specimen(5,6)^CollTime(7)^CollType(8) uVBECList: TStringList; //List of items from VBEC api uTestsForResults: TStringList; //List of tests to show results uUrgencyList: TStringList; //List of Urgencies uTNSOrders: TStringList; //List of Current orders for Type & Screen uModifierList: TStringList; //List of Modifiers uReasonsList: TStringList; //List of Reasons for Request uRaw: TStringList; //Results Array uTestSelected, uComponentSelected: Boolean; //Used on Validate uDfltUrgency: Integer; //Default Urgency uSelUrgency: String; //Previously Selected Urgency - Used when components have been added for specific urgency uSelSurgery: Integer; //Selected Surgery for Blood order uSpecimen, uGetTnS: Integer; //Set to 1 if a specimen for test is already in lab... no need to collect uDfltCollType, uReason: 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_COMPONENT = 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; ListCount: Integer; x: string; begin AutoSizeDisabled := True; inherited; AList := TStringList.Create; ATests := TStringList.Create; uSelectedItems := TStringList.Create; uVBECList := TStringList.Create; uTestsForResults := TStringList.Create; uUrgencyList := TStringList.Create; uTNSOrders := TStringList.Create; uModifierList := TStringList.Create; uReasonsList := TStringList.Create; uRaw := TStringList.Create; uSpecimen := 0; uGetTnS := 0; uReason := ''; lblTNS.Caption := ''; lblTNS.Visible := false; pnlMessage.Visible := false; uDfltUrgency := 9; uSelUrgency := ''; uSelSurgery := 0; TabResults.Caption := 'Lab Results'; edtResults.Lines.Clear; edtResults.Lines.Add('Lab results are ONLY available after selecting/adding a component on the Blood Bank Orders tab that has been designated for results retrieval.'); Responses.Clear; try LRFZX := ''; LRFSAMP := ''; LRFSPEC := ''; LRFDATE := ''; LRFURG := ''; LRFSCH := ''; LRORDERMODE := TORDER_MODE_INFO; FLastColltime := ''; FLastLabCollTime := ''; FLastItemID := ''; uDfltCollType := ''; FillerID := 'LR'; FEvtDelayLoc := 0; FEvtDivision := 0; UserHasLRLABKey := User.HasKey('LRLAB'); AllowQuickOrder := True; StatusText('Loading Dialog Definition'); 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 FastAssign(ODForLab(EvtDelayLoc,EvtDivision), AList) else FastAssign(ODForLab(Encounter.Location,EvtDivision), AList); end else FastAssign(ODForLab(Encounter.Location), AList); // ODForLab returns TStrings with defaults CtrlInits.LoadDefaults(AList); InitDialog; GroupBox1.Visible := True; 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(''); //Populates cboAvailTest control based on S.VBT xref 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); ExtractTNSOrders(uTNSOrders, uVBECList); LoadUrgencies(cboUrgency); ExtractModifiers(uModifierList, uVBECList); ExtractReasons(uReasonsList, uVBECList); LoadModifiers(cboModifiers); LoadReasons(cboReasons); calWantTime.Text := 'NOW'; //FormatFMDateTime('mmm dd,yyyy@hh:nn',DateTimeToFMDateTime(Now)); pgeProduct.TabIndex := TI_INFO; lvSelectionList.Column[0].Width := 240; lvSelectionList.Column[1].Width := 30; lvSelectionList.Column[2].Width := 100; DisableComponentControls; DisableDiagTestControls; pgeProduct.ActivePageIndex := TI_INFO; StatusText(''); x := 'VBEC'; FQuickItems := TStringList.Create; ListForQuickOrders(FQuickList, ListCount, x); if ListCount > 0 then begin SubsetOfQuickOrders(FQuickItems, FQuickList, 0, 0); end else begin ListCount := 1; FQuickItems.Add('0^(No quick orders available)'); end; FastAssign(FQuickItems, cboQuick.Items); if lvSelectionList.Items.Count > 0 then begin memOrder.Visible := true; cmdAccept.Visible := true; end; 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 AnInstance, CurAdd: Integer; AResponse: TResponse; i, j, k, aTNS, aTNSDays, getTest, TestAdded: integer; aStr, aTestYes, aName, aTypeScreen, aSpecimen, aModifier, sub, sub1, x, aTNSString: string; ListItem: TListItem; aList: TStringList; aTests: TStringList; begin inherited; aList := TStringList.Create; aTests:= TStringList.Create; try FOrderAction := OrderAction; ReadServerVariables; sub1 := ''; aTypeScreen := ''; aSpecimen := '^'; aModifier := ''; if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses, ALabTest do begin AnInstance := NextInstance('ORDERABLE', 0); while AnInstance > 0 do begin AResponse := FindResponseByName('ORDERABLE', AnInstance); if AResponse <> nil then begin sub := GetSubtype(AResponse.EValue); if sub = 't' then begin SetControl(cboAvailTest, 'ORDERABLE', AnInstance); ALabTest := TLabTest.Create(cboAvailTest.ItemID, Responses); end else begin SetControl(cboAvailComp, 'ORDERABLE', AnInstance); ALabTest := TLabTest.Create(cboAvailComp.ItemID, Responses); end; if ALabTest = nil then Exit; // Causes access violation if AnInstance = 1 then begin SetControl(cboReasons, 'REASON' , AnInstance); SetControl(calWantTime, 'DATETIME', AnInstance); SetControl(memDiagComment, 'COMMENT', AnInstance); SetControl(chkConsent, 'YN', AnInstance); //DetermineCollectionDefaults(Responses); SetControl(cboCollType, 'COLLECT', AnInstance); SetControl(cboCollTime, 'START', AnInstance); SetupCollTimes(cboCollType.ItemID); SetControl(cboUrgency, 'URGENCY', AnInstance); SetControl(cboSurgery, 'MISC', AnInstance); Urgency := cboUrgency.ItemIEN; if (Urgency = 0) and (cboUrgency.Items.Count = 1) then begin cboUrgency.ItemIndex := 0; Urgency := cboUrgency.ItemIEN; end; i := 1 ; AResponse := Responses.FindResponseByName('COMMENT',i); while AResponse <> nil do begin Comment.Add(AResponse.EValue); Inc(i); AResponse := Responses.FindResponseByName('COMMENT',i); end ; end; if sub = 't' then with ALabTest do //DIAGNOSTIC TEST begin Changing := True; DisableComponentControls; EnableDiagTestControls; LRORDERMODE := TORDER_MODE_DIAG; aList.Clear; aTestYes := '1'; ExtractTypeScreen(aList, uVBECList); if aList.Count > 0 then aTypeScreen := aList[0]; aList.Clear; with lvSelectionList do begin ListItem := Items.Add; ListItem.Caption := piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',2); ListItem.SubItems.Add(''); ListItem.SubItems.Add(''); 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; memMessage.Text := ''; pnlMessage.Visible := false; uGetTnS := 0; pnlDiagnosticTests.Caption := 'Diagnostic Tests'; end; end; aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + IntToStr(aLabTest.ItemID); //aSpecimen has 2 pieces additional pieces added for Tests uSelectedItems.Add(aStr); 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(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text); if Length(cboReasons.Text) > 0 then Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text); LoadCollType(cboCollType); if (cboCollType.ItemID = 'LC') or (cboCollType.ItemID = 'I') then if not(ALabTest.LabCanCollect) and OrderForInpatient then cboCollType.SelectByID('WC') else if not(ALabTest.LabCanCollect) then cboCollType.SelectByID('SP'); SetupCollTimes(cboCollType.ItemID); 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(cboCollType.Text) > 0 then Responses.Update('COLLECT',1,cboCollType.ItemID,cboCollType.ItemID); memOrder.Text := Responses.OrderText; Changing := False; 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; end; if sub = 'c' then with ALabTest do //COMPONENT begin Changing := True; DisableDiagTestControls; EnableComponentControls; aTestYes := '0'; LRORDERMODE := TORDER_MODE_COMP; SetControl(cboModifiers, 'MODIFIER', AnInstance); SetControl(tQuantity, 'QTY', AnInstance); uComponentSelected := true; 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.Caption := 'Lab Results Available'; //TabResults.ImageIndex := 1; uRaw.Clear; GetPatientBloodResultsRaw(uRaw, Patient.DFN, uTestsForResults); end; 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; 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 begin ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]); ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex)); end else begin ListItem.SubItems.Add(''); ListItem.SubItems.Add(''); end; ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1)); end; aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + IntToStr(aLabTest.ItemID); //aSpecimen has 2 pieces additional pieces added for Tests uSelectedItems.Add(aStr); memOrder.Text := Responses.OrderText; Changing := False; end; end; StatusText(''); AnInstance := NextInstance('ORDERABLE', AnInstance); end; //while AnInstance - ORDERABLE DisableComponentControls; DisableDiagTestControls; end; CurAdd := 1; for i := 0 to uSelectedItems.Count - 1 do begin aName := 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), aName); end else begin if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName); 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), piece(x,'^',4)); 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); if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text); if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text) else begin cboUrgency.ItemIndex := 1; Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text); cboUrgencyChange(self); end; end; Inc(CurAdd); end; for i := 0 to lvSelectionList.Items.Count - 1 do begin if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then begin if uTNSOrders.Count > 0 then begin for j := 0 to uTNSOrders.Count - 1 do aTNSString := aTNSString + CRLF + uTNSOrders[j]; with Application do begin NormalizeTopMosts; aTNSDays := TNSDaysBack; aTNS := MessageBox(PChar(aTNSString + CRLF + CRLF + 'Do you wish to continue with this request for Type & Screen?'), PChar('Type & Screen Entered in Past ' + IntToStr(TNSDaysBack) + ' Days'), MB_YESNO); RestoreTopMosts; if aTNS = 7 then begin lvSelectionList.ItemIndex := i; lvSelectionListClick(self); btnRemoveClick(self); break; end; end; end; break; end; end; {if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses, ALabTest do begin if OrderAction in [ORDER_QUICK, ORDER_EDIT] then uQuickInProcess := 1; AnInstance := NextInstance('ORDERABLE', 0); while AnInstance > 0 do begin AResponse := FindResponseByName('ORDERABLE', AnInstance); if AResponse <> nil then begin sub := GetSubtype(AResponse.EValue); if sub = 't' then begin SetControl(cboAvailTest, 'ORDERABLE', AnInstance); ALabTest := TLabTest.Create(cboAvailTest.ItemID, Responses); end else begin SetControl(cboAvailComp, 'ORDERABLE', AnInstance); ALabTest := TLabTest.Create(cboAvailComp.ItemID, Responses); end; //SetControl(cboTests, 'ORDERABLE', AnInstance); //ALabTest := TLabTest.Create(cboTests.ItemID, Responses); if ALabTest = nil then Exit; // Causes access violation //sub := GetSubtype(ALabTest.TestName); if AnInstance = 1 then begin DetermineCollectionDefaults(Responses); SetControl(cboReasons, 'REASON', AnInstance); SetControl(chkConsent, 'YN', AnInstance); SetControl(cboSurgery, 'MISC', AnInstance); //SetControl(cboCollType, 'COLLECT', AnInstance); //SetControl(cboCollTime, 'START', AnInstance); SetControl(calWantTime, 'DATETIME', AnInstance); //LoadUrgency(cboCollType.ItemID, cboUrgency); SetControl(cboUrgency, 'URGENCY', AnInstance); Urgency := cboUrgency.ItemIEN; if (Urgency = 0) and (cboUrgency.Items.Count = AnInstance) then begin cboUrgency.ItemIndex := 0; Urgency := cboUrgency.ItemIEN; end; i := 1 ; AResponse := Responses.FindResponseByName('COMMENT',i); while AResponse <> nil do begin if Length(AResponse.Evalue) > 0 then Comment.Add(AResponse.EValue); Inc(i); AResponse := Responses.FindResponseByName('COMMENT',i); end ; end; if sub = 't' then with ALabTest do //DIAGNOSTIC TEST begin Changing := True; DisableComponentControls; EnableDiagTestControls; LRORDERMODE := TORDER_MODE_DIAG; with Responses do begin StatusText('Initializing Order'); AResponse := FindResponseByName('ORDERABLE', AnInstance); if AResponse <> nil then sub1 := GetSubtype(AResponse.EValue); if sub1 = 't' then begin SetControl(cboAvailTest, 'ORDERABLE', AnInstance); //SetControl(cboTests, 'ORDERABLE', AnInstance); //DetermineCollectionDefaults(Responses); //cboCollType = COLLECT , calCollTime = START cboAvailTestSelect(self); end; end; Changing := False; 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; end; if sub = 'c' then with ALabTest do //COMPONENT begin Changing := True; DisableDiagTestControls; EnableComponentControls; LRORDERMODE := TORDER_MODE_COMP; with Responses do begin StatusText('Initializing Order'); AResponse := FindResponseByName('ORDERABLE', AnInstance); if AResponse <> nil then sub1 := GetSubtype(AResponse.EValue); if sub1 = 'c' then begin SetControl(cboAvailComp, 'ORDERABLE', AnInstance); //SetControl(cboTests, 'ORDERABLE', AnInstance); SetControl(cboModifiers, 'MODIFIER', AnInstance); SetControl(tQuantity, 'QTY', AnInstance); //DetermineCollectionDefaults(Responses); cboAvailCompSelect(self); end; end; Changing := False; end; with ALabTest do begin 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; if Length(x) > 0 then begin OrderMessage(x) ; end; end; StatusText(''); Changing := True; //if not(FOrderAction = ORDER_EDIT) then DetermineCollectionDefaults(Responses); Changing := False; end; AnInstance := NextInstance('ORDERABLE', AnInstance); end; //while AnInstance - ORDERABLE DisableComponentControls; DisableDiagTestControls; uQuickInProcess := 0; end; } finally aList.Free; aTests.Free; end; edtResults.Height := 247; edtInfo.Height := 247; if lvSelectionList.Items.Count > 0 then begin pnlSelectedTests.Visible := True; cmdAccept.Visible := True; memOrder.Visible := True; GroupBox1.Visible := False; end; end; procedure TfrmODBBank.SetOnQuickOrder; var AnInstance: Integer; AResponse: TResponse; i: integer; x,sub,sub1,aTNSString: string; aList: TStringList; aGotIt: boolean; aTests: TStringList; ListItem: TListItem; aName, aMsg, aStr, aModifier, aReason, aSurgery, aCollTime, aTestYes, aSpecimen, aTypeScreen: String; CurAdd, j, k, getTest, TestAdded, aMSBOS, aMSBOSContinue, aTNS, aTNSDays: Integer; begin inherited; aList := TStringList.Create; aTests := TStringList.Create; try aModifier := ''; aReason := ''; aSurgery := ''; aCollTime := ''; aTestYes := '0'; aTypeScreen := ''; aSpecimen := ''; sub1 := ''; ExtractTypeScreen(aList, uVBECList); if aList.Count > 0 then aTypeScreen := aList[0]; aList.Clear; Extractspecimen(aList, uVBECList); if aList.Count > 0 then aSpecimen := aList[0]; with Responses, ALabTest do begin Changing := True; aGotIt := False; FLastItemID := cboQuick.ItemID; QuickOrder := ExtractInteger(cboQuick.ItemID); with Responses do begin StatusText('Initializing Quick Order'); AnInstance := NextInstance('ORDERABLE', 0); while AnInstance > 0 do begin AResponse := FindResponseByName('ORDERABLE', AnInstance); sub := GetSubtype(AResponse.EValue); if sub = 't' then begin SetControl(cboAvailTest, 'ORDERABLE', AnInstance); ALabTest := TLabTest.Create(cboAvailTest.ItemID, Responses); end else begin SetControl(cboAvailComp, 'ORDERABLE', AnInstance); ALabTest := TLabTest.Create(cboAvailComp.ItemID, Responses); end; for i := 0 to aList.Count - 1 do if aList[i] = ALabTest.TestName then begin aGotIt := true; break; end; if aGotIt = true then begin aGotIt := false; AnInstance := NextInstance('ORDERABLE', AnInstance); Continue; end else begin aList.Add(ALabTest.TestName); end; if AResponse <> nil then sub1 := GetSubtype(AResponse.EValue); if AnInstance = 1 then begin SetControl(cboReasons, 'REASON', AnInstance); SetControl(calWantTime, 'DATETIME', AnInstance); SetControl(memDiagComment, 'COMMENT', AnInstance); SetControl(chkConsent, 'YN', AnInstance); //DetermineCollectionDefaults(Responses); SetControl(cboCollType, 'COLLECT', AnInstance); SetupCollTimes(cboCollType.ItemID); //SetControl(cboCollTime, 'START', AnInstance); //LoadUrgency(cboCollType.ItemID, cboUrgency); SetControl(cboUrgency, 'URGENCY', AnInstance); Urgency := cboUrgency.ItemIEN; if (Urgency = 0) and (cboUrgency.Items.Count = AnInstance) then begin cboUrgency.ItemIndex := 0; Urgency := cboUrgency.ItemIEN; cboUrgencyChange(self); end; SetControl(cboSurgery, 'MISC', AnInstance); if not(ALabTest = nil) then begin Urgency := cboUrgency.ItemIEN; if (Urgency = 0) and (cboUrgency.Items.Count = 1) then begin cboUrgency.ItemIndex := 0; Urgency := cboUrgency.ItemIEN; end; i := 1 ; AResponse := Responses.FindResponseByName('COMMENT',i); while AResponse <> nil do begin Comment.Add(AResponse.EValue); Inc(i); AResponse := Responses.FindResponseByName('COMMENT',i); end ; end; if not(cboCollType.ItemID = 'LC') then begin if Length(cboCollTime.Text) > 0 then begin calCollTime.FMDateTime := StrToFMDateTime(cboCollTime.Text); FLastCollTime := cboCollTime.Text; end else begin FLastCollTime := ''; end; end; end; if sub1 = 'c' then begin DisableDiagTestControls; EnableComponentControls; LRORDERMODE := TORDER_MODE_COMP; SetControl(cboAvailComp, 'ORDERABLE', AnInstance); SetControl(cboModifiers, 'MODIFIER', AnInstance); SetControl(tQuantity, 'QTY', AnInstance); //DetermineCollectionDefaults(Responses); //Check for and display any associated Lab Results 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.Caption := 'Lab Results Available'; //TabResults.ImageIndex := 1; uRaw.Clear; GetPatientBloodResultsRaw(uRaw, Patient.DFN, uTestsForResults); end; 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; aSpecimen := '^'; aTestYes := '0'; aReason := ''; aSurgery := ''; aCollTime := ''; ExtractSpecimen(aList, uVBECList); if aList.Count > 0 then aSpecimen := aList[0]; if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex]; if length(cboReasons.ItemID) > 0 then aReason := cboReasons.Items[cboReasons.ItemIndex]; if length(cboSurgery.ItemID) > 0 then aSurgery := cboSurgery.Items[cboSurgery.ItemIndex]; if length(cboCollTime.ItemID) > 0 then aCollTime := cboCollTime.Items[cboCollTime.ItemIndex]; 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 (piece(aList[i],'^',3) = cboSurgery.Text) 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 + ') for ' + aLabTest.TestName + ' 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 ShowMsg(cboAvailComp.Text + ' has NOT been added to this request.'); exit; end; end; end; end; end; if (uTNSOrders.Count < 1) then //SpecimenNeeded(aList, uVBECList, aLabTest.ItemID) then //check to see if type and screen is needed begin uGetTnS := 1; 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 begin ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]); ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex)); end else begin ListItem.SubItems.Add(''); ListItem.SubItems.Add(''); end; ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1)); end; CurAdd := 1; aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + IntToStr(aLabTest.ItemID); //aSpecimen has 2 pieces additional pieces added for Tests uSelectedItems.Add(aStr); for i := 0 to uSelectedItems.Count - 1 do begin aName := 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), aName); end else begin if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName); 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); end; memOrder.Text := Responses.OrderText; GroupBox1.Visible := False; aMsg := ''; LRORDERMODE := TORDER_MODE_INFO; {if uGetTnS = 1 then begin lblTNS.Caption := 'TYPE + SCREEN must be added to order'; lblTNS.Visible := true; memMessage.Text := 'TYPE + SCREEN must be added to order'; memMessage.Visible := false; pnlMessage.Visible := true; pnlDiagnosticTests.Caption := 'Diagnostic Tests*'; end; } {if uGetTnS = 1 then begin if responses.QuickOrder < 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); cboTests.SelectByID(aTypeScreen); cboTestsClick(self); //cboAvailTestSelect(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 else begin lblTNS.Caption := 'TYPE + SCREEN must be added to order'; lblTNS.Visible := true; memMessage.Text := 'TYPE + SCREEN must be added to order'; memMessage.Visible := false; pnlMessage.Visible := true; end; end; if (uGetTnS = 1) then begin if length(aMsg) > 0 then aMsg := aMsg + crlf + crlf; ShowMsg(aMsg); end; } //cboModifiers.Text := ''; edtResults.Height := 247; edtInfo.Height := 247; if lvSelectionList.Items.Count > 0 then begin pnlSelectedTests.Visible := True; cmdAccept.Visible := True; memOrder.Visible := True; GroupBox1.Visible := False; end; end else begin if sub1 = 't' then begin DisableComponentControls; EnableDiagTestControls; LRORDERMODE := TORDER_MODE_DIAG; aTestYes := '1'; SetControl(cboAvailTest, 'ORDERABLE', AnInstance); //DetermineCollectionDefaults(Responses); //cboCollType = COLLECT , calCollTime = START i := 1 ; AResponse := Responses.FindResponseByName('COMMENT',i); while AResponse <> nil do begin Comment.Add(AResponse.EValue); Inc(i); AResponse := Responses.FindResponseByName('COMMENT',i); end ; 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 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) else begin cboUrgency.ItemIndex := 1; Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text); cboUrgencyChange(self); end; if Length(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text); if Length(cboReasons.Text) > 0 then Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text); LoadCollType(cboCollType); if (cboCollType.ItemID = 'LC') or (cboCollType.ItemID = 'I') then if not(ALabTest.LabCanCollect) and OrderForInpatient then cboCollType.SelectByID('WC') else if not(ALabTest.LabCanCollect) then cboCollType.SelectByID('SP'); SetupCollTimes(cboCollType.ItemID); 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; if length(cboCollTime.ItemID) > 0 then aCollTime := cboCollTime.Items[cboCollTime.ItemIndex]; with cboCollType do if Length(ItemID) > 0 then begin Responses.Update('COLLECT', 1, ItemID, ItemID) ; FLastCollType := ItemID; end; uTestSelected := true; with lvSelectionList do begin ListItem := Items.Add; ListItem.Caption := piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',2); ListItem.SubItems.Add(''); ListItem.SubItems.Add(''); ListItem.SubItems.Add(''); ListItem.SubItems.Add(piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1)); end; CurAdd := 1; aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + aCollTime + '^' + cboCollType.Text + '^' + IntToStr(aLabTest.ItemID); //aSpecimen has 2 pieces uSelectedItems.Add(aStr); for i := 0 to uSelectedItems.Count - 1 do begin aName := 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), aName); end; Inc(CurAdd); end; memOrder.Text := Responses.OrderText; edtResults.Height := 247; edtInfo.Height := 247; if lvSelectionList.Items.Count > 0 then begin pnlSelectedTests.Visible := True; cmdAccept.Visible := True; memOrder.Visible := True; GroupBox1.Visible := False; end; end; end; AnInstance := NextInstance('ORDERABLE', AnInstance); end; //Quick Order end; for i := 0 to lvSelectionList.Items.Count - 1 do begin if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then begin uGetTnS := 0; uDfltUrgency := cboUrgency.ItemID; lblTNS.Caption := ''; lblTNS.Visible := false; memMessage.Text := ''; pnlMessage.Visible := false; pnlDiagnosticTests.Caption := 'Diagnostic Tests'; if uTNSOrders.Count > 0 then begin for j := 0 to uTNSOrders.Count - 1 do aTNSString := aTNSString + CRLF + uTNSOrders[j]; with Application do begin NormalizeTopMosts; aTNSDays := TNSDaysBack; aTNS := MessageBox(PChar(aTNSString + CRLF + CRLF + 'Do you wish to continue with this request for Type & Screen?'), PChar('Type & Screen Entered in Past ' + IntToStr(TNSDaysBack) + ' Days'), MB_YESNO); RestoreTopMosts; if aTNS = 7 then begin lvSelectionList.ItemIndex := i; lvSelectionListClick(self); btnRemoveClick(self); break; end; end; end; break; end; end; if uGetTnS = 1 then begin lblTNS.Caption := 'TYPE + SCREEN must be added to order'; lblTNS.Visible := true; memMessage.Text := 'TYPE + SCREEN must be added to order'; pnlMessage.Visible := true; pnlDiagnosticTests.Caption := 'Diagnostic Tests*'; end; if ALabTest <> nil then begin 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; with ALabTest do begin 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; GroupBox1.Visible := False; end; StatusText(''); Changing := False; end; finally //**SubTest alist.Free; aTests.Free; 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'); UniqueCollSamp := false; 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))); UrgencyList := TStringList.Create; if Length(ExtractDefault(LoadData, 'Default Urgency')) > 0 then { forced urgency } begin ForceUrgency := True; UrgencyList.Add(ExtractDefault(LoadData, 'Default Urgency')); Urgency := StrToInt(Piece(ExtractDefault(LoadData, 'Default Urgency'), '^', 1)); uDfltUrgency := Urgency; end else begin { list of urgencies } ExtractItems(UrgencyList, LoadData, 'Urgencies'); if StrToIntDef(LRFURG, 0) > 0 then Urgency := StrToInt(LRFURG) else Urgency := uDfltUrgency; end; 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 FastAssign(GetOneCollSamp(StrToInt(LRFSAMP)), OneSamp); 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; UrgencyList.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) ; FastAssign(SpecimenList, AComboBox.Items); 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; procedure TLabTest.LoadUrgency(CollType: string; AComboBox:TORComboBox); var i: integer; begin if UrgencyList.Count < 1 then Exit; with AComboBox do begin Clear; for i := 0 to UrgencyList.Count - 1 do if (CollType = 'LC') and (Piece(UrgencyList[i], U, 3) = '') then Continue else Items.Add(UrgencyList[i]); if (LRFURG <> '') and (ALabTest.ObtainUrgency) then SelectByID(LRFURG) else SelectByIEN(uDfltUrgency); Urgency := AComboBox.ItemIEN; end; 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.NameOfUrgency: string; var i: Integer; begin Result := ''; with UrgencyList do for i := 0 to Count - 1 do begin if StrToInt(Piece(Strings[i], '^', 1)) = Urgency then 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.ObtainUrgency: Boolean; begin Result := not ForceUrgency; 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.ExtractReasons(OutList:TStrings; AList:TStrings); begin ExtractItems(Outlist, AList,'REASONS'); end; procedure TfrmODBBank.ExtractUrgencies(OutList:TStrings; AList:TStrings); begin ExtractItems(Outlist, AList,'URGENCIES'); end; procedure TfrmODBBank.ExtractTNSOrders(OutList:TStrings; AList:TStrings); begin ExtractItems(Outlist, AList,'TNS ORDERS'); 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.ExtractOther(OutList:TStrings; AList:TStrings); begin ExtractItems(OutList, AList, 'OTHER'); 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 begin SetError(TX_NO_TESTS); Exit; end; if uGetTns = 1 then begin SetError(TX_TNS_REQUIRED); Exit; end; ValidateAdd(AnErrMsg); 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 aList: TStringList; i, DaysofFuturePast: integer; d1, d2: TDateTime; x,test,aOther: 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_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_REASON_TOO_LONG= 'Reason for Request MUST be less than 76 characters long'; TX_MODIFIER_TOO_LONG = 'Modifer text MUST be less than 51 characters long'; 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 := ''; aList := TStringList.Create; try ExtractOther(aList, uVBECList); if aList.Count > 0 then aOther := aList[0]; aList.Clear; if uSelectedItems.Count < 1 then begin AnErrMsg := TX_NO_TEST_SELECTED; Exit; end; for i := 0 to uSelectedItems.Count - 1 do begin x := uSelectedItems[i]; test := lvSelectionList.Items[i].Caption; if piece(x,'^',1) = '1' then //Diagnostic Test begin if uSpecimen = 0 then if cboCollType.ItemID = '' then SetError(TX_NO_TCOLLTYPE + ' (' + test + ')') else if cboCollType.ItemID = 'LC' then begin if Length(cboCollTime.Text) = 0 then SetError(TX_NO_TIME + ' (' + test + ')'); with cboCollTime do if (Length(Text) > 0) and (ItemIndex = -1) then begin if StrToFMDateTime(Text) < 0 then SetError(TX_BAD_TIME + ' (' + test + ')') else if StrToFMDateTime(Text) < FMNow then SetError(TX_PAST_TIME + ' (' + test + ')') 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 + ' (' + test + ')'); end else if EvtDelayLoc <= 0 then begin if (not IsLabCollectTime(StrToFMDateTime(cboCollTime.Text), Encounter.Location)) then SetError(cboCollTime.Text + TX_NOT_LAB_COLL_TIME + ' (' + test + ')'); 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 + ' (' + test + ')') else begin // date only was entered if (FMDateTime - Trunc(FMDateTime) = 0) then begin if (Trunc(FMDateTime) < FMToday) then SetError(TX_PAST_TIME + ' (' + test + ')'); end // date/time was entered else begin if (UpperCase(Text) <> 'NOW') and (FMDateTime < FMNow) then SetError(TX_PAST_TIME + ' (' + test + ')'); end; end; end; end; with cboUrgency do if ItemIEN <= 0 then SetError(TX_NO_URGENCY + ' (' + test + ')'); end else //Component begin if piece(x,'^',3) ='' then SetError(TX_NO_QUANTITY + ' (' + test + ')') else begin if StrToInt(piece(x,'^',3)) < 1 then SetError(TX_NO_QUANTITY + ' (' + test + ')'); if StrToInt(piece(x,'^',3)) > 100 then SetError(TX_HIGH_QUANTITY + ' (' + test + ')'); end; if calWantTime.Text = '' then SetError(TX_NO_DATEMODIFIED + ' (' + test + ')'); if (cboReasons.Text = '') and not(uReason = '') then begin SetError(TX_NO_REASON + ' (' + test + ').' + ' Previously entered ''Reason for Request'' will be retained.'); cboReasons.Text := uReason; //reset reason back to previous value end; if (cboReasons.Text = '') then begin SetError(TX_NO_REASON + ' (' + test + ').'); end; if (memDiagComment.Text = '') and (piece(x,'^',2) = aOther) then SetError(TX_NO_COMMENT + ' (' + test + ')'); if (cboUrgency.Text = 'PRE-OP') and (length(cboSurgery.Text) < 1) then SetError(TX_NO_SURGERY + ' (' + test + ')'); if (length(cboReasons.Text) > 75) then SetError(TX_REASON_TOO_LONG); if (length(cboModifiers.Text) > 50) then SetError(TX_MODIFIER_TOO_LONG); end; end; finally aList.Free; 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.cboQuickClick(Sender: TObject); begin inherited; SetOnQuickOrder; end; procedure TfrmODBBank.cboReasonsChange(Sender: TObject); begin inherited; if (length(cboReasons.Text) > 75) then begin ShowMsg('REASON FOR REQUEST cannot be longer than 75 characters'); cboReasons.Text := Copy(cboReasons.Text,0,75); Exit; end; if Length(cboReasons.Text) > 0 then Responses.Update('REASON', 1, cboReasons.Text, cboReasons.Text); memOrder.Text := Responses.OrderText; end; procedure TfrmODBBank.cboReasonsEnter(Sender: TObject); begin inherited; if Length(cboReasons.Text) > 0 then uReason := cboReasons.Text; end; procedure TfrmODBBank.cboReasonsExit(Sender: TObject); begin inherited; if Length(cboReasons.Text) > 0 then uReason := cboReasons.Text; end; procedure TfrmODBBank.cboAvailTestSelect(Sender: TObject); var i: integer; text : string; ListItem: TListItem; aCollTime,aTypeScreen,aStr,aModifier,aSpecimen,aTestYes,x,aName,aTNSString: string; aList: TStringList; curAdd,AnInstance,aTNS,aTNSDays: Integer; sub,sub1: string; AResponse: TResponse; begin if cboAvailTest.ItemID = '' then Exit; aList := TStringList.Create; try ALabTest := nil; aTypeScreen := ''; aSpecimen := '^'; aTestYes := '1'; aModifier := ''; changing := true; tQuantity.Text := ''; sub1 := ''; cboModifiers.ItemIndex := -1; DisableComponentControls; EnableDiagTestControls; LRORDERMODE := TORDER_MODE_DIAG; ALabTest := TLabTest.Create(cboAvailTest.ItemID, Responses); sub := GetSubtype(ALabTest.TestName); with CtrlInits do begin SetControl(cboCollType, 'Collection Types'); LoadCollType(cboCollType); if FLastCollType <> '' then cboCollType.SelectByID(FLastCollType) else if uDfltCollType <> '' then cboCollType.SelectByID(uDfltCollType) else if OrderForInpatient then if (ALabTest.LabCanCollect) then cboCollType.SelectByID('LC') else cboCollType.SelectByID('WC') else cboCollType.SelectByID('SP'); SetupCollTimes(cboCollType.ItemID); end; with cboAvailTest do begin if (Length(ItemID) = 0) or (ItemID = '0') then Exit; FLastLabID := ItemID ; FLastItemID := ItemID; for i := 0 to uSelectedItems.Count - 1 do if ItemID = piece(uSelectedItems[i],'^',2) then begin ItemIndex := -1; lvSelectionList.Items[i].Selected := true; lvSelectionListClick(self); Exit; end; Changing := True; Changing := False; ExtractTypeScreen(aList, uVBECList); if aList.Count > 0 then aTypeScreen := aList[0]; aList.Clear; aTNSString := ''; if (StrToInt(aTypeScreen) = cboAvailTest.ItemID) and (uTNSOrders.Count > 0) then begin for i := 0 to uTNSOrders.Count - 1 do aTNSString := aTNSString + CRLF + uTNSOrders[i]; with Application do begin NormalizeTopMosts; aTNSDays := TNSDaysBack; aTNS := MessageBox(PChar(aTNSString + CRLF + CRLF + 'Do you wish to continue?'), PChar('Type & Screen Entered in Past ' + IntToStr(TNSDaysBack) + ' Days'), MB_YESNO); RestoreTopMosts; if aTNS = 7 then begin cboAvailTest.ItemIndex := -1; exit; end; end; end; if sub = 't' then with ALabTest do //DIAGNOSTIC TEST begin 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; end; Changing := False; 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) else begin cboUrgency.ItemIndex := 1; Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text); end; if Length(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text); if Length(cboReasons.Text) > 0 then Responses.Update('REASON',1,cboReasons.Text,cboReasons.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; if Length(cboCollType.Text) > 0 then Responses.Update('COLLECT',1,cboCollType.ItemID,cboCollType.ItemID); end; if length(cboCollTime.ItemID) > 0 then aCollTime := cboCollTime.Items[cboCollTime.ItemIndex]; uTestSelected := true; with lvSelectionList do begin ListItem := Items.Add; ListItem.Caption := piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',2); ListItem.SubItems.Add(''); ListItem.SubItems.Add(''); 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; memMessage.Text := ''; pnlMessage.Visible := false; uGetTnS := 0; pnlDiagnosticTests.Caption := 'Diagnostic Tests'; end; end; aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + aCollTime + '^' + cboCollType.Text + '^' + IntToStr(aLabTest.ItemID); //aSpecimen has 2 pieces uSelectedItems.Add(aStr); CurAdd := 1; for i := 0 to uSelectedItems.Count - 1 do begin aName := 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), aName); end; Inc(CurAdd); end; memOrder.Text := Responses.OrderText; finally aList.Free; end; edtResults.Height := 247; edtInfo.Height := 247; if lvSelectionList.Items.Count > 0 then begin pnlSelectedTests.Visible := True; cmdAccept.Visible := True; memOrder.Visible := True; GroupBox1.Visible := False; end; end; procedure TfrmODBBank.cboAvailCompSelect(Sender: TObject); var aList,aTests: TStringList; i,j,k,getTest,TestAdded: integer; text : string; aMSBOS,aMSBOSContinue,curAdd,AnInstance: integer; sub,sub1: string; AResponse: TResponse; ListItem: TListItem; aTypeScreen,aSpecimen,aTestYes,aStr,aMsg,aModifier,x,x1,aReason,aSurgery,aCollTime,aCollSave,aName: String; begin if cboAvailComp.ItemID = '' then Exit; aList := TStringList.Create; aTests := TStringList.Create; sub1 := ''; try DisableDiagTestControls; EnableComponentControls; if not(changing = true) then begin changing := true; tQuantity.Text := ''; cboModifiers.ItemIndex := -1; changing := false; end; LRORDERMODE := TORDER_MODE_COMP; with cboAvailComp do begin if (Length(ItemID) = 0) or (ItemID = '0') then Exit; FLastLabID := ItemID ; FLastItemID := ItemID; for i := 0 to uSelectedItems.Count - 1 do if ItemID = piece(uSelectedItems[i],'^',2) then begin ItemIndex := -1; lvSelectionList.Items[i].Selected := true; lvSelectionListClick(self); Exit; end; ALabTest := TLabTest.Create(ItemID, Responses); sub := GetSubtype(ALabTest.TestName); Changing := False; StatusText(''); end; //Check for and display any associated Lab Results 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.Caption := 'Lab Results Available'; uRaw.Clear; GetPatientBloodResultsRaw(uRaw, Patient.DFN, uTestsForResults); end; 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; aTypeScreen := ''; aSpecimen := '^'; aTestYes := '0'; aReason := ''; aSurgery := ''; aCollTime := ''; aList.Clear; 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 length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex]; if length(cboReasons.ItemID) > 0 then aReason := cboReasons.Items[cboReasons.ItemIndex]; if length(cboSurgery.ItemID) > 0 then aSurgery := cboSurgery.Items[cboSurgery.ItemIndex]; if length(cboCollTime.ItemID) > 0 then aCollTime := cboCollTime.Items[cboCollTime.ItemIndex]; 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 (piece(aList[i],'^',3) = cboSurgery.Text) then begin aMSBOS := StrToInt(piece(aList[i],'^',4)); if (aMSBOS > 0) and (Length(tQuantity.Text) > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then begin with Application do begin NormalizeTopMosts; aMSBOSContinue := MessageBox(PChar('The number of units ordered (' + tQuantity.Text + ') for ' + aLabTest.TestName + ' 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 ShowMsg(cboAvailComp.Text + ' has NOT been added to this request.'); exit; end; end; end; end; end; if (uTNSOrders.Count < 1) then // 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[3] = aTypeScreen then begin uGetTnS := 0; if length(cboUrgency.ItemID) > 0 then uDfltUrgency := cboUrgency.ItemID; lblTNS.Caption := ''; lblTNS.Visible := false; memMessage.Text := ''; pnlMessage.Visible := false; pnlDiagnosticTests.Caption := 'Diagnostic Tests'; 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 begin ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]); ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex)); end else begin ListItem.SubItems.Add(''); ListItem.SubItems.Add(''); end; ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1)); end; aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + IntToStr(aLabTest.ItemID); //aSpecimen has 2 pieces additional pieces added for Tests uSelectedItems.Add(aStr); CurAdd := 1; for i := 0 to uSelectedItems.Count - 1 do begin aName := 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), aName); end else begin if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName); 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), piece(x,'^',4)); 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); if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text); if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text) else begin cboUrgency.ItemIndex := 1; Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text); end; end; Inc(CurAdd); end; memOrder.Text := Responses.OrderText; finally alist.Free; aTests.Free; end; aMsg := ''; LRORDERMODE := TORDER_MODE_INFO; if uGetTnS = 1 then begin lblTNS.Caption := 'TYPE + SCREEN must be added to order'; lblTNS.Visible := true; memMessage.Text := 'TYPE + SCREEN must be added to order'; pnlMessage.Visible := true; pnlDiagnosticTests.Caption := 'Diagnostic Tests*'; end; {if uGetTnS = 1 then begin if responses.QuickOrder < 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); cboTests.SelectByID(aTypeScreen); cboTestsClick(self); //cboAvailTestSelect(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 else begin lblTNS.Caption := 'TYPE + SCREEN must be added to order'; lblTNS.Visible := true; memMessage.Text := 'TYPE + SCREEN must be added to order'; memMessage.Visible := false; pnlMessage.Visible := true; end; end; if (uGetTnS = 1) then begin if length(aMsg) > 0 then aMsg := aMsg + crlf + crlf; ShowMsg(aMsg); end; } edtResults.Height := 247; edtInfo.Height := 247; if lvSelectionList.Items.Count > 0 then begin pnlSelectedTests.Visible := True; cmdAccept.Visible := True; memOrder.Visible := True; GroupBox1.Visible := False; end; if tQuantity.CanFocus = true then tQuantity.SetFocus; end; procedure TfrmODBBank.DisableCommentPanels; begin lblReqComment.Visible := False; end; procedure TfrmODBBank.DisableComponentControls; begin lblQuantity.Enabled := false; tQuantity.Enabled := false; lblModifiers.Enabled := false; cboModifiers.Enabled := false; cboAvailComp.ItemIndex := -1; end; procedure TfrmODBBank.EnableComponentControls; begin lblQuantity.Enabled := true; tQuantity.Enabled := true; lblModifiers.Enabled := true; cboModifiers.Enabled := true; if not(changing) then if not(uSelUrgency = 'PRE-OP') then if uSelUrgency = '' then if lvSelectionList.Items.Count < 1 then cboUrgency.SelectByID(IntToStr(uDfltUrgency)); if cboUrgency.Text = 'PRE-OP' then begin lblSurgery.Enabled := true; cboSurgery.Enabled := true; lblSurgery.Caption := 'Surgery*'; end else begin lblSurgery.Enabled := false; cboSurgery.Enabled := false; lblSurgery.Caption := 'Surgery'; end; lblDiagComment.Enabled := true; end; procedure TfrmODBBank.DisableDiagTestControls; begin lblCollTime.Enabled := false; calCollTime.Enabled := false; cboCollTime.Enabled := false; lblCollType.Enabled := false; cboCollType.Enabled := false; cmdImmedColl.Enabled := false; cboAvailTest.ItemIndex := -1; cboAvailTest.InitLongList(''); end; procedure TfrmODBBank.EnableDiagTestControls; begin lblCollTime.Enabled := true; calCollTime.Enabled := true; cboCollTime.Enabled := true; lblCollType.Enabled := true; cboCollType.Enabled := true; cmdImmedColl.Enabled := true; if not(changing) then if not(uSelUrgency = 'PRE-OP') then if uSelUrgency = '' then if lvSelectionList.Items.Count < 1 then cboUrgency.SelectByID(IntToStr(uDfltUrgency)); 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; if ALabTest.LabSubscript = 'BB' 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.cboAvailCompChange(Sender: TObject); begin inherited; changing := true; changing := false; 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_COMPONENT : begin memOrder.Visible := true; cmdAccept.Visible := true; pnlSelectedTests.Visible := true; lvSelectionList.Width := lvSelectionList.Width + 1; //added to fix font resize issue - funky column display end; TI_INFO : begin if lvSelectionList.Items.Count > 0 then begin memOrder.Visible := true; cmdAccept.Visible := true; pnlSelectedTests.Visible := true; end else begin memOrder.Visible := false; cmdAccept.Visible := false; pnlSelectedTests.Visible := false; end; end; TI_RESULTS : begin if lvSelectionList.Items.Count > 0 then begin memOrder.Visible := true; cmdAccept.Visible := true; pnlSelectedTests.Visible := true; end else begin memOrder.Visible := false; cmdAccept.Visible := false; pnlSelectedTests.Visible := false; end; end; end; {case} end; procedure TfrmODBBank.cboCollTimeChange(Sender: TObject); var CollType: string; const TX_BAD_TIME = ' is not a routine lab collection time.' ; TX_BAD_TIME_CAP = 'Invalid Time'; begin CollType := 'LC'; with cboCollTime do begin if ItemID = 'LO' then begin ItemIndex := -1; Text := GetFutureLabTime(FMToday); end; end; cboCollType.SelectByID(CollType); if uSelectedItems.Count > 0 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; 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; if cboCollType.ItemID = 'I' then begin cboCollTime.ItemIndex := -1; cboCollTime.Text := 'NOW'; calCollTime.Text := 'NOW'; end; SetupCollTimes(cboCollType.ItemID); if Length(cboCollType.Text) > 0 then Responses.Update('COLLECT',1,cboCollType.ItemID,cboCollType.ItemID); FLastCollType := cboCollType.ItemID; calCollTimeChange(self); end; procedure TfrmODBBank.cboModifiersChange(Sender: TObject); var i: integer; ListItem: TListItem; x,q,m: string; begin inherited; if changing = true then Exit; if (cboAvailComp.ItemIndex <> -1) and (uSelectedItems.Count > 0) then begin for i := 0 to lvSelectionList.Items.Count - 1 do begin x := uSelectedItems[i]; m := piece(x,'^',4); q := piece(x,'^',3); if lvSelectionList.Items[i].Caption = piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2) then begin ListItem := lvSelectionList.Items[i]; ListItem.SubItems.Clear; ListItem.SubItems.Add(q); if length(cboModifiers.ItemID) > 0 then begin ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]); ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex)); end else begin ListItem.SubItems.Add(''); ListItem.SubItems.Add(''); end; ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1)); Responses.Update('MODIFIER', (i+1), cboModifiers.Text, cboModifiers.Text); Break; end; end; end; if Length(cboModifiers.Text) > 0 then begin memOrder.Text := Responses.OrderText; end; 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.LoadReasons(AComboBox:TORComboBox); var i: integer; begin with AComboBox do begin Clear; for i := 0 to uReasonsList.Count - 1 do Items.Add(uReasonsList[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.lvSelectionListClick(Sender: TObject); var ListItem: TListItem; x,y: string; i,j: integer; begin inherited; if lvSelectionList.Selected = nil then Exit; ListItem := lvSelectionList.Selected; changing := true; tQuantity.Text := ''; cboModifiers.ItemIndex := -1; i := lvSelectionList.ItemIndex; j := 0; if cboCollType.ItemID = 'LC' then begin if FLastLabCollTime <> '' then cboCollTime.SelectByID(piece(FLastLabCollTime,'^',1)); end else begin if FLastCollTime = 'TODAY' then calCollTime.Text := FLastCollTime else if FLastCollTime = 'NOW' then calCollTime.Text := FLastCollTime else if FLastCollTime <> '' then calCollTime.Text := FormatFMDateTime('mmm dd,yyyy@hh:nn',StrToFMDateTime(FLastCollTime)); end; if FLastCollType <> '' then cboCollType.SelectByID(FLastCollType); if uSelectedItems.Count > 0 then begin x := uSelectedItems[i]; ALabTest := TLabTest.Create(piece(uSelectedItems[i],'^',2), Responses); if not(piece(x,'^',2) = '') then j := StrToInt(piece(x,'^',2)); if not(piece(x,'^',1) = '1') and (j > 0) then //Components begin DisableDiagTestControls; EnableComponentControls; y := ListItem.SubItems[2]; changing := true; cboModifiers.Text := ''; cboAvailComp.SelectByIEN(j); tQuantity.Text := ListItem.SubItems[0]; changing := false; if y <> '' then cboModifiers.ItemIndex := StrToInt(y); end else //Diagnostic Tests begin DisableComponentControls; EnableDiagTestControls; cboAvailTest.SelectByIEN(j); end; end; changing := false; end; procedure TfrmODBBank.memDiagCommentChange(Sender: TObject); begin inherited; if (length(memDiagComment.Text) > 250) then begin ShowMsg('COMMENT cannot be longer than 250 characters'); memDiagComment.Text := Copy(memDiagComment.Text,0,250); Exit; end; if lvSelectionList.Items.Count < 1 then Exit; if uSelectedItems = nil then Exit; if uSelectedItems.Count > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text); memOrder.Text := Responses.OrderText; end; procedure TfrmODBBank.FormDestroy(Sender: TObject); begin inherited; uSelectedItems.Free; uVBECList.Free; uTestsForResults.Free; uUrgencyList.Free; uTNSOrders.Free; uModifierList.Free; uReasonsList.Free; uRaw.Free; end; procedure TfrmODBBank.btnRemoveClick(Sender: TObject); var i,j,curAdd: integer; x, aName, aModifier, aReason, aTypeScreen: string; aList: TStringList; aSel, aSelTst : boolean; begin inherited; aList := TStringList.Create; try curAdd := 1; aModifier := ''; aReason := ''; aTypeScreen := ''; aSel := false; aSelTst := false; ExtractTypeScreen(aList, uVBECList); if aList.Count > 0 then aTypeScreen := aList[0]; aList.Clear; if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex]; if length(cboReasons.ItemID) > 0 then aReason := cboReasons.Items[cboReasons.ItemIndex]; if lvSelectionList.Items.Count < 1 then begin ShowMsg('There is nothing in the list to remove.'); exit; end; cboAvailComp.ItemIndex := -1; tQuantity.Text := ''; cboAvailTest.ItemIndex := -1; uGetTnS := 0; lblTNS.Caption := ''; lblTNS.Visible := false; memMessage.Text := ''; pnlMessage.Visible := false; pnlDiagnosticTests.Caption := 'Diagnostic Tests'; with lvSelectionList do begin for i := lvSelectionList.Items.Count - 1 downto 0 do begin if lvSelectionList.Items[i].Selected = true then begin aSel := true; for j := uSelectedItems.Count - 1 downto 0 do if lvSelectionList.Items[i].SubItems[3] = piece(uSelectedItems[j],'^',2) then begin {if (uGetTnS = 1) and (lvSelectionList.Items[i].SubItems[3] = aTypeScreen) then begin uGetTnS := 1; lblTNS.Caption := 'TYPE+SCREEN must be added to order'; lblTNS.Visible := true; memMessage.Text := 'TYPE + SCREEN must be added to order'; //memMessage.Visible := true; pnlMessage.Visible := true; pnlDiagnosticTests.Caption := 'Diagnostic Tests*'; end; } uSelectedItems.Delete(j); lvSelectionList.Items[i].Delete; break; end; end; end; end; for i := uSelectedItems.Count - 1 downto 0 do begin if (not(piece(uSelectedItems[i],'^',1) = '1')) and (uTNSOrders.Count < 1) then // and (SpecimenNeeded(aList, uVBECList, StrToInt(piece(uSelectedItems[i],'^',9)))) then begin uGetTnS := 1; lblTNS.Caption := 'TYPE+SCREEN must be added to order'; lblTNS.Visible := true; memMessage.Text := 'TYPE + SCREEN must be added to order'; //memMessage.Visible := true; pnlMessage.Visible := true; pnlDiagnosticTests.Caption := 'Diagnostic Tests*'; break; end; end; if (aSel = false) and (lvSelectionList.Items.Count > 0) then begin ShowMsg('Please select an item from the list to be removed.'); exit; end; Responses.Clear; if lvSelectionList.Items.Count < 1 then begin cboReasons.ItemIndex := -1; memDiagComment.Text := ''; cboSurgery.ItemIndex := -1; cboUrgency.ItemIndex := -1; cboCollType.ItemIndex := -1; cboCollTime.ItemIndex := -1; cboQuick.ItemIndex := -1; calCollTime.Text := ''; end; for i := 0 to uSelectedItems.Count - 1 do begin aName := 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), aName); aSelTst := true; end else begin if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName); 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)); cboModifiers.ItemIndex := -1; cboAvailComp.ItemIndex := -1; tQuantity.Text := ''; end; Inc(CurAdd); end; if aSelTst = false then begin cboCollType.ItemIndex := -1; cboCollTime.ItemIndex := -1; calCollTime.Text := ''; 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(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text); if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text); if Length(cboReasons.Text) > 0 then Responses.Update('REASON',1,cboReasons.Text,cboReasons.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; memMessage.Text := ''; pnlMessage.Visible := false; GroupBox1.Visible := true; pnlDiagnosticTests.Caption := 'Diagnostic Tests'; end; finally aList.Free; end; end; procedure TfrmODBBank.btnUpdateCommentsClick(Sender: TObject); begin inherited; pnlComments.Visible := false; pnlComments.SendToBack; Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text); memOrder.Text := Responses.OrderText; end; procedure TfrmODBBank.btnCancelCommentClick(Sender: TObject); begin inherited; pnlComments.Visible := false; pnlComments.SendToBack; end; procedure TfrmODBBank.btnRemoveAllClick(Sender: TObject); begin inherited; if lvSelectionList.Items.Count < 1 then begin ShowMsg('There is nothing in the list to remove.'); exit; end; lvSelectionList.Clear; uSelectedItems.Clear; uTestsForResults.Clear; uRaw.Clear; uGetTnS := 0; lblTNS.Caption := ''; lblTNS.Visible := false; memMessage.Text := ''; pnlMessage.Visible := false; InitDialog; cboModifiers.ItemIndex := -1; cboAvailTest.ItemIndex := -1; cboAvailComp.ItemIndex := -1; cboSurgery.ItemIndex := -1; cboUrgency.ItemIndex := -1; cboReasons.ItemIndex := -1; cboCollType.ItemIndex := -1; cboCollTime.ItemIndex := -1; cboQuick.ItemIndex := -1; calWantTime.Text := ''; memDiagComment.Text := ''; GroupBox1.Visible := true; tQuantity.Text := ''; FLastCollType := ''; FLastCollTime := ''; FLastLabCollTime := ''; txtImmedColl.Text := ''; 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 not ValidAdd then Exit; 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 begin if NursAdminSuppress = true then ShowMsg('The nursing blood administration order must be entered separately' + '.'); end; inherited; end; procedure TfrmODBBank.calWantTimeChange(Sender: TObject); begin inherited; if uSelectedItems.Count > 0 then begin with calWantTime do if not Changing then begin if FMDateTime = 0 then begin ShowMsg('Invalid Date/Time entered'); Changing := true; calWantTime.Text := ''; Changing := false; Exit; end else begin // date/time was entered if (UpperCase(Text) <> 'NOW') and not(Trunc(FMNow) = Trunc(FMDateTime)) and (FMDateTime < FMNow) then begin ShowMsg('Date/Time Wanted must be a future Date/Time'); Changing := true; calWantTime.Text := ''; Changing := false; Exit; end; end; end; if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text); memOrder.Text := Responses.OrderText; end; 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'); memOrder.Text := Responses.OrderText; end; end; procedure TfrmODBBank.cboUrgencyChange(Sender: TObject); begin inherited; if Length(cboUrgency.Text) > 0 then begin Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text); uSelUrgency := cboUrgency.Text; if cboUrgency.Text = 'PRE-OP' then begin lblSurgery.Enabled := true; cboSurgery.Enabled := true; lblSurgery.Caption := 'Surgery*'; end else begin lblSurgery.Enabled := false; cboSurgery.Enabled := false; lblSurgery.Caption := 'Surgery'; cboSurgery.ItemIndex := -1; Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text); end; end else cboUrgency.SelectByID(IntToStr(uDfltUrgency)); memOrder.Text := Responses.OrderText; end; procedure TfrmODBBank.cboUrgencyExit(Sender: TObject); begin inherited; if Length(cboUrgency.Text) < 1 then cboUrgency.SelectByID(IntToStr(uDfltUrgency)); end; procedure TfrmODBBank.cboSurgeryChange(Sender: TObject); var aList: TStringList; i,j,aMSBOS,aMSBOSContinue: integer; x: string; handled: boolean; begin inherited; aList := TStringList.Create; handled := false; try if (Length(cboSurgery.ItemID) > 0) and (Length(tQuantity.Text) > 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 (piece(aList[i],'^',3) = cboSurgery.Text) 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 unit Quantity selected (' + tQuantity.Text + ') for ' + aLabTest.TestName + ' exceeds the maximum number of units (' + IntToStr(aMSBOS) + ') for the ' + cboSurgery.text + ' surgical procedure selected.' + CRLF + CRLF + 'Continue to order ' + tQuantity.Text + ' units?'), PChar('Maximum Number of Units Exceeded'), MB_YESNO); RestoreTopMosts; end; if aMSBOSContinue = 7 then begin ShowMsg('Please enter a new quantity for ' + cboAvailComp.Text); tQuantity.Text := '0'; tQuantity.SelLength := 2; tQuantity.SelectAll; break; end; end; handled := true; break; end; end; end; if (handled = false) and (Length(cboSurgery.ItemID) > 0) and (uSelectedItems.Count > 0) then begin aList.Clear; ExtractMSBOS(aList, uVBECList); //Get maximum units for selected Surgey for j := 0 to uSelectedItems.Count - 1 do begin ALabTest := TLabTest.Create(piece(uSelectedItems[j],'^',2), Responses); for i := 0 to aList.Count - 1 do begin if (piece(uSelectedItems[j],'^',1) = '0') and (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) and (piece(aList[i],'^',3) = cboSurgery.Text) then begin aMSBOS := StrToInt(piece(aList[i],'^',4)); if (aMSBOS > 0) and (length(piece(uSelectedItems[j],'^',3)) > 0) and (StrToInt(piece(uSelectedItems[j],'^',3)) > aMSBOS) then begin with Application do begin NormalizeTopMosts; aMSBOSContinue := MessageBox(PChar('The number of unit Quantity selected (' + piece(uSelectedItems[j],'^',3) + ') for ' + lvSelectionList.Items[j].Caption + ' exceeds the maximum number of units (' + IntToStr(aMSBOS) + ') for the ' + cboSurgery.text + ' surgical procedure selected.' + CRLF + CRLF + 'Continue to order ' + piece(uSelectedItems[j],'^',3) + ' units?'), PChar('Maximum Number of Units Exceeded'), MB_YESNO); RestoreTopMosts; end; if aMSBOSContinue = 7 then begin ShowMsg('Please enter a new quantity for ' + lvSelectionList.Items[j].Caption); tQuantity.Text := '0'; tQuantity.SelLength := 2; tQuantity.SelectAll; x := uSelectedItems[j]; SetPiece(x,U,3,''); uSelectedItems[j] := x; lvSelectionList.Items[j].SubItems[0] := ''; RePaint; break; end; end; break; end; end; end; end; if uSelectedItems.Count > 0 then if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text); uSelSurgery := 0; if Length(cboSurgery.Text) > 0 then begin if length(cboSurgery.ItemID) > 0 then uSelSurgery := cboSurgery.ItemID; cboReasons.Text := cboSurgery.Text; Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text); end; memOrder.Text := Responses.OrderText; finally aList.Free; end; end; procedure TfrmODBBank.cboSurgeryClick(Sender: TObject); begin inherited; if Length(cboSurgery.Text) > 0 then uSelSurgery := cboSurgery.ItemID; end; procedure TfrmODBBank.tQuantityChange(Sender: TObject); var aList: TStringList; i,aMSBOS,aMSBOSContinue: integer; ListItem: TListItem; x,m: string; begin inherited; if changing = true then Exit; aList := TStringList.Create; if Length(tQuantity.Text) > 0 then begin if Length(tQuantity.Text) > 2 then begin ShowMsg('Invalid entry. Please select a numeric value <100'); tQuantity.Text := ''; Exit; end; if StrToInt(tQuantity.Text) > 100 then begin ShowMsg('Quantity too high. Please select a value <100'); tQuantity.Text := Copy(tQuantity.Text,0,1); Exit; end; end; try if (Length(cboSurgery.ItemID) > 0) and (Length(tQuantity.Text) > 0) then begin aList.Clear; ExtractMSBOS(aList, uVBECList); //Get maximum units for selected Surgery for i := 0 to aList.Count - 1 do begin if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) and (piece(aList[i],'^',3) = cboSurgery.Text) 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 + ') for ' + aLabTest.TestName + ' 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 ShowMsg('Please enter a new quantity for ' + cboAvailComp.Text); tQuantity.Text := '0'; tQuantity.SelLength := 2; tQuantity.SelectAll; break; end; end; break; end; end; end; if (cboAvailComp.ItemIndex <> -1) and (uSelectedItems.Count > 0) then for i := 0 to lvSelectionList.Items.Count - 1 do begin if lvSelectionList.Items[i].Caption = piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2) then begin x := uSelectedItems[i]; m := piece(x,'^',4); ListItem := lvSelectionList.Items[i]; ListItem.SubItems.Clear; ListItem.SubItems.Add(tQuantity.Text); SetPiece(x,U,3,tQuantity.Text); Responses.Update('QTY', (i+1), tQuantity.Text, tQuantity.Text); uSelectedItems[i] := x; if length(cboModifiers.ItemID) > 0 then begin ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]); ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex)); end else begin ListItem.SubItems.Add(''); ListItem.SubItems.Add(''); end; ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1)); Break; end; end; if Length(tQuantity.Text) > 0 then begin memOrder.Text := Responses.OrderText; end; finally aList.Free; end; end; procedure TfrmODBBank.tQuantityClick(Sender: TObject); begin inherited; tQuantity.SelLength := 2; tQuantity.SelectAll; end; procedure TfrmODBBank.tQuantityEnter(Sender: TObject); begin inherited; tQuantity.SelLength := 2; tQuantity.SelectAll; 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; memOrder.Text := Responses.OrderText; end; end; end.