wastagefrm.~pas

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

Var
  sEmpNo,sEmpName,LogText:String;
begin
  IF FEditMode=0 Then Exit;
  sEmpNo:=cdsWastageEmpNo.Value;
  If sEmpNo='' Then Exit;
  if sEmpNo=BeforeEmpNo Then Exit;
  BeforeEmpNo:=sEmpNO;
  sEmpName:=VarToStr(SvrCommon.AppServer.GetEmpInfo(iClientID,sEmpNo,1,'Name',LogText));
  If LogText<>'' Then Begin
    Messagebox(Handle,Pchar(LogText),nil,16);
    RzDBEdit5.SetFocus;
    Abort;
  End;
  if cdsWastage.State in dsEditModes then
    cdsWastageName.Value:=sEmpName;
end;

procedure TFmWastage.cdsWastageAfterScroll(DataSet: TDataSet);
begin
  If cdsWastageTransfer.Value Then Begin
    ActAudit.Enabled:=False and CanAudit;
    ActRevert.Enabled:=True and CanRevert;
    Lab_State.Caption:='单据状态：已审核';
    Lab_State.Font.Color:=clRed;
  End Else Begin
    ActAudit.Enabled:=True and CanAudit;
    ActRevert.Enabled:=False and CanRevert;
    Lab_State.Caption:='单据状态：未审核';
    Lab_State.Font.Color:=clHotLight;
  End;
end;

procedure TFmWastage.cdsWastageDtlBeforeInsert(DataSet: TDataSet);
begin
  iLastItemNO := GetFieldMaxInt(CdsWastageDtl, 'ItemNo')+1;
end;

procedure TFmWastage.cdsWastageDtlNewRecord(DataSet: TDataSet);
begin
  inherited;
  BeforeGoodsID:='';
  CdsWastageDtlItemNo.Value:=iLastItemNO;
  CdsWastageDtlBillNo.Value:=CdsWastageBillNo.Value;
  CdsWastageDtlValidDate.Value:=IncMonth(Date,12);
end;

procedure TFmWastage.cdsWastageReconcileError(
  DataSet: TCustomClientDataSet; E: EReconcileError;
  UpdateKind: TUpdateKind; var Action: TReconcileAction);
begin
  MessageBox(Handle,Pchar(E.Message),'',16);
  Action:=raAbort;
end;

procedure TFmWastage.cdsWastageNewRecord(DataSet: TDataSet);
var sBillNo : string;
begin
  cdsWastageFDate.Value := Date;
  sBillNo := BuildBillNo('Wastage');
  CdsWastageBillNo.Value :=sBillNo;
  cdsWastageCreater.Value := LogonInfo^.UserID;
  cdsWastageGrup.Value := LogonInfo^.UserGrupID;
end;

procedure TFmWastage.dbgWastageDtlEditButtonClick(Sender: TObject);
Var
  sField,sBerthNo,sProvNo:String;
  dPrice:Double;
  iDepotID : Integer;
Begin
  If FEditMode=0 Then Exit;
  sField :='';
  sField := Trim(LowerCase(dbgWastageDtl.SelectedField.FieldName));
  if sField='goodsid' then
  begin
    ParseGoodsInfo;
  end else if sField='provno' then
  begin
    sProvNo := cdsWastageDtlProvNo.Value;
    if SelectProv(sProvNo) then
    begin
      CdsWastageDtl.Edit;
      cdsWastageDtlProvNo.Value := sProvNo;
    end;
  end else
  begin
    if sField='price' then
    begin
      dPrice := ViewGoodsPrice(CdsWastageDtlGoodsID.Value, CdsWastageDtlUnit.Value);
      If dPrice>=0 Then Begin
        CdsWastageDtl.Edit;
        CdsWastageDtlprice.Value := dPrice;
      End;
    End Else
    Begin
      if sField='berthno' Then Begin
        if RzDBEdit3.Text='' Then Begin
          MessageBox(Handle,Pchar('请先指定报损仓库!'),nil,16);
          Exit;
        end;
        iDepotID := CdsWastageDepotID.Value;
        If SelectBerth(iDepotID,sBerthNo) Then
        begin
          CdsWastageDtl.Edit;
          CdsWastageDtlBerthNo.Value := sBerthNo;
        end;
      end
      else
      if sField='batchno' then
      begin
        if ViewGoodsBatch(cdsWastageDepotID.Value, cdsWastageDtlGoodsID.Value, cdsWastageDtlUnit.Value, '.') then
        begin
          CdsWastageDtl.Edit;
          cdsWastageDtlBatchNo.Value := FmSelectBatchNo.cdsStock.FieldByName('BatchNo').AsString;
        end;
      end;
    end;
  end;
end;

procedure TFmWastage.edDepotButtonClick(Sender: TObject);
var iDepotID: Integer;
    DepotNo,DepotName: string;
