Procedure

TfrmODBBank.tQuantityChange

Module

fODBBank

Last Modified

7/15/2014 3:26:40 PM

Visibility

Public/Published

Owner

TfrmODBBank

Declaration

procedure tQuantityChange(Sender: TObject);

Calls Hierarchy


TfrmODBBank.tQuantityChange
 ├TfrmODBBank.cboSurgeryChange
 │ ├TfrmODBBank.ExtractTypeScreen
 │ ├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.ExtractMSBOS
 │ ├TResponses.Update
 │ │ ├TResponses.FindResponseByName
 │ │ └TResponses.IENForPrompt
 │ ├TfrmODBBank.DisableComponentControls
 │ └TResponses.GetOrderText
 │   ├TResponses.NextInstance
 │   ├TResponses.FindResponseByName
 │   ├TResponses.FormatResponse
 │   │ └TResponses.FindResponseByIEN
 │   └TResponses.AppendChildren
 │     ├TResponses.FindPromptByIEN
 │     ├TResponses.FindResponseByIEN
 │     └TResponses.FormatResponse...
 ├TfrmODBBank.ExtractMSBOS
 ├TResponses.Update...
 └TResponses.GetOrderText...

Calls

Name Declaration Comments
TfrmODBBank.cboSurgeryChange procedure cboSurgeryChange(Sender: TObject); -
TfrmODBBank.ExtractMSBOS procedure ExtractMSBOS(OutList:TStrings; AList:TStrings); -
TResponses.GetOrderText function GetOrderText: string; -
TResponses.Update procedure Update(const APromptID: string; AnInstance: Integer; const AnIValue, AnEValue: string); -


Source

4214  procedure TfrmODBBank.tQuantityChange(Sender: TObject);
4215  var
4216    aList: TStringList;
4217    i,aMSBOS,aMSBOSContinue: integer;
4218    ListItem: TListItem;
4219    x,m: string;
4220  begin
4221    inherited;
4222    if changing = true then Exit;
4223    aList := TStringList.Create;
4224    if Length(tQuantity.Text) > 0 then
4225      begin
4226        if Length(tQuantity.Text) > 2 then
4227          begin
4228            ShowMsg('Invalid entry. Please select a numeric value <100');
4229            tQuantity.Text := '';
4230            Exit;
4231          end;
4232        if StrToInt(tQuantity.Text) > 100 then
4233          begin
4234            ShowMsg('Quantity too high. Please select a value <100');
4235            tQuantity.Text := Copy(tQuantity.Text,0,1);
4236            Exit;
4237          end;
4238      end;
4239    try
4240      if not(aLabTest = nil) and (Length(cboSurgery.ItemID) > 0) and (Length(tQuantity.Text) > 0) then
4241        begin
4242          uChangingMSBOS := true;
4243          cboSurgeryChange(self);
4244          uChangingMSBOS := false;
4245          aList.Clear;
4246          ExtractMSBOS(aList, uVBECList);    //Get maximum units for selected Surgery
4247          for i := 0 to aList.Count - 1 do
4248            begin
4249              if (StrToInt(piece(aList[i],'^',1)) = aLabTest.ItemID)
4250               and (uppercase((piece(aList[i],'^',3))) = uppercase(cboSurgery.Text)) and (Length(tQuantity.Text) > 0) then
4251                begin
4252                  aMSBOS := StrToInt(piece(aList[i],'^',4));
4253                  if (aMSBOS > 0) and (StrToInt(tQuantity.Text) > aMSBOS) then
4254                    begin
4255                      with Application do
4256                      begin
4257                        NormalizeTopMosts;
4258                        aMSBOSContinue :=
4259                          MessageBox(PChar('The number of units ordered (' + tQuantity.Text +
4260                           ') for ' + aLabTest.TestName + ' Exceeds the maximum number recommended ('
4261                           + IntToStr(aMSBOS) +
4262                           ') for the ' + cboSurgery.text +
4263                           ' surgical procedure.' + CRLF +
4264                           'If you need to order more than the maximum number of units, please enter a justification in the Comment box.'
4265                            + CRLF + CRLF + 'Edit the Blood component Quantity?'),
4266                           PChar('Maximum Number of Units Exceeded'),
4267                           MB_YESNO);
4268  
4269                        RestoreTopMosts;
4270                      end;
4271                      if aMSBOSContinue = 6 then
4272                        begin
4273                          ShowMsg('Please enter a new quantity for ' + cboAvailComp.Text);
4274                          tQuantity.Text := '0';
4275                          tQuantity.SelLength := 2;
4276                          tQuantity.SelectAll;
4277                          break;
4278                        end;
4279                    end;
4280                  break;
4281                end;
4282            end;
4283        end;
4284      if (cboAvailComp.ItemIndex <> -1) and (uSelectedItems.Count > 0) then
4285        for i := 0 to lvSelectionList.Items.Count - 1 do
4286          begin
4287            if lvSelectionList.Items[i].Caption = piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',2) then
4288              begin
4289                x := uSelectedItems[i];
4290                m := piece(x,'^',4);
4291                ListItem := lvSelectionList.Items[i];
4292                ListItem.SubItems.Clear;
4293                ListItem.SubItems.Add(tQuantity.Text);
4294                SetPiece(x,U,3,tQuantity.Text);
4295                Responses.Update('QTY', (i+1), tQuantity.Text, tQuantity.Text);
4296                uSelectedItems[i] := x;
4297                if length(cboModifiers.ItemID) > 0 then
4298                  begin
4299                    ListItem.SubItems.Add(cboModifiers.Items[cboModifiers.ItemIndex]);
4300                    ListItem.SubItems.Add(IntToStr(cboModifiers.ItemIndex));
4301                  end
4302                  else
4303                    begin
4304                      ListItem.SubItems.Add('');
4305                      ListItem.SubItems.Add('');
4306                    end;
4307  
4308                ListItem.SubItems.Add(piece(cboAvailComp.Items[cboAvailComp.ItemIndex],'^',1));
4309                Break;
4310              end;
4311          end;
4312      if Length(tQuantity.Text) > 0 then
4313        begin
4314          memOrder.Text := Responses.OrderText;
4315        end;
4316    finally
4317      aList.Free;
4318    end;
4319  end;