pchspeer.pas

群星医药系统源码

end;

procedure TFmPchSpeer.CdsPchSpeerDtlGoodsIDChange(Sender: TField);
{Var
  LogText,Flag,sGoodsID,sSetFields,sProvNo:String;
Begin
  IF (FEditMode=0) or bBrowGoods Then Exit;
  IF FlagGoodsID<>'' Then Begin
    FlagGoodsID:='';
    Exit;
  End;
  sGoodsID:=CdsPchSpeerDtlGoodsID.AsString;
  If sGoodsID='' Then Exit;
  if (BeforeGoodsID=sGoodsID) Then Exit;
  BeforeGoodsID:=sGoodsID;
  sSetFields:= 'Name,Specs,Unit,PdcAddr,Maker';
  sProvNo := CdsPchSpeerProvNo.Value;
  FlagGoodsID:=GetGoodsInfo(CdsPchSpeerDtl,'OPrice',sGoodsID,sSetFields,sProvNo,'P', 1);
  If FlagGoodsID='' Then Begin
    Messagebox(Handle,'无效药品编号',nil,16);
    Abort;
  End Else Begin
    if sGoodsID<>FlagGoodsID then
      CdsPchSpeerDtl.FieldByName('GoodsID').AsString:=FlagGoodsID
    Else
      FlagGoodsID:='';
  End;}
begin
  ParseGoodsInfo;
End;

procedure TFmPchSpeer.CdsPchSpeerProvNoChange(Sender: TField);
Var
  sProvNo,sProvName,LogText:String;
begin
  IF FEditMode=0 Then Exit;
  sProvNo:=CdsPchSpeerProvNo.Value;
  if sProvNo=BeforeProvNo Then Exit;
  If sProvNo='' Then Begin
    CdsPchSpeerProvName.Value:='';
    Exit;
  End;
  BeforeProvNo:=sProvNO;
  sProvName:=VarToStr(SvrCommon.AppServer.GetProvInfo(iClientID,sProvNo,1,'ProvName',LogText));
  CdsPchSpeerProvName.Value:=sProvName;
  If LogText<>'' Then Begin
    Messagebox(Handle,Pchar(LogText),nil,16);
    Abort;
  End;
end;

procedure TFmPchSpeer.ShowPayModes;
Var
  A:Variant;
  iClientID, I, k:Integer;
begin
  Try
    iClientID := IFmMain.IFmMainEx.ClientID;
    A:=SvrPchSpeer.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 TFmPchSpeer.CdsPchSpeerReconcileError(
  DataSet: TCustomClientDataSet; E: EReconcileError;
  UpdateKind: TUpdateKind; var Action: TReconcileAction);
begin
  Messagebox(Handle,Pchar(E.Message),'',16);
  Action:=RaAbort;
end;

procedure TFmPchSpeer.CdsPchSpeerEmpNOChange(Sender: TField);
Var
  sEmpNo,sEmpName,LogText:String;
begin
  IF FEditMode=0 Then Exit;
  sEmpNo:=CdsPchSpeerEmpNO.Value;
  If sEmpNo='' Then Exit;
  if sEmpNo=BeforeEmpNo Then Exit;
  BeforeEmpNo:=sEmpNO;
  sEmpName:=VarToStr(SvrCommon.AppServer.GetEmpInfo(iClientID,sEmpNo,1,'Name',LogText));
  CdsPchSpeerName.Value:=sEmpName;
  If LogText<>'' Then Begin
    Messagebox(Handle,Pchar(LogText),nil,16);
    Abort;
  End;
end;

procedure TFmPchSpeer.dbgPchSpeerDtlEditButtonClick(Sender: TObject);
Var
  sField:String;
  dPrice:Double;
Begin
  If FEditMode=0 Then Exit;
  sField :='';
  sField := Trim(LowerCase(dbgPchSpeerDtl.SelectedField.FieldName));
  If sField='goodsid' Then Begin
    ParseGoodsInfo;
  End Else
  Begin
    If sField='oprice' Then Begin
      dPrice := ViewGoodsPrice(CdsPchSpeerDtlGoodsID.Value, CdsPchSpeerDtlUnit.Value);
      If dPrice>=0 Then Begin
        CdsPchSpeerDtl.Edit;
        CdsPchSpeerDtlOprice.Value := dPrice;
      End;
    End;
  End;
End;

