VbzCart/docs/archive/code/VBA/clsPackageItem

From Woozle Writes Code
< VbzCart‎ | docs‎ | archive‎ | code‎ | VBA
Revision as of 01:53, 25 February 2024 by Woozle (talk | contribs) (Woozle moved page VbzCart/VbzCart/archive/code/VBA/clsPackageItem to VbzCart/docs/archive/code/VBA/clsPackageItem without leaving a redirect: correct naming (was no way to import directly to this name))
(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Jump to navigation Jump to search 
' CLASS: clsPackageItem

Option Compare Database
Option Explicit
Private vID As Long
Private vPkg As Long
Private vItem As Long
Private vOrdItem As Long
Private vQtyShipped As Long ' qty shipped as ordered
Private vQtyExtra As Long   ' qty shipped unrequested
Private vQtyNotAvail As Variant
Private vQtyCancelled As Variant
Public Sub Init(iFields As Fields)
    With iFields
        vID = !ID
        vPkg = !ID_Package
        vItem = Nz(!ID_Item)
        vOrdItem = Nz(!ID_OrderItem)
        vQtyShipped = Nz(!QtyShipped)
        vQtyExtra = Nz(!QtyExtra)
        vQtyNotAvail = !QtyNotAvail
        vQtyCancelled = !QtyCancelled
    End With
End Sub
Public Sub InitNew(iParent As clsPackage)
' ACTION: creates a new line item for the given package
' ASSUMES: no fields have been filled in beforehand; must be saved explicitly afterwards if those fields are to be written to the db
    vPkg = iParent.ID
    With clsPackageItems
        .DataOpen
        With .Data
            .AddNew
            vID = !ID
            !ID_Package = vPkg
            .Update
        End With
        .DataShut
    End With
End Sub
Public Sub CopyOrderItem(iData As clsOrderItem)
' ACTION: fills in the appropriate data in this object with information from the given order item
' USAGE: used for creating a new package from an order
    With iData
        ' get the item to be shipped, and the order item it's shipping from
        Me.Item_ID = .Item_ID
        Me.OrderItem_ID = .ID
' (2004-01-16) we used to assume everything would ship; now we check stock first.
'        ' assume we'll be shipping everything not nailed down... I mean, not already accounted for
'        Me.QtyShipped = .QtyOrd - .QtyDone
        ' other quantities default to NULL
    End With
    Me.Save
End Sub
Public Sub Ship()
' ACTION: ships this item. This used to involve adjusting a quantity in the Order Item record, but for now it does nothing.
'   If there is no corresponding order item, does nothing too.
'    Dim objOrdItm As clsOrderItem
    
'    If Me.OrderItemExists Then
'        Set objOrdItm = Me.OrderItem
'        With objOrdItm
'            .QtyDoneAdd Me.QtyHandled + Me.QtyNotAvail + Me.QtyCancelled
'            .Save
'        End With
'    End If
End Sub
Public Sub UnShip()
' ACTION: UNships this item, i.e. reverses the action of Ship()
'   If there is no corresponding order item, does nothing
'    Dim objOrdItm As clsOrderItem
'
'    If Me.OrderItemExists Then
'        Set objOrdItm = Me.OrderItem
'        With objOrdItm
'            .QtyDoneDel Me.QtyHandled + Me.QtyNotAvail + Me.QtyCancelled
'            .Save
'        End With
'    End If
End Sub
Public Function Delete() As Boolean
    With clsPackageItems
        .DataOpen
        If Located Then
            .Data.Delete
            Delete = True
        Else
            Delete = False
        End If
    End With
End Function
Public Sub Save()
    With clsPackageItems
        .DataOpen
        If Located Then
            With .Data
                .Edit
                !ID_Package = vPkg
                !ID_Item = vItem
                !ID_OrderItem = IIf(vOrdItem = 0, Null, vOrdItem)
                !QtyShipped = vQtyShipped
                !QtyExtra = vQtyExtra
                !QtyNotAvail = vQtyNotAvail
                !QtyCancelled = vQtyCancelled
                .Update
            End With
        End If
    End With
End Sub
Public Property Get ID() As Long
    ID = vID
End Property
Public Property Get Package_ID() As Long
    Package_ID = vPkg
End Property
Public Property Get PackageExists() As Boolean
    PackageExists = (vPkg <> 0)
End Property
Public Property Get Package() As clsPackage
    Dim objPkg As clsPackage

    Set objPkg = clsPackages.Item(Me.Package_ID)
    If objPkg Is Nothing Then
        With clsPackages
            .DataOpen
            .Data.Requery
            Set objPkg = .Item(Me.Package_ID)
            .DataShut
        End With
    End If
    Set Package = objPkg
End Property
Public Property Get Item_ID() As Long
    Item_ID = vItem
End Property
Public Property Let Item_ID(iID As Long)
    vItem = iID
End Property
Public Property Get Item() As clsItem
    Set Item = clsItems.Item(Me.Item_ID)
End Property
Public Property Get OrderItem_ID() As Long
    OrderItem_ID = vOrdItem
End Property
Public Property Let OrderItem_ID(iID As Long)
    vOrdItem = iID
End Property
Public Property Get OrderItem() As clsOrderItem
    Set OrderItem = clsOrderItems.Item(vOrdItem)
End Property
Public Property Get OrderItemExists() As Boolean
    If (Me.OrderItem_ID = 0) Then
        OrderItemExists = False
    Else
        OrderItemExists = Not (Me.OrderItem Is Nothing)
    End If
End Property
Public Property Get QtyShipped() As Long
    QtyShipped = vQtyShipped
End Property
Public Property Let QtyShipped(iQty As Long)
    vQtyShipped = iQty
End Property
Public Property Get QtyMoved() As Long
' RETURNS: quantity shipped + quantity extra
    QtyMoved = vQtyShipped + vQtyExtra
End Property
Public Sub AddQtyShipped(iQty As Long)
    vQtyShipped = vQtyShipped + iQty
End Sub
Public Property Get QtyNotAvail() As Long
    QtyNotAvail = Nz(vQtyNotAvail)
End Property
Public Property Let QtyNotAvail(iQty As Long)
    vQtyNotAvail = iQty
End Property
Public Property Get QtyCancelled() As Long
    QtyCancelled = Nz(vQtyCancelled)
End Property
Public Property Let QtyCancelled(iQty As Long)
    vQtyCancelled = iQty
End Property
Public Property Get QtyCancelledEver() As Long
' ACTION: returns the total cancelled of this item for all packages started prior to this one
    Dim objList As Scripting.Dictionary
    Dim objItem As clsPackageItem
    Dim dtStart As Date, dtItem As Date
    Dim didFinish As Boolean
    Dim doCount As Boolean
    Dim qtyTot As Long
    
    Set objList = Me.Packings
    With Me.Package
        didFinish = .HasBeenFinished
        If didFinish Then
            dtStart = .WhenFinished
        End If
    End With

    If objList Is Nothing Then
        QtyCancelledEver = 0
    Else
        For Each objItem In objList
            With objItem
                dtItem = .Package.WhenStarted
                If didFinish Then
                    doCount = (dtItem < dtStart)
                Else
                    doCount = False
                End If
                If doCount Then
                    qtyTot = qtyTot + .QtyCancelled
                End If
            End With
        Next objItem
        QtyCancelledEver = qtyTot
    End If
End Property
Public Property Get QtyHandled() As Long
    QtyHandled = QtyShipped + QtyNotAvail + QtyCancelled
End Property
Public Property Get QtyOpen() As Long
    With Me.OrderItem
        QtyOpen = .QtyRem
    End With
End Property
Public Property Get QtyOrdered() As Long
' ACTION: returns the quantity originally ordered for the current item
    With Me.OrderItem
        QtyOrdered = .QtyOrd
    End With
End Property
Public Property Get QtyYetToPack() As Long
' ACTION: returns the quantity not packed earlier than this package's creation date
' STEPS:
'   1. get all package items referring to the same Order Item
'   2. total the ones whose package is dated earlier than this package
'   3. subtract from the total ordered; return this result.
    Dim objPkg As clsPackage
    Dim dtStart As Date, dtItem As Date
    Dim objList As Scripting.Dictionary
    Dim objItem As clsPackageItem
    Dim qtyPkd As Long
    
    Set objPkg = Me.Package
    If objPkg Is Nothing Then
        QtyYetToPack = 0
        Debug.Print "Package object not returned for ID=" & Me.Package_ID
    Else
        dtStart = objPkg.WhenStarted
        Set objList = Me.Packings
        
        If objList Is Nothing Then
            QtyYetToPack = 0
        Else
            For Each objItem In objList
                With objItem
                    If .PackageExists Then
                        If .Package Is Nothing Then
                            MsgBox "Package ID=" & .Package_ID & " could not be loaded.", vbCritical, "Internal Error"
                        Else
                            dtItem = .Package.WhenStarted
                            If dtItem < dtStart Then
                                qtyPkd = qtyPkd + .QtyHandled
                            End If
                        End If
                    End If
                End With
            Next objItem
            QtyYetToPack = Me.OrderItem.QtyOrd - qtyPkd
        End If
    End If
End Property
Public Property Get WasOrdered() As Boolean
    WasOrdered = (Me.OrderItem_ID <> 0)
End Property
'Public Property Get Item() As clsItem
'' ACTION: returns the package item's item object, if available, else pops up error messages and allows the user
''   to enter missing data.
'    Dim objItRef As clsItemRef
'    Dim objItem As clsItem
'
'    Set objItRef = Me.ItRef
'    If objItRef Is Nothing Then
'        MsgBox "An item in the package has no item reference.", vbExclamation, "Data Missing"
'    Else
'        Set objItem = objItRef.Item
'        If objItem Is Nothing Then
'            With objItRef
'                MsgBox "The item reference " & .DescrText & " (" & .CatNum & ") has no item assigned.", vbExclamation, "Data Missing"
'                .Edit
'            doCancel = True ' cancel the rest of the operation
'            End With
'        Else
'            Set Item = objItem
'        End If
'    End If
'End Property
Public Property Get ShipCode_Exists() As Boolean
    Dim objItem As clsItem
    
    Set objItem = Me.Item
    If objItem Is Nothing Then Exit Property
    ShipCode_Exists = objItem.ShipCodeExists
End Property
Public Property Get ShipCode() As clsShipCode
' ACTION: returns the package item's ship code object, if available, else pops up error messages and allows the user
'   to enter missing data.
    Dim objItem As clsItem
    Dim objShip As clsShipCode

    Set objItem = Me.Item
    If objItem Is Nothing Then Exit Property
    Set objShip = objItem.ShipCode
    If objShip Is Nothing Then
        With objItem
            MsgBox "The item " & .Description & " (" & .CatNum & ") has no shipping code set."
            .Edit
            doCancel = True ' cancel the rest of the operation
        End With
        Set ShipCode = Nothing
    Else
        Set ShipCode = objShip
    End If
End Property
Public Property Get PriceEffective() As Currency
' ACTION: returns the effective price of the item, which is the amount quoted in the order item record (if available)
'   or else defaults to the item's current price
    Dim objItem As clsItem
    Dim objPrice As clsPriceCode
    
    If Me.OrderItemExists Then
        PriceEffective = Me.OrderItem.Price
    Else
        Set objItem = Me.Item
        If objItem Is Nothing Then Exit Property
        Set objPrice = objItem.PriceCode
        If objPrice Is Nothing Then
            With objItem
                MsgBox "The item " & .Description & " (" & .CatNum & ") has no price code set."
                .Edit
                doCancel = True ' cancel the rest of the operation
            End With
        Else
            PriceEffective = Me.Item.PriceCode.Price
        End If
    End If
End Property
Public Property Get ShipPkgEffective() As Currency
' ACTION: returns the effective shipping package cost of the item, which is the amount quoted in the order item record (if available)
'   or else defaults to the value in the item's current shipping code
    Dim objShip As clsShipCode
    
    If Me.OrderItemExists Then
        ShipPkgEffective = Me.OrderItem.ShipPkg
    Else
        Set objShip = Me.ShipCode
        If objShip Is Nothing Then Exit Property
        ShipPkgEffective = objShip.PerPkg
    End If
End Property
Public Property Get ShipItmEffective() As Currency
' ACTION: returns the effective shipping per-item cost of the item, which is the amount quoted in the order item record (if available)
'   or else defaults to the value in the item's current shipping code
    Dim objShip As clsShipCode
    
    If Me.OrderItemExists Then
        ShipItmEffective = Me.OrderItem.ShipItem
    Else
        Set objShip = Me.ShipCode
        If objShip Is Nothing Then Exit Property
        ShipItmEffective = objShip.PerItem
    End If
End Property
Public Property Get PriceTotal() As Currency
' ACTION: returns the item's effective price multiplied by the quantity being shipped
    PriceTotal = Me.PriceEffective * Me.QtyShipped
End Property
Public Property Get ShipItemTotal() As Currency
' ACTION: returns the itemized shipping cost multiplied by the quantity being shipped
    ShipItemTotal = Me.ShipItmEffective * Me.QtyShipped
End Property
Public Property Get Packings() As Scripting.Dictionary
' ACTION: returns a list of all packings of the same line item (including this object)
    Dim objOItem As clsOrderItem

    If Me.WasOrdered Then
        Set objOItem = Me.OrderItem
        If objOItem Is Nothing Then
            Set Packings = Nothing
        Else
            Set Packings = objOItem.Packings
        End If
    Else
        Set Packings = Nothing
    End If
End Property
Private Function Located() As Boolean
    Dim isFnd As Boolean

    isFnd = True
    With clsPackageItems
        With .Data
            If .EOF Then
                isFnd = False
            ElseIf !ID <> vID Then
                .FindFirst "ID=" & vID
                If .NoMatch Then
                    MsgBox "Package Item with ID=" & vID & " was not found.", vbCritical, "Internal Error"
                    isFnd = False
                End If
            End If
        End With
    End With
    Located = isFnd
End Function
Public Sub FetchFromStockLine(iStkLine As Long, iQty As Long)
    Dim objStkLine As clsStockItem
    
    Set objStkLine = clsStockItems.Item(iStkLine)
    If objStkLine Is Nothing Then Stop  ' internal error
    objStkLine.FetchToPkgLine iQty, Me.ID
End Sub
Public Sub FetchFromLocation(iLoc As Long, iQty As Long)
    Dim sqlFilt As String
    Dim objStkLine As clsStockItem

    sqlFilt = "(ID_Location=" & iLoc & ") AND (ID_Item=" & Me.Item_ID & ")"
    Set objStkLine = New clsStockItem
    With clsStockItems
        .DataOpen
        With .Data
            .FindFirst sqlFilt
            Do While Not .NoMatch
                objStkLine.Init .Fields, clsStockItems
                objStkLine.FetchToPkgLine iQty, Me.ID
                .FindNext sqlFilt
            Loop
        End With
        .DataShut
    End With
End Sub
Retrieved from "https://wooz.dev/mw/index.php?title=VbzCart/docs/archive/code/VBA/clsPackageItem&oldid=6608"