goodscheckaccept.pas

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

  sProvNo := CdsGoodsCheckAcceptProvNo.Value;
  Flag:=GetGoodsInfo(CdsGoodsCheckAcceptDtl,'',sGoodsID,sSetFields,LogText,sProvNo,'Pch');

//  Flag:=GetGoodsInfo(CdsGoodsCheckAcceptDtl,sGoodsID,sSetFields,LogText);
  If Flag<>'' Then Begin
    Messagebox(Handle,'无效药品编号','错误:',16);
    Abort;
  End Else Begin
    FlagGoodsID:=LogText;
    If Copy(Trim(sGoodsID),1,1)='-' Then
      CdsGoodsCheckAcceptDtl.FieldByName('GoodsID').AsString:=FlagGoodsID
   Else
     FlagGoodsID:='';
  END;
end;

procedure TFmGoodsCheckAccept.dbgGoodsCheckAcceptDtlEditButtonClick(Sender: TObject);
var sField, sEmpNo, sEmpName: String;
begin
  inherited;
  if FEditMode=0 then Exit;
  CdsGoodsCheckAcceptDtl.Edit;
  sEmpNo := '';
  sEmpName := '';
  sField := LowerCase(dbgGoodsCheckAcceptDtl.SelectedField.FieldName);
  if sField='goodsid' then begin
    bBrowGoods := true;
    SelectGoods(CdsGoodsCheckAcceptDtl, CdsGoodsCheckAcceptDtlGoodsID, CdsGoodsCheckAcceptDtlUnit, true, False, False);
    bBrowGoods := false;
  end else
  If (sField='checker') Then Begin
    if SelectEmp(sEmpNo, sEmpName) then
      cdsGoodsCheckAcceptDtl.FieldByName('checker').Value := sEmpNo;
  End Else
  If sField = 'accepter' then Begin
    if SelectEmp(sEmpNo, sEmpName) then
      cdsGoodsCheckAcceptDtl.FieldByName('accepter').Value := sEmpNo;
  end;
end;

procedure TFmGoodsCheckAccept.ActUpdateExecute(Sender: TObject);
begin
  If CdsGoodsCheckAcceptTransfer.Value  Then Begin
    Messagebox(Handle,Pchar('当前单据已[审核]，不能进行修改操作!'),nil,16);
    Exit;
  End;
  inherited; 
end;

procedure TFmGoodsCheckAccept.CdsGoodsCheckAcceptDtlAfterDelete(
  DataSet: TDataSet);
begin
  BeforeGoodsID:='';
end;

procedure TFmGoodsCheckAccept.CdsGoodsCheckAcceptAfterScroll(
  DataSet: TDataSet);
begin
  If CdsGoodsCheckAcceptTransfer.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 TFmGoodsCheckAccept.ActAuditExecute(Sender: TObject);
Var
  BillNo,PBillNo,Str:String;
  sSysInfo : variant;
begin
  Try
    If CdsGoodsCheckAccept.IsEmpty Then Exit;
    If FEditMode>0 then Exit;
    If Application.MessageBox('确实要审核当前数据吗？','提示',4+32)<>6 Then Exit;
    str := 'CurrMonth';
    sSysInfo := SvrCommon.AppServer.GetSysInfo(iClientID,Str,1);
    If Not(VarIsNull(sSysInfo)) Then Begin
      If CdsGoodsCheckAcceptFDate.Value<VarToDateTime(sSysInfo) Then Begin
        Messagebox(Handle,Pchar('该月已结算，不能操作已月结的单据！'),nil,16);
        Exit;
      End;
    End Else Begin
      Messagebox(Handle,Pchar('请先设置开帐日期...'),nil,16);
      Exit;
    End;
    BillNo  := CdsGoodsCheckAcceptBillNo.Value;
    PBillNo := CdsGoodsCheckAcceptPBillNo.Value;
    If BillNo='' then Exit;
    If Not(SvrGoodsCheckAccept.AppServer.BillAudit(iClientID, 'GoodsCheckAccept',BillNo, PBillNo)) then
      Messagebox(Handle,Pchar('审核数据不成功！'),nil,16)
    Else Begin
      ActAudit.Enabled:=False and CanAudit;
      ActRevert.Enabled:=True and CanRevert;
      Lab_State.Caption:='单据状态：已审核';
      Lab_State.Font.Color:=clRed;
      ActRefreshExecute(NIL);
    End;
  Except
    On E:Exception Do
      Messagebox(Handle,Pchar(E.Message),nil,16);
  End;
