wastagefrm.~pas

来自「群星医药系统源码」· ~PAS 代码 · 共 542 行 · 第 1/2 页

unit WastageFrm;

interface

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

type
  TFmWastage = class(TceBaseBillForm)
    Label3: TLabel;
    Label1: TLabel;
    Label2: TLabel;
    Label7: TLabel;
    Label4: TLabel;
    Lab_State: TLabel;
    edBillID: TRzDBEdit;
    edDate: TRzDBDateTimePicker;
    RzDBEdit1: TRzDBEdit;
    edEmpID: TRzDBButtonEdit;
    edDepot: TRzDBButtonEdit;
    RzDBEdit3: TRzDBEdit;
    RzDBEdit5: TRzDBEdit;
    Label11: TLabel;
    Label22: TLabel;
    Label9: TLabel;
    RzDBEdit21: TRzDBEdit;
    RzDBEdit10: TRzDBEdit;
    RzDBEdit4: TRzDBEdit;
    dbgWastageDtl: TxDBGridEh;
    cdsWastage: TckClientDataSet;
    cdsWastageDtl: TckClientDataSet;
    cdsWastageBillNo: TStringField;
    cdsWastageFDate: TDateTimeField;
    cdsWastageDepotID: TIntegerField;
    cdsWastageDepotNo: TStringField;
    cdsWastageDepotName: TStringField;
    cdsWastageInOutKind: TIntegerField;
    cdsWastageEmpNo: TStringField;
    cdsWastageName: TStringField;
    cdsWastageAudit: TStringField;
    cdsWastageGoodsQty: TBCDField;
    cdsWastageGoodsSum: TBCDField;
    cdsWastageRemark: TStringField;
    cdsWastageTransfer: TBooleanField;
    cdsWastageCreater: TStringField;
    cdsWastageCreattime: TDateTimeField;
    cdsWastageMender: TStringField;
    cdsWastageGrup: TIntegerField;
    cdsWastageadsWastageDtl: TDataSetField;
    cdsWastageDtlBillNo: TStringField;
    cdsWastageDtlItemNo: TIntegerField;
    cdsWastageDtlGoodsID: TStringField;
    cdsWastageDtlName: TStringField;
    cdsWastageDtlSpecs: TStringField;
    cdsWastageDtlDoseType: TStringField;
    cdsWastageDtlPdcAddr: TStringField;
    cdsWastageDtlMaker: TStringField;
    cdsWastageDtlUnit: TStringField;
    cdsWastageDtlQty: TBCDField;
    cdsWastageDtlPrice: TFloatField;
    cdsWastageDtlAmount: TBCDField;
    cdsWastageDtlBerthNo: TStringField;
    cdsWastageDtlGroupNo: TIntegerField;
    cdsWastageDtlBatchNo: TStringField;
    cdsWastageDtlValidDate: TDateTimeField;
    cdsWastageDtlProvNo: TStringField;
    cdsWastageDtlProvName: TStringField;
    cdsWastageDtlQualityState: TStringField;
    dsWastageDtl: TDataSource;
    dsWastage: TDataSource;
    Label5: TLabel;
    Label6: TLabel;
    RzDBLabel1: TRzDBLabel;
    RzDBLabel2: TRzDBLabel;
    procedure FormShow(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ActInsertExecute(Sender: TObject);
    procedure ActUpdateExecute(Sender: TObject);
    procedure ActSaveExecute(Sender: TObject);
    procedure ActAuditExecute(Sender: TObject);
    procedure ActRevertExecute(Sender: TObject);
    procedure cdsWastageDepotNoChange(Sender: TField);
    procedure edEmpIDChange(Sender: TObject);
    procedure cdsWastageAfterScroll(DataSet: TDataSet);
    procedure cdsWastageDtlBeforeInsert(DataSet: TDataSet);
    procedure cdsWastageDtlNewRecord(DataSet: TDataSet);
    procedure cdsWastageReconcileError(DataSet: TCustomClientDataSet;
      E: EReconcileError; UpdateKind: TUpdateKind;
      var Action: TReconcileAction);
    procedure cdsWastageNewRecord(DataSet: TDataSet);
    procedure dbgWastageDtlEditButtonClick(Sender: TObject);
    procedure edDepotButtonClick(Sender: TObject);
    procedure edEmpIDButtonClick(Sender: TObject);
    procedure cdsWastageDtlAfterPost(DataSet: TDataSet);
    procedure cdsWastageDtlPriceChange(Sender: TField);
    procedure cdsWastageEmpNoChange(Sender: TField);
    procedure ActQueryExecute(Sender: TObject);
    procedure cdsWastageDtlGoodsIDChange(Sender: TField);
    procedure ActDataExportExecute(Sender: TObject);
    procedure ActFieldLayoutExecute(Sender: TObject);
  private
    { Private declarations }
    bBrowGoods,CanAudit, CanRevert:Boolean;
    CdsFieldProPerty:TCkClientDataSet;
    iClientID,iLastItemNo:Integer;
    SvrWastage ,SvrCommon:TDispatchConnection;
    BeforeGoodsID,FlagGoodsID,BeforeProvNo,BeforeEmpNo,BeforeDepotNo:String;
    procedure ParseGoodsInfo;
  public
    { Public declarations }
  end;

const
  sFieldProPerty='Select * From SysFieldProPerty '+
    ' Where TableName in(''Wastage'',''WastageDtl'',''Goodses'')';

var
  FmWastage: TFmWastage;

implementation
uses
  SelectEmpFrm,SelectProvFrm,SelectDepotFrm, ViewGoodsPriceFrm, SelectBatchNoFrm,
  SelectBerthFrm,SelectGoodsFrm,FieldsLayoutFrm,DataExportFrm;

{$R *.dfm}

procedure TFmWastage.FormCreate(Sender: TObject);
begin
  inherited;
  IFmMain.SetActionStatus(ActionList1, hInstance, self.ClassName);
  CdsFieldProPerty:=TCKClientDataSet.Create(Self);
  LocSetting := IFmMain.IFmMainEx.GetLocSetting;
  SetGressHint('正在连接药品库存服务器...');
  CanAudit := ActAudit.Enabled;
  CanRevert:= ActCancel.Enabled;
  iClientID :=IFmMain.IFmMainEx.ClientID;
  SvrWastage :=IFmMain.GetConnection(Handle,'','CkStockSvr.Stock');
  sBillNoList.Text := SvrWastage.AppServer.GetCurrMonthBills(iClientID, 'Wastage');
  CdsWastage.RemoteServer := SvrWastage;
  SetGressHint('正在连接到公用信息服务器...');
  SvrCommon:=IFmMain.GetConnection(Handle,'','CommonSvr.CommonRDM');
  CdsFieldProPerty.ProviderName := 'DspTemp';
  CdsFieldProPerty.RemoteServer := SvrCommon;
  SetGressHint('正在读取用户操作权限...');
  SetLength(FDetailDataSets, 1);
  RepDataSetNames := '药品报损;药品报损明细';
  sRepSection := '药品报损单';
  MasterDataSet:=CdsWastage;
  FDetailDataSets[0] := CdsWastageDtl;
end;

procedure TFmWastage.FormShow(Sender: TObject);
var sTableNames : string;
begin
  SetGressHint('初始化本地环境...');
  SetGridEhColor(dbgWastageDtl);
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFmWastage.Xml');
  SetFieldProperty(CdsFieldProPerty,CdsWastage, 'Wastage');
  SetFieldProperty(CdsFieldProPerty,CdsWastageDtl, 'WastageDtl,Goodses');
  SetGressHint('读取历史单据...');
  SetCurrBillIdx(0);
  inherited;
  FreeGressForm;
end;

procedure TFmWastage.ActInsertExecute(Sender: TObject);
begin
  inherited;//
  BeforeDepotNo := '';
  BeforeProvNo  := '';
  BeforeEmpNo   := '';
end;

procedure TFmWastage.ActUpdateExecute(Sender: TObject);
begin
  inherited;
  BeforeDepotNo := '';
  BeforeProvNo  := '';
  BeforeEmpNo   := '';
end;

procedure TFmWastage.ActSaveExecute(Sender: TObject);
begin
  inherited; //
  Try
    If  FEditMode=0 Then Exit;
    Inherited;
  Except
    On E:Exception Do
      Messagebox(Handle,Pchar(E.Message),nil,16);
  End;
end;

procedure TFmWastage.ActAuditExecute(Sender: TObject);
Var Str : String;
    sSysInfo : Variant;
begin
  if FEditMode>0 then Exit;
  if cdsWastage.IsEmpty 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 cdsWastageFDate.Value<VarToDateTime(sSysInfo) Then Begin
      Messagebox(Handle,Pchar('该月已结算，不能操作已月结的单据！'),nil,16);
      Exit;
    End;
  End Else Begin
    Messagebox(Handle,Pchar('请先设置开帐日期...'),nil,16);
    Exit;
  End;
  if not SvrWastage.AppServer.BillAudit(iClientID, 'Wastage', cdsWastageBillNo.Value) then begin
      Messagebox(Handle,Pchar('复核数据不成功！'),nil,16);
  end else begin
    ActAudit.Enabled:=False and CanAudit;
    ActRevert.Enabled:=True and CanRevert;
    Lab_State.Caption:='单据状态：已审核';
    Lab_State.Font.Color:=clRed;
    ActRefreshExecute(NIL);
  End;
end;

procedure TFmWastage.ActRevertExecute(Sender: TObject);
begin
  if FEditMode>0 then Exit;
  if CdsWastage.IsEmpty then Exit;
  if Application.MessageBox('确实要还原当前已审核过的数据吗？','提示',4+32)<>6 then
    Exit;
  if not SvrWastage.AppServer.BillRevert(iClientID, 'Wastage', cdsWastageBillNo.Value) then begin
      Messagebox(Handle,Pchar('还原数据不成功！'),nil,16)
  end else Begin
    ActAudit.Enabled:=True;
    ActRevert.Enabled:=False;
    Lab_State.Caption:='单据状态：未审核';
    Lab_State.Font.Color:=clHotLight;
    ActRefreshExecute(NIL);
  end;
end;

procedure TFmWastage.cdsWastageDepotNoChange(Sender: TField);
Var
  sDepotNo,LogText:String;
  A:Variant;
begin
  Try
    IF FEditMode=0 Then Exit;
    sDepotNo:=cdsWastageDepotNo.Value;
    If sDepotNo='' Then Exit;
    if sDepotNo=BeforeDepotNo Then Exit;
    BeforeDepotNo:=sDepotNo;
    A := SvrCommon.AppServer.GetDepotInfo(iClientID,sDepotNo,2,'DepotID,DepotName',LogText);
    CdsWastageDepotID.Value  := A[0];
    CdsWastageDepotName.Value:= A[1];
    If LogText<>'' Then Begin
      Messagebox(Handle,Pchar(LogText),nil,16);
      RzDBEdit3.SetFocus;
      Abort;
    End;
  Except
    Messagebox(Handle,Pchar(LogText),nil,16);
    RzDBEdit3.SetFocus;
  End;
end;

procedure TFmWastage.edEmpIDChange(Sender: TObject);