Procedure

TfrmODBBank.cboAvailTestSelect

Module

fODBBank

Last Modified

7/15/2014 3:26:40 PM

Visibility

Public/Published

Owner

TfrmODBBank

Declaration

procedure cboAvailTestSelect(Sender: TObject);

Calls Hierarchy


TfrmODBBank.cboAvailTestSelect
 ├TfrmODBBank.DisableComponentControls
 ├TfrmODBBank.EnableDiagTestControls
 ├TLabTest.Create
 │ ├LoadLabTestData
 │ ├GetOneSpecimen
 │ ├TLabTest.FillCollSampList
 │ ├TResponses.FindResponseByName
 │ ├TLabTest.IndexOfCollSamp
 │ ├GetOneCollSamp
 │ ├TLabTest.LoadAllSamples
 │ │ ├LoadSamples
 │ │ └TLabTest.FillCollSampList
 │ └TLabTest.SetCollSampDflts
 │   ├TResponses.FindResponseByName
 │   ├TLabTest.ChangeSpecimen
 │   └TLabTest.IndexOfCollSamp
 ├GetSubtype
 ├TfrmODBBank.DetermineCollectionDefaults
 │ ├TResponses.FindResponseByName
 │ ├TLabTest.LabCanCollect
 │ │ └TLabTest.IndexOfCollSamp
 │ ├TfrmODBBank.SetupCollTimes
 │ │ ├GetLastCollectionTime
 │ │ ├TfrmODBBank.ValidCollTime
 │ │ │ └StrToFMDateTime
 │ │ ├StrToFMDateTime
 │ │ ├RemoveCollTimeDefault
 │ │ ├TCtrlInits.SetControl
 │ │ │ ├ClearControl
 │ │ │ └TCtrlInits.FindInitByName
 │ │ ├MakeRelativeDateTime
 │ │ │ └FMToday
 │ │ │   └FMNow
 │ │ └GetDefaultImmCollTime
 │ ├TCtrlInits.SetControl...
 │ ├StrToFMDateTime
 │ └TfrmODBBank.LoadCollType
 │   ├TCtrlInits.SetControl...
 │   ├TLabTest.LabCanCollect...
 │   ├TfrmODBase.OrderForInpatient
 │   │ ├OrderEventTypeOnCreate
 │   │ └IsPassEvt1
 │   └TfrmODBBank.SetupCollTimes...
 ├TfrmODBBank.lvSelectionListClick
 │ ├StrToFMDateTime
 │ ├TLabTest.Create...
 │ ├TfrmODBBank.DisableDiagTestControls
 │ ├TfrmODBBank.EnableComponentControls
 │ │ └TResponses.Update
 │ │   ├TResponses.FindResponseByName
 │ │   └TResponses.IENForPrompt
 │ ├TfrmODBBank.DisableComponentControls
 │ └TfrmODBBank.EnableDiagTestControls
 ├TfrmODBBank.ExtractTypeScreen
 ├TNSDaysBack
 ├TLabTest.ObtainCollSamp
 ├TLabTest.IndexOfCollSamp
 ├TfrmODBase.OrderMessage
 │ └TfrmODBase.ShowOrderMessage
 ├TResponses.Update...
 ├TfrmODBBank.ValidCollTime...
 └TResponses.GetOrderText
   ├TResponses.NextInstance
   ├TResponses.FindResponseByName
   ├TResponses.FormatResponse
   │ └TResponses.FindResponseByIEN
   └TResponses.AppendChildren
     ├TResponses.FindPromptByIEN
     ├TResponses.FindResponseByIEN
     └TResponses.FormatResponse...

Called-By Hierarchy


TfrmODBBank.cboAvailTestSelect
     TfrmODBBank.SetupDialog┤ 
TfrmODBBank.cboAvailTestExit┘ 

Calls

