selreturnfrm.~pas

群星医药系统源码

  End;
End;

procedure TFmSelReturn.edProvNameButtonClick(Sender: TObject);
Var
  sCustNo,sCustName,sEmpNo,sPayModeNo : String;
begin
  if FEditMode=0 Then Exit;
  sCustNo := CdsSelReturnCustNo.Value;
  if SelectCust(sCustNo,sCustName,sEmpNo,sPayModeNo) Then
  Begin
    CdsSelReturnCustNo.Value := sCustNo;
    CdsSelReturnCustName.Value := sCustName;
    CdsSelReturnEmpNo.Value := sEmpNo;
    CdsSelReturnPayModeNo.Value := sPayModeNo;
  End;
End;

procedure TFmSelReturn.CdsSelReturnDtlGoodsIDChange(Sender: TField);
{Var
  LogText,Flag,sGoodsID,sSetFields,sCustNo:String;
Begin
  if FEditMode=0 Then Exit;
  if FlagGoodsID<>'' Then Begin
    FlagGoodsID:='';
    Exit;
  End;
//  if bBrowGoods then Exit;
  sGoodsID:=CdsSelReturnDtlGoodsID.AsString;
  if sGoodsID='' Then Exit;
  if (BeforeGoodsID=sGoodsID) Then Exit;
  BeforeGoodsID:=sGoodsID;
  sSetFields:= 'Name,Specs,Unit';
  sCustNo := CdsSelReturnCustNo.Value;
  FlagGoodsID:=GetGoodsInfo(CdsSelReturnDtl,'OPrice',sGoodsID,sSetFields,sCustNo,'S',1);
  if FlagGoodsID='' Then Begin
    Messagebox(Handle,'无效药品编号',nil,16);
    Abort;
  End Else Begin
    if sGoodsID<>FlagGoodsID then
      CdsSelReturnDtl.FieldByName('GoodsID').AsString:=FlagGoodsID
    Else
      FlagGoodsID:='';
  End;}
begin
  ParseGoodsInfo;
End;

procedure TFmSelReturn.SumCount;
Var
  dOPrice,dRebate,dTaxRate,dQty,
  dUnTaxPrice,dPrice,dGoodsSum,dAmount:Double;
begin
  //基本的只须标准售价、折扣，税率、数量;
  dQty    := CdsSelReturnDtlQTY.Value;          //数量
  dTaxRate:= CdsSelReturnDtlTaxRate.Value;      //税率
  dOPrice := CdsSelReturnDtlOPrice.Value;       //标准售价
  if CdsSelReturnDtlRebate.IsNull Then
    dRebate := 1
  Else
    dRebate := CdsSelReturnDtlRebate.Value/100;   //折扣
  dPrice  := dOPrice*dRebate;                   //实际售价=标准售价*折扣
  CdsSelReturnDtlPrice.Value := dPrice;         //保存实际售价

  dUnTaxPrice := dPrice/(1+dTaxRate/100);         //未税单价(实际单价/1+(税率)%)
  CdsSelReturnDtlUnTaxPrice.Value := dUnTaxPrice; //保存未税单价

  dGoodsSum := dQty*dUnTaxPrice;                  //计算货款=数量*未税单价
  CdsSelReturnDtlGoodsSum.Value := dGoodsSum;     //保存货款

  dAmount := dQty*dPrice;                         //计算合计=数量*实际单价
  CdsSelReturnDtlAmount.Value := dAmount;         //保存合计
  CdsSelReturnDtlTaxSum.Value := dAmount-dGoodsSum;   //税款=合计-货款
end;

procedure TFmSelReturn.CdsSelReturnDtlOPriceChange(Sender: TField);
begin
  SumCount;
end;

procedure TFmSelReturn.ShowPayModes;
Var
  A:Variant;
  iClientID, I, k:Integer;
