stockconfectfrm.pas

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

  cdsStockConfectAmount.Value := dAmount;
end;

procedure TFmStockConfect.cdsStockConfectDtlGoodsIDChange(Sender: TField);
{Var
  LogText,Flag,sGoodsID,sSetFields:String;
Begin
  if FEditMode=0 then Exit;
  sGoodsID:=cdsStockConfectDtlGoodsID.AsString;
  if sGoodsID='' then Exit;
  sSetFields:= 'Name,Specs,Unit,Maker,PdcAddr';
  Flag:=GetGoodsInfo(cdsStockConfectDtl,'Price',sGoodsID,sSetFields,'','S',1);
  if Flag='' then
  begin
    Messagebox(Handle,'无效药品编号','错误',16);
    Abort;
  end;}
begin
  ParseGoodsInfo;
end;

procedure TFmStockConfect.cdsStockConfectGoodsIDChange(Sender: TField);
Var
  LogText,Flag,sGoodsID,sSetFields:String;
Begin
  if FEditMode=0 then Exit;
  sGoodsID:=cdsStockConfectGoodsID.AsString;
  if sGoodsID='' then Exit;
  sSetFields:= 'Name,Unit';
  Flag:=GetGoodsInfo(cdsStockConfect,'Price',sGoodsID,sSetFields,'','S',1);
  if Flag='' then
  begin
    Messagebox(Handle,'无效药品编号','错误',16);
    Abort;
  end;
end;

procedure TFmStockConfect.dbgStockConfectDtlEditButtonClick(
  Sender: TObject);
var
  Field: TField;
  s1,s2: string;
  iDepotID: integer;
begin
  if (cdsStockConfect.State in dsEditModes)and(not (cdsStockConfectDtl.State in dsEditModes)) then
    cdsStockConfectDtl.Edit;
  if not (cdsStockConfectDtl.State in dsEditModes) then exit;
  Field := dbgStockConfectDtl.SelectedField;
  if Field = nil then exit;
  if LowerCase(Field.FieldName)='goodsid' then
  begin
    ParseGoodsInfo;
  end
  else if LowerCase(Field.FieldName)='berthno' then
  begin
    s1 := Field.AsString;
    iDepotID := cdsStockConfectDepotID.Value;
    if SelectBerth(iDepotID,s1) then
      Field.AsString := s1;
  end;
end;

procedure TFmStockConfect.edDepotNoButtonClick(Sender: TObject);
var
  iDepotID: integer;
  sDepotNo,sDepotName: string;
begin
  if FEditMode = 0 then exit;
  iDepotID := cdsStockConfectDepotID.Value;
  if SelectDepot(iDepotID,sDepotNo,sDepotName) then
  begin
    edDepotNo.Field.AsString := sDepotNo;
    edDepotName.Field.AsString := sDepotName;
    edDepotNo.Tag := iDepotID;
    cdsStockConfectDepotID.Value := iDepotID;
  end;
end;

procedure TFmStockConfect.edDepotNoKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key=13)and(ssCtrl in Shift) then
    edDepotNoButtonClick(nil);
end;

procedure TFmStockConfect.edGoodsIDButtonClick(Sender: TObject);
var
  sGoodsID: string;
begin
  if FEditMode=0 then exit;
  sGoodsID := edGoodsID.Text;
  if SelectGoodsID(sGoodsID,false) then
    edGoodsID.Text := sGoodsID;
end;

procedure TFmStockConfect.edGoodsIDKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (key=13)and(ssCtrl in Shift) then
    edGoodsIDButtonClick(nil);
end;

procedure TFmStockConfect.edBerthNoButtonClick(Sender: TObject);
var
  iDepotID: integer;
  sBerthNo: string;
begin
  if FEditMode=0 then exit;
  iDepotID := cdsStockConfectDepotID.Value;
  if iDepotID = 0 then exit;
  if SelectBerth(iDepotID,sBerthNo) then
    edBerthNo.Text := sBerthNo;
end;

procedure TFmStockConfect.edBerthNoKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (key=13)and(ssCtrl in Shift) then
    edBerthNoButtonClick(nil);
end;

procedure TFmStockConfect.edProvNoButtonClick(Sender: TObject);
var
  sProvName,sProvNo: string;
begin
  if FEditMode=0 then exit;
  sProvNo := edProvNo.Text;
  if SelectProv(sProvNo,sProvName) then
  begin
    edProvNo.Text := sProvNo;
    edProvName.Text := sProvName;
  end;
end;

procedure TFmStockConfect.edProvNoKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (key=13)and(ssCtrl in Shift) then
    edProvNoButtonClick(nil);
end;

procedure TFmStockConfect.edEmpNoButtonClick(Sender: TObject);
var
  sEmpNo,sEmpName: string;
begin
  if FEditMode=0 then exit;
  sEmpNo := edEmpNo.Text;
  if SelectEmp(sEmpNo,sEmpName) then
  begin
    edEmpNo.Field.AsString := sEmpNo;
    edEmpName.Field.AsString := sEmpName;
  end;