Name Declaration Comments
TLabTest.Create constructor Create(const LabTestIEN: string; Responses: TResponses); -
TfrmODBBank.DetermineCollectionDefaults procedure DetermineCollectionDefaults(Responses: TResponses); -
TfrmODBBank.DisableComponentControls procedure DisableComponentControls; -
TfrmODBBank.EnableDiagTestControls procedure EnableDiagTestControls; -
TfrmODBBank.ExtractTypeScreen procedure ExtractTypeScreen(OutList:TStrings; AList:TStrings); -
TResponses.GetOrderText function GetOrderText: string; -
GetSubtype function GetSubtype(TestName: string): string; -
TLabTest.IndexOfCollSamp function IndexOfCollSamp(CollSampIEN: Integer): Integer; -
TfrmODBBank.lvSelectionListClick procedure lvSelectionListClick(Sender: TObject); -
TLabTest.ObtainCollSamp function ObtainCollSamp: Boolean; -
TfrmODBase.OrderMessage procedure OrderMessage(const AMessage: string); -
TNSDaysBack function TNSDaysBack: integer; -
TResponses.Update procedure Update(const APromptID: string; AnInstance: Integer; const AnIValue, AnEValue: string); -
TfrmODBBank.ValidCollTime function ValidCollTime(UserEntry: string): string; -

Called-By

Name Declaration Comments
TfrmODBBank.cboAvailTestExit procedure cboAvailTestExit(Sender: TObject); -
TfrmODBBank.SetupDialog procedure SetupDialog(OrderAction: Integer; const ID: string); override; -


Source

