VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "DPC_Generate"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

#If LIVE = 1 Then
  Private mo_Db As Object
  Private mo_FSO As Object
#Else
  Private mo_Db As ARMSYSCOMLib.ArmDb
  Private mo_FSO As FileSystemObject
#End If

Private mo_Tools As DPC_Tools
Private mv_Edge As Variant
Private mc_Error As Long

Private ml_U_Code As Long
Private ms_Language_Code As String
Public CT_Code As String
Public CURR_Code As String
Public ValidityDate As Date

Private ms_BaeurerServer As String
Private ms_BaeurerDatabase As String
Private ms_BaeurerLoginName As String
Private ms_BaeurerPassword As String
Private ms_BaeurerSource As String
Private ml_BaeurerFi_Nr As Long

Private Type tDPC_Coil
  MAT_Id As Long
  RPL_MatTyp  As String
  MAT_Prefx As String
  MAT_OrdQty As Long
  MAT_WiStep As Long
  MAT_MaxCut As Long
  CoilTemplateIdentNr As String
  DefaultSpecWeight As Double
  DefaultWasteFactor As Double
  Thickness As Double
  Width As Long
  MaxQty As Double
  MinWidth As Double
  MaxWidth As Double
  Products As Collection
End Type

Private Type tDPC_Material
  BOM_IdentNr As String
  Qty As Double
End Type

Private Type tDPC_Palette
  IdentNr As String
  PalA  As Double
  PalB As Double
  PalH As Double
  PalMaxH As Double
  PaletteFreeSpace  As Long
  MaxPaletteFreeSpace As Long
  LastPackageQty As Long
  PackageQty As Long
  PaletteQty As Long
  RowsLength As Long
  RowsWidth As Long
  RowsHeight As Long
  MaxPackageQty As Long
  SmallQty As Long
  EdgeProtectionLIdentNr As String
  EdgeProtectionHIdentNr As String
End Type

Private Type tDPC_Package
  PkgA  As Double
  PkgB As Double
  PkgH As Double
  MaxWeight As Double
  AdditionalPkgMatSize As Double
  PanelQty As Long
End Type

Private Type tDPC_PackingItem
  Type As eDPCBOMPackingItemType
  IdentNr As String
  ItemA  As Double
  ItemB As Double
  ItemH As Double
  PalMaxH As Double
  Formula As String
  Factor  As Double
  UM_Code As String
  MaxWeight As Double
  Qty As Double
End Type

Private Const C_ERRORRAISE As Long = 2500
Private Const SEP = "®©"
Private Const C_SEP As String = "@@"
Private Const SEP1 As String = "®"
Private Const SEP2 As String = "©"

Private Enum ArmErr
    DBCnxFailed = vbObjectError + 1             ' Unable to connect to the database
    CPTAlreadyInitialized = vbObjectError + 2   ' We try to initialize a component that is already initialized
    CPTNotInitialized = vbObjectError + 3       ' We try to use or free that is not initialized yet
    InvalidArgument = vbObjectError + 4
    PropertyNotSet = vbObjectError + 5
    SQLFailure = vbObjectError + 6               ' A SQL runtime error has occured : syntax wrong....
    SQLBadRowAffectedCount = vbObjectError + 7   ' A SQL request has not affected the expected rowcount (ex: one Update do nothing)
    SQLBadRowExpectedCount = vbObjectError + 8   ' A SQL request does not return the expected rowcount : select an item return nothing...
    DrivingError = vbObjectError + 9
    CompFncFailed = vbObjectError + 10           ' when component function fail
    GridLoadFailed = vbObjectError + 11          ' load function failed ... bad sql
    QuietException = vbObjectError + 12          ' do not display error message
    SQLTableReferenceConstraint = vbObjectError + 13 ' A SQL request cannot be executed : Table reference constraint
    DuplicityDetected = vbObjectError + 2301     ' detected row with same unique id
End Enum

Property Let U_Code(al_Code As Long)
  ml_U_Code = al_Code
End Property

Property Let Language_Code(AString As String)
  ms_Language_Code = AString
End Property

Property Get Language_Code() As String
  Language_Code = ms_Language_Code
End Property

Public Property Set ArmDb(ByRef lo_Db As Object)
    If Not (lo_Db Is Nothing) Then
        Set mo_Db = lo_Db
    End If
  Exit Property
ErrHandler:
  Call ErrorHandler("ArmDb.Set")
End Property

Public Property Set Tools(ByRef ao_Tools As Object)
On Error GoTo ErrorHandler

  Set mo_Tools = ao_Tools
  Exit Property
ErrorHandler:
  Call ErrorHandler("Tools.Set")
End Property

Public Function Load_A_COM() As Boolean
On Error GoTo ErrHandler

Dim ls_Connect() As String
  
  If mo_Db Is Nothing Then
      Call Err.Raise(ArmErr.PropertyNotSet)
  End If
  If mo_Tools Is Nothing Then
      Call Err.Raise(ArmErr.PropertyNotSet)
  End If
  
  mv_Edge = Array("C", "D", "E", "F")
  
  ls_Connect = Split(mo_Tools.GetAConfigData("DPC_BaeurerConnection"), SEP)
  If UBound(ls_Connect) = 5 Then
    ms_BaeurerServer = ls_Connect(0)
    ms_BaeurerDatabase = ls_Connect(1)
    ms_BaeurerLoginName = ls_Connect(2)
    ms_BaeurerPassword = ls_Connect(3)
    ms_BaeurerSource = ls_Connect(4)
    ml_BaeurerFi_Nr = Val(ls_Connect(5))
  End If
  Exit Function
ErrHandler:
  Call ErrorHandler("Load_A_COM")
End Function

Public Function Unload_A_COM() As Boolean
On Error GoTo ErrHandler

  mv_Edge = Empty
  Exit Function
ErrHandler:
  Call ErrorHandler("Unload_A_COM")
End Function

Private Function GetBaeurerIdentNr(ByVal as_PRD_Id As String) As String
On Error GoTo ErrHandler

Dim ls_Request As String
Dim lc_Cursor As Long

  GetBaeurerIdentNr = ""
  If as_PRD_Id <> "" Then
    ls_Request = _
      "SELECT PRD.PRD_CodeAMC " & _
      "FROM DPC_PrdCommon PRD " & _
      "WHERE  PRD.PRD_Id = $PRD_Id$"
    
    ls_Request = Replace(ls_Request, "$PRD_Id$", mo_Tools.SQLStr(as_PRD_Id), , , vbTextCompare)
    lc_Cursor = mo_Tools.OpenSQLSafe(mo_Db, ls_Request)
    If mo_Db.RowCount(lc_Cursor) = 1 Then
      GetBaeurerIdentNr = Trim(mo_Db.GetFields(lc_Cursor, "PRD_CodeAMC"))
    End If
    Call mo_Db.Close(lc_Cursor)
  End If
  Exit Function
ErrHandler:
  Call ErrorHandler("GetBaeurerIdentNr")
End Function

Private Function GetProductCoilIndex(ByRef ata_Coil() As tDPC_Coil, ByVal ao_Product As DPC_Product) As Long
On Error GoTo ErrHandler

  GetProductCoilIndex = GetCoilIndex(ata_Coil, ao_Product.MAT_Id, ao_Product.RPL_MatTyp, ao_Product.RPL_Thick)
  Exit Function
ErrHandler:
  Call ErrorHandler("GetProductCoilIndex")
End Function

Private Function GetCoilIndex(ByRef ata_Coil() As tDPC_Coil, ByVal al_MAT_Id As Long, ByVal as_RPL_MatTyp As String, ByVal ad_Thickness As Double) As Long
On Error GoTo ErrHandler

Dim ll_Idx As Long

  GetCoilIndex = -1
  For ll_Idx = 0 To UBound(ata_Coil)
    If (ata_Coil(ll_Idx).MAT_Id = al_MAT_Id) And (StrComp(ata_Coil(ll_Idx).RPL_MatTyp, as_RPL_MatTyp, vbTextCompare) = 0) And (ata_Coil(ll_Idx).Thickness = ad_Thickness) Then
      GetCoilIndex = ll_Idx
      Exit Function
    End If
  Next
  Exit Function
ErrHandler:
  Call ErrorHandler("GetCoilIndex")
End Function

Private Sub InitCoilIndex(ByRef ata_Coil() As tDPC_Coil, ByVal ao_Collection As Collection)
On Error GoTo ErrHandler

  Dim lo_Product As DPC_Product
  Dim ll_Idx As Long
  
  ReDim ata_Coil(-1 To -1)
  
  For Each lo_Product In ao_Collection
  
    'get unique list of combination material and thickness
    If lo_Product.MAT_CoilTypeIdx = -1 Then
      ll_Idx = GetCoilIndex(ata_Coil, lo_Product.MAT_Id, lo_Product.RPL_MatTyp, lo_Product.RPL_Thick)
      If ll_Idx >= 0 Then
        If ata_Coil(ll_Idx).MinWidth > lo_Product.RPL_CoWMin Then
          ata_Coil(ll_Idx).MinWidth = lo_Product.RPL_CoWMin
        End If
        If ata_Coil(ll_Idx).MaxWidth < lo_Product.RPL_CoWMax Then
          ata_Coil(ll_Idx).MaxWidth = lo_Product.RPL_CoWMax
        End If
      Else
        If UBound(ata_Coil) = -1 Then
          ReDim ata_Coil(0)
          ll_Idx = 0
        Else
          ReDim Preserve ata_Coil(UBound(ata_Coil) + 1)
          ll_Idx = UBound(ata_Coil)
        End If
        ata_Coil(ll_Idx).MAT_Id = lo_Product.MAT_Id
        ata_Coil(ll_Idx).RPL_MatTyp = lo_Product.RPL_MatTyp
        ata_Coil(ll_Idx).MAT_Prefx = lo_Product.MAT_Prefx
        ata_Coil(ll_Idx).MAT_OrdQty = lo_Product.MAT_OrdQty
        ata_Coil(ll_Idx).MAT_MaxCut = lo_Product.MAT_MaxCut
        ata_Coil(ll_Idx).MAT_WiStep = lo_Product.MAT_WiStep
        ata_Coil(ll_Idx).Thickness = lo_Product.RPL_Thick
        ata_Coil(ll_Idx).MinWidth = lo_Product.RPL_CoWMin
        ata_Coil(ll_Idx).MaxWidth = lo_Product.RPL_CoWMax
        ata_Coil(ll_Idx).MaxQty = 0
        ata_Coil(ll_Idx).Width = 0
        ata_Coil(ll_Idx).CoilTemplateIdentNr = GetCoilTemplateIdentNr(lo_Product.MAT_Prefx, lo_Product.RPL_MatTyp, lo_Product.RPL_Thick)
        ata_Coil(ll_Idx).DefaultSpecWeight = 0
        ata_Coil(ll_Idx).DefaultWasteFactor = 0
        Set ata_Coil(ll_Idx).Products = New Collection
      End If
      lo_Product.MAT_CoilTypeIdx = ll_Idx
    End If
  Next
  Exit Sub
ErrHandler:
  Call ErrorHandler("InitCoilIndex")
End Sub

Private Function ExistsUnassignedProduct(ByVal ao_Collection As Collection, ByRef ata_Coil() As tDPC_Coil, ByVal al_CoilIndex As Long) As Boolean
On Error GoTo ErrHandler

  Dim lo_Product As DPC_Product
  
  ExistsUnassignedProduct = False
  For Each lo_Product In ao_Collection
  
    If lo_Product.RPL_CoilW = 0 Then
      If GetProductCoilIndex(ata_Coil, lo_Product) = al_CoilIndex Then
        ExistsUnassignedProduct = True
        Exit Function
      End If
    End If
  Next
  Exit Function
ErrHandler:
  Call ErrorHandler("ExistsUnassignedProduct")
End Function

'Private Sub AssignProductToCoilWidth(ByRef ata_Coil() As tDPC_Coil, ByVal al_MatIdx As Long, ByVal ad_Width As Double, ByVal ao_Product As DPC_Product)
'On Error GoTo ErrHandler
'
'  Exit Sub
'ErrHandler:
'  Call errorHandler("AssignProductToCoilWidth")
'End Sub

Private Function AssignCollectionToCoilWidth(ByVal ao_Db As Object, ByVal ac_CoilCursor As Long, ByRef ata_Coil As tDPC_Coil, ByVal ad_Width As Double, ByVal ao_Products As Collection, ByVal ao_ErrCollection As Collection) As Boolean
On Error GoTo ErrHandler

Dim lo_Product As DPC_Product
 
  AssignCollectionToCoilWidth = False
  If Not AssignCoilAttributes(ao_Db, ac_CoilCursor, ata_Coil, ad_Width, ao_Products, ao_ErrCollection) Then
    Exit Function
  End If
  For Each lo_Product In ao_Products
    lo_Product.RPL_CoilW = ad_Width
'    Call AssignProductToCoilWidth(ata_Coil, al_MatIdx, ad_Width, lo_Product)
  Next
  AssignCollectionToCoilWidth = True
  Exit Function
ErrHandler:
  Call ErrorHandler("AssignCollectionToCoilWidth")
End Function

Private Function AssignCoilAttributes(ByVal ao_Db As Object, ByVal ac_CoilCursor As Long, ByRef ata_Coil As tDPC_Coil, ByVal ad_CoilWidth As Double, ByVal ao_PrdCollection As Collection, ByVal ao_ErrCollection As Collection) As Boolean
On Error GoTo ErrHandler

Dim lo_Product As DPC_Product
Dim ld_SpecWeight As Double, ld_WasteFactor As Double
Dim lb_IsStock As Boolean
Dim ls_IdentNr As String
Dim ls_COI_Code As String
  
  AssignCoilAttributes = False
  ld_SpecWeight = 0
  ld_WasteFactor = 0
  lb_IsStock = False
  ls_IdentNr = ""
  ls_COI_Code = ""
  ' check if we are on the correct coil width
  If Round(ao_Db.GetFields(ac_CoilCursor, "Width"), 2) = Round(ad_CoilWidth, 2) Then
    ld_SpecWeight = ao_Db.GetFields(ac_CoilCursor, "SpecWeight")
    ld_WasteFactor = ao_Db.GetFields(ac_CoilCursor, "WasteFactor") / 100
    lb_IsStock = StrComp(ao_Db.GetFields(ac_CoilCursor, "StandardCoil"), "L", vbTextCompare) = 0
    ls_IdentNr = ao_Db.GetFields(ac_CoilCursor, "IdentNr")
    ls_COI_Code = ls_IdentNr
  Else
    ' if not try to find correct coil width
    If ao_Db.Find(ac_CoilCursor, "Width", ad_CoilWidth) >= 0 Then
      ld_SpecWeight = ao_Db.GetFields(ac_CoilCursor, "SpecWeight")
      ld_WasteFactor = ao_Db.GetFields(ac_CoilCursor, "WasteFactor") / 100
      lb_IsStock = StrComp(ao_Db.GetFields(ac_CoilCursor, "StandardCoil"), "L", vbTextCompare) = 0
      ls_IdentNr = ao_Db.GetFields(ac_CoilCursor, "IdentNr")
      ls_COI_Code = ls_IdentNr
    Else
      ld_SpecWeight = ata_Coil.DefaultSpecWeight
      ld_WasteFactor = ata_Coil.DefaultWasteFactor
      lb_IsStock = False
      ls_IdentNr = ata_Coil.CoilTemplateIdentNr
      ls_COI_Code = ""
    End If
  End If
  
  If (ld_SpecWeight <= 0) Or (ld_WasteFactor <= 0) Then
    ld_SpecWeight = ata_Coil.DefaultSpecWeight
    ld_WasteFactor = ata_Coil.DefaultWasteFactor
'    Call mo_Tools.AddCheckError(eDPCError.erBOMMaterialSpecWeightZero, ms_Language_Code, ao_ErrCollection, Nothing, Nothing, Array("$OFD_Pos$"), Array(ls_IdentNr))
'    Exit Function
  End If
  
  For Each lo_Product In ao_PrdCollection
    If ls_COI_Code = "" Then
      lo_Product.COI_Code = DPC_BOM_NEW_IDENTNR
      lo_Product.COI_CodeTmp = ls_IdentNr
    Else
      lo_Product.COI_Code = ls_COI_Code
      lo_Product.COI_CodeTmp = ""
    End If
    lo_Product.COI_SpcWgh = ld_SpecWeight
    lo_Product.COI_WasteFact = ld_WasteFactor
    lo_Product.COI_IsStock = lb_IsStock
  Next
  AssignCoilAttributes = True
  Exit Function
ErrHandler:
  Call ErrorHandler("AssignCoilAttributes")
End Function

Private Function CalculateMatWeight(ByRef ata_Coil As tDPC_Coil, ByVal ad_CoilWidth As Double, ByVal ao_Collection As Collection) As Double
On Error GoTo ErrHandler

Dim lo_Product As DPC_Product
Dim ld_Weight As Double
Dim ld_CutA As Double
Dim ld_Volume As Double
  
  ld_Weight = 0
  For Each lo_Product In ao_Collection
    
    If lo_Product.RPL_CutA = 0 Then
      ld_CutA = lo_Product.GetCutA
    Else
      ld_CutA = lo_Product.RPL_CutA
    End If
    
    ld_Volume = (ad_CoilWidth / 1000) * (ld_CutA / 1000) * lo_Product.RPL_Thick * lo_Product.COI_SpcWgh    'volume of material
    ld_Weight = ld_Weight + (lo_Product.PanelQtyPCS + lo_Product.COI_WasteQty) * (1 + lo_Product.COI_WasteFact) * ld_Volume  'weight of material in kg
  Next
  CalculateMatWeight = ld_Weight
  Exit Function
ErrHandler:
  Call ErrorHandler("CalculateMatWeight")
End Function

Private Function OptimizeCoilWidth(ByVal ao_Db As Object, ByVal ao_PrdCollection As Collection, ByVal ao_ErrCollection As Collection) As Boolean
On Error GoTo ErrHandler

Dim lta_Coil() As tDPC_Coil
Dim lo_Product As DPC_Product
Dim lo_PosProduct As DPC_Product
Dim ll_CoilTypeIdx As Long
Dim ll_CoilWidthStep As Long
Dim ll_MaxCutSize As Long
Dim ll_MaxOrderQty As Long
Dim ll_CoilMaxCut As Long
Dim ld_Width As Double
Dim ld_Qty As Double
Dim lo_CoilProducts As New Collection
Dim lc_CoilCursor As Long

  OptimizeCoilWidth = False
  ' clear coil width information
  For Each lo_Product In ao_PrdCollection
    If Not LoadCoilMatInfo(ao_Db, lo_Product) Then
      Exit Function
    End If
    If (lo_Product.RPL_CoWMin = 0 Or lo_Product.RPL_CoWMax = 0) Then
      Call mo_Tools.AddCheckError(eDPCError.erMandatoryCoilWMinMax, ms_Language_Code, ao_ErrCollection, Nothing, Nothing, Array("$OFD_Pos$"), Array(lta_Coil(ll_CoilTypeIdx).CoilTemplateIdentNr))
      'this is error, coil cannot be calculated for this product
      Exit Function
    End If
    If (lo_Product.RPL_CutA = 0 And lo_Product.GetCutA = 0) Then
      Call mo_Tools.AddCheckError(eDPCError.erMandatoryCutAB, ms_Language_Code, ao_ErrCollection, Nothing, Nothing, Array("$OFD_Pos$"), Array(lta_Coil(ll_CoilTypeIdx).CoilTemplateIdentNr))
      'this is error, coil cannot be calculated for this product
      Exit Function
    End If
    lo_Product.COI_WasteQty = lo_Product.LoadWasteQty(eDPCBOMMaterial.bcCoil, lo_Product.PanelQtyPCS)
    lo_Product.MAT_CoilTypeIdx = -1
    lo_Product.COI_SpcWgh = 0
    lo_Product.COI_WasteFact = 0
    lo_Product.COI_Code = ""
    lo_Product.COI_CodeTmp = ""
  Next
  
  Call InitCoilIndex(lta_Coil, ao_PrdCollection)
  
  For ll_CoilTypeIdx = 0 To UBound(lta_Coil)
  
    lc_CoilCursor = GetCoilCursor(ao_Db, lta_Coil(ll_CoilTypeIdx).Thickness, lta_Coil(ll_CoilTypeIdx).MAT_Prefx, lta_Coil(ll_CoilTypeIdx).RPL_MatTyp)
    If ao_Db.RowCount(lc_CoilCursor) = 0 Then
      Exit Function
    End If
    
