selretcheckinfrm.~pas

群星医药系统源码

unit SelRetCheckinFrm;

interface

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

type
  TFmSelRetCheckIn = class(TceBaseBillForm)
    Label1: TLabel;
    DcomCnn: TDCOMConnection;
    CdsSelRetCheckIn: TckClientDataSet;
    CdsSelRetCheckInDtl: TckClientDataSet;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label8: TLabel;
    Lab_State: TLabel;
    RzDBEdit1: TRzDBEdit;
    RzDBDateTimePicker1: TRzDBDateTimePicker;
    RzDBEdit2: TRzDBEdit;
    DsSelRetCheckIn: TDataSource;
    DsSelRetCheckInDtl: TDataSource;
    RzDBButtonEdit4: TRzDBButtonEdit;
    Label10: TLabel;
    RzDBEdit6: TRzDBEdit;
    RzDBNumericEdit1: TRzDBEdit;
    Label9: TLabel;
    RzDBEdit3: TRzDBEdit;
    RzDBCheckBox2: TRzDBCheckBox;
    RzDBEdit7: TRzDBEdit;
    dbgSelRetCheckInDtl: TxDBGridEh;
    Label7: TLabel;
    edCustName: TRzDBButtonEdit;
    RzDBEdit4: TRzDBEdit;
    RzLabel15: TRzLabel;
    RzLabel13: TRzLabel;
    RzLabel14: TRzLabel;
    RzDBNumericEdit4: TRzDBEdit;
    RzDBNumericEdit2: TRzDBEdit;
    RzDBNumericEdit3: TRzDBEdit;
    CdsSelRetCheckInDtlBillNo: TStringField;
    CdsSelRetCheckInDtlItemNo: TIntegerField;
    CdsSelRetCheckInDtlGoodsID: TStringField;
    CdsSelRetCheckInDtlName: TStringField;
    CdsSelRetCheckInDtlSpecs: TStringField;
    CdsSelRetCheckInDtlUnit: TStringField;
    CdsSelRetCheckInDtlQty: TBCDField;
    CdsSelRetCheckInDtlOPrice: TFloatField;
    CdsSelRetCheckInDtlRebate: TBCDField;
    CdsSelRetCheckInDtlPrice: TFloatField;
    CdsSelRetCheckInDtlTaxRate: TBCDField;
    CdsSelRetCheckInDtlUnTaxPrice: TFloatField;
    CdsSelRetCheckInDtlGoodsSum: TBCDField;
    CdsSelRetCheckInDtlTaxSum: TBCDField;
    CdsSelRetCheckInDtlAmount: TBCDField;
    CdsSelRetCheckInDtlBatchNo: TStringField;
    CdsSelRetCheckInDtlProdDate: TDateTimeField;
    CdsSelRetCheckInDtlValidDate: TDateTimeField;
    CdsSelRetCheckInDtlEligibleQty: TBCDField;
    CdsSelRetCheckInBillNo: TStringField;
    CdsSelRetCheckInFDate: TDateTimeField;
    CdsSelRetCheckInContractNo: TStringField;
    CdsSelRetCheckInEmpNO: TStringField;
    CdsSelRetCheckInName: TStringField;
    CdsSelRetCheckInAudit: TStringField;
    CdsSelRetCheckInCustNo: TStringField;
    CdsSelRetCheckInCustName: TStringField;
    CdsSelRetCheckInLinkMan: TStringField;
    CdsSelRetCheckInGoodsQty: TBCDField;
    CdsSelRetCheckInGoodsSum: TBCDField;
    CdsSelRetCheckInTaxSum: TBCDField;
    CdsSelRetCheckInAmount: TBCDField;
    CdsSelRetCheckInRemark: TStringField;
    CdsSelRetCheckInFungible: TBooleanField;
    CdsSelRetCheckInTransfer: TBooleanField;
    CdsSelRetCheckInCreater: TStringField;
    CdsSelRetCheckInCreatTime: TDateTimeField;
    CdsSelRetCheckInMender: TStringField;
    CdsSelRetCheckInUpdateTime: TDateTimeField;
    CdsSelRetCheckInGrup: TIntegerField;
    CdsSelRetCheckInDtlPBillNo: TStringField;
    CdsSelRetCheckInDtlPItemNo: TIntegerField;
    CdsSelRetCheckInDtlCustGoodsID: TStringField;
    CdsSelRetCheckInDtlRemark: TStringField;
    RzDBLabel1: TRzDBLabel;
    RzLabel1: TRzLabel;
    RzDBLabel2: TRzDBLabel;
    RzLabel2: TRzLabel;
    RzDBButtonEdit2: TRzDBEdit;
    RzDBButtonEdit1: TRzDBButtonEdit;
    CdsSelRetCheckInAdsSelRetCheckInDtl: TDataSetField;
    CdsSelRetCheckInPBillNo: TStringField;
    procedure ActDeleteExecute(Sender: TObject);
    procedure ActSaveExecute(Sender: TObject);
    procedure ActAddSubItemExecute(Sender: TObject);
    procedure ActDelSubItemExecute(Sender: TObject);
    procedure ActAuditExecute(Sender: TObject);
    procedure ActRevertExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure CdsSelRetCheckInDtlBeforeInsert(DataSet: TDataSet);
    procedure CdsSelRetCheckInDtlNewRecord(DataSet: TDataSet);
    procedure CdsSelRetCheckInDtlAfterPost(DataSet: TDataSet);
    procedure RzDBButtonEdit4ButtonClick(Sender: TObject);
    procedure CdsSelRetCheckInReconcileError(DataSet: TCustomClientDataSet;
      E: EReconcileError; UpdateKind: TUpdateKind;
      var Action: TReconcileAction);
    procedure edCustNameButtonClick(Sender: TObject);
    procedure CdsSelRetCheckInNewRecord(DataSet: TDataSet);
    procedure ActRefershExecute(Sender: TObject);
    procedure CdsSelRetCheckInDtlQtyChange(Sender: TField);
    procedure FormShow(Sender: TObject);
    procedure CdsSelRetCheckInDtlGoodsIDChange(Sender: TField);
    procedure CdsSelRetCheckInEmpNoChange(Sender: TField);
    procedure CdsSelRetCheckInCustNoChange(Sender: TField);
    procedure dbgSelRetCheckInDtlEditButtonClick(Sender: TObject);
    procedure CdsSelRetCheckInAfterScroll(DataSet: TDataSet);
    procedure ActUpdateExecute(Sender: TObject);
    procedure ActFieldLayoutExecute(Sender: TObject);
    procedure ActDataExportExecute(Sender: TObject);
    procedure RzDBButtonEdit1ButtonClick(Sender: TObject);
    procedure CdsSelRetCheckInDtlPriceChange(Sender: TField);
    procedure CdsSelRetCheckInDtlUnTaxPriceChange(Sender: TField);
    procedure CdsSelRetCheckInDtlProdDateChange(Sender: TField);
    procedure CdsSelRetCheckInDtlAfterOpen(DataSet: TDataSet);
    procedure CdsSelRetCheckInDtlTaxRateChange(Sender: TField);
    procedure ActQueryExecute(Sender: TObject);
  private
    iClientID :integer;
    bBrowGoods, bDateChanging, CanAudit, CanRevert:Boolean;
    BeforeGoodsID,BeforeEmpNo,BeforeCustNo:String;
    LocSetting: PLocSetting;
    SvrSelRetCheckin,SvrCommon :TDispatchConnection;
    FlagGoodsID :String;
    procedure ParseGoodsInfo;
  public
    CdsFieldProPerty :TckClientDataSet;
  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 (''SelRetCheckIn'', ''SelRetCheckInDtl'', ''Goodses'')';