2454  procedure TfrmODBBank.cboAvailTestSelect(Sender: TObject);
2455  var
2456    i: integer;
2457    ListItem: TListItem;
2458    aCollTime,aTypeScreen,aStr,aModifier,aSpecimen,aSpecimenUID,aSpecimenReq,aTestYes,x,aName,aTNSString, aUrgText: string;
2459    aList: TStringList;
2460    curAdd,aTNS: Integer;
2461    sub,sub1: string;
2462    aChanging: Boolean;
2463  begin
2464    if cboAvailTest.ItemID = '' then Exit;
2465    aList := TStringList.Create;
2466    aChanging := changing;
2467    try
2468      ALabTest := nil;
2469      aTypeScreen := '';
2470      aSpecimen := '';
2471      aSpecimenUID := '';
2472      aSpecimenReq := '';
2473      aTestYes := '1';
2474      aModifier := '';
2475      changing := true;
2476      tQuantity.Text := '';
2477      changing := aChanging;
2478      sub1 := '';
2479      cboModifiers.ItemIndex := -1;
2480      DisableComponentControls;
2481      EnableDiagTestControls;
2482      LRORDERMODE := TORDER_MODE_DIAG;
2483      ALabTest := TLabTest.Create(cboAvailTest.ItemID, Responses);
2484      sub := GetSubtype(ALabTest.TestName);
2485      {if not(FOrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK]) then
2486        DetermineCollectionDefaults(Responses); }
2487      DetermineCollectionDefaults(Responses);
2488      with cboAvailTest do
2489        begin
2490          if (Length(ItemID) = 0) or (ItemID = '0') then
2491            begin
2492              changing := aChanging;
2493              Exit;
2494            end;
2495          FLastLabID := ItemID ;
2496          FLastItemID := ItemID;
2497          for i := 0 to uSelectedItems.Count - 1 do
2498            if ItemID = piece(uSelectedItems[i],'^',2) then
2499              begin
2500                ItemIndex := -1;
2501                lvSelectionList.Items[i].Selected := true;
2502                lvSelectionListClick(self);
2503                changing := aChanging;
2504                Exit;
2505              end;
2506          ExtractTypeScreen(aList, uVBECList);
2507          if aList.Count > 0 then aTypeScreen := aList[0];
2508          aList.Clear;
2509          aTNSString := '';
2510          if (Changing = false) and (StrToInt(aTypeScreen) = cboAvailTest.ItemID) and (uTNSOrders.Count > 0) then
2511            begin
2512              for i := 0 to uTNSOrders.Count - 1 do
2513                aTNSString := aTNSString + CRLF + uTNSOrders[i];
2514              with Application do
2515                begin
2516                  NormalizeTopMosts;
2517                  aTNS :=
2518                    MessageBox(PChar(aTNSString + CRLF + CRLF +
2519                     'Do you wish to cancel this request for Type & Screen?'),
2520                     PChar('Type & Screen Entered in Past ' + IntToStr(TNSDaysBack) + ' Days'),
2521                     MB_YESNO);
2522                  RestoreTopMosts;
2523                  if aTNS = 6 then
2524                    begin
2525                      cboAvailTest.ItemIndex := -1;
2526                      exit;
2527                    end;
2528                end;
2529            end;
2530          if sub = 't' then with ALabTest do      //DIAGNOSTIC TEST
2531            begin
2532              if ObtainCollSamp then
2533                begin
2534                //For BloodBank orders, this condition should never occur
2535                end
2536              else
2537                begin
2538                  with ALabTest do
2539                    with TCollSamp(CollSampList.Items[IndexOfCollSamp(CollSamp)]) do
2540                      begin
2541                        x := '' ;
2542                        for i := 0 to WardComment.Count-1 do
2543                        x := x + WardComment.strings[i]+#13#10 ;
2544                        pnlMessage.TabOrder := cboAvailTest.TabOrder + 1;
2545                        OrderMessage(x) ;
2546                      end ;
2547                end;
2548          end;
2549        end;
2550      if LRORDERMODE = TORDER_MODE_DIAG then
2551        begin
2552          if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
2553          if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text)
2554          else if changing = false then
2555            begin
2556              for i := 0 to cboUrgency.Items.Count - 1 do
2557                begin
2558                  aUrgText := cboUrgency.Items[i];
2559                  if aUrgText = '9^ROUTINE' then    // Find urgency default of ROUTINE
2560                    begin
2561                      cboUrgency.ItemIndex := i;
2562                      break;
2563                    end;
2564                end;
2565              Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
2566            end;
2567          if Length(memDiagComment.Text) > 0 then Responses.Update('COMMENT',1,memDiagComment.Text,memDiagComment.Text);
2568          if Length(cboReasons.Text) > 0 then Responses.Update('REASON',1,cboReasons.Text,cboReasons.Text);
2569          with cboCollTime do
2570  
2571          if cboCollType.ItemID = 'LC' then
2572            begin
2573              with cboCollTime do
2574                if Length(ItemID) > 0 then
2575                  begin
2576                    Responses.Update('START', 1, Copy(ItemID, 2, 999), Copy(ItemID, 2, 999));
2577                    FLastLabCollTime := ItemID + U + Text;
2578                  end
2579                else if Length(Text) > 0 then
2580                  begin
2581                    Responses.Update('START', 1, ValidCollTime(Text), Text) ;
2582                    FLastLabCollTime := ValidCollTime(Text);
2583                  end;
2584            end
2585          else
2586            begin
2587              with calCollTime do
2588                if FMDateTime > 0 then
2589                  begin
2590                    Responses.Update('START', 1, ValidCollTime(Text), Text);
2591                    FLastColltime := ValidCollTime(Text);
2592                  end
2593                else
2594                  begin
2595                    Responses.Update('START', 1, '', '') ;
2596                    FLastCollTime := '';
2597                  end;
2598            end;
2599          if Length(cboCollType.Text) > 0 then Responses.Update('COLLECT',1,cboCollType.ItemID,cboCollType.ItemID);
2600        end;
2601      uTestSelected := true;
2602      with lvSelectionList do
2603        begin
2604          ListItem := Items.Add;
2605          ListItem.Caption := piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',2);
2606          ListItem.SubItems.Add('');
2607          ListItem.SubItems.Add('');
2608          ListItem.SubItems.Add('');
2609          ListItem.SubItems.Add(piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1));
2610          if piece(cboAvailTest.Items[cboAvailTest.ItemIndex],'^',1) = aTypeScreen then
2611            begin
2612              lblTNS.Caption := '';
2613              lblTNS.Visible := false;
2614              memMessage.Text := '';
2615              pnlMessage.Visible := false;
2616              uGetTnS := 0;
2617              pnlDiagnosticTests.Caption := 'Diagnostic Tests';
2618            end;
2619        end;
2620      aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimenReq + '^' + aSpecimen + '^' + aSpecimenUID + '^' + IntToStr(aLabTest.ItemID);
2621      uSelectedItems.Add(aStr);
2622      CurAdd := 1;
2623      for i := 0 to uSelectedItems.Count - 1 do
2624        begin
2625          aName := lvSelectionList.Items[i].Caption;
2626          x := uSelectedItems[i];
2627          if piece(x,'^',1) = '1' then    //Diagnostic Test related fields
2628            begin
2629              if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
2630            end;
2631          Inc(CurAdd);
2632        end;
2633      memOrder.Text := Responses.OrderText;
2634    finally
2635      aList.Free;
2636    end;
2637    if lvSelectionList.Items.Count > 0 then
2638      begin
2639        pnlSelectedTests.Visible := True;
2640        cmdAccept.Visible := True;
2641        memOrder.Visible := True;
2642        GroupBox1.Visible := False;
2643      end;
2644  end;