'    lta_Coil(ll_CoilTypeIdx).SpecWeight = ao_Db.GetFields(lc_CoilCursor, "SpecWeight")
'    lta_Coil(ll_CoilTypeIdx).WasteFactor = ao_Db.GetFields(lc_CoilCursor, "WasteFactor") / 100
        
'    If (lta_Coil(ll_CoilTypeIdx).SpecWeight <= 0) Or (lta_Coil(ll_CoilTypeIdx).WasteFactor <= 0) Then
'      Call mo_Tools.AddCheckError(eDPCError.erBOMMaterialSpecWeightZero, ms_Language_Code, ao_ErrCollection, Nothing, Nothing, Array("$OFD_Pos$"), Array(ao_Db.GetFields(lc_CoilCursor, "IdentNr")))
'      Exit Function
'    Else
'      For Each lo_Product In ao_PrdCollection
'        If (lo_Product.MAT_CoilTypeIdx = ll_CoilTypeIdx) And (lo_Product.COI_SpcWgh = 0) Then
'          lo_Product.COI_SpcWgh = lta_Coil(ll_CoilTypeIdx).SpecWeight
'        End If
'      Next
'    End If
    
    ll_CoilWidthStep = lta_Coil(ll_CoilTypeIdx).MAT_WiStep
    ll_CoilMaxCut = lta_Coil(ll_CoilTypeIdx).MAT_MaxCut
    ll_MaxOrderQty = lta_Coil(ll_CoilTypeIdx).MAT_OrdQty
    If ao_Db.Find(lc_CoilCursor, "IdentNr", lta_Coil(ll_CoilTypeIdx).CoilTemplateIdentNr) >= 0 Then
      lta_Coil(ll_CoilTypeIdx).DefaultSpecWeight = ao_Db.GetFields(lc_CoilCursor, "SpecWeight")
      lta_Coil(ll_CoilTypeIdx).DefaultWasteFactor = ao_Db.GetFields(lc_CoilCursor, "WasteFactor")
      If (lta_Coil(ll_CoilTypeIdx).DefaultSpecWeight <= 0) Or (lta_Coil(ll_CoilTypeIdx).DefaultWasteFactor <= 0) Then
        Call mo_Tools.AddCheckError(eDPCError.erBOMMaterialSpecWeightZero, ms_Language_Code, ao_ErrCollection, Nothing, Nothing, Array("$OFD_Pos$"), Array(lta_Coil(ll_CoilTypeIdx).CoilTemplateIdentNr))
        Exit Function
      End If
    End If
        
    'this rule must be false, otherwise some panels width could not be made from coil in width in step of ll_CoilWidthStep
    If ll_CoilMaxCut <= (ll_CoilWidthStep / 2) Then
      Exit Function
    End If
    
    '1. loop, find if we do not have coil with direct order qty MAT_OrdQty from "Stock" coil without cut in step 1
    If lta_Coil(ll_CoilTypeIdx).MAT_OrdQty > 0 Then
      Do
        lta_Coil(ll_CoilTypeIdx).MaxQty = 0
        lta_Coil(ll_CoilTypeIdx).Width = 0
        Call mo_Tools.ClearCollection(lta_Coil(ll_CoilTypeIdx).Products)
        Call ao_Db.First(lc_CoilCursor)
        While Not ao_Db.EOF(lc_CoilCursor)
          If StrComp(ao_Db.GetFields(lc_CoilCursor, "StandardCoil"), "L", vbTextCompare) = 0 Then
            ld_Width = ao_Db.GetFields(lc_CoilCursor, "Width")
            Call mo_Tools.ClearCollection(lo_CoilProducts)
            
            For Each lo_Product In ao_PrdCollection
              If (lo_Product.MAT_CoilTypeIdx = ll_CoilTypeIdx) And (lo_Product.RPL_CoilW = 0) And (ld_Width >= lo_Product.RPL_CoWMin) Then
                If (ld_Width <= lo_Product.RPL_CoWMax) Then
                  Call lo_CoilProducts.Add(lo_Product)
                End If
              End If
            Next
            
            If lo_CoilProducts.Count > 0 Then
              If Not AssignCoilAttributes(ao_Db, lc_CoilCursor, lta_Coil(ll_CoilTypeIdx), ld_Width, lo_CoilProducts, ao_ErrCollection) Then
                Exit Function
              End If
              ' find the maximum unassigned material weight
              ld_Qty = CalculateMatWeight(lta_Coil(ll_CoilTypeIdx), ld_Width, lo_CoilProducts)
              If ld_Qty >= lta_Coil(ll_CoilTypeIdx).MaxQty Then
                lta_Coil(ll_CoilTypeIdx).MaxQty = ld_Qty
                lta_Coil(ll_CoilTypeIdx).Width = ld_Width
                Call mo_Tools.ClearCollection(lta_Coil(ll_CoilTypeIdx).Products)
                Call mo_Tools.CopyCollection(lo_CoilProducts, lta_Coil(ll_CoilTypeIdx).Products)
              End If
            End If
          End If
          Call ao_Db.Next(lc_CoilCursor)
        Wend
        If (lta_Coil(ll_CoilTypeIdx).Products.Count > 0) And (lta_Coil(ll_CoilTypeIdx).MaxQty >= ll_MaxOrderQty) Then
          If Not AssignCollectionToCoilWidth(ao_Db, lc_CoilCursor, lta_Coil(ll_CoilTypeIdx), lta_Coil(ll_CoilTypeIdx).Width, lta_Coil(ll_CoilTypeIdx).Products, ao_ErrCollection) Then
            Exit Function
          End If
        End If
      Loop While lta_Coil(ll_CoilTypeIdx).MaxQty >= ll_MaxOrderQty
    
      If ExistsUnassignedProduct(ao_PrdCollection, lta_Coil, ll_CoilTypeIdx) Then
        '2. loop, find if we do not have coil with direct order qty MAT_OrdQty from stepped coil without cut in step 1
        Do
          lta_Coil(ll_CoilTypeIdx).MaxQty = 0
          lta_Coil(ll_CoilTypeIdx).Width = 0
          Call mo_Tools.ClearCollection(lta_Coil(ll_CoilTypeIdx).Products)
          For ld_Width = ((lta_Coil(ll_CoilTypeIdx).MaxWidth \ ll_CoilWidthStep) + 1) * ll_CoilWidthStep To ((lta_Coil(ll_CoilTypeIdx).MinWidth \ ll_CoilWidthStep) - 1) * ll_CoilWidthStep Step -ll_CoilWidthStep
            
            Call mo_Tools.ClearCollection(lo_CoilProducts)
            For Each lo_Product In ao_PrdCollection
              If (lo_Product.MAT_CoilTypeIdx = ll_CoilTypeIdx) And (lo_Product.RPL_CoilW = 0) And (ld_Width >= lo_Product.RPL_CoWMin) Then
                If (ld_Width <= lo_Product.RPL_CoWMax) Then
                  Call lo_CoilProducts.Add(lo_Product)
                End If
              End If
            Next
            If lo_CoilProducts.Count > 0 Then
              If Not AssignCoilAttributes(ao_Db, lc_CoilCursor, lta_Coil(ll_CoilTypeIdx), ld_Width, lo_CoilProducts, ao_ErrCollection) Then
                Exit Function
              End If
              ' find the maximum unassigned material weight
              ld_Qty = CalculateMatWeight(lta_Coil(ll_CoilTypeIdx), ld_Width, lo_CoilProducts)
              If ld_Qty >= lta_Coil(ll_CoilTypeIdx).MaxQty Then
                lta_Coil(ll_CoilTypeIdx).MaxQty = ld_Qty
                lta_Coil(ll_CoilTypeIdx).Width = ld_Width
                Call mo_Tools.ClearCollection(lta_Coil(ll_CoilTypeIdx).Products)
                Call mo_Tools.CopyCollection(lo_CoilProducts, lta_Coil(ll_CoilTypeIdx).Products)
              End If
            End If
          Next
          If lta_Coil(ll_CoilTypeIdx).MaxQty >= ll_MaxOrderQty Then
            If Not AssignCollectionToCoilWidth(ao_Db, lc_CoilCursor, lta_Coil(ll_CoilTypeIdx), lta_Coil(ll_CoilTypeIdx).Width, lta_Coil(ll_CoilTypeIdx).Products, ao_ErrCollection) Then
              Exit Function
            End If
          End If
        Loop While lta_Coil(ll_CoilTypeIdx).MaxQty >= ll_MaxOrderQty
      End If
    
      If ExistsUnassignedProduct(ao_PrdCollection, lta_Coil, ll_CoilTypeIdx) Then
        '3. loop, find if we do not have coil with direct order qty MAT_OrdQty any coil without cut in step 1
        Do
          lta_Coil(ll_CoilTypeIdx).MaxQty = 0
          lta_Coil(ll_CoilTypeIdx).Width = 0
          Call mo_Tools.ClearCollection(lta_Coil(ll_CoilTypeIdx).Products)
          For ld_Width = lta_Coil(ll_CoilTypeIdx).MaxWidth To lta_Coil(ll_CoilTypeIdx).MinWidth Step -1
            
            Call mo_Tools.ClearCollection(lo_CoilProducts)
            For Each lo_Product In ao_PrdCollection
              If (lo_Product.MAT_CoilTypeIdx = ll_CoilTypeIdx) And (lo_Product.RPL_CoilW = 0) And (ld_Width >= lo_Product.RPL_CoWMin) Then
                If (ld_Width <= lo_Product.RPL_CoWMax) Then
                  Call lo_CoilProducts.Add(lo_Product)
                End If
              End If
            Next
            If lo_CoilProducts.Count > 0 Then
              If Not AssignCoilAttributes(ao_Db, lc_CoilCursor, lta_Coil(ll_CoilTypeIdx), ld_Width, lo_CoilProducts, ao_ErrCollection) Then
                Exit Function
              End If
              ' find the maximum unassigned material weight
              ld_Qty = CalculateMatWeight(lta_Coil(ll_CoilTypeIdx), ld_Width, lo_CoilProducts)
              If ld_Qty >= lta_Coil(ll_CoilTypeIdx).MaxQty Then
                lta_Coil(ll_CoilTypeIdx).MaxQty = ld_Qty
                lta_Coil(ll_CoilTypeIdx).Width = ld_Width
                Call mo_Tools.ClearCollection(lta_Coil(ll_CoilTypeIdx).Products)
                Call mo_Tools.CopyCollection(lo_CoilProducts, lta_Coil(ll_CoilTypeIdx).Products)
              End If
            End If
          Next
          If lta_Coil(ll_CoilTypeIdx).MaxQty >= ll_MaxOrderQty Then
            If Not AssignCollectionToCoilWidth(ao_Db, lc_CoilCursor, lta_Coil(ll_CoilTypeIdx), lta_Coil(ll_CoilTypeIdx).Width, lta_Coil(ll_CoilTypeIdx).Products, ao_ErrCollection) Then
              Exit Function
            End If
          End If
        Loop While lta_Coil(ll_CoilTypeIdx).MaxQty >= ll_MaxOrderQty
      End If
    End If
        
    If ExistsUnassignedProduct(ao_PrdCollection, lta_Coil, ll_CoilTypeIdx) Then
      ' then loop over all StandardCoil = "L" (StockCoils)
      Call ao_Db.First(lc_CoilCursor)
      While Not ao_Db.EOF(lc_CoilCursor)
        If StrComp(ao_Db.GetFields(lc_CoilCursor, "StandardCoil"), "L", vbTextCompare) = 0 Then
          ld_Width = ao_Db.GetFields(lc_CoilCursor, "Width")
          Call mo_Tools.ClearCollection(lo_CoilProducts)
          For Each lo_Product In ao_PrdCollection
            If (lo_Product.MAT_CoilTypeIdx = ll_CoilTypeIdx) And (lo_Product.RPL_CoilW = 0) And (ld_Width >= lo_Product.RPL_CoWMin) Then
              If ld_Width <= lo_Product.RPL_CoWMax Then
                Call lo_CoilProducts.Add(lo_Product)
                'Call AssignProductToCoilWidth(lta_Coil, ll_CoilTypeIdx, ld_Width, lo_Product)
              ElseIf (ld_Width - lo_Product.RPL_CoWMin <= ll_CoilMaxCut) Then
                Call lo_CoilProducts.Add(lo_Product)
                'Call AssignProductToCoilWidth(lta_Coil, ll_CoilTypeIdx, ld_Width, lo_Product)
              ElseIf (ld_Width >= lo_Product.RPL_CoWMax) And (ld_Width - lo_Product.RPL_CoWMax <= ll_CoilMaxCut) Then
                Call lo_CoilProducts.Add(lo_Product)
                'Call AssignProductToCoilWidth(lta_Coil, ll_CoilTypeIdx, ld_Width, lo_Product)
              End If
            End If
          Next
          If lo_CoilProducts.Count > 0 Then
            If Not AssignCollectionToCoilWidth(ao_Db, lc_CoilCursor, lta_Coil(ll_CoilTypeIdx), ld_Width, lo_CoilProducts, ao_ErrCollection) Then
              Exit Function
            End If
          End If
        End If
        Call ao_Db.Next(lc_CoilCursor)
      Wend
    End If
    
    If ExistsUnassignedProduct(ao_PrdCollection, lta_Coil, ll_CoilTypeIdx) Then
      ' loop over all existing positions and find one within RPL_MaxCut dimension
      For Each lo_PosProduct In ao_PrdCollection
        ld_Width = lo_PosProduct.RPL_CoilW
        If (lo_PosProduct.MAT_CoilTypeIdx = ll_CoilTypeIdx) And (ld_Width > 0) Then
          Call mo_Tools.ClearCollection(lo_CoilProducts)
          For Each lo_Product In ao_PrdCollection
            If (lo_Product.MAT_CoilTypeIdx = ll_CoilTypeIdx) And (lo_Product.RPL_CoilW = 0) And (ld_Width >= lo_Product.RPL_CoWMin) Then
              If (ld_Width - lo_Product.RPL_CoWMin <= ll_CoilMaxCut) Then
                Call lo_CoilProducts.Add(lo_Product)
                'Call AssignProductToCoilWidth(lta_Coil, ll_CoilTypeIdx, ld_Width, lo_Product)
              ElseIf (ld_Width >= lo_Product.RPL_CoWMax) And (ld_Width - lo_Product.RPL_CoWMax <= ll_CoilMaxCut) Then
                Call lo_CoilProducts.Add(lo_Product)
                'Call AssignProductToCoilWidth(lta_Coil, ll_CoilTypeIdx, ld_Width, lo_Product)
              End If
            End If
          Next
          If lo_CoilProducts.Count > 0 Then
            If Not AssignCollectionToCoilWidth(ao_Db, lc_CoilCursor, lta_Coil(ll_CoilTypeIdx), ld_Width, lo_CoilProducts, ao_ErrCollection) Then
              Exit Function
            End If
          End If
        End If
      Next
    End If
    
    If ExistsUnassignedProduct(ao_PrdCollection, lta_Coil, ll_CoilTypeIdx) Then
      ' if there is still some unassigned coil, try to find any coil in step ll_CoilWidthStep optimized for position qty
      Do
        lta_Coil(ll_CoilTypeIdx).MaxQty = 0
        lta_Coil(ll_CoilTypeIdx).Width = 0
        Call mo_Tools.ClearCollection(lta_Coil(ll_CoilTypeIdx).Products)
        For ld_Width = ((lta_Coil(ll_CoilTypeIdx).MaxWidth \ ll_CoilWidthStep) + 1) * ll_CoilWidthStep To ((lta_Coil(ll_CoilTypeIdx).MinWidth \ ll_CoilWidthStep) - 1) * ll_CoilWidthStep Step -ll_CoilWidthStep
          ld_Qty = 0
          Call mo_Tools.ClearCollection(lo_CoilProducts)
          For Each lo_Product In ao_PrdCollection
            If (lo_Product.MAT_CoilTypeIdx = ll_CoilTypeIdx) And (lo_Product.RPL_CoilW = 0) And (ld_Width >= lo_Product.RPL_CoWMin) Then
              If ld_Width <= lo_Product.RPL_CoWMax Then
                Call lo_CoilProducts.Add(lo_Product)
                ld_Qty = ld_Qty + 1
              ElseIf (ld_Width - lo_Product.RPL_CoWMin <= ll_CoilMaxCut) Then
                Call lo_CoilProducts.Add(lo_Product)
                ld_Qty = ld_Qty + 1
              ElseIf (ld_Width >= lo_Product.RPL_CoWMax) And (ld_Width - lo_Product.RPL_CoWMax <= ll_CoilMaxCut) Then
                Call lo_CoilProducts.Add(lo_Product)
                ld_Qty = ld_Qty + 1
              End If
            End If
          Next
          If ld_Qty >= lta_Coil(ll_CoilTypeIdx).MaxQty Then
            lta_Coil(ll_CoilTypeIdx).MaxQty = ld_Qty
            lta_Coil(ll_CoilTypeIdx).Width = ld_Width
            Call mo_Tools.ClearCollection(lta_Coil(ll_CoilTypeIdx).Products)
            Call mo_Tools.CopyCollection(lo_CoilProducts, lta_Coil(ll_CoilTypeIdx).Products)
          End If
        Next
        If Not AssignCollectionToCoilWidth(ao_Db, lc_CoilCursor, lta_Coil(ll_CoilTypeIdx), lta_Coil(ll_CoilTypeIdx).Width, lta_Coil(ll_CoilTypeIdx).Products, ao_ErrCollection) Then
          Exit Function
        End If
      Loop While ExistsUnassignedProduct(ao_PrdCollection, lta_Coil, ll_CoilTypeIdx)
    End If
    
    For Each lo_Product In ao_PrdCollection
      If (lo_Product.MAT_CoilTypeIdx = ll_CoilTypeIdx) And (lo_Product.RPL_CoilW > 0) And (lo_Product.COI_Code = "") Then
        Call mo_Tools.ClearCollection(lo_CoilProducts)
        Call lo_CoilProducts.Add(lo_Product)
        If Not AssignCoilAttributes(ao_Db, lc_CoilCursor, lta_Coil(ll_CoilTypeIdx), lo_Product.RPL_CoilW, lo_CoilProducts, ao_ErrCollection) Then
          Exit Function
        End If
      End If
    Next
    
    Call mo_Tools.ClearCollection(lo_CoilProducts)
    Call mo_Tools.ClearCollection(lta_Coil(ll_CoilTypeIdx).Products)
    Call ao_Db.Close(lc_CoilCursor)
  Next
  
  For Each lo_Product In ao_PrdCollection
    If (lo_Product.RPL_CoilW > 0) And (lo_Product.MAT_CoilTypeIdx >= 0) Then
      If lo_Product.RPL_CoilW > lo_Product.RPL_CoWMax Then
        Call lo_Product.CalcBendSizeU(lo_Product.RPL_CoWMax)
      Else
        Call lo_Product.CalcBendSizeU(lo_Product.RPL_CoilW)
      End If
      Call lo_Product.CalculateCutAB
      'Call FindCoil(ao_Db, lo_Product, ao_ErrCollection)
    End If
  Next
  
  For Each lo_Product In ao_PrdCollection
    If StrComp(lo_Product.COI_Code, DPC_BOM_NEW_IDENTNR, vbTextCompare) = 0 Then
      Call mo_Tools.AddCheckError(eDPCError.erBOMCoilBaeurerExport, ms_Language_Code, ao_ErrCollection, lo_Product)
    End If
    If (lo_Product.RPL_CoilW = 0) Or (lo_Product.MAT_CoilTypeIdx < 0) Or (lo_Product.COI_Code = "") Then
      Call mo_Tools.AddCheckError(eDPCError.erCoilSizeInvalid, ms_Language_Code, ao_ErrCollection, Nothing, Nothing, Array("$OFD_Pos$"), Array(lo_Product.OFD_Pos))
      Exit Function
    End If
    If (lo_Product.RPL_CutA = 0) Or (lo_Product.RPL_CutB = 0) Then
      Call mo_Tools.AddCheckError(eDPCError.erCoilCutABInvalid, ms_Language_Code, ao_ErrCollection, Nothing, Nothing, Array("$OFD_Pos$"), Array(lo_Product.OFD_Pos))
      Exit Function
    End If
    If (lo_Product.RPL_CutB > lo_Product.RPL_CoilW) Then
      Call mo_Tools.AddCheckError(eDPCError.erCoilSizeInvalid, ms_Language_Code, ao_ErrCollection, Nothing, Nothing, Array("$OFD_Pos$"), Array(lo_Product.OFD_Pos))
      Exit Function
    End If
    If (lo_Product.RPL_CoWMin > lo_Product.RPL_CoilW) Or (lo_Product.RPL_CoilW > lo_Product.RPL_CoWMax + lta_Coil(lo_Product.MAT_CoilTypeIdx).MAT_MaxCut) Then
      Call mo_Tools.AddCheckError(eDPCError.erCoilSizeInvalid, ms_Language_Code, ao_ErrCollection, Nothing, Nothing, Array("$OFD_Pos$"), Array(lo_Product.OFD_Pos))
      Exit Function
    End If
  Next
  OptimizeCoilWidth = True
  Exit Function
