overflowfrm.pas

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

unit OverflowFrm;

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
  TFmOverflow = 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;
    dbgOverflowDtl: TxDBGridEh;
    cdsOverflow: TckClientDataSet;
    cdsOverflowDtl: TckClientDataSet;
    dsOverflowDtl: TDataSource;
    dsOverflow: TDataSource;
    Label5: TLabel;
    Label6: TLabel;
    RzDBLabel1: TRzDBLabel;
    RzDBLabel2: TRzDBLabel;
    cdsOverflowBillNo: TStringField;
    cdsOverflowFDate: TDateTimeField;
    cdsOverflowDepotID: TIntegerField;
    cdsOverflowDepotNo: TStringField;
    cdsOverflowDepotName: TStringField;
    cdsOverflowInOutKind: TIntegerField;
    cdsOverflowEmpNo: TStringField;
    cdsOverflowName: TStringField;
    cdsOverflowAudit: TStringField;
    cdsOverflowGoodsQty: TBCDField;
    cdsOverflowGoodsSum: TBCDField;
    cdsOverflowRemark: TStringField;
    cdsOverflowTransfer: TBooleanField;
    cdsOverflowCreater: TStringField;
    cdsOverflowCreattime: TDateTimeField;
    cdsOverflowMender: TStringField;
    cdsOverflowGrup: TIntegerField;
    cdsOverflowadsOverflowDtl: TDataSetField;
    cdsOverflowDtlBillNo: TStringField;
    cdsOverflowDtlItemNo: TIntegerField;
    cdsOverflowDtlGoodsID: TStringField;
    cdsOverflowDtlName: TStringField;
    cdsOverflowDtlSpecs: TStringField;
    cdsOverflowDtlDoseType: TStringField;
    cdsOverflowDtlPdcAddr: TStringField;
    cdsOverflowDtlMaker: TStringField;
    cdsOverflowDtlUnit: TStringField;
    cdsOverflowDtlQty: TBCDField;
    cdsOverflowDtlPrice: TFloatField;
    cdsOverflowDtlAmount: TBCDField;
    cdsOverflowDtlBerthNo: TStringField;
    cdsOverflowDtlGroupNo: TIntegerField;
    cdsOverflowDtlBatchNo: TStringField;
    cdsOverflowDtlValidDate: TDateTimeField;
    cdsOverflowDtlProvNo: TStringField;
    cdsOverflowDtlProvName: TStringField;
    cdsOverflowDtlQualityState: TStringField;
    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 cdsOverflowDepotNoChange(Sender: TField);
    procedure edEmpIDChange(Sender: TObject);
    procedure cdsOverflowAfterScroll(DataSet: TDataSet);
    procedure cdsOverflowDtlBeforeInsert(DataSet: TDataSet);
    procedure cdsOverflowDtlNewRecord(DataSet: TDataSet);
    procedure cdsOverflowReconcileError(DataSet: TCustomClientDataSet;
      E: EReconcileError; UpdateKind: TUpdateKind;
      var Action: TReconcileAction);
    procedure cdsOverflowNewRecord(DataSet: TDataSet);
    procedure dbgOverflowDtlEditButtonClick(Sender: TObject);
    procedure edDepotButtonClick(Sender: TObject);
    procedure edEmpIDButtonClick(Sender: TObject);
    procedure cdsOverflowDtlAfterPost(DataSet: TDataSet);
    procedure cdsOverflowDtlPriceChange(Sender: TField);
    procedure cdsOverflowEmpNoChange(Sender: TField);
    procedure ActQueryExecute(Sender: TObject);
    procedure cdsOverflowDtlGoodsIDChange(Sender: TField);
    procedure ActDataExportExecute(Sender: TObject);
    procedure ActFieldLayoutExecute(Sender: TObject);
  private
    { Private declarations }
    CanAudit, CanRevert, bBrowGoods:Boolean;
    CdsFieldProPerty:TCkClientDataSet;
    iClientID,iLastItemNo:Integer;
    SvrOverflow ,SvrCommon:TDispatchConnection;
    BeforeGoodsID,FlagGoodsID,BeforeProvNo,BeforeEmpNo,BeforeDepotNo:String;
    procedure ParseGoodsInfo;
  public
    { Public declarations }
  end;

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

var
  FmOverflow: TFmOverflow;

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

{$R *.dfm}

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

procedure TFmOverflow.FormShow(Sender: TObject);
var sTableNames : string;
begin
  SetGressHint('初始化本地环境...');
  SetGridEhColor(dbgOverflowDtl);
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFmOverflow.Xml');
  SetFieldProperty(CdsFieldProPerty,CdsOverflow, 'Overflow');
  SetFieldProperty(CdsFieldProPerty,CdsOverflowDtl, 'OverflowDtl,Goodses');
  SetGressHint('读取历史单据...');
  SetCurrBillIdx(0);
  inherited;
  FreeGressForm;
end;

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

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

procedure TFmOverflow.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 TFmOverflow.ActAuditExecute(Sender: TObject);
Var Str : String;
    sSysInfo : Variant;
begin
  if FEditMode>0 then Exit;
  if cdsOverflow.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 cdsOverflowFDate.Value<VarToDateTime(sSysInfo) Then Begin
      Messagebox(Handle,Pchar('该月已结算，不能操作已月结的单据！'),nil,16);
      Exit;
    End;
  End Else Begin
    Messagebox(Handle,Pchar('请先设置开帐日期...'),nil,16);
    Exit;
  End;

  if not SvrOverflow.AppServer.BillAudit(iClientID, 'Overflow', cdsOverflowBillNo.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 TFmOverflow.ActRevertExecute(Sender: TObject);
begin
  if FEditMode>0 then Exit;
  if CdsOverflow.IsEmpty then Exit;
  if Application.MessageBox('确实要还原当前已审核过的数据吗？','提示',4+32)<>6 then
    Exit;
  if not SvrOverflow.AppServer.BillRevert(iClientID, 'Overflow', cdsOverflowBillNo.Value) then begin
      Messagebox(Handle,Pchar('还原数据不成功！'),nil,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;
end;

procedure TFmOverflow.cdsOverflowDepotNoChange(Sender: TField);
Var
  sDepotNo,LogText:String;
  A:Variant;
begin
  Try
    IF FEditMode=0 Then Exit;
    sDepotNo:=cdsOverflowDepotNo.Value;
    If sDepotNo='' Then Exit;
    if sDepotNo=BeforeDepotNo Then Exit;
    BeforeDepotNo:=sDepotNo;
    A := SvrCommon.AppServer.GetDepotInfo(iClientID,sDepotNo,2,'DepotID,DepotName',LogText);
    CdsOverflowDepotID.Value  := A[0];
    CdsOverflowDepotName.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;