end;

procedure TFmGoodsCheckAccept.ActRevertExecute(Sender: TObject);
begin
  Try
    If CdsGoodsCheckAccept.IsEmpty Then Exit;
    If FEditMode>0 then Exit;
    If Application.MessageBox('确实要还原当前已审核过的数据吗？','提示',4+32)<>6 Then Exit;
    CdsGoodsCheckAccept.Edit;
    CdsGoodsCheckAcceptTransfer.Value:=False;
    CdsGoodsCheckAcceptAudit.Value := '';
    try
      CdsGoodsCheckAccept.Post;
    Except
      CdsGoodsCheckAccept.Cancel;
      Raise;
    end;
    If CdsGoodsCheckAccept.ApplyUpdates(0)>0 Then
      Messagebox(Handle,Pchar('还原数据不成功！'),nil,16)
    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 TFmGoodsCheckAccept.ActFieldLayoutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name,
                  [dbgGoodsCheckAcceptDtl],'采购药品质量验收明细');
end;

procedure TFmGoodsCheckAccept.ActDataExportExecute(Sender: TObject);
begin
	ExportData([CdsGoodsCheckAccept, CdsGoodsCheckAcceptDtl],'药品质量验收;药品质量验收明细', '');
end;

function TFmGoodsCheckAccept.DoSome(cType: PChar;
  Values: Variant): Variant;
const
  cTypes = 'viewbill'#13'query';
  //       查看某单     查询
var sTypes, sBillList: TStrings;
    b1: Boolean;
    i, k: integer;
    str, str2: String;
begin
  sBillList := TStringList.Create;
  sTypes := TStringList.Create;
  sTypes.Text := cTypes;
  i := sTypes.IndexOf(cType);
  case i of
    0: begin//ViewBill
      b1 := VarIsArray(Values);
      if b1 then begin
        str := Values[0];
        str2:= Values[1];
      end else begin
        str := Values;
        str2:= '';
      end;
      sBillList.Text := Str;
      if not b1 then begin
        if sBillNoList.IndexOf(sBillList[0])<0 then
          sBillNoList.AddStrings(sBillList);
      end else
        sBillNoList.Text := str2;
      SetCurrBillNo(sBillList[0]);
    end;
  end;
end;

procedure TFmGoodsCheckAccept.CdsGoodsCheckAcceptNewRecord(
  DataSet: TDataSet);
begin
  inherited;
  CdsGoodsCheckAcceptBillNo.Value := BuildBillNo('GoodsCheckAccept');
  CdsGoodsCheckAcceptFDate.Value := Date;
  CdsGoodsCheckAcceptCheckKind.Value := 0;                          
end;

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

procedure TFmGoodsCheckAccept.CdsGoodsCheckAcceptDtlCheckQtyChange(
  Sender: TField);
var
  iCheckQty, iEligibleQty, iRejectQty: integer;