ErrHandler:
  Call ErrorHandler("OptimizeCoilWidth")
End Function

Private Function LoadCoilMatInfo(ByVal ao_Db As Object, ByVal ao_Product As DPC_Product) As Boolean
On Error GoTo ErrHandler

Dim ls_Request As String
Dim lc_Cursor As Long
  
  LoadCoilMatInfo = False
  ao_Product.MAT_Prefx = ""
  ao_Product.RPL_MatTyp = ""
  ao_Product.MAT_OrdQty = 0
  ao_Product.MAT_WiStep = 0
  ao_Product.MAT_MaxCut = 0
  
  ls_Request = "SELECT MAT_Prefx,MAT_Werk,MAT_OrdQty,MAT_WiStep,MAT_MaxCut FROM DPC_Material WHERE MAT_Id=$MAT_Id$"
  ls_Request = Replace(ls_Request, "$MAT_Id$", mo_Tools.SqlInt(ao_Product.MAT_Id), , , vbTextCompare)
  lc_Cursor = mo_Tools.OpenSQLSafe(mo_Db, ls_Request)
  If mo_Db.RowCount(lc_Cursor) = 1 Then
    ao_Product.MAT_Prefx = mo_Db.GetFields(lc_Cursor, "MAT_Prefx")
    ao_Product.RPL_MatTyp = mo_Db.GetFields(lc_Cursor, "MAT_Werk")
    ao_Product.MAT_OrdQty = mo_Db.GetFields(lc_Cursor, "MAT_OrdQty")
    ao_Product.MAT_WiStep = mo_Db.GetFields(lc_Cursor, "MAT_WiStep")
    ao_Product.MAT_MaxCut = mo_Db.GetFields(lc_Cursor, "MAT_MaxCut")
    LoadCoilMatInfo = True
  End If
  Call mo_Db.Close(lc_Cursor)
  
  ls_Request = "SELECT MAT_Werk "
  ls_Request = ls_Request & "FROM DPC_BOM_Material "
  ls_Request = ls_Request & "WHERE (MAT_Id=$MAT_Id$) AND "
  ls_Request = ls_Request & "(PRF_Id=$PRF_Id$ OR (PRF_Id IS NULL AND $PRF_Id$ IS NULL)) AND "
  ls_Request = ls_Request & "((ROUND(ThickMin,2) < $Thickness$ AND $Thickness$ <= ROUND(ThickMax,2)) OR (ROUND(ThickMin,2) = $Thickness$ AND $Thickness$ = ROUND(ThickMax,2)))"
  
  ls_Request = Replace(ls_Request, "$MAT_Id$", mo_Tools.SqlInt(ao_Product.MAT_Id), , , vbTextCompare)
  ls_Request = Replace(ls_Request, "$PRF_Id$", mo_Tools.SqlStrKey(ao_Product.PRF_Id), , , vbTextCompare)
  ls_Request = Replace(ls_Request, "$Thickness$", mo_Tools.SqlDbl(ao_Product.RPL_Thick), , , vbTextCompare)
  
  lc_Cursor = mo_Tools.OpenSQLSafe(mo_Db, ls_Request)
  If mo_Db.RowCount(lc_Cursor) = 1 Then
    ao_Product.RPL_MatTyp = mo_Db.GetFields(lc_Cursor, "MAT_Werk")
  End If
  Call mo_Db.Close(lc_Cursor)
  Exit Function
ErrHandler:
  Call ErrorHandler("LoadCoilMatInfo")
End Function

Private Function GetCoilCursor(ByVal ao_Db As Object, ByVal ad_RPL_Thick As Double, ByVal as_MAT_Prefx As String, ByVal as_MAT_Type As String) As Long
On Error GoTo ErrHandler

Dim ls_req As String

  ls_req = "SELECT DISTINCT "
  ls_req = ls_req & "g000.identnr, g0402.ben, g000.me, g0402.werkstoff,"
  ls_req = ls_req & "g711StdCoil.ausprtxt as StandardCoil, ROUND(g711Width.ausprfloat,2) as Width,"
  ls_req = ls_req & "ROUND(g711Thick.ausprfloat,2) as Thickness, g711SpecWeight.ausprfloat  as SpecWeight,"
  ls_req = ls_req & "g711WasteMaterial.ausprfloat as WasteFactor,"
  ls_req = ls_req & "g023.vpreis, g030.pevk, g040.ts "
  ls_req = ls_req & "FROM g000 "
  ls_req = ls_req & "LEFT JOIN g040 ON (g000.fi_nr = g040.fi_nr AND g000.identnr = g040.identnr ) "
  ls_req = ls_req & "LEFT JOIN g0402 ON (g000.fi_nr = g0402.fi_nr AND g000.identnr = g0402.identnr and g0402.lang_ext ='de_de') "
  ls_req = ls_req & "LEFT JOIN g711 as g711Width ON (g000.objektid = g711Width.objektid and g711Width.kritnr = 12) "
  ls_req = ls_req & "LEFT JOIN g711 as g711Thick ON (g000.objektid = g711Thick.objektid and g711Thick.kritnr = 17) "
  ls_req = ls_req & "LEFT JOIN g711 as g711SpecWeight ON (g000.objektid = g711SpecWeight.objektid and g711SpecWeight.kritnr = 20) "
  ls_req = ls_req & "LEFT JOIN g711 as g711WasteMaterial ON (g000.objektid = g711WasteMaterial.objektid and g711WasteMaterial.kritnr = 1175) "
  ls_req = ls_req & "LEFT JOIN g020 ON (g000.identnr = g020.identnr) "
  ls_req = ls_req & "LEFT JOIN g711 as g711StdCoil ON (g000.objektid = g711StdCoil.objektid and g711StdCoil.kritnr = 1181) "
  ls_req = ls_req & "LEFT JOIN g023 ON (g000.fi_nr = g023.fi_nr AND g000.identnr = g023.identnr) "
  ls_req = ls_req & "LEFT JOIN g030 on (g000.identnr = g030.identnr AND g000.fi_nr = g030.fi_nr) "
  ls_req = ls_req & "WHERE "
  ls_req = ls_req & "(g000.identnr LIKE $MAT_Pefx$) AND "
  ls_req = ls_req & "(g0402.werkstoff = $MAT_Werk$ OR ($MAT_Werk$ IS NULL)) AND "
  ls_req = ls_req & "(ROUND(g711Thick.ausprfloat,2) = $RPL_Thick$) AND "
  ls_req = ls_req & "(g040.ts = $ts$) AND "
  ls_req = ls_req & "(g020.lgnr = $lgnr$) "
  ls_req = ls_req & "ORDER BY ROUND(g711Width.ausprfloat,2)"

  ls_req = Replace(ls_req, "$MAT_Pefx$", mo_Tools.SQLStr(as_MAT_Prefx & "%"), , , vbTextCompare)
  If Trim(as_MAT_Type) = "" Then
    ls_req = Replace(ls_req, "$MAT_Werk$", "NULL", , , vbTextCompare)
  Else
    ls_req = Replace(ls_req, "$MAT_Werk$", mo_Tools.SQLStr(as_MAT_Type), , , vbTextCompare)
  End If
  ls_req = Replace(ls_req, "$ts$", mo_Tools.SQLStr(eDPCB7ArticleStatus.asActive), , , vbTextCompare)
  ls_req = Replace(ls_req, "$lgnr$", mo_Tools.SqlInt(0), , , vbTextCompare)
  ls_req = Replace(ls_req, "$RPL_Thick$", mo_Tools.SqlDbl(ad_RPL_Thick), , , vbTextCompare)
  GetCoilCursor = mo_Tools.OpenSQLSafe(ao_Db, ls_req)
  Exit Function
ErrHandler:
  Call ErrorHandler("GetCoilCursor")
End Function

Private Function GetCoilThicknessPrefix(ByVal ad_RPL_Thick As Double) As String
On Error GoTo ErrHandler

Dim ls_ThickPrefix As String

  ls_ThickPrefix = Trim(Str(ad_RPL_Thick))
  If Left(ls_ThickPrefix, 1) = "." Then ls_ThickPrefix = "0" & ls_ThickPrefix
  ls_ThickPrefix = Replace(ls_ThickPrefix, ".", "")
  GetCoilThicknessPrefix = ls_ThickPrefix
  Exit Function
ErrHandler:
  Call ErrorHandler("GetCoilThicknessPrefix")
End Function

Private Function GetCoilTemplateIdentNr(ByVal as_MAT_Prefx As String, ByVal as_RPL_MatTyp As String, ByVal ad_RPL_Thick As Double) As String
On Error GoTo ErrHandler

  GetCoilTemplateIdentNr = as_MAT_Prefx & GetCoilThicknessPrefix(ad_RPL_Thick) & as_RPL_MatTyp
  Exit Function
ErrHandler:
  Call ErrorHandler("GetCoilTemplateIdentNr")
End Function

'Private Function FindCoil(ByVal ao_Db As Object, ByVal ao_Product As DPC_Product, ByVal ao_ErrCollection As Collection) As Boolean
'On Error GoTo ErrHandler
'
'Dim ls_req As String
'Dim lc_Cursor As Long
'Dim ll_Count As Long
'
'  FindCoil = False
'  If (ao_Product.MAT_Prefx <> "") And (ao_Product.RPL_CoilW > 0) And (ao_Product.RPL_Thick > 0) Then
'
'    ls_req = "SELECT DISTINCT "
'    ls_req = ls_req & "g000.identnr, g0402.ben, g000.me, g0402.werkstoff,"
'    ls_req = ls_req & "g711StdCoil.ausprtxt as StandardCoil, ROUND(g711Width.ausprfloat,2) as Width,"
'    ls_req = ls_req & "ROUND(g711Thick.ausprfloat,2) as Thickness, g711SpecWeight.ausprfloat  as SpecWeight,"
'    ls_req = ls_req & "g711WasteMaterial.ausprfloat as WasteFactor,"
'    ls_req = ls_req & "g023.vpreis, g030.pevk, g040.ts "
'    ls_req = ls_req & "FROM g000 "
'    ls_req = ls_req & "LEFT JOIN g040 ON (g000.fi_nr = g040.fi_nr AND g000.identnr = g040.identnr) "
'    ls_req = ls_req & "LEFT JOIN g0402 ON (g000.fi_nr = g0402.fi_nr AND g000.identnr = g0402.identnr and g0402.lang_ext ='de_de') "
'    ls_req = ls_req & "LEFT JOIN g711 as g711Width ON (g000.objektid = g711Width.objektid and g711Width.kritnr = 12) "
'    ls_req = ls_req & "LEFT JOIN g711 as g711Thick ON (g000.objektid = g711Thick.objektid and g711Thick.kritnr = 17) "
'    ls_req = ls_req & "LEFT JOIN g711 as g711SpecWeight ON (g000.objektid = g711SpecWeight.objektid and g711SpecWeight.kritnr = 20) "
'    ls_req = ls_req & "LEFT JOIN g711 as g711WasteMaterial ON (g000.objektid = g711WasteMaterial.objektid and g711WasteMaterial.kritnr = 1175) "
'    ls_req = ls_req & "LEFT JOIN g020 on (g000.fi_nr = g020.fi_nr AND g000.identnr = g020.identnr) "
'    ls_req = ls_req & "LEFT JOIN g711 as g711StdCoil ON (g000.objektid = g711StdCoil.objektid and g711StdCoil.kritnr = 1181) "
'    ls_req = ls_req & "LEFT JOIN g023 ON (g000.fi_nr = g023.fi_nr AND g000.identnr = g023.identnr) "
'    ls_req = ls_req & "LEFT JOIN g030 on (g000.identnr = g030.identnr AND g000.fi_nr = g030.fi_nr) "
'    ls_req = ls_req & "WHERE "
'    ls_req = ls_req & "(g000.identnr LIKE $MAT_Prefx$) AND "
'    ls_req = ls_req & "(g0402.werkstoff = $MAT_Werk$ OR ($MAT_Werk$ IS NULL)) AND "
'    ls_req = ls_req & "(ROUND(g711Thick.ausprfloat,2) = $RPL_Thick$) AND "
'    ls_req = ls_req & "(ROUND(g711Width.ausprfloat,2) = $RPL_CoilW$) AND "
'    ls_req = ls_req & "(g020.lgnr=$lgnr$) AND "
'    ls_req = ls_req & "(g040.ts = $ts$) "
'    ls_req = ls_req & "ORDER BY ROUND(g711Width.ausprfloat,2)"
'
'    ls_req = Replace(ls_req, "$RPL_CoilW$", mo_Tools.SqlDbl(ao_Product.RPL_CoilW), , , vbTextCompare)
'    ls_req = Replace(ls_req, "$RPL_Thick$", mo_Tools.SqlDbl(ao_Product.RPL_Thick), , , vbTextCompare)
'    ls_req = Replace(ls_req, "$MAT_Prefx$", mo_Tools.SQLStr(ao_Product.MAT_Prefx & "%"), , , vbTextCompare)
'    ls_req = Replace(ls_req, "$ts$", mo_Tools.SQLStr(1), , , vbTextCompare)
'    ls_req = Replace(ls_req, "$lgnr$", mo_Tools.SqlInt(0), , , vbTextCompare)
'    ls_req = Replace(ls_req, "$MAT_Werk$", mo_Tools.SqlStrKey(ao_Product.RPL_MatTyp), , , vbTextCompare)
'
'    lc_Cursor = mo_Tools.OpenSQLSafe(ao_Db, ls_req)
'    ll_Count = ao_Db.RowCount(lc_Cursor)
'    If ll_Count = 1 Then
'      ao_Product.COI_Code = ao_Db.GetFields(lc_Cursor, "identnr")
'      ao_Product.COI_CodeTmp = ""
'      ao_Product.COI_SpcWgh = ao_Db.GetFields(lc_Cursor, "SpecWeight")
'      FindCoil = True
'    ElseIf ll_Count = 0 Then
'      ao_Product.COI_CodeTmp = GetCoilTemplateIdentNr(ao_Product.MAT_Prefx, ao_Product.RPL_MatTyp, ao_Product.RPL_Thick)
'      ao_Product.COI_Code = DPC_BOM_NEW_IDENTNR
'      Call mo_Tools.AddCheckError(eDPCError.erBOMCoilBaeurerExport, ms_Language_Code, ao_ErrCollection, ao_Product)
'    Else
'      ao_Product.COI_Code = ""
'      ao_Product.COI_CodeTmp = ""
'      Call mo_Tools.AddCheckError(eDPCError.erBOMCoilNotFound, ms_Language_Code, ao_ErrCollection, ao_Product, Nothing, Array("$Count$"), Array(ll_Count))
'    End If
'    Call ao_Db.Close(lc_Cursor)
'  End If
'  Exit Function
'ErrHandler:
'  Call errorHandler("FindCoil")
'End Function

Private Function FindInlay(ByVal ao_Db As Object, ByVal ao_Product As DPC_Product, ByVal ao_Inlay As DPC_Inlay, ByVal ao_ErrCollection As Collection) As Boolean
On Error GoTo ErrHandler

Dim ls_req As String
Dim lc_Cursor As Long
Dim ll_Count As Long

  FindInlay = False
  ao_Inlay.INL_IdentNr = ""
  ao_Inlay.INL_IdentNrTmp = ""
  If Trim(ao_Inlay.INL_Code) = "" Then
    Call mo_Tools.AddCheckError(eDPCError.erInlayMandatory, ms_Language_Code, ao_ErrCollection, ao_Product, ao_Inlay)
    Exit Function
  End If
  If (ao_Inlay.PIN_SizeA <= 0) Or (ao_Inlay.PIN_SizeB <= 0) Then
    Call mo_Tools.AddCheckError(eDPCError.erInlaySizeInvalid, ms_Language_Code, ao_ErrCollection, ao_Product, ao_Inlay)
    Exit Function
  End If
  ls_req = "SELECT TOP 1 "
  ls_req = ls_req & "g000.identnr, g0402.ben, g000.me, g0402.werkstoff,"
  ls_req = ls_req & "ROUND(g711Length.ausprfloat,2) as Length, ROUND(g711Width.ausprfloat,2) as Width,"
  ls_req = ls_req & "g711Inlay.ausprtxt AS InlayCode "
  ls_req = ls_req & "FROM g000 "
  'ls_req = ls_req & "LEFT JOIN g040 ON (g000.fi_nr = g040.fi_nr AND g000.identnr = g040.identnr ) "
  ls_req = ls_req & "LEFT JOIN g043 on (g000.fi_nr = g043.fi_nr AND g000.identnr = g043.identnr) "
  ls_req = ls_req & "LEFT JOIN g0402 ON (g000.fi_nr = g0402.fi_nr AND g000.identnr = g0402.identnr and g0402.lang_ext ='de_de') "
  ls_req = ls_req & "LEFT JOIN g711 as g711Length ON (g000.objektid = g711Length.objektid and g711Length.kritnr = 11) "
  ls_req = ls_req & "LEFT JOIN g711 as g711Width ON (g000.objektid = g711Width.objektid and g711Width.kritnr = 12) "
  ls_req = ls_req & "LEFT JOIN g711 as g711Inlay ON (g000.objektid = g711Inlay.objektid and g711Inlay.kritnr = 8) "
  ls_req = ls_req & "LEFT JOIN g030 on (g000.identnr = g030.identnr AND g000.fi_nr = g030.fi_nr) "
  ls_req = ls_req & "WHERE "
  ls_req = ls_req & "(g043.agr $agr$) AND "
  ls_req = ls_req & "(g711Inlay.ausprtxt = $INL_Code$) AND "
  ls_req = ls_req & "((ROUND(g711Length.ausprfloat,2) = $PIN_SizeA$) OR ($PIN_SizeA$ IS NULL)) AND "
  ls_req = ls_req & "((ROUND(g711Width.ausprfloat,2) = $PIN_SizeB$) OR ($PIN_SizeB$ IS NULL)) AND "
  ls_req = ls_req & "((ROUND(g711Width.ausprfloat,2) >= $PIN_SizeBRoll$) OR ($PIN_SizeBRoll$ IS NULL)) "
  'ls_req = ls_req & "(g040.ts = $ts$) AND "
  ls_req = ls_req & "ORDER BY ROUND(g711Width.ausprfloat,2) DESC "
  
  ls_req = Replace(ls_req, "$agr$", "IN (250,260,270)", , , vbTextCompare)
  ls_req = Replace(ls_req, "$INL_Code$", mo_Tools.SQLStr(ao_Inlay.INL_Code), , , vbTextCompare)
  If ao_Inlay.PIN_Purch = eDPCInlayPurchaseType.ipCutToSize Then
    ls_req = Replace(ls_req, "$PIN_SizeA$", mo_Tools.SqlDbl(0), , , vbTextCompare)
    ls_req = Replace(ls_req, "$PIN_SizeB$", "NULL", , , vbTextCompare)
    ls_req = Replace(ls_req, "$PIN_SizeBRoll$", mo_Tools.SqlDbl(ao_Inlay.PIN_SizeB), , , vbTextCompare)
  ElseIf ao_Inlay.PIN_Purch = eDPCInlayPurchaseType.ipOrderedSize Then
    ls_req = Replace(ls_req, "$PIN_SizeA$", mo_Tools.SqlDbl(ao_Inlay.PIN_SizeA), , , vbTextCompare)
    ls_req = Replace(ls_req, "$PIN_SizeB$", mo_Tools.SqlDbl(ao_Inlay.PIN_SizeB), , , vbTextCompare)
    ls_req = Replace(ls_req, "$PIN_SizeBRoll$", "NULL", , , vbTextCompare)
  Else
    Call mo_Tools.AddCheckError(eDPCError.erInlayDeliveryMandatory, ms_Language_Code, ao_ErrCollection, ao_Product, ao_Inlay)
    Exit Function
  End If
  lc_Cursor = mo_Tools.OpenSQLSafe(ao_Db, ls_req)
  ll_Count = ao_Db.RowCount(lc_Cursor)
  If ll_Count = 1 Then
    ao_Inlay.INL_IdentNr = ao_Db.GetFields(lc_Cursor, "identnr")
    If ao_Inlay.PIN_Purch = eDPCInlayPurchaseType.ipCutToSize Then
      ao_Inlay.INL_IdentNrTmp = ao_Inlay.INL_IdentNr
   ElseIf ao_Inlay.PIN_Purch = eDPCInlayPurchaseType.ipOrderedSize Then
      ao_Inlay.INL_IdentNrTmp = ao_Inlay.INL_Code
   End If
   FindInlay = True
  ElseIf ll_Count = 0 Then
    If ao_Inlay.PIN_Purch = eDPCInlayPurchaseType.ipCutToSize Then
      Call mo_Tools.AddCheckError(eDPCError.erBOMInlayNotFound, ms_Language_Code, ao_ErrCollection, ao_Product, ao_Inlay, Array("$Count$"), Array(ll_Count))
    ElseIf ao_Inlay.PIN_Purch = eDPCInlayPurchaseType.ipOrderedSize Then
      ao_Inlay.INL_IdentNr = DPC_BOM_NEW_IDENTNR
      ao_Inlay.INL_IdentNrTmp = ao_Inlay.INL_Code
      Call mo_Tools.AddCheckError(eDPCError.erBOMInlayBaeurerExport, ms_Language_Code, ao_ErrCollection, ao_Product, ao_Inlay, Array("$Count$"), Array(ll_Count))
      FindInlay = True
    End If
  Else
    Call mo_Tools.AddCheckError(eDPCError.erBOMInlayNotFound, ms_Language_Code, ao_ErrCollection, ao_Product, ao_Inlay, Array("$Count$"), Array(ll_Count))
  End If
  Call ao_Db.Close(lc_Cursor)
  Exit Function
