FSN#27866 Contracten via orderqueue

svn path=/Website/trunk/; revision=19610
2013-10-24 13:08:59 +00:00
parent c9c48f7869
commit abc2e90834
4 changed files with 91 additions and 71 deletions
--- a/UTILS/PutOrders/AllOrders.bas
+++ b/UTILS/PutOrders/AllOrders.bas
@@ -5,46 +5,29 @@ Option Explicit
 ' *
 ' * SendAllOrders() $Revision$
 ' *
-' * Doorloop alle opdrachten per bedrijf en roep SendOrder aan voor dat bedrijf
-' * Vervangt vanaf 4.70 de eerdere MLDOrders EN BESOrders
+' * Doorloop alle opdrachten etc uit de queues en verstuur die.
 ' *
 ' ******************************************
 Function SendAllOrders(ByVal conn As ADODB.Connection)
-  Dim oRs, oRsB, oRsC, oRsS As ADODB.Recordset
+  Dim oRs, oRsB, oRsC, oRsS, oRsOT As ADODB.Recordset
  Dim sql As String
-  Dim RecTotal As Long, MLDRecSaved As Long, BESRecSaved As Long, CustRecSaved As Long
+  Dim RecTotal As Long, MLDRecSaved As Long, BESRecSaved As Long, CustRecSaved As Long, CNTRecSaved As Long
  Dim Bedrijf As Long
  Dim XMLnode As String
  Dim ValidBedrijf As Boolean
  Dim xml_content As String
  Dim filer As New SendOrder
  Dim errText As String
-  Dim CurrentBedrijf As Long
-  Dim CurrentXMLnode As String
  Dim connect As New Connector
  Dim ordernr As String
  Dim certificateName As String
  Dim SendOrderResult As Long
  Dim AttachPath As String
-  Dim sql_cust As String
+  Dim sqlOT As String
  Dim Sender As String
  Dim XSLfile As String
  Dim MailSubject As String
-
-  ' Sinds 4.70 hebben we een virtuele orderqueue
-  ' en sinds 4.70.1 een kolom reference
-  ' custom order queue view
-  sql_cust = ""
-  If CustOrders Then
-    sql_cust = " UNION" _
-             & " SELECT prs_bedrijf_key," _
-             & " xmlnode," _
-             & " key," _
-             & " reference," _
-             & " 1 cust," _
-             & " COALESCE(sender,'-') sender" _
-             & " FROM " & CustomerId & "_v_orderqueue "
-  End If
+  Dim typeopdr_key As Long

  ' De sortering is van belang voor de loops erna
  sql = "SELECT prs_bedrijf_key," _
@@ -53,58 +36,87 @@ Function SendAllOrders(ByVal conn As ADODB.Connection)
      & " reference," _
      & " 0 cust," _
      & " COALESCE(sender,'-') sender " _
-      & " FROM fac_v_orderqueue" _
-      & sql_cust _
-      & " ORDER BY prs_bedrijf_key, xmlnode"
+      & " FROM fac_v_orderqueue"
+
+  If CustOrders Then
+    sql = sql & " UNION" _
+             & " SELECT prs_bedrijf_key," _
+             & " xmlnode," _
+             & " key," _
+             & " reference," _
+             & " 1 cust," _
+             & " COALESCE(sender,'-') sender" _
+             & " FROM " & CustomerId & "_v_orderqueue "
+  End If
+  sql = sql & " ORDER BY prs_bedrijf_key, xmlnode"
+
  Log2File 2, sql
  Set oRs = conn.Execute(sql)

-  CurrentBedrijf = -1
-  CurrentXMLnode = ""
  ValidBedrijf = False

  RecTotal = 0
  MLDRecSaved = 0
  BESRecSaved = 0
+  CNTRecSaved = 0
  CustRecSaved = 0

  While Not oRs.EOF
    Log2File 1, vbCrLf + "====== " & oRs("xmlnode").value & ": " & oRs("key").value & " (" & CStr(Now) & ")"
    Bedrijf = oRs("prs_bedrijf_key").value
    XMLnode = oRs("xmlnode").value
