pchcheckinfrm.~pas

群星医药系统源码

unit PchCheckinFrm;

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,
  SelectProvFrm,SelectProvLinkManFrm,RzLabel,RzDBLbl;

type
  TFmPchCheckin = class(TceBaseBillForm)
    Label1: TLabel;
    DcomCnn: TDCOMConnection;
    CdsPchCheckin: TckClientDataSet;
    CdsPchCheckinDtl: TckClientDataSet;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label8: TLabel;
    Lab_State: TLabel;
    RzDBEdit1: TRzDBEdit;
    RzDBDateTimePicker1: TRzDBDateTimePicker;
    RzDBEdit2: TRzDBEdit;
    DsPchCheckin: TDataSource;
    DsPchCheckinDtl: TDataSource;
    RzDBButtonEdit4: TRzDBButtonEdit;
    Label10: TLabel;
    RzDBEdit6: TRzDBEdit;
    RzDBNumericEdit1: TRzDBEdit;
    Label9: TLabel;
    RzDBEdit3: TRzDBEdit;
    RzDBCheckBox2: TRzDBCheckBox;
    RzDBEdit7: TRzDBEdit;
    dbgPchCheckInDtl: TxDBGridEh;
    Label7: TLabel;
    edProvName: TRzDBButtonEdit;
    RzDBEdit4: TRzDBEdit;
    RzLabel15: TRzLabel;
    RzLabel13: TRzLabel;
    RzLabel14: TRzLabel;
    RzDBNumericEdit4: TRzDBEdit;
    RzDBNumericEdit2: TRzDBEdit;
    RzDBNumericEdit3: TRzDBEdit;
    CdsPchCheckinDtlBillNo: TStringField;
    CdsPchCheckinDtlItemNo: TIntegerField;
    CdsPchCheckinDtlGoodsID: TStringField;
    CdsPchCheckinDtlName: TStringField;
    CdsPchCheckinDtlSpecs: TStringField;
    CdsPchCheckinDtlUnit: TStringField;
    CdsPchCheckinDtlQty: TBCDField;
    CdsPchCheckinDtlOPrice: TFloatField;
    CdsPchCheckinDtlRebate: TBCDField;
    CdsPchCheckinDtlPrice: TFloatField;
    CdsPchCheckinDtlTaxRate: TBCDField;
    CdsPchCheckinDtlUnTaxPrice: TFloatField;
    CdsPchCheckinDtlGoodsSum: TBCDField;
    CdsPchCheckinDtlTaxSum: TBCDField;
    CdsPchCheckinDtlAmount: TBCDField;
    CdsPchCheckinDtlBatchNo: TStringField;
    CdsPchCheckinDtlProdDate: TDateTimeField;
    CdsPchCheckinDtlValidDate: TDateTimeField;
    CdsPchCheckinDtlEligibleQty: TBCDField;
    CdsPchCheckinBillNo: TStringField;
    CdsPchCheckinFDate: TDateTimeField;
    CdsPchCheckinOrderNo: TStringField;
    CdsPchCheckinContractNo: TStringField;
    CdsPchCheckinEmpNO: TStringField;
    CdsPchCheckinName: TStringField;
    CdsPchCheckinAudit: TStringField;
    CdsPchCheckinProvNo: TStringField;
    CdsPchCheckinProvName: TStringField;
    CdsPchCheckinLinkMan: TStringField;
    CdsPchCheckinGoodsQty: TBCDField;
    CdsPchCheckinGoodsSum: TBCDField;
    CdsPchCheckinTaxSum: TBCDField;
    CdsPchCheckinAmount: TBCDField;
    CdsPchCheckinRemark: TStringField;
    CdsPchCheckinFungible: TBooleanField;
    CdsPchCheckinTransfer: TBooleanField;
    CdsPchCheckinCreater: TStringField;
    CdsPchCheckinCreatTime: TDateTimeField;
    CdsPchCheckinMender: TStringField;
    CdsPchCheckinUpdateTime: TDateTimeField;
    CdsPchCheckinGrup: TIntegerField;
    CdsPchCheckinDtlPBillNo: TStringField;
    CdsPchCheckinDtlPItemNo: TIntegerField;
    CdsPchCheckinDtlProvGoodsID: TStringField;
    CdsPchCheckinDtlRemark: TStringField;
    RzDBLabel1: TRzDBLabel;
    RzLabel1: TRzLabel;
    RzDBLabel2: TRzDBLabel;
    RzLabel2: TRzLabel;
    RzDBButtonEdit2: TRzDBEdit;
    RzDBButtonEdit1: TRzDBButtonEdit;
    CdsPchCheckinAdsPchCheckinDtl: TDataSetField;
    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 CdsPchCheckinDtlBeforeInsert(DataSet: TDataSet);
    procedure CdsPchCheckinDtlNewRecord(DataSet: TDataSet);
    procedure CdsPchCheckinDtlAfterPost(DataSet: TDataSet);
    procedure RzDBButtonEdit4ButtonClick(Sender: TObject);
    procedure CdsPchCheckinReconcileError(DataSet: TCustomClientDataSet;
      E: EReconcileError; UpdateKind: TUpdateKind;
      var Action: TReconcileAction);
    procedure edProvNameButtonClick(Sender: TObject);
    procedure CdsPchCheckinNewRecord(DataSet: TDataSet);
    procedure ActRefershExecute(Sender: TObject);
    procedure CdsPchCheckinDtlQtyChange(Sender: TField);
    procedure FormShow(Sender: TObject);
    procedure CdsPchCheckinDtlGoodsIDChange(Sender: TField);
    procedure CdsPchCheckinEmpNoChange(Sender: TField);
    procedure CdsPchCheckinProvNoChange(Sender: TField);
    procedure dbgPchCheckInDtlEditButtonClick(Sender: TObject);
    procedure CdsPchCheckinAfterScroll(DataSet: TDataSet);
    procedure ActUpdateExecute(Sender: TObject);
    procedure ActFieldLayoutExecute(Sender: TObject);
    procedure ActDataExportExecute(Sender: TObject);
    procedure RzDBButtonEdit1ButtonClick(Sender: TObject);
    procedure CdsPchCheckinDtlPriceChange(Sender: TField);
    procedure CdsPchCheckinDtlUnTaxPriceChange(Sender: TField);
    procedure CdsPchCheckinDtlProdDateChange(Sender: TField);
    procedure CdsPchCheckinDtlAfterOpen(DataSet: TDataSet);
    procedure CdsPchCheckinDtlTaxRateChange(Sender: TField);
    procedure ActQueryExecute(Sender: TObject);
  private
    iClientID :integer;
    bBrowGoods, bDateChanging, CanAudit, CanRevert:Boolean;
    BeforeGoodsID,BeforeEmpNo,BeforeProvNo:String;
    LocSetting: PLocSetting;
    SvrCdsPchCheckin,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 (''PchCheckIn'', ''PchCheckinDtl'', ''Goodses'')';

