Procedure

TfrmODBBank.cboAvailCompSelect

Module

fODBBank

Last Modified

7/15/2014 3:26:40 PM

Visibility

Public/Published

Owner

TfrmODBBank

Declaration

procedure cboAvailCompSelect(Sender: TObject);

Calls Hierarchy


TfrmODBBank.cboAvailCompSelect
 ├TfrmODBBank.DisableDiagTestControls
 ├TfrmODBBank.EnableComponentControls
 │ └TResponses.Update
 │   ├TResponses.FindResponseByName
 │   └TResponses.IENForPrompt
 ├TfrmODBBank.lvSelectionListClick
 │ ├StrToFMDateTime
 │ ├TLabTest.Create
 │ │ ├LoadLabTestData
 │ │ ├GetOneSpecimen
 │ │ ├TLabTest.FillCollSampList
 │ │ ├TResponses.FindResponseByName
 │ │ ├TLabTest.IndexOfCollSamp
 │ │ ├GetOneCollSamp
 │ │ ├TLabTest.LoadAllSamples
 │ │ │ ├LoadSamples
 │ │ │ └TLabTest.FillCollSampList
 │ │ └TLabTest.SetCollSampDflts
 │ │   ├TResponses.FindResponseByName
 │ │   ├TLabTest.ChangeSpecimen
 │ │   └TLabTest.IndexOfCollSamp
 │ ├TfrmODBBank.DisableDiagTestControls
 │ ├TfrmODBBank.EnableComponentControls...
 │ ├TfrmODBBank.DisableComponentControls
 │ └TfrmODBBank.EnableDiagTestControls
 ├TLabTest.Create...
 ├GetSubtype
 ├TfrmODBBank.ExtractTests
 ├GetPatientBloodResults
 ├GetPatientBloodResultsRaw
 ├TResponses.Update...
 ├TfrmODBBank.ExtractTypeScreen
 ├TfrmODBBank.ExtractSpecimen
 ├TfrmODBBank.cboSurgeryChange
 │ ├TfrmODBBank.ExtractTypeScreen
 │ ├TLabTest.Create...
 │ ├TfrmODBBank.ExtractMSBOS
 │ ├TResponses.Update...
 │ ├TfrmODBBank.DisableComponentControls
 │ └TResponses.GetOrderText
 │   ├TResponses.NextInstance
 │   ├TResponses.FindResponseByName
 │   ├TResponses.FormatResponse
 │   │ └TResponses.FindResponseByIEN
 │   └TResponses.AppendChildren
 │     ├TResponses.FindPromptByIEN
 │     ├TResponses.FindResponseByIEN
 │     └TResponses.FormatResponse...
 ├TfrmODBBank.ExtractMSBOS
 ├TfrmODBBank.SpecimenNeeded
 │ └TfrmODBBank.ExtractSpecimen
 ├TfrmODBBank.ExtractSpecimens
 ├TfrmODBBank.ValidCollTime
 │ └StrToFMDateTime
 └TResponses.GetOrderText...

Called-By Hierarchy


TfrmODBBank.cboAvailCompSelect
TfrmODBBank.cboAvailCompExit┘ 

Calls

Name Declaration Comments
TfrmODBBank.cboSurgeryChange procedure cboSurgeryChange(Sender: TObject); -
TLabTest.Create constructor Create(const LabTestIEN: string; Responses: TResponses); -
TfrmODBBank.DisableDiagTestControls procedure DisableDiagTestControls; -
TfrmODBBank.EnableComponentControls procedure EnableComponentControls; -
TfrmODBBank.ExtractMSBOS procedure ExtractMSBOS(OutList:TStrings; AList:TStrings); -
TfrmODBBank.ExtractSpecimen procedure ExtractSpecimen(OutList:TStrings; AList:TStrings); -
TfrmODBBank.ExtractSpecimens procedure ExtractSpecimens(OutList:TStrings; AList:TStrings); -
TfrmODBBank.ExtractTests procedure ExtractTests(OutList:TStrings; AList:TStrings); -
TfrmODBBank.ExtractTypeScreen procedure ExtractTypeScreen(OutList:TStrings; AList:TStrings); -
TResponses.GetOrderText function GetOrderText: string; -
GetPatientBloodResults procedure GetPatientBloodResults(Dest: TStrings; PatientID: string; ATests: TStringList); -
GetPatientBloodResultsRaw procedure GetPatientBloodResultsRaw(Dest: TStrings; PatientID: string; ATests: TStringList); -
GetSubtype function GetSubtype(TestName: string): string; -
TfrmODBBank.lvSelectionListClick procedure lvSelectionListClick(Sender: TObject); -
TfrmODBBank.SpecimenNeeded function SpecimenNeeded(OutList:TStrings; AList:TStrings; CompID:integer): Boolean; -
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.cboAvailCompExit procedure cboAvailCompExit(Sender: TObject); -