procedure TFmPchSpeer.ActDeleteExecute(Sender: TObject);
begin
  If CdsPchSpeerTransfer.Value Then Begin
    Messagebox(Handle,Pchar('当前单据已[审核]，不能执行删除操作！'),'警告',64);
    Exit;
  End;
  inherited;
end;

procedure TFmPchSpeer.ActSaveExecute(Sender: TObject);
Var iIndex:Integer;
begin
  If FEditMode=0 Then Exit;
  iIndex:=cbPayModes.ItemIndex;
  if iIndex<-1 Then
    raise Exception.Create('请指定结算方式！');
  cdsPchSpeer.Edit;
  CdsPchSpeerPayModeNo.Value:=slPayModes[iIndex];
  If (CdsPchSpeerDtl.State In dsEditModes) Then
    CdsPchspeerDtl.Post;
  Inherited;
End;

procedure TFmPchSpeer.SumCount;
Var
  dUnTaxPrice,dQty,dAmount,D,E,T:Double;
begin
  D:=CdsPchSpeerDtlOPrice.AsFloat;             //标准售价
  IF CdsPchSpeerDtlRebate.IsNull Then
    E := 100
  Else
    E:=CdsPchSpeerDtlRebate.AsFloat;             //折扣
  T:=CdsPchSpeerDtlTaxRate.AsFloat;            //税率
  dQty:=CdsPchSpeerDtlQty.AsFloat;             //数量
  CdsPchSpeerDtlPrice.AsFloat:=D*(E/100);      //实际售价             //实际售价
  dUnTaxPrice:=D*(E/100)/(1+T/100);             //未税单价
  CdsPchSpeerDtlUnTaxPrice.AsFloat:=dUnTaxPrice;
  CdsPchSpeerDtlGoodsSum.AsFloat:=dQty*dUnTaxPrice;     //货款;
  dAmount:=dQty*D*(E/100);                       //合计;
  CdsPchSpeerDtlAmount.AsFloat:=dAmount;
  CdsPchSpeerDtlTaxSum.AsFloat:=dAmount-dQty*dUnTaxPrice;  //税款
end;

procedure TFmPchSpeer.edProvNameButtonClick(Sender: TObject);
Var sProvNo,sProvName,sEmpNo,sPayModeNo:String;
begin
  If FEditMode=0 Then Exit;
  sProvNo := CdsPchSpeerProvNo.Value;
  If SelectProv(sProvNo,sProvName,sEmpNo,sPayModeNo) Then Begin
    CdsPchSpeerProvNo.Value := sProvNo;
    CdsPchSpeerProvName.Value := sProvName;
    CdsPchSpeerEmpNO.Value := sEmpNo;
    CdsPchSpeerPayModeNO.Value := sPayModeNo;
  End;
End;

procedure TFmPchSpeer.ActAuditExecute(Sender: TObject);
Var
  sUserID,Str:String;
  sSysInfo : Variant;
begin
  Try
    If CdsPchSpeer.IsEmpty Then Exit;
    If FEditMode>0 then Exit;
    inherited;
    If Application.MessageBox('确实要[审核]当前数据吗？','提示',4+32)<>6 Then Exit;
    str := 'CurrMonth';
    sSysInfo := SvrCommon.AppServer.GetSysInfo(iClientID,Str,1);
    If Not(VarIsNull(sSysInfo)) Then Begin
      If CdsPchSpeerFDate.Value<VarToDateTime(sSysInfo) Then Begin
        Messagebox(Handle,Pchar('该月已结算，不能操作已月结的单据！'),nil,16);
        Exit;
      End;
    End Else Begin
      Messagebox(Handle,Pchar('请先设置开帐日期...'),nil,16);
      Exit;
    End;
    CdsPchSpeer.Edit;
    CdsPchSpeerTransfer.Value:=True;
    sUserID := iFmMain.IFmMainEx.LogonInfo^.UserID;
    CdsPchSpeerAudit.Value := sUserID;
    If CdsPchSpeer.ApplyUpdates(0)>0 Then
      Messagebox(Handle,Pchar('审核数据不成功！'),nil,16)
    Else Begin
      ActAudit.Enabled:=False and CanAudit;
      ActRevert.Enabled:=True and CanRevert;
      Lab_State.Caption:='单据状态：已审核';
      Lab_State.Font.Color:=clRed;
      ActRefreshExecute(Nil);
    End;
  Except
    On E:Exception Do
    begin
      Messagebox(Handle,Pchar(E.Message),nil,16);
      cdsPchSpeer.Cancel;
    end;
  End;
end;

