selgoodscheckaccept3.pas

医药连锁经营管理系统源码

unit SelGoodsCheckAccept3;     // 医疗机器

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ceBaseBillFrm, Menus, ActnList, ModuleAction, ImgList, TB2Dock,
  ExtCtrls, RzPanel, Buttons, RzButton, TB2Item, TB2Toolbar, DB, DBClient,
  MConnect, Grids, DBGridEh, DbUtilsEh, EhLibCDS, xEhLibCtl, StdCtrls, RzCmboBx, RzDBCmbo,
  RzDBBnEd, ComCtrls, RzDTP, RzDBDTP, Mask, RzEdit, RzDBEdit, RzRadGrp,
  RzDBRGrp,RecError,TransComp,uGlobal, sConnect, ckDBClient,DbFuncs,ShowProGress,
  uDataTypes,ceGlobal,SelectCustFrm, RzLabel, RzDBLbl;

type
  TFmSelGoodsCheckAccept3 = class(TceBaseBillForm)
    CdsGoodsCheckAccept: TckClientDataSet;
    CdsGoodsCheckAcceptDtl: TckClientDataSet;
    DcomCnn: TDCOMConnection;
    DsGoodsCheckAccept: TDataSource;
    DsGoodsCheckAcceptDtl: TDataSource;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label7: TLabel;
    RzDBEdit1: TRzDBEdit;
    RzDBDateTimePicker1: TRzDBDateTimePicker;
    Lab_State: TLabel;
    RzDBEdit2: TRzDBEdit;
    RzDBEdit4: TRzDBEdit;
    edProvName: TRzDBButtonEdit;
    RzDBEdit3: TRzDBEdit;
    RzDBLabel2: TRzDBLabel;
    RzLabel2: TRzLabel;
    RzDBLabel1: TRzDBLabel;
    RzLabel1: TRzLabel;
    RzDBButtonEdit1: TRzDBEdit;
    CdsGoodsCheckAcceptDtlBillNo: TStringField;
    CdsGoodsCheckAcceptDtlItemNo: TIntegerField;
    CdsGoodsCheckAcceptDtlGoodsID: TStringField;
    CdsGoodsCheckAcceptDtlName: TStringField;
    CdsGoodsCheckAcceptDtlSpecs: TStringField;
    CdsGoodsCheckAcceptDtlUnit: TStringField;
    CdsGoodsCheckAcceptDtlCheckQty: TBCDField;
    CdsGoodsCheckAcceptDtlPrice: TFloatField;
    CdsGoodsCheckAcceptDtlAmount: TBCDField;
    CdsGoodsCheckAcceptDtlBatchNo: TStringField;
    CdsGoodsCheckAcceptDtlProdDate: TDateTimeField;
    CdsGoodsCheckAcceptDtlValidDate: TDateTimeField;
    CdsGoodsCheckAcceptDtlVerifyReport: TStringField;
    CdsGoodsCheckAcceptDtlPassGateNo: TStringField;
    CdsGoodsCheckAcceptDtlRegisterCardNo: TStringField;
    CdsGoodsCheckAcceptDtlEligibleCard: TStringField;
    CdsGoodsCheckAcceptDtlQualityState: TStringField;
    CdsGoodsCheckAcceptDtlPackageState: TStringField;
    CdsGoodsCheckAcceptDtlLabelState: TStringField;
    CdsGoodsCheckAcceptDtlDirections: TStringField;
    CdsGoodsCheckAcceptDtlEligibleQty: TBCDField;
    CdsGoodsCheckAcceptDtlRejectQty: TBCDField;
    CdsGoodsCheckAcceptDtlCheckVerdict: TStringField;
    CdsGoodsCheckAcceptDtlChecker: TStringField;
    CdsGoodsCheckAcceptDtlCheckDate: TDateTimeField;
    CdsGoodsCheckAcceptDtlAccepter: TStringField;
    CdsGoodsCheckAcceptDtlRemark: TStringField;
    CdsGoodsCheckAcceptDtlPBillNo: TStringField;
    CdsGoodsCheckAcceptDtlPItemNO: TIntegerField;
    CdsGoodsCheckAcceptDtlPdcAddr: TStringField;
    CdsGoodsCheckAcceptDtlMakerName: TStringField;
    CdsGoodsCheckAcceptDtlPassNO: TStringField;
    CdsGoodsCheckAcceptDtlBrand: TStringField;
    CdsGoodsCheckAcceptDtlGermicidalNo: TStringField;
    dbgGoodsCheckAcceptDtl: TxDBGridEh;
    CdsGoodsCheckAcceptBillNo: TStringField;
    CdsGoodsCheckAcceptFDate: TDateTimeField;
    CdsGoodsCheckAcceptCheckKind: TSmallintField;
    CdsGoodsCheckAcceptProvNo: TStringField;
    CdsGoodsCheckAcceptProvName: TStringField;
    CdsGoodsCheckAcceptPBillNo: TStringField;
    CdsGoodsCheckAcceptRemark: TStringField;
    CdsGoodsCheckAcceptAudit: TStringField;
    CdsGoodsCheckAcceptTransfer: TBooleanField;
    CdsGoodsCheckAcceptCreater: TStringField;
    CdsGoodsCheckAcceptCreatTime: TDateTimeField;
    CdsGoodsCheckAcceptMender: TStringField;
    CdsGoodsCheckAcceptGrup: TIntegerField;
    CdsGoodsCheckAcceptAdsGoodsCheckAcceptDtl: TDataSetField;
    CdsGoodsCheckAcceptCheckType: TSmallintField;
    procedure FormCreate(Sender: TObject);
    procedure edProvNameButtonClick(Sender: TObject);
    procedure ActAddSubItemExecute(Sender: TObject);
    procedure CdsGoodsCheckAcceptDtlNewRecord(DataSet: TDataSet);
    procedure CdsGoodsCheckAcceptDtlBeforeInsert(DataSet: TDataSet);
    procedure CdsGoodsCheckAcceptReconcileError(
      DataSet: TCustomClientDataSet; E: EReconcileError;
      UpdateKind: TUpdateKind; var Action: TReconcileAction);
    procedure ActDelSubItemExecute(Sender: TObject);
    procedure ActRefershExecute(Sender: TObject);
    procedure ActDeleteExecute(Sender: TObject);
    procedure CdsGoodsCheckAcceptDtlReconcileError(
      DataSet: TCustomClientDataSet; E: EReconcileError;
      UpdateKind: TUpdateKind; var Action: TReconcileAction);
    procedure ActSaveExecute(Sender: TObject);
    procedure CdsGoodsCheckAcceptProvNoChange(Sender: TField);
    procedure FormShow(Sender: TObject);
    procedure CdsGoodsCheckAcceptDtlGoodsIDChange(Sender: TField);
    procedure dbgGoodsCheckAcceptDtlEditButtonClick(Sender: TObject);
    procedure ActUpdateExecute(Sender: TObject);
    procedure CdsGoodsCheckAcceptDtlAfterDelete(DataSet: TDataSet);
    procedure CdsGoodsCheckAcceptAfterScroll(DataSet: TDataSet);
    procedure ActAuditExecute(Sender: TObject);
    procedure ActRevertExecute(Sender: TObject);
    procedure ActFieldLayoutExecute(Sender: TObject);
    procedure ActDataExportExecute(Sender: TObject);
    procedure CdsGoodsCheckAcceptNewRecord(DataSet: TDataSet);
    procedure ActQueryExecute(Sender: TObject);
    procedure CdsGoodsCheckAcceptDtlEligibleQtyChange(Sender: TField);
    procedure CdsGoodsCheckAcceptDtlCheckQtyChange(Sender: TField);
    procedure CdsGoodsCheckAcceptDtlRejectQtyChange(Sender: TField);
  private
    iClientID:Integer;
    bBrowGoods, CanAudit, CanRevert:Boolean;
    FlagGoodsID,BeforeGoodsID,BeforeProvNo:String;
    CdsFieldProperty:TCkClientDataSet;
    LocSetting: PLocSetting;
    SvrGoodsCheckAccept,SvrCommon:TDispatchConnection;

    procedure SetDatasetState;
    procedure ParseGoodsInfo;
  public
    GetItemNo :Integer;
  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 in (''GoodsCheckAccept'', ''GoodsCheckAcceptDtl'', ''Goodses'')';