Source

2646  procedure TfrmODBBank.cboAvailCompSelect(Sender: TObject);
2647   var
2648    aList,aTests: TStringList;
2649    i,j,k,getTest,TestAdded: integer;
2650    text : string;
2651    aMSBOS,aMSBOSContinue,curAdd,AnInstance: integer;
2652    sub,sub1: string;
2653    ListItem: TListItem;
2654    aTypeScreen,aSpecimen,aSpecimenUID,aSpecimenReq,aTestYes,aStr,aMsg,aModifier,x,x1,aReason,aSurgery,aCollTime,aCollSave,aName,aUrgText: String;
2655    aChanging: Boolean;
2656  begin
2657    if cboAvailComp.ItemID = '' then Exit;
2658    aList := TStringList.Create;
2659    aTests := TStringList.Create;
2660    sub1 := '';
2661    aChanging := changing;
2662    try
2663      DisableDiagTestControls;
2664      EnableComponentControls;
2665      if not(changing = true) then
2666        begin
2667          changing := true;
2668          tQuantity.Text := '';
2669          cboModifiers.ItemIndex := -1;
2670          changing := aChanging;
2671        end;
2672      LRORDERMODE := TORDER_MODE_COMP;
2673      with cboAvailComp do
2674        begin
2675          if (Length(ItemID) = 0) or (ItemID = '0') then Exit;
2676          FLastLabID := ItemID ;
2677          FLastItemID := ItemID;
2678          for i := 0 to uSelectedItems.Count - 1 do
2679            if ItemID = piece(uSelectedItems[i],'^',2) then
2680              begin
2681                ItemIndex := -1;
2682                lvSelectionList.Items[i].Selected := true;
2683                lvSelectionListClick(self);
2684                Exit;
2685              end;
2686          ALabTest := TLabTest.Create(ItemID, Responses);
2687          sub := GetSubtype(ALabTest.TestName);
2688          changing := aChanging;
2689          StatusText('');
2690        end;
2691      aList.Clear;
2692      TestAdded := 0;
2693      getTest := 0;
2694      ExtractTests(aList, uVBECList);   //Get Lab Results associated with ordered components
2695        for j := 0 to aList.Count - 1 do
2696          begin
2697            if StrToInt(piece(aList[j],'^',1)) = aLabTest.ItemID then
2698              begin
2699                if uTestsForResults.Count < 1 then getTest := 1;
2700                for k := 0 to uTestsForResults.Count - 1 do
2701                  begin
2702                    if piece(uTestsForResults[k],'^',1) = piece(aList[j],'^',3) then
2703                      begin
2704                        getTest := 0;
2705                        break;
2706                      end
2707                    else getTest := 1;
2708                  end;
2709                if getTest = 1 then
2710                  begin
2711                    uTestsForResults.Add(piece(aList[j],'^',3));
2712                    TestAdded := 1;
2713                  end;
2714              end;
2715          end;
2716        if TestAdded = 1 then
2717          begin
2718            aTests.Clear;
2719            GetPatientBloodResults(aTests, Patient.DFN, uTestsForResults);
2720            if aTests.Count > 0 then
2721              begin
2722                edtResults.Clear;
2723                QuickCopy(ATests,edtResults);
2724                TabResults.Caption := 'Lab Results Available';
2725                uRaw.Clear;
2726                GetPatientBloodResultsRaw(uRaw, Patient.DFN, uTestsForResults);
2727              end;
2728          end;
2729        CurAdd := 1;
2730        if uRaw.Count > 0 then
2731        for j := 0 to uRaw.Count - 1 do
2732          begin
2733            if Length(uRaw[j]) > 0 then Responses.Update('RESULTS', CurAdd, uRaw[j], piece(uRaw[j],'^',1));
2734            Inc(CurAdd);
2735          end;
2736      aTypeScreen := '';
2737      aSpecimen := '';
2738      aSpecimenUID := '';
2739      aSpecimenReq := '';
2740      aTestYes := '0';
2741      aReason := '';
2742      aSurgery := '';
2743      aCollTime := '';
2744      aList.Clear;
2745      ExtractTypeScreen(aList, uVBECList);
2746      if aList.Count > 0 then aTypeScreen := aList[0];
2747      aList.Clear;
2748      ExtractSpecimen(aList, uVBECList);
2749      if aList.Count > 0 then
2750        begin
2751          aSpecimen := piece(aList[0], '^', 1);
2752          aSpecimenUID := piece(aList[0], '^', 2);
2753        end;
2754      if (cboSurgery.ItemID = '') and (length(cboSurgery.Text) > 0) then
2755        begin
2756          for i := 0 to cboSurgery.Items.Count - 1 do
2757            if uppercase(cboSurgery.Text) = uppercase(piece(cboSurgery.Items[i],'^',2)) then
2758              begin
2759                cboSurgery.ItemIndex := i;
2760                Break;
2761              end;
2762        end;
2763      if length(cboModifiers.ItemID) > 0 then aModifier := cboModifiers.Items[cboModifiers.ItemIndex];
2764      if length(cboReasons.ItemID) > 0 then aReason := cboReasons.Items[cboReasons.ItemIndex];
2765      if length(cboSurgery.ItemID) > 0 then aSurgery := cboSurgery.Items[cboSurgery.ItemIndex];
2766      if (Length(cboSurgery.ItemID) > 0) and (length(tQuantity.Text) > 0) and (strToInt(tQuantity.Text) > 0) then
2767        begin
2768          uChangingMSBOS := true;
2769          cboSurgeryChange(self);
2770          uChangingMSBOS := false;
2771          if cboAvailComp.ItemIndex = -1 then Exit;
2772          aList.Clear;
2773          ExtractMSBOS(aList, uVBECList);    //Get maximum units for selected Surgey
2774          for i := 0 to aList.Count - 1 do
2775            begin
2776              if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
2777               and (uppercase((piece(aList[i],'^',3))) = uppercase(cboSurgery.Text)) then
2778                begin
2779                  aMSBOS := StrToInt(piece(aList[i],'^',4));
2780                  if (aMSBOS > 0) and (Length(tQuantity.Text) > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then
2781                    begin
2782                      with Application do
2783                      begin
2784                        NormalizeTopMosts;
2785                        aMSBOSContinue :=
2786                          MessageBox(PChar('The number of units ordered (' + tQuantity.Text +
2787                           ') for ' + aLabTest.TestName + ' Exceeds the maximum number recommended ('
2788                           + IntToStr(aMSBOS) +
2789                           ') for the ' + cboSurgery.text +
2790                           ' surgical procedure.' + CRLF +
2791                           'If you need to order more than the maximum number of units, please enter a justification in the Comment box.'
2792                            + CRLF + CRLF + 'Edit the Blood component Quantity?'),
2793                           PChar('Maximum Number of Units Exceeded'),
2794                           MB_YESNO);
2795                        RestoreTopMosts;
2796                      end;
2797                      if aMSBOSContinue = 6 then
2798                        begin
2799                          ShowMsg(cboAvailComp.Text + ' has NOT been added to this request.');
2800                          exit;
2801                        end;
2802                    end;
2803                end;
2804            end;
2805        end;
2806      if (uTNSOrders.Count < 1) and (SpecimenNeeded(aList, uVBECList, aLabTest.ItemID)) then  //check to see if type and screen is needed CQ 17349
2807        begin
2808          uGetTnS := 1;
2809          for i := 0 to lvSelectionList.Items.Count - 1 do
2810            begin
2811              if lvSelectionList.Items[i].SubItems[3] = aTypeScreen then
2812                begin
2813                  uGetTnS := 0;
2814                  if length(cboUrgency.ItemID) > 0 then uDfltUrgency := cboUrgency.ItemID;
2815                  lblTNS.Caption := '';
2816                  lblTNS.Visible := false;
2817                  memMessage.Text := '';
2818                  pnlMessage.Visible := false;
2819                  pnlDiagnosticTests.Caption := 'Diagnostic Tests';
2820                  break;
2821                end;
2822            end;
2823        end;
2824      aList.Clear;
2825      ExtractSpecimens(aList, uVBECList);    //Get specimen values to pass back to Server
2826      for i := 0 to aList.Count - 1 do
2827        begin
2828          if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID) then
2829            begin
2830              aSpecimenReq := piece(aList[i],'^',2);
2831              if (SpecimenNeeded(aList, uVBECList, aLabTest.ItemID)) then
2832                aSpecimenUID := '';
2833              break;
2834            end;
2835        end;
2836      uComponentSelected := true;
2837      with lvSelectionList do
2838        begin
2839          ListItem := Items.Add;
2840          ListItem.Caption := piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2);
2841          ListItem.SubItems.Add(tQuantity.Text);
2842          if length(cboModifiers.ItemID) > 0 then
2843            begin
2844              ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]);
2845              ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex));
2846            end
2847            else
2848              begin
2849                ListItem.SubItems.Add('');
2850                ListItem.SubItems.Add('');
2851              end;
2852          ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
2853        end;
2854        aStr := aTestYes + '^' + IntToStr(aLabTest.TestID) + '^' + tQuantity.Text + '^' + aModifier + '^' + aSpecimenReq + '^' + aSpecimen + '^' + aSpecimenUID + '^' + IntToStr(aLabTest.ItemID);
2855        uSelectedItems.Add(aStr);
2856        CurAdd := 1;
2857        for i := 0 to uSelectedItems.Count - 1 do
2858          begin
2859            aName := lvSelectionList.Items[i].Caption;
2860            x := uSelectedItems[i];
2861            if piece(x,'^',1) = '1' then    //Diagnostic Test related fields
2862              begin
2863                if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
2864              end
2865            else
2866              begin
2867                if Length(piece(x,'^',2)) > 0 then Responses.Update('ORDERABLE', CurAdd, piece(x,'^',2), aName);
2868                if Length(piece(x,'^',3)) > 0 then Responses.Update('QTY', CurAdd, piece(x,'^',3), piece(x,'^',3));
2869                if Length(piece(x,'^',4)) > 0 then Responses.Update('MODIFIER', CurAdd, piece(x,'^',4), piece(x,'^',4));
2870                if Length(piece(x,'^',5)) > 0 then Responses.Update('SPECSTS', CurAdd, pieces(x,'^',5,7), piece(x,'^',5));
2871                if Length(cboSurgery.Text) > 0 then Responses.Update('MISC',1,cboSurgery.Text,cboSurgery.Text);
2872                if Length(calWantTime.Text) > 0 then Responses.Update('DATETIME',1,ValidCollTime(calWantTime.Text),calWantTime.Text);
2873                if Length(cboUrgency.Text) > 0 then Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text)
2874                  else
2875                    begin
2876                      cboUrgency.ItemIndex := 2;
2877                      for j := 0 to cboUrgency.Items.Count - 1 do
2878                        begin
2879                          aUrgText := cboUrgency.Items[j];
2880                          if aUrgText = '9^ROUTINE' then    // Find urgency default of ROUTINE
2881                            begin
2882                              cboUrgency.ItemIndex := i;
2883                              break;
2884                            end;
2885                        end;
2886                      Responses.Update('URGENCY',1,cboUrgency.ItemID,cboUrgency.Text);
2887                    end;
2888              end;
2889            Inc(CurAdd);
2890          end;
2891        memOrder.Text := Responses.OrderText;
2892    finally
2893      alist.Free;
2894      aTests.Free;
2895    end;
2896    aMsg := '';
2897    LRORDERMODE := TORDER_MODE_INFO;
2898    if uGetTnS = 1 then
2899      begin
2900        lblTNS.Caption := 'TYPE + SCREEN must be added to order';
2901        lblTNS.Visible := true;
2902        memMessage.Text := 'TYPE + SCREEN must be added to order';
2903        pnlMessage.Visible := true;
2904        pnlDiagnosticTests.Caption := 'Diagnostic Tests*';
2905      end
2906      else pnlDiagnosticTests.Caption := 'Diagnostic Tests';
2907    if lvSelectionList.Items.Count > 0 then
2908      begin
2909        pnlSelectedTests.Visible := True;
2910        cmdAccept.Visible := True;
2911        memOrder.Visible := True;
2912        GroupBox1.Visible := False;
2913      end;
2914    if tQuantity.CanFocus = true then tQuantity.SetFocus;
2915  end;