begin
  If FEditMode=0 Then Exit;
  iDepotID := CdsWastageDepotID.Value;
  If SelectDepot(iDepotID,DepotNo,DepotName) Then Begin
    CdsWastageDepotID.Value := iDepotID;
    CdsWastageDepotNo.Value := DepotNo;
    CdsWastageDepotName.Value := DepotName;
  End;
end;

procedure TFmWastage.edEmpIDButtonClick(Sender: TObject);
Var sEmpNo,sEmpName:String;
begin
  If FEditMode=0 Then Exit;
  sEmpNo := CdsWastageEmpNo.Value;
  If SelectEmp(sEmpNo,sEmpName) Then begin
    CdsWastageEmpNo.Value := sEmpNo;
    CdsWastageName.Value := sEmpName;
  End;
end;

procedure TFmWastage.cdsWastageDtlAfterPost(DataSet: TDataSet);
Var
  D,dAmount:Double;
  Abk:TBookMark;
begin
  BeforeGoodsID:='';
  With CdsWastageDtl Do Begin
    D:=0;
    dAmount:=0;
    Try
      Abk:=GetBookmark;
      DisableControls;
      First;
      while Not Eof Do Begin
        D:=D+cdsWastageDtlQty.Value;
        dAmount:=dAmount+CdswastageDtlAmount.Value;
        Next;
      End;
      cdsWastageGoodsQty.Value:=D;
      cdsWastageGoodsSum.Value:=dAmount;
    Finally
      GotoBookmark(Abk);
      FreeBookmark(Abk);
      EnableControls;
    End;
  End;
end;

procedure TFmWastage.cdsWastageDtlPriceChange(Sender: TField);
Var dQty,dPrice:Double;
begin
  dQty:=CdsWastageDtlQty.Value;
  dPrice:=CdsWastageDtlPrice.Value;
  CdsWastageDtlAmount.Value:=dQty*dPrice;
end;

procedure TFmWastage.cdsWastageEmpNoChange(Sender: TField);
Var
  sEmpNo,sEmpName,LogText:String;
begin
  IF FEditMode=0 Then Exit;
  sEmpNo:=cdsWastageEmpNo.Value;
  If sEmpNo='' Then Exit;
  if sEmpNo=BeforeEmpNo Then Exit;
  BeforeEmpNo:=sEmpNO;
  sEmpName:=VarToStr(SvrCommon.AppServer.GetEmpInfo(iClientID,sEmpNo,1,'Name',LogText));
  cdsWastageName.Value:=sEmpName;
  If LogText<>'' Then Begin
    Messagebox(Handle,Pchar(LogText),nil,16);
    RzDBEdit5.SetFocus;
    Abort;
  End;
end;

procedure TFmWastage.ActQueryExecute(Sender: TObject);
begin
  IFmMain.OnAction(Sender);
end;

procedure TFmWastage.cdsWastageDtlGoodsIDChange(Sender: TField);
Var
  LogText,Flag,sGoodsID,sSetFields:String;
Begin
  if not (cdsWastageDtl.State in dsEditModes) then exit;
  IF FlagGoodsID<>'' Then Begin
    FlagGoodsID:='';
    Exit;
  End;
  if bBrowGoods then Exit;
  sGoodsID:=cdsWastageDtlGoodsID.AsString;
  If sGoodsID='' Then Exit;
  if (BeforeGoodsID=sGoodsID) Then Exit;
  BeforeGoodsID:=sGoodsID;
  sSetFields:= 'Name,Specs,Unit';
  FlagGoodsID:=GetGoodsInfo(cdsWastageDtl,'Price',sGoodsID,sSetFields,'','S',1);
  If FlagGoodsID<>'' Then Begin
    Messagebox(Handle,'无效药品编号','错误:',16);
    Abort;
  End Else Begin
    If sGoodsID<>FlagGoodsID then
      cdsWastageDtl.FieldByName('GoodsID').AsString:=FlagGoodsID
    Else
      FlagGoodsID:='';
  End;
end;

procedure TFmWastage.ParseGoodsInfo;
var
  B1:boolean;
begin
  if FEditMode=0 then Exit;
  if bBrowGoods then Exit;
  bBrowGoods := true;
  try
    b1:=SelectGoods(CdsWastageDtl, CdsWastageDtlGoodsID, CdsWastageDtlUnit, true, False, False);
    if not b1 then abort;
  finally
    bBrowGoods := false;
  end;
end;

procedure TFmWastage.ActDataExportExecute(Sender: TObject);
begin
  if not(cdsWastage.Active and cdsWastageDtl.Active) then exit;
  if cdsWastage.IsEmpty then
  begin
    MessageBox(Handle,'没有可导出的数据！','警告',MB_ICONEXCLAMATION);
    exit;
  end;
	ExportData([cdsWastage,cdsWastageDtl],'药品报损;药品报损明细', '');
end;

procedure TFmWastage.ActFieldLayoutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name,
                  [dbgWastageDtl],'药品报损');
end;

initialization
  RegisterClass(TFmWastage);

finalization
  UnRegisterClass(TFmWastage);

end.