ErrHandler:
  Call ErrorHandler("FindInlay")
End Function

Private Function GetMaterialIndex(ByRef ata_Material() As tDPC_Material, ByVal as_IdentNr As String) As Long
On Error GoTo ErrHandler

Dim ll_Idx As Long

  GetMaterialIndex = -1
  For ll_Idx = 0 To UBound(ata_Material)
    If StrComp(ata_Material(ll_Idx).BOM_IdentNr, as_IdentNr, vbTextCompare) = 0 Then
      GetMaterialIndex = ll_Idx
      Exit Function
    End If
  Next
  Exit Function
ErrHandler:
  Call ErrorHandler("GetMaterialIndex")
End Function

Private Sub DistributeCoatingWaste(ByVal ao_Db As Object, ByVal ao_Collection As Collection)
On Error GoTo ErrHandler

Dim lta_Material() As tDPC_Material
Dim lo_Product As DPC_Product
Dim lo_BOM As DPC_BOM
Dim ll_Idx As Long

  ReDim lta_Material(-1 To -1)
  
  For Each lo_Product In ao_Collection
    For Each lo_BOM In lo_Product.BOMs
      ll_Idx = GetMaterialIndex(lta_Material, lo_BOM.BOM_IdentNr)
      If ll_Idx >= 0 Then
        lta_Material(ll_Idx).Qty = lta_Material(ll_Idx).Qty + lo_BOM.BOM_Qty
      Else
        If UBound(lta_Material) < 0 Then
          ReDim lta_Material(0)
          ll_Idx = 0
        Else
          ll_Idx = UBound(lta_Material) + 1
          ReDim Preserve lta_Material(ll_Idx)
        End If
        lta_Material(ll_Idx).Qty = lo_BOM.BOM_Qty
      End If
    Next
  Next
  Exit Sub
ErrHandler:
  Call ErrorHandler("DistributeCoatingWaste")
End Sub

Private Sub DistributeBOMWaste(ByVal ao_Collection As Collection, ByVal ao_Db As Object)
On Error GoTo ErrHandler
  
  Call DistributeCoatingWaste(ao_Db, ao_Collection)
  Exit Sub
ErrHandler:
  Call ErrorHandler("DistributeBOMWaste")
End Sub

Private Function AddBOM(ByVal ao_Product As DPC_Product, ByVal ae_BOMMaterial As eDPCBOMMaterial) As DPC_BOM
On Error GoTo ErrHandler
  Dim lo_BOM As DPC_BOM
  
  Set lo_BOM = New DPC_BOM
  Call ao_Product.InitBOM(lo_BOM, eDPCRowStatus.rsAdd)
  Call ao_Product.AddBOM(lo_BOM)
  lo_BOM.BOM_Categ = ae_BOMMaterial
  lo_BOM.BOM_CategDesc = mo_Tools.GetAReferenceData(eDPCReferenceML.rfBOMCategory, ae_BOMMaterial, ms_Language_Code)
  lo_BOM.BOM_RejectFactor = ao_Product.RPL_BOMRejectFact
  Set AddBOM = lo_BOM
  Exit Function
ErrHandler:
  Call ErrorHandler("AddBOM")
End Function

Private Function AddBOR(ByVal ao_Db As Object, ByVal ao_Product As DPC_Product, ByVal ae_BOROperation As eDPCBOROperation, ByVal al_WghPnt As Long) As DPC_BOR
On Error GoTo ErrHandler

Dim lo_BOR As DPC_BOR

  Set lo_BOR = New DPC_BOR
  Call ao_Product.InitBOR(lo_BOR, eDPCRowStatus.rsAdd)
  Call ao_Product.AddBOR(lo_BOR)
  lo_BOR.BOR_Categ = ae_BOROperation
  lo_BOR.BOR_CategDesc = mo_Tools.GetAReferenceData(eDPCReferenceML.rfBORCategory, ae_BOROperation, ms_Language_Code)
  lo_BOR.BOR_WasteFact = ao_Product.RPL_BORWasteFact
  lo_BOR.BOR_CostCalcMPE2 = ao_Product.RPL_MPE2Fact
  lo_BOR.BOR_WghPnt = al_WghPnt
  Set AddBOR = lo_BOR
  Exit Function
ErrHandler:
  Call ErrorHandler("AddBOR")
End Function

Private Function SetBORErr(ByVal ao_BOR As DPC_BOR, ByVal ae_DPCError As eDPCError, ByVal ao_ErrCollection As Collection, ByVal ao_Product As DPC_Product) As DPC_Error
On Error GoTo ErrHandler

Dim lo_Error As DPC_Error

  Set lo_Error = mo_Tools.AddCheckError(ae_DPCError, ms_Language_Code, ao_ErrCollection, ao_Product, ao_BOR)
  ao_BOR.BOR_Name = lo_Error.Message_Text
  ao_BOR.BOR_Status = eDPCBOMBORStatus.boGeneratedError
  Set SetBORErr = lo_Error
  Exit Function
ErrHandler:
  Call ErrorHandler("SetBORErr")
End Function

Private Function SetBOMErr(ByVal ao_BOM As DPC_BOM, ByVal ae_DPCError As eDPCError, ByVal ao_ErrCollection As Collection, ByVal ao_Product As DPC_Product) As DPC_Error
On Error GoTo ErrHandler

Dim lo_Error As DPC_Error

  Set lo_Error = mo_Tools.AddCheckError(ae_DPCError, ms_Language_Code, ao_ErrCollection, ao_Product, ao_BOM)
  ao_BOM.BOM_Name = lo_Error.Message_Text
  ao_BOM.BOM_Status = eDPCBOMBORStatus.boGeneratedError
  Set SetBOMErr = lo_Error
  Exit Function
ErrHandler:
  Call ErrorHandler("SetBOMErr")
End Function

Public Function AddBOMCoil(ByVal ao_DbBaeurer As Object, ByVal ao_Product As DPC_Product, ByVal ao_ErrCollection As Collection) As DPC_BOM
On Error GoTo ErrHandler

Dim lo_BOM As DPC_BOM
Dim ls_IdentNr As String

  If StrComp(ao_Product.COI_Code, DPC_BOM_NEW_IDENTNR, vbTextCompare) = 0 Then
    ls_IdentNr = ao_Product.COI_CodeTmp
  Else
    ls_IdentNr = ao_Product.COI_Code
  End If
  Set lo_BOM = AddBOM(ao_Product, eDPCBOMMaterial.bcCoil)
  If ls_IdentNr = "" Then
    Call SetBOMErr(lo_BOM, eDPCError.erBOMMaterialCodeMissing, ao_ErrCollection, ao_Product)
  Else
    If lo_BOM.LoadBOMFromBaeurer(mo_Db, ao_DbBaeurer, ms_Language_Code, ls_IdentNr) Then
      Call lo_BOM.CalculateCoil(mo_Db, ao_DbBaeurer, ms_Language_Code, ao_Product, ao_ErrCollection)
    Else
      Call SetBOMErr(lo_BOM, eDPCError.erBOMMaterialNotFoundB7, ao_ErrCollection, ao_Product)
    End If
    lo_BOM.BOM_IdentNr = ao_Product.COI_Code
    lo_BOM.BOM_IdentNrTmp = ao_Product.COI_CodeTmp
  End If
  Set AddBOMCoil = lo_BOM
  Exit Function
ErrHandler:
  Call ErrorHandler("AddBOMCoil")
End Function

Public Function AddBOMSpacer(ByVal ao_DbBaeurer As Object, ByVal ao_Product As DPC_Product, ByVal as_GSK_Id2 As String, ByVal ao_ErrCollection As Collection) As DPC_BOM
On Error GoTo ErrHandler

Dim lo_BOM As DPC_BOM
Dim ls_IdentNr As String

  Set lo_BOM = AddBOM(ao_Product, eDPCBOMMaterial.bcSpacer)
  ls_IdentNr = GetBaeurerIdentNr(as_GSK_Id2)
  If ls_IdentNr = "" Then
    Call SetBOMErr(lo_BOM, eDPCError.erBOMMaterialCodeMissing, ao_ErrCollection, ao_Product)
  Else
    If lo_BOM.LoadBOMFromBaeurer(mo_Db, ao_DbBaeurer, ms_Language_Code, ls_IdentNr) Then
      Call lo_BOM.CalculateSpacer(mo_Db, ao_DbBaeurer, ms_Language_Code, as_GSK_Id2, ao_Product, ao_ErrCollection)
    Else
      Call SetBOMErr(lo_BOM, eDPCError.erBOMMaterialNotFoundB7, ao_ErrCollection, ao_Product)
    End If
  End If
  Set AddBOMSpacer = lo_BOM
  Exit Function
ErrHandler:
  Call ErrorHandler("AddBOMSpacer")
End Function

Public Function AddBOMGasket(ByVal ao_DbBaeurer As Object, ByVal ao_Product As DPC_Product, ByVal as_GSK_Id As String, ByVal ao_ErrCollection As Collection) As DPC_BOM
On Error GoTo ErrHandler

Dim lo_BOM As DPC_BOM
Dim ld_TotalQty As Double
Dim ls_IdentNr As String
Dim ll_SideIdx As Long

  Set lo_BOM = AddBOM(ao_Product, eDPCBOMMaterial.bcGasket)
  ls_IdentNr = GetBaeurerIdentNr(as_GSK_Id)
  If ls_IdentNr = "" Then
    Call SetBOMErr(lo_BOM, eDPCError.erBOMMaterialCodeMissing, ao_ErrCollection, ao_Product)
  Else
    If lo_BOM.LoadBOMFromBaeurer(mo_Db, ao_DbBaeurer, ms_Language_Code, ls_IdentNr) Then
      Call lo_BOM.CalculateGasket(mo_Db, ao_DbBaeurer, ms_Language_Code, as_GSK_Id, ao_Product, ao_ErrCollection)
    Else
      Call SetBOMErr(lo_BOM, eDPCError.erBOMMaterialNotFoundB7, ao_ErrCollection, ao_Product)
    End If
  End If
  Set AddBOMGasket = lo_BOM
  Exit Function
ErrHandler:
  Call ErrorHandler("AddBOMGasket")
End Function

Public Function AddBOMCoating(ByVal ao_DbBaeurer As Object, ByVal ao_Product As DPC_Product, ByVal ao_ErrCollection As Collection) As DPC_BOM
On Error GoTo ErrHandler

Dim lo_BOM As DPC_BOM
Dim ls_IdentNr As String
Dim ld_TotalQty As Double
  
  Set lo_BOM = AddBOM(ao_Product, eDPCBOMMaterial.bcCoating)
  
  If ao_Product.COA_IsCus Then
    ls_IdentNr = ao_Product.COA_Code
  Else
    ls_IdentNr = GetBaeurerIdentNr(ao_Product.COA_Id)
  End If
  
  If ls_IdentNr = "" Then
    Call SetBOMErr(lo_BOM, eDPCError.erBOMMaterialCodeMissing, ao_ErrCollection, ao_Product)
  Else
    If lo_BOM.LoadBOMFromBaeurer(mo_Db, ao_DbBaeurer, ms_Language_Code, ls_IdentNr) Then
      Call lo_BOM.CalculateCoating(mo_Db, ao_DbBaeurer, ms_Language_Code, ao_Product, ao_ErrCollection)
    Else
      Call SetBOMErr(lo_BOM, eDPCError.erBOMMaterialNotFoundB7, ao_ErrCollection, ao_Product)
    End If
  End If
  Set AddBOMCoating = lo_BOM
  Exit Function
ErrHandler:
  Call ErrorHandler("AddBOMCoating")
End Function

Public Function AddBOMInlay(ByVal ao_DbBaeurer As Object, ByVal ao_Product As DPC_Product, ByVal ao_Inlay As DPC_Inlay, ByVal ao_ErrCollection As Collection) As DPC_BOM
On Error GoTo ErrHandler

Dim lo_BOM As DPC_BOM
Dim ls_IdentNr As String
  
  Set lo_BOM = AddBOM(ao_Product, eDPCBOMMaterial.bcInlay)
  If StrComp(ao_Inlay.INL_IdentNr, DPC_BOM_NEW_IDENTNR, vbTextCompare) = 0 Then
    ls_IdentNr = ao_Inlay.INL_IdentNrTmp
  Else
    ls_IdentNr = ao_Inlay.INL_IdentNr
  End If
  If ls_IdentNr = "" Then
    Call SetBOMErr(lo_BOM, eDPCError.erBOMMaterialCodeMissing, ao_ErrCollection, ao_Product)
  Else
    If lo_BOM.LoadBOMFromBaeurer(mo_Db, ao_DbBaeurer, ms_Language_Code, ls_IdentNr) Then
      Call lo_BOM.CalculateInlay(mo_Db, ao_DbBaeurer, ms_Language_Code, ao_Product, ao_Inlay, ao_ErrCollection)
    Else
      Call SetBOMErr(lo_BOM, eDPCError.erBOMMaterialNotFoundB7, ao_ErrCollection, ao_Product)
    End If
  End If
  Set AddBOMInlay = lo_BOM
  Exit Function
ErrHandler:
  Call ErrorHandler("AddBOMInlay")
End Function

Public Sub AddBOMPacking(ByVal ao_DbBaeurer As Object, ByVal ao_Product As DPC_Product, ByVal ao_ErrCollection As Collection)
On Error GoTo ErrHandler

Dim lo_BOM As DPC_BOM
Dim ls_req As String
Dim lc_Cursor As Long
Dim ll_BPK_Id As Long
Dim lt_Palette As tDPC_Palette
Dim lt_Package As tDPC_Package
Dim lt_PackingItem As tDPC_PackingItem


  If ao_Product.IsStandard Then
    lt_Package.PanelQty = ao_Product.RPL_PU
  ElseIf ao_Product.RPL_PU > 0 Then
    lt_Package.PanelQty = ao_Product.RPL_PU
  ElseIf ao_Product.PRD_IdPar <> "" Then
    ls_req = "SELECT RPL_PU FROM DPC_RectPanel WHERE RPL_Id=$RPL_Id$"
    ls_req = Replace(ls_req, "$RPL_Id$", mo_Tools.SQLStr(ao_Product.PRD_IdPar), , , vbTextCompare)
    lt_Package.PanelQty = mo_Tools.SelectValue(mo_Db, ls_req)
    ao_Product.RPL_PU = lt_Package.PanelQty
  Else
    lt_Package.PanelQty = 0
  End If
  
  ls_req = "exec DPC_BOM_Generate_Packing_lst $PKG_Id$, $PRD_Id$, $PanelQtyPCS$"
'  ls_req = "SELECT TOP 1 BPK.BPK_Id, BPK.PKG_Id, BPK.BPK_PkgAMin, BPK.BPK_PkgAMax, BPK.BPK_PkgBMin, BPK.BPK_PkgBMax,"
'  ls_req = ls_req & "BPK.BPK_PkgHMin, BPK.BPK_PkgHMax, BPK.BPK_PalAMax, BPK.BPK_PalBMax, BPK.BPK_PalHMax, BPK.BPK_WghMax,"
'  ls_req = ls_req & "BPK.BPK_PkgQty, BPK.BPK_NClosed, BPK.BPK_BVisible, BPK.BPK_QtyMin, BPK.BPK_QtyMax,"
'  ls_req = ls_req & "PKG.PKG_MaxWgh, PKG.PKG_PalFre, PKG.PKG_PakAdd, PKG.PKG_SmallQty "
'  ls_req = ls_req & "FROM DPC_BOM_Packing BPK "
'  ls_req = ls_req & "INNER JOIN DPC_Packing PKG ON (BPK.PKG_Id=PKG.PKG_Id) "
'  ls_req = ls_req & "WHERE BPK.PKG_Id=$PKG_Id$ AND "
'  ls_req = ls_req & "BPK.Drop_Flag='' "
'  ls_req = ls_req & "ORDER BY BPK.BPK_PkgAMax, BPK.BPK_PkgBMax, BPK.BPK_PkgHMax"
  
  ls_req = Replace(ls_req, "$PKG_Id$", mo_Tools.SQLStr(ao_Product.PKG_Id), , , vbTextCompare)
  ls_req = Replace(ls_req, "$PRD_Id$", mo_Tools.SQLStr(ao_Product.PRD_Id), , , vbTextCompare)
  ls_req = Replace(ls_req, "$PanelQtyPCS$", mo_Tools.SqlInt(ao_Product.PanelQtyPCS), , , vbTextCompare)
  lc_Cursor = mo_Tools.OpenSQLSafe(mo_Db, ls_req)
  If mo_Db.RowCount(lc_Cursor) = 1 Then
    ll_BPK_Id = mo_Db.GetFields(lc_Cursor, "BPK_Id")
    lt_Package.MaxWeight = Round(mo_Db.GetFields(lc_Cursor, "PKG_MaxWgh"), 1)
    lt_Palette.MaxPaletteFreeSpace = Round(mo_Db.GetFields(lc_Cursor, "PKG_PalFre"))
    lt_Palette.SmallQty = mo_Db.GetFields(lc_Cursor, "PKG_SmallQty")
    lt_Package.AdditionalPkgMatSize = mo_Db.GetFields(lc_Cursor, "PKG_PakAdd")
    Call mo_Db.Close(lc_Cursor)
        
    ls_req = "exec DPC_BOM_Generate_PackingItem_lst $BPK_Id$"
