selgoodscheckacceptfrm.pas

群星医药系统源码

unit SelGoodsCheckAcceptFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ceBaseBillFrm, ActnList, ModuleAction, ImgList, TB2Dock,
  ExtCtrls, RzPanel, TB2Item, TB2Toolbar, StdCtrls, DBCtrls, Mask, DB,
  DBClient, MConnect, Grids, DBGridEh, DbUtilsEh, EhLibCDS, xEhLibCtl, RzEdit, RzDBEdit,
  ComCtrls, RzDTP, RzDBDTP, RzTabs,iMainFrm, RzButton, RzRadChk, RzDBChk,
  RzCmboBx, RzDBCmbo, RzDBBnEd, Menus, Buttons,DbFuncs, ckDBClient,ShowProGress,
  uDataTypes,SelectProvFrm,ceGlobal, RzDBLbl, RzLabel, RzBtnEdt;

type
  TFmSelGoodsCheckAccept = class(TceBaseBillForm)
    DComConn: TDCOMConnection;
    GoodsCheckAccept: TckClientDataSet;
    DsGoodsCheckAccept: TDataSource;
    Label1: TLabel;
    Label2: TLabel;
    Label4: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    DBEdit1: TRzDBEdit;
    DBEdit7: TRzDBEdit;
    DBEdit8: TRzDBEdit;
    DBEdit2: TRzDBDateTimePicker;
    Lab_State: TLabel;
    Label21: TLabel;
    DBEdit16: TRzDBEdit;
    GoodsCheckAcceptDtl: TckClientDataSet;
    DsGoodsCheckAcceptDtl: TDataSource;
    dbgGoodsCheckAcceptDtl: TxDBGridEh;
    GoodsCheckAcceptDtlbillno: TStringField;
    GoodsCheckAcceptDtlitemno: TIntegerField;
    GoodsCheckAcceptDtlgoodsid: TStringField;
    GoodsCheckAcceptDtlname: TStringField;
    GoodsCheckAcceptDtlspecs: TStringField;
    GoodsCheckAcceptDtlunit: TStringField;
    GoodsCheckAcceptDtlbatchno: TStringField;
    GoodsCheckAcceptDtlproddate: TDateTimeField;
    GoodsCheckAcceptDtlvaliddate: TDateTimeField;
    GoodsCheckAcceptDtleligiblecard: TStringField;
    GoodsCheckAcceptDtlqualitystate: TStringField;
    GoodsCheckAcceptDtlpackagestate: TStringField;
    GoodsCheckAcceptDtllabelstate: TStringField;
    GoodsCheckAcceptDtldirections: TStringField;
    GoodsCheckAcceptDtlcheckqty: TBCDField;
    GoodsCheckAcceptDtleligibleqty: TBCDField;
    GoodsCheckAcceptDtlrejectqty: TBCDField;
    GoodsCheckAcceptDtlcheckverdict: TStringField;
    GoodsCheckAcceptDtlchecker: TStringField;
    GoodsCheckAcceptDtlcheckdate: TDateTimeField;
    GoodsCheckAcceptDtlaccepter: TStringField;
    GoodsCheckAcceptDtlremark: TStringField;
    RzLabel7: TRzLabel;
    RzDBLabel1: TRzDBLabel;
    RzLabel16: TRzLabel;
    RzDBLabel2: TRzDBLabel;
    RzDBButtonEdit1: TRzEdit;
    GoodsCheckAcceptBillNo: TStringField;
    GoodsCheckAcceptFDate: TDateTimeField;
    GoodsCheckAcceptCheckKind: TSmallintField;
    GoodsCheckAcceptProvNo: TStringField;
    GoodsCheckAcceptProvName: TStringField;
    GoodsCheckAcceptPBillNo: TStringField;
    GoodsCheckAcceptRemark: TStringField;
    GoodsCheckAcceptAudit: TStringField;
    GoodsCheckAcceptTransfer: TBooleanField;
    GoodsCheckAcceptCreater: TStringField;
    GoodsCheckAcceptCreatTime: TDateTimeField;
    GoodsCheckAcceptMender: TStringField;
    GoodsCheckAcceptGrup: TIntegerField;
    GoodsCheckAcceptAdsGoodsCheckAcceptDtl: TDataSetField;
    GoodsCheckAcceptFullName: TStringField;
    edCustName: TRzButtonEdit;
    procedure ActSaveExecute(Sender: TObject);
    procedure ActDeleteExecute(Sender: TObject);
    procedure ActCancelExecute(Sender: TObject);
    procedure ActFirstExecute(Sender: TObject);
    procedure ActPriorExecute(Sender: TObject);
    procedure ActNextExecute(Sender: TObject);
    procedure ActLastExecute(Sender: TObject);
    procedure ActAddSubItemExecute(Sender: TObject);
    procedure ActDelSubItemExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure GoodsCheckAcceptReconcileError(DataSet: TCustomClientDataSet;
      E: EReconcileError; UpdateKind: TUpdateKind;
      var Action: TReconcileAction);
    procedure GoodsCheckAcceptNewRecord(DataSet: TDataSet);
    procedure GoodsCheckAcceptDtlNewRecord(DataSet: TDataSet);
    procedure GoodsCheckAcceptDtlBeforeInsert(DataSet: TDataSet);
    procedure GoodsCheckAcceptDtlReconcileError(
      DataSet: TCustomClientDataSet; E: EReconcileError;
      UpdateKind: TUpdateKind; var Action: TReconcileAction);
    procedure dbgGoodsCheckAcceptDtlEditButtonClick(Sender: TObject);
    procedure GoodsCheckAcceptDtlgoodsidChange(Sender: TField);
    procedure FormShow(Sender: TObject);
    procedure ActUpdateExecute(Sender: TObject);
    procedure GoodsCheckAcceptprovnoChange(Sender: TField);
    procedure GoodsCheckAcceptDtlcheckqtyChange(Sender: TField);
    procedure GoodsCheckAcceptDtlBeforePost(DataSet: TDataSet);
    procedure GoodsCheckAcceptDtlAfterPost(DataSet: TDataSet);
    procedure GoodsCheckAcceptAfterScroll(DataSet: TDataSet);
    procedure ActAuditExecute(Sender: TObject);
    procedure ActRevertExecute(Sender: TObject);
    procedure ActFieldLayoutExecute(Sender: TObject);
    procedure ActDataExportExecute(Sender: TObject);
    procedure edCustNameButtonClick(Sender: TObject);
  private
    CdsFieldProperty :TckClientDataSet;
    SvrCommon,SvrGoodsCheckAccept:TDispatchConnection;
    bBrowGoods:Boolean;
    LocSetting: PLocSetting;
    BeforeCustNo,FlagGoodsID,BeforeGoodsID:String;
    iClientID,iLastItemNo:Integer;
    procedure BrowGoods;
  public
    { Public declarations }
  protected
    Function DoSome(cType: PChar; Values: Variant): Variant; override;     
  end;