begin
  Try
    iClientID := IFmMain.IFmMainEx.ClientID;
    A:=SvrSelReturn.AppServer.GetNeedValue(iClientID,3,sPayModes);
    if (Not VarIsNull(A)) And (VarIsArray(A)) Then
    Begin
      slPayModes.Clear;
      cbPayModes.Items.Clear;
      k := VarArrayHighBound(A,2);
      for i:=VarArrayLowBound(A,2) to k do
      Begin
        slPayModes.Add(A[0,i]);
        cbPayModes.Items.Add(A[0,i]+':'+A[1,i]+'('+A[2,i]+')');
      End;
    End;
  Except
    On E:Exception Do
      Messagebox(Handle,Pchar(E.Message),'',16);
  End;
end;

procedure TFmSelReturn.CdsSelReturnCustNoChange(Sender: TField);
Var
  sCustNo,sCustName,LogText:String;
begin
  if FEditMode=0 Then Exit;
  sCustNo:=CdsSelReturnCustNo.Value;
  if sCustNo='' Then Exit;
  if sCustNo=BeforeCustNo Then Exit;
  BeforeCustNo:=sCustNO;
  sCustName:=VarToStr(SvrCommon.AppServer.GetCustInfo(iClientID,sCustNo,1,'CustName',LogText));
  CdsSelReturnCustName.Value:=sCustName;
  cdsSelReturnLinkman.Clear;
  if LogText<>'' Then Begin
    Messagebox(Handle,Pchar(LogText),'错误',16);
    Abort;
  End;
end;

procedure TFmSelReturn.CdsSelReturnEmpNoChange(Sender: TField);
Var
  sEmpNo,sEmpName,LogText:String;
begin
  if FEditMode=0 Then Exit;
  sEmpNo:=CdsSelReturnEmpNo.Value;
  if sEmpNo='' Then Exit;
  if sEmpNo=BeforeEmpNo Then Exit;
  BeforeEmpNo:=sEmpNO;
  sEmpName:=VarToStr(SvrCommon.AppServer.GetEmpInfo(iClientID,sEmpNo,1,'Name',LogText));
  cdsSelReturnEmpName.Value:=sEmpName;
  if LogText<>'' Then Begin
    Messagebox(Handle,Pchar(LogText),'错误',16);
    Abort;
  End;
end;

procedure TFmSelReturn.dbgSelReturnDtlEditButtonClick(Sender: TObject);
Var
  sField:String;
  dPrice:Double;
  iDepotID: Integer;
  DepotNo,DepotName: string;
Begin
  if FEditMode=0 Then Exit;
  sField :='';
  sField := Trim(LowerCase(dbgSelReturnDtl.SelectedField.FieldName));
  if sField='goodsid' Then
  Begin
    ParseGoodsInfo;
  end
  else if sField='oprice' Then
  begin
    dPrice := ViewGoodsPrice(CdsSelReturnDtlGoodsID.Value, CdsSelReturnDtlUnit.Value);
    if dPrice>=0 Then
    Begin
      CdsSelReturnDtl.Edit;
      CdsSelReturnDtlOprice.Value := dPrice;
    end;
  end
  else if sField='depotno' then
  begin
    iDepotID := CdsSelReturnDtlDepotID.Value;
    if SelectDepot(iDepotID,DepotNo,DepotName) Then Begin
      CdsSelReturnDtlDepotID.Value := iDepotID;
      CdsSelReturnDtlDepotNo.Value := DepotNo;
      CdsSelReturnDtlDepotName.Value := DepotName;
    end;
  end;
end;

procedure TFmSelReturn.CdsSelReturnDtlDepotNoChange(Sender: TField);
Var
  sDepotNo,LogText:String;
  A:Variant;
begin
  Try
    if FEditMode=0 Then Exit;
    sDepotNo:=CdsSelReturnDtlDepotNo.Value;
    if sDepotNo='' Then Exit;
    if sDepotNo=BeforeDepotNo Then Exit;
    BeforeDepotNo:=sDepotNo;
    A := SvrCommon.AppServer.GetDepotInfo(iClientID,sDepotNo,2,'DepotID,DepotName',LogText);
    CdsSelReturnDtlDepotID.Value  := A[0];
    CdsSelReturnDtlDepotName.Value:= A[1];
    if LogText<>'' Then Begin
      Messagebox(Handle,Pchar('无效的仓库编号...'),'错误',16);
      Abort;
    End;
  Except
    Messagebox(Handle,Pchar('无效的仓库编号...'),'错误',16);
    Abort;
  End;
