t-ansprech-write.p 5.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156
  1. TRIGGER PROCEDURE FOR WRITE OF Ansprech
  2. NEW BUFFER NAnsprech
  3. OLD BUFFER OAnsprech.
  4. DEF VAR cDiff AS CHAR NO-UNDO.
  5. DEF VAR cFeld AS CHAR NO-UNDO.
  6. DEF VAR hBuffer AS HANDLE NO-UNDO.
  7. DEF VAR hFeld1 AS HANDLE NO-UNDO.
  8. DEF VAR kk AS INT NO-UNDO.
  9. DEF VAR cWort AS CHAR NO-UNDO.
  10. DEF VAR iArt AS INT NO-UNDO.
  11. DEF TEMP-TABLE tAnsprech LIKE Ansprech.
  12. BUFFER-COMPARE NAnsprech
  13. EXCEPT BriefAnr
  14. AdrArt
  15. Anschrift
  16. Anzeig
  17. Anzeig_br
  18. Cd01 Cd02 Cd03 Cd04 Cd05 Cd06 Cd07 Cd08
  19. Cd09 Cd10 Cd11 Cd12 Cd13 Cd14 Cd15
  20. TO OAnsprech
  21. SAVE RESULT IN cDiff NO-ERROR.
  22. IF cDiff = ? THEN cDiff = ''.
  23. IF cDiff = '' THEN RETURN.
  24. DISABLE TRIGGERS FOR LOAD OF Adresse.
  25. FIND Adresse
  26. WHERE Adresse.Firma = NAnsprech.Firma
  27. AND Adresse.Knr = NAnsprech.Knr.
  28. ASSIGN hBuffer = BUFFER Adresse:HANDLE
  29. cWort = ''
  30. Adresse.WortIndex = ''.
  31. DO kk = 1 TO hBuffer:NUM-FIELDS:
  32. hFeld1 = hBuffer:BUFFER-FIELD(kk).
  33. IF hFeld1:EXTENT > 0 THEN NEXT.
  34. IF NOT hFeld1:DATA-TYPE BEGINS 'CHAR' THEN NEXT.
  35. IF hFeld1:BUFFER-VALUE(0) = ? THEN hFeld1:BUFFER-VALUE(0) = ''.
  36. cFeld = hFeld1:NAME.
  37. IF cFeld BEGINS 'Erf' THEN NEXT.
  38. IF cFeld BEGINS 'Mut' THEN NEXT.
  39. IF cFeld BEGINS 'Anzeig' THEN NEXT.
  40. IF cFeld BEGINS 'Anschr' THEN NEXT.
  41. IF cFeld BEGINS 'Word' THEN NEXT.
  42. IF cFeld BEGINS 'Brief' THEN NEXT.
  43. IF cFeld BEGINS 'Cd' THEN NEXT.
  44. IF cFeld BEGINS 'Wort' THEN NEXT.
  45. iArt = 0.
  46. IF cFeld BEGINS 'Tel' THEN iArt = 1.
  47. IF cFeld BEGINS 'Nat' THEN iArt = 1.
  48. RUN BEREINIGEN ( iArt, hFeld1:BUFFER-VALUE(0) ).
  49. END.
  50. hFeld1 = hBuffer:BUFFER-FIELD('Knr').
  51. RUN BEREINIGEN ( 0, TRIM(STRING(INTEGER(hFeld1:BUFFER-VALUE(0)),'>>>>>>9')) ).
  52. EMPTY TEMP-TABLE tAnsprech.
  53. CREATE tAnsprech.
  54. BUFFER-COPY NAnsprech to tAnsprech.
  55. FOR EACH Ansprech NO-LOCK
  56. WHERE Ansprech.Firma = NAnsprech.Firma
  57. AND Ansprech.Knr = NAnsprech.Knr
  58. AND Ansprech.Ind <> NAnsprech.Ind:
  59. CREATE tAnsprech.
  60. BUFFER-COPY Ansprech to tAnsprech.
  61. END.
  62. hBuffer = TEMP-TABLE tAnsprech:DEFAULT-BUFFER-HANDLE.
  63. FOR EACH tAnsprech:
  64. DO kk = 1 TO hBuffer:NUM-FIELDS:
  65. hFeld1 = hBuffer:BUFFER-FIELD(kk).
  66. IF hFeld1:EXTENT > 0 THEN NEXT.
  67. IF NOT hFeld1:DATA-TYPE BEGINS 'CHAR' THEN NEXT.
  68. IF hFeld1:BUFFER-VALUE(0) = ? THEN hFeld1:BUFFER-VALUE(0) = ''.
  69. cFeld = hFeld1:NAME.
  70. IF cFeld BEGINS 'Erf' THEN NEXT.
  71. IF cFeld BEGINS 'Mut' THEN NEXT.
  72. IF cFeld BEGINS 'Anzeig' THEN NEXT.
  73. IF cFeld BEGINS 'Anschr' THEN NEXT.
  74. IF cFeld BEGINS 'Word' THEN NEXT.
  75. IF cFeld BEGINS 'Brief' THEN NEXT.
  76. IF cFeld BEGINS 'Cd' THEN NEXT.
  77. IF cFeld BEGINS 'Wort' THEN NEXT.
  78. iArt = 0.
  79. IF cFeld BEGINS 'Tel' THEN iArt = 1.
  80. IF cFeld BEGINS 'Nat' THEN iArt = 1.
  81. RUN BEREINIGEN ( iArt, hFeld1:BUFFER-VALUE(0) ).
  82. END.
  83. END.
  84. FOR EACH Steuer NO-LOCK
  85. WHERE Steuer.Firma < '9999'
  86. AND Steuer.AdFirma = Adresse.Firma:
  87. IF CAN-FIND ( Debst NO-LOCK USE-INDEX Debst-k1
  88. WHERE Debst.Firma = Steuer.Firma
  89. AND Debst.Knr = Adresse.Knr
  90. AND Debst.Aktiv)
  91. THEN DO:
  92. RUN BEREINIGEN ( 0, 'XDEBSTX' ).
  93. END.
  94. IF CAN-FIND ( Liefst NO-LOCK USE-INDEX Liefst-k1
  95. WHERE Liefst.Firma = Steuer.Firma
  96. AND Liefst.Knr = Adresse.Knr
  97. AND Liefst.Aktiv)
  98. THEN DO:
  99. RUN BEREINIGEN ( 0, 'XLIEFSTX' ).
  100. END.
  101. END.
  102. Adresse.WortIndex = cWort.
  103. RETURN.
  104. PROCEDURE BEREINIGEN:
  105. DEF INPUT PARAMETER ipArt AS INT NO-UNDO.
  106. DEF INPUT PARAMETER ipString AS CHAR NO-UNDO.
  107. DEF VAR wString AS CHAR NO-UNDO.
  108. DEF VAR yy AS INT NO-UNDO.
  109. IF ipString = '' THEN RETURN.
  110. wString = ipString.
  111. IF ipArt = 1 THEN DO:
  112. wString = REPLACE(wString, ' ', '').
  113. wString = REPLACE(wString, '.', '').
  114. wString = REPLACE(wString, '/', '').
  115. wString = REPLACE(wString, '-', '').
  116. END.
  117. wString = REPLACE(wString, '*' , '' ).
  118. wString = REPLACE(wString, '&' , ' ').
  119. wString = REPLACE(wString, '+' , '' ).
  120. wString = REPLACE(wString, '(' , '' ).
  121. wString = REPLACE(wString, ')' , '' ).
  122. wString = REPLACE(wString, '!' , '' ).
  123. wString = REPLACE(wString, '|' , '' ).
  124. wString = REPLACE(wString, '^' , '' ).
  125. wString = REPLACE(wString, ';' , '' ).
  126. wString = REPLACE(wString, "'" , '' ).
  127. wString = REPLACE(wString, ',' , '' ).
  128. wString = REPLACE(wString, ' ', ' ').
  129. wString = TRIM(wString).
  130. IF wString = '' THEN RETURN.
  131. IF LOOKUP(wString, cWort, ' ') > 0 THEN NEXT.
  132. cWort = cWort + (IF cWort = '' THEN '' ELSE ' ')
  133. + wString.
  134. END PROCEDURE.