begin
  iCheckQty := CdsGoodsCheckAcceptDtl.FieldByName('CheckQty').AsInteger;
  iEligibleQty := CdsGoodsCheckAcceptDtl.FieldByName('EligibleQty').AsInteger;
  iRejectQty := CdsGoodsCheckAcceptDtl.FieldByName('RejectQty').AsInteger;

  if iCheckQty < 1 then
  begin
    Application.MessageBox('[验收数量]不能小于1！','提示',MB_OK+MB_ICONINFORMATION);
    SetDatasetState;
    CdsGoodsCheckAcceptDtl.FieldByName('CheckQty').Value := 1;
    exit;
  end;

  if iEligibleQty > 0 then
  begin
    if iEligibleQty > iCheckQty then
      Application.MessageBox('[验收数量]不能小于[合格品数量]！','提示',MB_OK+MB_ICONINFORMATION)
    else
    begin
      SetDatasetState;
      CdsGoodsCheckAcceptDtl.FieldByName('RejectQty').AsInteger := iCheckQty - iEligibleQty;
    end;
    exit;
  end;

  if iRejectQty > 0 then
  begin
    if iRejectQty > iCheckQty then
      Application.MessageBox('[验收数量]不能小于[不合格数量]！','提示',MB_OK+MB_ICONINFORMATION)
    else
    begin
      SetDatasetState;
      CdsGoodsCheckAcceptDtl.FieldByName('EligibleQty').AsInteger := iCheckQty - iRejectQty;
    end;
    exit;
  end;
end;

procedure TFmGoodsCheckAccept.CdsGoodsCheckAcceptDtlEligibleQtyChange(
  Sender: TField);
var
  iCheckQty, iEligibleQty, iRejectQty: integer;
begin
  iCheckQty := CdsGoodsCheckAcceptDtl.FieldByName('CheckQty').AsInteger;
  iEligibleQty := CdsGoodsCheckAcceptDtl.FieldByName('EligibleQty').AsInteger;
  iRejectQty := CdsGoodsCheckAcceptDtl.FieldByName('RejectQty').AsInteger;

  if iEligibleQty < 0 then
  begin
    Application.MessageBox('[合格品数量]不能小于0！','提示',MB_OK+MB_ICONINFORMATION);
    CdsGoodsCheckAcceptDtl.FieldByName('EligibleQty').AsInteger := 0;
    exit;
  end;

  if (iCheckQty > 0) and (iEligibleQty > 0) then
  begin
    if iEligibleQty > iCheckQty then
    begin
      Application.MessageBox('[验收数量]不能小于[合格品数量]！','提示',MB_OK+MB_ICONINFORMATION);
      CdsGoodsCheckAcceptDtl.FieldByName('EligibleQty').AsInteger := 0;
    end
    else
    begin
      SetDatasetState;
      CdsGoodsCheckAcceptDtl.FieldByName('RejectQty').AsInteger := iCheckQty - iEligibleQty;
    end;
  end;
end;

procedure TFmGoodscheckAccept.setDatasetState;
begin
  if not (CdsGoodsCheckAcceptDtl.State = dsInsert) then
    CdsGoodsCheckAcceptDtl.Append
  else if not (CdsGoodsCheckAcceptDtl.State = dsEdit) then
    CdsGoodsCheckAcceptDtl.Edit;
end;

procedure TFmGoodsCheckAccept.CdsGoodsCheckAcceptDtlRejectQtyChange(
  Sender: TField);
var
  iCheckQty, iEligibleQty, iRejectQty: integer;
begin
  iCheckQty := CdsGoodsCheckAcceptDtl.FieldByName('CheckQty').AsInteger;
  iEligibleQty := CdsGoodsCheckAcceptDtl.FieldByName('EligibleQty').AsInteger;
  iRejectQty := CdsGoodsCheckAcceptDtl.FieldByName('RejectQty').AsInteger;

  if iRejectQty < 0 then
  begin
    Application.MessageBox('[不合格数量]不能小于零！','提示',MB_OK+MB_ICONINFORMATION);
    CdsGoodsCheckAcceptDtl.FieldByName('RejectQty').AsInteger := 0;
    exit;
  end;

  if iEligibleQty <= 0 then exit;

  if iRejectQty <> (iCheckQty - iEligibleQty) then
  begin
    Application.MessageBox('输入的[不合格数量]不符合计算结果！','提示',MB_OK+MB_ICONINFORMATION);
    SetDatasetState;
    CdsGoodsCheckAcceptDtl.FieldByName('RejectQty').AsInteger := iCheckQty - iEligibleQty;
  end;
end;

initialization
  RegisterClass(TFmGoodsCheckAccept);

finalization
  UnRegisterClass(TFmGoodsCheckAccept);

end.