MwstCalcFaktura.p 9.4 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262
  1. DEF VAR i1 AS INT NO-UNDO.
  2. DEF VAR nWW AS DEC NO-UNDO INIT 0.00.
  3. DEF VAR nProz AS DEC NO-UNDO INIT 100.00.
  4. DEF VAR nFakBetr AS DEC NO-UNDO.
  5. DEF VAR nTotNebenkosten AS DEC NO-UNDO DECIMALS 2.
  6. DEF VAR nRestNebenkosten AS DEC NO-UNDO DECIMALS 2.
  7. DEF VAR iFaktNebenkosten AS INT NO-UNDO.
  8. DEF VAR htMwstCalc AS HANDLE NO-UNDO.
  9. DEF VAR iStdCd AS INT NO-UNDO.
  10. DEF VAR nStdAnsatz AS DEC NO-UNDO.
  11. DEF VAR nRundbetr AS DEC NO-UNDO DECIMALS 4.
  12. DEF VAR iRundcode AS INT NO-UNDO INIT 1.
  13. DEF VAR cFrw AS CHAR NO-UNDO.
  14. { incl/tmwstcalc.i }
  15. DEF BUFFER btMwstCalc FOR tMwstCalc.
  16. DEFINE INPUT PARAMETER TABLE FOR tMwstParam.
  17. DEFINE OUTPUT PARAMETER TABLE FOR tMwstCalc .
  18. DEFINE OUTPUT PARAMETER opcMessage AS CHAR NO-UNDO.
  19. htMwstCalc = TEMP-TABLE tMwstCalc:DEFAULT-BUFFER-HANDLE.
  20. EMPTY TEMP-TABLE tMwstCalc.
  21. FIND FIRST tMwstParam.
  22. cFrw = tMwstParam.Frw.
  23. DO i1 = 1 TO 11:
  24. IF tMwstParam.MwstPfl[i1] = 0 THEN NEXT.
  25. FIND LAST MwstAns NO-LOCK
  26. WHERE MwstAns.Mwst_Cd = i1
  27. AND MwstAns.Datum <= tMwstParam.Datum NO-ERROR.
  28. CREATE tMwstCalc.
  29. ASSIGN
  30. tMwstCalc.Mwst_Cd = i1
  31. tMwstCalc.Faktor = (IF tMwstParam.MwstPfl[i1] >= 0 THEN 1 ELSE -1)
  32. tMwstCalc.Ansatz = MwstAns.Ansatz
  33. tMwstCalc.Brutto = tMwstParam.MwstPfl[i1] + tMwstParam.MwstBetr[i1]
  34. tMwstCalc.Mwst = tMwstParam.MwstBetr[i1].
  35. IF tMwstParam.lInklusive THEN
  36. DO:
  37. ASSIGN
  38. tMwstCalc.Mwst = tMwstCalc.Brutto * tMwstCalc.Ansatz / (100 + tMwstCalc.Ansatz)
  39. tMwstCalc.Netto = tMwstCalc.Brutto - tMwstCalc.Mwst.
  40. END.
  41. ELSE DO:
  42. ASSIGN
  43. tMwstCalc.Netto = tMwstCalc.Brutto - tMwstCalc.Mwst.
  44. END.
  45. ASSIGN
  46. tMwstCalc.WW = tMwstCalc.Netto
  47. tMwstCalc.AbsBrutto = ABS(tMwstCalc.Brutto)
  48. tMwstCalc.AbsNetto = ABS(tMwstCalc.Netto )
  49. tMwstCalc.AbsMwst = ABS(tMwstCalc.Mwst )
  50. .
  51. nWW = nWW + ABS(tMwstCalc.WW).
  52. END.
  53. FIND FIRST tMwstCalc NO-ERROR.
  54. DO WHILE NOT AVAILABLE tMwstCalc: /* Nur Nebenkosten ? */
  55. IF tMwstParam.MwstPfl[12] = 0 THEN /* Keine Nebenkosten, Keine Beträge */
  56. DO:
  57. opcMessage = 'NORECORDS'.
  58. RETURN.
  59. END.
  60. opcMessage = 'NEBENKOSTENRECHNUNG'.
  61. /* Nebenkosten zum höchsten Ansatz wie Normale Artikel */
  62. DO i1 = 1 TO 11:
  63. FIND Wust NO-LOCK
  64. WHERE Wust.CodeK = tMwstParam.MwstCdKd
  65. AND Wust.CodeA = i1 NO-ERROR.
  66. IF NOT AVAILABLE Wust THEN NEXT.
  67. FIND LAST MwstAns NO-LOCK
  68. WHERE MwstAns.Mwst_Cd = Wust.Wucd
  69. AND MwstAns.Datum <= tMwstParam.Datum NO-ERROR.
  70. IF NOT AVAILABLE MwstAns THEN NEXT.
  71. ASSIGN
  72. iStdCd = Wust.WuCd
  73. nStdAnsatz = MwstAns.Ansatz.
  74. LEAVE.
  75. END.
  76. /* Nur Kosten */
  77. CREATE tMwstCalc.
  78. ASSIGN
  79. tMwstCalc.Mwst_Cd = iStdCd
  80. tMwstCalc.Faktor = (IF tMwstParam.MwstPfl[12] >= 0 THEN 1 ELSE -1)
  81. tMwstCalc.Ansatz = nStdAnsatz
  82. tMwstCalc.Fakbetr = 0
  83. tMwstCalc.ProzAnt = 100.00
  84. tMwstCalc.VerpAnt = tMwstParam.MwstPfl[12]
  85. tMwstCalc.Brutto = tMwstParam.MwstPfl[12]
  86. .
  87. ASSIGN
  88. tMwstCalc.WW = tMwstCalc.Netto
  89. tMwstCalc.AbsBrutto = ABS(tMwstCalc.Brutto)
  90. tMwstCalc.AbsNetto = ABS(tMwstCalc.Netto )
  91. tMwstCalc.AbsMwst = ABS(tMwstCalc.Mwst )
  92. .
  93. ASSIGN
  94. nWW = nWW + tMwstCalc.WW
  95. .
  96. LEAVE.
  97. END.
  98. DO WHILE tMwstParam.MwstPfl[12] <> 0: /* Nebenkosten zum verteilen */
  99. CREATE tMwstCalc.
  100. ASSIGN
  101. tMwstCalc.Mwst_Cd = 999
  102. tMwstCalc.Faktor = (IF tMwstParam.MwstPfl[12] >= 0 THEN 1 ELSE -1)
  103. tMwstCalc.Ansatz = 0.0
  104. tMwstCalc.Brutto = tMwstParam.MwstPfl[12]
  105. tMwstCalc.Netto = tMwstParam.MwstPfl[12]
  106. tMwstCalc.Mwst = 0
  107. tMwstCalc.AbsBrutto = ABS(tMwstCalc.Brutto)
  108. tMwstCalc.AbsNetto = ABS(tMwstCalc.Netto )
  109. tMwstCalc.AbsMwst = 0
  110. tMwstCalc.ProzAnt = 0.
  111. LEAVE.
  112. END.
  113. OUTPUT TO 'C:\TEMP\tMwstCalc_Faktura.csv'.
  114. DO i1 = 1 TO htMwstCalc:NUM-FIELDS:
  115. PUT CONTROL htMwstCalc:BUFFER-FIELD(i1):LABEL ';'.
  116. END.
  117. PUT CONTROL CHR(10).
  118. FOR EACH tMwstCalc:
  119. EXPORT DELIMITER ';' tMwstCalc.
  120. END.
  121. OUTPUT CLOSE.
  122. DO WHILE TRUE:
  123. FIND FIRST tMwstCalc NO-ERROR.
  124. IF NOT AVAILABLE tMwstCalc THEN DO:
  125. opcMessage = 'NORECORDS'.
  126. RETURN.
  127. END.
  128. FIND FIRST btMwstCalc
  129. WHERE btMwstCalc.Mwst_Cd = 999 NO-ERROR.
  130. IF NOT AVAILABLE btMwstCalc THEN LEAVE.
  131. nRestNebenkosten = btMwstCalc.Brutto.
  132. nTotNebenkosten = btMwstCalc.AbsBrutto.
  133. iFaktNebenkosten = btMwstCalc.Faktor.
  134. FOR EACH tMwstCalc
  135. WHERE tMwstCalc.Mwst_Cd < 999
  136. BREAK
  137. BY tMwstCalc.Mwst_Cd:
  138. IF LAST(tMwstCalc.Mwst_Cd) THEN
  139. DO:
  140. tMwstCalc.ProzAnt = nProz.
  141. tMwstCalc.VerpAnt = nRestNebenkosten.
  142. IF tMwstParam.lInklusive THEN
  143. DO:
  144. tMwstCalc.Brutto = tMwstCalc.Brutto + nRestNebenkosten.
  145. tMwstCalc.Netto = tMwstCalc.Brutto * 100 / (100 + tMwstCalc.Ansatz).
  146. tMwstCalc.Mwst = tMwstCalc.Brutto - tMwstCalc.Netto.
  147. END.
  148. ELSE DO:
  149. tMwstCalc.Netto = tMwstCalc.Netto + nRestNebenkosten.
  150. nRundbetr = tMwstCalc.Netto * tMwstCalc.Ansatz / 100.
  151. RUN RUNDEN.
  152. tMwstCalc.Mwst = nRundbetr.
  153. tMwstCalc.Brutto = tMwstCalc.Netto + tMwstCalc.Mwst.
  154. END.
  155. nFakBetr = nFakbetr + tMwstCalc.Brutto.
  156. LEAVE.
  157. END.
  158. tMwstCalc.ProzAnt = tMwstCalc.AbsNetto * 100 / nWW.
  159. tMwstCalc.VerpAnt = nTotNebenkosten * tMwstCalc.ProzAnt / 100 * iFaktNebenkosten.
  160. IF tMwstParam.lInklusive THEN
  161. DO:
  162. tMwstCalc.Brutto = tMwstCalc.Brutto + tMwstCalc.VerpAnt.
  163. tMwstCalc.Netto = tMwstCalc.Brutto * 100 / (100 + tMwstCalc.Ansatz).
  164. tMwstCalc.Mwst = tMwstCalc.Brutto - tMwstCalc.Netto.
  165. END.
  166. ELSE DO:
  167. tMwstCalc.Netto = tMwstCalc.Netto + tMwstCalc.VerpAnt.
  168. nRundbetr = tMwstCalc.Netto * tMwstCalc.Ansatz / 100.
  169. RUN RUNDEN.
  170. tMwstCalc.Mwst = nRUndbetr.
  171. tMwstCalc.Brutto = tMwstCalc.Netto + tMwstCalc.Mwst.
  172. END.
  173. nProz = nProz - tMwstCalc.ProzAnt.
  174. nRestNebenkosten = nRestNebenkosten - tMwstCalc.VerpAnt.
  175. nFakBetr = nFakbetr + tMwstCalc.Brutto.
  176. END.
  177. LEAVE.
  178. END.
  179. opcMessage = opcMessage
  180. + (IF opcMessage = '' THEN '' ELSE CHR(10))
  181. + SUBSTITUTE('&1', nFakbetr).
  182. OUTPUT TO 'C:\TEMP\tMwstCalc_Faktura.csv' APPEND.
  183. /* DO i1 = 1 TO htMwstCalc:NUM-FIELDS: */
  184. /* PUT CONTROL htMwstCalc:BUFFER-FIELD(i1):LABEL ';'. */
  185. /* END. */
  186. PUT CONTROL CHR(10).
  187. FOR EACH tMwstCalc:
  188. EXPORT DELIMITER ';' tMwstCalc.
  189. END.
  190. OUTPUT CLOSE.
  191. PROCEDURE RUNDEN :
  192. /*------------------------------------------------------------------------------*/
  193. /* Purpose: */
  194. /* Parameters: <none> */
  195. /* Notes: */
  196. /*------------------------------------------------------------------------------*/
  197. /*---------------------------------------------------------------------------*/
  198. /* Preis Runden */
  199. /*---------------------------------------------------------------------------*/
  200. /* Input: Rundbetr */
  201. /* Rundcode 0 = keine Rundung */
  202. /* 1 = 0.05 Rundung */
  203. /* 2 = 0.50 Rundung */
  204. /* 3 = 1.00 Rundung */
  205. /* 4 = 5.00 Rundung */
  206. /* 5 = 10.0 Rundung */
  207. /* Output: Rundbetr */
  208. /* */
  209. /*---------------------------------------------------------------------------*/
  210. DEFINE VARIABLE nBetr AS DECIMAL DECIMALS 4 NO-UNDO.
  211. DEFINE VARIABLE VOp AS DECIMAL INIT 0.2 NO-UNDO.
  212. /*---------------------------------------------------------------------------*/
  213. nBetr = nRundbetr.
  214. IF cFrw <> 'CHF' AND iRundcode = 1 THEN iRundcode = 0.
  215. IF iRundcode > 5 THEN iRundcode = 0.
  216. IF iRundcode = 1 THEN
  217. nBetr = ROUND((nBetr / 100 * VOp), 4) / Vop * 100.
  218. IF iRundcode = 2 THEN
  219. nBetr = ROUND((nBetr / 100 * VOp), 3) / Vop * 100.
  220. IF iRundcode = 3 THEN
  221. nBetr = ROUND((nBetr / 100), 2) * 100.
  222. IF iRundcode = 4 THEN
  223. nBetr = ROUND((nBetr / 100 * VOp), 2) / Vop * 100.
  224. IF iRundcode = 5 THEN
  225. nBetr = ROUND((nBetr / 100), 1) * 100.
  226. nRundbetr = nBetr.
  227. END PROCEDURE.