var
  FmSelGoodsCheckAccept3: TFmSelGoodsCheckAccept3;

implementation
uses SelectGoodsFrm,FieldsLayoutFrm,DataExportFrm, SelectEmpFrm,ViewGoodsPriceFrm;
{$R *.dfm}
procedure TFmSelGoodsCheckAccept3.FormCreate(Sender: TObject);
begin
  inherited;
  LocSetting := IFmMain.IFmMainEx.GetLocSetting;
  SetGressHint('正在登录到质量验收服务器...');
  CanAudit := ActAudit.Enabled;
  CanRevert:= ActCancel.Enabled;
  CdsFieldProperty:=TCkClientDataSet.Create(Self);
  SvrGoodsCheckAccept:=iFmMain.GetConnection(Handle,'','ckSalesBase.SalesBase');
  SetGressHint('正在连接到公用信息服务器');
  SvrCommon:=iFmMain.GetConnection(Handle,'','CommonSvr.CommonRDM');
  SetGressHint('读取用户操作权限');
  IFmMain.SetActionStatus(ActionList1, hInstance, self.ClassName);
  iClientID:=LogonInfo^.ClientID;
  sBillNoList.Text := SvrGoodsCheckAccept.AppServer.GetCurrMonthBills(iClientID, 'SelGoodsCheckAccept3'); // 销退医疗机械
  CdsGoodsCheckAccept.RemoteServer:=SvrGoodsCheckAccept;
  MasterDataSet := CdsGoodsCheckAccept;

  SetLength(FDetailDataSets, 1);
  FDetailDataSets[0] := CdsGoodsCheckAcceptDtl;
  RepDataSetNames := '进口药品质量验收;进口药品质量验收明细';

  CdsFieldProPerty.ProviderName:='DspTemp';
  CdsFieldProPerty.RemoteServer:=SvrCommon;
