Ignore:
Timestamp:
Jul 7, 2010, 4:31:10 PM (14 years ago)
Author:
Kevin Toppenberg
Message:

Upgrade to version 27

File:
1 edited

Legend:

Unmodified
Added
Removed

  • cprs/trunk/CPRS-Chart/Orders/fODBBank.pas

    r456 r829  
    11unit fODBBank;
    2 
    32interface
    43
    … …  
    65  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
    76  Forms, Dialogs, StdCtrls, ORCtrls, ORfn, fODBase, ExtCtrls, ComCtrls, uConst,
    8   ORDtTm, Buttons, Menus, ImgList;
     7  ORDtTm, Buttons, Menus, ImgList, VA508AccessibilityManager, VAUtils;
    98
    109type
    1110  TfrmODBBank = class(TfrmODBase)
    12     pnlBB: TPanel;
    13     pnlFull: TPanel;
     11    dlgLabCollTime: TORDateTimeDlg;
     12    ORWanted: TORDateTimeDlg;
     13    pnlComments: TPanel;
     14    btnUpdateComments: TButton;
     15    btnCancelComment: TButton;
     16    lblOrdComment: TLabel;
    1417    pgeProduct: TPageControl;
    15     tabInfo: TTabSheet;
     18    TabInfo: TTabSheet;
    1619    edtInfo: TCaptionRichEdit;
    1720    TabDiag: TTabSheet;
    1821    lblReqComment: TOROffsetLabel;
     22    TabResults: TTabSheet;
     23    edtResults: TCaptionRichEdit;
    1924    pnlFields: TPanel;
    20     dlgLabCollTime: TORDateTimeDlg;
    21     ORWanted: TORDateTimeDlg;
    2225    lblDiagComment: TOROffsetLabel;
    23     txtDiagComment: TCaptionEdit;
    24     pnlSelectedTests: TGroupBox;
    25     lvSelectionList: TCaptionListView;
    2626    lblUrgency: TLabel;
     27    lblReason: TLabel;
     28    lblSurgery: TLabel;
    2729    cboUrgency: TORComboBox;
    28     lblCollType: TLabel;
    29     cboCollType: TORComboBox;
    3030    chkConsent: TCheckBox;
    31     lblPreparation: TLabel;
    32     calWantTime: TORDateBox;
    33     lblWanted: TLabel;
    34     tReason: TEdit;
    35     lblReason: TLabel;
    3631    cboSurgery: TORComboBox;
    37     lblSurgery: TLabel;
    38     txtImmedColl: TCaptionEdit;
    39     cboCollTime: TORComboBox;
    40     lblCollTime: TLabel;
    41     cmdImmedColl: TSpeedButton;
    42     pnlCollTimeButton: TKeyClickPanel;
    43     calCollTime: TORDateBox;
    44     cboPreparation: TORComboBox;
    45     btnRemove: TButton;
    46     btnRemoveAll: TButton;
    47     pnlTop: TPanel;
    4832    pnlSelect: TPanel;
    49     pnlDiagTests: TGroupBox;
     33    pnlDiagnosticTests: TGroupBox;
    5034    cboAvailTest: TORComboBox;
    5135    pnlBloodComponents: TGroupBox;
    5236    lblQuantity: TLabel;
     37    lblModifiers: TLabel;
    5338    cboAvailComp: TORComboBox;
    5439    tQuantity: TEdit;
    55     upQuantity: TUpDown;
    56     TabResults: TTabSheet;
    57     edtResults: TCaptionRichEdit;
    58     btnAddTests: TORAlignSpeedButton;
    59     ImageList1: TImageList;
    60     lblModifiers: TLabel;
    6140    cboModifiers: TORComboBox;
     41    GroupBox1: TGroupBox;
     42    cboQuick: TORComboBox;
     43    pnlSelectedTests: TGroupBox;
     44    lvSelectionList: TCaptionListView;
     45    btnRemove: TButton;
     46    btnRemoveAll: TButton;
     47    cboReasons: TORComboBox;
     48    lblRequiredField: TLabel;
     49    memDiagComment: TRichEdit;
     50    lblCollType: TLabel;
     51    cboCollType: TORComboBox;
     52    lblCollTime: TLabel;
     53    cboCollTime: TORComboBox;
     54    calWantTime: TORDateBox;
     55    lblWanted: TLabel;
     56    calCollTime: TORDateBox;
     57    txtImmedColl: TCaptionEdit;
     58    pnlCollTimeButton: TKeyClickPanel;
     59    cmdImmedColl: TSpeedButton;
    6260    lblTNS: TLabel;
    6361    procedure FormCreate(Sender: TObject);
    … …  
    7876    procedure pgeProductChange(Sender: TObject);
    7977    procedure cboCollTypeChange(Sender: TObject);
    80     procedure btnAddTestsClick(Sender: TObject);
    8178    procedure FormDestroy(Sender: TObject);
    8279    procedure btnRemoveClick(Sender: TObject);
    … …  
    8683    procedure chkConsentClick(Sender: TObject);
    8784    procedure cboUrgencyChange(Sender: TObject);
    88     procedure txtDiagCommentChange(Sender: TObject);
    89     procedure cboPreparationChange(Sender: TObject);
    9085    procedure cboSurgeryChange(Sender: TObject);
    91     procedure tReasonChange(Sender: TObject);
    9286    procedure calCollTimeChange(Sender: TObject);
     87    procedure cboQuickClick(Sender: TObject);
     88    procedure tQuantityEnter(Sender: TObject);
     89    procedure btnUpdateCommentsClick(Sender: TObject);
     90    procedure btnCancelCommentClick(Sender: TObject);
     91    procedure cboSurgeryClick(Sender: TObject);
     92    procedure cboReasonsEnter(Sender: TObject);
     93    procedure cboReasonsExit(Sender: TObject);
     94    procedure tQuantityClick(Sender: TObject);
     95    procedure tQuantityChange(Sender: TObject);
     96    procedure cboReasonsChange(Sender: TObject);
     97    procedure cboModifiersChange(Sender: TObject);
     98    procedure lvSelectionListClick(Sender: TObject);
     99    procedure cboAvailCompChange(Sender: TObject);
     100    procedure cboCollTimeChange(Sender: TObject);
     101    procedure memDiagCommentChange(Sender: TObject);
     102    procedure cboUrgencyExit(Sender: TObject);
    93103  protected
    94104    FCmtTypes: TStringList ;
    … …  
    106116    procedure ExtractSurgeries(OutList:TStrings; AList:TStrings);
    107117    procedure ExtractUrgencies(OutList:TStrings; AList:TStrings);
     118    procedure ExtractTNSOrders(OutList:TStrings; AList:TStrings);
    108119    procedure ExtractModifiers(OutList:TStrings; AList:TStrings);
     120    procedure ExtractReasons(OutList:TStrings; AList:TStrings);
    109121    procedure ExtractSpecimens(OutList:TStrings; AList:TStrings);
    110122    procedure ExtractTypeScreen(OutList:TStrings; AList:TStrings);
     123    procedure ExtractOther(OutList:TStrings; AList:TStrings);
    111124    procedure ExtractPatientInfo(OutList:TStrings; AList:TStrings);
    112125    procedure ExtractSpecimen(OutList:TStrings; AList:TStrings);
    … …  
    114127    procedure LoadUrgencies(AComboBox:TORComboBox);
    115128    procedure LoadModifiers(AComboBox:TORComboBox);
     129    procedure LoadReasons(AComboBox:TORComboBox);
     130
    116131  private
    117132    FLastCollType: string;
    … …  
    123138    FEvtDivision: integer;
    124139    FVbecLookup: string;
     140    FQuickList:  Integer;
     141    FQuickItems: TStringList;
     142    FOrderAction: Integer;
    125143    procedure ReadServerVariables;
     144    procedure SetOnQuickOrder;
    126145  public
    127146    procedure SetupDialog(OrderAction: Integer; const ID: string); override;
    … …  
    153172    CollSamp: Integer;                    { index into CollSampList }
    154173    Specimen: Integer;                    { IEN of specimen }
     174    Urgency: Integer;                     { IEN of urgency }
    155175    Comment: TStringList;                 { text of comment }
    156176    TestReqComment: string;               { Name of required comment }
    … …  
    162182    SpecimenList: TStringList;            { Strings: IEN^Specimen Name }
    163183    SpecListCount: integer;               { count of original contents of SpecimenList}
     184    UrgencyList: TStringList;             { Strings: IEN^Urgency Name }
     185    ForceUrgency: Boolean;                { true if not prompt Urgency }
    164186    SurgeryList: TStringList;             { Strings: Surgeries}
    165187    PatientInfo: TStringList;             { Text of Patient Information}
    … …  
    179201    procedure LoadCollSamp(AComboBox: TORComboBox);
    180202    procedure LoadSpecimen(AComboBox: TORComboBox);
     203    procedure LoadUrgency(CollType: string; AComboBox:TORComboBox);
    181204    function  NameOfCollSamp: string;
    182205    function  NameOfSpecimen: string;
     206    function  NameOfUrgency: string;
    183207    function  ObtainCollSamp: Boolean;
    184208    function  ObtainSpecimen: Boolean;
     209    function  ObtainUrgency: Boolean;
    185210    function  ObtainComment: Boolean;
     211
    186212  end;
    187213
    … …  
    202228var
    203229  uSelectedItems: TStringList;   //Selected Items in ListView- if TestYes =1 then test else component
    204                                  //TestYes(1)^Test-Component(2)^Qty(3)^Sample(4,5)^Specimen(6,7)^Modifier(8)
     230                                 //TestYes(1)^Test-Component(2)^Qty(3)^Modifier(4)^Specimen(5,6)^CollTime(7)^CollType(8)
    205231  uVBECList: TStringList;        //List of items from VBEC api
    206232  uTestsForResults: TStringList; //List of tests to show results
    207233  uUrgencyList: TStringList;     //List of Urgencies
     234  uTNSOrders: TStringList;       //List of Current orders for Type & Screen
    208235  uModifierList: TStringList;    //List of Modifiers
     236  uReasonsList: TStringList;     //List of Reasons for Request
    209237  uRaw: TStringList;             //Results Array
    210238  uTestSelected, uComponentSelected: Boolean;  //Used on Validate
    211   uDfltUrgency: Integer;
     239  uDfltUrgency: Integer;         //Default Urgency
     240  uSelUrgency: String;          //Previously Selected Urgency - Used when components have been added for specific urgency
     241  uSelSurgery: Integer;          //Selected Surgery for Blood order
    212242  uSpecimen, uGetTnS: Integer;            //Set to 1 if a specimen for test is already in lab... no need to collect
    213   uDfltCollType: string;
     243  uDfltCollType, uReason: string;
    214244  ALabTest: TLabTest;
    215245  UserHasLRLABKey: boolean;
    … …  
    228258
    229259  TI_INFO = 0;    //Corresponds with pgeProduct TabIndex
    230   TI_ORDER = 1;
     260  TI_COMPONENT = 1;
    231261  TI_RESULTS = 2;
    232262
    … …  
    239269  i: integer;
    240270  AList, ATests: TStringList;
     271  ListCount: Integer;
     272  x: string;
    241273begin
    242274  AutoSizeDisabled := True;
    … …  
    248280  uTestsForResults := TStringList.Create;
    249281  uUrgencyList := TStringList.Create;
     282  uTNSOrders := TStringList.Create;
    250283  uModifierList := TStringList.Create;
     284  uReasonsList := TStringList.Create;
    251285  uRaw := TStringList.Create;
    252286  uSpecimen := 0;
    253287  uGetTnS := 0;
     288  uReason := '';
    254289  lblTNS.Caption := '';
    255290  lblTNS.Visible := false;
     291  pnlMessage.Visible := false;
    256292  uDfltUrgency := 9;
    257   TabResults.ImageIndex := 0;
     293  uSelUrgency := '';
     294  uSelSurgery := 0;
     295  TabResults.Caption := 'Lab Results';
     296  edtResults.Lines.Clear;
     297  edtResults.Lines.Add('Lab results are ONLY available after selecting/adding a component on the Blood Bank Orders tab that has been designated for results retrieval.');
    258298  Responses.Clear;
    259299  try
    … …  
    265305    LRFSCH   := '';
    266306    LRORDERMODE := TORDER_MODE_INFO;
    267     DisableComponentControls;
    268     DisableDiagTestControls;
    269307    FLastColltime := '';
    270308    FLastLabCollTime := '';
    … …  
    277315    AllowQuickOrder := True;
    278316    StatusText('Loading Dialog Definition');
    279     lblReqComment.Visible := False ;
    280     lblModifiers.Enabled := False;
    281     cboModifiers.Enabled := False;
    282317    FCmtTypes := TStringList.Create;
    283318    for i := 0 to 6 do FCmtTypes.Add(CmtType[i]) ;
    … …  
    289324      EvtDivision := StrToIntDef(GetEventDiv1(IntToStr(Self.EvtID)),0);
    290325      if EvtDelayLoc>0 then
    291         AList.Assign(ODForLab(EvtDelayLoc,EvtDivision))
     326        FastAssign(ODForLab(EvtDelayLoc,EvtDivision), AList)
    292327      else
    293         AList.Assign(ODForLab(Encounter.Location,EvtDivision));
     328        FastAssign(ODForLab(Encounter.Location,EvtDivision), AList);
    294329    end else
    295       AList.Assign(ODForLab(Encounter.Location)); // ODForLab returns TStrings with defaults
     330      FastAssign(ODForLab(Encounter.Location), AList); // ODForLab returns TStrings with defaults
    296331    CtrlInits.LoadDefaults(AList);
    297332    InitDialog;
     333    GroupBox1.Visible := True;
    298334    with CtrlInits do
    299335    begin
    … …  
    309345      StatusText('Initializing List of Tests');
    310346      FVbecLookup := 'S.VBT';
    311       cboAvailTest.InitLongList('');
     347      cboAvailTest.InitLongList('');      //Populates cboAvailTest control based on S.VBT xref
    312348    end;
    313349    cboAvailComp.Clear;
    … …  
    329365    AList.Clear;
    330366    ExtractUrgencies(uUrgencyList, uVBECList);
     367    ExtractTNSOrders(uTNSOrders, uVBECList);
    331368    LoadUrgencies(cboUrgency);
    332     cboUrgency.SelectByID(IntToStr(uDfltUrgency));
    333369    ExtractModifiers(uModifierList, uVBECList);
     370    ExtractReasons(uReasonsList, uVBECList);
    334371    LoadModifiers(cboModifiers);
    335     calWantTime.Text := FormatFMDateTime('mmm dd,yyyy@hh:nn',DateTimeToFMDateTime(Now));
    336     //cboPreparation.SelectByID('I');
    337     memMessage.Visible := false;
    338     memOrder.Visible := false;
    339     cmdAccept.Visible := false;
     372    LoadReasons(cboReasons);
     373    calWantTime.Text := 'NOW'; //FormatFMDateTime('mmm dd,yyyy@hh:nn',DateTimeToFMDateTime(Now));
    340374    pgeProduct.TabIndex := TI_INFO;
    341     lvSelectionList.Column[0].Width := 200;
    342     lvSelectionList.Column[1].Width := 40;
     375    lvSelectionList.Column[0].Width := 240;
     376    lvSelectionList.Column[1].Width := 30;
     377    lvSelectionList.Column[2].Width := 100;
     378    DisableComponentControls;
     379    DisableDiagTestControls;
    343380    pgeProduct.ActivePageIndex := TI_INFO;
    344     PreserveControl(cboAvailTest);
    345     PreserveControl(cboAvailComp);
    346     PreserveControl(cboCollType);
    347     PreserveControl(cboCollTime);
    348     PreserveControl(calCollTime);
    349     PreserveControl(calWantTime);
    350381    StatusText('');
    351 
     382    x := 'VBEC';
     383    FQuickItems := TStringList.Create;
     384    ListForQuickOrders(FQuickList, ListCount, x);
     385    if ListCount > 0 then
     386      begin
     387        SubsetOfQuickOrders(FQuickItems, FQuickList, 0, 0);
     388      end else
     389      begin
     390        ListCount := 1;
     391        FQuickItems.Add('0^(No quick orders available)');
     392      end;
     393
     394    FastAssign(FQuickItems, cboQuick.Items);
     395    if lvSelectionList.Items.Count > 0 then
     396      begin
     397        memOrder.Visible := true;
     398        cmdAccept.Visible := true;
     399      end;
    352400  finally
    353401    AList.Free;
    … …  
    375423procedure TfrmODBBank.SetupDialog(OrderAction: Integer; const ID: string);
    376424var
    377   tmpResp: TResponse;
     425  AnInstance, CurAdd: Integer;
     426  AResponse: TResponse;
     427  i, j, k, aTNS, aTNSDays, getTest, TestAdded: integer;
     428  aStr, aTestYes, aName, aTypeScreen, aSpecimen, aModifier, sub, sub1, x, aTNSString: string;
     429  ListItem: TListItem;
     430  aList: TStringList;
     431  aTests: TStringList;
     432begin
     433  inherited;
     434  aList := TStringList.Create;
     435  aTests:= TStringList.Create;
     436  try
     437  FOrderAction := OrderAction;
     438  ReadServerVariables;
     439  sub1 := '';
     440  aTypeScreen := '';
     441  aSpecimen := '^';
     442  aModifier := '';
     443  if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses, ALabTest do
     444    begin
     445      AnInstance := NextInstance('ORDERABLE', 0);
     446      while AnInstance > 0 do
     447        begin
     448          AResponse := FindResponseByName('ORDERABLE', AnInstance);
     449          if AResponse <> nil then
     450            begin
     451              sub := GetSubtype(AResponse.EValue);
     452              if sub = 't' then
     453                begin
     454                  SetControl(cboAvailTest,        'ORDERABLE', AnInstance);
     455                  ALabTest := TLabTest.Create(cboAvailTest.ItemID, Responses);
     456                end
     457              else
     458                begin
     459                  SetControl(cboAvailComp,        'ORDERABLE', AnInstance);
     460                  ALabTest := TLabTest.Create(cboAvailComp.ItemID, Responses);
     461                end;
     462              if ALabTest = nil then Exit;  // Causes access violation
     463              if AnInstance = 1 then
     464                begin
     465                  SetControl(cboReasons,         'REASON' , AnInstance);
     466                  SetControl(calWantTime,        'DATETIME', AnInstance);
     467                  SetControl(memDiagComment,     'COMMENT', AnInstance);
     468                  SetControl(chkConsent,         'YN', AnInstance);
     469                  //DetermineCollectionDefaults(Responses);
     470                  SetControl(cboCollType,        'COLLECT', AnInstance);
     471                  SetControl(cboCollTime,        'START', AnInstance);
     472                  SetupCollTimes(cboCollType.ItemID);
     473                  SetControl(cboUrgency,         'URGENCY', AnInstance);
     474                  SetControl(cboSurgery,         'MISC', AnInstance);
     475                  Urgency := cboUrgency.ItemIEN;
     476                  if (Urgency = 0) and (cboUrgency.Items.Count = 1) then
     477                    begin
     478                      cboUrgency.ItemIndex := 0;
     479                      Urgency := cboUrgency.ItemIEN;
     480                    end;
     481                  i := 1 ;
     482                  AResponse := Responses.FindResponseByName('COMMENT',i);
     483                  while AResponse <> nil do
     484                    begin
     485                      Comment.Add(AResponse.EValue);
     486                      Inc(i);
     487                      AResponse := Responses.FindResponseByName('COMMENT',i);
     488                    end ;
     489                end;
     490              if sub = 't' then with ALabTest do      //DIAGNOSTIC TEST
     491                begin
     492                  Changing := True;
     493                  DisableComponentControls;
     494                  EnableDiagTestControls;
     495                  LRORDERMODE := TORDER_MODE_DIAG;
     496                  aList.Clear;
     497                  aTestYes := '1';
     498                  ExtractTypeScreen(aList, uVBECList);
     499                  if aList.Count > 0 then aTypeScreen := aList[0];
     500                  aList.Clear;
     501                  with lvSelectionList do
     502                    begin
     503                      ListItem := Items.Add;
     504                      ListItem.Caption := piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',2);
     505                      ListItem.SubItems.Add('');
     506                      ListItem.SubItems.Add('');
     507                      ListItem.SubItems.Add('');
     508                      ListItem.SubItems.Add(piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1));
     509                      if piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1) = aTypeScreen then
     510                        begin
     511                          lblTNS.Caption := '';
     512                          lblTNS.Visible := false;
     513                          memMessage.Text := '';
     514                          pnlMessage.Visible := false;
     515                          uGetTnS := 0;
     516                          pnlDiagnosticTests.Caption := 'Diagnostic Tests';
     517                        end;
     518                    end;
     519                  aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + IntToStr(aLabTest.ItemID);  //aSpecimen has 2 pieces additional pieces added for Tests
     520                  uSelectedItems.Add(aStr);
     521                  if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
     522                  {with cboCollType do if Length(ItemID) > 0 then
     523                    begin
     524                      Responses.Update('COLLECT', 1, ItemID, ItemID) ;
     525                      FLastCollType := ItemID;
     526                    end;  }
     527                  if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
     528                  if Length(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
     529                  if Length(cboReasons.Text) > 0 then Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text);
     530                  LoadCollType(cboCollType);
     531                  if (cboCollType.ItemID = 'LC') or (cboCollType.ItemID = 'I') then
     532                    if not(ALabTest.LabCanCollect) and OrderForInpatient then
     533                      cboCollType.SelectByID('WC')
     534                    else if not(ALabTest.LabCanCollect) then
     535                      cboCollType.SelectByID('SP');
     536                  SetupCollTimes(cboCollType.ItemID);
     537                  if cboCollType.ItemID = 'LC' then
     538                    begin
     539                      with cboCollTime do
     540                        if Length(ItemID) > 0 then
     541                          begin
     542                            Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
     543                            FLastLabCollTime := ItemID + U + Text;
     544                          end
     545                        else if Length(Text) > 0 then
     546                          begin
     547                            Responses.Update('START', 1, ValidCollTime(Text), Text) ;
     548                            FLastLabCollTime := ValidCollTime(Text);
     549                          end;
     550                    end
     551                  else
     552                    begin
     553                      with calCollTime do
     554                        if FMDateTime > 0 then
     555                          begin
     556                            Responses.Update('START', 1, ValidCollTime(Text), Text);
     557                            FLastColltime := ValidCollTime(Text);
     558                          end
     559                        else
     560                          begin
     561                            Responses.Update('START', 1, '', '') ;
     562                            FLastCollTime := '';
     563                          end;
     564                    end;
     565                  with cboCollType do if Length(ItemID) > 0 then
     566                    begin
     567                      Responses.Update('COLLECT', 1, ItemID, ItemID) ;
     568                      FLastCollType := ItemID;
     569                    end;
     570                  //if Length(cboCollType.Text) > 0 then Responses.Update('COLLECT',1,cboCollType.ItemID,cboCollType.ItemID);
     571                  memOrder.Text := Responses.OrderText;
     572                  Changing := False;
     573                  if ObtainCollSamp then
     574                    begin
     575                      //For BloodBank orders, this condition should never occur
     576                    end
     577                  else
     578                    begin
     579                      with ALabTest do
     580                        with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
     581                          begin
     582                            x := '' ;
     583                            for i := 0 to WardComment.Count-1 do
     584                            x := x + WardComment.strings[i]+#13#10 ;
     585                            pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
     586                            OrderMessage(x) ;
     587                          end ;
     588                    end;
     589                end;
     590              if sub = 'c' then with ALabTest do  //COMPONENT
     591                begin
     592                  Changing := True;
     593                  DisableDiagTestControls;
     594                  EnableComponentControls;
     595                  aTestYes := '0';
     596                  LRORDERMODE := TORDER_MODE_COMP;
     597                  SetControl(cboModifiers,       'MODIFIER', AnInstance);
     598                  SetControl(tQuantity,          'QTY', AnInstance);
     599                  uComponentSelected := true;
     600                  aList.Clear;
     601                  TestAdded := 0;
     602                  getTest := 0;
     603                  ExtractTests(aList, uVBECList);   //Get Results associated with ordered components
     604                    for j := 0 to aList.Count - 1 do
     605                      begin
     606                        if StrToInt(piece(aList[j],'^',1)) = aLabTest.ItemID then
     607                          begin
     608                            if uTestsForResults.Count < 1 then getTest := 1;
     609                            for k := 0 to uTestsForResults.Count - 1 do
     610                              begin
     611                                if piece(uTestsForResults[k],'^',1) = piece(aList[j],'^',3) then
     612                                  begin
     613                                    getTest := 0;
     614                                    break;
     615                                  end
     616                                else getTest := 1;
     617                              end;
     618                            if getTest = 1 then
     619                              begin
     620                                uTestsForResults.Add(piece(aList[j],'^',3));
     621                                TestAdded := 1;
     622                              end;
     623                          end;
     624                      end;
     625                    if TestAdded = 1 then
     626                      begin
     627                        edtResults.Clear;
     628                        aTests.Clear;
     629                        GetPatientBloodResults(aTests, Patient.DFN, uTestsForResults);
     630                        QuickCopy(ATests,edtResults);
     631                        if edtResults.Lines.Count > 0 then TabResults.Caption := 'Lab Results Available'; //TabResults.ImageIndex := 1;
     632                        uRaw.Clear;
     633                        GetPatientBloodResultsRaw(uRaw, Patient.DFN, uTestsForResults);
     634                      end;
     635                    CurAdd := 1;
     636                    if uRaw.Count > 0 then
     637                    for j := 0 to uRaw.Count - 1 do
     638                      begin
     639                        if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));
     640                        Inc(CurAdd);
     641                      end;
     642                  with lvSelectionList do
     643                    begin
     644                      ListItem := Items.Add;
     645                      ListItem.Caption := piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2);
     646                      ListItem.SubItems.Add(tQuantity.Text);
     647                      if length(cboModifiers.ItemID) > 0 then
     648                        begin
     649                          ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]);
     650                          ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex));
     651                        end
     652                        else
     653                          begin
     654                            ListItem.SubItems.Add('');
     655                            ListItem.SubItems.Add('');
     656                          end;
     657                      ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
     658                    end;
     659                  aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + IntToStr(aLabTest.ItemID);  //aSpecimen has 2 pieces additional pieces added for Tests
     660                  uSelectedItems.Add(aStr);
     661                  memOrder.Text := Responses.OrderText;
     662                  Changing := False;
     663                end;
     664            end;
     665          StatusText('');
     666          AnInstance := NextInstance('ORDERABLE', AnInstance);
     667        end;  //while AnInstance - ORDERABLE
     668      DisableComponentControls;
     669      DisableDiagTestControls;
     670    end;
     671    CurAdd := 1;
     672    for i := 0 to uSelectedItems.Count - 1 do
     673      begin
     674        aName := lvSelectionList.Items[i].Caption;
     675        x := uSelectedItems[i];
     676        if piece(x,'^',1) = '1' then    //Diagnostic Test related fields
     677          begin
     678            if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
     679          end
     680        else
     681          begin
     682            if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
     683            if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3));
     684            if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), piece(x,'^',4));
     685            if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5));
     686            if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
     687            if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
     688            if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text)
     689              else
     690                begin
     691                  cboUrgency.ItemIndex := 1;
     692                  Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
     693                  cboUrgencyChange(self);
     694                end;
     695          end;
     696        Inc(CurAdd);
     697      end;
     698    for i := 0 to lvSelectionList.Items.Count - 1 do
     699      begin
     700        if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then
     701          begin
     702            if uTNSOrders.Count > 0 then
     703              begin
     704                for j := 0 to uTNSOrders.Count - 1 do
     705                  aTNSString := aTNSString + CRLF + uTNSOrders[j];
     706                with Application do
     707                  begin
     708                    NormalizeTopMosts;
     709                    aTNSDays := TNSDaysBack;
     710                    aTNS :=
     711                      MessageBox(PChar(aTNSString + CRLF + CRLF +
     712                                 'Do you wish to continue with this request for Type & Screen?'),
     713                                 PChar('Type & Screen Entered in Past ' + IntToStr(TNSDaysBack) + ' Days'),
     714                                 MB_YESNO);
     715                    RestoreTopMosts;
     716                    if aTNS = 7 then
     717                      begin
     718                        lvSelectionList.ItemIndex := i;
     719                        lvSelectionListClick(self);
     720                        btnRemoveClick(self);
     721                        break;
     722                      end;
     723                  end;
     724              end;
     725            break;
     726          end;
     727      end;
     728  {if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses, ALabTest do
     729    begin
     730      if OrderAction in [ORDER_QUICK, ORDER_EDIT] then uQuickInProcess := 1;
     731      AnInstance := NextInstance('ORDERABLE', 0);
     732      while AnInstance > 0 do
     733        begin
     734          AResponse := FindResponseByName('ORDERABLE', AnInstance);
     735          if AResponse <> nil then
     736            begin
     737              sub := GetSubtype(AResponse.EValue);
     738              if sub = 't' then
     739                begin
     740                  SetControl(cboAvailTest,        'ORDERABLE', AnInstance);
     741                  ALabTest := TLabTest.Create(cboAvailTest.ItemID, Responses);
     742                end
     743              else
     744                begin
     745                  SetControl(cboAvailComp,        'ORDERABLE', AnInstance);
     746                  ALabTest := TLabTest.Create(cboAvailComp.ItemID, Responses);
     747                end;
     748              //SetControl(cboTests,           'ORDERABLE', AnInstance);
     749              //ALabTest := TLabTest.Create(cboTests.ItemID, Responses);
     750              if ALabTest = nil then Exit;  // Causes access violation
     751              //sub := GetSubtype(ALabTest.TestName);
     752              if AnInstance = 1 then
     753                begin
     754                  DetermineCollectionDefaults(Responses);
     755                  SetControl(cboReasons,         'REASON', AnInstance);
     756                  SetControl(chkConsent,         'YN', AnInstance);
     757                  SetControl(cboSurgery,         'MISC', AnInstance);
     758                  //SetControl(cboCollType,        'COLLECT', AnInstance);
     759                  //SetControl(cboCollTime,        'START', AnInstance);
     760                  SetControl(calWantTime,        'DATETIME', AnInstance);
     761                  //LoadUrgency(cboCollType.ItemID, cboUrgency);
     762                  SetControl(cboUrgency,         'URGENCY', AnInstance);
     763                  Urgency := cboUrgency.ItemIEN;
     764                  if (Urgency = 0) and (cboUrgency.Items.Count = AnInstance) then
     765                    begin
     766                      cboUrgency.ItemIndex := 0;
     767                      Urgency := cboUrgency.ItemIEN;
     768                    end;
     769                  i := 1 ;
     770                  AResponse := Responses.FindResponseByName('COMMENT',i);
     771                  while AResponse <> nil do
     772                      begin
     773                        if Length(AResponse.Evalue) > 0 then
     774                          Comment.Add(AResponse.EValue);
     775                        Inc(i);
     776                        AResponse := Responses.FindResponseByName('COMMENT',i);
     777                      end ;
     778                end;
     779              if sub = 't' then with ALabTest do      //DIAGNOSTIC TEST
     780                begin
     781                  Changing := True;
     782                  DisableComponentControls;
     783                  EnableDiagTestControls;
     784                  LRORDERMODE := TORDER_MODE_DIAG;
     785                  with Responses do
     786                    begin
     787                      StatusText('Initializing Order');
     788                      AResponse := FindResponseByName('ORDERABLE', AnInstance);
     789                      if AResponse <> nil then
     790                        sub1 := GetSubtype(AResponse.EValue);
     791                      if sub1 = 't' then
     792                        begin
     793                          SetControl(cboAvailTest,       'ORDERABLE', AnInstance);
     794                          //SetControl(cboTests,           'ORDERABLE', AnInstance);
     795                          //DetermineCollectionDefaults(Responses);   //cboCollType = COLLECT , calCollTime = START
     796                          cboAvailTestSelect(self);
     797                        end;
     798                    end;
     799                  Changing := False;
     800                  if ObtainCollSamp then
     801                    begin
     802                      //For BloodBank orders, this condition should never occur
     803                    end
     804                  else
     805                    begin
     806                      with ALabTest do
     807                        with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
     808                          begin
     809                            x := '' ;
     810                            for i := 0 to WardComment.Count-1 do
     811                            x := x + WardComment.strings[i]+#13#10 ;
     812                            pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
     813                            OrderMessage(x) ;
     814                          end ;
     815                    end;
     816                end;
     817              if sub = 'c' then with ALabTest do  //COMPONENT
     818                begin
     819                  Changing := True;
     820                  DisableDiagTestControls;
     821                  EnableComponentControls;
     822                  LRORDERMODE := TORDER_MODE_COMP;
     823                  with Responses do
     824                    begin
     825                      StatusText('Initializing Order');
     826                      AResponse := FindResponseByName('ORDERABLE', AnInstance);
     827                      if AResponse <> nil then
     828                        sub1 := GetSubtype(AResponse.EValue);
     829                      if sub1 = 'c' then
     830                        begin
     831                          SetControl(cboAvailComp,       'ORDERABLE', AnInstance);
     832                          //SetControl(cboTests,           'ORDERABLE', AnInstance);
     833                          SetControl(cboModifiers,       'MODIFIER', AnInstance);
     834                          SetControl(tQuantity,          'QTY', AnInstance);
     835                          //DetermineCollectionDefaults(Responses);
     836                          cboAvailCompSelect(self);
     837                        end;
     838                    end;
     839                  Changing := False;
     840                end;
     841              with ALabTest do
     842                begin
     843                  if ObtainComment then
     844                    LoadRequiredComment(FCmtTypes.IndexOf(CurReqComment))
     845                  else
     846                    DisableCommentPanels;
     847                  x := '' ;
     848                  for i := 0 to CurWardComment.Count-1 do
     849                    x := x + CurWardComment.strings[i]+#13#10 ;
     850                  i :=  IndexOfCollSamp(CollSamp);
     851                  if i > -1 then with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
     852                    for i := 0 to WardComment.Count-1 do
     853                      x := x + WardComment.strings[i]+#13#10 ;
     854                  pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
     855                  if Length(x) > 0 then
     856                    begin
     857                      OrderMessage(x) ;
     858                    end;
     859                end;
     860              StatusText('');
     861              Changing := True;
     862              //if not(FOrderAction = ORDER_EDIT) then DetermineCollectionDefaults(Responses);
     863              Changing := False;
     864            end;
     865          AnInstance := NextInstance('ORDERABLE', AnInstance);
     866        end; //while AnInstance - ORDERABLE
     867      DisableComponentControls;
     868      DisableDiagTestControls;
     869      uQuickInProcess := 0;
     870    end;  }
     871  finally
     872    aList.Free;
     873    aTests.Free;
     874  end;
     875  edtResults.Height := 247;
     876  edtInfo.Height := 247;
     877  if lvSelectionList.Items.Count > 0 then
     878    begin
     879      pnlSelectedTests.Visible := True;
     880      cmdAccept.Visible := True;
     881      memOrder.Visible := True;
     882      GroupBox1.Visible := False;
     883    end;
     884end;
     885
     886procedure TfrmODBBank.SetOnQuickOrder;
     887  var
     888  AnInstance: Integer;
     889  AResponse: TResponse;
    378890  i: integer;
     891  x,sub,sub1,aTNSString: string;
     892  aList: TStringList;
     893  aGotIt: boolean;
     894  aTests: TStringList;
     895  ListItem: TListItem;
     896  aName, aMsg, aStr, aModifier, aReason, aSurgery, aCollTime, aTestYes, aSpecimen, aTypeScreen: String;
     897  CurAdd, j, k, getTest, TestAdded, aMSBOS, aMSBOSContinue, aTNS, aTNSDays: Integer;
    379898begin
    380899  inherited;
    381   ReadServerVariables;
    382   if LRFZX <> '' then
    383     begin
    384       cboCollType.SelectByID(LRFZX);
    385       if cboCollType.ItemIndex > -1 then SetupCollTimes(LRFZX);
    386     end;
    387   if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses, ALabTest do
    388    begin
    389       SetControl(cboAvailTest,       'ORDERABLE', 1);
    390       cboAvailTestSelect(Self);
    391       if ALabTest = nil then Exit;  // Causes access violation in FillCollSampleList
    392       Changing := True;
    393       DetermineCollectionDefaults(Responses);
    394       i := 1 ;
    395       tmpResp := Responses.FindResponseByName('COMMENT',i);
    396       while tmpResp <> nil do
    397         begin
    398           Comment.Add(tmpResp.EValue);
    399           Inc(i);
    400           tmpResp := Responses.FindResponseByName('COMMENT',i);
    401         end ;
    402       Changing := False;
    403    end;
     900  aList := TStringList.Create;
     901  aTests := TStringList.Create;
     902  try
     903    aModifier := '';
     904    aReason := '';
     905    aSurgery := '';
     906    aCollTime := '';
     907    aTestYes := '0';
     908    aTypeScreen := '';
     909    aSpecimen := '';
     910    sub1 := '';
     911    ExtractTypeScreen(aList, uVBECList);
     912    if aList.Count > 0 then aTypeScreen := aList[0];
     913    aList.Clear;
     914    Extractspecimen(aList, uVBECList);
     915    if aList.Count > 0 then aSpecimen := aList[0];
     916    with Responses, ALabTest do
     917      begin
     918        Changing := True;
     919        aGotIt := False;
     920        FLastItemID := cboQuick.ItemID;
     921        QuickOrder := ExtractInteger(cboQuick.ItemID);
     922        with Responses do
     923          begin
     924            StatusText('Initializing Quick Order');
     925            AnInstance := NextInstance('ORDERABLE', 0);
     926            while AnInstance > 0 do
     927              begin
     928                AResponse := FindResponseByName('ORDERABLE', AnInstance);
     929                sub := GetSubtype(AResponse.EValue);
     930                if sub = 't' then
     931                  begin
     932                    SetControl(cboAvailTest,        'ORDERABLE', AnInstance);
     933                    ALabTest := TLabTest.Create(cboAvailTest.ItemID, Responses);
     934                  end
     935                else
     936                  begin
     937                    SetControl(cboAvailComp,        'ORDERABLE', AnInstance);
     938                    ALabTest := TLabTest.Create(cboAvailComp.ItemID, Responses);
     939                  end;
     940                for i := 0 to aList.Count - 1 do
     941                  if aList[i] = ALabTest.TestName then
     942                    begin
     943                      aGotIt := true;
     944                      break;
     945                    end;
     946                if aGotIt = true then
     947                  begin
     948                    aGotIt := false;
     949                    AnInstance := NextInstance('ORDERABLE', AnInstance);
     950                    Continue;
     951                  end
     952                  else
     953                    begin
     954                      aList.Add(ALabTest.TestName);
     955                    end;
     956                if AResponse <> nil then
     957                  sub1 := GetSubtype(AResponse.EValue);
     958                if AnInstance = 1 then
     959                  begin
     960                    SetControl(cboReasons,         'REASON', AnInstance);
     961                    SetControl(calWantTime,        'DATETIME', AnInstance);
     962                    SetControl(memDiagComment,     'COMMENT', AnInstance);
     963                    SetControl(chkConsent,         'YN', AnInstance);
     964                    //DetermineCollectionDefaults(Responses);
     965                    SetControl(cboCollType,        'COLLECT', AnInstance);
     966                    SetupCollTimes(cboCollType.ItemID);
     967                    //SetControl(cboCollTime,        'START', AnInstance);
     968                    //LoadUrgency(cboCollType.ItemID, cboUrgency);
     969                    SetControl(cboUrgency,         'URGENCY', AnInstance);
     970                    Urgency := cboUrgency.ItemIEN;
     971                    if (Urgency = 0) and (cboUrgency.Items.Count = AnInstance) then
     972                      begin
     973                        cboUrgency.ItemIndex := 0;
     974                        Urgency := cboUrgency.ItemIEN;
     975                        cboUrgencyChange(self);
     976                      end;
     977                    SetControl(cboSurgery,         'MISC', AnInstance);
     978                    if not(ALabTest = nil) then
     979                      begin
     980                        Urgency := cboUrgency.ItemIEN;
     981                        if (Urgency = 0) and (cboUrgency.Items.Count = 1) then
     982                          begin
     983                            cboUrgency.ItemIndex := 0;
     984                            Urgency := cboUrgency.ItemIEN;
     985                          end;
     986                        i := 1 ;
     987                        AResponse := Responses.FindResponseByName('COMMENT',i);
     988                        while AResponse <> nil do
     989                          begin
     990                            Comment.Add(AResponse.EValue);
     991                            Inc(i);
     992                            AResponse := Responses.FindResponseByName('COMMENT',i);
     993                          end ;
     994                      end;
     995                    if not(cboCollType.ItemID = 'LC') then
     996                      begin
     997                        if Length(cboCollTime.Text) > 0 then
     998                          begin
     999                            calCollTime.FMDateTime := StrToFMDateTime(cboCollTime.Text);
     1000                            FLastCollTime := cboCollTime.Text;
     1001                          end
     1002                        else
     1003                          begin
     1004                            FLastCollTime := '';
     1005                          end;
     1006                      end;
     1007                  end;
     1008                if sub1 = 'c' then
     1009                  begin
     1010                    DisableDiagTestControls;
     1011                    EnableComponentControls;
     1012                    LRORDERMODE := TORDER_MODE_COMP;
     1013                    SetControl(cboAvailComp,       'ORDERABLE', AnInstance);
     1014                    SetControl(cboModifiers,       'MODIFIER', AnInstance);
     1015                    SetControl(tQuantity,          'QTY', AnInstance);
     1016                    //DetermineCollectionDefaults(Responses);
     1017                    //Check for and display any associated Lab Results
     1018                    aList.Clear;
     1019                    TestAdded := 0;
     1020                    getTest := 0;
     1021                    ExtractTests(aList, uVBECList);   //Get Results associated with ordered components
     1022                      for j := 0 to aList.Count - 1 do
     1023                        begin
     1024                          if StrToInt(piece(aList[j],'^',1)) = aLabTest.ItemID then
     1025                            begin
     1026                              if uTestsForResults.Count < 1 then getTest := 1;
     1027                              for k := 0 to uTestsForResults.Count - 1 do
     1028                                begin
     1029                                  if piece(uTestsForResults[k],'^',1) = piece(aList[j],'^',3) then
     1030                                    begin
     1031                                      getTest := 0;
     1032                                      break;
     1033                                    end
     1034                                  else getTest := 1;
     1035                                end;
     1036                              if getTest = 1 then
     1037                                begin
     1038                                  uTestsForResults.Add(piece(aList[j],'^',3));
     1039                                  TestAdded := 1;
     1040                                end;
     1041                            end;
     1042                        end;
     1043                      if TestAdded = 1 then
     1044                        begin
     1045                          edtResults.Clear;
     1046                          aTests.Clear;
     1047                          GetPatientBloodResults(aTests, Patient.DFN, uTestsForResults);
     1048                          QuickCopy(ATests,edtResults);
     1049                          if edtResults.Lines.Count > 0 then TabResults.Caption := 'Lab Results Available'; //TabResults.ImageIndex := 1;
     1050                          uRaw.Clear;
     1051                          GetPatientBloodResultsRaw(uRaw, Patient.DFN, uTestsForResults);
     1052                        end;
     1053                      CurAdd := 1;
     1054                      if uRaw.Count > 0 then
     1055                      for j := 0 to uRaw.Count - 1 do
     1056                        begin
     1057                          if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));
     1058                          Inc(CurAdd);
     1059                        end;
     1060                    aSpecimen := '^';
     1061                    aTestYes := '0';
     1062                    aReason := '';
     1063                    aSurgery := '';
     1064                    aCollTime := '';
     1065                    ExtractSpecimen(aList, uVBECList);
     1066                    if aList.Count > 0 then aSpecimen := aList[0];
     1067                    if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex];
     1068                    if length(cboReasons.ItemID) > 0 then aReason := cboReasons.Items[cboReasons.ItemIndex];
     1069                    if length(cboSurgery.ItemID) > 0 then aSurgery := cboSurgery.Items[cboSurgery.ItemIndex];
     1070                    if length(cboCollTime.ItemID) > 0 then aCollTime := cboCollTime.Items[cboCollTime.ItemIndex];
     1071                    if Length(cboSurgery.ItemID) > 0 then
     1072                      begin
     1073                        aList.Clear;
     1074                        ExtractMSBOS(aList, uVBECList);    //Get maximum units for selected Surgey
     1075                        for i := 0 to aList.Count - 1 do
     1076                          begin
     1077                            if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
     1078                             and (piece(aList[i],'^',3) = cboSurgery.Text) then
     1079                              begin
     1080                                aMSBOS := StrToInt(piece(aList[i],'^',4));
     1081                                if (aMSBOS > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then
     1082                                  begin
     1083                                    with Application do
     1084                                    begin
     1085                                      NormalizeTopMosts;
     1086                                      aMSBOSContinue :=
     1087                                        MessageBox(PChar('The number of units ordered (' + tQuantity.Text +
     1088                                                   ') for ' + aLabTest.TestName + ' exceeds the maximum number of units ('
     1089                                                   + IntToStr(aMSBOS) +
     1090                                                   ') for the ' + cboSurgery.text +
     1091                                                   ' surgical procedure selected.' + CRLF + CRLF + 'Do you wish to continue?'),
     1092                                                   PChar('Maximum Number of Units Exceeded'),
     1093                                                   MB_YESNO);
     1094                                      RestoreTopMosts;
     1095                                    end;
     1096                                    if aMSBOSContinue = 7 then
     1097                                      begin
     1098                                        ShowMsg(cboAvailComp.Text + ' has NOT been added to this request.');
     1099                                        exit;
     1100                                      end;
     1101                                  end;
     1102                              end;
     1103                          end;
     1104                      end;
     1105                    if (uTNSOrders.Count < 1) then //SpecimenNeeded(aList, uVBECList, aLabTest.ItemID) then  //check to see if type and screen is needed
     1106                      begin
     1107                        uGetTnS := 1;
     1108                      end;
     1109                    aList.Clear;
     1110                    ExtractSpecimens(aList, uVBECList);    //Get specimen values to pass back to Server
     1111                    for i := 0 to aList.Count - 1 do
     1112                      begin
     1113                        if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) then
     1114                          begin
     1115                            aSpecimen := piece(aList[i],'^',2) + '^' + aSpecimen;
     1116                            break;
     1117                          end;
     1118                      end;
     1119                    uComponentSelected := true;
     1120                    with lvSelectionList do
     1121                      begin
     1122                        ListItem := Items.Add;
     1123                        ListItem.Caption := piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2);
     1124                        ListItem.SubItems.Add(tQuantity.Text);
     1125                        if length(cboModifiers.ItemID) > 0 then
     1126                          begin
     1127                            ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]);
     1128                            ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex));
     1129                          end
     1130                          else
     1131                            begin
     1132                              ListItem.SubItems.Add('');
     1133                              ListItem.SubItems.Add('');
     1134                            end;
     1135                        ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
     1136                      end;
     1137                    CurAdd := 1;
     1138                    aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + IntToStr(aLabTest.ItemID);  //aSpecimen has 2 pieces additional pieces added for Tests
     1139                    uSelectedItems.Add(aStr);
     1140                    for i := 0 to uSelectedItems.Count - 1 do
     1141                      begin
     1142                        aName := lvSelectionList.Items[i].Caption;
     1143                        x := uSelectedItems[i];
     1144                        if piece(x,'^',1) = '1' then    //Diagnostic Test related fields
     1145                          begin
     1146                            if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
     1147                          end
     1148                        else
     1149                          begin
     1150                            if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
     1151                            if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3));
     1152                            if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), aModifier);
     1153                            if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5));
     1154                            if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
     1155                          end;
     1156                        Inc(CurAdd);
     1157                      end;
     1158                    memOrder.Text := Responses.OrderText;
     1159                    GroupBox1.Visible := False;
     1160                  aMsg := '';
     1161                  LRORDERMODE := TORDER_MODE_INFO;
     1162                  {if uGetTnS = 1 then
     1163                    begin
     1164                      lblTNS.Caption := 'TYPE + SCREEN must be added to order';
     1165                      lblTNS.Visible := true;
     1166                      memMessage.Text := 'TYPE + SCREEN must be added to order';
     1167                      memMessage.Visible := false;
     1168                      pnlMessage.Visible := true;
     1169                      pnlDiagnosticTests.Caption := 'Diagnostic Tests*';
     1170                    end;  }
     1171                  {if uGetTnS = 1 then
     1172                    begin
     1173                      if responses.QuickOrder < 1 then
     1174                        begin
     1175                          for i := 1 to cboAvailTest.Items.Count - 1 do
     1176                            begin
     1177                              if piece(cboAvailTest.Items[i],'^',1) = aTypeScreen then
     1178                                begin
     1179                                  if piece(aSpecimen,'^',1) = '1' then
     1180                                    begin
     1181                                      cboCollTime.Text := calWantTime.Text;
     1182                                      aCollSave := cboCollTime.Text + '^' + cboCollTime.ItemID + '^' + cboCollType.Text + '^' + cboCollType.ItemID;
     1183                                      cboCollTime.Text := '';
     1184                                      cboCollType.Text := '';
     1185                                      uSpecimen := 1;
     1186                                    end;
     1187                                  cboModifiers.Text := '';
     1188                                  cboAvailTest.SelectByID(aTypeScreen);
     1189                                  cboTests.SelectByID(aTypeScreen);
     1190                                  cboTestsClick(self);
     1191                                  //cboAvailTestSelect(Self);
     1192                                  uSpecimen := 0;
     1193                                  cboCollTime.Text := piece(aCollSave,'^',1);
     1194                                  cboCollType.Text := piece(aCollSave,'^',3);
     1195                                  aCollSave := '';
     1196                                  break;
     1197                                end;
     1198                            end;
     1199                          aMsg := 'An order for Type and Screen has been added to this request' + '.';
     1200                        end
     1201                        else
     1202                          begin
     1203                            lblTNS.Caption := 'TYPE + SCREEN must be added to order';
     1204                            lblTNS.Visible := true;
     1205                            memMessage.Text := 'TYPE + SCREEN must be added to order';
     1206                            memMessage.Visible := false;
     1207                            pnlMessage.Visible := true;
     1208                          end;
     1209                    end;
     1210                  if (uGetTnS = 1) then
     1211                    begin
     1212                      if length(aMsg) > 0 then aMsg := aMsg + crlf + crlf;
     1213                      ShowMsg(aMsg);
     1214                    end;  }
     1215
     1216                  //cboModifiers.Text := '';
     1217                  edtResults.Height := 247;
     1218                  edtInfo.Height := 247;
     1219                  if lvSelectionList.Items.Count > 0 then
     1220                    begin
     1221                      pnlSelectedTests.Visible := True;
     1222                      cmdAccept.Visible := True;
     1223                      memOrder.Visible := True;
     1224                      GroupBox1.Visible := False;
     1225                    end;
     1226                  end
     1227                  else
     1228                    begin
     1229                      if sub1 = 't' then
     1230                      begin
     1231                        DisableComponentControls;
     1232                        EnableDiagTestControls;
     1233                        LRORDERMODE := TORDER_MODE_DIAG;
     1234                        aTestYes := '1';
     1235                        SetControl(cboAvailTest,       'ORDERABLE', AnInstance);
     1236                        //DetermineCollectionDefaults(Responses);   //cboCollType = COLLECT , calCollTime = START
     1237                        i := 1 ;
     1238                        AResponse := Responses.FindResponseByName('COMMENT',i);
     1239                        while AResponse <> nil do
     1240                          begin
     1241                            Comment.Add(AResponse.EValue);
     1242                            Inc(i);
     1243                            AResponse := Responses.FindResponseByName('COMMENT',i);
     1244                          end ;
     1245                        if ObtainCollSamp then
     1246                          begin
     1247                          //For BloodBank orders, this condition should never occur
     1248                          end
     1249                        else
     1250                          begin
     1251                            with ALabTest do
     1252                              with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
     1253                                begin
     1254                                  x := '' ;
     1255                                  for i := 0 to WardComment.Count-1 do
     1256                                  x := x + WardComment.strings[i]+#13#10 ;
     1257                                  pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
     1258                                  OrderMessage(x) ;
     1259                                end ;
     1260                          end;
     1261                        if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
     1262                        with cboCollType do if Length(ItemID) > 0 then
     1263                          begin
     1264                            Responses.Update('COLLECT', 1, ItemID, ItemID) ;
     1265                            FLastCollType := ItemID;
     1266                          end;
     1267                        if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text)
     1268                          else
     1269                            begin
     1270                              cboUrgency.ItemIndex := 1;
     1271                              Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
     1272                              cboUrgencyChange(self);
     1273                            end;
     1274                        if Length(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
     1275                        if Length(cboReasons.Text) > 0 then Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text);
     1276                        LoadCollType(cboCollType);
     1277                        if (cboCollType.ItemID = 'LC') or (cboCollType.ItemID = 'I') then
     1278                          if not(ALabTest.LabCanCollect) and OrderForInpatient then
     1279                            cboCollType.SelectByID('WC')
     1280                          else if not(ALabTest.LabCanCollect) then
     1281                            cboCollType.SelectByID('SP');
     1282                        SetupCollTimes(cboCollType.ItemID);
     1283                        if cboCollType.ItemID = 'LC' then
     1284                          begin
     1285                            with cboCollTime do
     1286                              if Length(ItemID) > 0 then
     1287                                begin
     1288                                  Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
     1289                                  FLastLabCollTime := ItemID + U + Text;
     1290                                end
     1291                              else if Length(Text) > 0 then
     1292                                begin
     1293                                  Responses.Update('START', 1, ValidCollTime(Text), Text) ;
     1294                                  FLastLabCollTime := ValidCollTime(Text);
     1295                                end;
     1296                          end
     1297                        else
     1298                          begin
     1299                            with calCollTime do
     1300                              if FMDateTime > 0 then
     1301                                begin
     1302                                  Responses.Update('START', 1, ValidCollTime(Text), Text);
     1303                                  FLastColltime := ValidCollTime(Text);
     1304                                end
     1305                              else
     1306                                begin
     1307                                  Responses.Update('START', 1, '', '') ;
     1308                                  FLastCollTime := '';
     1309                                end;
     1310                          end;
     1311                        if length(cboCollTime.ItemID) > 0 then aCollTime := cboCollTime.Items[cboCollTime.ItemIndex];
     1312                        with cboCollType do if Length(ItemID) > 0 then
     1313                          begin
     1314                            Responses.Update('COLLECT', 1, ItemID, ItemID) ;
     1315                            FLastCollType := ItemID;
     1316                          end;
     1317                        uTestSelected := true;
     1318                        with lvSelectionList do
     1319                          begin
     1320                            ListItem := Items.Add;
     1321                            ListItem.Caption := piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',2);
     1322                            ListItem.SubItems.Add('');
     1323                            ListItem.SubItems.Add('');
     1324                            ListItem.SubItems.Add('');
     1325                            ListItem.SubItems.Add(piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1));
     1326                          end;
     1327                        CurAdd := 1;
     1328                        aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + aCollTime + '^' + cboCollType.Text + '^' + IntToStr(aLabTest.ItemID);  //aSpecimen has 2 pieces
     1329                        uSelectedItems.Add(aStr);
     1330                        for i := 0 to uSelectedItems.Count - 1 do
     1331                          begin
     1332                            aName := lvSelectionList.Items[i].Caption;
     1333                            x := uSelectedItems[i];
     1334                            if piece(x,'^',1) = '1' then    //Diagnostic Test related fields
     1335                              begin
     1336                                if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
     1337                              end;
     1338                            Inc(CurAdd);
     1339                          end;
     1340                        memOrder.Text := Responses.OrderText;
     1341                      edtResults.Height := 247;
     1342                      edtInfo.Height := 247;
     1343                      if lvSelectionList.Items.Count > 0 then
     1344                        begin
     1345                          pnlSelectedTests.Visible := True;
     1346                          cmdAccept.Visible := True;
     1347                          memOrder.Visible := True;
     1348                          GroupBox1.Visible := False;
     1349                        end;
     1350                      end;
     1351                    end;
     1352                  AnInstance := NextInstance('ORDERABLE', AnInstance);
     1353              end;
     1354              //Quick Order
     1355          end;
     1356        for i := 0 to lvSelectionList.Items.Count - 1 do
     1357          begin
     1358            if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then
     1359              begin
     1360                uGetTnS := 0;
     1361                uDfltUrgency := cboUrgency.ItemID;
     1362                lblTNS.Caption := '';
     1363                lblTNS.Visible := false;
     1364                memMessage.Text := '';
     1365                pnlMessage.Visible := false;
     1366                pnlDiagnosticTests.Caption := 'Diagnostic Tests';
     1367                if uTNSOrders.Count > 0 then
     1368                  begin
     1369                    for j := 0 to uTNSOrders.Count - 1 do
     1370                      aTNSString := aTNSString + CRLF + uTNSOrders[j];
     1371                    with Application do
     1372                      begin
     1373                        NormalizeTopMosts;
     1374                        aTNSDays := TNSDaysBack;
     1375                        aTNS :=
     1376                          MessageBox(PChar(aTNSString + CRLF + CRLF +
     1377                                     'Do you wish to continue with this request for Type & Screen?'),
     1378                                     PChar('Type & Screen Entered in Past ' + IntToStr(TNSDaysBack) + ' Days'),
     1379                                     MB_YESNO);
     1380                        RestoreTopMosts;
     1381                        if aTNS = 7 then
     1382                          begin
     1383                            lvSelectionList.ItemIndex := i;
     1384                            lvSelectionListClick(self);
     1385                            btnRemoveClick(self);
     1386                            break;
     1387                          end;
     1388                      end;
     1389                  end;
     1390                break;
     1391              end;
     1392          end;
     1393        if uGetTnS = 1 then
     1394          begin
     1395            lblTNS.Caption := 'TYPE + SCREEN must be added to order';
     1396            lblTNS.Visible := true;
     1397            memMessage.Text := 'TYPE + SCREEN must be added to order';
     1398            pnlMessage.Visible := true;
     1399            pnlDiagnosticTests.Caption := 'Diagnostic Tests*';
     1400          end;
     1401        if ALabTest <> nil then
     1402          begin
     1403            if ObtainCollSamp then
     1404              begin
     1405               //For BloodBank orders, this condition should never occur
     1406              end
     1407            else
     1408              begin
     1409                with ALabTest do
     1410                  with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
     1411                    begin
     1412                      x := '' ;
     1413                      for i := 0 to WardComment.Count-1 do
     1414                      x := x + WardComment.strings[i]+#13#10 ;
     1415                      pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
     1416                      OrderMessage(x) ;
     1417                    end ;
     1418              end;
     1419            with ALabTest do
     1420              begin
     1421                if ObtainComment then
     1422                  LoadRequiredComment(FCmtTypes.IndexOf(CurReqComment))
     1423                else
     1424                  DisableCommentPanels;
     1425                x := '' ;
     1426                for i := 0 to CurWardComment.Count-1 do
     1427                  x := x + CurWardComment.strings[i]+#13#10 ;
     1428                i :=  IndexOfCollSamp(CollSamp);
     1429                if i > -1 then with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
     1430                  for i := 0 to WardComment.Count-1 do
     1431                    x := x + WardComment.strings[i]+#13#10 ;
     1432                pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
     1433                OrderMessage(x) ;
     1434              end;
     1435            GroupBox1.Visible := False;
     1436          end;
     1437        StatusText('');
     1438        Changing := False;
     1439      end;
     1440  finally                      //**SubTest
     1441    alist.Free;
     1442    aTests.Free;
     1443  end;
    4041444end;
    4051445
    … …  
    4221462      LabSubscript := Piece(ExtractDefault(LoadData, 'Item ID'),U,2);
    4231463      TestReqComment := ExtractDefault(LoadData, 'ReqCom');
     1464      UniqueCollSamp := false;
    4241465      if Length(ExtractDefault(LoadData, 'Unique CollSamp')) > 0 then UniqueCollSamp := True;
    4251466      x := ExtractDefault(LoadData, 'Unique CollSamp');
    … …  
    4311472      ExtractItems(SpecimenList, LoadData, 'Specimens');
    4321473      if LRFSPEC <> '' then SpecimenList.Add(GetOneSpecimen(StrToInt(LRFSPEC)));
     1474      UrgencyList := TStringList.Create;
     1475      if Length(ExtractDefault(LoadData, 'Default Urgency')) > 0 then  { forced urgency }
     1476        begin
     1477          ForceUrgency := True;
     1478          UrgencyList.Add(ExtractDefault(LoadData, 'Default Urgency'));
     1479          Urgency := StrToInt(Piece(ExtractDefault(LoadData, 'Default Urgency'), '^', 1));
     1480          uDfltUrgency := Urgency;
     1481        end
     1482      else
     1483        begin                 { list of urgencies }
     1484          ExtractItems(UrgencyList, LoadData, 'Urgencies');
     1485          if StrToIntDef(LRFURG, 0) > 0 then
     1486            Urgency := StrToInt(LRFURG)
     1487          else
     1488            Urgency := uDfltUrgency;
     1489        end;
    4331490      Comment := TStringList.Create ;
    4341491      CurWardComment := TStringList.Create;
    … …  
    4431500          OneSamp := TStringList.Create;
    4441501          try
    445             OneSamp.Assign(GetOneCollSamp(StrToInt(LRFSAMP)));
     1502            FastAssign(GetOneCollSamp(StrToInt(LRFSAMP)), OneSamp);
    4461503            FillCollSampList(OneSamp, CollSampList.Count);
    4471504          finally
    … …  
    4711528  CollSampList.Free;
    4721529  SpecimenList.Free;
     1530  UrgencyList.Free;
    4731531  CurWardComment.Free;
    4741532  Comment.Free;
    … …  
    6311689    begin
    6321690      if SpecimenList.Count = 0 then LoadSpecimens(SpecimenList) ;
    633       AComboBox.Items.Assign(SpecimenList);
     1691      FastAssign(SpecimenList, AComboBox.Items);
    6341692      AComboBox.Items.Add('0^Other...');
    6351693      with QuickOrderResponses do tmpResp := FindResponseByName('SPECIMEN'  ,1);
    … …  
    6591717end;
    6601718
     1719procedure TLabTest.LoadUrgency(CollType: string; AComboBox:TORComboBox);
     1720var
     1721  i: integer;
     1722begin
     1723  if UrgencyList.Count < 1 then Exit;
     1724  with AComboBox do
     1725    begin
     1726      Clear;
     1727      for i := 0 to UrgencyList.Count - 1 do
     1728         if (CollType = 'LC') and (Piece(UrgencyList[i], U, 3) = '') then
     1729           Continue
     1730         else
     1731           Items.Add(UrgencyList[i]);
     1732      if (LRFURG <> '') and (ALabTest.ObtainUrgency) then
     1733        SelectByID(LRFURG)
     1734      else
     1735        SelectByIEN(uDfltUrgency);
     1736      Urgency := AComboBox.ItemIEN;
     1737    end;
     1738end;
     1739
    6611740function TLabTest.NameOfCollSamp: string;
    6621741var
    … …  
    6831762end;
    6841763
     1764function TLabTest.NameOfUrgency: string;
     1765var
     1766  i: Integer;
     1767begin
     1768  Result := '';
     1769  with UrgencyList do for i := 0 to Count - 1 do
     1770  begin
     1771    if StrToInt(Piece(Strings[i], '^', 1)) = Urgency
     1772      then Result := Piece(Strings[i], '^', 2);
     1773    break;
     1774  end;
     1775end;
     1776
    6851777function TLabTest.ObtainCollSamp: Boolean;
    6861778begin
    … …  
    6981790end;
    6991791
     1792function TLabTest.ObtainUrgency: Boolean;
     1793begin
     1794  Result := not ForceUrgency;
     1795end;
     1796
    7001797function TLabTest.ObtainComment: Boolean;
    7011798begin
    … …  
    7081805end;
    7091806
     1807procedure TfrmODBBank.ExtractReasons(OutList:TStrings; AList:TStrings);
     1808begin
     1809  ExtractItems(Outlist, AList,'REASONS');
     1810end;
     1811
    7101812procedure TfrmODBBank.ExtractUrgencies(OutList:TStrings; AList:TStrings);
    7111813begin
    … …  
    7131815end;
    7141816
     1817procedure TfrmODBBank.ExtractTNSOrders(OutList:TStrings; AList:TStrings);
     1818begin
     1819  ExtractItems(Outlist, AList,'TNS ORDERS');
     1820end;
     1821
    7151822procedure TfrmODBBank.ExtractSurgeries(OutList:TStrings; AList:TStrings);
    7161823begin
    … …  
    7261833begin
    7271834  ExtractItems(OutList, AList, 'TYPE AND SCREEN');
     1835end;
     1836
     1837procedure TfrmODBBank.ExtractOther(OutList:TStrings; AList:TStrings);
     1838begin
     1839  ExtractItems(OutList, AList, 'OTHER');
    7281840end;
    7291841
    … …  
    8131925  inherited;
    8141926  if uSelectedItems.Count < 1 then
    815     SetError(TX_NO_TESTS);
     1927    begin
     1928      SetError(TX_NO_TESTS);
     1929      Exit;
     1930    end;
    8161931  if uGetTns = 1 then
    817     SetError(TX_TNS_REQUIRED);
     1932    begin
     1933      SetError(TX_TNS_REQUIRED);
     1934      Exit;
     1935    end;
     1936  ValidateAdd(AnErrMsg);
    8181937end;
    8191938
    … …  
    8271946
    8281947var
    829   i, CmtType, DaysofFuturePast: integer;
     1948  aList: TStringList;
     1949  i, DaysofFuturePast: integer;
    8301950  d1, d2: TDateTime;
    831   x: string;
     1951  x,test,aOther: string;
    8321952const
    8331953  {Diagnostic Test Errors}
    834   TX_NO_TIME        = 'Collection Time is required.' ;
    835   TX_NO_TCOLLTYPE   = 'Collection Type is required.' ;
    836   TX_NO_TESTS       = 'A Lab Test or tests must be selected.' ;
     1954  TX_NO_TIME        = 'Collection Time is required' ;
     1955  TX_NO_TCOLLTYPE   = 'Collection Type is required' ;
     1956  TX_NO_TESTS       = 'A Lab Test or tests must be selected' ;
    8371957  TX_BAD_TIME       = 'Collection times must be chosen from the drop down list or entered as valid' +
    838                       ' Fileman date/times (T@1700, T+1@0800, etc.).' ;
    839   TX_PAST_TIME      = 'Collection times in the past are not allowed.';
    840   TX_NO_DAYS        = 'A number of days must be entered for continuous orders.';
    841   TX_NO_TIMES       = 'A number of times must be entered for continuous orders.';
    842   TX_NO_STOP_DATE   = 'Could not calculate the stop date for the order.  Check "for n Days".';
     1958                      ' Fileman date/times (T@1700, T+1@0800, etc.)' ;
     1959  TX_PAST_TIME      = 'Collection times in the past are not allowed';
     1960  TX_NO_DAYS        = 'A number of days must be entered for continuous orders';
     1961  TX_NO_TIMES       = 'A number of times must be entered for continuous orders';
     1962  TX_NO_STOP_DATE   = 'Could not calculate the stop date for the order.  Check "for n Days"';
    8431963  TX_TOO_MANY_DAYS  = 'Maximum number of days allowed is ';
    8441964  TX_TOO_MANY_TIMES = 'For this frequency, the maximum number of times allowed is:  X';
    8451965  //TX_NO_COMMENT     = 'A comment is required for this test and collection sample.';
    846   TX_NUMERIC_REQD   = 'A numeric value is required for urine volume.';
    847   TX_DOSEDRAW_REQD  = 'Both DOSE and DRAW times are required for this order.';
    848   TX_TDM_REQD       = 'A value for LEVEL is required for this order.';
     1966  TX_NUMERIC_REQD   = 'A numeric value is required for urine volume';
     1967  TX_DOSEDRAW_REQD  = 'Both DOSE and DRAW times are required for this order';
     1968  TX_TDM_REQD       = 'A value for LEVEL is required for this order';
    8491969  //TX_ANTICOAG_REQD  = 'You must specify an anticoagulant on this order.' ;
    850   TX_NO_COLLSAMPLE  = 'A collection sample MUST be specified.';
    851   TX_NO_SPECIMEN    = 'A specimen MUST be specified.';
    852   TX_NO_URGENCY     = 'An urgency MUST be specified.';
    853   TX_NO_FREQUENCY   = 'A collection frequency MUST be specified.';
    854   TX_NOT_LAB_COLL_TIME = ' is not a routine lab collection time.';
    855   TX_NO_ALPHA       = 'For continuous orders, enter a number of days, or an "X" followed by a number of times.';
     1970  TX_NO_COLLSAMPLE  = 'A collection sample MUST be specified';
     1971  TX_NO_SPECIMEN    = 'A specimen MUST be specified';
     1972  TX_NO_URGENCY     = 'An urgency MUST be specified';
     1973  TX_NO_FREQUENCY   = 'A collection frequency MUST be specified';
     1974  TX_NOT_LAB_COLL_TIME = ' is not a routine lab collection time';
     1975  TX_NO_ALPHA       = 'For continuous orders, enter a number of days, or an "X" followed by a number of times';
    8561976  TX_BADTIME_CAP    = 'Invalid Immediate Collect Time';
    8571977  {Component/Type & Screen Errors}
    858   TX_NO_COMPONENTS  = 'A Blood Product MUST be selected.';
    859   TX_NO_QUANTITY    = 'The number of units MUST be specified under "Quantity".';
    860   TX_HIGH_QUANTITY  = 'Quantity too high.';
     1978  TX_NO_COMPONENTS  = 'A Blood Product MUST be selected';
     1979  TX_NO_QUANTITY    = 'The number of units MUST be specified under "Quantity"';
     1980  TX_HIGH_QUANTITY  = 'Quantity too high';
    8611981  TX_NO_DATEMODIFIED= 'A Date/time Wanted MUST be specified';
    862   //TX_NO_PREPARATION = 'Preparation MUST be specified - either "Hold" or "Immediate".';
    8631982  TX_NO_SURGERY     = 'A Surgery MUST be specified for Pre-Op orders';         //only if Pre-op selected
    8641983  TX_NO_REASON      = 'A Reason for Request MUST be entered';
     1984  TX_REASON_TOO_LONG= 'Reason for Request MUST be less than 76 characters long';
     1985  TX_MODIFIER_TOO_LONG = 'Modifer text MUST be less than 51 characters long';
    8651986  TX_NO_COMMENT     = 'A Comment MUST be entered for this Component';
    8661987  TX_DUPLICATE      = 'Duplicate Test/Component not allowed';
    … …  
    8701991  inherited;
    8711992  AnErrMsg := '';
    872   if aLabTest = nil then
    873     begin
    874       AnErrMsg := TX_NO_TEST_SELECTED;
    875       Exit;
    876     end;
    877   for i := 0 to uSelectedItems.Count - 1 do
    878     if IntToStr(aLabTest.TestID) = piece(uSelectedItems[i],'^',2) then
     1993  aList := TStringList.Create;
     1994  try
     1995    ExtractOther(aList, uVBECList);
     1996    if aList.Count > 0 then aOther := aList[0];
     1997    aList.Clear;
     1998    if uSelectedItems.Count < 1 then
    8791999      begin
    880         AnErrMsg := TX_DUPLICATE;
     2000        AnErrMsg := TX_NO_TEST_SELECTED;
    8812001        Exit;
    8822002      end;
    883   if LRORDERMODE = TORDER_MODE_DIAG then
    884     begin
    885       with cboAvailTest do if ItemIEN <= 0 then SetError(TX_NO_TESTS);
    886 
    887       if ALabTest <> nil then
    888         if (cboCollType.ItemID = 'I') and (not ALabTest.LabCanCollect) then
     2003    for i := 0 to uSelectedItems.Count - 1 do
     2004      begin
     2005        x := uSelectedItems[i];
     2006        test := lvSelectionList.Items[i].Caption;
     2007        if piece(x,'^',1) = '1' then    //Diagnostic Test
    8892008          begin
    890             SetError(TX_NO_IMMED);
    891             cboCollType.ItemIndex := -1;
     2009            if uSpecimen = 0 then
     2010              if cboCollType.ItemID = '' then
     2011                SetError(TX_NO_TCOLLTYPE + ' (' + test + ')')
     2012              else if cboCollType.ItemID = 'LC' then
     2013                begin
     2014                 if Length(cboCollTime.Text) = 0 then SetError(TX_NO_TIME + ' (' + test + ')');
     2015                 with cboCollTime do if (Length(Text) > 0) and (ItemIndex = -1) then
     2016                   begin
     2017                     if StrToFMDateTime(Text) < 0 then
     2018                       SetError(TX_BAD_TIME + ' (' + test + ')')
     2019                     else if StrToFMDateTime(Text) < FMNow then
     2020                       SetError(TX_PAST_TIME + ' (' + test + ')')
     2021                     else if OrderForInpatient then
     2022                       begin
     2023                         d1 := FMDateTimeToDateTime(Trunc(StrToFMDateTime(cboColltime.Text)));
     2024                         d2 := FMDateTimeToDateTime(FMToday);
     2025                         if EvtDelayLoc > 0 then
     2026                           DaysofFuturePast := LabCollectFutureDays(EvtDelayLoc,EvtDivision)
     2027                         else
     2028                           DaysofFuturePast := LabCollectFutureDays(Encounter.Location);
     2029                         if DaysofFuturePast = 0 then DaysofFuturePast := 7;
     2030                         if ((d1 - d2) > DaysofFuturePast) then
     2031                           SetError('A lab collection cannot be ordered more than '
     2032                             + IntToStr(DaysofFuturePast) + ' days in advance');
     2033                       end
     2034                     else if EvtDelayLoc > 0 then
     2035                       begin
     2036                         if (not IsLabCollectTime(StrToFMDateTime(cboCollTime.Text), EvtDelayLoc)) then
     2037                           SetError(cboCollTime.Text + TX_NOT_LAB_COLL_TIME + ' (' + test + ')');
     2038                       end
     2039                     else if EvtDelayLoc <= 0 then
     2040                       begin
     2041                         if (not IsLabCollectTime(StrToFMDateTime(cboCollTime.Text), Encounter.Location)) then
     2042                           SetError(cboCollTime.Text + TX_NOT_LAB_COLL_TIME + ' (' + test + ')');
     2043                       end;
     2044                   end;
     2045                end
     2046              else
     2047                begin
     2048                  if cboCollType.ItemID = 'I' then
     2049                    begin
     2050                      calCollTime.Text := txtImmedColl.Text;
     2051                      x := ValidImmCollTime(calCollTime.FMDateTime);
     2052                      if (Piece(x, U, 1) <> '1') then
     2053                        SetError(Piece(x, U, 2));
     2054                    end;
     2055
     2056                  with calColltime do
     2057                    begin
     2058                      if FMDateTime = 0 then SetError(TX_BAD_TIME + ' (' + test + ')')
     2059                      else
     2060                        begin
     2061                          // date only was entered
     2062                          if (FMDateTime - Trunc(FMDateTime) = 0) then
     2063                            begin
     2064                              if (Trunc(FMDateTime) < FMToday) then SetError(TX_PAST_TIME + ' (' + test + ')');
     2065                            end
     2066                          // date/time was entered
     2067                          else
     2068                            begin
     2069                              if (UpperCase(Text) <> 'NOW') and (FMDateTime < FMNow) then SetError(TX_PAST_TIME + ' (' + test + ')');
     2070                            end;
     2071                        end;
     2072                    end;
     2073                end;
     2074
     2075            with cboUrgency do if ItemIEN  <= 0 then SetError(TX_NO_URGENCY + ' (' + test + ')');
     2076          end
     2077        else                            //Component
     2078          begin
     2079            if piece(x,'^',3) ='' then SetError(TX_NO_QUANTITY + ' (' + test + ')')
     2080              else
     2081                begin
     2082                  if StrToInt(piece(x,'^',3)) < 1 then SetError(TX_NO_QUANTITY + ' (' + test + ')');
     2083                  if StrToInt(piece(x,'^',3)) > 100 then SetError(TX_HIGH_QUANTITY + ' (' + test + ')');
     2084                end;
     2085            if calWantTime.Text = '' then SetError(TX_NO_DATEMODIFIED + ' (' + test + ')');
     2086            if (cboReasons.Text = '') and not(uReason = '') then
     2087              begin
     2088                SetError(TX_NO_REASON + ' (' + test + ').' + ' Previously entered ''Reason for Request'' will be retained.');
     2089                cboReasons.Text := uReason; //reset reason back to previous value
     2090              end;
     2091              if (cboReasons.Text = '') then
     2092                begin
     2093                  SetError(TX_NO_REASON + ' (' + test + ').');
     2094                end;
     2095            if (memDiagComment.Text = '') and (piece(x,'^',2) = aOther) then SetError(TX_NO_COMMENT + ' (' + test + ')');
     2096            if (cboUrgency.Text = 'PRE-OP') and (length(cboSurgery.Text) < 1) then SetError(TX_NO_SURGERY + ' (' + test + ')');
     2097            if (length(cboReasons.Text) > 75) then SetError(TX_REASON_TOO_LONG);
     2098            if (length(cboModifiers.Text) > 50) then SetError(TX_MODIFIER_TOO_LONG);
    8922099          end;
    893       if uSpecimen = 0 then
    894         if cboCollType.ItemID = '' then
    895           SetError(TX_NO_TCOLLTYPE)
    896         else if cboCollType.ItemID = 'LC' then
    897           begin
    898            if Length(cboCollTime.Text) = 0 then SetError(TX_NO_TIME);
    899            with cboCollTime do if (Length(Text) > 0) and (ItemIndex = -1) then
    900              begin
    901                if StrToFMDateTime(Text) < 0 then
    902                  SetError(TX_BAD_TIME)
    903                else if StrToFMDateTime(Text) < FMNow then
    904                  SetError(TX_PAST_TIME)
    905                else if OrderForInpatient then
    906                  begin
    907                    d1 := FMDateTimeToDateTime(Trunc(StrToFMDateTime(cboColltime.Text)));
    908                    d2 := FMDateTimeToDateTime(FMToday);
    909                    if EvtDelayLoc > 0 then
    910                      DaysofFuturePast := LabCollectFutureDays(EvtDelayLoc,EvtDivision)
    911                    else
    912                      DaysofFuturePast := LabCollectFutureDays(Encounter.Location);
    913                    if DaysofFuturePast = 0 then DaysofFuturePast := 7;
    914                    if ((d1 - d2) > DaysofFuturePast) then
    915                      SetError('A lab collection cannot be ordered more than '
    916                        + IntToStr(DaysofFuturePast) + ' days in advance');
    917                  end
    918                else if EvtDelayLoc > 0 then
    919                  begin
    920                    if (not IsLabCollectTime(StrToFMDateTime(cboCollTime.Text), EvtDelayLoc)) then
    921                      SetError(cboCollTime.Text + TX_NOT_LAB_COLL_TIME);
    922                  end
    923                else if EvtDelayLoc <= 0 then
    924                  begin
    925                    if (not IsLabCollectTime(StrToFMDateTime(cboCollTime.Text), Encounter.Location)) then
    926                      SetError(cboCollTime.Text + TX_NOT_LAB_COLL_TIME);
    927                  end;
    928              end;
    929           end
    930         else
    931           begin
    932             if cboCollType.ItemID = 'I' then
    933               begin
    934                 calCollTime.Text := txtImmedColl.Text;
    935                 x := ValidImmCollTime(calCollTime.FMDateTime);
    936                 if (Piece(x, U, 1) <> '1') then
    937                   SetError(Piece(x, U, 2));
    938               end;
    939 
    940             with calColltime do
    941               begin
    942                 if FMDateTime = 0 then SetError(TX_BAD_TIME)
    943                 else
    944                   begin
    945                     // date only was entered
    946                     if (FMDateTime - Trunc(FMDateTime) = 0) then
    947                       begin
    948                         if (Trunc(FMDateTime) < FMToday) then SetError(TX_PAST_TIME);
    949                       end
    950                     // date/time was entered
    951                     else
    952                       begin
    953                         if (UpperCase(Text) <> 'NOW') and (FMDateTime < FMNow) then SetError(TX_PAST_TIME);
    954                       end;
    955                   end;
    956               end;
    957           end;
    958 
    959       with cboUrgency do if ItemIEN  <= 0 then SetError(TX_NO_URGENCY);
    960       if ALabTest <> nil then
    961         begin
    962           CmtType := FCmtTypes.IndexOf(ALabTest.CurReqComment) ;
    963           with ALabTest do
    964           case CmtType of
    965             0 : {ANTICOAGULATION}         {if (Pos('ANTICOAGULANT',Comment.Text)=0) then
    966                                          SetError(TX_ANTICOAG_REQD)};
    967             1 : {DOSE/DRAW TIMES}         if (Pos('Last dose:',Comment.Text)=0) or
    968                                           (Pos('draw time:',Comment.Text)=0) then
    969                                          SetError(TX_DOSEDRAW_REQD);
    970             2 : {ORDER COMMENT}           {if (Length(Comment.Text)=0) then
    971                                          SetError(TX_NO_COMMENT)};
    972             3 : {ORDER COMMENT MODIFIED}  {if (Length(Comment.Text)=0) then
    973                                          SetError(TX_NO_COMMENT)};
    974             4 : {TDM (PEAK-TROUGH}        if (Pos('Dose is expected',Comment.Text)=0) then
    975                                          SetError(TX_TDM_REQD);
    976             5 : {TRANSFUSION}             {if (Length(Comment.Text)=0) then
    977                                          SetError(TX_NO_COMMENT)};
    978             6 : {URINE VOLUME}            if (Length(Comment.Text)>0) and
    979                                        (ExtractInteger(Comment.Text)<=0) then
    980                                           Comment.Text := '?';
    981                                          {SetError(TX_NUMERIC_REQD);}
    982           end;
    983         end;
    984     end
    985   else if LRORDERMODE = TORDER_MODE_COMP then
    986     begin
    987       with cboAvailComp do
    988         begin
    989           if ItemIEN <= 0 then SetError(TX_NO_COMPONENTS);
    990         end;
    991       if StrToInt(tQuantity.Text) < 1 then SetError(TX_NO_QUANTITY);
    992       if calWantTime.Text = '' then SetError(TX_NO_DATEMODIFIED);
    993       //if cboPreparation.Text ='' then SetError(TX_NO_PREPARATION);
    994       if StrToInt(tQuantity.Text) > 100 then SetError(TX_HIGH_QUANTITY);
    995       if tReason.Text = '' then SetError(TX_NO_REASON);
    996       if (txtDiagComment.Text = '') and (cboAvailComp.Text = 'OTHER') then SetError(TX_NO_COMMENT);
    997       if (cboUrgency.Text = 'PRE-OP') and (length(cboSurgery.ItemID) < 1) then SetError(TX_NO_SURGERY);
    998     end;
     2100      end;
     2101  finally
     2102    aList.Free;
     2103  end;
    9992104end;
    10002105
    … …  
    12732378end;
    12742379
     2380procedure TfrmODBBank.cboQuickClick(Sender: TObject);
     2381begin
     2382  inherited;
     2383  SetOnQuickOrder;
     2384end;
     2385
     2386procedure TfrmODBBank.cboReasonsChange(Sender: TObject);
     2387begin
     2388  inherited;
     2389  if (length(cboReasons.Text) > 75) then
     2390    begin
     2391      ShowMsg('REASON FOR REQUEST cannot be longer than 75 characters');
     2392      cboReasons.Text := Copy(cboReasons.Text,0,75);
     2393      Exit;
     2394    end;
     2395  if Length(cboReasons.Text) > 0 then Responses.Update('REASON', 1, cboReasons.Text, cboReasons.Text);
     2396  memOrder.Text := Responses.OrderText;
     2397end;
     2398
     2399procedure TfrmODBBank.cboReasonsEnter(Sender: TObject);
     2400begin
     2401  inherited;
     2402  if Length(cboReasons.Text) > 0 then
     2403    uReason := cboReasons.Text;
     2404end;
     2405
     2406procedure TfrmODBBank.cboReasonsExit(Sender: TObject);
     2407begin
     2408  inherited;
     2409  if Length(cboReasons.Text) > 0 then
     2410    uReason := cboReasons.Text;
     2411end;
     2412
    12752413procedure TfrmODBBank.cboAvailTestSelect(Sender: TObject);
    12762414var
    1277   x: string;
    12782415  i: integer;
    1279 begin
    1280   DisableComponentControls;
    1281   EnableDiagTestControls;
    1282   LRORDERMODE := TORDER_MODE_DIAG;
    1283   with cboAvailTest do
    1284     begin
    1285       if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
     2416  text : string;
     2417  ListItem: TListItem;
     2418  aCollTime,aTypeScreen,aStr,aModifier,aSpecimen,aTestYes,x,aName,aTNSString: string;
     2419  aList: TStringList;
     2420  curAdd,AnInstance,aTNS,aTNSDays: Integer;
     2421  sub,sub1: string;
     2422  AResponse: TResponse;
     2423begin
     2424  if cboAvailTest.ItemID = '' then Exit;
     2425  aList := TStringList.Create;
     2426  try
     2427    ALabTest := nil;
     2428    aTypeScreen := '';
     2429    aSpecimen := '^';
     2430    aTestYes := '1';
     2431    aModifier := '';
     2432    changing := true;
     2433    tQuantity.Text := '';
     2434    sub1 := '';
     2435    cboModifiers.ItemIndex := -1;
     2436    DisableComponentControls;
     2437    EnableDiagTestControls;
     2438    LRORDERMODE := TORDER_MODE_DIAG;
     2439    ALabTest := TLabTest.Create(cboAvailTest.ItemID, Responses);
     2440    sub := GetSubtype(ALabTest.TestName);
     2441    with CtrlInits do
     2442        begin
     2443          SetControl(cboCollType, 'Collection Types');
     2444          LoadCollType(cboCollType);
     2445          if FLastCollType <> '' then
     2446            cboCollType.SelectByID(FLastCollType)
     2447          else if uDfltCollType <> '' then
     2448            cboCollType.SelectByID(uDfltCollType)
     2449          else if OrderForInpatient then
     2450            if (ALabTest.LabCanCollect) then
     2451              cboCollType.SelectByID('LC')
     2452            else
     2453              cboCollType.SelectByID('WC')
     2454          else
     2455            cboCollType.SelectByID('SP');
     2456          SetupCollTimes(cboCollType.ItemID);
     2457        end;
     2458    with cboAvailTest do
     2459      begin
     2460        if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
     2461        FLastLabID := ItemID ;
     2462        FLastItemID := ItemID;
     2463        for i := 0 to uSelectedItems.Count - 1 do
     2464          if ItemID = piece(uSelectedItems[i],'^',2) then
     2465            begin
     2466              ItemIndex := -1;
     2467              lvSelectionList.Items[i].Selected := true;
     2468              lvSelectionListClick(self);
     2469              Exit;
     2470            end;
     2471        Changing := True;
     2472        Changing := False;
     2473        ExtractTypeScreen(aList, uVBECList);
     2474        if aList.Count > 0 then aTypeScreen := aList[0];
     2475        aList.Clear;
     2476        aTNSString := '';
     2477        if (StrToInt(aTypeScreen) = cboAvailTest.ItemID) and (uTNSOrders.Count > 0) then
     2478          begin
     2479            for i := 0 to uTNSOrders.Count - 1 do
     2480              aTNSString := aTNSString + CRLF + uTNSOrders[i];
     2481            with Application do
     2482              begin
     2483                NormalizeTopMosts;
     2484                aTNSDays := TNSDaysBack;
     2485                aTNS :=
     2486                  MessageBox(PChar(aTNSString + CRLF + CRLF +
     2487                             'Do you wish to continue?'),
     2488                             PChar('Type & Screen Entered in Past ' + IntToStr(TNSDaysBack) + ' Days'),
     2489                             MB_YESNO);
     2490                RestoreTopMosts;
     2491                if aTNS = 7 then
     2492                  begin
     2493                    cboAvailTest.ItemIndex := -1;
     2494                    exit;
     2495                  end;
     2496              end;
     2497          end;
     2498        if sub = 't' then with ALabTest do      //DIAGNOSTIC TEST
     2499          begin
     2500            if ObtainCollSamp then
     2501              begin
     2502              //For BloodBank orders, this condition should never occur
     2503              end
     2504            else
     2505              begin
     2506                with ALabTest do
     2507                  with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
     2508                    begin
     2509                      x := '' ;
     2510                      for i := 0 to WardComment.Count-1 do
     2511                      x := x + WardComment.strings[i]+#13#10 ;
     2512                      pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
     2513                      OrderMessage(x) ;
     2514                    end ;
     2515              end;
     2516        end;
     2517        Changing := False;
     2518      end;
     2519    if LRORDERMODE = TORDER_MODE_DIAG then
     2520      begin
     2521        if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
     2522        with cboCollType do if Length(ItemID) > 0 then
     2523          begin
     2524            Responses.Update('COLLECT', 1, ItemID, ItemID) ;
     2525            FLastCollType := ItemID;
     2526          end;
     2527        if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text)
     2528        else
     2529          begin
     2530            cboUrgency.ItemIndex := 1;
     2531            Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
     2532          end;
     2533        if Length(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
     2534        if Length(cboReasons.Text) > 0 then Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text);
     2535        if cboCollType.ItemID = 'LC' then
     2536          begin
     2537            with cboCollTime do
     2538              if Length(ItemID) > 0 then
     2539                begin
     2540                  Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
     2541                  FLastLabCollTime := ItemID + U + Text;
     2542                end
     2543              else if Length(Text) > 0 then
     2544                begin
     2545                  Responses.Update('START', 1, ValidCollTime(Text), Text) ;
     2546                  FLastLabCollTime := ValidCollTime(Text);
     2547                end;
     2548          end
     2549          else
     2550            begin
     2551              with calCollTime do
     2552                if FMDateTime > 0 then
     2553                  begin
     2554                    Responses.Update('START', 1, ValidCollTime(Text), Text);
     2555                    FLastColltime := ValidCollTime(Text);
     2556                  end
     2557                else
     2558                  begin
     2559                    Responses.Update('START', 1, '', '') ;
     2560                    FLastCollTime := '';
     2561                  end;
     2562            end;
     2563          if Length(cboCollType.Text) > 0 then Responses.Update('COLLECT',1,cboCollType.ItemID,cboCollType.ItemID);
     2564      end;
     2565    if length(cboCollTime.ItemID) > 0 then aCollTime := cboCollTime.Items[cboCollTime.ItemIndex];
     2566    uTestSelected := true;
     2567    with lvSelectionList do
     2568      begin
     2569        ListItem := Items.Add;
     2570        ListItem.Caption := piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',2);
     2571        ListItem.SubItems.Add('');
     2572        ListItem.SubItems.Add('');
     2573        ListItem.SubItems.Add('');
     2574        ListItem.SubItems.Add(piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1));
     2575        if piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1) = aTypeScreen then
     2576          begin
     2577            lblTNS.Caption := '';
     2578            lblTNS.Visible := false;
     2579            memMessage.Text := '';
     2580            pnlMessage.Visible := false;
     2581            uGetTnS := 0;
     2582            pnlDiagnosticTests.Caption := 'Diagnostic Tests';
     2583          end;
     2584      end;
     2585    aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + aCollTime + '^' + cboCollType.Text + '^' + IntToStr(aLabTest.ItemID);  //aSpecimen has 2 pieces
     2586    uSelectedItems.Add(aStr);
     2587    CurAdd := 1;
     2588    for i := 0 to uSelectedItems.Count - 1 do
     2589      begin
     2590        aName := lvSelectionList.Items[i].Caption;
     2591        x := uSelectedItems[i];
     2592        if piece(x,'^',1) = '1' then    //Diagnostic Test related fields
     2593          begin
     2594            if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
     2595          end;
     2596        Inc(CurAdd);
     2597      end;
     2598    memOrder.Text := Responses.OrderText;
     2599  finally
     2600    aList.Free;
     2601  end;
     2602  edtResults.Height := 247;
     2603  edtInfo.Height := 247;
     2604  if lvSelectionList.Items.Count > 0 then
     2605    begin
     2606      pnlSelectedTests.Visible := True;
     2607      cmdAccept.Visible := True;
     2608      memOrder.Visible := True;
     2609      GroupBox1.Visible := False;
     2610    end;
     2611end;
     2612
     2613procedure TfrmODBBank.cboAvailCompSelect(Sender: TObject);
     2614 var
     2615  aList,aTests: TStringList;
     2616  i,j,k,getTest,TestAdded: integer;
     2617  text : string;
     2618  aMSBOS,aMSBOSContinue,curAdd,AnInstance: integer;
     2619  sub,sub1: string;
     2620  AResponse: TResponse;
     2621  ListItem: TListItem;
     2622  aTypeScreen,aSpecimen,aTestYes,aStr,aMsg,aModifier,x,x1,aReason,aSurgery,aCollTime,aCollSave,aName: String;
     2623begin
     2624  if cboAvailComp.ItemID = '' then Exit;
     2625  aList := TStringList.Create;
     2626  aTests := TStringList.Create;
     2627  sub1 := '';
     2628  try
     2629    DisableDiagTestControls;
     2630    EnableComponentControls;
     2631    if not(changing = true) then
     2632      begin
     2633        changing := true;
     2634        tQuantity.Text := '';
     2635        cboModifiers.ItemIndex := -1;
     2636        changing := false;
     2637      end;
     2638    LRORDERMODE := TORDER_MODE_COMP;
     2639    with cboAvailComp do
     2640      begin
     2641        if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
     2642        FLastLabID := ItemID ;
     2643        FLastItemID := ItemID;
     2644        for i := 0 to uSelectedItems.Count - 1 do
     2645          if ItemID = piece(uSelectedItems[i],'^',2) then
     2646            begin
     2647              ItemIndex := -1;
     2648              lvSelectionList.Items[i].Selected := true;
     2649              lvSelectionListClick(self);
     2650              Exit;
     2651            end;
     2652        ALabTest := TLabTest.Create(ItemID, Responses);
     2653        sub := GetSubtype(ALabTest.TestName);
     2654        Changing := False;
     2655        StatusText('');
     2656      end;
     2657    //Check for and display any associated Lab Results
     2658    aList.Clear;
     2659    TestAdded := 0;
     2660    getTest := 0;
     2661    ExtractTests(aList, uVBECList);   //Get Results associated with ordered components
     2662      for j := 0 to aList.Count - 1 do
     2663        begin
     2664          if StrToInt(piece(aList[j],'^',1)) = aLabTest.ItemID then
     2665            begin
     2666              if uTestsForResults.Count < 1 then getTest := 1;
     2667              for k := 0 to uTestsForResults.Count - 1 do
     2668                begin
     2669                  if piece(uTestsForResults[k],'^',1) = piece(aList[j],'^',3) then
     2670                    begin
     2671                      getTest := 0;
     2672                      break;
     2673                    end
     2674                  else getTest := 1;
     2675                end;
     2676              if getTest = 1 then
     2677                begin
     2678                  uTestsForResults.Add(piece(aList[j],'^',3));
     2679                  TestAdded := 1;
     2680                end;
     2681            end;
     2682        end;
     2683      if TestAdded = 1 then
     2684        begin
     2685          edtResults.Clear;
     2686          aTests.Clear;
     2687          GetPatientBloodResults(aTests, Patient.DFN, uTestsForResults);
     2688          QuickCopy(ATests,edtResults);
     2689          if edtResults.Lines.Count > 0 then TabResults.Caption := 'Lab Results Available';
     2690          uRaw.Clear;
     2691          GetPatientBloodResultsRaw(uRaw, Patient.DFN, uTestsForResults);
     2692        end;
     2693      CurAdd := 1;
     2694      if uRaw.Count > 0 then
     2695      for j := 0 to uRaw.Count - 1 do
     2696        begin
     2697          if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));
     2698          Inc(CurAdd);
     2699        end;
     2700    aTypeScreen := '';
     2701    aSpecimen := '^';
     2702    aTestYes := '0';
     2703    aReason := '';
     2704    aSurgery := '';
     2705    aCollTime := '';
     2706    aList.Clear;
     2707    ExtractTypeScreen(aList, uVBECList);
     2708    if aList.Count > 0 then aTypeScreen := aList[0];
     2709    aList.Clear;
     2710    ExtractSpecimen(aList, uVBECList);
     2711    if aList.Count > 0 then aSpecimen := aList[0];
     2712    if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex];
     2713    if length(cboReasons.ItemID) > 0 then aReason := cboReasons.Items[cboReasons.ItemIndex];
     2714    if length(cboSurgery.ItemID) > 0 then aSurgery := cboSurgery.Items[cboSurgery.ItemIndex];
     2715    if length(cboCollTime.ItemID) > 0 then aCollTime := cboCollTime.Items[cboCollTime.ItemIndex];
     2716    if Length(cboSurgery.ItemID) > 0 then
     2717      begin
     2718        aList.Clear;
     2719        ExtractMSBOS(aList, uVBECList);    //Get maximum units for selected Surgey
     2720        for i := 0 to aList.Count - 1 do
     2721          begin
     2722            if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
     2723             and (piece(aList[i],'^',3) = cboSurgery.Text) then
     2724              begin
     2725                aMSBOS := StrToInt(piece(aList[i],'^',4));
     2726                if (aMSBOS > 0) and (Length(tQuantity.Text) > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then
     2727                  begin
     2728                    with Application do
     2729                    begin
     2730                      NormalizeTopMosts;
     2731                      aMSBOSContinue :=
     2732                        MessageBox(PChar('The number of units ordered (' + tQuantity.Text +
     2733                                   ') for ' + aLabTest.TestName + ' exceeds the maximum number of units ('
     2734                                   + IntToStr(aMSBOS) +
     2735                                   ') for the ' + cboSurgery.text +
     2736                                   ' surgical procedure selected.' + CRLF + CRLF + 'Do you wish to continue?'),
     2737                                   PChar('Maximum Number of Units Exceeded'),
     2738                                   MB_YESNO);
     2739                      RestoreTopMosts;
     2740                    end;
     2741                    if aMSBOSContinue = 7 then
     2742                      begin
     2743                        ShowMsg(cboAvailComp.Text + ' has NOT been added to this request.');
     2744                        exit;
     2745                      end;
     2746                  end;
     2747              end;
     2748          end;
     2749      end;
     2750    if (uTNSOrders.Count < 1) then // SpecimenNeeded(aList, uVBECList, aLabTest.ItemID) then  //check to see if type and screen is needed
     2751      begin
     2752        uGetTnS := 1;
     2753        for i := 0 to lvSelectionList.Items.Count - 1 do
     2754          begin
     2755            if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then
     2756              begin
     2757                uGetTnS := 0;
     2758                if length(cboUrgency.ItemID) > 0 then uDfltUrgency := cboUrgency.ItemID;
     2759                lblTNS.Caption := '';
     2760                lblTNS.Visible := false;
     2761                memMessage.Text := '';
     2762                pnlMessage.Visible := false;
     2763                pnlDiagnosticTests.Caption := 'Diagnostic Tests';
     2764                break;
     2765              end;
     2766          end;
     2767      end;
     2768    aList.Clear;
     2769    ExtractSpecimens(aList, uVBECList);    //Get specimen values to pass back to Server
     2770    for i := 0 to aList.Count - 1 do
     2771      begin
     2772        if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) then
     2773          begin
     2774            aSpecimen := piece(aList[i],'^',2) + '^' + aSpecimen;
     2775            break;
     2776          end;
     2777      end;
     2778    uComponentSelected := true;
     2779    with lvSelectionList do
     2780      begin
     2781        ListItem := Items.Add;
     2782        ListItem.Caption := piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2);
     2783        ListItem.SubItems.Add(tQuantity.Text);
     2784        if length(cboModifiers.ItemID) > 0 then
     2785          begin
     2786            ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]);
     2787            ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex));
     2788          end
     2789          else
     2790            begin
     2791              ListItem.SubItems.Add('');
     2792              ListItem.SubItems.Add('');
     2793            end;
     2794        ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
     2795      end;
     2796      aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen + '^' + IntToStr(aLabTest.ItemID);  //aSpecimen has 2 pieces additional pieces added for Tests
     2797      uSelectedItems.Add(aStr);
     2798      CurAdd := 1;
    12862799      for i := 0 to uSelectedItems.Count - 1 do
    1287         if ItemID = piece(uSelectedItems[i],'^',1) then
     2800        begin
     2801          aName := lvSelectionList.Items[i].Caption;
     2802          x := uSelectedItems[i];
     2803          if piece(x,'^',1) = '1' then    //Diagnostic Test related fields
     2804            begin
     2805              if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
     2806            end
     2807          else
     2808            begin
     2809              if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
     2810              if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3));
     2811              if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), piece(x,'^',4));
     2812              if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5));
     2813              if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
     2814              if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
     2815              if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text)
     2816                else
     2817                  begin
     2818                    cboUrgency.ItemIndex := 1;
     2819                    Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
     2820                  end;
     2821            end;
     2822          Inc(CurAdd);
     2823        end;
     2824      memOrder.Text := Responses.OrderText;
     2825  finally
     2826    alist.Free;
     2827    aTests.Free;
     2828  end;
     2829  aMsg := '';
     2830  LRORDERMODE := TORDER_MODE_INFO;
     2831  if uGetTnS = 1 then
     2832    begin
     2833      lblTNS.Caption := 'TYPE + SCREEN must be added to order';
     2834      lblTNS.Visible := true;
     2835      memMessage.Text := 'TYPE + SCREEN must be added to order';
     2836      pnlMessage.Visible := true;
     2837      pnlDiagnosticTests.Caption := 'Diagnostic Tests*';
     2838    end;
     2839  {if uGetTnS = 1 then
     2840    begin
     2841      if responses.QuickOrder < 1 then
     2842        begin
     2843          for i := 1 to cboAvailTest.Items.Count - 1 do
     2844            begin
     2845              if piece(cboAvailTest.Items[i],'^',1) = aTypeScreen then
     2846                begin
     2847                  if piece(aSpecimen,'^',1) = '1' then
     2848                    begin
     2849                      cboCollTime.Text := calWantTime.Text;
     2850                      aCollSave := cboCollTime.Text + '^' + cboCollTime.ItemID + '^' + cboCollType.Text + '^' + cboCollType.ItemID;
     2851                      cboCollTime.Text := '';
     2852                      cboCollType.Text := '';
     2853                      uSpecimen := 1;
     2854                    end;
     2855                  cboModifiers.Text := '';
     2856                  cboAvailTest.SelectByID(aTypeScreen);
     2857                  cboTests.SelectByID(aTypeScreen);
     2858                  cboTestsClick(self);
     2859                  //cboAvailTestSelect(Self);
     2860                  uSpecimen := 0;
     2861                  cboCollTime.Text := piece(aCollSave,'^',1);
     2862                  cboCollType.Text := piece(aCollSave,'^',3);
     2863                  aCollSave := '';
     2864                  break;
     2865                end;
     2866            end;
     2867          aMsg := 'An order for Type and Screen has been added to this request' + '.';
     2868        end
     2869        else
    12882870          begin
    1289             ShowMessage('This test has already been selected!');
    1290             Exit;
     2871            lblTNS.Caption := 'TYPE + SCREEN must be added to order';
     2872            lblTNS.Visible := true;
     2873            memMessage.Text := 'TYPE + SCREEN must be added to order';
     2874            memMessage.Visible := false;
     2875            pnlMessage.Visible := true;
    12912876          end;
    1292       FLastLabID := ItemID ;
    1293       FLastItemID := ItemID;
    1294       Changing := True;
    1295       if Sender <> Self then
    1296         Responses.Clear;       // Sender=Self when called from SetupDialog
    1297       if CharAt(ItemID, 1) = 'Q' then
    1298         with Responses do
    1299           begin
    1300             FLastItemID := ItemID;
    1301             QuickOrder := ExtractInteger(ItemID);
    1302             SetControl(cboAvailTest, 'ORDERABLE', 1);
    1303             if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
    1304             FLastLabID := ItemID;
    1305           end;
    1306       ALabTest := TLabTest.Create(ItemID, Responses);
    1307     end;
    1308   with ALabTest do
    1309   begin
    1310 
    1311     {with Responses do if QuickOrder > 0 then
    1312      begin
    1313       StatusText('Initializing Quick Order');
    1314       Changing := True;
    1315       SetControl(cboAvailTest,       'ORDERABLE', 1);
    1316       DetermineCollectionDefaults(Responses);
    1317       LoadUrgency(cboCollType.ItemID, cboUrgency);
    1318       SetControl(cboUrgency,         'URGENCY', 1);
    1319       Urgency := cboUrgency.ItemIEN;
    1320       if (Urgency = 0) and (cboUrgency.Items.Count = 1) then
    1321         begin
    1322           cboUrgency.ItemIndex := 0;
    1323           Urgency := cboUrgency.ItemIEN;
    1324         end;
    1325       tmpResp := FindResponseByName('SPECIMEN'  ,1);
    1326       i := 1 ;
    1327       tmpResp := Responses.FindResponseByName('COMMENT',i);
    1328       while tmpResp <> nil do
    1329         begin
    1330           Comment.Add(tmpResp.EValue);
    1331           Inc(i);
    1332           tmpResp := Responses.FindResponseByName('COMMENT',i);
    1333         end ;
    1334       end;  //  Quick Order}
    1335     if ObtainCollSamp then
    1336       begin
    1337         //For BloodBank orders, this condition should never occur
    1338       end
     2877      end;
     2878  if (uGetTnS = 1) then
     2879    begin
     2880      if length(aMsg) > 0 then aMsg := aMsg + crlf + crlf;
     2881      ShowMsg(aMsg);
     2882    end;  }
     2883  edtResults.Height := 247;
     2884  edtInfo.Height := 247;
     2885  if lvSelectionList.Items.Count > 0 then
     2886    begin
     2887      pnlSelectedTests.Visible := True;
     2888      cmdAccept.Visible := True;
     2889      memOrder.Visible := True;
     2890      GroupBox1.Visible := False;
     2891    end;
     2892  if tQuantity.CanFocus = true then tQuantity.SetFocus;
     2893end;
     2894
     2895procedure TfrmODBBank.DisableCommentPanels;
     2896begin
     2897  lblReqComment.Visible := False;
     2898end;
     2899
     2900procedure TfrmODBBank.DisableComponentControls;
     2901begin
     2902  lblQuantity.Enabled := false;
     2903  tQuantity.Enabled := false;
     2904  lblModifiers.Enabled := false;
     2905  cboModifiers.Enabled := false;
     2906  cboAvailComp.ItemIndex := -1;
     2907end;
     2908
     2909procedure TfrmODBBank.EnableComponentControls;
     2910begin
     2911  lblQuantity.Enabled := true;
     2912  tQuantity.Enabled := true;
     2913  lblModifiers.Enabled := true;
     2914  cboModifiers.Enabled := true;
     2915  if not(changing) then
     2916    if not(uSelUrgency = 'PRE-OP') then
     2917      if uSelUrgency = '' then
     2918        if lvSelectionList.Items.Count < 1 then
     2919          cboUrgency.SelectByID(IntToStr(uDfltUrgency));
     2920  if cboUrgency.Text = 'PRE-OP' then
     2921    begin
     2922      lblSurgery.Enabled := true;
     2923      cboSurgery.Enabled := true;
     2924      lblSurgery.Caption := 'Surgery*';
     2925    end
    13392926    else
    13402927      begin
    1341         with ALabTest do
    1342           with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
    1343             begin
    1344               x := '' ;
    1345               for i := 0 to WardComment.Count-1 do
    1346                 x := x + WardComment.strings[i]+#13#10 ;
    1347               pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
    1348               OrderMessage(x) ;
    1349             end ;
     2928        lblSurgery.Enabled := false;
     2929        cboSurgery.Enabled := false;
     2930        lblSurgery.Caption := 'Surgery';
    13502931      end;
    1351     if ObtainComment then
    1352       LoadRequiredComment(FCmtTypes.IndexOf(CurReqComment))
    1353     else
    1354       DisableCommentPanels;
    1355     x := '' ;
    1356     for i := 0 to CurWardComment.Count-1 do
    1357       x := x + CurWardComment.strings[i]+#13#10 ;
    1358     i :=  IndexOfCollSamp(CollSamp);
    1359     if i > -1 then with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
    1360        for i := 0 to WardComment.Count-1 do
    1361          x := x + WardComment.strings[i]+#13#10 ;
    1362     pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
    1363     OrderMessage(x) ;
    1364    end; { with }
    1365   StatusText('');
    1366   Changing := False;
    1367 end;
    1368 
    1369 procedure TfrmODBBank.cboAvailCompSelect(Sender: TObject);
    1370 var
    1371   x: string;
    1372   i: integer;
    1373 begin
    1374   DisableDiagTestControls;
    1375   EnableComponentControls;
    1376   LRORDERMODE := TORDER_MODE_COMP;
    1377   with cboAvailComp do
    1378     begin
    1379       if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
    1380       for i := 0 to uSelectedItems.Count - 1 do
    1381         if ItemID = piece(uSelectedItems[i],'^',1) then
    1382           begin
    1383             ShowMessage('This component has already been selected!');
    1384             Exit;
    1385           end;
    1386       FLastLabID := ItemID ;
    1387       FLastItemID := ItemID;
    1388       Changing := True;
    1389       if Sender <> Self then
    1390         Responses.Clear;       // Sender=Self when called from SetupDialog
    1391       if CharAt(ItemID, 1) = 'Q' then
    1392         with Responses do
    1393           begin
    1394             FLastItemID := ItemID;
    1395             QuickOrder := ExtractInteger(ItemID);
    1396             SetControl(cboAvailComp, 'ORDERABLE', 1);
    1397             if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
    1398             FLastLabID := ItemID;
    1399           end;
    1400       ALabTest := TLabTest.Create(ItemID, Responses);
    1401     end;
    1402   with ALabTest do
    1403   begin
    1404 
    1405     {with Responses do if QuickOrder > 0 then
    1406      begin
    1407       StatusText('Initializing Quick Order');
    1408       Changing := True;
    1409       SetControl(cboAvailTest,       'ORDERABLE', 1);
    1410       DetermineCollectionDefaults(Responses);
    1411       LoadUrgency(cboCollType.ItemID, cboUrgency);
    1412       SetControl(cboUrgency,         'URGENCY', 1);
    1413       Urgency := cboUrgency.ItemIEN;
    1414       if (Urgency = 0) and (cboUrgency.Items.Count = 1) then
    1415         begin
    1416           cboUrgency.ItemIndex := 0;
    1417           Urgency := cboUrgency.ItemIEN;
    1418         end;
    1419       tmpResp := FindResponseByName('SPECIMEN'  ,1);
    1420       i := 1 ;
    1421       tmpResp := Responses.FindResponseByName('COMMENT',i);
    1422       while tmpResp <> nil do
    1423         begin
    1424           Comment.Add(tmpResp.EValue);
    1425           Inc(i);
    1426           tmpResp := Responses.FindResponseByName('COMMENT',i);
    1427         end ;
    1428       end;  //  Quick Order}
    1429     {if ObtainCollSamp then
    1430       begin
    1431         // should not occur with Blood orders
    1432       end
    1433     else
    1434       begin
    1435         with ALabTest do
    1436           with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
    1437             begin
    1438               x := '' ;
    1439               for i := 0 to WardComment.Count-1 do
    1440                 x := x + WardComment.strings[i]+#13#10 ;
    1441               pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
    1442               OrderMessage(x) ;
    1443             end ;
    1444       end;
    1445      }
    1446     if ObtainComment then
    1447       LoadRequiredComment(FCmtTypes.IndexOf(CurReqComment))
    1448     else
    1449       DisableCommentPanels;
    1450     x := '' ;
    1451     for i := 0 to CurWardComment.Count-1 do
    1452       x := x + CurWardComment.strings[i]+#13#10 ;
    1453     i :=  IndexOfCollSamp(CollSamp);
    1454     if i > -1 then with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
    1455        for i := 0 to WardComment.Count-1 do
    1456          x := x + WardComment.strings[i]+#13#10 ;
    1457     pnlMessage.TabOrder := cboAvailComp.TabOrder + 1;
    1458     OrderMessage(x) ;
    1459    end; { with }
    1460   StatusText('');
    1461   Changing := False;
    1462 end;
    1463 
    1464 procedure TfrmODBBank.DisableCommentPanels;
    1465 begin
    1466   lblReqComment.Visible := False;
    1467 end;
    1468 
    1469 procedure TfrmODBBank.DisableComponentControls;
    1470 begin
    1471   lblModifiers.Enabled := false;
    1472   cboModifiers.Enabled := false;
    1473   lblWanted.Enabled := false;
    1474   calWantTime.Enabled := false;
    1475   //lblPreparation.Enabled := false;
    1476   //cboPreparation.Enabled := false;
    1477   lblSurgery.Enabled := false;
    1478   cboSurgery.Enabled := false;
    1479   lblReason.Enabled := false;
    1480   tReason.Enabled := false;
    1481   chkConsent.Enabled := false;
    1482   lblQuantity.Enabled := false;
    1483   tQuantity.Enabled := false;
    1484   upQuantity.Enabled := false;
    1485   cboAvailComp.ItemIndex := -1;
    1486   tQuantity.Text := '0';
    1487 end;
    1488 
    1489 procedure TfrmODBBank.EnableComponentControls;
    1490 begin
    1491   lblModifiers.Enabled := true;
    1492   cboModifiers.Enabled := true;
    1493   lblWanted.Enabled := true;
    1494   calWantTime.Enabled := true;
    1495   //lblPreparation.Enabled := true;
    1496   //cboPreparation.Enabled := true;
    1497   if cboUrgency.Text = 'PRE-OP' then
    1498     begin
    1499       lblSurgery.Enabled := true;
    1500       cboSurgery.Enabled := true;
    1501     end;
    1502   lblReason.Enabled := true;
    1503   tReason.Enabled := true;
    1504   chkConsent.Enabled := true;
    1505   lblQuantity.Enabled := true;
    1506   tQuantity.Enabled := true;
    1507   upQuantity.Enabled := true;
    1508   txtDiagComment.Enabled := true;
    15092932  lblDiagComment.Enabled := true;
    15102933end;
    … …  
    15152938  calCollTime.Enabled := false;
    15162939  cboCollTime.Enabled := false;
    1517   cboAvailTest.ItemIndex := -1;
    15182940  lblCollType.Enabled := false;
    15192941  cboCollType.Enabled := false;
    15202942  cmdImmedColl.Enabled := false;
     2943  cboAvailTest.ItemIndex := -1;
     2944  cboAvailTest.InitLongList('');
    15212945end;
    15222946
    15232947procedure TfrmODBBank.EnableDiagTestControls;
    15242948begin
    1525   calWantTime.Enabled := true;
    1526   lblWanted.Enabled := true;
    15272949  lblCollTime.Enabled := true;
    15282950  calCollTime.Enabled := true;
    … …  
    15302952  lblCollType.Enabled := true;
    15312953  cboCollType.Enabled := true;
    1532   lblUrgency.Enabled := true;
    1533   cboUrgency.Enabled := true;
    1534   txtDiagComment.Enabled := true;
    1535   lblDiagComment.Enabled := true;
    15362954  cmdImmedColl.Enabled := true;
     2955  if not(changing) then
     2956    if not(uSelUrgency = 'PRE-OP') then
     2957      if uSelUrgency = '' then
     2958        if lvSelectionList.Items.Count < 1 then
     2959          cboUrgency.SelectByID(IntToStr(uDfltUrgency));
    15372960end;
    15382961
    … …  
    15482971begin
    15492972  if ALabTest = nil then exit;
     2973  if ALabTest.LabSubscript = 'BB' then exit;
    15502974  calCollTime.Clear;
    15512975  cboCollTime.Clear;
    … …  
    16183042end;
    16193043
     3044procedure TfrmODBBank.cboAvailCompChange(Sender: TObject);
     3045begin
     3046  inherited;
     3047  changing := true;
     3048  changing := false;
     3049end;
     3050
    16203051procedure TfrmODBBank.cboAvailCompExit(Sender: TObject);
    16213052begin
    … …  
    16623093  inherited;
    16633094  case pgeProduct.TabIndex of
    1664   TI_ORDER :     begin
    1665                   memMessage.Visible := true;
     3095  TI_COMPONENT :     begin
    16663096                  memOrder.Visible := true;
    16673097                  cmdAccept.Visible := true;
    16683098                  pnlSelectedTests.Visible := true;
    1669                   pgeProduct.Height := 281;
     3099                  lvSelectionList.Width := lvSelectionList.Width + 1; //added to fix font resize issue - funky column display
    16703100                end;
    16713101  TI_INFO :     begin
    1672                   if lvSelectionList.Items.Count > 0 then exit;
    1673                   LRORDERMODE := TORDER_MODE_INFO;
    1674                   memMessage.Visible := false;
    1675                   memOrder.Visible := false;
    1676                   cmdAccept.Visible := false;
    1677                   pnlSelectedTests.Visible := false;
    1678                   pgeProduct.Height := 411;
     3102                  if lvSelectionList.Items.Count > 0 then
     3103                  begin
     3104                    memOrder.Visible := true;
     3105                    cmdAccept.Visible := true;
     3106                    pnlSelectedTests.Visible := true;
     3107                  end
     3108                  else
     3109                  begin
     3110                    memOrder.Visible := false;
     3111                    cmdAccept.Visible := false;
     3112                    pnlSelectedTests.Visible := false;
     3113                  end;
    16793114                end;
    16803115  TI_RESULTS :  begin
    1681                   if lvSelectionList.Items.Count > 0 then exit;
    1682                   memMessage.Visible := false;
    1683                   memOrder.Visible := false;
    1684                   cmdAccept.Visible := false;
    1685                   pnlSelectedTests.Visible := false;
    1686                   pgeProduct.Height := 411;
     3116                  if lvSelectionList.Items.Count > 0 then
     3117                  begin
     3118                    memOrder.Visible := true;
     3119                    cmdAccept.Visible := true;
     3120                    pnlSelectedTests.Visible := true;
     3121                  end
     3122                  else
     3123                  begin
     3124                    memOrder.Visible := false;
     3125                    cmdAccept.Visible := false;
     3126                    pnlSelectedTests.Visible := false;
     3127                  end;
    16873128                end;
    16883129  end; {case}
    16893130end;
    16903131
    1691 procedure TfrmODBBank.cboCollTypeChange(Sender: TObject);
    1692 begin
    1693   if (ALabTest = nil) or Changing or (cboCollType.ItemID = '') then exit;
    1694   if (cboCollType.ItemID = 'I') and (not ALabTest.LabCanCollect) then
    1695     begin
    1696       InfoBox(TX_NO_IMMED, TX_NO_IMMED_CAP, MB_OK or MB_ICONWARNING);
    1697       cboCollType.ItemIndex := -1;
    1698       Exit;
    1699     end;
    1700   SetupCollTimes(cboCollType.ItemID);
    1701 end;
    1702 
    1703 procedure TfrmODBBank.LoadModifiers(AComboBox:TORComboBox);
     3132procedure TfrmODBBank.cboCollTimeChange(Sender: TObject);
    17043133var
    1705   i: integer;
    1706 begin
    1707   with AComboBox do
    1708     begin
    1709       Clear;
    1710       for i := 0 to uModifierList.Count - 1 do
    1711            Items.Add(uModifierList[i]);
    1712     end;
    1713 end;
    1714 
    1715 procedure TfrmODBBank.LoadUrgencies(AComboBox:TORComboBox);
    1716 var
    1717   i: integer;
    1718 begin
    1719   with AComboBox do
    1720     begin
    1721       Clear;
    1722       for i := 0 to uUrgencyList.Count - 1 do
    1723          if (piece(uUrgencyList[i],'^',2) = 'STAT') and (StatAllowed(Patient.DFN) = false) then
    1724            Continue
    1725          else
    1726            Items.Add(uUrgencyList[i]);
    1727     end;
    1728 end;
    1729 
    1730 procedure TfrmODBBank.btnAddTestsClick(Sender: TObject);
    1731 var
    1732   aList, aTests, aRaw: TStringList;
    1733   ListItem: TListItem;
    1734   aStr, aMsg: String;                  //add independent structures for components, Tests, and associated fields.
    1735   aCollType, aModifier, aPreparation, aSurgery, aCollTime, aTestYes, aSpecimen, aCollSave: String;
    1736   CurAdd, i, j, k, getTest, TestAdded, aMSBOS, aMSBOSContinue: Integer;
    1737   x, name, aTypeScreen: String;
    1738 begin
    1739   if not ValidAdd then Exit;
    1740   aList := TStringList.Create;
    1741   aTests := TStringList.Create;
    1742   aRaw := TStringList.Create;
    1743   try
    1744     aCollType := '';
    1745     aModifier := '';
    1746     aPreparation := '';
    1747     aSurgery := '';
    1748     aCollTime := '';
    1749     aTestYes := '0';
    1750     aTypeScreen := '';
    1751     uGetTnS := 0;
    1752     aSpecimen := '';
    1753     ExtractTypeScreen(aList, uVBECList);
    1754     if aList.Count > 0 then aTypeScreen := aList[0];
    1755     aList.Clear;
    1756     ExtractSpecimen(aList, uVBECList);
    1757     if aList.Count > 0 then aSpecimen := aList[0];
    1758     if LRORDERMODE = TORDER_MODE_DIAG then aTestYes := '1';
    1759     if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex];
    1760     //if length(cboPreparation.ItemID) > 0 then aPreparation := cboPreparation.Items[cboPreparation.ItemIndex];
    1761     if length(cboSurgery.ItemID) > 0 then aSurgery := cboSurgery.Items[cboSurgery.ItemIndex];
    1762     if length(cboCollTime.ItemID) > 0 then aCollTime := cboCollTime.Items[cboCollTime.ItemIndex];
    1763     if (LRORDERMODE = TORDER_MODE_DIAG) and (length(cboAvailTest.ItemID) > 0) then
    1764       begin
    1765         uTestSelected := true;
    1766         with lvSelectionList do
    1767           begin
    1768             ListItem := Items.Add;
    1769             ListItem.Caption := piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',2);
    1770             ListItem.SubItems.Add('');
    1771             if length(cboModifiers.ItemID) > 0 then ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex])
    1772               else ListItem.SubItems.Add('');
    1773             ListItem.SubItems.Add(piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1));
    1774             if piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1) = aTypeScreen then
    1775               begin
    1776                 lblTNS.Caption := '';
    1777                 lblTNS.Visible := false;
    1778               end;
    1779           end;
    1780         lblCollTime.Enabled := false;
    1781         calCollTime.Enabled := false;
    1782         cboCollTime.Enabled := false;
    1783         lblCollType.Enabled := false;
    1784         cboCollType.Enabled := false;
    1785         cboAvailTest.ItemIndex := -1;
    1786       end;
    1787     if (LRORDERMODE = TORDER_MODE_COMP) and (length(cboAvailComp.ItemID) > 0) then
    1788       begin
    1789         if Length(cboSurgery.ItemID) > 0 then
    1790           begin
    1791             aList.Clear;
    1792             ExtractMSBOS(aList, uVBECList);    //Get maximum units for selected Surgey
    1793             for i := 0 to aList.Count - 1 do
    1794               begin
    1795                 if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
    1796                  and (StrToInt(piece(aList[i],'^',2)) = cboSurgery.ItemID) then
    1797                   begin
    1798                     aMSBOS := StrToInt(piece(aList[i],'^',4));
    1799                     if (aMSBOS > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then
    1800                       begin
    1801                         with Application do
    1802                         begin
    1803                           NormalizeTopMosts;
    1804                           aMSBOSContinue :=
    1805                             MessageBox(PChar('The number of units ordered (' + tQuantity.Text +
    1806                                        ') exceeds the maximum number of units (' + IntToStr(aMSBOS) +
    1807                                        ') for the ' + cboSurgery.text +
    1808                                        ' surgical procedure selected.' + CRLF + CRLF + 'Do you wish to continue?'),
    1809                                        PChar('Maximum Number of Units Exceeded'),
    1810                                        MB_YESNO);
    1811                           RestoreTopMosts;
    1812                         end;
    1813                         if aMSBOSContinue = 7 then
    1814                           begin
    1815                             ShowMessage(cboAvailComp.Text + ' has NOT been added to this request.');
    1816                             exit;
    1817                           end;
    1818                       end;
    1819                   end;
    1820               end;
    1821           end;
    1822         if SpecimenNeeded(aList, uVBECList, aLabTest.ItemID) then  //check to see if type and screen is needed
    1823           begin
    1824             uGetTnS := 1;
    1825             for i := 0 to lvSelectionList.Items.Count - 1 do
    1826               begin
    1827                 if lvSelectionList.Items[i].SubItems[2] = aTypeScreen then
    1828                   begin
    1829                     uGetTnS := 0;
    1830                     uDfltUrgency := cboUrgency.ItemID;
    1831                     lblTNS.Caption := '';
    1832                     lblTNS.Visible := false;
    1833                     break;
    1834                   end;
    1835               end;
    1836           end;
    1837         aList.Clear;
    1838         ExtractSpecimens(aList, uVBECList);    //Get specimen values to pass back to Server
    1839         for i := 0 to aList.Count - 1 do
    1840           begin
    1841             if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) then
    1842               begin
    1843                 aSpecimen := piece(aList[i],'^',2) + '^' + aSpecimen;
    1844                 break;
    1845               end;
    1846           end;
    1847         uComponentSelected := true;
    1848         with lvSelectionList do
    1849           begin
    1850             ListItem := Items.Add;
    1851             ListItem.Caption := piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2);
    1852             ListItem.SubItems.Add(tQuantity.Text);
    1853             if length(cboModifiers.ItemID) > 0 then ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex])
    1854               else ListItem.SubItems.Add('');
    1855             ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
    1856           end;
    1857         lblWanted.Enabled := false;
    1858         calWantTime.Enabled := false;
    1859         //lblPreparation.Enabled := false;
    1860         //cboPreparation.Enabled := false;
    1861         lblSurgery.Enabled := false;
    1862         cboSurgery.Enabled := false;
    1863         lblReason.Enabled := false;
    1864         tReason.Enabled := false;
    1865         chkConsent.Enabled := false;
    1866         cboAvailComp.ItemIndex := -1;
    1867       end;
    1868     if Sender <> Self then
    1869       Responses.Clear;       // Sender=Self when called from SELF
    1870     CurAdd := 1;
    1871     aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimen;  //aSpecimen has 2 pieces
    1872     uSelectedItems.Add(aStr);
    1873     for i := 0 to uSelectedItems.Count - 1 do
    1874       begin
    1875         name := lvSelectionList.Items[i].Caption;
    1876         x := uSelectedItems[i];
    1877         if piece(x,'^',1) = '1' then    //Diagnostic Test related fields
    1878           begin
    1879             if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), name);
    1880           end
    1881         else
    1882           begin
    1883             if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), name);
    1884             if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3));
    1885             if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), aModifier);
    1886             if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5));
    1887             if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
    1888           end;
    1889         Inc(CurAdd);
    1890         aList.Clear;
    1891         TestAdded := 0;
    1892         getTest := 0;
    1893         ExtractTests(aList, uVBECList);   //Get Results associated with ordered components
    1894         for j := 0 to aList.Count - 1 do
    1895           begin
    1896             if StrToInt(piece(aList[j],'^',1)) = aLabTest.ItemID then
    1897               begin
    1898                 if uTestsForResults.Count < 1 then getTest := 1;
    1899                 for k := 0 to uTestsForResults.Count - 1 do
    1900                   begin
    1901                     if piece(uTestsForResults[k],'^',1) = piece(aList[j],'^',3) then
    1902                       begin
    1903                         getTest := 0;
    1904                         break;
    1905                       end
    1906                     else getTest := 1;
    1907                   end;
    1908                 if getTest = 1 then
    1909                   begin
    1910                     uTestsForResults.Add(piece(aList[j],'^',3));
    1911                     TestAdded := 1;
    1912                   end;
    1913               end;
    1914           end;
    1915         if TestAdded = 1 then
    1916           begin
    1917             edtResults.Clear;
    1918             aTests.Clear;
    1919             GetPatientBloodResults(aTests, Patient.DFN, uTestsForResults);
    1920             QuickCopy(ATests,edtResults);
    1921             if edtResults.Lines.Count > 0 then TabResults.ImageIndex := 1;
    1922             uRaw.Clear;
    1923             GetPatientBloodResultsRaw(uRaw, Patient.DFN, uTestsForResults);
    1924           end;
    1925       end;
    1926     if LRORDERMODE = TORDER_MODE_DIAG then
    1927       begin
    1928         if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
    1929         with cboCollType do if Length(ItemID) > 0 then
    1930           begin
    1931             Responses.Update('COLLECT', 1, ItemID, ItemID) ;
    1932             FLastCollType := ItemID;
    1933           end;
    1934         if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
    1935         if Length(txtDiagComment.Text) > 0 then Responses.Update('COMMENT',1,txtDiagComment.Text,txtDiagComment.Text);
    1936         if cboCollType.ItemID = 'LC' then
    1937           begin
    1938             with cboCollTime do
    1939               if Length(ItemID) > 0 then
    1940                 begin
    1941                   Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
    1942                   FLastLabCollTime := ItemID + U + Text;
    1943                 end
    1944               else if Length(Text) > 0 then
    1945                 begin
    1946                   Responses.Update('START', 1, ValidCollTime(Text), Text) ;
    1947                   FLastLabCollTime := ValidCollTime(Text);
    1948                 end;
    1949           end
    1950         else
    1951           begin
    1952             with calCollTime do
    1953               if FMDateTime > 0 then
    1954                 begin
    1955                   Responses.Update('START', 1, ValidCollTime(Text), Text);
    1956                   FLastColltime := ValidCollTime(Text);
    1957                 end
    1958               else
    1959                 begin
    1960                   Responses.Update('START', 1, '', '') ;
    1961                   FLastCollTime := '';
    1962                 end;
    1963           end;
    1964       end;
    1965     if LRORDERMODE = TORDER_MODE_COMP then
    1966       begin
    1967         if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
    1968         if Length(txtDiagComment.Text) > 0 then Responses.Update('COMMENT',1,txtDiagComment.Text,txtDiagComment.Text);
    1969         if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
    1970         //if Length(cboPreparation.Text) > 0 then Responses.Update('XFUSION',1,cboPreparation.ItemID,cboPreparation.Text);
    1971         if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
    1972         if Length(tReason.Text) > 0 then Responses.Update('REASON',1,tReason.Text,tReason.Text);
    1973         if chkConsent.Checked = true then Responses.Update('YN',1,'1','Yes');
    1974       end;
    1975     memOrder.Text := Responses.OrderText;
    1976     CurAdd := 1;
    1977     if uRaw.Count > 0 then
    1978       for j := 0 to uRaw.Count - 1 do
     3134  CollType: string;
     3135const
     3136  TX_BAD_TIME         = ' is not a routine lab collection time.' ;
     3137  TX_BAD_TIME_CAP     = 'Invalid Time';
     3138begin
     3139  CollType := 'LC';
     3140  with cboCollTime do
     3141    begin
     3142      if ItemID = 'LO' then
    19793143        begin
    1980           if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));
    1981           Inc(CurAdd);
     3144          ItemIndex := -1;
     3145          Text := GetFutureLabTime(FMToday);
    19823146        end;
    1983     tQuantity.Text := '0';
    1984     ALabTest := nil;
    1985   finally
    1986     aList.Free;
    1987     aTests.Free;
    1988     aRaw.Free;
    1989   end;
    1990   aMsg := '';
    1991   if UgetTnS = 1 then
    1992     begin
    1993       lblTNS.Caption := 'TYPE + SCREEN must be added to order';
    1994       lblTNS.Visible := true;
    1995       cboAvailTest.SelectByID(aTypeScreen);
    1996       cboAvailTestSelect(self);
    1997     end;
    1998   {if getTnS = 1 then
    1999     begin
    2000       for i := 1 to cboAvailTest.Items.Count - 1 do
    2001         begin
    2002           if piece(cboAvailTest.Items[i],'^',1) = aTypeScreen then
    2003             begin
    2004               if piece(aSpecimen,'^',1) = '1' then
    2005                 begin
    2006                   cboCollTime.Text := calWantTime.Text;
    2007                   aCollSave := cboCollTime.Text + '^' + cboCollTime.ItemID + '^' + cboCollType.Text + '^' + cboCollType.ItemID;
    2008                   cboCollTime.Text := '';
    2009                   cboCollType.Text := '';
    2010                   uSpecimen := 1;
    2011                 end;
    2012               cboModifiers.Text := '';
    2013               cboAvailTest.SelectByID(aTypeScreen);
    2014               cboAvailTestSelect(Self);
    2015               btnAddTestsClick(Self);
    2016               uSpecimen := 0;
    2017               cboCollTime.Text := piece(aCollSave,'^',1);
    2018               cboCollType.Text := piece(aCollSave,'^',3);
    2019               aCollSave := '';
    2020               break;
    2021             end;
    2022         end;
    2023       aMsg := 'An order for Type and Screen has been added to this request' + '.';
    2024     end;
    2025   if (getTns = 1) then
    2026     begin
    2027       if length(aMsg) > 0 then aMsg := aMsg + crlf + crlf;
    2028       ShowMessage(aMsg);
    2029     end;}
    2030   cboModifiers.Text := '';
    2031   edtResults.Height := 247;
    2032   edtInfo.Height := 247;
    2033 end;
    2034 
    2035 procedure TfrmODBBank.FormDestroy(Sender: TObject);
    2036 begin
    2037   inherited;
    2038   uSelectedItems.Free;
    2039   uVBECList.Free;
    2040   uTestsForResults.Free;
    2041   uUrgencyList.Free;
    2042   uModifierList.Free;
    2043   uRaw.Free;
    2044 end;
    2045 
    2046 procedure TfrmODBBank.btnRemoveClick(Sender: TObject);
    2047 var
    2048   i,j,curAdd: integer;
    2049   x, name, aModifier, aTypeScreen: string;
    2050   aList: TStringList;
    2051 begin
    2052   inherited;
    2053   aList := TStringList.Create;
    2054   curAdd := 1;
    2055   aModifier := '';
    2056   aTypeScreen := '';
    2057   ExtractTypeScreen(aList, uVBECList);
    2058   if aList.Count > 0 then aTypeScreen := aList[0];
    2059   aList.Clear;
    2060   if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex];
    2061   with lvSelectionList do
    2062     begin
    2063       for i := lvSelectionList.Items.Count - 1 downto 0 do
    2064         begin
    2065           if lvSelectionList.Items[i].Selected = true then
    2066             for j := uSelectedItems.Count - 1 downto 0 do
    2067             if lvSelectionList.Items[i].SubItems[2] = piece(uSelectedItems[j],'^',2) then
    2068               begin
    2069                 if lvSelectionList.Items[i].SubItems[2] = aTypeScreen then
    2070                   begin
    2071                     uGetTnS := 1;
    2072                     lblTNS.Caption := 'TYPE+SCREEN must be added to order';
    2073                     lblTNS.Visible := true;
    2074                   end;
    2075                 uSelectedItems.Delete(j);
    2076                 lvSelectionList.Items[i].Delete;
    2077                 break;
    2078               end;
    2079         end;
    2080     end;
    2081   Responses.Clear;
    2082   for i := 0 to uSelectedItems.Count - 1 do
    2083     begin
    2084       name := lvSelectionList.Items[i].Caption;
    2085       x := uSelectedItems[i];
    2086       if piece(x,'^',1) = '1' then    //Diagnostic Test related fields
    2087         begin
    2088           if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), name);
    2089         end
    2090       else
    2091         begin
    2092           if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), name);
    2093           if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3));
    2094           if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), aModifier);
    2095           if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5));
    2096         end;
    2097       Inc(CurAdd);
    2098     end;
    2099   if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
    2100   if cboCollType.ItemID = 'LC' then
     3147    end;
     3148  cboCollType.SelectByID(CollType);
     3149  if uSelectedItems.Count > 0 then
    21013150    begin
    21023151      with cboCollTime do
    … …  
    21113160            FLastLabCollTime := ValidCollTime(Text);
    21123161          end;
     3162    end;
     3163end;
     3164
     3165procedure TfrmODBBank.cboCollTypeChange(Sender: TObject);
     3166begin
     3167  if (ALabTest = nil) or Changing or (cboCollType.ItemID = '') then exit;
     3168  if (cboCollType.ItemID = 'I') and (not ALabTest.LabCanCollect) then
     3169    begin
     3170      InfoBox(TX_NO_IMMED, TX_NO_IMMED_CAP, MB_OK or MB_ICONWARNING);
     3171      cboCollType.ItemIndex := -1;
     3172      Exit;
     3173    end;
     3174  if cboCollType.ItemID = 'I' then
     3175  begin
     3176    cboCollTime.ItemIndex := -1;
     3177    cboCollTime.Text := 'NOW';
     3178    calCollTime.Text := 'NOW';
     3179  end;
     3180  SetupCollTimes(cboCollType.ItemID);
     3181  if Length(cboCollType.Text) > 0 then Responses.Update('COLLECT',1,cboCollType.ItemID,cboCollType.ItemID);
     3182  FLastCollType := cboCollType.ItemID;
     3183  calCollTimeChange(self);
     3184end;
     3185
     3186procedure TfrmODBBank.cboModifiersChange(Sender: TObject);
     3187var
     3188  i: integer;
     3189  ListItem: TListItem;
     3190  x,q,m: string;
     3191begin
     3192  inherited;
     3193  if changing = true then Exit;
     3194  if (cboAvailComp.ItemIndex <> -1) and (uSelectedItems.Count > 0) then
     3195    begin
     3196      for i := 0 to lvSelectionList.Items.Count - 1 do
     3197        begin
     3198          x := uSelectedItems[i];
     3199          m := piece(x,'^',4);
     3200          q := piece(x,'^',3);
     3201          if lvSelectionList.Items[i].Caption = piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2) then
     3202            begin
     3203              ListItem := lvSelectionList.Items[i];
     3204              ListItem.SubItems.Clear;
     3205              ListItem.SubItems.Add(q);
     3206              if length(cboModifiers.ItemID) > 0 then
     3207                begin
     3208                  ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]);
     3209                  ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex));
     3210                end
     3211                else
     3212                  begin
     3213                    ListItem.SubItems.Add('');
     3214                    ListItem.SubItems.Add('');
     3215                  end;
     3216              ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
     3217              Responses.Update('MODIFIER', (i+1), cboModifiers.Text, cboModifiers.Text);
     3218              Break;
     3219            end;
     3220        end;
     3221    end;
     3222  if Length(cboModifiers.Text) > 0 then
     3223    begin
     3224      memOrder.Text := Responses.OrderText;
     3225    end;
     3226end;
     3227
     3228procedure TfrmODBBank.LoadModifiers(AComboBox:TORComboBox);
     3229var
     3230  i: integer;
     3231begin
     3232  with AComboBox do
     3233    begin
     3234      Clear;
     3235      for i := 0 to uModifierList.Count - 1 do
     3236           Items.Add(uModifierList[i]);
     3237    end;
     3238end;
     3239
     3240procedure TfrmODBBank.LoadReasons(AComboBox:TORComboBox);
     3241var
     3242  i: integer;
     3243begin
     3244  with AComboBox do
     3245    begin
     3246      Clear;
     3247      for i := 0 to uReasonsList.Count - 1 do
     3248           Items.Add(uReasonsList[i]);
     3249    end;
     3250end;
     3251
     3252procedure TfrmODBBank.LoadUrgencies(AComboBox:TORComboBox);
     3253var
     3254  i: integer;
     3255begin
     3256  with AComboBox do
     3257    begin
     3258      Clear;
     3259      for i := 0 to uUrgencyList.Count - 1 do
     3260         if (piece(uUrgencyList[i],'^',2) = 'STAT') and (StatAllowed(Patient.DFN) = false) then
     3261           Continue
     3262         else
     3263           Items.Add(uUrgencyList[i]);
     3264    end;
     3265end;
     3266
     3267procedure TfrmODBBank.lvSelectionListClick(Sender: TObject);
     3268var
     3269  ListItem: TListItem;
     3270  x,y: string;
     3271  i,j: integer;
     3272begin
     3273  inherited;
     3274  if lvSelectionList.Selected = nil then Exit;
     3275  ListItem := lvSelectionList.Selected;
     3276  changing := true;
     3277  tQuantity.Text := '';
     3278  cboModifiers.ItemIndex := -1;
     3279  i := lvSelectionList.ItemIndex;
     3280  j := 0;
     3281  if cboCollType.ItemID = 'LC' then
     3282    begin
     3283      if FLastLabCollTime <> '' then
     3284        cboCollTime.SelectByID(piece(FLastLabCollTime,'^',1));
    21133285    end
    21143286  else
    21153287    begin
    2116       with calCollTime do
    2117         if FMDateTime > 0 then
     3288      if FLastCollTime = 'TODAY' then
     3289        calCollTime.Text := FLastCollTime
     3290      else if FLastCollTime = 'NOW' then
     3291        calCollTime.Text := FLastCollTime
     3292      else if FLastCollTime <> '' then
     3293        calCollTime.Text := FormatFMDateTime('mmm dd,yyyy@hh:nn',StrToFMDateTime(FLastCollTime));
     3294    end;
     3295  if FLastCollType <> '' then
     3296    cboCollType.SelectByID(FLastCollType);
     3297  if uSelectedItems.Count > 0 then
     3298    begin
     3299      x := uSelectedItems[i];
     3300      ALabTest := TLabTest.Create(piece(uSelectedItems[i],'^',2), Responses);
     3301      if not(piece(x,'^',2) = '') then j := StrToInt(piece(x,'^',2));
     3302      if not(piece(x,'^',1) = '1') and (j > 0) then //Components
     3303        begin
     3304          DisableDiagTestControls;
     3305          EnableComponentControls;
     3306          y := ListItem.SubItems[2];
     3307          changing := true;
     3308          cboModifiers.Text := '';
     3309          cboAvailComp.SelectByIEN(j);
     3310          tQuantity.Text := ListItem.SubItems[0];
     3311          changing := false;
     3312          if y <> '' then cboModifiers.ItemIndex := StrToInt(y);
     3313        end
     3314      else                            //Diagnostic Tests
     3315        begin
     3316          DisableComponentControls;
     3317          EnableDiagTestControls;
     3318          cboAvailTest.SelectByIEN(j);
     3319        end;
     3320    end;
     3321  changing := false;
     3322end;
     3323
     3324procedure TfrmODBBank.memDiagCommentChange(Sender: TObject);
     3325begin
     3326  inherited;
     3327  if (length(memDiagComment.Text) > 250) then
     3328    begin
     3329      ShowMsg('COMMENT cannot be longer than 250 characters');
     3330      memDiagComment.Text := Copy(memDiagComment.Text,0,250);
     3331      Exit;
     3332    end;
     3333  if lvSelectionList.Items.Count < 1 then Exit;
     3334
     3335  if uSelectedItems = nil then Exit;
     3336 
     3337  if uSelectedItems.Count > 0 then
     3338    Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
     3339  memOrder.Text := Responses.OrderText;
     3340end;
     3341
     3342procedure TfrmODBBank.FormDestroy(Sender: TObject);
     3343begin
     3344  inherited;
     3345  uSelectedItems.Free;
     3346  uVBECList.Free;
     3347  uTestsForResults.Free;
     3348  uUrgencyList.Free;
     3349  uTNSOrders.Free;
     3350  uModifierList.Free;
     3351  uReasonsList.Free;
     3352  uRaw.Free;
     3353end;
     3354
     3355procedure TfrmODBBank.btnRemoveClick(Sender: TObject);
     3356var
     3357  i,j,curAdd: integer;
     3358  x, aName, aModifier, aReason, aTypeScreen: string;
     3359  aList: TStringList;
     3360  aSel, aSelTst : boolean;
     3361begin
     3362  inherited;
     3363  aList := TStringList.Create;
     3364  try
     3365    curAdd := 1;
     3366    aModifier := '';
     3367    aReason := '';
     3368    aTypeScreen := '';
     3369    aSel := false;
     3370    aSelTst := false;
     3371    ExtractTypeScreen(aList, uVBECList);
     3372    if aList.Count > 0 then aTypeScreen := aList[0];
     3373    aList.Clear;
     3374    if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex];
     3375    if length(cboReasons.ItemID) > 0 then aReason := cboReasons.Items[cboReasons.ItemIndex];
     3376    if lvSelectionList.Items.Count < 1 then
     3377      begin
     3378        ShowMsg('There is nothing in the list to remove.');
     3379        exit;
     3380      end;
     3381    cboAvailComp.ItemIndex := -1;
     3382    tQuantity.Text := '';
     3383    cboAvailTest.ItemIndex := -1;
     3384    uGetTnS := 0;
     3385    lblTNS.Caption := '';
     3386    lblTNS.Visible := false;
     3387    memMessage.Text := '';
     3388    pnlMessage.Visible := false;
     3389    pnlDiagnosticTests.Caption := 'Diagnostic Tests';
     3390    with lvSelectionList do
     3391      begin
     3392        for i := lvSelectionList.Items.Count - 1 downto 0 do
    21183393          begin
    2119             Responses.Update('START', 1, ValidCollTime(Text), Text);
    2120             FLastColltime := ValidCollTime(Text);
     3394            if lvSelectionList.Items[i].Selected = true then
     3395              begin
     3396                aSel := true;
     3397                for j := uSelectedItems.Count - 1 downto 0 do
     3398                  if lvSelectionList.Items[i].SubItems[3] = piece(uSelectedItems[j],'^',2) then
     3399                    begin
     3400                      {if (uGetTnS = 1) and (lvSelectionList.Items[i].SubItems[3] = aTypeScreen) then
     3401                        begin
     3402                          uGetTnS := 1;
     3403                          lblTNS.Caption := 'TYPE+SCREEN must be added to order';
     3404                          lblTNS.Visible := true;
     3405                          memMessage.Text := 'TYPE + SCREEN must be added to order';
     3406                          //memMessage.Visible := true;
     3407                          pnlMessage.Visible := true;
     3408                          pnlDiagnosticTests.Caption := 'Diagnostic Tests*';
     3409                        end; }
     3410                      uSelectedItems.Delete(j);
     3411                      lvSelectionList.Items[i].Delete;
     3412                      break;
     3413                    end;
     3414              end;
     3415          end;
     3416      end;
     3417    for i := uSelectedItems.Count - 1 downto 0 do
     3418      begin
     3419        if (not(piece(uSelectedItems[i],'^',1) = '1')) and (uTNSOrders.Count < 1) then // and (SpecimenNeeded(aList, uVBECList, StrToInt(piece(uSelectedItems[i],'^',9)))) then
     3420          begin
     3421            uGetTnS := 1;
     3422            lblTNS.Caption := 'TYPE+SCREEN must be added to order';
     3423            lblTNS.Visible := true;
     3424            memMessage.Text := 'TYPE + SCREEN must be added to order';
     3425            //memMessage.Visible := true;
     3426            pnlMessage.Visible := true;
     3427            pnlDiagnosticTests.Caption := 'Diagnostic Tests*';
     3428            break;
     3429          end;
     3430      end;
     3431     
     3432    if (aSel = false) and (lvSelectionList.Items.Count > 0) then
     3433      begin
     3434        ShowMsg('Please select an item from the list to be removed.');
     3435        exit;
     3436      end;
     3437    Responses.Clear;
     3438    if lvSelectionList.Items.Count < 1 then
     3439      begin
     3440        cboReasons.ItemIndex := -1;
     3441        memDiagComment.Text := '';
     3442        cboSurgery.ItemIndex := -1;
     3443        cboUrgency.ItemIndex := -1;
     3444        cboCollType.ItemIndex := -1;
     3445        cboCollTime.ItemIndex := -1;
     3446        cboQuick.ItemIndex := -1;
     3447        calCollTime.Text := '';
     3448      end;
     3449    for i := 0 to uSelectedItems.Count - 1 do
     3450      begin
     3451        aName := lvSelectionList.Items[i].Caption;
     3452        x := uSelectedItems[i];
     3453        if piece(x,'^',1) = '1' then    //Diagnostic Test related fields
     3454          begin
     3455            if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
     3456            aSelTst := true;
    21213457          end
    21223458        else
    21233459          begin
    2124             Responses.Update('START', 1, '', '') ;
    2125             FLastCollTime := '';
     3460            if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
     3461            if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3));
     3462            if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), aModifier);
     3463            if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5));
     3464            cboModifiers.ItemIndex := -1;
     3465            cboAvailComp.ItemIndex := -1;
     3466            tQuantity.Text := '';
    21263467          end;
    2127     end;
    2128   with cboCollType do if Length(ItemID) > 0 then
    2129     begin
    2130       Responses.Update('COLLECT', 1, ItemID, ItemID) ;
    2131       FLastCollType := ItemID;
    2132     end;
    2133   if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
    2134   if Length(txtDiagComment.Text) > 0 then Responses.Update('COMMENT',1,txtDiagComment.Text,txtDiagComment.Text);
    2135   //if Length(cboPreparation.Text) > 0 then Responses.Update('XFUSION',1,cboPreparation.ItemID,cboPreparation.Text);
    2136   if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
    2137   if Length(tReason.Text) > 0 then Responses.Update('REASON',1,tReason.Text,tReason.Text);
    2138   if chkConsent.Checked = true then Responses.Update('YN',1,'1','Yes');
    2139   memOrder.Text := Responses.OrderText;
    2140   CurAdd := 1;
    2141   if uRaw.Count > 0 then
    2142     for j := 0 to uRaw.Count - 1 do
    2143       begin
    2144         if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));
    21453468        Inc(CurAdd);
    21463469      end;
    2147   if uSelectedItems.Count < 1 then
    2148     begin
    2149       uGetTnS := 0;
    2150       lblTNS.Caption := '';
    2151       lblTNS.Visible := false;
    2152     end;
    2153   aList.Free;
     3470    if aSelTst = false then
     3471      begin
     3472        cboCollType.ItemIndex := -1;
     3473        cboCollTime.ItemIndex := -1;
     3474        calCollTime.Text := '';
     3475      end;
     3476    if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
     3477    if cboCollType.ItemID = 'LC' then
     3478      begin
     3479        with cboCollTime do
     3480          if Length(ItemID) > 0 then
     3481            begin
     3482              Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
     3483              FLastLabCollTime := ItemID + U + Text;
     3484            end
     3485          else if Length(Text) > 0 then
     3486            begin
     3487              Responses.Update('START', 1, ValidCollTime(Text), Text) ;
     3488              FLastLabCollTime := ValidCollTime(Text);
     3489            end;
     3490      end
     3491    else
     3492      begin
     3493        with calCollTime do
     3494          if FMDateTime > 0 then
     3495            begin
     3496              Responses.Update('START', 1, ValidCollTime(Text), Text);
     3497              FLastColltime := ValidCollTime(Text);
     3498            end
     3499          else
     3500            begin
     3501              Responses.Update('START', 1, '', '') ;
     3502              FLastCollTime := '';
     3503            end;
     3504      end;
     3505    with cboCollType do if Length(ItemID) > 0 then
     3506      begin
     3507        Responses.Update('COLLECT', 1, ItemID, ItemID) ;
     3508        FLastCollType := ItemID;
     3509      end;
     3510    if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
     3511    if Length(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
     3512    if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
     3513    if Length(cboReasons.Text) > 0 then Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text);
     3514    if chkConsent.Checked = true then Responses.Update('YN',1,'1','Yes');
     3515    memOrder.Text := Responses.OrderText;
     3516    CurAdd := 1;
     3517    if uRaw.Count > 0 then
     3518      for j := 0 to uRaw.Count - 1 do
     3519        begin
     3520          if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));
     3521          Inc(CurAdd);
     3522        end;
     3523    if uSelectedItems.Count < 1 then
     3524      begin
     3525        uGetTnS := 0;
     3526        lblTNS.Caption := '';
     3527        lblTNS.Visible := false;
     3528        memMessage.Text := '';
     3529        pnlMessage.Visible := false;
     3530        GroupBox1.Visible := true;
     3531        pnlDiagnosticTests.Caption := 'Diagnostic Tests';
     3532      end;
     3533  finally
     3534    aList.Free;
     3535  end;
     3536end;
     3537
     3538procedure TfrmODBBank.btnUpdateCommentsClick(Sender: TObject);
     3539begin
     3540  inherited;
     3541  pnlComments.Visible := false;
     3542  pnlComments.SendToBack;
     3543  Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
     3544  memOrder.Text := Responses.OrderText;
     3545end;
     3546
     3547procedure TfrmODBBank.btnCancelCommentClick(Sender: TObject);
     3548begin
     3549  inherited;
     3550  pnlComments.Visible := false;
     3551  pnlComments.SendToBack;
    21543552end;
    21553553
    … …  
    21573555begin
    21583556  inherited;
     3557  if lvSelectionList.Items.Count < 1 then
     3558    begin
     3559      ShowMsg('There is nothing in the list to remove.');
     3560      exit;
     3561    end;
    21593562  lvSelectionList.Clear;
    21603563  uSelectedItems.Clear;
    … …  
    21643567  lblTNS.Caption := '';
    21653568  lblTNS.Visible := false;
     3569  memMessage.Text := '';
     3570  pnlMessage.Visible := false;
    21663571  InitDialog;
     3572  cboModifiers.ItemIndex := -1;
     3573  cboAvailTest.ItemIndex := -1;
     3574  cboAvailComp.ItemIndex := -1;
     3575  cboSurgery.ItemIndex := -1;
     3576  cboUrgency.ItemIndex := -1;
     3577  cboReasons.ItemIndex := -1;
     3578  cboCollType.ItemIndex := -1;
     3579  cboCollTime.ItemIndex := -1;
     3580  cboQuick.ItemIndex := -1;
     3581  calWantTime.Text := '';
     3582  memDiagComment.Text := '';
     3583  GroupBox1.Visible := true;
     3584  tQuantity.Text := '';
     3585  FLastCollType := '';
     3586  FLastCollTime := '';
     3587  FLastLabCollTime := '';
     3588  txtImmedColl.Text := '';
    21673589end;
    21683590
    … …  
    21753597  Txt2 = #13+#13+'An order for TYPE and SCREEN must be created with this order set.';
    21763598begin
     3599  if not ValidAdd then Exit;
    21773600  if uGetTnS = 1 then
    21783601    begin
    … …  
    21913614    end;
    21923615  if Comp = true then
    2193     ShowMessage('The nursing blood administration order must be entered separately' + '.');
     3616    begin
     3617      if NursAdminSuppress = true then
     3618        ShowMsg('The nursing blood administration order must be entered separately' + '.');
     3619    end;
    21943620  inherited;
    21953621end;
    … …  
    21993625  inherited;
    22003626  if uSelectedItems.Count > 0 then
    2201     if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
     3627    begin
     3628      with calWantTime do if not Changing then
     3629        begin
     3630          if FMDateTime = 0 then
     3631            begin
     3632              ShowMsg('Invalid Date/Time entered');
     3633              Changing := true;
     3634              calWantTime.Text := '';
     3635              Changing := false;
     3636              Exit;
     3637            end
     3638          else
     3639            begin
     3640              // date/time was entered
     3641              if (UpperCase(Text) <> 'NOW') and not(Trunc(FMNow) = Trunc(FMDateTime)) and (FMDateTime < FMNow) then
     3642                begin
     3643                  ShowMsg('Date/Time Wanted must be a future Date/Time');
     3644                  Changing := true;
     3645                  calWantTime.Text := '';
     3646                  Changing := false;
     3647                  Exit;
     3648                end;
     3649            end;
     3650        end;
     3651      if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
     3652      memOrder.Text := Responses.OrderText;
     3653    end;
    22023654end;
    22033655
    … …  
    22073659  if uSelectedItems.Count > 0 then
    22083660    begin
    2209       if chkConsent.Checked = true then Responses.Update('YN',1,'1','Yes')
    2210       else Responses.Update('YN',1,'0','No');
     3661      if chkConsent.Checked = true then Responses.Update('YN',1,'1','Yes');
     3662      memOrder.Text := Responses.OrderText;
    22113663    end;
    22123664end;
    … …  
    22183670    begin
    22193671      Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
     3672      uSelUrgency := cboUrgency.Text;
    22203673      if cboUrgency.Text = 'PRE-OP' then
    22213674        begin
    22223675          lblSurgery.Enabled := true;
    22233676          cboSurgery.Enabled := true;
     3677          lblSurgery.Caption := 'Surgery*';
    22243678        end
    22253679      else
    … …  
    22273681          lblSurgery.Enabled := false;
    22283682          cboSurgery.Enabled := false;
    2229           cboSurgery.Text := '';
    2230           if uSelectedItems.Count > 0 then
    2231             Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
     3683          lblSurgery.Caption := 'Surgery';
     3684          cboSurgery.ItemIndex := -1;
     3685          Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
    22323686        end;
    2233     end;
    2234 end;
    2235 
    2236 procedure TfrmODBBank.txtDiagCommentChange(Sender: TObject);
     3687    end
     3688  else
     3689    cboUrgency.SelectByID(IntToStr(uDfltUrgency));
     3690  memOrder.Text := Responses.OrderText;
     3691end;
     3692
     3693procedure TfrmODBBank.cboUrgencyExit(Sender: TObject);
    22373694begin
    22383695  inherited;
    2239   if uSelectedItems.Count > 0 then
    2240     Responses.Update('COMMENT',1,txtDiagComment.Text,txtDiagComment.Text);
    2241 end;
    2242 
    2243 procedure TfrmODBBank.cboPreparationChange(Sender: TObject);
     3696  if Length(cboUrgency.Text) < 1 then
     3697    cboUrgency.SelectByID(IntToStr(uDfltUrgency));
     3698end;
     3699
     3700procedure TfrmODBBank.cboSurgeryChange(Sender: TObject);
     3701var
     3702  aList: TStringList;
     3703  i,j,aMSBOS,aMSBOSContinue: integer;
     3704  x: string;
     3705  handled: boolean;
    22443706begin
    22453707  inherited;
    2246   Exit;  // disable Preparation, since it is no longer needed by VBECS
    2247   if uSelectedItems.Count > 0 then
    2248     if Length(cboPreparation.Text) > 0 then
    2249       Responses.Update('XFUSION',1,cboPreparation.ItemID,cboPreparation.Text);
    2250 end;
    2251 
    2252 procedure TfrmODBBank.cboSurgeryChange(Sender: TObject);
     3708  aList := TStringList.Create;
     3709  handled := false;
     3710  try
     3711    if (Length(cboSurgery.ItemID) > 0) and (Length(tQuantity.Text) > 0) then
     3712      begin
     3713        aList.Clear;
     3714        ExtractMSBOS(aList, uVBECList);    //Get maximum units for selected Surgey
     3715        for i := 0 to aList.Count - 1 do
     3716          begin
     3717            if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
     3718             and (piece(aList[i],'^',3) = cboSurgery.Text) then
     3719              begin
     3720                aMSBOS := StrToInt(piece(aList[i],'^',4));
     3721                if (aMSBOS > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then
     3722                  begin
     3723                    with Application do
     3724                    begin
     3725                      NormalizeTopMosts;
     3726                      aMSBOSContinue :=
     3727                        MessageBox(PChar('The number of unit Quantity selected (' + tQuantity.Text +
     3728                                   ') for ' + aLabTest.TestName + ' exceeds the maximum number of units ('
     3729                                   + IntToStr(aMSBOS) +
     3730                                   ') for the ' + cboSurgery.text +
     3731                                   ' surgical procedure selected.' + CRLF + CRLF + 'Continue to order ' + tQuantity.Text + ' units?'),
     3732                                   PChar('Maximum Number of Units Exceeded'),
     3733                                   MB_YESNO);
     3734                      RestoreTopMosts;
     3735                    end;
     3736                    if aMSBOSContinue = 7 then
     3737                      begin
     3738                        ShowMsg('Please enter a new quantity for ' + cboAvailComp.Text);
     3739                        tQuantity.Text := '0';
     3740                        tQuantity.SelLength := 2;
     3741                        tQuantity.SelectAll;
     3742                        break;
     3743                      end;
     3744                  end;
     3745                handled := true;
     3746                break;
     3747              end;
     3748          end;
     3749      end;
     3750    if (handled = false) and (Length(cboSurgery.ItemID) > 0) and (uSelectedItems.Count > 0) then
     3751      begin
     3752        aList.Clear;
     3753        ExtractMSBOS(aList, uVBECList);    //Get maximum units for selected Surgey
     3754        for j := 0 to uSelectedItems.Count - 1 do
     3755          begin
     3756            ALabTest := TLabTest.Create(piece(uSelectedItems[j],'^',2), Responses);
     3757            for i := 0 to aList.Count - 1 do
     3758              begin
     3759                if (piece(uSelectedItems[j],'^',1) = '0')
     3760                 and (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
     3761                 and (piece(aList[i],'^',3) = cboSurgery.Text) then
     3762                  begin
     3763                    aMSBOS := StrToInt(piece(aList[i],'^',4));
     3764                    if (aMSBOS > 0) and (length(piece(uSelectedItems[j],'^',3)) > 0) and (StrToInt(piece(uSelectedItems[j],'^',3)) > aMSBOS) then
     3765                      begin
     3766                        with Application do
     3767                        begin
     3768                          NormalizeTopMosts;
     3769                          aMSBOSContinue :=
     3770                            MessageBox(PChar('The number of unit Quantity selected (' + piece(uSelectedItems[j],'^',3) +
     3771                               ') for ' + lvSelectionList.Items[j].Caption + ' exceeds the maximum number of units ('
     3772                               + IntToStr(aMSBOS) +
     3773                               ') for the ' + cboSurgery.text +
     3774                               ' surgical procedure selected.' + CRLF + CRLF + 'Continue to order ' + piece(uSelectedItems[j],'^',3) + ' units?'),
     3775                               PChar('Maximum Number of Units Exceeded'),
     3776                               MB_YESNO);
     3777                          RestoreTopMosts;
     3778                        end;
     3779                        if aMSBOSContinue = 7 then
     3780                          begin
     3781                            ShowMsg('Please enter a new quantity for ' + lvSelectionList.Items[j].Caption);
     3782                            tQuantity.Text := '0';
     3783                            tQuantity.SelLength := 2;
     3784                            tQuantity.SelectAll;
     3785                            x := uSelectedItems[j];
     3786                            SetPiece(x,U,3,'');
     3787                            uSelectedItems[j] := x;
     3788                            lvSelectionList.Items[j].SubItems[0] := '';
     3789                            RePaint;
     3790                            break;
     3791                          end;
     3792                      end;
     3793                    break;
     3794                  end;
     3795              end;
     3796          end;
     3797      end;
     3798    if uSelectedItems.Count > 0 then
     3799      if Length(cboSurgery.Text) > 0 then
     3800        Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
     3801    uSelSurgery := 0;
     3802    if Length(cboSurgery.Text) > 0 then
     3803      begin
     3804        if length(cboSurgery.ItemID) > 0 then uSelSurgery := cboSurgery.ItemID;
     3805        cboReasons.Text := cboSurgery.Text;
     3806        Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text);
     3807      end;
     3808    memOrder.Text := Responses.OrderText;
     3809    finally
     3810      aList.Free;
     3811    end;
     3812end;
     3813
     3814procedure TfrmODBBank.cboSurgeryClick(Sender: TObject);
    22533815begin
    22543816  inherited;
    2255   if uSelectedItems.Count > 0 then
    2256     if Length(cboSurgery.Text) > 0 then
    2257       Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
    2258 end;
    2259 
    2260 procedure TfrmODBBank.tReasonChange(Sender: TObject);
     3817  if Length(cboSurgery.Text) > 0 then uSelSurgery := cboSurgery.ItemID;
     3818end;
     3819
     3820procedure TfrmODBBank.tQuantityChange(Sender: TObject);
     3821var
     3822  aList: TStringList;
     3823  i,aMSBOS,aMSBOSContinue: integer;
     3824  ListItem: TListItem;
     3825  x,m: string;
    22613826begin
    22623827  inherited;
    2263   if uSelectedItems.Count > 0 then
    2264     if Length(tReason.Text) > 0 then
    2265       Responses.Update('REASON',1,tReason.Text,tReason.Text);
     3828  if changing = true then Exit;
     3829  aList := TStringList.Create;
     3830  if Length(tQuantity.Text) > 0 then
     3831    begin
     3832      if Length(tQuantity.Text) > 2 then
     3833        begin
     3834          ShowMsg('Invalid entry. Please select a numeric value <100');
     3835          tQuantity.Text := '';
     3836          Exit;
     3837        end;
     3838      if StrToInt(tQuantity.Text) > 100 then
     3839        begin
     3840          ShowMsg('Quantity too high. Please select a value <100');
     3841          tQuantity.Text := Copy(tQuantity.Text,0,1);
     3842          Exit;
     3843        end;
     3844    end;
     3845  try
     3846    if (Length(cboSurgery.ItemID) > 0) and (Length(tQuantity.Text) > 0) then
     3847      begin
     3848        aList.Clear;
     3849        ExtractMSBOS(aList, uVBECList);    //Get maximum units for selected Surgery
     3850        for i := 0 to aList.Count - 1 do
     3851          begin
     3852            if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
     3853             and (piece(aList[i],'^',3) = cboSurgery.Text) then
     3854              begin
     3855                aMSBOS := StrToInt(piece(aList[i],'^',4));
     3856                if (aMSBOS > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then
     3857                  begin
     3858                    with Application do
     3859                    begin
     3860                      NormalizeTopMosts;
     3861                      aMSBOSContinue :=
     3862                        MessageBox(PChar('The number of units ordered (' + tQuantity.Text +
     3863                                   ') for ' + aLabTest.TestName + ' exceeds the maximum number of units ('
     3864                                   + IntToStr(aMSBOS) +
     3865                                   ') for the ' + cboSurgery.text +
     3866                                   ' surgical procedure selected.' + CRLF + CRLF + 'Do you wish to continue?'),
     3867                                   PChar('Maximum Number of Units Exceeded'),
     3868                                   MB_YESNO);
     3869                      RestoreTopMosts;
     3870                    end;
     3871                    if aMSBOSContinue = 7 then
     3872                      begin
     3873                        ShowMsg('Please enter a new quantity for ' + cboAvailComp.Text);
     3874                        tQuantity.Text := '0';
     3875                        tQuantity.SelLength := 2;
     3876                        tQuantity.SelectAll;
     3877                        break;
     3878                      end;
     3879                  end;
     3880                break;
     3881              end;
     3882          end;
     3883      end;
     3884    if (cboAvailComp.ItemIndex <> -1) and (uSelectedItems.Count > 0) then
     3885      for i := 0 to lvSelectionList.Items.Count - 1 do
     3886        begin
     3887          if lvSelectionList.Items[i].Caption = piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2) then
     3888            begin
     3889              x := uSelectedItems[i];
     3890              m := piece(x,'^',4);
     3891              ListItem := lvSelectionList.Items[i];
     3892              ListItem.SubItems.Clear;
     3893              ListItem.SubItems.Add(tQuantity.Text);
     3894              SetPiece(x,U,3,tQuantity.Text);
     3895              Responses.Update('QTY', (i+1), tQuantity.Text, tQuantity.Text);
     3896              uSelectedItems[i] := x;
     3897              if length(cboModifiers.ItemID) > 0 then
     3898                begin
     3899                  ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]);
     3900                  ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex));
     3901                end
     3902                else
     3903                  begin
     3904                    ListItem.SubItems.Add('');
     3905                    ListItem.SubItems.Add('');
     3906                  end;
     3907
     3908              ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
     3909              Break;
     3910            end;
     3911        end;
     3912    if Length(tQuantity.Text) > 0 then
     3913      begin
     3914        memOrder.Text := Responses.OrderText;
     3915      end;
     3916  finally
     3917    aList.Free;
     3918  end;
     3919end;
     3920
     3921procedure TfrmODBBank.tQuantityClick(Sender: TObject);
     3922begin
     3923  inherited;
     3924  tQuantity.SelLength := 2;
     3925  tQuantity.SelectAll;
     3926end;
     3927
     3928procedure TfrmODBBank.tQuantityEnter(Sender: TObject);
     3929begin
     3930  inherited;
     3931  tQuantity.SelLength := 2;
     3932  tQuantity.SelectAll;
    22663933end;
    22673934
    … …  
    22993966              end;
    23003967        end;
     3968      memOrder.Text := Responses.OrderText;
    23013969    end;
    23023970end;
Note: See TracChangeset for help on using the changeset viewer.