'    ls_req = "SELECT BPI.BPI_Id, BPI.BPK_Id, BPI.BPI_IdentNr, BPI.BPI_Name, BPI.BPI_Factor1, BPI.BPI_FactUM1,"
'    ls_req = ls_req & "BPI.BPI_Factor2, BPI.BPI_FactUM2, BPI.BPI_Formula, BPI.BPI_Type, BPI.BPI_PkgA, BPI.BPI_PkgB,"
'    ls_req = ls_req & "BPI.BPI_PkgH, BPI.BPI_MaxH, DFO.DFO_Formula "
'    ls_req = ls_req & "FROM DPC_BOM_Packing_Item BPI "
'    ls_req = ls_req & "LEFT JOIN DPC_Formula DFO ON (BPI.BPI_Formula=DFO.DFO_Id) "
'    ls_req = ls_req & "WHERE BPI.BPK_Id=$BPK_Id$ AND "
'    ls_req = ls_req & "BPI.Drop_Flag='' "
'    ls_req = ls_req & "ORDER BY BPI.BPI_Order"
    ls_req = Replace(ls_req, "$BPK_Id$", mo_Tools.SqlInt(ll_BPK_Id), , , vbTextCompare)
    lc_Cursor = mo_Tools.OpenSQLSafe(mo_Db, ls_req)
    
    If Not FindPalette(ao_Product, lc_Cursor, lt_Palette) Then
      Call mo_Db.Close(lc_Cursor)
      Call mo_Tools.AddCheckError(eDPCError.erBOMPaletteNotFound, ms_Language_Code, ao_ErrCollection, ao_Product)
      Exit Sub
    End If
    If lt_Package.PanelQty = 0 Then
      If Not OptimizePackingQty(ao_Product, lt_Palette, lt_Package, ao_ErrCollection) Then
        Call mo_Db.Close(lc_Cursor)
        Exit Sub
      End If
      If Not CalculatePalette(ao_Product, lt_Palette, lt_Package) Then
        Call mo_Tools.AddCheckError(eDPCError.erBOMIncorrectPacketSize, ms_Language_Code, ao_ErrCollection, ao_Product)
        Call mo_Db.Close(lc_Cursor)
        Exit Sub
      End If
      ao_Product.RPL_PU = lt_Package.PanelQty
    Else
      If Not CalculatePackage(lt_Package.PanelQty, ao_Product, lt_Palette, lt_Package) Then
        Call mo_Tools.AddCheckError(eDPCError.erBOMIncorrectPacketSize, ms_Language_Code, ao_ErrCollection, ao_Product)
      End If
      If Not CalculatePalette(ao_Product, lt_Palette, lt_Package) Then
        Call mo_Tools.AddCheckError(eDPCError.erBOMIncorrectPacketSize, ms_Language_Code, ao_ErrCollection, ao_Product)
      End If
    End If
    
    Call FindEdgeProtectionL(ao_Product, lc_Cursor, lt_Palette)
    Call FindEdgeProtectionH(ao_Product, lc_Cursor, lt_Palette)
    
    Call mo_Db.First(lc_Cursor)
    While Not mo_Db.EOF(lc_Cursor)
      lt_PackingItem.IdentNr = mo_Db.GetFields(lc_Cursor, "BPI_IdentNr")
      lt_PackingItem.Formula = mo_Db.GetFields(lc_Cursor, "DFO_Formula")
      lt_PackingItem.Factor = mo_Db.GetFields(lc_Cursor, "BPI_Factor2")
      lt_PackingItem.UM_Code = mo_Db.GetFields(lc_Cursor, "BPI_FactUM2")
      lt_PackingItem.Type = mo_Db.GetFields(lc_Cursor, "BPI_Type")
      lt_PackingItem.ItemA = mo_Db.GetFields(lc_Cursor, "BPI_PkgA")
      lt_PackingItem.ItemB = mo_Db.GetFields(lc_Cursor, "BPI_PkgB")
      lt_PackingItem.ItemH = mo_Db.GetFields(lc_Cursor, "BPI_PkgH")
      
      If lt_PackingItem.IdentNr = "" Then
        Set lo_BOM = AddBOM(ao_Product, eDPCBOMMaterial.bcPacking)
        Call SetBOMErr(lo_BOM, eDPCError.erBOMMaterialCodeMissing, ao_ErrCollection, ao_Product)
      End If
      
      'skip other palletes, only one is choosen
      If (lt_PackingItem.Type = eDPCBOMPackingItemType.ptPalette) And (StrComp(lt_PackingItem.IdentNr, lt_Palette.IdentNr, vbTextCompare) <> 0) Then
        lt_PackingItem.IdentNr = ""
      End If
      If (lt_PackingItem.Type = eDPCBOMPackingItemType.ptEdgeProtectionL) And (StrComp(lt_PackingItem.IdentNr, lt_Palette.EdgeProtectionLIdentNr, vbTextCompare) <> 0) Then
        lt_PackingItem.IdentNr = ""
      End If
      If (lt_PackingItem.Type = eDPCBOMPackingItemType.ptEdgeProtectionH) And (StrComp(lt_PackingItem.IdentNr, lt_Palette.EdgeProtectionHIdentNr, vbTextCompare) <> 0) Then
        lt_PackingItem.IdentNr = ""
      End If
      If lt_PackingItem.IdentNr <> "" Then
        Set lo_BOM = AddBOM(ao_Product, eDPCBOMMaterial.bcPacking)
        If lo_BOM.LoadBOMFromBaeurer(mo_Db, ao_DbBaeurer, ms_Language_Code, lt_PackingItem.IdentNr) Then
          lo_BOM.UM_Code = lt_PackingItem.UM_Code
          ' we can calculate small qty just for our palette and maximum possible panel qty
          If (StrComp(lt_PackingItem.IdentNr, lt_Palette.IdentNr, vbTextCompare) = 0) And (ao_Product.PanelQtyPCS <= lt_Palette.SmallQty) Then
            lo_BOM.BOM_Qty = 1 / (lt_Palette.MaxPackageQty * lt_Package.PanelQty)
          Else
            If CalculatePackingItem(ao_Product, lt_Palette, lt_Package, lt_PackingItem, ao_ErrCollection) Then
              lo_BOM.BOM_Qty = (lt_PackingItem.Qty * (1 + lo_BOM.BOM_WasteFactor))
            End If
          End If
  '        lo_BOM.BOM_WasteQty = GetWasteQty(eDPCBOMMaterial.bcPacking, ao_Product.PanelQtyM2)
  '        ld_Qty = ao_Product.PanelQtyPCS + lo_BOM.BOM_WasteQty
  '        If (lo_BOM.BOM_Productivity > 0) And (ao_Product.PanelQtyPCS > 0) Then
  '          lo_BOM.BOM_Qty = (ld_Qty / lo_BOM.BOM_Productivity) / ao_Product.PanelQtyPCS
  '        Else
  '          If ao_Product.PanelQtyPCS > 0 Then
  '            lo_BOM.BOM_Qty = ld_Qty / ao_Product.PanelQtyPCS
  '          Else
  '            lo_BOM.BOM_Qty = 0
  '          End If
  '        End If
          If Not lo_BOM.LoadBOMPriceFromBaeurer(ao_DbBaeurer, lt_PackingItem.IdentNr, lo_BOM.BOM_Qty * ao_Product.PanelQtyPCS) Then
            Call mo_Tools.AddCheckError(eDPCError.erBOMCostNotFoundB7, ms_Language_Code, ao_ErrCollection, ao_Product)
          End If
        Else
          Call SetBOMErr(lo_BOM, eDPCError.erBOMMaterialNotFoundB7, ao_ErrCollection, ao_Product)
        End If
      End If
      Call mo_Db.Next(lc_Cursor)
    Wend
    Call mo_Db.Close(lc_Cursor)
  Else
    Call mo_Db.Close(lc_Cursor)
    Set lo_BOM = AddBOM(ao_Product, eDPCBOMMaterial.bcPacking)
    Call SetBOMErr(lo_BOM, eDPCError.erBOMMaterialCodeMissing, ao_ErrCollection, ao_Product)
  End If
  Exit Sub
ErrHandler:
  Call ErrorHandler("AddBOMPacking")
End Sub

Private Function FindPalette(ByVal ao_Product As DPC_Product, ByVal ac_Cursor As Long, ByRef at_Palette As tDPC_Palette) As Boolean
On Error GoTo ErrHandler

  FindPalette = False
  at_Palette.IdentNr = ""
  Call mo_Db.First(ac_Cursor)
  While Not mo_Db.EOF(ac_Cursor)
    If mo_Db.GetFields(ac_Cursor, "BPI_Type") = eDPCBOMPackingItemType.ptPalette Then
      If mo_Db.GetFields(ac_Cursor, "BPI_PkgA") > ao_Product.RPL_PanA Then
        If (at_Palette.PalA = 0) Or (mo_Db.GetFields(ac_Cursor, "BPI_PkgA") < at_Palette.PalA) Then
          at_Palette.IdentNr = mo_Db.GetFields(ac_Cursor, "BPI_IdentNr")
          at_Palette.PalA = mo_Db.GetFields(ac_Cursor, "BPI_PkgA")
          at_Palette.PalB = mo_Db.GetFields(ac_Cursor, "BPI_PkgB")
          at_Palette.PalH = mo_Db.GetFields(ac_Cursor, "BPI_PkgH")
          at_Palette.PalMaxH = mo_Db.GetFields(ac_Cursor, "BPI_MaxH")
          FindPalette = True
        End If
      End If
    End If
    Call mo_Db.Next(ac_Cursor)
  Wend
  Exit Function
ErrHandler:
  Call ErrorHandler("FindPalette")
End Function

Private Function FindEdgeProtectionL(ByVal ao_Product As DPC_Product, ByVal ac_Cursor As Long, ByRef at_Palette As tDPC_Palette) As Boolean
On Error GoTo ErrHandler

Dim ll_EdgeSize As Long

  FindEdgeProtectionL = False
  at_Palette.EdgeProtectionLIdentNr = ""
  ll_EdgeSize = 0
  Call mo_Db.First(ac_Cursor)
  While Not mo_Db.EOF(ac_Cursor)
    If mo_Db.GetFields(ac_Cursor, "BPI_Type") = eDPCBOMPackingItemType.ptEdgeProtectionL Then
      If mo_Db.GetFields(ac_Cursor, "BPI_PkgA") >= at_Palette.PalA Then
        If (ll_EdgeSize = 0) Or (mo_Db.GetFields(ac_Cursor, "BPI_PkgA") < ll_EdgeSize) Then
          at_Palette.EdgeProtectionLIdentNr = mo_Db.GetFields(ac_Cursor, "BPI_IdentNr")
          ll_EdgeSize = mo_Db.GetFields(ac_Cursor, "BPI_PkgA")
          FindEdgeProtectionL = True
        End If
      End If
    End If
    Call mo_Db.Next(ac_Cursor)
  Wend
  Exit Function
ErrHandler:
  Call ErrorHandler("FindEdgeProtectionL")
End Function

Private Function FindEdgeProtectionH(ByVal ao_Product As DPC_Product, ByVal ac_Cursor As Long, ByRef at_Palette As tDPC_Palette) As Boolean
On Error GoTo ErrHandler

Dim ll_EdgeSize As Long

  FindEdgeProtectionH = False
  at_Palette.EdgeProtectionHIdentNr = ""
  ll_EdgeSize = 0
  Call mo_Db.First(ac_Cursor)
  While Not mo_Db.EOF(ac_Cursor)
    If mo_Db.GetFields(ac_Cursor, "BPI_Type") = eDPCBOMPackingItemType.ptEdgeProtectionH Then
      If mo_Db.GetFields(ac_Cursor, "BPI_PkgA") >= at_Palette.PalMaxH Then
        If (ll_EdgeSize = 0) Or (mo_Db.GetFields(ac_Cursor, "BPI_PkgA") < ll_EdgeSize) Then
          at_Palette.EdgeProtectionHIdentNr = mo_Db.GetFields(ac_Cursor, "BPI_IdentNr")
          ll_EdgeSize = mo_Db.GetFields(ac_Cursor, "BPI_PkgA")
          FindEdgeProtectionH = True
        End If
      End If
    End If
    Call mo_Db.Next(ac_Cursor)
  Wend
  Exit Function
ErrHandler:
  Call ErrorHandler("FindEdgeProtectionH")
End Function

Private Function OptimizePackingQty(ByVal ao_Product As DPC_Product, ByRef at_Palette As tDPC_Palette, ByRef at_Package As tDPC_Package, ByVal ao_ErrCollection As Collection) As Boolean
On Error GoTo ErrHandler

Dim ll_PanQty As Long
Dim ll_MinFreeSpace As Long
Dim ll_MinFreeSpaceQty As Long
Dim lb_Result As Boolean

  OptimizePackingQty = False
  If (ao_Product.RPL_NWgh <= 0) Then
    Call mo_Tools.AddCheckError(eDPCError.erBOMIncorrectPanelWeight, ms_Language_Code, ao_ErrCollection, ao_Product)
    Exit Function
  End If
  
  ll_PanQty = Int(at_Package.MaxWeight / ao_Product.RPL_NWgh)
  ' we need always pack by two pieces
  If ll_PanQty Mod 2 = 1 Then ll_PanQty = ll_PanQty - 1
  ' cannot calculate, panel too heavy
  If ll_PanQty < 2 Then
    Call mo_Tools.AddCheckError(eDPCError.erBOMIncorrectPanelWeight, ms_Language_Code, ao_ErrCollection, ao_Product)
    Exit Function
  End If
  
  ll_MinFreeSpace = 99999
  ll_MinFreeSpaceQty = 0
  Do
    Call CalculatePackage(ll_PanQty, ao_Product, at_Palette, at_Package)
    If at_Palette.PaletteFreeSpace <= at_Palette.MaxPaletteFreeSpace Then
      Exit Do
    End If
    If at_Palette.PaletteFreeSpace < ll_MinFreeSpace Then
      ll_MinFreeSpace = at_Palette.PaletteFreeSpace
      ll_MinFreeSpaceQty = ll_PanQty
    End If
    ll_PanQty = ll_PanQty - 2
  Loop While ll_PanQty > 0
  
  If ll_PanQty <= 0 Then
    ll_PanQty = ll_MinFreeSpaceQty
  End If
  
  If ll_PanQty > 0 Then
    lb_Result = CalculatePackage(ll_PanQty, ao_Product, at_Palette, at_Package)
'    If lb_Result Then
'      lb_Result = CalculatePalette(ao_Product, at_Palette, at_Package)
'    End If
    If Not lb_Result Then
      Call mo_Tools.AddCheckError(eDPCError.erBOMIncorrectPacketSize, ms_Language_Code, ao_ErrCollection, ao_Product)
    End If
    OptimizePackingQty = lb_Result
  End If
  
  Exit Function
ErrHandler:
  Call ErrorHandler("OptimizePackingQty")
End Function

Private Function CalculatePackage(ByVal al_PanelQty As Long, ByVal ao_Product As DPC_Product, ByRef at_Palette As tDPC_Palette, ByRef at_Package As tDPC_Package) As Boolean
On Error GoTo ErrHandler
  
  CalculatePackage = False
  at_Package.PanelQty = al_PanelQty
  at_Package.PkgA = ao_Product.RPL_PanA + at_Package.AdditionalPkgMatSize
  at_Package.PkgB = (at_Package.PanelQty / 2) * (ao_Product.RPL_HA + ao_Product.RPL_Thick) + at_Package.AdditionalPkgMatSize
  at_Package.PkgH = ao_Product.GetTotalWidth + ao_Product.RPL_U(eDPCSide.esSideC)
  
  If (at_Package.PkgA <= 0) Or (at_Package.PkgB <= 0) Or (at_Package.PkgH <= 0) Then
    Exit Function
  End If
  at_Palette.RowsLength = Int(at_Palette.PalA / at_Package.PkgA)
  at_Palette.RowsWidth = Int(at_Palette.PalB / at_Package.PkgB)
  at_Palette.RowsHeight = Int(at_Palette.PalMaxH / at_Package.PkgH)
  at_Palette.PaletteFreeSpace = Round(at_Palette.PalB - (at_Palette.RowsWidth * at_Package.PkgB))
  at_Palette.MaxPackageQty = at_Palette.RowsLength * at_Palette.RowsWidth * at_Palette.RowsHeight
'  If (at_Package.PanelQty <= 0) Or (at_Palette.MaxPackageQty <= 0) Then
'    Exit Function
'  End If
'
'  at_Palette.PackageQty = mo_Tools.RoundUp(ao_Product.PanelQtyPCS / at_Package.PanelQty)
'  at_Palette.LastPackageQty = ao_Product.PanelQtyPCS - (at_Palette.PackageQty * at_Package.PanelQty)
'  at_Palette.PaletteQty = mo_Tools.RoundUp(at_Palette.PackageQty / at_Palette.MaxPackageQty)
  CalculatePackage = True
  Exit Function
ErrHandler:
  Call ErrorHandler("CalculatePackage")
End Function

Private Function CalculatePalette(ByVal ao_Product As DPC_Product, ByRef at_Palette As tDPC_Palette, ByRef at_Package As tDPC_Package) As Boolean
On Error GoTo ErrHandler

  CalculatePalette = False
  If (at_Package.PanelQty <= 0) Or (at_Palette.MaxPackageQty <= 0) Then
    Exit Function
  End If
  
  at_Palette.PackageQty = mo_Tools.RoundUp(ao_Product.PanelQtyPCS / at_Package.PanelQty)
  at_Palette.LastPackageQty = ao_Product.PanelQtyPCS - (at_Palette.PackageQty * at_Package.PanelQty)
  at_Palette.PaletteQty = mo_Tools.RoundUp(at_Palette.PackageQty / at_Palette.MaxPackageQty)
  CalculatePalette = True
  Exit Function
ErrHandler:
  Call ErrorHandler("CalculatePalette")
End Function

Private Function CalculatePackingItem(ByVal ao_Product As DPC_Product, ByRef at_Palette As tDPC_Palette, ByRef at_Package As tDPC_Package, ByRef at_PackingItem As tDPC_PackingItem, ByVal ao_ErrCollection As Collection) As Boolean
On Error GoTo ErrHandler

Dim ld_Perimeter As Double
Dim ld_GirdQty As Double

  CalculatePackingItem = False
  
  at_PackingItem.Qty = 0
  If ao_Product.PanelQtyPCS <= 0 Then
    Exit Function
  End If
  
  Select Case at_PackingItem.Formula
  Case "Anz_Pakete*Faktor/Menge"
    at_PackingItem.Qty = at_Palette.PackageQty * at_PackingItem.Factor / ao_Product.PanelQtyPCS
  Case "Anz_Pakete*Anz_PaketWicklung*PaketUmfang*Faktor/Menge"
    If at_PackingItem.ItemA <= 0 Then
      Exit Function
    End If
    ld_Perimeter = ((at_Package.PkgB + at_Package.PkgH) * 2) / 1000
    ld_GirdQty = ao_Product.GetTotalLength / (at_PackingItem.ItemA / 2) + (2 * 3)
    at_PackingItem.Qty = at_Palette.PackageQty * ld_GirdQty * ld_Perimeter * at_PackingItem.Factor / ao_Product.PanelQtyPCS
  Case "Anz_Pakete*PaketUmfang*Faktor/Menge"
    ld_Perimeter = ((at_Package.PkgB + at_Package.PkgH) * 2) / 1000
    at_PackingItem.Qty = at_Palette.PackageQty * ld_Perimeter * at_PackingItem.Factor / ao_Product.PanelQtyPCS
  Case "Anz_Pakete/Menge"
    at_PackingItem.Qty = at_Palette.PackageQty / ao_Product.PanelQtyPCS
  Case "Anz_Paletten/Menge"
    at_PackingItem.Qty = at_Palette.PaletteQty / ao_Product.PanelQtyPCS
  Case "Anz_Paletten*Faktor/Menge"
    at_PackingItem.Qty = at_Palette.PaletteQty * at_PackingItem.Factor / ao_Product.PanelQtyPCS
  Case "Anz_PaletteWicklungen*PaletteUmfang*Faktor*Anz_Paletten/Menge"
    If at_PackingItem.ItemA <= 0 Then
      Exit Function
    End If
    ld_Perimeter = ((at_Palette.PalA + at_Palette.PalB) * 2) / 1000
    ld_GirdQty = (at_Palette.PalH + (at_Palette.RowsHeight * at_Package.PkgH)) / (at_PackingItem.ItemA / 2) + (2 * 3)
    at_PackingItem.Qty = ld_GirdQty * ld_Perimeter * at_PackingItem.Factor * at_Palette.PaletteQty / ao_Product.PanelQtyPCS
  Case Else
    at_PackingItem.Qty = 0
    Call mo_Tools.AddCheckError(eDPCError.erBOMIncorrectFormula, ms_Language_Code, ao_ErrCollection, ao_Product)
    Exit Function
  End Select
  CalculatePackingItem = True
  Exit Function
ErrHandler:
  Call ErrorHandler("CalculatePackingItem")
End Function

Private Function AddBOMList(ByVal ao_Db As Object, ByVal ao_Product As DPC_Product, ByVal ao_ErrCollection As Collection) As Boolean
On Error GoTo ErrHandler