end;

procedure TFmSelGoodsCheckAccept3.FormShow(Sender: TObject);
Var
  sTableNames:String;
Begin
  LoadFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [dbgGoodsCheckAcceptDtl]);
  SetGressHint('初始化本地环境...');
  SetGridEhColor([dbgGoodsCheckAcceptDtl]);
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFmSelGoodsCheckAccept3.Xml');
  SetFieldProperty(CdsFieldProPerty,CdsGoodsCheckAccept, 'GoodsCheckAccept');
  SetFieldProperty(CdsFieldProPerty,CdsGoodsCheckAcceptDtl, 'GoodsCheckAcceptDtl,Goodses');
  SetGressHint('读取历史单据...');
  SetCurrBillIdx(0);
  FreeGressForm;
  inherited;
End;

procedure TFmSelGoodsCheckAccept3.edProvNameButtonClick(Sender: TObject);
Var sProvNo,sProvName:String;
begin
  If FEditMode=0 Then Exit;
  sProvNo := CdsGoodsCheckAcceptProvNo.Value;
  If SelectCust(sProvNo,sProvName) Then Begin
    CdsGoodsCheckAcceptProvNo.Value := sProvNo;
    CdsGoodsCheckAcceptProvName.Value := sProvName;
  End;
End;

procedure TFmSelGoodsCheckAccept3.ActAddSubItemExecute(Sender: TObject);
begin
  If FEditMode=0 Then Exit;
  If Not(CdsGoodsCheckAccept.State In dsEditModes) Then Exit;
  CdsGoodsCheckAcceptDtl.Append;
