.#selgoodscheckaccept.removed.pas

群星医药系统源码

  inherited;
  Action := raAbort;
end;

procedure TFmSelGoodsCheckAccept.ActSaveExecute(Sender: TObject);
begin
  Try
    If  FEditMode=0 Then Exit;
    edProvName.SetFocus;
    Inherited;
  Except
    On E:Exception Do
      Messagebox(Handle,Pchar(E.Message),'错误',16);
  End;
end;

procedure TFmSelGoodsCheckAccept.CdsGoodsCheckAcceptProvNoChange(
  Sender: TField);
Var
  sProvNo,sProvName,LogText:String;
begin
  IF FEditMode=0 Then Exit;
  sProvNo:=CdsGoodsCheckAcceptProvNo.Value;
  if sProvNo=BeforeProvNo Then Exit;
  If sProvNo='' Then Begin
    CdsGoodsCheckAcceptProvName.Value:='';
    Exit;
  End;
  BeforeProvNo:=sProvNO;
  sProvName:=VarToStr(SvrCommon.AppServer.GetProvInfo(iClientID,sProvNo,1,'ProvName',LogText));
  CdsGoodsCheckAcceptProvName.Value:=sProvName;
  If LogText<>'' Then Begin
    Messagebox(Handle,Pchar(LogText),'错误：',16);
    Abort;
  End;
end;

procedure TFmSelGoodsCheckAccept.CdsGoodsCheckAcceptDtlGoodsIDChange(
  Sender: TField);
Var
  LogText,Flag,sGoodsID,sSetFields:String;
Begin
  IF FEditMode=0 Then Exit;
  IF FlagGoodsID<>'' Then Begin
    FlagGoodsID:='';
    Exit;
  End;
  sGoodsID:=CdsGoodsCheckAcceptDtlGoodsID.AsString;
  If sGoodsID='' Then Exit;
  if BeforeGoodsID=sGoodsID Then Exit;
  BeforeGoodsID:=sGoodsID;
  sSetFields:= 'Name,Specs,Unit';
  FlagGoodsID:=GetGoodsInfo(CdsGoodsCheckAcceptDtl,'OPrice',sGoodsID,sSetFields,'','S',1);
  If FlagGoodsID<>'' Then Begin
    Messagebox(Handle,'无效药品编号','错误:',16);
    Abort;
  End Else Begin
    If sGoodsID<>FlagGoodsID then
      CdsGoodsCheckAcceptDtl.FieldByName('GoodsID').AsString:=FlagGoodsID
   Else
     FlagGoodsID:='';
  END;
end;

procedure TFmSelGoodsCheckAccept.dbgGoodsCheckAcceptDtlEditButtonClick(Sender: TObject);
begin
  inherited;
  if FEditMode=0 then Exit;
  bBrowGoods := true;
  if LowerCase(dbgGoodsCheckAcceptDtl.SelectedField.FieldName)='goodsid' then begin
    SelectGoods(CdsGoodsCheckAcceptDtl, CdsGoodsCheckAcceptDtlGoodsID, CdsGoodsCheckAcceptDtlUnit, true, False, False);
  end;
  bBrowGoods := false;
end;

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

procedure TFmSelGoodsCheckAccept.CdsGoodsCheckAcceptDtlBeforePost(
  DataSet: TDataSet);
begin
end;

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

procedure TFmSelGoodsCheckAccept.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 TFmSelGoodsCheckAccept.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('该月已结算，不能操作已月结的单据！'),'错误',16);
        Exit;
      End;
    End Else Begin
      Messagebox(Handle,Pchar('请先设置开帐日期...'),'错误',16);
      Exit;
    End;
    BillNo  := CdsGoodsCheckAcceptBillNo.Value;
    PBillNo := CdsGoodsCheckAcceptPBillNo.Value;
    If BillNo='' then Exit;
    If Not(SvrGoodsCheckAccept.AppServer.BillAudit(iClientID, 'SelGoodsCheckAccept',BillNo, PBillNo)) then
      Messagebox(Handle,Pchar('审核数据不成功！'),'错误：',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),'错误：',16);
  End;
end;

procedure TFmSelGoodsCheckAccept.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('还原数据不成功！'),'错误：',16)
    Else Begin
      CdsGoodsCheckAccept.RefreshRecord;
      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),'错误：',16);
  End;
End;

procedure TFmSelGoodsCheckAccept.ActFieldLayoutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name,
                  [dbgGoodsCheckAcceptDtl],'采购药品质量验收明细');
end;

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

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

end;

procedure TFmSelGoodsCheckAccept.CdsGoodsCheckAcceptNewRecord(
  DataSet: TDataSet);
begin
  inherited;
  CdsGoodsCheckAcceptBillNo.Value := BuildBillNo('SelGoodsCheckAccept');
  CdsGoodsCheckAcceptFDate.Value := Date;
  CdsGoodsCheckAcceptCheckKind.Value := 1;
end;

initialization
  RegisterClass(TFmSelGoodsCheckAccept);

finalization
  UnRegisterClass(TFmSelGoodsCheckAccept);

end.