Dim lo_Inlay As DPC_Inlay
Dim lsa_Spacer() As String
Dim lsa_Gasket() As String
Dim ll_SideIdx As Long
Dim ll_Idx As Long
Dim lb_Found As Boolean
Dim lo_BOM As DPC_BOM
Dim ls_Request As String
  
  AddBOMList = False
  
  Call mo_Tools.ClearCollection(ao_Product.BOMs)
  
  Call AddBOMCoil(ao_Db, ao_Product, ao_ErrCollection)
  
  If ao_Product.HasSpacer Then
    ReDim lsa_Spacer(-1 To -1)
    For ll_SideIdx = eDPCSide.esSideC To eDPCSide.esSideF
      If ao_Product.IsSpacerOn(ll_SideIdx) Then
        lb_Found = False
        For ll_Idx = 0 To UBound(lsa_Spacer)
          If StrComp(lsa_Spacer(ll_Idx), ao_Product.GSK_Id2(ll_SideIdx), vbTextCompare) = 0 Then
            lb_Found = True
            Exit For
          End If
        Next
        If Not lb_Found Then
          If UBound(lsa_Spacer) = -1 Then
            ReDim lsa_Spacer(0)
          Else
            ReDim Preserve lsa_Spacer(UBound(lsa_Spacer) + 1)
          End If
          lsa_Spacer(UBound(lsa_Spacer)) = ao_Product.GSK_Id2(ll_SideIdx)
          Set lo_BOM = AddBOMSpacer(ao_Db, ao_Product, ao_Product.GSK_Id2(ll_SideIdx), ao_ErrCollection)
          For ll_Idx = eDPCSide.esSideC To eDPCSide.esSideF
            If ao_Product.GSK_Id2(ll_SideIdx) = ao_Product.GSK_Id2(ll_Idx) Then
              ao_Product.GSK_ExName2(ll_Idx) = lo_BOM.BOM_Name
            End If
          Next
        End If
      End If
    Next
  End If
  
  If ao_Product.HasGasket Then
    ReDim lsa_Gasket(-1 To -1)
    For ll_SideIdx = eDPCSide.esSideC To eDPCSide.esSideF
      If ao_Product.IsGasketOn(ll_SideIdx) Then
        lb_Found = False
        For ll_Idx = 0 To UBound(lsa_Gasket)
          If StrComp(lsa_Gasket(ll_Idx), ao_Product.GSK_Id(ll_SideIdx), vbTextCompare) = 0 Then
            lb_Found = True
            Exit For
          End If
        Next
        If Not lb_Found Then
          If UBound(lsa_Gasket) = -1 Then
            ReDim lsa_Gasket(0)
          Else
            ReDim Preserve lsa_Gasket(UBound(lsa_Gasket) + 1)
          End If
          lsa_Gasket(UBound(lsa_Gasket)) = ao_Product.GSK_Id(ll_SideIdx)
          Set lo_BOM = AddBOMGasket(ao_Db, ao_Product, ao_Product.GSK_Id(ll_SideIdx), ao_ErrCollection)
          For ll_Idx = eDPCSide.esSideC To eDPCSide.esSideF
            If ao_Product.GSK_Id(ll_SideIdx) = ao_Product.GSK_Id(ll_Idx) Then
              ao_Product.GSK_ExName(ll_Idx) = lo_BOM.BOM_Name
            End If
          Next
        End If
      End If
    Next
    ReDim lsa_Gasket(-1 To -1)
  End If
  
  If ao_Product.HasCoating Then
    Set lo_BOM = AddBOMCoating(ao_Db, ao_Product, ao_ErrCollection)
    ao_Product.COA_ExName = lo_BOM.BOM_Name
  End If
  
  If ao_Product.Inlays.Count > 0 Then
    For Each lo_Inlay In ao_Product.Inlays
      If FindInlay(ao_Db, ao_Product, lo_Inlay, ao_ErrCollection) Then
        Set lo_BOM = AddBOMInlay(ao_Db, ao_Product, lo_Inlay, ao_ErrCollection)
        lo_Inlay.PIN_ExName = lo_BOM.BOM_Name
        Call ao_Product.InlayUpdate(lo_Inlay)
      End If
    Next
  End If
  
  If ao_Product.HasPacking Then
    Call AddBOMPacking(ao_Db, ao_Product, ao_ErrCollection)
  End If
  Set lo_BOM = Nothing
  AddBOMList = True
  Exit Function
ErrHandler:
  Call ErrorHandler("AddBOMList")
End Function

'Private Function GetSalaryFactor(ByVal lo_BOR As DPC_BOR, ByVal ao_Db As Object) As Boolean
'On Error GoTo ErrHandler
'
'Dim ls_Request As String
'Dim lc_Cursor As Long
'
'  GetSalaryFactor = False
'  ls_Request = "SELECT ks_varper " & _
'              "FROM f310 " & _
'              "WHERE " & _
'              "fi_nr=1 AND " & _
'              "kostst=$BOR_KostSt$ AND " & _
'              "lgrp=$BOR_Lgrp$"
'
'  ls_Request = Replace(ls_Request, "$BOR_KostSt$", mo_Tools.SqlInt(lo_BOR.BOR_KostSt), , , vbTextCompare)
'  ls_Request = Replace(ls_Request, "$BOR_Lgrp$", mo_Tools.SqlInt(lo_BOR.BOR_Lgrp), , , vbTextCompare)
'  lc_Cursor = mo_Tools.OpenSQLSafe(ao_Db, ls_Request)
'  If ao_Db.RowCount(lc_Cursor) = 1 Then
'    lo_BOR.BOR_VarPerFact = ao_Db.GetFields(lc_Cursor, "ks_varper")
'    GetSalaryFactor = True
'  End If
'  Call ao_Db.Close(lc_Cursor)
'  Exit Function
'ErrHandler:
'  Call ErrorHandler("GetSalaryFactor")
'End Function

'Private Function GetOperationTime(ByVal ao_Product As DPC_Product, ByVal lo_BOR As DPC_BOR, ByVal ao_Db As Object) As Boolean
'On Error GoTo ErrHandler
'
'Dim ls_Request As String
'Dim lc_Cursor As Long
'
'  GetOperationTime = False
'  ls_Request = "SELECT TOP 1 te,tr,lgtr,brtr,laenge,breite " & _
'              "FROM fa211 " & _
'              "WHERE " & _
'              "fi_nr=1 AND " & _
'              "kostst=$BOR_KostSt$ AND " & _
'              "stagnr=$BOR_StagNr$ AND " & _
'              "laenge>=$RPL_PanA$ AND " & _
'              "breite>=$RPL_PanB$ " & _
'              "ORDER BY laenge,breite"
'  ls_Request = Replace(ls_Request, "$BOR_KostSt$", mo_Tools.SqlInt(lo_BOR.BOR_KostSt), , , vbTextCompare)
'  ls_Request = Replace(ls_Request, "$BOR_StagNr$", mo_Tools.SqlStr(lo_BOR.BOR_StagNr), , , vbTextCompare)
'  ls_Request = Replace(ls_Request, "$RPL_PanA$", mo_Tools.SqlDbl(ao_Product.RPL_PanA), , , vbTextCompare)
'  ls_Request = Replace(ls_Request, "$RPL_PanB$", mo_Tools.SqlDbl(ao_Product.RPL_PanB), , , vbTextCompare)
'  lc_Cursor = mo_Tools.OpenSQLSafe(ao_Db, ls_Request)
'  If ao_Db.RowCount(lc_Cursor) = 1 Then
'    lo_BOR.BOR_Te = ao_Db.GetFields(lc_Cursor, "te")
'    lo_BOR.BOR_Tr = ao_Db.GetFields(lc_Cursor, "tr")
'    lo_BOR.BOR_Lgtr = ao_Db.GetFields(lc_Cursor, "lgtr")
'    lo_BOR.BOR_Brtr = ao_Db.GetFields(lc_Cursor, "brtr")
'    GetOperationTime = True
'  End If
'  Call ao_Db.Close(lc_Cursor)
'  Exit Function
'ErrHandler:
'  Call ErrorHandler("GetOperationTime")
'End Function

Private Sub AddBORMultipleOperations(ByVal ao_Db As Object, ByVal ac_Cursor As Long, ByVal ao_Product As DPC_Product, ByVal ae_Operation As eDPCBOROperation, ByVal ao_ErrCollection As Collection, Optional ByVal as_ExtText As String = "")
On Error GoTo ErrHandler

Dim ll_Idx As Long
Dim ll_AgId As Long
Dim ll_WghPnt As Long
Dim lb_Found As Boolean
Dim lo_BOR As DPC_BOR
    
  lb_Found = False
  For ll_Idx = 1 To 3
    ll_AgId = mo_Db.GetFields(ac_Cursor, "AgId" & ll_Idx)
    ll_WghPnt = mo_Db.GetFields(ac_Cursor, "WghPnt" & ll_Idx)
    If ll_AgId <> 0 Then
      Set lo_BOR = AddBOR(ao_Db, ao_Product, ae_Operation, ll_WghPnt)
      If Not lo_BOR.LoadBORFromBaeurer(ao_Db, ll_AgId) Then
        Call SetBORErr(lo_BOR, eDPCError.erBORRoutingNotFoundB7, ao_ErrCollection, ao_Product)
      End If
      If Not lo_BOR.LoadBORTimeFromBaeurer(ao_Db, ao_Product) Then
        Call mo_Tools.AddCheckError(eDPCError.erBORRoutingTimeNotFound, ms_Language_Code, ao_ErrCollection, ao_Product)
        lo_BOR.BOR_Status = eDPCBOMBORStatus.boGeneratedError
      End If
      If as_ExtText <> "" Then
        lo_BOR.BOR_Name = lo_BOR.BOR_Name & " " & as_ExtText
      End If
      lb_Found = True
    End If
  Next
  If Not lb_Found Then
    Set lo_BOR = AddBOR(ao_Db, ao_Product, ae_Operation, 0)
    Call SetBORErr(lo_BOR, eDPCError.erBORRoutingSettingMissing, ao_ErrCollection, ao_Product)
  End If
  Exit Sub
ErrHandler:
  Call ErrorHandler("AddBORMultipleOperations")
End Sub

Private Sub AddBORPerforation(ByVal ao_Db As Object, ByVal ao_Product As DPC_Product, ByVal ao_ErrCollection As Collection)
On Error GoTo ErrHandler

Dim lo_BOR As DPC_BOR
Dim ls_req As String
Dim lc_Cursor As Long

 ls_req = "exec DPC_BOR_Generate_Perforation_lst $PRD_Id$,$OPR_Id$,$CAT_Id$,$PanelQtyM2$,$RPL_CutA$,$RPL_CutB$"
'  ls_Request = _
'    "SELECT TOP 1 BOP.BOP_Priority, BOP.BOP_AgId1 as AgId1, BOP.BOP_AgId2 as AgId2, BOP.BOP_AgId3 as AgId3," & _
'    "BOP.BOP_WghPnt1 as WghPnt1, BOP.BOP_WghPnt2 as WghPnt2, BOP.BOP_WghPnt3 as WghPnt3 " & _
'    "FROM DPC_BOR_Perf BOP " & _
'    "INNER JOIN DPC_BOR_Param_Sys BPS ON (BPS.BPS_Id=BOP.BOP_Id and BPS.OPR_Id=$OPR_Id$ AND BPS.SYS_Id=$SYS_Id$) " & _
'    "INNER JOIN DPC_BOR_Param_Prod BPP ON (BPP.BPP_Id=BOP.BOP_Id and BPP.OPR_Id=$OPR_Id$ AND BPP.CAT_Id=$CAT_Id$ AND BPP.PRD_Id=$PRF_Id$) " & _
'    "INNER JOIN DPC_BOR_Param_Mat BPM ON (BPM.BPM_Id=BOP.BOP_Id and BPM.OPR_Id=$OPR_Id$ AND BPM.MAT_Id=$MAT_Id$) " & _
'    "WHERE " & _
'    "(ROUND(BOP.BOP_ThsMin,2) < $RPL_Thick$ AND $RPL_Thick$ <= ROUND(BOP.BOP_ThsMax,2)) AND " & _
'    "(BOP.BOP_QtyMin < $Qty$ AND $Qty$ <= BOP.BOP_QtyMax) AND " & _
'    "(ROUND(BOP.BOP_CutAMin,2) < $RPL_CutA$ AND $RPL_CutA$ <= ROUND(BOP.BOP_CutAMax,2)) AND " & _
'    "(ROUND(BOP.BOP_CutBMin,2) < $RPL_CutB$ AND $RPL_CutB$ <= ROUND(BOP.BOP_CutBMax,2)) AND " & _
'    "BOP.Drop_Flag='' " & _
'    "ORDER BY BOP.BOP_Priority"

  ls_req = Replace(ls_req, "$PRD_Id$", mo_Tools.SQLStr(ao_Product.PRD_Id), , , vbTextCompare)
  ls_req = Replace(ls_req, "$OPR_Id$", mo_Tools.SqlInt(eDPCBOROperation.ePerforation), , , vbTextCompare)
  ls_req = Replace(ls_req, "$CAT_Id$", mo_Tools.SqlInt(eDPCCategory.cgPerforation), , , vbTextCompare)
  ls_req = Replace(ls_req, "$PanelQtyM2$", mo_Tools.SqlDbl(ao_Product.PanelQtyM2), , , vbTextCompare)
  ls_req = Replace(ls_req, "$RPL_CutA$", mo_Tools.SqlDbl(ao_Product.RPL_CutA), , , vbTextCompare)
  ls_req = Replace(ls_req, "$RPL_CutB$", mo_Tools.SqlDbl(ao_Product.RPL_CutB), , , vbTextCompare)
  lc_Cursor = mo_Tools.OpenSQLSafe(mo_Db, ls_req)
  If mo_Db.RowCount(lc_Cursor) > 0 Then
    Call AddBORMultipleOperations(ao_Db, lc_Cursor, ao_Product, eDPCBOROperation.ePerforation, ao_ErrCollection)
  Else
    Set lo_BOR = AddBOR(ao_Db, ao_Product, eDPCBOROperation.ePerforation, 0)
    Call SetBORErr(lo_BOR, eDPCError.erBORRoutingSettingMissing, ao_ErrCollection, ao_Product)
  End If
  Call mo_Db.Close(lc_Cursor)
  Exit Sub
ErrHandler:
  Call ErrorHandler("AddBORPerforation")
End Sub

Private Sub AddBORRerolling(ByVal ao_Db As Object, ByVal ao_Product As DPC_Product, ByVal ao_ErrCollection As Collection)
On Error GoTo ErrHandler

Dim ls_req As String
Dim lc_Cursor As Long

 ls_req = "exec DPC_BOR_Generate_Rerolling_lst $PRD_Id$,$OPR_Id$,$CAT_Id$,$PanelQty$,$RPL_CutA$,$RPL_CutB$"
'  ls_Request = _
'    "SELECT TOP 1 BRR.BRR_Priority, BRR.BRR_AgId1 as AgId1, BRR.BRR_AgId2 as AgId2, BRR.BRR_AgId3 as AgId3," & _
'    "BRR.BRR_WghPnt1 as WghPnt1, BRR.BRR_WghPnt2 as WghPnt2, BRR.BRR_WghPnt3 as WghPnt3 " & _
'    "FROM DPC_BOR_Rerolling BRR " & _
'    "INNER JOIN DPC_BOR_Param_Sys BPS ON (BPS.BPS_Id=BRR.BRR_Id and BPS.OPR_Id=$OPR_Id$ AND BPS.SYS_Id=$SYS_Id$) " & _
'    "INNER JOIN DPC_BOR_Param_Prod BPP ON (BPP.BPP_Id=BRR.BRR_Id and BPP.OPR_Id=$OPR_Id$ AND BPP.CAT_Id=$CAT_Id$ AND BPP.PRD_Id=$PRF_Id$) " & _
'    "INNER JOIN DPC_BOR_Param_Mat BPM ON (BPM.BPM_Id=BRR.BRR_Id and BPM.OPR_Id=$OPR_Id$ AND BPM.MAT_Id=$MAT_Id$) " & _
'    "WHERE " & _
'    "(ROUND(BRR.BRR_ThsMin,2) < $RPL_Thick$ AND $RPL_Thick$ <= ROUND(BRR.BRR_ThsMax,2)) AND " & _
'    "(BRR.BRR_QtyMin < $Qty$ AND $Qty$ <= BRR.BRR_QtyMax) AND " & _
'    "(ROUND(BRR.BRR_CutAMin,2) < $RPL_CutA$ AND $RPL_CutA$ <= ROUND(BRR.BRR_CutAMax,2)) AND " & _
'    "(ROUND(BRR.BRR_CutBMin,2) < $RPL_CutB$ AND $RPL_CutB$ <= ROUND(BRR.BRR_CutBMax,2)) AND " & _
'    "BRR.Drop_Flag='' " & _
'    "ORDER BY BRR.BRR_Priority"

  ls_req = Replace(ls_req, "$PRD_Id$", mo_Tools.SQLStr(ao_Product.PRD_Id), , , vbTextCompare)
  ls_req = Replace(ls_req, "$OPR_Id$", mo_Tools.SqlInt(eDPCBOROperation.eRerolling), , , vbTextCompare)
  ls_req = Replace(ls_req, "$CAT_Id$", mo_Tools.SqlInt(eDPCCategory.cgPerforation), , , vbTextCompare)
  ls_req = Replace(ls_req, "$PanelQty$", mo_Tools.SqlInt(ao_Product.PanelQtyPCS), , , vbTextCompare)
  ls_req = Replace(ls_req, "$RPL_CutA$", mo_Tools.SqlDbl(ao_Product.RPL_CutA), , , vbTextCompare)
  ls_req = Replace(ls_req, "$RPL_CutB$", mo_Tools.SqlDbl(ao_Product.RPL_CutB), , , vbTextCompare)
  lc_Cursor = mo_Tools.OpenSQLSafe(mo_Db, ls_req)
  If mo_Db.RowCount(lc_Cursor) = 1 Then
    Call AddBORMultipleOperations(ao_Db, lc_Cursor, ao_Product, eDPCBOROperation.eRerolling, ao_ErrCollection)
  End If
  Call mo_Db.Close(lc_Cursor)
  Exit Sub
ErrHandler:
  Call ErrorHandler("AddBORRerolling")
End Sub

Private Sub AddBORCutting(ByVal ao_Db As Object, ByVal ao_Product As DPC_Product, ByVal ao_ErrCollection As Collection)
On Error GoTo ErrHandler

Dim lo_BOR As DPC_BOR
Dim ls_req As String
Dim lc_Cursor As Long

 ls_req = "exec DPC_BOR_Generate_Cutting_lst $PRD_Id$,$OPR_Id$,$CAT_Id$,$PanelQty$,$RPL_CutA$,$RPL_CutB$"
'  ls_Request = _
'    "SELECT TOP 1 BOC.BOC_Priority, BOC.BOC_AgId1 as AgId1, BOC.BOC_AgId2 as AgId2, BOC.BOC_AgId3 as AgId3," & _
'    "BOC.BOC_WghPnt1 as WghPnt1, BOC.BOC_WghPnt2 as WghPnt2, BOC.BOC_WghPnt3 as WghPnt3 " & _
'    "FROM DPC_BOR_Cutting BOC " & _
'    "INNER JOIN DPC_BOR_Param_Mat BPM ON (BPM.BPM_Id=BOC.BOC_Id and BPM.OPR_Id=$OPR_Id$ AND BPM.MAT_Id=$MAT_Id$) " & _
'    "WHERE " & _
'    "(ROUND(BOC.BOC_ThsMin,2) < $RPL_Thick$ AND $RPL_Thick$ <= ROUND(BOC.BOC_ThsMax,2)) AND " & _
'    "(BOC.BOC_QtyMin < $Qty$ AND $Qty$ <= BOC.BOC_QtyMax) AND " & _
'    "(ROUND(BOC.BOC_CutAMin,2) < $RPL_CutA$ AND $RPL_CutA$ <= ROUND(BOC.BOC_CutAMax,2)) AND " & _
'    "(ROUND(BOC.BOC_CutBMin,2) < $RPL_CutB$ AND $RPL_CutB$ <= ROUND(BOC.BOC_CutBMax,2)) AND " & _
'    "BOC.Drop_Flag='' " & _
'    "ORDER BY BOC.BOC_Priority"

  ls_req = Replace(ls_req, "$PRD_Id$", mo_Tools.SQLStr(ao_Product.PRD_Id), , , vbTextCompare)
  ls_req = Replace(ls_req, "$OPR_Id$", mo_Tools.SqlInt(eDPCBOROperation.eCutting), , , vbTextCompare)
  ls_req = Replace(ls_req, "$CAT_Id$", mo_Tools.SqlInt(eDPCCategory.cgPerforation), , , vbTextCompare)
  ls_req = Replace(ls_req, "$PanelQty$", mo_Tools.SqlInt(ao_Product.PanelQtyPCS), , , vbTextCompare)
  ls_req = Replace(ls_req, "$RPL_CutA$", mo_Tools.SqlDbl(ao_Product.RPL_CutA), , , vbTextCompare)
  ls_req = Replace(ls_req, "$RPL_CutB$", mo_Tools.SqlDbl(ao_Product.RPL_CutB), , , vbTextCompare)
  lc_Cursor = mo_Tools.OpenSQLSafe(mo_Db, ls_req)
  If mo_Db.RowCount(lc_Cursor) > 0 Then
    Call AddBORMultipleOperations(ao_Db, lc_Cursor, ao_Product, eDPCBOROperation.eCutting, ao_ErrCollection)
  Else
    Set lo_BOR = AddBOR(ao_Db, ao_Product, eDPCBOROperation.eCutting, 0)
    Call SetBORErr(lo_BOR, eDPCError.erBORRoutingSettingMissing, ao_ErrCollection, ao_Product)
  End If
  Call mo_Db.Close(lc_Cursor)
  Exit Sub
ErrHandler:
  Call ErrorHandler("AddBORCutting")