Const
  sPayModes='Select PayModeNo,PayModename,TimeLimit From PayModes order By PayModeNO';
  sFieldProPerty='Select * From SysFieldProperty '+
        ' Where TableName='+'''Goodses'' and FieldName in ('+'''Name'',''Specs'') '+
        ' Or TableName='+'''Providers''  and FieldName =''ProvName''' +
        ' Or TableName In ('+'''GoodsCheckAccept'',''GoodsCheckAcceptDtl'', ''Goodses'') ';

var
  FmSelGoodsCheckAccept: TFmSelGoodsCheckAccept;

implementation
Uses SelectGoodsFrm,FieldsLayoutFrm,DataExportFrm;

{$R *.dfm}

procedure TFmSelGoodsCheckAccept.ActSaveExecute(Sender: TObject);
begin
  Try
    If FEditMode=0 Then Exit;
    If GoodsCheckAccept.State in dsEditModes Then Begin
      If GoodsCheckAcceptprovno.Value='' Then Begin
        Messagebox(handle,Pchar('销售退回质量验收的[客户单位]不能为空！'),'错误',16);
        Exit;
      End;
    End;
    Inherited;
  Except
    On E:Exception Do ;
  End;
end;

procedure TFmSelGoodsCheckAccept.ActDeleteExecute(Sender: TObject);
begin
  Try
    If GoodsCheckAccept.IsEmpty Then Exit;
    if IsEditing then Exit;           
    If GoodsCheckAcceptTransfer.Value Then Begin
      Messagebox(Handle,Pchar('当前单据已[复核]，不能执行删除操作！'),'警告',64);
      Exit;
    End;
    If Application.MessageBox('确实要删除当前数据吗？','提示',4+32)<>6 then Exit;
      inherited;
  Except
    On E:Exception Do
      Messagebox(Handle,Pchar(E.Message),'',16);
  End;
end;

procedure TFmSelGoodsCheckAccept.ActCancelExecute(Sender: TObject);
begin
  Try
    if FEditMode>0 then
      If Application.MessageBox('确实要取消当前的操作吗？','提示',4+32)=6 Then
      Begin
        inherited;
      End;
  Except
    ON E:Exception Do
      Messagebox(Handle,Pchar(E.Message),'',16);
  End;
end;

procedure TFmSelGoodsCheckAccept.ActFirstExecute(Sender: TObject);
begin
  IF FEditMode=0 Then GoodsCheckAccept.First;
end;

procedure TFmSelGoodsCheckAccept.ActPriorExecute(Sender: TObject);
begin
  If FEditMode=0 Then GoodsCheckAccept.Prior;
end;

procedure TFmSelGoodsCheckAccept.ActNextExecute(Sender: TObject);
begin
  If FEditMode=0 Then GoodsCheckAccept.Next;
end;

procedure TFmSelGoodsCheckAccept.ActLastExecute(Sender: TObject);
begin
  If FEditMode=0 Then GoodsCheckAccept.Last;
end;

procedure TFmSelGoodsCheckAccept.ActAddSubItemExecute(Sender: TObject);
begin
  If FEditMode=0 Then Exit;
  If Not(GoodsCheckAccept.State In dsEditModes) then
  GoodsCheckAcceptDtl.Append;
end;

procedure TFmSelGoodsCheckAccept.ActDelSubItemExecute(Sender: TObject);
begin
  If FEditMode=0 Then Exit;
	if GoodsCheckAcceptDtl.IsEmpty then Exit;
      GoodsCheckAcceptDtl.Delete;
End;

procedure TFmSelGoodsCheckAccept.FormCreate(Sender: TObject);
begin
  inherited;
  CdsFieldProperty:=TCkClientDataSet.Create(Self);
  LocSetting := IFmMain.IFmMainEx.GetLocSetting;
  SetGressHint('正在登录到销售退回质量验怍服务器...');
  iClientID:=IFmMain.IFmMainEx.ClientID;
  SetLength(FDetailDataSets, 1);
  FDetailDataSets[0] := GoodsCheckAcceptDtl;
  RepDataSetNames := '销售退回质量验收;销售退回质量验收明细';
  sRepSection := '药品销售退回质量验收';
  SvrGoodsCheckAccept:=IFmMain.GetConnection(Handle,'','ckSalesBase.SalesBase');

  sBillNoList.Text := SvrGoodsCheckAccept.AppServer.GetCurrMonthBills(iClientID, 'GoodsCheckAccept');

  GoodsCheckAccept.RemoteServer:=SvrGoodsCheckAccept;
  SetGressHint('正在连接到公用信息服务器...');
  SvrCommon:=iFmMain.GetConnection(Handle,'','CommonSvr.CommonRDM');
  CdsFieldProPerty.RemoteServer:=SvrCommon;
  CdsFieldProPerty.ProviderName:='DspTemp';
  SetGressHint('读取用户操作权限...');
  IFmMain.SetActionStatus(ActionList1, hInstance, self.ClassName);
  MasterDataSet:=GoodsCheckAccept;
end;

procedure TFmSelGoodsCheckAccept.GoodsCheckAcceptReconcileError(
  DataSet: TCustomClientDataSet; E: EReconcileError;
  UpdateKind: TUpdateKind; var Action: TReconcileAction);
begin
  Messagebox(Handle,Pchar(E.Message),'',16);
  Action:=RaAbort;
end;

procedure TFmSelGoodsCheckAccept.GoodsCheckAcceptNewRecord(DataSet: TDataSet);
Var sBillNo:String;
Begin
//  sBillNo := BuildBillNo('SelGoodsCheckAccept');
  sBillNo := BuildBillNo('GoodsCheckAccept');

  GoodsCheckAcceptBillNo.Value :=sBillNo;
  GoodsCheckAcceptFDate.Value:=Date;
  GoodsCheckAcceptGrup.Value:=1;
  GoodsCheckAcceptCheckKind.Value:=1; //表示销售退回验收
end;

procedure TFmSelGoodsCheckAccept.GoodsCheckAcceptDtlNewRecord(DataSet: TDataSet);
begin
  BeforeGoodsID:='';
  GoodsCheckAcceptDtlItemNo.Value:=iLastItemNO;
  GoodsCheckAcceptDtlBillNo.Value:=GoodsCheckAcceptBillNo.Value;
  GoodsCheckAcceptDtlProdDate.Value:=Date;
  GoodsCheckAcceptDtlValidDate.Value:=incMonth(Date,1);
  GoodsCheckAcceptDtlCheckDate.Value:=date;
end;

procedure TFmSelGoodsCheckAccept.GoodsCheckAcceptDtlBeforeInsert(DataSet: TDataSet);
begin
  iLastItemNO:=GetFieldMaxInt(GoodsCheckAcceptDtl,'ItemNO')+1;