goodscheckaccept3.~pas

医药连锁经营管理系统源码

  sGoodsID:=CdsGoodsCheckAcceptDtlGoodsID.AsString;
  If sGoodsID='' Then Exit;
  if BeforeGoodsID=sGoodsID Then Exit;
  BeforeGoodsID:=sGoodsID;
  sSetFields:= 'Name,Specs,Unit';
  sProvNo := CdsGoodsCheckAcceptProvNo.Value;
  FlagGoodsID:=GetGoodsInfo(CdsGoodsCheckAcceptDtl,'',sGoodsID,sSetFields,sProvNo,'P',1);
  If FlagGoodsID='' Then Begin
    Messagebox(Handle,'无效药品编号','错误:',16);
    Abort;
  End Else Begin
    if sGoodsID<>FlagGoodsID then
      CdsGoodsCheckAcceptDtl.FieldByName('GoodsID').AsString:=FlagGoodsID
   Else
     FlagGoodsID:='';
  END;}
begin
  ParseGoodsInfo;
end;

procedure TFmGoodsCheckAccept3.dbgGoodsCheckAcceptDtlEditButtonClick(Sender: TObject);
var sField, sEmpNo, sEmpName: String;
  dPrice : Double;
begin
  inherited;
  if FEditMode=0 then Exit;
  CdsGoodsCheckAcceptDtl.Edit;
  sEmpNo := '';
  sEmpName := '';
  sField := LowerCase(dbgGoodsCheckAcceptDtl.SelectedField.FieldName);
  if sField='goodsid' then begin
    ParseGoodsInfo;
  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 Else
  If sField='price' Then Begin
    dPrice := ViewGoodsPrice(CdsGoodsCheckAcceptDtlGoodsID.Value, CdsGoodsCheckAcceptDtlUnit.Value);
    If dPrice>=0 Then Begin
      CdsGoodsCheckAcceptDtl.Edit;
      CdsGoodsCheckAcceptDtlPrice.Value := dPrice;
    End;
  End;
end;

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

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

procedure TFmGoodsCheckAccept3.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 TFmGoodsCheckAccept3.ActAuditExecute(Sender: TObject);
Const
  cPch : Array[0..1] of string=('入库通知单', '来货拒收单');
Var
  BillNo,PBillNo,sToBillNo,Str,MatchBillNo,sDisp:String;
  sSysInfo : variant;
  sList : TStrings;
  iBranchID,iMachineId,iCount,i,iPos : integer;
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;
    iBranchID  := iFmMain.IFmMainEx.GetLocSetting^.BranchNo;
    iMachineId := iFmMain.IFmMainEx.GetLocSetting^.MachineNo;
    MatchBillNo := FormatFloat('000',iBranchID)+FormatFloat('00',iMachineID);
    If Not SvrGoodsCheckAccept.AppServer.BillTurn(iClientID, 'GoodsCheckAccept', 'PchReceive', BillNo,PBillNo,MatchBillNo) 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);
      If MatchBillNo<>'' Then begin
        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)+cPch[iPos]+#13;
        end;
        str := BillNo+'号质量验收单成功验收完毕，已生成了:'#13+sDisp+'要查看这些单据吗？';
        If Application.MessageBox(PChar(str), '消息', MB_YESNO+MB_ICONINFORMATION)=IDYES then Begin
          for i := 0 To iCount-1 Do Begin
            str := sList[i];
            iPos := StrToInt(str[1])-1;
            If iPos = 0 Then
              IFmMain.DoSome('PurchInBase.bpl;TFmPchReceive', 'ViewBill', Copy(sList[i], 3, Length(str)-2));
            If iPos=1 Then
              IFmMain.DoSome('PurchInBase.bpl;TFmPchExclude', 'ViewBill', Copy(sList[i], 3, Length(str)-2));
          End;
        End;
      End;
    End;
  Except
    On E:Exception Do
      Messagebox(Handle,Pchar(E.Message),nil,16);
  End;
end;

procedure TFmGoodsCheckAccept3.ActRevertExecute(Sender: TObject);
Var
  sBillNo : String;