-    If Bedrijf <> CurrentBedrijf Then
-      ' Een ander bedrijf, haal bijbehorende settings
-      ' Disconnect
-      connect.Connected = False
+    ' Voor opdrachten zouden we per type een ander adres enz kunnen hebben, we moeten dus gewoon elke
+    ' entry uit de queue gaan behandelen. Eventuele voorkennis ter beperkte optimalisatie laten we vallen
+    ' Haal bijbehorende settings
+    ' Disconnect
+    connect.Connected = False
+    ' techparams 5.3.3 style
+    sql = "SELECT prs_bedrijfadres_url, " _
+        & " NVL(prs_bedrijfadres_ordermode, 0) prs_bedrijfadres_ordermode, " _
+        & " prs_bedrijf_email, " _
+        & " prs_bedrijfadres_xsl, " _
+        & " NVL(prs_bedrijfadres_certificate, '-') prs_bedrijfadres_certificate, " _
+        & " ba.mld_typeopdr_key " _
+        & " FROM prs_bedrijf b, prs_bedrijfadres ba " _
+        & " WHERE b.prs_bedrijf_key = " & Bedrijf _
+        & " AND b.prs_bedrijf_key = ba.prs_bedrijf_key(+)" _
+        & " AND prs_bedrijfadres_xsl IS NOT NULL"

-      sql = "SELECT prs_bedrijf_order_adres, " _
-          & " prs_bedrijf_mldorder_adres, " _
-          & " NVL(prs_bedrijf_order_mode, 0) prs_bedrijf_order_mode, " _
-          & " prs_bedrijf_email, " _
-          & " prs_bedrijf_xsl, " _
-          & " NVL(prs_bedrijf_order_certificate, '-') prs_bedrijf_order_certificate " _
-          & " FROM prs_bedrijf " _
-          & " WHERE prs_bedrijf_key =" & Bedrijf _
-          & " AND prs_bedrijf_xsl IS NOT NULL"
-      Log2File 2, sql
-      Set oRsB = conn.Execute(sql)
-      If oRsB.EOF Then
-        ValidBedrijf = False
-        Log2File 0, "Bedrijf is niet goed geconfigureerd: " & Bedrijf
-      Else
-        ValidBedrijf = True
-      End If
-      CurrentBedrijf = Bedrijf
+    Select Case XMLnode
+        Case "opdracht"
+            sql = sql & " AND prs_bedrijfadres_type = 'O'"
+            ' Moet ik hier GVD zelf nog het opdrachttype gaan opzoeken?? Ja.
+            sqlOT = "SELECT mld_typeopdr_key FROM mld_opdr WHERE mld_opdr_key = " & oRs("key").value
+            Log2File 2, sqlOT
+            Set oRsOT = conn.Execute(sqlOT)
+            If Not oRsOT.EOF Then
+              sql = sql _
+                  & " AND (ba.mld_typeopdr_key = " & oRsOT("mld_typeopdr_key").value & " OR ba.mld_typeopdr_key IS NULL)" _
+                  & " ORDER BY mld_typeopdr_key"  ' bedoeling: de gevulde specifieke boven de lege fallback
+            Else
+                    Log2File 0, "Opdracht niet meer kunnen vinden?? Key=" & oRs("key").value
+            End If
+        Case "bestelopdr"
+            sql = sql & " AND prs_bedrijfadres_type = 'B'"
+        Case "contract"
+            sql = sql & " AND prs_bedrijfadres_type = 'C'"
+        Case Else
+            sql = sql & " AND 1 = 0"  'unsupported
+            Log2File 0, "Niet ondersteunde xmlnode"
+    End Select
+
+    Log2File 2, sql
+    Set oRsB = conn.Execute(sql)
+    If oRsB.EOF Then
+      ValidBedrijf = False
+      Log2File 0, "Bedrijf is niet goed geconfigureerd: " & Bedrijf
+    Else
+      ValidBedrijf = True
    End If