procedure TFmPchSpeer.ActRevertExecute(Sender: TObject);
begin
  Try
    If CdsPchSpeer.IsEmpty Then Exit;
    If FEditMode>0 then Exit;
    inherited;
    If Application.MessageBox('确实要还原当前已审核过的数据吗？','提示',4+32)<>6 Then Exit;
    CdsPchSpeer.Edit;
    CdsPchSpeerTransfer.Value:=False;
    CdsPchSpeerAudit.Value := '';
    try
      CdsPchSpeer.Post;
    Except
      CdsPchSpeer.Cancel;
      Raise;
    end;
    If CdsPchSpeer.ApplyUpdates(0)>0 Then
      Messagebox(Handle,Pchar('还原数据不成功！'),nil,16)
    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),nil,16);
  End;
end;

procedure TFmPchSpeer.ActFieldLayoutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [dbgPchSpeerDtl],'采购询价明细');
end;

procedure TFmPchSpeer.ActDataExportExecute(Sender: TObject);
begin
	ExportData([CdsPchSpeer, CdsPchSpeerDtl],'采购询价;采购询价明细', '');
end;

procedure TFmPchSpeer.ActBillTurnExecute(Sender: TObject);
var sBillNo, sToBillNo, str ,MatchBillNo: String;
begin
  if FEditMode>0 then Exit;
  If Not(CdsPchSpeerTransFer.Value) Then Begin
    Messagebox(Handle,Pchar('当前单据尚没[审核],不能进行转单操作!'),'警告',64);
    Exit;
  End;
  sBillNo := cdsPchSpeerBillNo.AsString;
  if sBillNo='' then Exit;
  if Application.MessageBox('确定要将此采购询价单转出到采购合同吗？', '消息', MB_YESNO+MB_ICONQUESTION)=IDNO then
    Exit;
  sToBillNo := BuildBillNo('PchOrder');
  if SvrPchSpeer.AppServer.BillTurn(iClientID, 'PchSpeer', 'PchOrder', sBillNo, sToBillNo,MatchBillNo) then begin
    ActRefresh.Execute;
    str := sBillNo+'号询价单已成功转出到['+MatchBillNo+']号采购合同，要查看该单据吗？';
    if Application.MessageBox(PChar(str), '消息', MB_YESNO+MB_ICONINFORMATION)=IDYES then
      IFmMain.DoSome(ActBillTurn.ModuleFile, 'ViewBill', MatchBillNo);
  end;
end;

function TFmPchSpeer.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 TFmPchSpeer.ActUpdateExecute(Sender: TObject);
begin
  If CdsPchSpeerTransFer.Value Then Begin
    Messagebox(Handle,Pchar('当前单据已[审核]，不能进行修改操作!'),'警告',64);
    Exit;
  End;
  inherited;
end;

procedure TFmPchSpeer.RzDBButtonEdit2ButtonClick(Sender: TObject);
Var
  sProvNo,sLinkMan : String;
begin
  If FEditMode=0 Then Exit;
  If RzDBEdit9.Text='' Then Begin
    MessageBox(Handle,Pchar('请先指定供应厂商!'),nil,16);
    Exit;
  End;
  sProvNo := CdsPchSpeerProvNo.Value;
  If SelectProvLinkMan(sProvNo,sLinkMan) Then
    CdsPchSpeerLinkMan.Value := sLinkMan ;
end;

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

procedure TFmPchSpeer.ParseGoodsInfo;
var sGoodsID,sProvNo,sUnit:string;
    dPrice:Double;
    b1: Boolean;
begin
  if FEditMode=0 then Exit;
  if bBrowGoods then Exit;
  bBrowGoods := true;
  try
    b1:=SelectGoods(CdsPchSpeerDtl, CdsPchSpeerDtlGoodsID, CdsPchSpeerDtlUnit, true, False, false);
    if not b1 then Abort;
    sGoodsID := CdsPchSpeerDtlGoodsID.Value;
    sProvNo := CdsPchSpeerProvNo.Value;
    sUnit := CdsPchSpeerDtlUnit.Value;
    if (sGoodsID<>'') And (sUnit<>'') Then Begin
      dPrice := SvrCommon.AppServer.GetGoodsPrice(IClientID,'P',sProvNo,sGoodsID,sUnit);
      if dPrice<>0 Then
        CdsPchSpeerDtlOprice.Value := dPrice;
    End;
  finally
    bBrowGoods := false;
  end;
end;

initialization
  RegisterClass(TFmPchSpeer);

finalization
  UnRegisterClass(TFmPchSpeer);

end.