t-adresse-write.p 6.6 KB

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