datamod.vbs

Dream Scripter v3.5 Full Source Code

dim  PrevPartNo
dim  PrevQty
dim  DeletingItems
dim  FItemNo

'-------------------------------------------------------------------

function Confirm(Msg)
  Confirm =  (MessageDlg(Msg, mtConfirmation, mbYesNoCancel, 0) = mrYes)
End function

'-------------------------------------------------------------------

function Database()
  result = Null
  for i=0 to Session.DatabaseCount-1
    if (UpperCase(Session.Databases(i).DatabaseName)="DBDEMOS") or  (UpperCase(Session.Databases(i).AliasName)="DBDEMOS") then
      result = Session.Databases(i)
      Exit For
    End IF
  Next
  Database = result
End function

'-------------------------------------------------------------------

function DataDirectory()
  DataDirectory Database().Directory
End function

'-------------------------------------------------------------------

sub PartsBeforeOpen(DataSet)
  Vendors.Open
End Sub

'-------------------------------------------------------------------

sub PartsCalcFields(DataSet)
  PartsBackOrd.Value = (PartsOnOrder.Value > PartsOnHand.Value)
End Sub

'-------------------------------------------------------------------

sub PartsQueryCalcFields(DataSet)
  PartsQueryBackOrd.Value = (PartsOnOrder.Value > PartsOnHand.Value)
End Sub

'-------------------------------------------------------------------

sub OrdersAfterCancel(DataSet)
  Cust.CancelUpdates
  Parts.CancelUpdates
  Items.CancelUpdates
  Orders.CancelUpdates
End Sub

'-------------------------------------------------------------------

sub OrdersAfterDelete(DataSet)
  Database().ApplyUpdates(Array(Cust, Parts, Items, Orders))
End Sub

'-------------------------------------------------------------------

sub OrdersAfterPost(DataSet)
  if  Cust.Locate("CustNo", OrdersCustNo.Value, 0) and (CustLastInvoiceDate.Value < OrdersShipDate.Value) then
    Cust.Edit
    CustLastInvoiceDate.Value = OrdersShipDate.Value
    Cust.Post
  End If
  Database().ApplyUpdates(Array(Orders, Items, Parts, Cust))
End Sub

'-------------------------------------------------------------------

sub OrdersBeforeCancel(DataSet)
  if (Orders.State = dsInsert) and  not (Items.BOF and Items.EOF) then
    if not Confirm("Cancel order being inserted and delete all line items?") then Abort
  end If
End Sub

'-------------------------------------------------------------------

sub OrdersBeforeClose(DataSet)
  Items.Close
  Emps.Close
  CustByOrd.Close
End Sub

'-------------------------------------------------------------------

sub OrdersBeforeDelete(DataSet)
  if not Confirm("Delete order and line items?") then
    Abort
  else
   call DeleteItems()
  End If
End Sub

'-------------------------------------------------------------------

sub OrdersBeforeInsert(DataSet)
  if inset(Orders.State, dsEditModes)  then
    if Confirm("An order is being processed.  Save changes and start a new one?") then
      Orders.Post
    else
      Abort
    End If
  End IF
  FItemNo = 1
End Sub

'-------------------------------------------------------------------

sub OrdersBeforeOpen(DataSet)
  CustByComp.Open
  CustByOrd.Open
  Cust.Open
  Emps.Open
  Items.Open
End Sub

'-------------------------------------------------------------------

sub OrdersCalcFields(DataSet)
  OrdersTaxTotal.Value = OrdersItemsTotal.Value * (OrdersTaxRate.Value / 100)
  OrdersAmountDue.Value = OrdersItemsTotal.Value + OrdersTaxTotal.Value + OrdersFreight.Value - OrdersAmountPaid.Value
End Sub

'-------------------------------------------------------------------

sub OrdersNewRecord(DataSet)
  NextOrd.Open
  NextOrd.Edit
  OrdersOrderNo.Value = NextOrdNewKey.Value
  NextOrdNewKey.Value = NextOrdNewKey.Value + 1
  NextOrd.Post
  NextOrd.Close

  OrdersSaleDate.Value = Date()
  OrdersShipVia.Value = "UPS"
  OrdersTerms.Value = "net 30"
  OrdersPaymentMethod.Value = "Check"
  OrdersItemsTotal.Value = 0
  OrdersTaxRate.Value = 0
  OrdersFreight.Value = 0
  OrdersAmountPaid.Value = 0
End Sub

'-------------------------------------------------------------------

sub ItemsAfterDelete(DataSet)
  call UpdateTotals()
End Sub

'-------------------------------------------------------------------

sub UpdateParts(PartNo,Qty)
  if (PartNo > 0) and  (Qty <> 0) then
    if not Parts.Locate("PartNo", PartNo, 0) then  Abort
    Parts.Edit
    PartsOnOrder.Value = PartsOnOrder.Value + Qty
    Parts.Post
  End IF
End Sub

'-------------------------------------------------------------------

sub ItemsAfterPost(DataSet)
  FItemNo = FItemNo + 1
  call UpdateTotals()
  if  not ((PrevPartNo = ItemsPartNo.Value) and  (PrevQty = ItemsQty.Value)) then
    call UpdateParts(PrevPartNo, -PrevQty)
    call UpdateParts(ItemsPartNo.Value, ItemsQty.Value)
  End If
End Sub

'-------------------------------------------------------------------

sub EnsureOrdersEdit(DataSet)
  Orders.Edit
End Sub

'-----------------------------------------------------------------

sub ItemsBeforeEdit(DataSet)
  Orders.Edit
  PrevPartNo = ItemsPartNo.Value
  PrevQty = ItemsQty.Value