end;

procedure TFmSelReturn.ActAuditExecute(Sender: TObject);
const
  cCheckTypes: Array[0..5] of string=('普通药品验收单', '进口药品验收单', '医疗器械验收单', '中药饮片验收单', '特殊药品验收单', '非药品验收单');
var sBillNo, str,MatchBillNo,sBranchMachine,sCheckType,sDisp: String;
  iBranchID,iMachineId, i, iCount,iPos : Integer;
  sSysInfo: Variant;
  sList,lCheckTypes,lview : TStrings;
begin
  if FEditMode>0 then Exit;
  if Application.MessageBox('确定要将此单进行审核吗？', '消息', MB_YESNO+MB_ICONQUESTION)=IDNO then
    Exit;
  str := 'CurrMonth';
  sSysInfo := SvrCommon.AppServer.GetSysInfo(iClientID,Str,1);
  if not(VarIsNull(sSysInfo)) then
  begin
    if CdsSelReturnFDate.Value < VarToDateTime(sSysInfo) then
    begin
      Messagebox(Handle,Pchar('该月已结算，不能操作已月结的单据！'),nil,16);
      Exit;
    end;
  end else
  begin
    Messagebox(Handle,Pchar('请先设置开帐日期...'),nil,16);
    Exit;
  end;
  sBillNo := CdsSelReturnBillNo.AsString;
  if sBillNo='' then Exit;
  iBranchID  := IFmMain.IFmMainEx.GetLocSetting^.BranchNo;
  iMachineId := IFmMain.IFmMainEx.GetLocSetting^.MachineNo;
  sBranchMachine := FormatFloat('000',iBranchID)+FormatFloat('00',iMachineID);
  if SvrSelReturn.AppServer.BillTurn(iClientID, 'SelReturn', 'GoodsCheckAccept', sBillNo, sBranchMachine,MatchBillNo) then
  begin
    ActAudit.Enabled:=False and CanAudit;
    ActRevert.Enabled:=True and CanRevert;
    Lab_State.Caption:='单据状态：已审核';
    Lab_State.Font.Color:=clRed;
    ActRefresh.Execute;
    sList := TStringList.Create;
    sList.Text := MatchBillNo;
    iCount := sList.Count;
    for i :=0 To iCount -1 do
    begin
      str := sList[i];
      iPos := StrToInt(str[1])-1;
      sDisp := sDisp+Copy(str, 3, Length(str)-2)+cChecktypes[iPos]+#13;
    end;
    str := sBillNo+'号销售退回登记单已成功生成：'#13+sDisp+'要查看这些单据吗？';
    if Application.MessageBox(PChar(str), '消息', MB_YESNO+MB_ICONINFORMATION)=IDYES then
    begin
      for i := 0 To iCount-1 Do
        IFmMain.DoSome(Trim(ActBillTurn.ModuleFile)+IntToStr(i+1), 'ViewBill', Copy(sList[i], 3, Length(str)-2));
    end;
  end;
end;

procedure TFmSelReturn.ActRevertExecute(Sender: TObject);
var sBillNo : String;
begin
  try
    if CdsSelReturn.IsEmpty Then Exit;
    if FEditMode>0 then Exit;
    if Application.MessageBox('确实要还原当前已审核过的数据吗？','提示',4+32)<>6 Then Exit;
    sBillNo := CdsSelReturnBillNo.AsString;
    if sBillNo='' Then Exit;
    if Not(SvrSelReturn.AppServer.BillRevert(iClientID,'SelReturn',sBillNo,'')) Then Begin
      Messagebox(Handle,Pchar('还原数据不成功！'),'错误',16);
    End Else Begin
      ActAudit.Enabled:=True and CanAudit;
      ActRevert.Enabled:=False and CanRevert;
      Lab_State.Caption:='单据状态：未审核';
      Lab_State.Font.Color:=clHotLight;
      ActRefreshExecute(Nil);
    End;
  except
    On E:Exception Do
      Messagebox(Handle,Pchar(E.Message),'错误',16);
  end;