var
  FmSelRetCheckIn  :TFmSelRetCheckIn;
  iLastItemNO   :Integer;
  BeforeGoodsID :String;
  BeforeCustNo  :String;

implementation

uses SelectGoodsFrm,FieldsLayoutFrm,DataExportFrm, DateUtils;

{$R *.dfm}

procedure TFmSelRetCheckIn.FormCreate(Sender: TObject);
begin
  inherited;
  CdsFieldProperty:=TCkClientDataSet.Create(Self);
  LocSetting := IFmMain.IFmMainEx.GetLocSetting;
  SetGressHint('正在登录到来货登记服务器...');
  CanAudit := ActAudit.Enabled;
  CanRevert:= ActCancel.Enabled;
  SvrSelRetCheckin:=iFmMain.GetConnection(Handle,'','ckSalesBase.SalesBase');
  SetGressHint('正在连接到公用信息服务器...');
  SvrCommon:=iFmMain.GetConnection(Handle,'','CommonSvr.CommonRDM');
  SetGressHint('读取用户操作权限...');
  IFmMain.SetActionStatus(ActionList1, hInstance, self.ClassName);
  iClientID:=LogonInfo^.ClientID;

  sBillNoList.Text := SvrSelRetCheckin.AppServer.GetCurrMonthBills(iClientID, 'SelRetCheckIn');
  CdsSelRetCheckIn.RemoteServer:=SvrSelRetCheckin;
  BillType :='SelRetCheckIn';
  MasterDataSet := CdsSelRetCheckIn;

  SetLength(FDetailDataSets, 1);
  FDetailDataSets[0] := CdsSelRetCheckInDtl;
  RepDataSetNames := '来货登记;来货登记明细';

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