End;

procedure TFmSelGoodsCheckAccept3.CdsGoodsCheckAcceptDtlNewRecord(
  DataSet: TDataSet);
begin
  BeforeGoodsID:='';
  CdsGoodsCheckAcceptDtlBillNo.Value := CdsGoodsCheckAcceptBillNo.Value;
  CdsGoodsCheckAcceptDtlItemNo.Value := GetItemNo+1;
  CdsGoodsCheckAcceptDtlProdDate.Value:=Date;
  CdsGoodsCheckAcceptDtlValidDate.Value:=Date;
  CdsGoodsCheckAcceptDtlCheckDate.Value:=Date;
end;

procedure TFmSelGoodsCheckAccept3.CdsGoodsCheckAcceptDtlBeforeInsert(
  DataSet: TDataSet);
begin
  inherited;
  GetItemNo:=GetFieldMaxInt(CdsGoodsCheckAcceptDtl,'ItemNO');
end;

procedure TFmSelGoodsCheckAccept3.CdsGoodsCheckAcceptReconcileError(
  DataSet: TCustomClientDataSet; E: EReconcileError;
  UpdateKind: TUpdateKind; var Action: TReconcileAction);
begin
//  inherited;
//  HandleReconcileError(DataSet,UpdateKind,E);
  Messagebox(Handle,Pchar(E.Message),'错误提示:',16);
  Action := raAbort;
end;

procedure TFmSelGoodsCheckAccept3.ActDelSubItemExecute(Sender: TObject);
begin
  If FEditMode=0 Then Exit;
  if CdsGoodsCheckAcceptDtl.IsEmpty then Exit;
  CdsGoodsCheckAcceptDtl.Delete;
end;

procedure TFmSelGoodsCheckAccept3.ActRefershExecute(Sender: TObject);
begin
  CdsGoodsCheckAcceptdtl.active := False;
  CdsGoodsCheckAcceptdtl.active := True;
end;

procedure TFmSelGoodsCheckAccept3.ActDeleteExecute(Sender: TObject);
begin
  Try
    If CdsGoodsCheckAccept.IsEmpty Then Exit;
    if IsEditing then Exit;
    If CdsGoodsCheckAcceptTransfer.Value Then Begin
      Messagebox(Handle,Pchar('当前单据已[复核]，不能执行删除操作！'),'警告:',64);
      Exit;
    End;
    if CdsGoodsCheckAccept.IsEmpty  Then Exit;
    inherited;
  Except
    On E:Exception Do
      Messagebox(Handle,Pchar(E.Message),'',16);
  End;
End;

procedure TFmSelGoodsCheckAccept3.CdsGoodsCheckAcceptDtlReconcileError(
  DataSet: TCustomClientDataSet; E: EReconcileError;
  UpdateKind: TUpdateKind; var Action: TReconcileAction);
begin
  inherited;
  Action := raAbort;
end;

procedure TFmSelGoodsCheckAccept3.ActSaveExecute(Sender: TObject);
begin
  If  FEditMode=0 Then Exit;
  edProvName.SetFocus;
  IF CdsGoodsCheckAcceptDtl.State In dsEditModes Then
    CdsGoodsCheckAcceptDtl.Post;
  Inherited;
end;

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

procedure TFmSelGoodsCheckAccept3.CdsGoodsCheckAcceptDtlGoodsIDChange(
  Sender: TField);
{Var
  LogText,Flag,sGoodsID,sSetFields,sProvNo:String;
Begin
  IF FEditMode=0 Then Exit;
  IF FlagGoodsID<>'' Then Begin
    FlagGoodsID:='';
    Exit;
  End;
  sGoodsID:=CdsGoodsCheckAcceptDtlGoodsID.AsString;
  If sGoodsID='' Then Exit;