End Sub

Private Sub AddBORPunchNotching(ByVal ao_Db As Object, ByVal ao_Product As DPC_Product, ByVal lo_Cutout As DPC_Cutout, ByVal ao_ErrCollection As Collection)
On Error GoTo ErrHandler

Dim lo_BOR As DPC_BOR
Dim ls_req As String
Dim lc_Cursor As Long

  ls_req = "exec DPC_BOR_Generate_PunchNotch_lst $PRD_Id$,$OPR_Id$,$CAT_Id$,$PanelQty$,$RPL_CutA$,$RPL_CutB$,$PCT_Id$"
'  ls_Request = _
'    "SELECT TOP 1 BPN.BPN_Priority, BPN.BPN_AgId1 as AgId1, BPN.BPN_AgId2 as AgId2, BPN.BPN_AgId3 as AgId3," & _
'    "BPN.BPN_WghPnt1 as WghPnt1, BPN.BPN_WghPnt2 as WghPnt2, BPN.BPN_WghPnt3 as WghPnt3 " & _
'    "FROM DPC_BOR_PunchNotching BPN " & _
'    "INNER JOIN DPC_BOR_Param_Sys BPS ON (BPS.BPS_Id=BPN.BPN_Id and BPS.OPR_Id=$OPR_Id$ AND BPS.SYS_Id=$SYS_Id$) " & _
'    "INNER JOIN DPC_BOR_Param_Prod BPP ON (BPP.BPP_Id=BPN.BPN_Id and BPP.OPR_Id=$OPR_Id$ AND BPP.CAT_Id=$CAT_Id$ AND BPP.PRD_Id=$PRF_Id$) " & _
'    "INNER JOIN DPC_BOR_Param_Mat BPM ON (BPM.BPM_Id=BPN.BPN_Id and BPM.OPR_Id=$OPR_Id$ AND BPM.MAT_Id=$MAT_Id$) " & _
'    "WHERE " & _
'    "(BPN.CUT_Id=$CUT_Id$) AND " & _
'    "(BPN.BPN_QtyMin < $Qty$ AND $Qty$ <= BPN.BPN_QtyMax) AND " & _
'    "(ROUND(BPN.BPN_CutAMin,2) < $RPL_CutA$ AND $RPL_CutA$ <= ROUND(BPN.BPN_CutAMax,2)) AND " & _
'    "(ROUND(BPN.BPN_CutBMin,2) < $RPL_CutB$ AND $RPL_CutB$ <= ROUND(BPN.BPN_CutBMax,2)) AND " & _
'    "($PCT_SizeJ$ <= ROUND(BPN.BPN_JMax,2)) AND " & _
'    "($PCT_SizeK$ <= ROUND(BPN.BPN_KMax,2)) AND " & _
'    "($PCT_SizeD$ <= ROUND(BPN.BPN_DMax,2)) AND " & _
'    "BPN.Drop_Flag='' " & _
'    "ORDER BY BPN.BPN_Priority, BPN.BPN_JMax, BPN.BPN_KMax, BPN.BPN_DMax"

  ls_req = Replace(ls_req, "$PRD_Id$", mo_Tools.SQLStr(ao_Product.PRD_Id), , , vbTextCompare)
  ls_req = Replace(ls_req, "$OPR_Id$", mo_Tools.SqlInt(eDPCBOROperation.ePunchNotching), , , vbTextCompare)
  ls_req = Replace(ls_req, "$CAT_Id$", mo_Tools.SqlInt(eDPCCategory.cgPerforation), , , vbTextCompare)
  ls_req = Replace(ls_req, "$PanelQty$", mo_Tools.SqlInt(ao_Product.PanelQtyPCS), , , vbTextCompare)
  ls_req = Replace(ls_req, "$RPL_CutA$", mo_Tools.SqlDbl(ao_Product.RPL_CutA), , , vbTextCompare)
  ls_req = Replace(ls_req, "$RPL_CutB$", mo_Tools.SqlDbl(ao_Product.RPL_CutB), , , vbTextCompare)
  If lo_Cutout Is Nothing Then
    ls_req = Replace(ls_req, "$PCT_Id$", "NULL", , , vbTextCompare)
  Else
    ls_req = Replace(ls_req, "$PCT_Id$", mo_Tools.SQLStr(lo_Cutout.PCT_Id), , , vbTextCompare)
  End If
  lc_Cursor = mo_Tools.OpenSQLSafe(mo_Db, ls_req)
  If mo_Db.RowCount(lc_Cursor) > 0 Then
    Call AddBORMultipleOperations(ao_Db, lc_Cursor, ao_Product, eDPCBOROperation.ePunchNotching, ao_ErrCollection)
  ElseIf Not lo_Cutout Is Nothing Then
    Set lo_BOR = AddBOR(ao_Db, ao_Product, eDPCBOROperation.ePunchNotching, 0)
    Call SetBORErr(lo_BOR, eDPCError.erBORRoutingSettingMissing, ao_ErrCollection, ao_Product)
  End If
  Call mo_Db.Close(lc_Cursor)
  Exit Sub
ErrHandler:
  Call ErrorHandler("AddBORPunchNotching")
End Sub

Private Sub AddBORBending(ByVal ao_Db As Object, ByVal ao_Product As DPC_Product, ByVal ao_ErrCollection As Collection)
On Error GoTo ErrHandler

Dim lo_BOR As DPC_BOR
Dim ls_req As String
Dim lc_SpecCursor As Long
Dim lc_ParamCursor As Long
Dim ll_BOB_Id As Long
Dim ll_SideIdx As eDPCSide
Dim lb_FoundBOR As Boolean


  ls_req = "exec DPC_BOR_Generate_BendingSpec_lst $PRD_Id$,$OPR_Id$,$CAT_Id$,$PanelQtyPCS$,$RPL_CutA$,$RPL_CutB$,$BOS_ExtBnd$"
'  ls_Req = "SELECT DISTINCT BOB.BOB_Id, BOB.BOB_Priority "
'  ls_Req = ls_Req & "FROM DPC_BOR_Bend BOB "
'  ls_Req = ls_Req & "INNER JOIN DPC_BOR_Bend_Spec BOS ON (BOB.BOB_Id=BOS.BOB_Id) "
'  ls_Req = ls_Req & "INNER JOIN DPC_BOR_Param_Sys BPS ON (BPS.BPS_Id=BOB.BOB_Id and BPS.OPR_Id=$OPR_Id$ AND BPS.SYS_Id=$SYS_Id$) "
'  ls_Req = ls_Req & "WHERE "
'  ls_Req = ls_Req & "(ROUND(BOS.BOS_PanAMin,2) < $RPL_PanA$ AND $RPL_PanA$ <= ROUND(BOS.BOS_PanAMax,2)) AND "
'  ls_Req = ls_Req & "(ROUND(BOS.BOS_PanBMin,2) < $RPL_PanB$ AND $RPL_PanB$ <= ROUND(BOS.BOS_PanBMax,2)) AND "
'  ls_Req = ls_Req & "(ROUND(BOS.BOS_CutAMin,2) < $RPL_CutA$ AND $RPL_CutA$ <= ROUND(BOS.BOS_CutAMax,2)) AND "
'  ls_Req = ls_Req & "(ROUND(BOS.BOS_CutBMin,2) < $RPL_CutB$ AND $RPL_CutB$ <= ROUND(BOS.BOS_CutBMax,2)) AND "
'  ls_Req = ls_Req & "(ROUND(BOS.BOS_ThsMin,2) < $RPL_Thick$ AND $RPL_Thick$ <= ROUND(BOS.BOS_ThsMax,2)) AND "
'  ls_Req = ls_Req & "((BOS.BOS_ABMin=0) OR (ABS($RPL_PanA$-$RPL_PanB$) > BOS.BOS_ABMin)) AND "
'  ls_Req = ls_Req & "((BOS.BOS_CDIsEqual='') OR ($BND_IdC$=$BND_IdD$)) AND "
'  ls_Req = ls_Req & "(BOS.BOS_ExtBnd <=$BOS_ExtBnd$) AND "
'  ls_Req = ls_Req & "(BOB.Drop_Flag='') AND "
'  ls_Req = ls_Req & "(BOS.Drop_Flag='') "
'  ls_Req = ls_Req & "ORDER BY BOB.BOB_Priority"
  
  ls_req = Replace(ls_req, "$PRD_Id$", mo_Tools.SQLStr(ao_Product.PRD_Id), , , vbTextCompare)
  ls_req = Replace(ls_req, "$OPR_Id$", mo_Tools.SqlInt(eDPCBOROperation.eBending), , , vbTextCompare)
  ls_req = Replace(ls_req, "$CAT_Id$", mo_Tools.SqlInt(eDPCCategory.cgBending), , , vbTextCompare)
  ls_req = Replace(ls_req, "$PanelQtyPCS$", mo_Tools.SqlInt(ao_Product.PanelQtyPCS), , , vbTextCompare)
  ls_req = Replace(ls_req, "$RPL_CutA$", mo_Tools.SqlDbl(ao_Product.RPL_CutA), , , vbTextCompare)
  ls_req = Replace(ls_req, "$RPL_CutB$", mo_Tools.SqlDbl(ao_Product.RPL_CutB), , , vbTextCompare)
  ls_req = Replace(ls_req, "$BOS_ExtBnd$", mo_Tools.SqlDbl(ao_Product.GetCutoutMinOutEdge), , , vbTextCompare)
  
  lb_FoundBOR = False
  ll_BOB_Id = 0
  lc_SpecCursor = mo_Tools.OpenSQLSafe(mo_Db, ls_req)
  Do While Not mo_Db.EOF(lc_SpecCursor)
    ll_BOB_Id = mo_Db.GetFields(lc_SpecCursor, "BOB_Id")
    
      ls_req = "exec DPC_BOR_Generate_BendingParam_lst $BOB_Id$,$PRD_Id$,$OPR_Id$,$CAT_Id$,$PanelQty$,$RPL_HC$,$RPL_HD$,$RPL_HE$,$RPL_HF$,$RPL_UC$,$RPL_UD$,$RPL_UE$,$RPL_UF$,$RPL_SC$,$RPL_SD$,$RPL_SE$,$RPL_SF$"
'    ls_Req = "SELECT TOP 1 BOE.BOE_AgId1 as AgId1, BOE.BOE_AgId2 as AgId2, BOE.BOE_AgId3 as AgId3,"
'    ls_Req = ls_Req & "BOE.BOE_WghPnt1 as WghPnt1, BOE.BOE_WghPnt2 as WghPnt2, BOE.BOE_WghPnt3 as WghPnt3 "
'    ls_Req = ls_Req & "FROM DPC_BOR_Bend_Param BOE "
'    ls_Req = ls_Req & "WHERE "
'    ls_Req = ls_Req & "(BOE.BOB_Id=$BOB_Id$) AND "
'    ls_Req = ls_Req & "(BOE.BND_IdC=$BND_IdC$) AND "
'    ls_Req = ls_Req & "(BOE.BND_IdD=$BND_IdD$) AND "
'    ls_Req = ls_Req & "(BOE.BND_IdE=$BND_IdE$) AND "
'    ls_Req = ls_Req & "(BOE.BND_IdF=$BND_IdF$) AND "
'    ls_Req = ls_Req & "(ROUND(BOE.BOE_CHMin,2) < $RPL_HC$ AND $RPL_HC$ <= ROUND(BOE.BOE_CHMax,2)) AND "
'    ls_Req = ls_Req & "(ROUND(BOE.BOE_DHMin,2) < $RPL_HD$ AND $RPL_HD$ <= ROUND(BOE.BOE_DHMax,2)) AND "
'    ls_Req = ls_Req & "(ROUND(BOE.BOE_EHMin,2) < $RPL_HE$ AND $RPL_HE$ <= ROUND(BOE.BOE_EHMax,2)) AND "
'    ls_Req = ls_Req & "(ROUND(BOE.BOE_FHMin,2) < $RPL_HF$ AND $RPL_HF$ <= ROUND(BOE.BOE_FHMax,2)) AND "
'    ls_Req = ls_Req & "(ROUND(BOE.BOE_CUZMin,2) < $RPL_UC$ AND $RPL_UC$ <= ROUND(BOE.BOE_CUZMax,2)) AND "
'    ls_Req = ls_Req & "(ROUND(BOE.BOE_DUZMin,2) < $RPL_UD$ AND $RPL_UD$ <= ROUND(BOE.BOE_DUZMax,2)) AND "
'    ls_Req = ls_Req & "(ROUND(BOE.BOE_EUZMin,2) < $RPL_UE$ AND $RPL_UE$ <= ROUND(BOE.BOE_EUZMax,2)) AND "
'    ls_Req = ls_Req & "(ROUND(BOE.BOE_FUZMin,2) < $RPL_UF$ AND $RPL_UF$ <= ROUND(BOE.BOE_FUZMax,2)) AND "
'    ls_Req = ls_Req & "((ROUND(BOE.BOE_CSMin,2) < $RPL_SC$ AND $RPL_SC$ <= ROUND(BOE.BOE_CSMax,2)) OR ($RPL_SC$=0)) AND "
'    ls_Req = ls_Req & "((ROUND(BOE.BOE_DSMin,2) < $RPL_SD$ AND $RPL_SD$ <= ROUND(BOE.BOE_DSMax,2)) OR ($RPL_SD$=0)) AND "
'    ls_Req = ls_Req & "((ROUND(BOE.BOE_ESMin,2) < $RPL_SE$ AND $RPL_SE$ <= ROUND(BOE.BOE_ESMax,2)) OR ($RPL_SE$=0)) AND "
'    ls_Req = ls_Req & "((ROUND(BOE.BOE_FSMin,2) < $RPL_SF$ AND $RPL_SF$ <= ROUND(BOE.BOE_FSMax,2)) OR ($RPL_SF$=0)) AND "
'    ls_Req = ls_Req & "(BOE.Drop_Flag='') "
'    ls_Req = ls_Req & "ORDER BY BOE.BOE_QtyMax, BOE.BOE_QtyMin "
    
    ls_req = Replace(ls_req, "$BOB_Id$", mo_Tools.SqlInt(ll_BOB_Id), , , vbTextCompare)
    ls_req = Replace(ls_req, "$PRD_Id$", mo_Tools.SQLStr(ao_Product.PRD_Id), , , vbTextCompare)
    ls_req = Replace(ls_req, "$OPR_Id$", mo_Tools.SqlInt(eDPCBOROperation.eBending), , , vbTextCompare)
    ls_req = Replace(ls_req, "$CAT_Id$", mo_Tools.SqlInt(eDPCCategory.cgBending), , , vbTextCompare)
    ls_req = Replace(ls_req, "$PanelQty$", mo_Tools.SqlInt(ao_Product.PanelQtyPCS), , , vbTextCompare)
    For ll_SideIdx = eDPCSide.esSideC To eDPCSide.esSideF
      ls_req = Replace(ls_req, "$BND_Id" & mv_Edge(ll_SideIdx) & "$", mo_Tools.SqlStrKey(ao_Product.BND_Id(ll_SideIdx)), , , vbTextCompare)
      ls_req = Replace(ls_req, "$RPL_H" & mv_Edge(ll_SideIdx) & "$", mo_Tools.SqlDbl(ao_Product.RPL_H(ll_SideIdx)), , , vbTextCompare)
      ls_req = Replace(ls_req, "$RPL_U" & mv_Edge(ll_SideIdx) & "$", mo_Tools.SqlDbl(ao_Product.RPL_U(ll_SideIdx)), , , vbTextCompare)
      ls_req = Replace(ls_req, "$RPL_S" & mv_Edge(ll_SideIdx) & "$", mo_Tools.SqlDbl(ao_Product.RPL_S(ll_SideIdx)), , , vbTextCompare)
    Next
    lc_ParamCursor = mo_Tools.OpenSQLSafe(mo_Db, ls_req)
    If mo_Db.RowCount(lc_ParamCursor) > 0 Then
      Call AddBORMultipleOperations(ao_Db, lc_ParamCursor, ao_Product, eDPCBOROperation.eBending, ao_ErrCollection)
      Call mo_Db.Close(lc_ParamCursor)
      lb_FoundBOR = True
      Exit Do
    End If
    Call mo_Db.Close(lc_ParamCursor)
    Call mo_Db.Next(lc_SpecCursor)
  Loop
  Call mo_Db.Close(lc_SpecCursor)
  If Not lb_FoundBOR Then
    Set lo_BOR = AddBOR(ao_Db, ao_Product, eDPCBOROperation.eBending, 0)
    Call SetBORErr(lo_BOR, eDPCError.erBORRoutingSettingMissing, ao_ErrCollection, ao_Product)
  End If
  Exit Sub
ErrHandler:
  Call ErrorHandler("AddBORBending")
End Sub

Private Sub AddBORGasketSpacer(ByVal ao_Db As Object, ByVal ao_Product As DPC_Product, ByVal ae_GasketType As eDPCGasketType, ByVal ao_ErrCollection As Collection)
On Error GoTo ErrHandler

Dim lo_BOR As DPC_BOR
Dim ls_req As String
Dim lc_Cursor As Long

  ls_req = "exec DPC_BOR_Generate_GasketSpacer_lst $PRD_Id$,$OPR_Id$,$CAT_Id$,$PanelQty$,$BOG_Type$"
'  ls_Request = _
'    "SELECT TOP 1 BOG.BOG_Priority, BOG.BOG_AgId1 as AgId1, BOG.BOG_AgId2 as AgId2, BOG.BOG_AgId3 as AgId3," & _
'    "BOG.BOG_WghPnt1 as WghPnt1, BOG.BOG_WghPnt2 as WghPnt2, BOG.BOG_WghPnt3 as WghPnt3 " & _
'    "FROM DPC_BOR_Gasket BOG " & _
'    "WHERE " & _
'    "(BOG.PRF_Class=$PRF_Class$) AND " & _
'    "($RPL_PanA$ <= ROUND(BOG.BOG_PanAMax,2)) AND " & _
'    "($RPL_PanB$ <= ROUND(BOG.BOG_PanBMax,2)) AND " & _
'    "(BOG.BOG_Type=$BOG_Type$) AND " & _
'    "(BOG.Drop_Flag='') " & _
'    "ORDER BY BOG.BOG_Priority,BOG.BOG_PanAMax,BOG.BOG_PanBMax"

  
  ls_req = Replace(ls_req, "$PRD_Id$", mo_Tools.SQLStr(ao_Product.PRD_Id), , , vbTextCompare)
  ls_req = Replace(ls_req, "$OPR_Id$", mo_Tools.SqlInt(eDPCBOROperation.eGasketSpacer), , , vbTextCompare)
  ls_req = Replace(ls_req, "$CAT_Id$", mo_Tools.SqlInt(eDPCCategory.cgGasket), , , vbTextCompare)
  ls_req = Replace(ls_req, "$PanelQty$", mo_Tools.SqlInt(ao_Product.PanelQtyPCS), , , vbTextCompare)
  ls_req = Replace(ls_req, "$BOG_Type$", mo_Tools.SqlInt(ae_GasketType), , , vbTextCompare)
  
  lc_Cursor = mo_Tools.OpenSQLSafe(mo_Db, ls_req)
  If mo_Db.RowCount(lc_Cursor) > 0 Then
    Call AddBORMultipleOperations(ao_Db, lc_Cursor, ao_Product, eDPCBOROperation.eGasketSpacer, ao_ErrCollection)
  Else
    Set lo_BOR = AddBOR(ao_Db, ao_Product, eDPCBOROperation.eGasketSpacer, 0)
    Call SetBORErr(lo_BOR, eDPCError.erBORRoutingSettingMissing, ao_ErrCollection, ao_Product)
  End If
  Call mo_Db.Close(lc_Cursor)
  Exit Sub
ErrHandler:
  Call ErrorHandler("AddBORGasketSpacer")
End Sub

Private Sub AddBORCoating(ByVal ao_Db As Object, ByVal ao_Product As DPC_Product, ByVal ao_ErrCollection As Collection)
On Error GoTo ErrHandler

Dim lo_BOR As DPC_BOR
Dim ls_req As String
Dim lc_Cursor As Long

  ls_req = "exec DPC_BOR_Generate_Coating_lst $PRD_Id$,$OPR_Id$,$CAT_Id$,$PanelQty$,$BOA_BndVis$"