End Sub

'-------------------------------------------------------------------

sub ItemsBeforeOpen(DataSet)
  Parts.Open
End Sub

'-------------------------------------------------------------------

sub ItemsBeforePost(DataSet)
  ItemsItemNo.Value = FItemNo
End Sub

'-------------------------------------------------------------------

sub ItemsCalcFields(DataSet)
  ItemsExtPrice.Value = ItemsQty.Value * ItemsSellPrice.Value * (100 - ItemsDiscount.Value) / 100
End Sub

'-------------------------------------------------------------------

sub ItemsNewRecord(DataSet)
  PrevPartNo = 0
  PrevQty = 0
  ItemsOrderNo.Value = OrdersOrderNo.Value
  ItemsQty.Value = 1
  ItemsDiscount.Value = 0
End Sub

'-------------------------------------------------------------------

sub EmpsCalcFields(DataSet)
  EmpsFullName.Value = EmpsLastName.Value + " " + EmpsFirstName.Value
End Sub

'-------------------------------------------------------------------

sub DeleteItems()
  DeletingItems = true
  Items.DisableControls
  Items.First
  while not Items.EOF
    Items.Delete
  Wend
  DeletingItems = false
  Items.EnableControls
End Sub

'-------------------------------------------------------------------

sub UpdateTotals()
  if not DeletingItems then
    PrevRecord = Items.Bookmark
    Items.DisableControls
    Items.First
    TempTotal = 0
    while not Items.EOF
      TempTotal = TempTotal + ItemsExtPrice.Value
      Items.Next
    Wend
    OrdersItemsTotal.Value = TempTotal
    Items.EnableControls
    if PrevRecord <> NULL then  Items.Bookmark =PrevRecord
  End IF
End Sub

'-------------------------------------------------------------------

sub OrdersCustNoChange(Sender)
  OrdersShipToContact.Value = ""
  OrdersShipToPhone.Value = ""
  OrdersShipToAddr1.Value = ""
  OrdersShipToAddr2.Value = ""
  OrdersShipToCity.Value = ""
  OrdersShipToState.Value = ""
  OrdersShipToZip.Value = ""
  OrdersShipToCountry.Value = ""
  TaxRate = Cust.Lookup("CustNo", OrdersCustNo.Value, "TaxRate")
  if TaxRate <> NULL then OrdersTaxRate.Value = TaxRate
End Sub

'-------------------------------------------------------------------

sub ItemsQtyValidate(Sender)
  if ItemsQty.Value < 1 then  Showmessage("Must specify quantity")
End Sub

'-------------------------------------------------------------------

sub OrdersFreightValidate(Sender)
  if OrdersFreight.Value < 0 then  Showmessage("Freight cannot be less than zero")
End Sub

'-------------------------------------------------------------------

sub ItemsPartNoValidate(Sender)
  if not Parts.Locate("PartNo", ItemsPartNo.Value, 0) then  Showmessage("You must specify a valid PartNo")
End Sub

'-------------------------------------------------------------------

sub OrdersSaleDateValidate(Sender)
  if OrdersSaleDate.Value > Now  then  Showmessage("Cannot enter a future date")
End Sub

'-------------------------------------------------------------------

sub CustBeforeOpen(DataSet)
  OrdByCust.Open
End Sub

'-------------------------------------------------------------------

sub OrdByCustCalcFields(DataSet)
  OrdByCustAmountDue.Value = OrdByCustItemsTotal.Value + OrdByCustItemsTotal.Value * OrdByCustTaxRate.Value / 100 + OrdByCustFreight.Value - OrdByCustAmountPaid.Value
End Sub

'-------------------------------------------------------------------

sub CustBeforePost(DataSet)
  if Cust.State = dsInsert then
    NextCust.Open
    NextCust.Edit
    CustCustNo.Value = NextCustNewCust.Value
    NextCustNewCust.Value = NextCustNewCust.Value + 1
    NextCust.Post
    NextCust.Close
  End If
End Sub

'-------------------------------------------------------------------

function DataSetApplyUpdates(DataSet,Apply)
  Result = true
  if  inset(DataSet.State,dsEditModes) or  DataSet.UpdatesPending then
    if Apply then
      Database.ApplyUpdates(Array(DataSet))
      DataSet.CancelUpdates
    else
      if  MessageDlg("Unsaved changes, exit anyway?", mtConfirmation, MkSet(mbYes, mbCancel), 0) = mrYes then
         Dataset.CancelUpdates
      else
         Result = false
      End If
    End If
  End IF
  DataSetApplyUpdates = Result
End function


'-------------------------------------------------------------------

sub OrdersBeforeEdit(DataSet)
  LastItemQuery.Close
  LastItemQuery.Open
  if LastItemQuery.Fields(0).IsNull then
    FItemNo = 1
  else
    FItemNo = LastItemQuery.Fields(0).Value + 1
  End If
End Sub

'-------------------------------------------------------------------

sub EditUpdateError(DataSet,E, UpdateKind,UpdateAction)
  UpdErrMsg = "%s."+chr(13)+chr(10)+"Discard the edits to %S %S and continue updating?"
  if UpdateKind = ukDelete then
    Key = Dataset.Fields(0).OldValue
  else
    Key = Dataset.Fields(0).NewValue
  End IF
  if MessageDlg( Format(UpdErrMsg, Array(E.Message, DataSet.Fields(0).DisplayLabel, Key) ),mtConfirmation, MkSet(mbYes, mbCancel), 0) = mrYes then
    UpdateAction = uaSkip
  else
    UpdateAction = uaAbort
  End IF
End Sub