end;

procedure TFmStockConfect.edEmpNoKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (key=13)and(ssCtrl in Shift) then
    edEmpNoButtonClick(nil); 
end;

procedure TFmStockConfect.ActAuditExecute(Sender: TObject);
var
  Str:string;
  sSysInfo : Variant;
begin
  if (FEditMode <> 0)or cdsStockConfect.IsEmpty then Exit;
  inherited;
  if cdsStockConfectTransfer.Value then
  begin
    MessageBox(Handle,'该单据已审核！','警告',MB_ICONEXCLAMATION);
    exit;
  end;
  if MessageBox(Handle,'单据审核后将不允许修改，确实要审核当前单据吗？','提示',MB_YESNO or MB_ICONEXCLAMATION)=IDNO then Exit;
  str := 'CurrMonth';
  sSysInfo := SvrCommon.AppServer.GetSysInfo(iClientID,Str,1);
  if not(VarIsNull(sSysInfo)) then begin
    If cdsStockConfectFDate.Value<VarToDateTime(sSysInfo) then
    begin
      Messagebox(Handle,'不能操作已月结的单据！',nil,16);
      Exit;
    end;
  end
  else
  begin
    Messagebox(Handle, '请先设置开帐日期！' ,nil,16);
    Exit;
  end;
  if not SvrStockConfect.AppServer.BillAudit(iClientID, 'StockConfect', cdsStockConfectBillNo.Value) then
    Messagebox(Handle,Pchar('审核单据失败！'),nil,16)
  else
  begin
    ActRefreshExecute(nil);
    ActAudit.Enabled := not cdsStockConfectTransfer.Value ;
    ActRevert.Enabled := cdsStockConfectTransfer.Value;
    lbStatus.Font.Color := clBlue;
  end;
end;

procedure TFmStockConfect.ActRevertExecute(Sender: TObject);
var
  Str:string;
  sSysInfo : Variant;
begin
  if (FEditMode <> 0)or cdsStockConfect.IsEmpty then Exit;
  inherited;
  if not cdsStockConfectTransfer.Value then
  begin
    MessageBox(Handle,'该单据未审核！','警告',MB_ICONEXCLAMATION);
    exit; 
  end;
  str := 'CurrMonth';
  sSysInfo := SvrCommon.AppServer.GetSysInfo(iClientID,Str,1);
  if not(VarIsNull(sSysInfo)) then begin
    If cdsStockConfectFDate.Value<VarToDateTime(sSysInfo) then begin
      Messagebox(Handle,'不能操作已月结的单据！',nil,16);
      Exit;
    end;
  end
  else
  begin
    Messagebox(Handle, '请先设置开帐日期！' ,nil,16);
    Exit;
  end;
  if not SvrStockConfect.AppServer.BillRevert(iClientID,'StockConfect', cdsStockConfectBillNo.Value) then
    Messagebox(Handle,Pchar('还原单据失败！'),nil,16)
  else
  begin
    ActRefreshExecute(nil);
    ActAudit.Enabled := not cdsStockConfectTransfer.Value ;
    ActRevert.Enabled := cdsStockConfectTransfer.Value;
    lbStatus.Font.Color := clRed;
  end;
end;

procedure TFmStockConfect.ActFieldLayoutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name,
                  [dbgStockConfectDtl],'药品组合加工明细');
end;

procedure TFmStockConfect.ActDataExportExecute(Sender: TObject);
begin
	ExportData([cdsStockConfect, cdsStockConfectDtl],'药品组合加工;药品组合加工', '');
end;

procedure TFmStockConfect.ActUpdateExecute(Sender: TObject);
begin
  inherited;
  cdsStockConfectDtl.Edit;
end;

procedure TFmStockConfect.edBatchNoButtonClick(Sender: TObject);
var s: string;
begin
  if not (edBatchNo.Field.DataSet.State in dsEditModes) then exit;
  s := edBerthNo.Text;
  if s='' then s:='.';
  if ViewGoodsBatch(edDepotNo.Tag, edGoodsID.Text, edUnit.Text, s) then
    edBatchNo.Field.AsString := FmSelectBatchNo.cdsStock.FieldByName('BatchNo').AsString;
end;

procedure TFmStockConfect.edBatchNoKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (key=13)and(ssCtrl in Shift) then
    edBatchNoButtonClick(nil);
end;

procedure TFmStockConfect.ParseGoodsInfo;
var Field: TField;
    b1: boolean;
begin
  if FEditMode=0 then Exit;
  if bBrowGoods then Exit;
  bBrowGoods := true;
  Field := dbgStockConfectDtl.SelectedField;
  if Field = nil then exit;
  try
    b1 := SelectGoods(cdsStockConfectDtl,Field,cdsStockConfectDtlUnit,true,false,false);
    if not b1 then abort;
  finally
    bBrowGoods := false;
  end;
end;

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

initialization
  RegisterClass(TFmStockConfect);

finalization
  UnRegisterClass(TFmStockConfect);

end.