'  ls_Request = _
'    "SELECT TOP 1 BOA.BOA_Priority, BOA.BOA_AgId1 as AgId1, BOA.BOA_AgId2 as AgId2, BOA.BOA_AgId3 as AgId3," & _
'    "BOA.BOA_WghPnt1 as WghPnt1, BOA.BOA_WghPnt2 as WghPnt2, BOA.BOA_WghPnt3 as WghPnt3 " & _
'    "FROM DPC_BOR_Coating BOA " & _
'    "WHERE " & _
'    "(BOA.PRF_Class=$PRF_Class$) AND " & _
'    "($RPL_PanA$ <= ROUND(BOA.BOA_PanAMax,2)) AND " & _
'    "($RPL_PanB$ <= ROUND(BOA.BOA_PanBMax,2)) AND " & _
'    "(BOA.BOA_CoSid=$RPL_CoSid$) AND " & _
'    "(BOA.COA_Type=$COA_Type$) AND " & _
'    "(BOA.BOA_BndVis=$BOA_BndVis$) AND " & _
'    "(BOA.Drop_Flag='') " & _
'    "ORDER BY BOA.BOA_Priority,BOA.BOA_PanAMax,BOA.BOA_PanBMax"

  ls_req = Replace(ls_req, "$PRD_Id$", mo_Tools.SQLStr(ao_Product.PRD_Id), , , vbTextCompare)
  ls_req = Replace(ls_req, "$OPR_Id$", mo_Tools.SqlInt(eDPCBOROperation.eCoating), , , vbTextCompare)
  ls_req = Replace(ls_req, "$CAT_Id$", mo_Tools.SqlInt(eDPCCategory.cgCoating), , , vbTextCompare)
  ls_req = Replace(ls_req, "$PanelQty$", mo_Tools.SqlInt(ao_Product.PanelQtyPCS), , , vbTextCompare)
  ls_req = Replace(ls_req, "$BOA_BndVis$", mo_Tools.SqlBool(ao_Product.HasBendingVisible), , , vbTextCompare)
  
  lc_Cursor = mo_Tools.OpenSQLSafe(mo_Db, ls_req)
  If mo_Db.RowCount(lc_Cursor) > 0 Then
    Call AddBORMultipleOperations(ao_Db, lc_Cursor, ao_Product, eDPCBOROperation.eCoating, ao_ErrCollection)
  Else
    Set lo_BOR = AddBOR(ao_Db, ao_Product, eDPCBOROperation.eCoating, 0)
    Call SetBORErr(lo_BOR, eDPCError.erBORRoutingSettingMissing, ao_ErrCollection, ao_Product)
  End If
  Call mo_Db.Close(lc_Cursor)
  Exit Sub
ErrHandler:
  Call ErrorHandler("AddBORCoating")
End Sub

Private Sub AddBORInlay(ByVal ao_Db As Object, ByVal ao_Product As DPC_Product, ByVal ao_Inlay As DPC_Inlay, ByVal ao_ErrCollection As Collection)
On Error GoTo ErrHandler

Dim lo_BOR As DPC_BOR
Dim ls_req As String
Dim lc_Cursor As Long


  ls_req = "exec DPC_BOR_Generate_Inlay_lst $PRD_Id$,$OPR_Id$,$CAT_Id$,$PanelQty$,$PIN_Id$"
'  ls_Request = _
'    "SELECT TOP 1 BOI.BOI_Priority, BOI.BOI_AgId1 as AgId1, BOI.BOI_AgId2 as AgId2, BOI.BOI_AgId3 as AgId3," & _
'    "BOI.BOI_WghPnt1 as WghPnt1, BOI.BOI_WghPnt2 as WghPnt2, BOI.BOI_WghPnt3 as WghPnt3 " & _
'    "FROM DPC_BOR_Inlay BOI " & _
'    "WHERE " & _
'    "(BOI.PRF_Class=$PRF_Class$) AND " & _
'    "($RPL_PanA$ <= ROUND(BOI.BOI_PanAMax,2)) AND " & _
'    "($RPL_PanB$ <= ROUND(BOI.BOI_PanBMax,2)) AND " & _
'    "(BOI.Drop_Flag='') " & _
'    "ORDER BY BOI.BOI_Priority,BOI.BOI_PanAMax,BOI.BOI_PanBMax"

  ls_req = Replace(ls_req, "$PRD_Id$", mo_Tools.SQLStr(ao_Product.PRD_Id), , , vbTextCompare)
  ls_req = Replace(ls_req, "$OPR_Id$", mo_Tools.SqlInt(eDPCBOROperation.eInlay), , , vbTextCompare)
  ls_req = Replace(ls_req, "$CAT_Id$", mo_Tools.SqlInt(eDPCCategory.cgInlay), , , vbTextCompare)
  ls_req = Replace(ls_req, "$PanelQty$", mo_Tools.SqlInt(ao_Product.PanelQtyPCS), , , vbTextCompare)
  ls_req = Replace(ls_req, "$PIN_Id$", mo_Tools.SQLStr(ao_Inlay.PIN_Id), , , vbTextCompare)
  
  lc_Cursor = mo_Tools.OpenSQLSafe(mo_Db, ls_req)
  If mo_Db.RowCount(lc_Cursor) > 0 Then
    Call AddBORMultipleOperations(ao_Db, lc_Cursor, ao_Product, eDPCBOROperation.eInlay, ao_ErrCollection)
'  ElseIf mo_Db.RowCount(lc_Cursor) > 1 Then
'    Set lo_BOR = AddBOR(ao_Db, ao_Product, eDPCBOROperation.eInlay, 0)
'    Call SetBORErr(lo_BOR, eDPCError.erBOR, ao_ErrCollection, ao_Product)
  Else
    Set lo_BOR = AddBOR(ao_Db, ao_Product, eDPCBOROperation.eInlay, 0)
    Call SetBORErr(lo_BOR, eDPCError.erBORRoutingSettingMissing, ao_ErrCollection, ao_Product)
  End If
  Call mo_Db.Close(lc_Cursor)
  Exit Sub
ErrHandler:
  Call ErrorHandler("AddBORInlay")
End Sub

Private Sub AddBORPacking(ByVal ao_Db As Object, ByVal ao_Product As DPC_Product, ByVal ao_ErrCollection As Collection)
On Error GoTo ErrHandler

Dim lo_BOR As DPC_BOR
Dim ls_req As String
Dim lc_Cursor As Long
Dim ls_ExtText As String
Dim ll_PU As Long


  ls_req = "exec DPC_BOR_Generate_Packing_lst $PRD_Id$,$OPR_Id$,$CAT_Id$,$PanelQty$,$RPL_PkgA$,$RPL_PkgB$,$RPL_PkgH$,$RPL_PkgWgh$"
'  ls_Request = _
'    "SELECT TOP 1 BOK.BOK_Priority, BOK.BOK_AgId1 as AgId1, BOK.BOK_AgId2 as AgId2, BOK.BOK_AgId3 as AgId3," & _
'    "BOK.BOK_WghPnt1 as WghPnt1, BOK.BOK_WghPnt2 as WghPnt2, BOK.BOK_WghPnt3 as WghPnt3 " & _
'    "FROM DPC_BOR_Packing BOK " & _
'    "WHERE " & _
'    "(BOK.PKG_Id=$PKG_Id$) AND " & _
'    "(BOK.PRF_Class=$PRF_Class$) AND " & _
'    "($RPL_PkgA$ <= ROUND(BOK.BOK_PkgAMax,2)) AND " & _
'    "($RPL_PkgB$ <= ROUND(BOK.BOK_PkgBMax,2)) AND " & _
'    "($RPL_PkgH$ <= ROUND(BOK.BOK_PkgHMax,2)) AND " & _
'    "($RPL_PkgWgh$ <= ROUND(BOK.BOK_WghMax,2)) AND " & _
'    "(BOK.BOK_QtyMin < $Qty$ AND $Qty$ <= BOK.BOK_QtyMax) AND " & _
'    "(BOK.Drop_Flag='') " & _
'    "ORDER BY BOK.BOK_Priority,BOK.BOK_PkgAMax,BOK.BOK_PkgBMax,BOK.BOK_PkgHMax,BOK.BOK_WghMax"

  ls_req = Replace(ls_req, "$PRD_Id$", mo_Tools.SQLStr(ao_Product.PRD_Id), , , vbTextCompare)
  ls_req = Replace(ls_req, "$OPR_Id$", mo_Tools.SqlInt(eDPCBOROperation.ePacking), , , vbTextCompare)
  ls_req = Replace(ls_req, "$CAT_Id$", mo_Tools.SqlInt(eDPCCategory.cgPacking), , , vbTextCompare)
  ls_req = Replace(ls_req, "$PanelQty$", mo_Tools.SqlInt(ao_Product.PanelQtyPCS), , , vbTextCompare)
  ls_req = Replace(ls_req, "$RPL_PkgA$", mo_Tools.SqlDbl(ao_Product.RPL_PkgA), , , vbTextCompare)
  ls_req = Replace(ls_req, "$RPL_PkgB$", mo_Tools.SqlDbl(ao_Product.RPL_PkgB), , , vbTextCompare)
  ls_req = Replace(ls_req, "$RPL_PkgH$", mo_Tools.SqlDbl(ao_Product.RPL_PkgH), , , vbTextCompare)
  ls_req = Replace(ls_req, "$RPL_PkgWgh$", mo_Tools.SqlDbl(ao_Product.RPL_PkgWgh), , , vbTextCompare)
  
  lc_Cursor = mo_Tools.OpenSQLSafe(mo_Db, ls_req)
  If mo_Db.RowCount(lc_Cursor) > 0 Then
    If ao_Product.PanelQtyPCS >= ao_Product.RPL_PU Then
      ll_PU = ao_Product.RPL_PU
    Else
      ll_PU = ao_Product.PanelQtyPCS
    End If
    ls_ExtText = "VE " & ll_PU
    Call AddBORMultipleOperations(ao_Db, lc_Cursor, ao_Product, eDPCBOROperation.ePacking, ao_ErrCollection, ls_ExtText)
  Else
    Set lo_BOR = AddBOR(ao_Db, ao_Product, eDPCBOROperation.ePacking, 0)
    Call SetBORErr(lo_BOR, eDPCError.erBORRoutingSettingMissing, ao_ErrCollection, ao_Product)
  End If
  Call mo_Db.Close(lc_Cursor)
  Exit Sub
ErrHandler:
  Call ErrorHandler("AddBORPacking")
End Sub

Public Function AddBORList(ByVal ao_Db As Object, ByVal ao_Product As DPC_Product, ByVal ao_ErrCollection As Collection) As Boolean
On Error GoTo ErrHandler

Dim lo_Inlay As DPC_Inlay
Dim lo_Cutout As DPC_Cutout
Dim ls_Request As String

  AddBORList = False
  Call mo_Tools.ClearCollection(ao_Product.BORs)
  
  Call AddBORPerforation(ao_Db, ao_Product, ao_ErrCollection)
  
  Call AddBORRerolling(ao_Db, ao_Product, ao_ErrCollection)
  
  If ao_Product.RPL_CoilW > ao_Product.RPL_CutB Then
    Call AddBORCutting(ao_Db, ao_Product, ao_ErrCollection)
  End If
  
  
  Call AddBORPunchNotching(ao_Db, ao_Product, Nothing, ao_ErrCollection)
  If ao_Product.HasVentilation Or ao_Product.HasLoudspeaker Or ao_Product.HasCutout Then
    For Each lo_Cutout In ao_Product.Cutouts
      If lo_Cutout.RowStatus <> eDPCRowStatus.rsDrop Then
        Call AddBORPunchNotching(ao_Db, ao_Product, lo_Cutout, ao_ErrCollection)
      End If
    Next
  End If
  
  Call AddBORBending(ao_Db, ao_Product, ao_ErrCollection)
  
  If ao_Product.HasCoating Then
    Call AddBORCoating(ao_Db, ao_Product, ao_ErrCollection)
  End If
  
  If ao_Product.HasGasket Then
    Call AddBORGasketSpacer(ao_Db, ao_Product, eDPCGasketType.gtGasket, ao_ErrCollection)
  End If
  
  If ao_Product.HasSpacer Then
    Call AddBORGasketSpacer(ao_Db, ao_Product, eDPCGasketType.gtSpacer, ao_ErrCollection)
  End If
  
  If ao_Product.HasInlay Then
    For Each lo_Inlay In ao_Product.Inlays
      If lo_Inlay.RowStatus <> eDPCRowStatus.rsDrop Then
        Call AddBORInlay(ao_Db, ao_Product, lo_Inlay, ao_ErrCollection)
      End If
    Next
  End If
  
  If ao_Product.HasPacking Then
    Call AddBORPacking(ao_Db, ao_Product, ao_ErrCollection)
  End If
  
  AddBORList = True
  Exit Function
ErrHandler:
  Call ErrorHandler("AddBORList")
End Function


Public Sub DeleteBOM(ByVal as_PRD_Id As String)
On Error GoTo ErrHandler

Dim ls_req As String

  ls_req = "exec DPC_BOM_del $PRD_Id$, NULL, $Z_Last_Upd_User$"
  ls_req = Replace(ls_req, "$PRD_Id$", mo_Tools.SQLStr(as_PRD_Id))
  ls_req = ReplaceCommonPlaceholders(ls_req)
  Call mo_Tools.ExecuteSQLSafe(mo_Db, ls_req)
  Exit Sub
ErrHandler:
  Call ErrorHandler("DeleteBOM")
End Sub

Public Sub DeleteBOR(ByVal as_PRD_Id As String)
On Error GoTo ErrHandler

Dim ls_req As String

  ls_req = "exec DPC_BOR_del $PRD_Id$, NULL, $Z_Last_Upd_User$"
  ls_req = Replace(ls_req, "$PRD_Id$", mo_Tools.SQLStr(as_PRD_Id))
  ls_req = ReplaceCommonPlaceholders(ls_req)
  Call mo_Tools.ExecuteSQLSafe(mo_Db, ls_req)
  Exit Sub
ErrHandler:
  Call ErrorHandler("DeleteBOR")
End Sub

Public Function GenerateBOMandBOR(ByVal as_COF_Id As String, ByVal ao_PrdCollection As Collection, ByVal ao_ErrCollection As Collection) As Boolean
On Error GoTo ErrHandler

Dim lo_DPC_Product As DPC_Product
Dim ll_Idx As Long
Dim lb_ResultBOM As Boolean, lb_ResultBOR As Boolean
Dim lo_Db As Object
Dim lb_BOMBOR_Generated As Boolean

#If LIVE = 1 Then
  Set lo_Db = CreateObject("ARMSYSCOM.ArmDb")
#Else
  Set lo_Db = New ARMSYSCOMLib.ArmDb
#End If
  GenerateBOMandBOR = False
  If Not mo_Tools.ReconnectSafe(lo_Db, ms_BaeurerServer, ms_BaeurerDatabase, ms_BaeurerLoginName, ms_BaeurerPassword, ms_BaeurerSource) Then
    Exit Function
  End If
  
'  ls_Request = "SELECT PRD_Id,OFD_IdPar FROM Cap_OfferDetail WHERE COF_Id=$COF_Id$ AND CAT_Id=$CAT_Id$ AND OFD_Main=$OFD_Main$ AND Drop_Flag=''"
'  ls_Request = Replace(ls_Request, "$COF_Id$", mo_Tools.SqlStr(as_COF_Id))
'  ls_Request = Replace(ls_Request, "$CAT_Id$", mo_Tools.SqlInt(eDPCCategory.cgMetalCustomRectPanel))
'  ls_Request = Replace(ls_Request, "$OFD_Main$", mo_Tools.SqlInt(eDPCOfferDetailMain.odMain))
'  lc_Cursor = mo_Tools.OpenSQLSafe(mo_Db, ls_Request)
'  While Not mo_Db.EOF(lc_Cursor)
'    ls_PRD_Id = mo_Db.GetFields(lc_Cursor, "PRD_Id")
'    ls_OFD_IdPar = mo_Db.GetFields(lc_Cursor, "OFD_IdPar")
'
'    Set lo_DPC_Product = New DPC_Product
'    Set lo_DPC_Product.ArmDb = mo_Db
'    lo_DPC_Product.CT_Code = CT_Code
'    lo_DPC_Product.CURR_Code = CURR_Code
'    lo_DPC_Product.ValidityDate = ValidityDate
'    lo_DPC_Product.Language_Code = Language_Code
'    lo_DPC_Product.COF_Id = as_COF_Id
'    Call lo_DPC_Product.Load_A_Com
'    Call lo_DPC_Product.InitOffer
'    Call lo_DPC_Product.Load(ls_PRD_Id)
'    Call lo_DPC_Product.LoadBOM
'    Call lo_DPC_Product.LoadBOR
'    Call lo_DPC_Product.LoadOffer(as_COF_Id, ls_OFD_IdPar)
'    Call lo_Collection.Add(lo_DPC_Product)
'
'    Call mo_Db.Next(lc_Cursor)
'  Wend
'  Call mo_Db.Close(lc_Cursor)
  For Each lo_DPC_Product In ao_PrdCollection
    If lo_DPC_Product.PanelQtyPCS = 0 Then
      Call mo_Tools.AddCheckError(eDPCError.erMandatoryQty, ms_Language_Code, ao_ErrCollection, lo_DPC_Product)
    End If
  Next
  
  If Not OptimizeCoilWidth(lo_Db, ao_PrdCollection, ao_ErrCollection) Then
    Call mo_Tools.AddCheckError(eDPCError.erBOMCoilOptimisationFail, ms_Language_Code, ao_ErrCollection)
  End If
  
  For Each lo_DPC_Product In ao_PrdCollection
  
    If Not lo_DPC_Product.IsStandard Then
      
      lo_DPC_Product.RPL_BOMRejectFact = Val(Replace(mo_Tools.GetAConfigData("DPC_CostRejectFactorLev" & lo_DPC_Product.LEV_Id), ",", "."))
      lo_DPC_Product.RPL_BORWasteFact = Val(Replace(mo_Tools.GetAConfigData("DPC_CostWasteWorkTimeFactor"), ",", "."))
      lo_DPC_Product.RPL_MPE2Fact = Val(Replace(mo_Tools.GetAConfigData("DPC_CostMPE2Factor"), ",", "."))
      lo_DPC_Product.RPL_AdminFact = Val(Replace(mo_Tools.GetAConfigData("DPC_CostAdminFactor"), ",", "."))
      lo_DPC_Product.RPL_ICTPFact = Val(Replace(mo_Tools.GetAConfigData("DPC_CostICTPFactor"), ",", "."))
      lo_DPC_Product.RPL_RejectOtherFact = 0
      
      lb_BOMBOR_Generated = False
      If lo_DPC_Product.BOMs.Count = 0 Then
        Call AddBOMList(lo_Db, lo_DPC_Product, ao_ErrCollection)
        lb_BOMBOR_Generated = True
      End If
      If lo_DPC_Product.BORs.Count = 0 Then
        Call AddBORList(lo_Db, lo_DPC_Product, ao_ErrCollection)
        lb_BOMBOR_Generated = True
      End If
      If lb_BOMBOR_Generated Then
        Call lo_DPC_Product.CrossLinkBOMBOR
      End If
      Call lo_DPC_Product.CalculateGroup(ao_ErrCollection)
      Call lo_DPC_Product.CalculateWeightPoints(ao_ErrCollection)
      Call lo_DPC_Product.CalculateCEValues(ao_ErrCollection)
      Call lo_DPC_Product.InitCostCalc
      If (Not lo_DPC_Product.HasBOMError) And (Not lo_DPC_Product.HasBORError) Then
        Call lo_DPC_Product.CalculateCost
      End If
    End If
  Next
  
  Call DistributeBOMWaste(ao_PrdCollection, lo_Db)

  Call lo_Db.Disconnect
    
  GenerateBOMandBOR = True
  Exit Function
ErrHandler:
  Call ErrorHandler("GenerateBOMandBOR")
End Function

Private Function ReplaceCommonPlaceholders(ByVal as_Request As String) As String
On Error GoTo ErrHandler

  as_Request = Replace(as_Request, "$Z_Creator$", mo_Tools.SqlInt(ml_U_Code), , , vbTextCompare)
  as_Request = Replace(as_Request, "$U_Code$", mo_Tools.SqlInt(ml_U_Code), , , vbTextCompare)
  as_Request = Replace(as_Request, "$Z_Last_Upd_User$", mo_Tools.SqlInt(ml_U_Code), , , vbTextCompare)
  as_Request = Replace(as_Request, "$Language_Code$", mo_Tools.SQLStr(ms_Language_Code), , , vbTextCompare)
  ReplaceCommonPlaceholders = as_Request
  Exit Function
ErrHandler:
  Call ErrorHandler("ReplaceCommonPlaceholders")
End Function

' Standard error handler
Private Sub ErrorHandler(ByVal as_Fct As String)
  
    
    Call Err.Raise(Err.Number, as_Fct & SEP1 & Err.Source, Err.Description)
End Sub