procedure TFmSelRetCheckIn.FormShow(Sender: TObject);
Begin
  SetGressHint('初始化本地环境...');
  LoadFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [dbgSelRetCheckInDtl]);
  SetGridEhColor(dbgSelRetCheckInDtl);
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFmSelRetCheckIn.Xml');
  SetFieldProperty(CdsFieldProPerty, CdsSelRetCheckIn, 'SelRetCheckIn');
  SetFieldProperty(CdsFieldProPerty, CdsSelRetCheckInDtl, 'SelRetCheckInDtl,Goodses');
  SetGressHint('读取历史单据...');
  SetCurrBillIdx(0);
  Inherited;
  FreeGressForm;
end;

procedure TFmSelRetCheckIn.ActDeleteExecute(Sender: TObject);
Var BillNo,RetStr : String;
begin
  Try
    If CdsSelRetCheckInTransfer.Value Then Begin
      Messagebox(Handle,Pchar('当前单据已[复核]，不能执行删除操作！'),'警告',64);
      Exit;
    End;
    BillNo := CdsSelRetCheckInBillNo.Value;
    If Not(SvrSelRetCheckin.AppServer.CanDoAction(iClientID,'GoodsCheckAccept',BillNo,'',RetStr)) Then Begin
      Messagebox(Handle,Pchar(RetStr+'不能进行删除操作...'),nil,16);
      Exit;
    End;
    inherited;
  Except
    On E:Exception Do
      Messagebox(Handle,Pchar(E.Message),'',16);
  End;
end;

procedure TFmSelRetCheckIn.ActSaveExecute(Sender: TObject);
begin
  Try
    If  FEditMode=0 Then Exit;
    IF CdsSelRetCheckInDtl.State In dsEditModes Then
      CdsSelRetCheckInDtl.Post;
    Inherited;
  Except
    On E:Exception Do
      Messagebox(Handle,Pchar(E.Message),nil,16);
  End;
end;

procedure TFmSelRetCheckIn.ActAddSubItemExecute(Sender: TObject);
begin
  If FEditMode=0 Then Exit;
  If Not(CdsSelRetCheckIn.State In dsEditModes) Then Exit;
  CdsSelRetCheckInDtl.Append;
end;

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

procedure TFmSelRetCheckIn.ActAuditExecute(Sender: TObject);
const
  cCheckTypes: Array[0..5] of string=('普通药品验收单', '进口药品验收单', '医疗器械验收单', '中药饮片验收单', '特殊药品验收单', '非药品验收单');
var sBillNo, str,MatchBillNo,sBranchMachine,sCheckType,sDisp: String;
  iBranchID,iMachineId, i, iCount,iPos : Integer;
  sSysInfo: Variant;
  sList,lCheckTypes,lview : TStrings;