begin
  Try
    If CdsGoodsCheckAccept.IsEmpty Then Exit;
    If FEditMode>0 then Exit;
    sBillNo := CdsGoodsCheckAcceptBillNo.AsString;
    if sBillNo='' Then Exit;
    If Application.MessageBox('确实要还原当前已审核过的数据吗？','提示',4+32)<>6 Then Exit;
    If Not(SvrGoodsCheckAccept.AppServer.BillRevert(iClientID,'GoodsCheckAccept',sBillNo,'')) 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 TFmGoodsCheckAccept3.ActFieldLayoutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name,
                  [dbgGoodsCheckAcceptDtl],'医疗器械质量验收明细');
end;

procedure TFmGoodsCheckAccept3.ActDataExportExecute(Sender: TObject);
begin
	ExportData([CdsGoodsCheckAccept, CdsGoodsCheckAcceptDtl],'医疗器械质量验收;医疗器械质量验收明细', '');
end;

function TFmGoodsCheckAccept3.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;
      self.BringToFront;
      SetCurrBillNo(sBillList[0]);
    end;
  end;
end;

procedure TFmGoodsCheckAccept3.CdsGoodsCheckAcceptNewRecord(
  DataSet: TDataSet);
begin
  inherited;
  edProvName.Button.Click;
  CdsGoodsCheckAcceptBillNo.Value := BuildBillNo('GoodsCheckAccept');
  CdsGoodsCheckAcceptFDate.Value := Date;
  CdsGoodsCheckAcceptCheckKind.Value := 0;
  CdsGoodsCheckAcceptCheckType.Value := 3;
end;

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

procedure TFmGoodsCheckAccept3.CdsGoodsCheckAcceptDtlEligibleQtyChange(
  Sender: TField);
var
  iCheckQty, iEligibleQty, iRejectQty: integer;
begin
  if dbgGoodsCheckAcceptDtl.SelectedField.FieldName = Sender.FieldName then
  begin
    iCheckQty := CdsGoodsCheckAcceptDtl.FieldByName('CheckQty').AsInteger;
    iEligibleQty := CdsGoodsCheckAcceptDtl.FieldByName('EligibleQty').AsInteger;
    if (iCheckQty > 0) and (iEligibleQty > 0) then
    begin
      If iEligibleQty > iCheckQty then  Begin
        Application.MessageBox('[验收数量]不能小于[合格品数量]！','提示',MB_OK+MB_ICONINFORMATION);
        Abort;
      End;
      CdsGoodsCheckAcceptDtl.FieldByName('RejectQty').AsInteger := iCheckQty - iEligibleQty;
    end;
  end;
end;

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

procedure TFmGoodsCheckAccept3.ParseGoodsInfo;
begin
  if FEditMode=0 then Exit;
  if bBrowGoods then Exit;
  bBrowGoods := true;
  try
    SelectGoods(CdsGoodsCheckAcceptDtl, CdsGoodsCheckAcceptDtlGoodsID, CdsGoodsCheckAcceptDtlUnit, true, False, False);
  finally
    bBrowGoods := false;
  end;
end;

procedure TFmGoodsCheckAccept3.CdsGoodsCheckAcceptDtlRejectQtyChange(
  Sender: TField);
var
  iCheckQty, iEligibleQty, iRejectQty: integer;
begin
  if dbgGoodsCheckAcceptDtl.SelectedField.FieldName = Sender.FieldName then
  begin
    iCheckQty := CdsGoodsCheckAcceptDtl.FieldByName('CheckQty').AsInteger;
    iRejectQty := CdsGoodsCheckAcceptDtl.FieldByName('RejectQty').AsInteger;
    if (iCheckQty > 0) and (iRejectQty > 0) then
    begin
      If iRejectQty > iCheckQty then  Begin
        Application.MessageBox('[验收数量]不能小于[未合格品数量]！','提示',MB_OK+MB_ICONINFORMATION);
        Abort;
      End;
      CdsGoodsCheckAcceptDtl.FieldByName('EligibleQty').AsInteger := iCheckQty - iRejectQty;
    end;
  end;
end;

procedure TFmGoodsCheckAccept3.CdsGoodsCheckAcceptDtlCheckQtyChange(
  Sender: TField);
begin
  If (Not CdsGoodsCheckAcceptDtlCheckQty.IsNull) And (Not CdsGoodsCheckAcceptDtlPrice.IsNull) then
    CdsGoodsCheckAcceptDtlAmount.Value := CdsGoodsCheckAcceptDtlCheckQty.Value * CdsGoodsCheckAcceptDtlPrice.Value ;
end;

initialization
  RegisterClass(TFmGoodsCheckAccept3);

finalization
  UnRegisterClass(TFmGoodsCheckAccept3);

end.