End;

procedure TFmSelReturn.ActFieldLayoutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name,
                  [dbgSelReturnDtl,dbgSelExpense],'销售退回明细;销售退回费用');
end;

procedure TFmSelReturn.ActDataExportExecute(Sender: TObject);
begin
	ExportData([CdsSelReturn, CdsSelReturnDtl,CdsSelExpense],'销售退回;销售退回明细;销售退回费用', '');
end;

function TFmSelReturn.DoSome(cType: PChar; Values: Variant): Variant;
const
  cTypes = 'viewbill'#13'query';
  //       查看某单     查询
var sTypes: TStrings;
    i, k: integer;
    str, str2: String;
begin
  sTypes := TStringList.Create;
  sTypes.Text := cTypes;
  i := sTypes.IndexOf(cType);
  case i of
    0: begin//ViewBill
      if VarIsArray(Values) then begin
        str := Values[0];
        str2:= Values[1];
      end else begin
        str := Values;
        str2:= '';
      end;
      if str2='' then begin
        if sBillNoList.IndexOf(str)<0 then
          sBillNoList.Add(str);
      end else
        sBillNoList.Text := str2;
      self.BringToFront;
      SetCurrBillNo(str);
    end;
  end;
end;

procedure TFmSelReturn.RzDBButtonEdit2ButtonClick(Sender: TObject);
Var
  sCustNo,sLinkMan : String;
begin
  if FEditMode=0 Then Exit;
  if DBEdit8.Text='' Then Begin
    MessageBox(Handle,Pchar('请先指定客户单位!'),'错误:',16);
    Exit;
  End;
  sCustNo := CdsSelReturnCustNo.Value;
  if SelectCustLinkMan(sCustNo,sLinkMan) Then
    CdsSelReturnLinkMan.Value := sLinkMan ;
end;

procedure TFmSelReturn.RzDBButtonEdit1ButtonClick(Sender: TObject);
Var sEmpNo,sEmpName:String;
begin
  if FEditMode=0 Then Exit;
  sEmpNo := CdsSelReturnEmpNo.Value;
  if SelectEmp(sEmpNo,sEmpName) Then begin
    CdsSelReturnEmpNo.Value := sEmpNo;
    CdsSelReturnEmpName.Value := sEmpName;
  End;
end;

procedure TFmSelReturn.ActQueryExecute(Sender: TObject);
begin
  IFmMain.OnAction(Sender);
end;

procedure TFmSelReturn.cbPayModesChange(Sender: TObject);
Var iIndex : Integer;
begin
  iIndex:=cbPayModes.ItemIndex;
  if iIndex<>-1 Then
    CdsSelReturnPayModeNo.Value:=slPayModes[iIndex];
end;

procedure TFmSelReturn.ParseGoodsInfo;
var sGoodsID,sCustNo,sUnit:string;
    dPrice:Double;
    b1: Boolean;
begin
  if FEditMode=0 then Exit;
  if bBrowGoods then Exit;
  bBrowGoods := true;
  try
    b1:=SelectGoods(CdsSelReturnDtl, CdsSelReturnDtlGoodsID, CdsSelReturnDtlUnit, true, False, False);
    if not b1 then abort;
    sGoodsID := CdsSelReturnDtlGoodsID.Value;
    sCustNo := CdsSelReturnCustNo.Value;
    sUnit := CdsSelReturnDtlUnit.Value;
    if (sGoodsID<>'') And (sUnit<>'') Then Begin
      dPrice := SvrCommon.AppServer.GetGoodsPrice(IClientID,'S',sCustNo,sGoodsID,sUnit);
      if dPrice<>0 Then
        CdsSelReturnDtlOPrice.Value := dPrice;
    End;
  finally
    bBrowGoods := false;
  end;
end;

Initialization
  RegisterClass(TFmSelReturn);
Finalization
  UnRegisterClass(TFmSelReturn);

end.