-    If ValidBedrijf And (Not connect.Connected Or XMLnode <> CurrentXMLnode) Then
-        ' Een ander bedrijf en/of ander opdrachttype, verbindt opnieuw met het bezorgadres
-        If oRs("xmlnode").value = "opdracht" Then
-          Call connect.connect(oRsB("prs_bedrijf_mldorder_adres").value)
-        Else
-          Call connect.connect(oRsB("prs_bedrijf_order_adres").value)
-        End If
-        CurrentXMLnode = XMLnode
+    If ValidBedrijf Then
+        ' Verbindt met het (mogelijk andere) bezorgadres
+        Call connect.connect(oRsB("prs_bedrijfadres_url").value)
    End If

    If connect.Connected Then
@@ -115,10 +127,10 @@ Function SendAllOrders(ByVal conn As ADODB.Connection)

      If xml_content <> "" Then
        ordernr = oRs("reference").value
-        If oRsB("prs_bedrijf_order_certificate").value = "-" Then
+        If oRsB("prs_bedrijfadres_certificate").value = "-" Then
          certificateName = ""
        Else
-          certificateName = oRsB("prs_bedrijf_order_certificate").value
+          certificateName = oRsB("prs_bedrijfadres_certificate").value
        End If
        If oRs("xmlnode").value = "opdracht" Then
            AttachPath = FlexfilesFolder + "MLD/" & subfolderKey("O", CStr(oRs("key").value)) & "/"
@@ -129,28 +141,33 @@ Function SendAllOrders(ByVal conn As ADODB.Connection)
        If Sender = "-" Then
            Sender = ""
        End If
-Log2File 1, "Searching attachments under: " & AttachPath
+        Log2File 1, "Searching attachments under: " & AttachPath

-        XSLfile = LCase(oRsB("PRS_BEDRIJF_XSL").value)
+        XSLfile = LCase(oRsB("prs_bedrijfadres_xsl").value)
        XSLfile = getXslNode(XSLfile, XMLnode)

        Log2File 3, "In SendAllOrders sender=" + Sender
        Log2File 4, "xml_content=" & xml_content
-        Log2File 4, "xsl=" & oRsB("PRS_BEDRIJF_XSL").value & " ==>" & XSLfile
+        Log2File 4, "xsl=" & oRsB("prs_bedrijfadres_xsl").value & " ==>" & XSLfile
        Log2File 4, "ordernr=" & ordernr
        Log2File 4, "key=" & oRs("key").value
-        Log2File 4, "order_mode=" & oRsB("prs_bedrijf_order_mode")
+        Log2File 4, "order_mode=" & oRsB("prs_bedrijfadres_ordermode")
        Log2File 4, "certificate=" & certificateName
+        Log2File 4, "mld_typeopdr_key=" & oRsB("mld_typeopdr_key")
        Log2File 4, "errText=" & errText
        Log2File 4, "AttachPath=" & AttachPath

        If oRs("xmlnode").value = "opdracht" Then
            MailSubject = SubjectPrefixMLD
            sql = "SELECT mld.opdrsprintf('" & Replace(MailSubject, "'", "''") & "'," & oRs("key").value & ") subj FROM DUAL"
-        Else
+        ElseIf oRs("xmlnode").value = "bestelopdr" Then
            MailSubject = SubjectPrefix
            sql = "SELECT bes.opdrsprintf('" & Replace(MailSubject, "'", "''") & "'," & oRs("key").value & ") subj FROM DUAL"
+        ElseIf oRs("xmlnode").value = "contract" Then
+            MailSubject = SubjectPrefixCNT
+            sql = "SELECT cnt.sprintf('" & Replace(MailSubject, "'", "''") & "'," & oRs("key").value & ") subj FROM DUAL"
        End If
+
        If InStr(MailSubject, "##") = 0 Then
            MailSubject = SubjectPrefix & ordernr '' Geen ##, backwards compatible
        Else
@@ -161,7 +178,7 @@ Log2File 1, "Searching attachments under: " & AttachPath

        SendOrderResult = filer.SendOrder(connect, xml_content, XSLfile, _
                                   ordernr, oRs("key").value, _
-                                   oRsB("prs_bedrijf_order_mode"), certificateName, errText, _
+                                   oRsB("prs_bedrijfadres_ordermode"), certificateName, errText, _
                                   AttachPath, Sender, MailSubject)

        If oRs("cust").value = 0 Then