var
  FmPchCheckin  :TFmPchCheckin;
  iLastItemNO   :Integer;
  BeforeGoodsID :String;
  BeforeProvNo  :String;

implementation

uses SelectGoodsFrm,FieldsLayoutFrm,DataExportFrm, DateUtils;

{$R *.dfm}

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

  sBillNoList.Text := SvrCdsPchCheckin.AppServer.GetCurrMonthBills(iClientID, 'PchCheckIn');
  CdsPchCheckin.RemoteServer:=SvrCdsPchCheckin;
  BillType :='PchCheckIn';
  MasterDataSet := CdsPchCheckin;

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

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

procedure TFmPchCheckin.FormShow(Sender: TObject);
Begin
  SetGressHint('初始化本地环境...');
  LoadFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [dbgPchCheckInDtl]);
  SetGridEhColor(dbgPchCheckInDtl);
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFmPchCheckin.Xml');
  SetFieldProperty(CdsFieldProPerty, CdsPchCheckin, 'PchCheckin');
  SetFieldProperty(CdsFieldProPerty, CdsPchCheckinDtl, 'PchCheckinDtl,Goodses');
  SetGressHint('读取历史单据...');
  SetCurrBillIdx(0);
  Inherited;
  FreeGressForm;
end;

procedure TFmPchCheckin.ActDeleteExecute(Sender: TObject);
Var BillNo,RetStr : String;
begin
  Try
    If CdsPchCheckInTransfer.Value Then Begin
      Messagebox(Handle,Pchar('当前单据已[复核]，不能执行删除操作！'),'警告',64);
      Exit;
    End;
    BillNo := CdsPchCheckInBillNo.Value;
    If Not(SvrCdsPchCheckIn.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 TFmPchCheckin.ActSaveExecute(Sender: TObject);
begin
  Try
    If  FEditMode=0 Then Exit;
    IF CdsPchCheckInDtl.State In dsEditModes Then
      CdsPchCheckInDtl.Post;
    Inherited;
  Except
    On E:Exception Do
      Messagebox(Handle,Pchar(E.Message),nil,16);
  End;
end;

procedure TFmPchCheckin.ActAddSubItemExecute(Sender: TObject);
begin
  If FEditMode=0 Then Exit;
  If Not(CdsPchCheckin.State In dsEditModes) Then Exit;
  CdsPchCheckinDtl.Append;
end;

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

procedure TFmPchCheckin.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 CdsPchCheckinFDate.Value < VarToDateTime(sSysInfo) Then Begin
      Messagebox(Handle,Pchar('该月已结算，不能操作已月结的单据！'),nil,16);
      Exit;
    End;
  End Else Begin
    Messagebox(Handle,Pchar('请先设置开帐日期...'),nil,16);
    Exit;
  End;
  sBillNo := cdsPchCheckInBillNo.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 SvrCdsPchCheckIn.AppServer.BillTurn(iClientID, 'PchCheckIn', '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 TFmPchCheckin.ActRevertExecute(Sender: TObject);
Var BillNo,PBillNo : String;
begin
  Try
    If CdsPchCheckin.IsEmpty Then Exit;
    If FEditMode>0 then Exit;
    inherited;
    If Application.MessageBox('确实要还原当前已审核过的数据吗？','提示',4+32)<>6 Then Exit;
    BillNo  := CdsPchCheckInBillNo.Value ;
    PBillNo := CdsPchCheckInOrderNo.Value ;
    If Not(SvrCdsPchCheckIn.AppServer.BillRevert(iClientID,'PchCheckIn',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 TFmPchCheckin.CdsPchCheckinDtlBeforeInsert(DataSet: TDataSet);
begin
  iLastItemNO:=GetFieldMaxInt(CdsPchCheckinDtl,'ItemNO');
end;

procedure TFmPchCheckin.CdsPchCheckinDtlNewRecord(DataSet: TDataSet);
begin
  BeforeGoodsID:='';
  CdsPchCheckinDtlBillNo.Value   :=  CdsPchCheckinBillNo.Value;
  CdsPchCheckinDtlItemNo.Value   :=  iLastItemNO+1;
end;

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