begin
  If FEditMode>0 then Exit;
  if Application.MessageBox('确定要将此单据进行审核吗？', '消息', MB_YESNO+MB_ICONQUESTION)=IDNO then
    Exit;
  str := 'CurrMonth';
  sSysInfo := SvrCommon.AppServer.GetSysInfo(iClientID,Str,1);
  If Not(VarIsNull(sSysInfo)) Then Begin
    If CdsSelRetCheckInFDate.Value < VarToDateTime(sSysInfo) Then Begin
      Messagebox(Handle,Pchar('该月已结算，不能操作已月结的单据！'),nil,16);
      Exit;
    End;
  End Else Begin
    Messagebox(Handle,Pchar('请先设置开帐日期...'),nil,16);
    Exit;
  End;
  sBillNo := cdsSelRetCheckInBillNo.AsString;
  if sBillNo='' then Exit;
  iBranchID  := (Application.MainForm as iMainForm).IFmMainEx.GetLocSetting^.BranchNo;
  iMachineId := (Application.MainForm as iMainForm).IFmMainEx.GetLocSetting^.MachineNo;
  sBranchMachine := FormatFloat('000',iBranchID)+FormatFloat('00',iMachineID);
  If SvrSelRetCheckin.AppServer.BillTurn(iClientID, 'SelRetCheckIn', 'GoodsCheckAccept', sBillNo, sBranchMachine,MatchBillNo) then begin
    ActRefresh.Execute;
//    sBPL := 'PurchBase.bpl;TFmGoodsCheckAccept'
    sList := TStringList.Create;
    sList.Text := MatchBillNo;
    iCount := sList.Count;
    for i :=0 To iCount -1 do
    begin
      str := sList[i];
      iPos := StrToInt(str[1])-1;
      sDisp := sDisp+Copy(str, 3, Length(str)-2)+cChecktypes[iPos]+#13;
    end;
    str := sBillNo+'号来货登记单已成功生成：'#13+sDisp+'要查看这些单据吗？';
    If Application.MessageBox(PChar(str), '消息', MB_YESNO+MB_ICONINFORMATION)=IDYES then Begin
      for i := 0 To iCount-1 Do
        IFmMain.DoSome(Trim(ActBillTurn.ModuleFile)+IntToStr(i+1), 'ViewBill', Copy(sList[i], 3, Length(str)-2));
    End;
  end;
end;

procedure TFmSelRetCheckIn.ActRevertExecute(Sender: TObject);
Var BillNo,PBillNo : String;
begin
  Try
    If CdsSelRetCheckIn.IsEmpty Then Exit;
    If FEditMode>0 then Exit;
    inherited;
    If Application.MessageBox('确实要还原当前已审核过的数据吗？','提示',4+32)<>6 Then Exit;
    BillNo  := CdsSelRetCheckInBillNo.Value ;
    PBillNo := CdsSelRetCheckInOrderNo.Value ;
    If Not(SvrSelRetCheckin.AppServer.BillRevert(iClientID,'SelRetCheckIn',BillNo,PBillNo)) 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;
  Except
    On E:Exception Do
      Messagebox(Handle,Pchar(E.Message),nil,16);
  End;
End;

procedure TFmSelRetCheckIn.CdsSelRetCheckInDtlBeforeInsert(DataSet: TDataSet);
begin
  iLastItemNO:=GetFieldMaxInt(CdsSelRetCheckInDtl,'ItemNO');
end;

procedure TFmSelRetCheckIn.CdsSelRetCheckInDtlNewRecord(DataSet: TDataSet);
begin
  BeforeGoodsID:='';
  CdsSelRetCheckInDtlBillNo.Value   :=  CdsSelRetCheckInBillNo.Value;
  CdsSelRetCheckInDtlItemNo.Value   :=  iLastItemNO+1;
end;

procedure TFmSelRetCheckIn.CdsSelRetCheckInDtlAfterPost(DataSet: TDataSet);
Var
  dGoodsQty,dGoodsSum,dTaxSum,dAmount:Double;
  Mark1 : TBookMark;
begin
  BeforeGoodsID:='';
  dGoodsQty := 0;
  dGoodsSum := 0;
  dTaxSum   := 0;
  dAmount   := 0;
  with CdsSelRetCheckInDtl do
  begin
    Mark1 := GetBookmark;
    DisableControls;