@@ -179,7 +196,6 @@ Log2File 1, "Searching attachments under: " & AttachPath
        End If
        Log2File 2, sql
        Call conn.Execute(sql)
-''Debug.Assert (1 = 0)

        If SendOrderResult = 0 Or SendOrderResult = 2 Then
          Log2File 1, "File sent"
@@ -187,6 +203,8 @@ Log2File 1, "Searching attachments under: " & AttachPath
              MLDRecSaved = MLDRecSaved + 1
          ElseIf oRs("xmlnode") = "bestelopdr" Then
              BESRecSaved = BESRecSaved + 1
+          ElseIf oRs("xmlnode") = "contract" Then
+              CNTRecSaved = CNTRecSaved + 1
          Else
              CustRecSaved = CustRecSaved + 1
          End If
@@ -203,10 +221,10 @@ Log2File 1, "Searching attachments under: " & AttachPath
  '
  If RecTotal > 0 Then
    ' Als er minder opdrachten verstuurd zijn dan er te versturen waren, dan noemen we dat een error
-    If BESRecSaved + MLDRecSaved + CustRecSaved < RecTotal Then
-        Log2File 0, " CUST:" & CStr(CustRecSaved) & " and BES:" & CStr(BESRecSaved) & " and MLD:" & CStr(MLDRecSaved) & " of " & CStr(RecTotal) & " orders put"
+    If BESRecSaved + MLDRecSaved + CNTRecSaved + CustRecSaved < RecTotal Then
+        Log2File 0, " CUST:" & CStr(CustRecSaved) & " and BES:" & CStr(BESRecSaved) & " and MLD:" & CStr(MLDRecSaved) & " and CNT:" & CStr(CNTRecSaved) & " of " & CStr(RecTotal) & " orders put"
    Else
-        Log2File 1, " CUST:" & CStr(CustRecSaved) & " and BES:" & CStr(BESRecSaved) & " and MLD:" & CStr(MLDRecSaved) & " of " & CStr(RecTotal) & " orders put"
+        Log2File 1, " CUST:" & CStr(CustRecSaved) & " and BES:" & CStr(BESRecSaved) & " and MLD:" & CStr(MLDRecSaved) & " and CNT:" & CStr(CNTRecSaved) & " of " & CStr(RecTotal) & " orders put"
    End If
  Else
    Log2File 1, " 0 orders put"
--- a/UTILS/PutOrders/PutOrders.bas
+++ b/UTILS/PutOrders/PutOrders.bas
@@ -8,6 +8,7 @@ Const BufferSize As Long = 2048
 '
 Global SubjectPrefix As String ' BES
 Global SubjectPrefixMLD As String
+Global SubjectPrefixCNT As String
 Global IniNotificationInMailBody As String
 Global IniNotificationXSL As String
 Global IniSystem2SystemXSL As String
@@ -282,6 +283,7 @@ Dim errText As String
  '
  SubjectPrefix = ReadINIStr("GENERAL", "SubjectPrefix", "Facilitor bestelling: Bestelopdracht nr.")
  SubjectPrefixMLD = ReadINIStr("GENERAL", "SubjectPrefixMLD", SubjectPrefix)
+  SubjectPrefixCNT = ReadINIStr("GENERAL", "SubjectPrefixCNT", SubjectPrefix)
  '' FacilitorHome & "cust/" & CustomerId & "/flexfiles/
  FlexfilesFolder = ReadINIStr("GENERAL", "FlexfilesFolder", "")
  '
--- a/UTILS/PutOrders/PutOrders.exe
+++ b/UTILS/PutOrders/PutOrders.exe
--- a/UTILS/PutOrders/PutOrders.vbp
+++ b/UTILS/PutOrders/PutOrders.vbp
@@ -28,8 +28,8 @@ Name="PutOrders"
 HelpContextID="0"
 CompatibleMode="0"
 MajorVer=5
-MinorVer=2
-RevisionVer=37
+MinorVer=3
+RevisionVer=40
 AutoIncrementVer=1
 ServerSupportFiles=0
 VersionCompanyName="SG|facilitor"