SammelRechnung.p 80 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318
  1. &ANALYZE-SUSPEND _VERSION-NUMBER AB_v10r12
  2. &ANALYZE-RESUME
  3. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure
  4. /*------------------------------------------------------------------------
  5. File :
  6. Purpose :
  7. Syntax :
  8. Description :
  9. Author(s) :
  10. Created :
  11. Notes :
  12. ----------------------------------------------------------------------*/
  13. /* This .W file was created with the Progress AppBuilder. */
  14. /*----------------------------------------------------------------------*/
  15. /* *************************** Definitions ************************** */
  16. DEFINE INPUT PARAMETER iphParam AS HANDLE NO-UNDO.
  17. DEFINE OUTPUT PARAMETER opcResult AS CHARACTER NO-UNDO.
  18. DEFINE VARIABLE iSeite AS INTEGER NO-UNDO.
  19. DEFINE VARIABLE iAnzDok AS INTEGER NO-UNDO.
  20. DEFINE VARIABLE iLauf AS INTEGER NO-UNDO.
  21. DEFINE VARIABLE lFirst AS LOG INIT FALSE NO-UNDO.
  22. DEFINE VARIABLE lLast AS LOG INIT FALSE NO-UNDO.
  23. DEFINE VARIABLE lPreis AS LOG NO-UNDO.
  24. DEFINE VARIABLE cFirma AS CHARACTER NO-UNDO.
  25. DEFINE VARIABLE AdFirma AS CHARACTER NO-UNDO.
  26. DEFINE VARIABLE nFakBetr AS DECIMAL NO-UNDO.
  27. DEFINE VARIABLE dFakDatum AS DATE NO-UNDO.
  28. DEFINE VARIABLE iFaknr AS INTEGER NO-UNDO.
  29. DEFINE VARIABLE iSprcd AS INTEGER NO-UNDO.
  30. DEFINE VARIABLE nTotale AS DECIMAL EXTENT 15 NO-UNDO.
  31. DEFINE VARIABLE cFormtext AS CHARACTER EXTENT 30 NO-UNDO.
  32. DEFINE VARIABLE cRabText AS CHARACTER NO-UNDO.
  33. DEFINE VARIABLE cZusText AS CHARACTER NO-UNDO.
  34. DEFINE VARIABLE cEpzText AS CHARACTER NO-UNDO.
  35. DEFINE VARIABLE cBesrKopf AS CHARACTER EXTENT 12 NO-UNDO.
  36. DEFINE VARIABLE lDebIncl AS LOG NO-UNDO.
  37. DEFINE VARIABLE Rundbetr AS DECIMAL DECIMALS 4 NO-UNDO.
  38. DEFINE VARIABLE RundCode AS INTEGER INIT 1 NO-UNDO.
  39. DEFINE VARIABLE htTabTexte AS HANDLE NO-UNDO.
  40. DEFINE VARIABLE hAufko AS HANDLE NO-UNDO.
  41. DEFINE VARIABLE cInstallation AS CHARACTER NO-UNDO.
  42. DEFINE VARIABLE iWgr AS INTEGER NO-UNDO.
  43. DEFINE VARIABLE iPgr AS INTEGER NO-UNDO.
  44. DEFINE VARIABLE iAgr AS INTEGER NO-UNDO.
  45. DEFINE VARIABLE iArtnr AS INTEGER NO-UNDO.
  46. DEFINE VARIABLE iInhalt AS INTEGER NO-UNDO.
  47. DEFINE VARIABLE iJahr AS INTEGER NO-UNDO.
  48. DEFINE VARIABLE iMaxPos AS INTEGER INIT 2650 NO-UNDO.
  49. DEFINE VARIABLE cvpr_Dokument AS CHARACTER NO-UNDO.
  50. DEFINE VARIABLE iArtZeile AS INTEGER NO-UNDO.
  51. DEFINE VARIABLE iVPagePos AS INTEGER NO-UNDO.
  52. DEFINE VARIABLE iVGroupPos AS INTEGER NO-UNDO.
  53. DEFINE BUFFER bAufko FOR Aufko .
  54. DEFINE BUFFER bAufze FOR Aufze .
  55. DEFINE BUFFER FDebst FOR Debst . /* Fakturaadresse */
  56. DEFINE BUFFER LDebst FOR Debst . /* Lieferadresse */
  57. DEFINE BUFFER LAdresse FOR Adresse .
  58. DEFINE BUFFER bAdresse FOR Adresse .
  59. DEFINE BUFFER bWust FOR Wust .
  60. DEFINE BUFFER bSteuer FOR Steuer .
  61. { incl/properties.i }
  62. { incl/ttdruckparam.i }
  63. { swissQR/propertiesSwissQR.i }
  64. DEFINE TEMP-TABLE tDokument
  65. FIELD cGruppe AS CHARACTER
  66. FIELD iZeile AS INTEGER
  67. FIELD cFeld AS CHARACTER
  68. FIELD cInhalt AS CHARACTER
  69. INDEX tDokument-k1 IS PRIMARY
  70. cGruppe
  71. iZeile
  72. cFeld
  73. .
  74. DEFINE TEMP-TABLE tTotale
  75. FIELD nMwstPfl AS DECIMAL EXTENT 12
  76. FIELD nMwstBet AS DECIMAL EXTENT 12
  77. FIELD nSammTot AS DECIMAL
  78. FIELD nSkBer AS DECIMAL
  79. FIELD nWW AS DECIMAL
  80. .
  81. DEFINE TEMP-TABLE sAufko
  82. FIELD cFirma AS CHARACTER
  83. FIELD iAufnr AS INTEGER
  84. FIELD iFak_Knr AS INTEGER
  85. FIELD iKnr AS INTEGER
  86. FIELD iSamm_Nr AS INTEGER
  87. FIELD iRecid AS RECID
  88. FIELD iFaknr AS INTEGER
  89. .
  90. DEFINE TEMP-TABLE tAufko LIKE Aufko
  91. FIELD iRecid AS RECID
  92. .
  93. DEFINE TEMP-TABLE tqAufko LIKE Aufko
  94. FIELD iRecid AS RECID
  95. FIELD lBetrag AS LOGICAL.
  96. .
  97. DEFINE VARIABLE htqAufko AS HANDLE NO-UNDO.
  98. htqAufko = TEMP-TABLE tqAufko:DEFAULT-BUFFER-HANDLE.
  99. DEFINE TEMP-TABLE tAufze
  100. FIELD Aufnr AS INTEGER
  101. FIELD Sort1 AS CHARACTER
  102. FIELD Sort2 AS CHARACTER
  103. FIELD Sort3 AS CHARACTER
  104. FIELD Artnr AS INTEGER
  105. FIELD Inhalt AS INTEGER
  106. FIELD Jahr AS INTEGER
  107. FIELD Pos AS INTEGER
  108. FIELD Zeile AS RECID
  109. FIELD Preis AS DECIMAL DECIMALS 4
  110. FIELD Aktion AS LOG
  111. FIELD LagOrt AS CHARACTER
  112. FIELD MGeli AS DECIMAL
  113. FIELD MRuek AS DECIMAL
  114. INDEX tAufze-k1 IS PRIMARY
  115. Aufnr
  116. Sort1
  117. Sort2
  118. Sort3
  119. .
  120. DEFINE TEMP-TABLE tSpeRab
  121. FIELD Rab_Grp AS INTEGER
  122. FIELD Auf_Betr AS DECIMAL DECIMALS 4
  123. .
  124. DEFINE TEMP-TABLE tGebKto
  125. FIELD Sort_Cd AS CHARACTER
  126. FIELD Geb_Cd AS CHARACTER
  127. FIELD Bez AS CHARACTER
  128. FIELD Preis AS DECIMAL
  129. FIELD A_Anz AS DECIMAL
  130. FIELD A_Betrag AS DECIMAL
  131. FIELD E_Anz AS DECIMAL
  132. FIELD E_Betrag AS DECIMAL
  133. FIELD MWST_Art AS INTEGER
  134. FIELD MWST_Cd AS INTEGER
  135. .
  136. DEFINE TEMP-TABLE tRabSumm
  137. FIELD Rab_Summ AS INTEGER
  138. FIELD Bez AS CHARACTER
  139. FIELD F_Rab_Art AS INTEGER
  140. FIELD F_Wert AS DECIMAL DECIMALS 4
  141. FIELD A_Rab_Art AS INTEGER
  142. FIELD A_Wert AS DECIMAL DECIMALS 4
  143. FIELD Auf_Rab AS DECIMAL DECIMALS 4
  144. FIELD Abh_Rab AS DECIMAL DECIMALS 4
  145. .
  146. DEFINE TEMP-TABLE tUmsGrp
  147. FIELD Ums_Grp AS INTEGER
  148. FIELD Mwst AS INTEGER
  149. FIELD Ansatz AS DECIMAL
  150. FIELD Bez AS CHARACTER
  151. FIELD lInkl AS LOG
  152. FIELD Ums_Betr AS DECIMAL DECIMALS 4
  153. .
  154. DEFINE TEMP-TABLE tTabTexte
  155. FIELD cRecArt AS CHARACTER
  156. FIELD iZeile AS INTEGER
  157. FIELD cFeld1 AS CHARACTER
  158. FIELD cFeld2 AS CHARACTER
  159. FIELD cFeld3 AS CHARACTER
  160. FIELD iFeld1 AS INTEGER
  161. FIELD iFeld2 AS INTEGER
  162. FIELD iFeld3 AS INTEGER
  163. INDEX tTabTexte-k1 IS PRIMARY
  164. cRecArt
  165. iZeile.
  166. /* _UIB-CODE-BLOCK-END */
  167. &ANALYZE-RESUME
  168. &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  169. /* ******************** Preprocessor Definitions ******************** */
  170. &Scoped-define PROCEDURE-TYPE Procedure
  171. &Scoped-define DB-AWARE no
  172. /* _UIB-PREPROCESSOR-BLOCK-END */
  173. &ANALYZE-RESUME
  174. /* ************************ Function Prototypes ********************** */
  175. &IF DEFINED(EXCLUDE-calcBlock) = 0 &THEN
  176. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD calcBlock Procedure
  177. FUNCTION calcBlock RETURNS INTEGER (ipGruppe AS CHARACTER) FORWARD.
  178. /* _UIB-CODE-BLOCK-END */
  179. &ANALYZE-RESUME
  180. &ENDIF
  181. /* *********************** Procedure Settings ************************ */
  182. &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
  183. /* Settings for THIS-PROCEDURE
  184. Type: Procedure
  185. Allow:
  186. Frames: 0
  187. Add Fields to: Neither
  188. Other Settings: CODE-ONLY COMPILE
  189. */
  190. &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
  191. /* ************************* Create Window ************************** */
  192. &ANALYZE-SUSPEND _CREATE-WINDOW
  193. /* DESIGN Window definition (used by the UIB)
  194. CREATE WINDOW Procedure ASSIGN
  195. HEIGHT = 15
  196. WIDTH = 60.
  197. /* END WINDOW DEFINITION */
  198. */
  199. &ANALYZE-RESUME
  200. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
  201. /* *************************** Main Block *************************** */
  202. opcResult = ''.
  203. cInstallation = DYNAMIC-FUNCTION('getInstallation':U).
  204. CREATE tParam.
  205. htParam:BUFFER-COPY(iphParam).
  206. ASSIGN
  207. cFirma = tParam.cFirma
  208. iAnzDok = tParam.Anzahl.
  209. FIND bSteuer NO-LOCK WHERE bSteuer.Firma = cFirma.
  210. AdFirma = bSteuer.AdFirma.
  211. RUN AUFTRAG_ERMITTELN.
  212. IF opcResult <> '' THEN RETURN.
  213. FOR EACH sAufko
  214. BY sAufko.iFak_Knr:
  215. FIND bAdresse NO-LOCK
  216. WHERE bAdresse.Firma = AdFirma
  217. AND bAdresse.Knr = sAufko.iFak_Knr.
  218. iSprcd = bAdresse.Sprcd.
  219. RUN GET_FORMTEXT ( tParam.cInstall, tParam.cDokument, iSprcd,
  220. OUTPUT cFormText ) NO-ERROR.
  221. cRabText = TRIM(SUBSTRING(cFormText[21],01,20)).
  222. cZusText = TRIM(SUBSTRING(cFormText[21],21,20)).
  223. cEpzText = TRIM(SUBSTRING(cFormText[21],41,20)).
  224. RELEASE bAdresse.
  225. FIND Aufko NO-LOCK
  226. WHERE Aufko.Firma = sAufko.cFirma
  227. AND Aufko.Aufnr = sAufko.iAufnr NO-ERROR.
  228. EMPTY TEMP-TABLE tqAufko .
  229. CREATE tqAufko.
  230. BUFFER-COPY Aufko TO tqAufko
  231. ASSIGN
  232. tqAufko.iRecid = RECID(Aufko)
  233. tqAufko.lBetrag = TRUE.
  234. RELEASE Aufko.
  235. { vpr.i INIT }
  236. { vpr.i START }
  237. DO iLauf = 1 TO iAnzDok:
  238. dFakDatum = tParam.dFakDatum.
  239. iSeite = 0.
  240. iFaknr = sAufko.iFaknr.
  241. lFirst = TRUE.
  242. lPreis = TRUE.
  243. lLast = FALSE.
  244. EMPTY TEMP-TABLE tUmsGrp .
  245. EMPTY TEMP-TABLE tTotale .
  246. EMPTY TEMP-TABLE tDokument .
  247. CREATE tTotale.
  248. FOR EACH bAufko NO-LOCK
  249. WHERE bAufko.Firma = sAufko.cFirma
  250. AND bAufko.Fak_Knr = sAufko.iFak_Knr
  251. AND bAufko.Samm_Nr = sAufko.iSamm_Nr
  252. AND bAufko.Faknr = sAufko.iFaknr
  253. BREAK BY bAufko.Fak_Knr
  254. BY bAufko.Samm_Nr
  255. BY bAufko.Knr
  256. BY bAufko.Aufnr :
  257. EMPTY TEMP-TABLE tAufze .
  258. EMPTY TEMP-TABLE tGebKto .
  259. EMPTY TEMP-TABLE tRabSumm .
  260. EMPTY TEMP-TABLE tSpeRab .
  261. EMPTY TEMP-TABLE tTabTexte .
  262. FIND bAdresse NO-LOCK USE-INDEX Adresse-k1
  263. WHERE bAdresse.Firma = AdFirma
  264. AND bAdresse.Knr = bAufko.Fak_Knr NO-ERROR.
  265. FIND LDebst NO-LOCK USE-INDEX Debst-k1
  266. WHERE LDebst.Firma = cFirma
  267. AND LDebst.Knr = bAufko.Knr NO-ERROR.
  268. FIND FDebst NO-LOCK USE-INDEX Debst-k1
  269. WHERE FDebst.Firma = cFirma
  270. AND FDebst.Knr = bAufko.Fak_Knr NO-ERROR.
  271. FIND bWust NO-LOCK USE-INDEX Wust-k1
  272. WHERE bWust.CodeK = LDebst.MWST
  273. AND bWust.CodeA = 99 NO-ERROR.
  274. lDebIncl = FALSE.
  275. IF AVAILABLE bWust THEN lDebIncl = bWust.Incl.
  276. hAufko = BUFFER bAufko:HANDLE.
  277. htTabTexte = TEMP-TABLE tTabTexte:DEFAULT-BUFFER-HANDLE.
  278. /* Texte und Werte aus Tabelle 'Tabel' laden für RecArt */
  279. /* FAKART, AUFSTATUS, LIEFART, FAHRER, WISO, ABLAD */
  280. RUN CREATE_TABTEXTE ( hAufko, INPUT-OUTPUT htTabTexte ) NO-ERROR.
  281. RUN FUELLEN_tAufze ( bAufko.Aufnr ) NO-ERROR.
  282. FOR EACH tAufze
  283. WHERE tAufze.Artnr > 0:
  284. FIND bAufze NO-LOCK WHERE RECID(bAufze) = tAufze.Zeile.
  285. /* Spezial-Auftragsrabatt pro Lieferschein bilden */
  286. IF bAufze.Auf_Sp_Grp > 0 THEN
  287. DO:
  288. FIND FIRST tSpeRab
  289. WHERE tSpeRab.Rab_Grp = bAufze.Auf_Sp_Grp NO-ERROR.
  290. IF NOT AVAILABLE tSpeRab THEN
  291. DO:
  292. CREATE tSpeRab.
  293. ASSIGN
  294. tSpeRab.Rab_Grp = bAufze.Auf_Sp_Grp.
  295. END.
  296. tSpeRab.Auf_Betr = tSpeRab.Auf_Betr + bAufze.Auf_Sp_Rab.
  297. END.
  298. /* Summengruppen-Totale pro Lieferschein bilden */
  299. DO WHILE bAufze.Rab_Su_Grp > 0:
  300. FIND FIRST tRabSumm
  301. WHERE tRabSumm.Rab_Summ = bAufze.Rab_Su_Grp NO-ERROR.
  302. IF NOT AVAILABLE tRabSumm THEN
  303. DO:
  304. FIND FIRST RabSumm NO-LOCK
  305. WHERE RabSumm.Firma = bAufze.Firma
  306. AND RabSumm.Rab_Summ = bAufze.Rab_Su_Grp NO-ERROR.
  307. IF NOT AVAILABLE RabSumm THEN LEAVE.
  308. CREATE tRabSumm.
  309. ASSIGN
  310. tRabSumm.Rab_Summ = bAufze.Rab_Su_Grp
  311. tRabSumm.Bez = RabSumm.Bez
  312. tRabSumm.Auf_Rab = 0
  313. tRabSumm.Abh_Rab = 0.
  314. END.
  315. LEAVE.
  316. END.
  317. END.
  318. IF LAST-OF ( bAufko.Samm_Nr ) THEN lLast = TRUE.
  319. iArtZeile = 0.
  320. RUN DRUCKEN.
  321. /* Auftragskopf mutieren */
  322. REPEAT TRANSACTION:
  323. IF iLauf < iAnzDok THEN LEAVE.
  324. FIND FIRST tTabTexte NO-LOCK
  325. WHERE tTabTexte.cRecArt = 'FAKART'
  326. AND tTabTexte.iZeile = 1.
  327. FIND Aufko WHERE RECID(Aufko) = RECID(bAufko).
  328. Aufko.Gedruckt = TRUE.
  329. IF tTabTexte.iFeld1 > Aufko.Fak_Art THEN Aufko.Fak_Art = tTabTexte.iFeld1.
  330. IF tTabTexte.iFeld2 > Aufko.Auf_Sta THEN Aufko.Auf_Sta = tTabTexte.iFeld2.
  331. RELEASE Aufko.
  332. LEAVE.
  333. END.
  334. END.
  335. END.
  336. { vpr.i STOP }
  337. END.
  338. PROCEDURE ShellExecuteA EXTERNAL "shell32.dll" :
  339. DEFINE INPUT PARAMETER lphwnd AS LONG.
  340. DEFINE INPUT PARAMETER lpOperation AS CHARACTER.
  341. DEFINE INPUT PARAMETER lpFile AS CHARACTER.
  342. DEFINE INPUT PARAMETER lpParameters AS CHARACTER.
  343. DEFINE INPUT PARAMETER lpDirectory AS CHARACTER.
  344. DEFINE INPUT PARAMETER nShowCmd AS LONG.
  345. DEFINE RETURN PARAMETER hInstance AS LONG.
  346. END PROCEDURE.
  347. /* _UIB-CODE-BLOCK-END */
  348. &ANALYZE-RESUME
  349. &IF DEFINED(EXCLUDE-DRUCKEN_QRCODE) = 0 &THEN
  350. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN_QRCODE Procedure
  351. PROCEDURE DRUCKEN_QRCODE:
  352. /*------------------------------------------------------------------------------*/
  353. /* Purpose: */
  354. /* Parameters: <none> */
  355. /* Notes: */
  356. /*------------------------------------------------------------------------------*/
  357. DEFINE VARIABLE cFileName AS CHARACTER NO-UNDO.
  358. DEFINE VARIABLE cString AS CHARACTER NO-UNDO.
  359. DEFINE VARIABLE hAufko AS HANDLE NO-UNDO.
  360. DEFINE VARIABLE cBesrTemplate AS CHARACTER NO-UNDO INIT 'viper/wiederkehr/BESR_QR.vfr'.
  361. DEFINE VARIABLE cWerbung AS CHARACTER NO-UNDO.
  362. DEFINE VARIABLE cConString AS CHARACTER NO-UNDO.
  363. DEFINE VARIABLE i1 AS INTEGER NO-UNDO.
  364. FIND FIRST tqAufko.
  365. tqAufko.Auf_Tot = RundBetr.
  366. FIND FIRST tParam.
  367. RUN vpr_newPage.
  368. FIND FIRST ViperDoc NO-LOCK
  369. WHERE ViperDoc.Firma = tqAufko.Firma
  370. AND ViperDoc.Benutzer = ''
  371. AND ViperDoc.Formular = 'BESR_QR'
  372. AND ViperDoc.DokArt = 0 NO-ERROR.
  373. IF NOT AVAILABLE ViperDoc THEN RETURN.
  374. RUN vpr_LoadVFR (cBesrTemplate).
  375. RUN vpr_ActivateReport ('BESR_QR').
  376. RUN vpr_SelectPrinter (ViperDoc.Drucker).
  377. RUN vpr_SetDocAttrib ('PAPERSIZE=A4').
  378. RUN vpr_SetPreviewMode ('Direct').
  379. RUN vpr_InitGroups ("").
  380. RUN vpr_initGraphObj.
  381. IF ViperDoc.Schacht_Besr > 0 THEN RUN vpr_SetCurrentPageProperties("Papertray", ViperDoc.Schacht_BESR).
  382. cFileName = SUBSTITUTE('&1&2_&3', cPathQRCodes, 'QR_CODE', STRING(bAufko.Aufnr,'9999999')).
  383. RUN 'SwissQR/SwissQRCode.p' ( htqAufko, cFileName ).
  384. cFilename = cFileName + '.jpg'.
  385. IF SEARCH(cFileName) <> ? THEN
  386. DO:
  387. cFileName = 'FILENAME=' + cFileName.
  388. RUN vpr_setGraphObjAttrib ( 'QRCode', 'QRCODE', cFileName ).
  389. END.
  390. /* FILE-INFO:FILE-NAME = cFileName. */
  391. /* cFileName = FILE-INFO:FULL-PATHNAME.*/
  392. cWerbung = SUBSTITUTE(cPathWerbung, tParam.cInstall).
  393. cWerbung = SUBSTITUTE('&1Werbung_&2.jpg', cWerbung, tqAufko.Firma).
  394. IF SEARCH(cWerbung) <> ? THEN
  395. DO:
  396. cWerbung = SUBSTITUTE('FILENAME=&1', cWerbung).
  397. RUN vpr_setGraphObjAttrib ( 'Werbung', 'QRCODE', cWerbung ).
  398. END.
  399. RUN vpr_InitGraphObj.
  400. RUN vpr_flushGroup('QRCODE').
  401. /* RUN vpr_printdoc ( vpr_getPageNo(), vpr_getPageNo() ).*/
  402. /* RUN vpr_ActivateReport (tParam.cDokument).*/
  403. END PROCEDURE.
  404. /* _UIB-CODE-BLOCK-END */
  405. &ANALYZE-RESUME
  406. &ENDIF
  407. /* ********************** Internal Procedures *********************** */
  408. &IF DEFINED(EXCLUDE-ARTIKELZEILE) = 0 &THEN
  409. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE ARTIKELZEILE Procedure
  410. PROCEDURE ARTIKELZEILE :
  411. /*------------------------------------------------------------------------------
  412. Purpose:
  413. Parameters: <none>
  414. Notes:
  415. ------------------------------------------------------------------------------*/
  416. DEFINE INPUT PARAMETER ipRecid AS RECID NO-UNDO.
  417. DEFINE VARIABLE cString AS CHARACTER NO-UNDO.
  418. DEFINE VARIABLE nRabWert AS DECIMAL NO-UNDO.
  419. DEFINE VARIABLE xRabText AS CHARACTER NO-UNDO.
  420. FIND tAufze WHERE RECID(tAufze) = ipRecid NO-LOCK.
  421. FIND Aufze WHERE RECID(Aufze) = tAufze.Zeile NO-LOCK.
  422. iArtZeile = iArtZeile + 1.
  423. DO WHILE Aufze.Artnr = 0:
  424. cString = Aufze.Bez1.
  425. IF Aufze.Bez2 <> '' THEN
  426. DO:
  427. cString = cString
  428. + (IF cString = '' THEN '' ELSE CHR(10))
  429. + Aufze.Bez2.
  430. END.
  431. CREATE tDokument.
  432. ASSIGN
  433. tDokument.cGruppe = 'ArtikelZeile1'
  434. tDokument.iZeile = iArtZeile
  435. tDokument.cFeld = 'Bez1'
  436. tDokument.cInhalt = cString.
  437. RETURN.
  438. END.
  439. FIND Artst OF Aufze NO-LOCK.
  440. FIND GGebinde NO-LOCK
  441. WHERE GGebinde.Firma = cFirma
  442. AND GGebinde.Geb_Cd = Aufze.GGeb_Cd NO-ERROR.
  443. FIND VGebinde NO-LOCK
  444. WHERE VGebinde.Firma = cFirma
  445. AND VGebinde.Geb_Cd = Aufze.VGeb_Cd NO-ERROR.
  446. FIND KGebinde NO-LOCK
  447. WHERE KGebinde.Firma = cFirma
  448. AND KGebinde.Geb_Cd = Aufze.KGeb_Cd NO-ERROR.
  449. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Artnr' , STRING(Aufze.Artnr ,"999999") ).
  450. IF Aufze.VGeb_Me <> 0 THEN
  451. DO:
  452. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Menge_VGeb', TRIM(STRING(Aufze.VGeb_Me,'->>>>>9')) ).
  453. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'VGebinde' , VGebinde.KBez ).
  454. END.
  455. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'KGebinde', KGebinde.Kbez ).
  456. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Menge' , STRING(Aufze.MGeli,'->>,>>9') ).
  457. cString = Aufze.Bez1.
  458. IF Aufze.Bez2 <> '' THEN
  459. DO:
  460. cString = cString
  461. + (IF cString = '' THEN '' ELSE CHR(10))
  462. + Aufze.Bez2.
  463. END.
  464. IF Aufze.Aktion THEN
  465. DO:
  466. cString = cString
  467. + (IF cString = '' THEN '' ELSE CHR(10))
  468. + Aufze.Aktion_Text.
  469. END.
  470. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', cString ).
  471. IF Aufze.Alk_Gehalt <> 0 THEN
  472. DO:
  473. cString = STRING(Aufze.Alk_Gehalt,"zz9.9%").
  474. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Alk%', cString ).
  475. END.
  476. IF Aufze.Jahr > 9 THEN
  477. DO:
  478. cString = STRING(Aufze.Jahr,"9999").
  479. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'JG', cString ).
  480. END.
  481. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Preis' , STRING(Aufze.Preis ,'>,>>9.99') ).
  482. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', STRING(Aufze.Bru_Betr,'->>>,>>9.99') ).
  483. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'MC' , STRING(Aufze.WuCd ,'z9') ).
  484. IF Aufze.Rab_Betr <> 0 THEN
  485. DO:
  486. iArtZeile = iArtZeile + 1.
  487. nRabWert = ABSOLUTE(Aufze.Rab_Wert).
  488. IF Aufze.Rab_Art = 3 THEN xRabText = cEpzText.
  489. ELSE
  490. DO:
  491. IF Aufze.Rab_Betr < 0 THEN xRabText = cZusText.
  492. IF Aufze.Rab_Betr > 0 THEN xRabText = cRabText.
  493. END.
  494. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', TRIM(xRabText) ).
  495. IF Aufze.Rab_Art = 1 THEN cString = STRING(nRabWert,"->9.9%").
  496. IF Aufze.Rab_Art = 2 OR
  497. Aufze.Rab_Art = 3 THEN cString = STRING(nRabWert,"-9.99").
  498. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Preis', cString ).
  499. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', TRIM(STRING(- Aufze.Rab_Betr,"->>>,>>9.99")) ).
  500. END.
  501. DO WHILE TRUE:
  502. IF Aufze.Zus_Betr = 0 THEN LEAVE.
  503. iArtZeile = iArtZeile + 1.
  504. nRabWert = ABSOLUTE(Aufze.Zus_Wert).
  505. IF Aufze.Zus_Art = 3 THEN xRabText = cEpzText.
  506. ELSE
  507. DO:
  508. IF Aufze.Zus_Betr < 0 THEN xRabText = cRabText.
  509. IF Aufze.Zus_Betr > 0 THEN xRabText = cZusText.
  510. END.
  511. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', TRIM(xRabText) ).
  512. IF Aufze.Zus_Art = 1 THEN cString = STRING(nRabWert,"->9.9%").
  513. IF Aufze.Zus_Art = 2 OR
  514. Aufze.Zus_Art = 3 THEN cString = STRING(nRabWert,"-9.99").
  515. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Preis', cString ).
  516. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', TRIM(STRING(+ Aufze.Zus_Betr,"->>>,>>9.99")) ).
  517. LEAVE.
  518. END.
  519. /* ---- Summengruppen-Total -------------------------------------------- */
  520. IF Aufze.Rab_Su_Grp <> 0 THEN
  521. DO:
  522. FIND FIRST TRabSumm WHERE TRabSumm.Rab_Summ = Aufze.Rab_Su_Grp NO-ERROR.
  523. IF AVAILABLE TRabSumm THEN
  524. DO:
  525. TRabSumm.Auf_Rab = TRabSumm.Auf_Rab + Aufze.Auf_Rab.
  526. TRabSumm.Abh_Rab = TRabSumm.Abh_Rab + Aufze.Abh_Rab.
  527. END.
  528. END.
  529. /* ---- Warengruppen-Totale -------------------------------------------- */
  530. FIND FIRST tUmsGrp WHERE tUmsGrp.Ums_Grp = Artst.Wg_Grp
  531. AND tUmsGrp.MWst = Aufze.WuCd
  532. AND tUmsGrp.Ansatz = Aufze.Mwst% NO-ERROR.
  533. IF NOT AVAILABLE tUmsGrp THEN
  534. DO:
  535. FIND WarenGrp NO-LOCK USE-INDEX WarenGrp-k1
  536. WHERE WarenGrp.Firma = cFirma
  537. AND WarenGrp.Wgr = Artst.Wg_Grp NO-ERROR.
  538. CREATE tUmsGrp.
  539. ASSIGN
  540. tUmsGrp.Ums_Grp = Artst.Wg_Grp
  541. tUmsGrp.Mwst = Aufze.WuCd
  542. tUmsGrp.lInkl = Aufze.Mwst_Inkl
  543. tUmsGrp.Ansatz = Aufze.MWST%.
  544. IF AVAILABLE WarenGrp THEN tUmsGrp.Bez = WarenGrp.Bez1.
  545. ELSE tUmsGrp.Bez = "??????????".
  546. END.
  547. tUmsGrp.Ums_Betr = tUmsGrp.Ums_Betr
  548. + Aufze.Net_Betr
  549. - Aufze.Auf_Rab
  550. - Aufze.Abh_Rab
  551. - Aufze.Auf_Sp_Rab.
  552. END PROCEDURE.
  553. /* _UIB-CODE-BLOCK-END */
  554. &ANALYZE-RESUME
  555. &ENDIF
  556. &IF DEFINED(EXCLUDE-AUFTRAG_ERMITTELN) = 0 &THEN
  557. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE AUFTRAG_ERMITTELN Procedure
  558. PROCEDURE AUFTRAG_ERMITTELN :
  559. /*------------------------------------------------------------------------------
  560. Purpose:
  561. Parameters: <none>
  562. Notes:
  563. ------------------------------------------------------------------------------*/
  564. DEFINE VARIABLE iAufnr AS INTEGER NO-UNDO.
  565. DEFINE BUFFER bDebst FOR Debst.
  566. FIND FIRST tParam.
  567. EMPTY TEMP-TABLE sAufko.
  568. /* Sammeln aller Aufträge pro Sammelnummer */
  569. FOR EACH Aufko NO-LOCK USE-INDEX Aufko-k5
  570. WHERE Aufko.Firma = tParam.cFirma
  571. AND Aufko.Fak_Art = tParam.iFakArt
  572. AND Aufko.Auf_Sta = tParam.iAufSta
  573. AND Aufko.Auf_Sta >= 4
  574. AND Aufko.Fak_Knr >= tParam.iVonKnr
  575. AND Aufko.Fak_Knr <= tParam.iBisKnr
  576. AND Aufko.Lief_Datum >= tParam.dVonDatum
  577. AND Aufko.Lief_Datum <= tParam.dBisDatum
  578. AND Aufko.Samm_Nr > 0
  579. BREAK BY Aufko.Fak_Knr
  580. BY Aufko.Samm_Nr
  581. BY Aufko.Faknr DESCENDING:
  582. IF NOT FIRST-OF ( Aufko.Samm_Nr ) THEN NEXT.
  583. IF tParam.iVerband <> 999999 THEN
  584. DO:
  585. FIND bDebst NO-LOCK
  586. WHERE bDebst.Firma = Aufko.Firma
  587. AND bDebst.Knr = Aufko.Fak_Knr NO-ERROR.
  588. IF NOT AVAILABLE bDebst THEN NEXT.
  589. IF bDebst.Verband_Grp <> tParam.iVerband THEN NEXT.
  590. RELEASE bDebst.
  591. END.
  592. CREATE sAufko.
  593. ASSIGN
  594. sAufko.cFirma = Aufko.Firma
  595. sAufko.iAufnr = Aufko.Aufnr
  596. sAufko.iFak_Knr = Aufko.Fak_Knr
  597. sAufko.iKnr = Aufko.Knr
  598. sAufko.iSamm_Nr = Aufko.Samm_Nr
  599. sAufko.iRecid = RECID(Aufko)
  600. sAufko.iFaknr = Aufko.Faknr.
  601. END.
  602. /* Alle Aufträge, die nicht in diese Auswahl passen */
  603. /* Rechnunsnummer und Gedrucktflag zurücksetzen */
  604. /* In Status 4 (Monatsrechnungen) zurück setzen */
  605. REPEAT TRANSACTION:
  606. FOR EACH sAufko.
  607. FOR EACH Aufko
  608. WHERE Aufko.Firma = sAufko.cFirma
  609. AND Aufko.Samm_Nr = sAufko.iSamm_Nr
  610. AND Aufko.Fak_Knr = sAufko.iFak_Knr:
  611. IF Aufko.Lief_Datum >= tParam.dvonDatum AND
  612. Aufko.Lief_Datum <= tParam.dbisDatum THEN NEXT.
  613. iAufnr = 0.
  614. ASSIGN
  615. Aufko.Faknr = 0
  616. Aufko.Gedruckt = FALSE.
  617. IF Aufko.Auf_Sta > 4 THEN iAufnr = Aufko.Aufnr.
  618. RELEASE Aufko.
  619. IF iAufnr > 0 THEN RUN ZURUECK ( iAufnr ).
  620. END.
  621. END.
  622. RELEASE Aufko.
  623. LEAVE.
  624. END.
  625. /* Rechnungsnummer auf alle Lieferscheine der Sammelrechnung setzen */
  626. FOR EACH sAufko
  627. WHERE sAufko.iFaknr = 0:
  628. sAufko.iFaknr = DYNAMIC-FUNCTION('createFaknr':U, sAufko.cFirma ) NO-ERROR.
  629. IF sAufko.iFaknr = 0 OR
  630. sAufko.iFaknr = ? THEN
  631. DO:
  632. MESSAGE 'Es konnten keine(nicht alle Rechnungsnummern gelöst werden'
  633. VIEW-AS ALERT-BOX ERROR.
  634. opcResult = 'FAKNR'.
  635. RETURN NO-APPLY.
  636. END.
  637. END.
  638. REPEAT TRANSACTION:
  639. FOR EACH sAufko:
  640. FOR EACH Aufko
  641. WHERE Aufko.Firma = sAufko.cFirma
  642. AND Aufko.Samm_Nr = sAufko.iSamm_Nr
  643. AND Aufko.Fak_Knr = sAufko.iFak_Knr
  644. AND Aufko.Lief_Datum >= tParam.dvonDatum
  645. AND Aufko.Lief_Datum <= tParam.dbisDatum:
  646. ASSIGN
  647. Aufko.Faknr = sAufko.iFaknr
  648. Aufko.Fak_Datum = tParam.dFakDat.
  649. RELEASE Aufko.
  650. END.
  651. END.
  652. LEAVE.
  653. END.
  654. /* Alle Auftragstotale aller Lieferscheine neu rechnen */
  655. FOR EACH sAufko:
  656. FOR EACH bAufko NO-LOCK
  657. WHERE bAufko.Firma = sAufko.cFirma
  658. AND bAufko.Samm_Nr = sAufko.iSamm_Nr
  659. AND bAufko.Fak_Knr = sAufko.iFak_Knr
  660. AND bAufko.Lief_Datum >= tParam.dvonDatum
  661. AND bAufko.Lief_Datum <= tParam.dbisDatum:
  662. DYNAMIC-FUNCTION('calculateAuftragsTotal':U, bAufko.Firma,
  663. bAufko.Aufnr,
  664. OUTPUT nTotale ) NO-ERROR.
  665. RELEASE bAufko.
  666. END.
  667. END.
  668. END PROCEDURE.
  669. /* _UIB-CODE-BLOCK-END */
  670. &ANALYZE-RESUME
  671. &ENDIF
  672. &IF DEFINED(EXCLUDE-AUSGABE_ARTIKELZEILE) = 0 &THEN
  673. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE AUSGABE_ARTIKELZEILE Procedure
  674. PROCEDURE AUSGABE_ARTIKELZEILE :
  675. /*------------------------------------------------------------------------------
  676. Purpose:
  677. Parameters: <none>
  678. Notes:
  679. ------------------------------------------------------------------------------*/
  680. DEFINE VARIABLE cZellen AS CHARACTER NO-UNDO.
  681. DEFINE VARIABLE cWerte AS CHARACTER NO-UNDO.
  682. DEFINE VARIABLE iPos AS INTEGER NO-UNDO.
  683. FOR EACH tDokument
  684. WHERE tDokument.cGruppe = 'ArtikelZeile1'
  685. BREAK BY tDokument.cGruppe
  686. BY tDokument.iZeile:
  687. IF FIRST-OF ( tDokument.cGruppe ) THEN
  688. DO:
  689. iVPagePos = vpr_getPageVPos() + 20.
  690. RUN vpr_setPageVPos ( iVPagePos ).
  691. RUN vpr_setGroupVPos ( 'ArtikelZeile1', iVPagePos ).
  692. END.
  693. IF FIRST-OF ( tDokument.iZeile ) THEN
  694. DO:
  695. cZellen = ''.
  696. cWerte = ''.
  697. END.
  698. /* IF tDokument.cFeld = 'Bez1' THEN RUN vpr_Asc2RTF ( tDokument.cInhalt, '', OUTPUT tDokument.cInhalt).*/
  699. IF tDokument.cFeld = 'Bez1' THEN tDokument.cInhalt = REPLACE(tDokument.cInhalt, CHR(10), '\par ').
  700. cWerte = cWerte
  701. + tDokument.cInhalt.
  702. cZellen = cZellen
  703. + tDokument.cFeld.
  704. IF NOT LAST-OF ( tDokument.iZeile ) THEN
  705. DO:
  706. ASSIGN
  707. cWerte = cWerte + CHR(01)
  708. cZellen = cZellen + ','.
  709. NEXT.
  710. END.
  711. RUN vpr_SetDelimiter (CHR(01)).
  712. RUN vpr_setGroupText ('ArtikelZeile1', cZellen, cWerte).
  713. iVPagePos = vpr_getPageVPos().
  714. iPos = iVPagePos + vpr_getGroupHeight('ArtikelZeile1').
  715. IF iPos > iMaxPos THEN
  716. DO:
  717. RUN vpr_SetPageVPos ( iMaxPos ).
  718. RUN VIPER_NEUE_SEITE.
  719. RUN DRUCKEN_ADRESSE.
  720. iVPagePos = vpr_getPageVPos() + 20.
  721. RUN vpr_setPageVPos ( iVPagePos ).
  722. RUN vpr_setGroupText ('ArtikelZeile1', cZellen, cWerte).
  723. END.
  724. RUN vpr_FlushGroup ('ArtikelZeile1').
  725. iVPagePos = vpr_getPageVPos().
  726. IF LAST-OF ( tDokument.cGruppe ) THEN LEAVE.
  727. iVPagePos = vpr_getPageVPos().
  728. RUN vpr_setGroupVPos ( 'ArtikelZeile1', iVPagePos ).
  729. END.
  730. FOR EACH tDokument
  731. WHERE tDokument.cGruppe = 'ArtikelZeile1':
  732. DELETE tDokument.
  733. END.
  734. END PROCEDURE.
  735. /* _UIB-CODE-BLOCK-END */
  736. &ANALYZE-RESUME
  737. &ENDIF
  738. &IF DEFINED(EXCLUDE-AUSGABE_GRUPPE) = 0 &THEN
  739. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE AUSGABE_GRUPPE Procedure
  740. PROCEDURE AUSGABE_GRUPPE :
  741. /*------------------------------------------------------------------------------
  742. Purpose:
  743. Parameters: <none>
  744. Notes:
  745. ------------------------------------------------------------------------------*/
  746. DEFINE INPUT PARAMETER ipGruppe AS CHARACTER NO-UNDO.
  747. DEFINE VARIABLE cZellen AS CHARACTER NO-UNDO.
  748. DEFINE VARIABLE cWerte AS CHARACTER NO-UNDO.
  749. DEFINE VARIABLE iSpace AS INTEGER NO-UNDO.
  750. iSpace = vpr_getPageVPos().
  751. FOR EACH tDokument NO-LOCK
  752. WHERE tDokument.cGruppe = ipGruppe
  753. BREAK BY tDokument.cGruppe
  754. BY tDokument.iZeile:
  755. IF FIRST-OF ( tDokument.iZeile ) THEN iSpace = iSpace + 40.
  756. END.
  757. IF iSpace > iMaxPos THEN
  758. DO:
  759. RUN vpr_SetPageVPos ( iMaxPos ).
  760. RUN VIPER_NEUE_SEITE.
  761. RUN DRUCKEN_ADRESSE.
  762. END.
  763. iVPagePos = vpr_getPageVPos().
  764. CASE ipGruppe:
  765. WHEN 'Gebindeabrechnung' THEN
  766. DO:
  767. iVPagePos = iVPagePos + 20.
  768. RUN vpr_setGroupVPos ( 'GebindeabrechnungTitel', iVPagePos ).
  769. RUN vpr_FlushGroup ( 'GebindeabrechnungTitel' ).
  770. iVPagePos = vpr_getPageVPos().
  771. END.
  772. OTHERWISE
  773. DO:
  774. END.
  775. END CASE.
  776. FOR EACH tDokument
  777. WHERE tDokument.cGruppe = ipGruppe
  778. BREAK BY tDokument.cGruppe
  779. BY tDokument.iZeile:
  780. IF FIRST-OF ( tDokument.cGruppe ) THEN
  781. DO:
  782. IF ipGruppe <> 'Kondition' AND
  783. ipGruppe <> 'BESR' AND
  784. ipGruppe <> 'ADRESSE' THEN
  785. DO:
  786. iVPagePos = vpr_getPageVPos().
  787. RUN vpr_setPageVPos ( iVPagePos ).
  788. RUN vpr_setGroupVPos ( ipGruppe, iVPagePos ).
  789. END.
  790. END.
  791. IF FIRST-OF ( tDokument.iZeile ) THEN
  792. DO:
  793. cZellen = ''.
  794. cWerte = ''.
  795. END.
  796. cWerte = cWerte
  797. + tDokument.cInhalt.
  798. cZellen = cZellen
  799. + tDokument.cFeld.
  800. CASE tDokument.cFeld:
  801. WHEN 'Bez1' THEN
  802. cWerte = REPLACE(cWerte, CHR(10), ' \par ').
  803. END CASE.
  804. IF NOT LAST-OF ( tDokument.iZeile ) THEN
  805. DO:
  806. ASSIGN
  807. cWerte = cWerte + CHR(01)
  808. cZellen = cZellen + ','.
  809. NEXT.
  810. END.
  811. RUN vpr_SetDelimiter (CHR(01)).
  812. RUN vpr_SetGroupText (ipGruppe, cZellen, cWerte).
  813. RUN vpr_FlushGroup (ipGruppe).
  814. END.
  815. FOR EACH tDokument
  816. WHERE tDokument.cGruppe = ipGruppe:
  817. DELETE tDokument.
  818. END.
  819. END PROCEDURE.
  820. /* _UIB-CODE-BLOCK-END */
  821. &ANALYZE-RESUME
  822. &ENDIF
  823. &IF DEFINED(EXCLUDE-DRUCKEN) = 0 &THEN
  824. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN Procedure
  825. PROCEDURE DRUCKEN :
  826. /*------------------------------------------------------------------------------
  827. Purpose:
  828. Parameters: <none>
  829. Notes:
  830. ------------------------------------------------------------------------------*/
  831. DEFINE VARIABLE xString AS CHARACTER NO-UNDO.
  832. DEFINE VARIABLE cLAdresse AS CHARACTER NO-UNDO.
  833. DEFINE VARIABLE RText AS CHARACTER NO-UNDO.
  834. DEFINE VARIABLE WText AS CHARACTER NO-UNDO.
  835. DEFINE VARIABLE ii AS INTEGER NO-UNDO.
  836. DEFINE VARIABLE i1 AS INTEGER NO-UNDO.
  837. DEFINE VARIABLE nRabWert AS DECIMAL NO-UNDO.
  838. DEFINE VARIABLE iMwstCd AS INTEGER NO-UNDO.
  839. DEFINE VARIABLE nZeiTot AS DECIMAL DECIMALS 4 NO-UNDO.
  840. FIND FIRST tParam.
  841. IF tParam.lCreatePDF THEN tParam.lDokDruck = FALSE.
  842. nFakBetr = 0.
  843. IF iSeite = 0 THEN RUN VIPER_INIT.
  844. RUN DRUCKEN_KOPF.
  845. iVPagePos = vpr_getPageVPos() + 20.
  846. RUN vpr_setPageVPos ( iVPagePos ).
  847. RUN vpr_setGroupVPos( 'FetteZeile', iVPagePos ).
  848. iArtZeile = 1.
  849. RUN VIPER_CREATE_DOKUMENT ( 'FetteZeile', iArtZeile, 'Bez_LSText', ' ' ).
  850. xString = TRIM(SUBSTRING(cFormText[17],01,20)) + ' / '
  851. + TRIM(SUBSTRING(cFormText[17],21,20)) + ' '
  852. + TRIM(STRING(bAufko.Aufnr,"zzzzzzzzz9")) + ' / '
  853. + TRIM(STRING(bAufko.Lief_Datum,"99.99.9999")).
  854. iArtZeile = 2.
  855. RUN VIPER_CREATE_DOKUMENT ( 'FetteZeile', iArtZeile, 'Bez_LSText', xString ).
  856. DO WHILE TRUE:
  857. lFirst = TRUE.
  858. cLAdresse = ''.
  859. IF bAufko.Knr = bAufko.Fak_Knr AND
  860. NOT FDebst.Passant THEN LEAVE.
  861. iArtZeile = iArtZeile + 1.
  862. RUN VIPER_CREATE_DOKUMENT ( 'FetteZeile', iArtZeile, 'Bez_LSText', ' ' ).
  863. DO ii = 1 TO 5:
  864. IF bAufko.Adresse[ii] = '' THEN NEXT.
  865. iArtZeile = iArtZeile + 1.
  866. RUN VIPER_CREATE_DOKUMENT ( 'FetteZeile', iArtZeile, 'Bez_LSText', bAufko.Adresse[ii] ).
  867. lFirst = FALSE.
  868. END.
  869. IF NOT lFirst THEN LEAVE.
  870. IF bAufko.Knr = bAufko.Fak_Knr THEN LEAVE.
  871. FIND LAdresse NO-LOCK
  872. WHERE LAdresse.Firma = AdFirma
  873. AND LAdresse.Knr = bAufko.Knr NO-ERROR.
  874. IF NOT AVAILABLE LAdresse THEN LEAVE.
  875. DO ii = 1 TO 12:
  876. IF LAdresse.Anschrift[ii] = '' THEN NEXT.
  877. iArtZeile = iArtZeile + 1.
  878. RUN VIPER_CREATE_DOKUMENT ( 'FetteZeile', iArtZeile, 'Bez_LSText', LAdresse.Anschrift[ii] ).
  879. lFirst = FALSE.
  880. END.
  881. LEAVE.
  882. END.
  883. IF NOT lFirst THEN
  884. DO:
  885. iArtZeile = iArtZeile + 1.
  886. RUN VIPER_CREATE_DOKUMENT ( 'FetteZeile', iArtZeile, 'Bez_LSText', ' ' ).
  887. END.
  888. RUN AUSGABE_GRUPPE ( 'FetteZeile' ).
  889. iArtZeile = 0.
  890. FOR EACH tAufze NO-LOCK
  891. BY tAufze.Aufnr
  892. BY tAufze.Sort1
  893. BY tAufze.LagOrt
  894. BY tAufze.Sort2
  895. BY tAufze.Pos :
  896. FIND Aufze NO-LOCK WHERE RECID(Aufze) = tAufze.Zeile.
  897. RUN ARTIKELZEILE ( RECID(tAufze) ).
  898. nFakBetr = nFakBetr + Aufze.Net_Betr.
  899. RELEASE Aufze.
  900. END.
  901. iArtZeile = iArtZeile + 1.
  902. RUN vpr_Asc2RTF(TRIM(SUBSTRING(cFormText[10],41,20)), 'bold', OUTPUT xString ).
  903. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1' , xString ).
  904. RUN vpr_Asc2RTF(TRIM(STRING(nFakBetr,'->>>,>>9.99')), 'bold', OUTPUT xString ).
  905. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', xString ).
  906. iArtZeile = iArtZeile + 1.
  907. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1' , ' ' ).
  908. RUN AUSGABE_ARTIKELZEILE.
  909. /* Auftragsrabatt ---------------------------------------------------- */
  910. iArtZeile = 0.
  911. FOR EACH tRabSumm
  912. WHERE tRabSumm.Auf_Rab <> 0
  913. BY tRabSumm.Rab_Summ:
  914. Rundbetr = tRabSumm.Auf_Rab.
  915. nFakBetr = nFakBetr - Rundbetr.
  916. IF Rundbetr < 0 THEN RText = cZusText.
  917. ELSE RText = cRabText.
  918. xString = RText
  919. + " "
  920. + tRabSumm.Bez.
  921. iArtZeile = iArtZeile + 1.
  922. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', xString ).
  923. FIND FIRST AufRabSu NO-LOCK USE-INDEX AufRabSu-k1
  924. WHERE AufRabSu.Firma = bAufko.Firma
  925. AND AufRabSu.Aufnr = bAufko.Aufnr
  926. AND AufRabSu.Rab_Summ = tRabSumm.Rab_Summ.
  927. nRabWert = ABSOLUT(AufRabSu.F_Wert).
  928. IF AufRabSu.F_Proz_Betr THEN WText = "%".
  929. ELSE WText = "Fr.".
  930. xString = STRING(nRabWert,"z9.99-")
  931. + WText.
  932. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'KGebinde', xString ).
  933. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', TRIM(STRING(- Rundbetr,'->>>,>>9.99')) ).
  934. END.
  935. /* Abholrabatt ------------------------------------------------------- */
  936. FOR EACH tRabSumm WHERE tRabSumm.Abh_Rab <> 0
  937. BY tRabSumm.Rab_Summ:
  938. Rundbetr = tRabSumm.Abh_Rab.
  939. nFakBetr = nFakBetr - Rundbetr.
  940. IF Rundbetr < 0 THEN RText = cZusText.
  941. ELSE RText = cRabText.
  942. xString = RText
  943. + " "
  944. + tRabSumm.Bez.
  945. iArtZeile = iArtZeile + 1.
  946. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', xString ).
  947. FIND FIRST AufRabSu NO-LOCK USE-INDEX AufRabSu-k1
  948. WHERE AufRabSu.Firma = bAufko.Firma
  949. AND AufRabSu.Aufnr = bAufko.Aufnr
  950. AND AufRabSu.Rab_Summ = tRabSumm.Rab_Summ.
  951. nRabWert = ABSOLUT(AufRabSu.A_Wert).
  952. IF AufRabSu.A_Proz_Betr THEN WText = "%".
  953. ELSE WText = "Fr.".
  954. xString = STRING(nRabWert,"z9.99-")
  955. + WText.
  956. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'KGebinde', xString ).
  957. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', TRIM(STRING(- Rundbetr,'->>>,>>9.99')) ).
  958. END.
  959. /* Spezialpreis-Auftragsrabatte ---------------------------------------- */
  960. FOR EACH TSpeRab WHERE TSpeRab.Auf_Betr <> 0
  961. BY TSpeRab.Rab_Grp:
  962. FIND Tabel USE-INDEX Tabel-k1
  963. WHERE Tabel.Firma = cFirma
  964. AND Tabel.RecArt = 'ARABGRP'
  965. AND Tabel.CodeC = ''
  966. AND Tabel.CodeI = TSpeRab.Rab_Grp
  967. AND Tabel.Sprcd = 1 NO-LOCK.
  968. Rundbetr = TSpeRab.Auf_Betr.
  969. nFakBetr = nFakBetr - Rundbetr.
  970. IF Rundbetr < 0 THEN RText = cZusText.
  971. ELSE RText = cRabText.
  972. xString = RText
  973. + " "
  974. + Tabel.Bez1.
  975. iArtZeile = iArtZeile + 1.
  976. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', xString ).
  977. FIND FIRST AufSpRab USE-INDEX AufSpRab-k1
  978. WHERE AufSpRab.Firma = bAufko.Firma
  979. AND AufSpRab.Aufnr = bAufko.Aufnr
  980. AND AufSpRab.Rab_Grp = TSpeRab.Rab_Grp NO-LOCK.
  981. nRabWert = ABSOLUT(AufSpRab.Auf_Wert).
  982. IF AufSpRab.Auf_Proz_Betr THEN WText = "%".
  983. ELSE WText = "Fr.".
  984. xString = STRING(nRabWert,"z9.99-")
  985. + WText.
  986. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'KGebinde', xString ).
  987. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', TRIM(STRING(- Rundbetr,'->>>,>>9.99')) ).
  988. END.
  989. IF iArtZeile > 0 THEN
  990. DO:
  991. iArtZeile = iArtZeile + 1.
  992. RUN vpr_Asc2RTF(TRIM(SUBSTRING(cFormText[14],21,20)), 'bold', OUTPUT xString ).
  993. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1' , xString ).
  994. RUN vpr_Asc2RTF(TRIM(STRING(nFakBetr,'->>>,>>9.99')), 'bold', OUTPUT xString ).
  995. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', xString ).
  996. iArtZeile = iArtZeile + 1.
  997. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1' , ' ' ).
  998. END.
  999. RUN AUSGABE_GRUPPE ('ArtikelZeile1').
  1000. /* Recycling-Gebuehren ----------------------------------------------- */
  1001. iArtZeile = 0.
  1002. FOR EACH AufGKon USE-INDEX AufGKon-k1
  1003. WHERE AufGKon.Firma = bAufko.Firma
  1004. AND AufGKon.Aufnr = bAufko.Aufnr
  1005. AND AufGKon.Gebuehr <> 0
  1006. AND AufGKon.Betrag <> 0 NO-LOCK:
  1007. FIND GebKonto OF AufGKon NO-LOCK NO-ERROR.
  1008. IF NOT AVAILABLE GebKonto THEN xString = TRIM(SUBSTRING(cFormText[11],41,20)).
  1009. ELSE xString = GebKonto.Bez.
  1010. iMwstCd = AufGKon.MWST_Cd.
  1011. nFakBetr = nFakBetr + AufGKon.Betrag.
  1012. FIND LAST MwstAns NO-LOCK
  1013. WHERE MwstAns.Mwst_Cd = iMwstCd
  1014. AND MwstAns.Datum <= bAufko.Fak_Datum NO-ERROR.
  1015. iArtZeile = iArtZeile + 1.
  1016. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', xString ).
  1017. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', TRIM(STRING(AufGKon.Betrag,'->>>,>>9.99')) ).
  1018. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'MC', STRING(AufGKon.MWSt_Cd,'z9') ).
  1019. FIND FIRST tUmsGrp
  1020. WHERE tUmsGrp.Ums_Grp = 1000
  1021. AND tUmsGrp.Mwst = iMwstCd
  1022. AND tUmsGrp.Ansatz = MwstAns.Ansatz NO-ERROR.
  1023. IF NOT AVAILABLE tUmsGrp THEN
  1024. DO:
  1025. FIND WarenGrp USE-INDEX WarenGrp-k1
  1026. WHERE WarenGrp.Firma = cFirma
  1027. AND WarenGrp.Wgr = 1000 NO-LOCK NO-ERROR.
  1028. CREATE tUmsGrp.
  1029. ASSIGN
  1030. tUmsGrp.Ums_Grp = 1000
  1031. tUmsGrp.Mwst = iMwstCd
  1032. tUmsGrp.Ansatz = MwstAns.Ansatz
  1033. tUmsGrp.lInkl = lDebIncl
  1034. tUmsGrp.Bez = (IF AVAILABLE WarenGrp THEN WarenGrp.Bez1 ELSE 'Recyclinggebühren').
  1035. END.
  1036. tUmsGrp.Ums_Betr = tUmsGrp.Ums_Betr + AufGKon.Betrag.
  1037. END.
  1038. IF iArtZeile > 0 THEN
  1039. DO:
  1040. iArtZeile = iArtZeile + 1.
  1041. RUN vpr_Asc2RTF(TRIM(SUBSTRING(cFormText[14],41,20)), 'bold', OUTPUT xString ).
  1042. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1' , xString ).
  1043. RUN vpr_Asc2RTF(TRIM(STRING(nFakBetr,'->>>,>>9.99')), 'bold', OUTPUT xString ).
  1044. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', xString ).
  1045. iArtZeile = iArtZeile + 1.
  1046. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1' , ' ' ).
  1047. END.
  1048. RELEASE AufGKon.
  1049. RUN AUSGABE_GRUPPE ('ArtikelZeile1').
  1050. /* Gebindelieferungen ------------------------------------------------ */
  1051. nZeiTot = 0.
  1052. iArtZeile = 0.
  1053. FOR EACH AufGKon USE-INDEX AufGKon-k1
  1054. WHERE AufGKon.Firma = bAufko.Firma
  1055. AND AufGKon.Aufnr = bAufko.Aufnr
  1056. AND AufGKon.Depot <> 0
  1057. AND (AufGKon.Eingang <> 0 OR
  1058. AufGKon.Ausgang <> 0) NO-LOCK:
  1059. iMwstCd = AufGKon.MWSt_Cd.
  1060. FIND LAST MwstAns NO-LOCK
  1061. WHERE MwstAns.Mwst_Cd = iMwstCd
  1062. AND MwstAns.Datum <= bAufko.Fak_Datum NO-ERROR.
  1063. FIND FIRST tUmsGrp
  1064. WHERE tUmsGrp.Ums_Grp = 1001
  1065. AND tUmsGrp.Mwst = iMwstCd
  1066. AND tUmsGrp.Ansatz = MwstAns.Ansatz NO-ERROR.
  1067. IF NOT AVAILABLE tUmsGrp THEN
  1068. DO:
  1069. FIND WarenGrp NO-LOCK USE-INDEX WarenGrp-k1
  1070. WHERE WarenGrp.Firma = cFirma
  1071. AND WarenGrp.Wgr = 1001 NO-ERROR.
  1072. CREATE tUmsGrp.
  1073. ASSIGN
  1074. tUmsGrp.Ums_Grp = 1001
  1075. tUmsGrp.Mwst = iMwstCd
  1076. tUmsGrp.Ansatz = MwstAns.Ansatz
  1077. tUmsGrp.lInkl = lDebIncl
  1078. tUmsGrp.Bez = (IF AVAILABLE WarenGrp THEN WarenGrp.Bez1 ELSE 'Gebindesaldo').
  1079. END.
  1080. tUmsGrp.Ums_Betr = tUmsGrp.Ums_Betr + AufGKon.Betrag.
  1081. FIND GebKonto NO-LOCK USE-INDEX GebKonto-k1
  1082. WHERE GebKonto.Firma = cFirma
  1083. AND GebKonto.Geb_Cd = AufGKon.Geb_Cd.
  1084. i1 = AufGKon.Ausgang - AufGKon.Eingang.
  1085. Rundbetr = AufGKon.Betrag.
  1086. nZeiTot = nZeiTot + Rundbetr.
  1087. iArtZeile = iArtZeile + 1.
  1088. RUN VIPER_CREATE_DOKUMENT ( 'Gebindeabrechnung', iArtZeile, 'Gebindetext' , GebKonto.Bez ).
  1089. RUN VIPER_CREATE_DOKUMENT ( 'Gebindeabrechnung', iArtZeile, 'GebindeGel' , TRIM(STRING(AufGKon.Ausgang,"->>,>>9")) ).
  1090. RUN VIPER_CREATE_DOKUMENT ( 'Gebindeabrechnung', iArtZeile, 'GebindeRet' , TRIM(STRING(AufGKon.Eingang,"->>,>>9")) ).
  1091. RUN VIPER_CREATE_DOKUMENT ( 'Gebindeabrechnung', iArtZeile, 'GebindeSaldo', TRIM(STRING(i1 ,"->>,>>9")) ).
  1092. RUN VIPER_CREATE_DOKUMENT ( 'Gebindeabrechnung', iArtZeile, 'GebindeBetr' , TRIM(STRING(Rundbetr ,"->>,>>9.99")) ).
  1093. END.
  1094. IF iArtZeile > 0 THEN RUN VIPER_CREATE_DOKUMENT ( 'Gebindeabrechnung', iArtZeile, 'GebindeTot' , TRIM(STRING(nZeiTot,"->>,>>9.99")) ).
  1095. nFakBetr = nFakBetr + nZeiTot.
  1096. IF iArtZeile > 0 THEN RUN AUSGABE_GRUPPE ('Gebindeabrechnung').
  1097. FIND FIRST tTotale.
  1098. DO ii = 1 TO 12:
  1099. tTotale.nMwstPfl[ii] = tTotale.nMwstPfl[ii] + bAufko.Wpfl[ii].
  1100. tTotale.nMwstBet[ii] = tTotale.nMwstBet[ii] + bAufko.Wust[ii].
  1101. END.
  1102. tTotale.nSammTot = tTotale.nSammTot + nFakBetr.
  1103. tTotale.nSkBer = tTotale.nSkBer + bAufko.Sk_Ber.
  1104. iArtZeile = 1.
  1105. RUN vpr_Asc2RTF(TRIM(SUBSTRING(cFormText[15],21,20)), 'bold', OUTPUT xString ).
  1106. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1' , xString ).
  1107. RUN vpr_Asc2RTF(TRIM(STRING(nFakBetr,"->>>,>>9.99")), 'bold', OUTPUT xString ).
  1108. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', xString ).
  1109. IF lLast THEN
  1110. DO:
  1111. iArtZeile = iArtZeile + 1.
  1112. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1' , ' ' ).
  1113. iArtZeile = iArtZeile + 1.
  1114. RUN vpr_Asc2RTF(TRIM(SUBSTRING(cFormText[14],01,20)), 'bold', OUTPUT xString ).
  1115. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1' , xString ).
  1116. RUN vpr_Asc2RTF(TRIM(STRING(tTotale.nSammTot,"->>>,>>9.99")), 'bold', OUTPUT xString ).
  1117. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', xString ).
  1118. END.
  1119. iArtZeile = iArtZeile + 1.
  1120. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1' , ' ' ).
  1121. RUN AUSGABE_GRUPPE ( 'ArtikelZeile1' ).
  1122. IF lLast THEN RUN DRUCKEN_ENDE.
  1123. END PROCEDURE.
  1124. /* _UIB-CODE-BLOCK-END */
  1125. &ANALYZE-RESUME
  1126. &ENDIF
  1127. &IF DEFINED(EXCLUDE-DRUCKEN_ADRESSE) = 0 &THEN
  1128. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN_ADRESSE Procedure
  1129. PROCEDURE DRUCKEN_ADRESSE :
  1130. /*------------------------------------------------------------------------------
  1131. Purpose:
  1132. Parameters: <none>
  1133. Notes:
  1134. ------------------------------------------------------------------------------*/
  1135. DEFINE VARIABLE cZellen AS CHARACTER NO-UNDO.
  1136. DEFINE VARIABLE cWerte AS CHARACTER NO-UNDO.
  1137. FIND FIRST tParam.
  1138. FIND FIRST tDokument
  1139. WHERE tDokument.cGruppe = 'KOPF'
  1140. AND tDokument.iZeile = 1
  1141. AND tDokument.cFeld = 'Seite' NO-ERROR.
  1142. IF NOT AVAILABLE tDokument THEN
  1143. DO:
  1144. CREATE tDokument.
  1145. ASSIGN
  1146. tDokument.cGruppe = 'KOPF'
  1147. tDokument.iZeile = 1
  1148. tDokument.cFeld = 'Seite'.
  1149. END.
  1150. tDokument.cInhalt = STRING(iSeite,'z9').
  1151. cZellen = ''.
  1152. cWerte = ''.
  1153. FOR EACH tDokument
  1154. WHERE tDokument.cGruppe = 'Kopf'
  1155. BREAK BY tDokument.cGruppe
  1156. BY tDokument.cFeld:
  1157. cWerte = cWerte
  1158. + tDokument.cInhalt.
  1159. cZellen = cZellen
  1160. + tDokument.cFeld.
  1161. IF NOT LAST-OF ( tDokument.cGruppe ) THEN ASSIGN cWerte = cWerte + CHR(01)
  1162. cZellen = cZellen + ','.
  1163. END.
  1164. RUN vpr_SetDelimiter (CHR(01)).
  1165. RUN vpr_setGroupText ('Kopf', cZellen, cWerte).
  1166. RUN vpr_FlushGroup ('Kopf').
  1167. RUN vpr_FlushGroup ('Ueberschrift').
  1168. iVPagePos = vpr_getPageVPos() + 20.
  1169. RUN vpr_setPageVPos ( iVPagePos ).
  1170. END PROCEDURE.
  1171. /* _UIB-CODE-BLOCK-END */
  1172. &ANALYZE-RESUME
  1173. &ENDIF
  1174. &IF DEFINED(EXCLUDE-DRUCKEN_BESR) = 0 &THEN
  1175. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN_BESR Procedure
  1176. PROCEDURE DRUCKEN_BESR :
  1177. /*------------------------------------------------------------------------------
  1178. Purpose:
  1179. Parameters: <none>
  1180. Notes:
  1181. ------------------------------------------------------------------------------*/
  1182. DEFINE INPUT PARAMETER ipDokument AS CHARACTER NO-UNDO.
  1183. DEFINE VARIABLE ix AS INTEGER NO-UNDO.
  1184. DEFINE VARIABLE i1 AS INTEGER NO-UNDO.
  1185. DEFINE VARIABLE cFeld AS CHARACTER NO-UNDO.
  1186. DEFINE VARIABLE cInhalt AS CHARACTER NO-UNDO.
  1187. DEFINE VARIABLE cVorlage AS CHARACTER NO-UNDO.
  1188. DEFINE VARIABLE iKopfZeile AS INTEGER NO-UNDO.
  1189. DEFINE VARIABLE PZBetrag AS CHARACTER NO-UNDO.
  1190. DEFINE VARIABLE PZReferenz AS CHARACTER NO-UNDO.
  1191. DEFINE VARIABLE PZTNNummer AS CHARACTER NO-UNDO.
  1192. DEFINE VARIABLE cReferenz AS CHARACTER NO-UNDO.
  1193. FIND FIRST tParam.
  1194. /* IF Rundbetr < 0 THEN RETURN. */
  1195. RUN vpr_NewPage.
  1196. cVorlage = tParam.cInstall + '/' + ipDokument + '.vfr'.
  1197. RUN vpr_LoadVFR (cVorlage).
  1198. RUN vpr_ActivateReport (ipDokument).
  1199. RUN vpr_setPrinterAttrib("duplex=1").
  1200. RUN vpr_SetDocAttrib ("PAPERSIZE=A4").
  1201. RUN vpr_SetPrinterAttrib("copies=1").
  1202. RUN vpr_InitGroups ("").
  1203. IF tParam.lCreatePDF THEN RUN vpr_initGraphObj.
  1204. IF tParam.Schacht_Besr > 0 THEN RUN vpr_SetCurrentPageProperties ( "Papertray", tParam.Schacht_Besr ).
  1205. RUN vpr_SetGroupAttrib ("ADRESSE", "Fixed=true").
  1206. RUN vpr_SetGroupAttrib ("BESR" , "Fixed=true").
  1207. FIND Adresse NO-LOCK USE-INDEX Adresse-k1
  1208. WHERE Adresse.Firma = AdFirma
  1209. AND Adresse.Knr = bAufko.Fak_Knr NO-ERROR.
  1210. iKopfZeile = 1.
  1211. cBesrKopf = ''.
  1212. IF bAufko.Adresse[05] <> '' THEN
  1213. DO:
  1214. i1 = 6.
  1215. DO ix = 1 TO 5:
  1216. /* CREATE tDokument. */
  1217. /* ASSIGN tDokument.cGruppe = 'ADRESSE' */
  1218. /* tDokument.iZeile = 1 */
  1219. /* tDokument.cFeld = 'Adresse_' + STRING((6 + ix),'99') */
  1220. /* tDokument.cInhalt = bAufko.Adresse[ix]. */
  1221. i1 = i1 + 1.
  1222. cBesrKopf[i1] = bAufko.Adresse[ix].
  1223. END.
  1224. END.
  1225. ELSE
  1226. DO:
  1227. DO ix = 6 TO 11:
  1228. /* CREATE tDokument. */
  1229. /* ASSIGN tDokument.cGruppe = 'ADRESSE' */
  1230. /* tDokument.iZeile = 1 */
  1231. /* tDokument.cFeld = 'Adresse_' + STRING(ix,'99') */
  1232. /* tDokument.cInhalt = Adresse.Anschrift[ix]. */
  1233. cBesrKopf[ix] = Adresse.Anschrift[ix].
  1234. END.
  1235. END.
  1236. DO ix = 6 TO 11:
  1237. CREATE tDokument.
  1238. ASSIGN
  1239. tDokument.cGruppe = 'BESR'
  1240. tDokument.iZeile = 1
  1241. tDokument.cFeld = 'Adresse_R_' + STRING(ix,'99')
  1242. tDokument.cInhalt = cBesrKopf[ix].
  1243. IF ix < 7 THEN NEXT.
  1244. CREATE tDokument.
  1245. ASSIGN
  1246. tDokument.cGruppe = 'BESR'
  1247. tDokument.iZeile = 1
  1248. tDokument.cFeld = 'Adresse_L_' + STRING(ix,'99')
  1249. tDokument.cInhalt = cBesrKopf[ix].
  1250. END.
  1251. IF Rundbetr > 0.00 THEN
  1252. DO:
  1253. cFeld = STRING(Rundbetr,'zzzzzz9.99').
  1254. cFeld = REPLACE(cFeld, '.', ' ').
  1255. cFeld = STRING(cFeld,'X X X X X X X X X X').
  1256. END.
  1257. ELSE cFeld = ''.
  1258. RUN VIPER_CREATE_DOKUMENT ( 'BESR', iKopfZeile, 'Betrag_L', cFeld ).
  1259. RUN VIPER_CREATE_DOKUMENT ( 'BESR', iKopfZeile, 'Betrag_R', cFeld ).
  1260. IF Rundbetr > 0 THEN PZBetrag = '01' + STRING(Rundbetr * 100,'9999999999 ').
  1261. ELSE PZBetrag = ' 04 '.
  1262. PZReferenz = '00000000000'
  1263. + STRING(bAufko.Fak_Knr,'999999')
  1264. + STRING(bAufko.Faknr ,'9999999')
  1265. + '00'.
  1266. PZTNNummer = '01036226'.
  1267. RUN PRUEFZIFFER ( INPUT-OUTPUT PZBetrag, INPUT-OUTPUT PZReferenz, INPUT-OUTPUT PZTNNummer, OUTPUT cReferenz ).
  1268. RUN VIPER_CREATE_DOKUMENT ( 'BESR', iKopfZeile, 'Referenz_OCRB', cReferenz ).
  1269. RUN VIPER_CREATE_DOKUMENT ( 'BESR', iKopfZeile, 'Referenz_R', STRING(PZReferenz,'XX XXXXX XXXXX XXXXX XXXXX XXXXX') ).
  1270. RUN VIPER_CREATE_DOKUMENT ( 'BESR', iKopfZeile, 'Referenz_L', STRING(PZReferenz,'XX XXXXX XXXXX XXXXX XXXXX XXXXX') ).
  1271. RUN AUSGABE_GRUPPE ( 'ADRESSE' ).
  1272. RUN AUSGABE_GRUPPE ( 'BESR' ).
  1273. END PROCEDURE.
  1274. /* _UIB-CODE-BLOCK-END */
  1275. &ANALYZE-RESUME
  1276. &ENDIF
  1277. &IF DEFINED(EXCLUDE-DRUCKEN_ENDE) = 0 &THEN
  1278. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN_ENDE Procedure
  1279. PROCEDURE DRUCKEN_ENDE :
  1280. /*------------------------------------------------------------------------------
  1281. Purpose:
  1282. Parameters: <none>
  1283. Notes:
  1284. ------------------------------------------------------------------------------*/
  1285. DEFINE VARIABLE cPDFName AS CHARACTER INIT '' NO-UNDO.
  1286. DEFINE VARIABLE iSpace AS INTEGER INIT 0 NO-UNDO.
  1287. DEFINE VARIABLE iPos AS INTEGER NO-UNDO.
  1288. DEFINE VARIABLE iKopie AS INTEGER NO-UNDO.
  1289. DEFINE VARIABLE ix AS INTEGER NO-UNDO.
  1290. DEFINE VARIABLE lJa AS LOG NO-UNDO.
  1291. DEFINE VARIABLE nNetto AS DECIMAL NO-UNDO.
  1292. DEFINE VARIABLE nMwst AS DECIMAL NO-UNDO.
  1293. DEFINE VARIABLE nBrutto AS DECIMAL NO-UNDO.
  1294. DEFINE VARIABLE nTNetto AS DECIMAL NO-UNDO.
  1295. DEFINE VARIABLE nTMwst AS DECIMAL NO-UNDO.
  1296. DEFINE VARIABLE nTBrutto AS DECIMAL NO-UNDO.
  1297. DEFINE VARIABLE cText AS CHARACTER NO-UNDO.
  1298. FIND FIRST tParam.
  1299. FIND FIRST tTotale.
  1300. iPos = vpr_getPageVPos().
  1301. iArtZeile = 1.
  1302. iSpace = iSpace + 40.
  1303. iMaxPos = 2650.
  1304. RUN VIPER_CREATE_DOKUMENT ( 'Mehrwertsteuer', iArtZeile, 'MwstBez' , ' ' ).
  1305. FIND FIRST tTotale.
  1306. DO ix = 1 TO 11:
  1307. IF tTotale.nMwstPfl[ix] = 0 THEN NEXT.
  1308. tTotale.nSammTot = tTotale.nSammTot + tTotale.nMwstBet[ix].
  1309. FIND LAST MWSTAns USE-INDEX MWSTAns-k1
  1310. WHERE MWSTAns.MWST_Cd = ix
  1311. AND MWSTAns.Datum <= bAufko.Kond_Datum NO-LOCK.
  1312. iArtZeile = iArtZeile + 1.
  1313. iSpace = iSpace + 40.
  1314. RUN VIPER_CREATE_DOKUMENT ( 'Mehrwertsteuer', iArtZeile, 'MwstBez' , MWStAns.Bez ).
  1315. RUN VIPER_CREATE_DOKUMENT ( 'Mehrwertsteuer', iArtZeile, 'MwstPfl' , TRIM(STRING(tTotale.nMwstPfl[ix],"->>,>>9.99")) ).
  1316. RUN VIPER_CREATE_DOKUMENT ( 'Mehrwertsteuer', iArtZeile, 'MwstBetr', TRIM(STRING(tTotale.nMwstBet[ix],"->>>,>>9.99")) ).
  1317. RUN VIPER_CREATE_DOKUMENT ( 'Mehrwertsteuer', iArtZeile, 'MwstCd' , TRIM(STRING(ix ,">>9")) ).
  1318. END.
  1319. IF (iSpace + iPos + 80) >= iMaxPos THEN
  1320. DO:
  1321. RUN vpr_SetPageVPos ( iMaxPos ).
  1322. RUN VIPER_NEUE_SEITE.
  1323. RUN DRUCKEN_ADRESSE.
  1324. END.
  1325. RUN AUSGABE_GRUPPE ( 'Mehrwertsteuer' ).
  1326. Rundbetr = tTotale.nSammTot.
  1327. Rundcode = 1.
  1328. RUN RUNDEN ( Rundcode, INPUT-OUTPUT Rundbetr ).
  1329. tTotale.nSammTot = Rundbetr.
  1330. iArtZeile = 1.
  1331. RUN VIPER_CREATE_DOKUMENT ( 'RechnungsTotal', iArtZeile, 'EndBetrag' , TRIM(STRING(tTotale.nSammTot,"->,>>>,>>9.99")) ).
  1332. iArtZeile = 2.
  1333. RUN VIPER_CREATE_DOKUMENT ( 'RechnungsTotal', iArtZeile, 'EndBetrag' , '' ).
  1334. RUN AUSGABE_GRUPPE ( 'RechnungsTotal' ).
  1335. /* ------ Umsatzverteilung ------------------------------------------------ */
  1336. iArtZeile = 1.
  1337. RUN vpr_Asc2RTF(TRIM(SUBSTRING(cFormText[15],41,20)), 'bold', OUTPUT cText).
  1338. RUN VIPER_CREATE_DOKUMENT ( 'Umsatzverteilung', iArtZeile, 'Umsatzgruppe' , cText ).
  1339. ASSIGN
  1340. nTNetto = 0
  1341. nTMwst = 0
  1342. nTBrutto = 0.
  1343. FOR EACH TUmsGrp NO-LOCK
  1344. BY TUmsGrp.Ums_Grp
  1345. BY TUmsGrp.Mwst :
  1346. IF tUmsGrp.lInkl THEN
  1347. DO:
  1348. nNetto = tUmsGrp.Ums_Betr * 100 / (100 + tUmsGrp.Ansatz).
  1349. nBrutto = tUmsGrp.Ums_Betr.
  1350. nMwst = nBrutto - nNetto.
  1351. END.
  1352. ELSE
  1353. DO:
  1354. nNetto = tUmsGrp.Ums_Betr.
  1355. nBrutto = tUmsGrp.Ums_Betr * (100 + tUmsGrp.Ansatz) / 100.
  1356. nMwst = nBrutto - nNetto.
  1357. END.
  1358. ASSIGN
  1359. nTNetto = nTNetto + nNetto
  1360. nTMwst = nTMwst + nMwst
  1361. nTBrutto = nTBrutto + nBrutto.
  1362. iArtZeile = iArtZeile + 1.
  1363. RUN VIPER_CREATE_DOKUMENT ( 'Umsatzverteilung', iArtZeile, 'Umsatzgruppe' , TUmsGrp.Bez ).
  1364. RUN VIPER_CREATE_DOKUMENT ( 'Umsatzverteilung', iArtZeile, 'Frw' , BSteuer.Fwc03 ).
  1365. RUN VIPER_CREATE_DOKUMENT ( 'Umsatzverteilung', iArtZeile, 'Netto' , TRIM(STRING(nNetto ,"->>>,>>9.99")) ).
  1366. RUN VIPER_CREATE_DOKUMENT ( 'Umsatzverteilung', iArtZeile, 'Ansatz' , TRIM(STRING(TUmsGrp.Ansatz,">9.99%")) ).
  1367. RUN VIPER_CREATE_DOKUMENT ( 'Umsatzverteilung', iArtZeile, 'Mwst' , TRIM(STRING(nMwst ,"->>>,>>9.99")) ).
  1368. RUN VIPER_CREATE_DOKUMENT ( 'Umsatzverteilung', iArtZeile, 'Brutto' , TRIM(STRING(nBrutto ,"->>>,>>9.99")) ).
  1369. RUN VIPER_CREATE_DOKUMENT ( 'Umsatzverteilung', iArtZeile, 'MC' , TRIM(STRING(tUmsGrp.Mwst ,"z9")) ).
  1370. END.
  1371. iArtZeile = iArtZeile + 1.
  1372. RUN vpr_Asc2RTF('Total', 'bold', OUTPUT cText).
  1373. RUN VIPER_CREATE_DOKUMENT ( 'Umsatzverteilung', iArtZeile, 'Umsatzgruppe' , cText ).
  1374. RUN VIPER_CREATE_DOKUMENT ( 'Umsatzverteilung', iArtZeile, 'Netto' , TRIM(STRING(nTNetto ,"->>>,>>9.99")) ).
  1375. RUN VIPER_CREATE_DOKUMENT ( 'Umsatzverteilung', iArtZeile, 'Mwst' , TRIM(STRING(nTMwst ,"->>>,>>9.99")) ).
  1376. RUN VIPER_CREATE_DOKUMENT ( 'Umsatzverteilung', iArtZeile, 'Brutto' , TRIM(STRING(nTBrutto,"->>>,>>9.99")) ).
  1377. ix = DYNAMIC-FUNCTION('calcBlock':U, 'Umsatzverteilung' )
  1378. + 30
  1379. + vpr_getPageVPos().
  1380. IF ix >= iMaxPos THEN
  1381. DO:
  1382. RUN vpr_setPageVPos ( iMaxPos ).
  1383. RUN VIPER_NEUE_SEITE.
  1384. RUN DRUCKEN_ADRESSE.
  1385. END.
  1386. RUN AUSGABE_GRUPPE ( 'Umsatzverteilung' ).
  1387. /* Zahlungskondition ------------------------------------------------- */
  1388. FIND Kondi NO-LOCK USE-INDEX Kondi-k1
  1389. WHERE Kondi.Kond = bAufko.Kond
  1390. AND Kondi.Sprcd = iSprcd NO-ERROR.
  1391. IF AVAILABLE Kondi THEN
  1392. DO:
  1393. iArtZeile = 1.
  1394. RUN VIPER_CREATE_DOKUMENT ( 'Kondition', iArtZeile, 'Zahkond', Kondi.KoText ).
  1395. RUN VIPER_CREATE_DOKUMENT ( 'Kondition', iArtZeile, 'Faellig', STRING((dFakDatum + Kondi.Faellig),"99.99.9999") ).
  1396. IF Kondi.Skonto[01] <> 0 THEN
  1397. DO:
  1398. Rundbetr = tTotale.nSkBer * Kondi.Skonto[01] / 100.
  1399. Rundcode = 1.
  1400. RUN RUNDEN ( Rundcode, INPUT-OUTPUT Rundbetr ).
  1401. RUN VIPER_CREATE_DOKUMENT ( 'Kondition', iArtZeile, 'Skonto', TRIM(STRING(Rundbetr,"->>>,>>9.99")) ).
  1402. END.
  1403. END.
  1404. ELSE
  1405. DO:
  1406. iArtZeile = 1.
  1407. RUN VIPER_CREATE_DOKUMENT ( 'Kondition', iArtZeile, 'Zahkond', FILL('?', 29) ).
  1408. END.
  1409. RUN VIPER_CREATE_DOKUMENT ( 'Kondition', iArtZeile, 'Netto', TRIM(STRING(tTotale.nSammTot,"->>>,>>9.99")) ).
  1410. RUN AUSGABE_GRUPPE ( 'Kondition' ).
  1411. nFakBetr = tTotale.nSammTot.
  1412. IF nFakBetr = 0 THEN Rundbetr = -1.
  1413. ELSE Rundbetr = nFakBetr.
  1414. IF AVAILABLE Kondi AND
  1415. Kondi.Skonto[01] <> 0 THEN Rundbetr = 0.
  1416. /* Abschluss und Druck ----------------------------------------------- */
  1417. IF iLauf < iAnzDok THEN
  1418. DO:
  1419. RUN vpr_EndDoc.
  1420. IF tParam.lDokDruck THEN RUN vpr_printDoc (0, 0).
  1421. RETURN.
  1422. END.
  1423. IF nFakBetr > 0 THEN RUN DRUCKEN_QRCODE.
  1424. /* ------------------------------------------------------ */
  1425. /* Druckausgabe */
  1426. /* ------------------------------------------------------ */
  1427. RUN vpr_EndDoc.
  1428. cvpr_Dokument = SUBSTITUTE('&1-&2_&3.vpr',
  1429. STRING(bAufko.Knr ,'999999'),
  1430. STRING(bAufko.Faknr,'9999999'),
  1431. tParam.cDokument).
  1432. cvpr_Dokument = SUBSTITUTE(cERPDokumente, cInstallation, 'Rechnungen', cvpr_Dokument).
  1433. RUN vpr_SaveDoc ( cvpr_Dokument ).
  1434. DO WHILE tParam.lDokDruck:
  1435. SESSION:PRINTER-NAME = tParam.Drucker NO-ERROR.
  1436. IF SESSION:PRINTER-NAME <> tParam.Drucker THEN
  1437. DO:
  1438. RUN vpr_printerDialog ( OUTPUT lJa ).
  1439. IF NOT lJa THEN LEAVE.
  1440. END.
  1441. RUN vpr_printDoc (0, 0).
  1442. LEAVE.
  1443. END.
  1444. IF tParam.lCreatePDF THEN
  1445. DO:
  1446. cPDFName = REPLACE(cvpr_Dokument, '.vpr', '.pdf').
  1447. RUN vpr_printPDF (0, 0, INPUT-OUTPUT cPDFName ).
  1448. END.
  1449. IF tParam.lOpenPDF THEN
  1450. DO:
  1451. DEFINE VARIABLE o-i AS i NO-UNDO.
  1452. FILE-INFO:FILE-NAME = cPDFName.
  1453. cPDFName = FILE-INFO:FULL-PATHNAME.
  1454. RUN shellExecuteA (0,
  1455. "open",
  1456. cPDFName,
  1457. "",
  1458. "",
  1459. 0,
  1460. OUTPUT o-i).
  1461. END.
  1462. END PROCEDURE.
  1463. /* _UIB-CODE-BLOCK-END */
  1464. &ANALYZE-RESUME
  1465. &ENDIF
  1466. &IF DEFINED(EXCLUDE-DRUCKEN_KOPF) = 0 &THEN
  1467. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN_KOPF Procedure
  1468. PROCEDURE DRUCKEN_KOPF :
  1469. /*------------------------------------------------------------------------------
  1470. Purpose:
  1471. Parameters: <none>
  1472. Notes:
  1473. ------------------------------------------------------------------------------*/
  1474. DEFINE VARIABLE cString AS CHARACTER NO-UNDO.
  1475. DEFINE VARIABLE ii AS INTEGER NO-UNDO.
  1476. DEFINE VARIABLE i1 AS INTEGER NO-UNDO.
  1477. DEFINE VARIABLE iOldSeite AS INTEGER NO-UNDO.
  1478. FIND FIRST tParam.
  1479. iOldSeite = iSeite.
  1480. RUN VIPER_NEUE_SEITE.
  1481. IF iSeite = 1 THEN
  1482. DO:
  1483. FIND bSteuer NO-LOCK WHERE bSteuer.Firma = cFirma.
  1484. cBesrKopf = ''.
  1485. IF bAufko.Adresse[05] <> '' THEN
  1486. DO:
  1487. i1 = 6.
  1488. DO ii = 1 TO 5:
  1489. CREATE tDokument.
  1490. ASSIGN
  1491. tDokument.cGruppe = 'KOPF'
  1492. tDokument.iZeile = 1
  1493. tDokument.cFeld = 'Adresse_' + STRING((6 + ii),'99')
  1494. tDokument.cInhalt = bAufko.Adresse[ii].
  1495. i1 = i1 + 1.
  1496. cBesrKopf[i1] = bAufko.Adresse[ii].
  1497. END.
  1498. END.
  1499. ELSE
  1500. DO:
  1501. DO ii = 5 TO 11:
  1502. CREATE tDokument.
  1503. ASSIGN
  1504. tDokument.cGruppe = 'KOPF'
  1505. tDokument.iZeile = 1
  1506. tDokument.cFeld = 'Adresse_' + STRING(ii,'99')
  1507. tDokument.cInhalt = bAdresse.Anschrift[ii].
  1508. cBesrKopf[ii] = bAdresse.Anschrift[ii].
  1509. END.
  1510. END.
  1511. CREATE tDokument.
  1512. ASSIGN
  1513. tDokument.cGruppe = 'KOPF'
  1514. tDokument.iZeile = 1
  1515. tDokument.cFeld = 'Ort_Datum'
  1516. tDokument.cInhalt = TRIM(SUBSTRING(cFormText[07],01,20))
  1517. + " "
  1518. + STRING(dFakDatum,"99.99.9999").
  1519. cString = (IF bAufko.Auf_Tot >= 0
  1520. THEN TRIM(SUBSTRING(cFormText[02],01,20))
  1521. ELSE TRIM(SUBSTRING(cFormText[02],21,20))).
  1522. cString = cString
  1523. + ' '
  1524. + TRIM(STRING(bAufko.Faknr,'>>>>>>9')).
  1525. CREATE tDokument.
  1526. ASSIGN
  1527. tDokument.cGruppe = 'KOPF'
  1528. tDokument.iZeile = 1
  1529. tDokument.cFeld = 'T_Dokument'
  1530. tDokument.cInhalt = cString.
  1531. CREATE tDokument.
  1532. ASSIGN
  1533. tDokument.cGruppe = 'KOPF'
  1534. tDokument.iZeile = 1
  1535. tDokument.cFeld = 'Knr'
  1536. tDokument.cInhalt = STRING(bAufko.Fak_Knr,'999999').
  1537. END.
  1538. IF iSeite > iOldSeite THEN RUN DRUCKEN_ADRESSE.
  1539. END PROCEDURE.
  1540. /* _UIB-CODE-BLOCK-END */
  1541. &ANALYZE-RESUME
  1542. &ENDIF
  1543. &IF DEFINED(EXCLUDE-FUELLEN_tAufze) = 0 &THEN
  1544. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE FUELLEN_tAufze Procedure
  1545. PROCEDURE FUELLEN_tAufze :
  1546. /*------------------------------------------------------------------------------
  1547. Purpose:
  1548. Parameters: <none>
  1549. Notes:
  1550. ------------------------------------------------------------------------------*/
  1551. DEFINE INPUT PARAMETER ipAufnr AS INTEGER NO-UNDO.
  1552. DEFINE VARIABLE minPos AS INTEGER NO-UNDO.
  1553. DEFINE VARIABLE maxPos AS INTEGER NO-UNDO.
  1554. DEFINE VARIABLE jPlatz AS INTEGER NO-UNDO.
  1555. DEFINE VARIABLE cLagOrt AS CHARACTER NO-UNDO.
  1556. DEFINE VARIABLE iRuestArt AS INTEGER NO-UNDO.
  1557. DEFINE VARIABLE iPlusMinus AS INTEGER NO-UNDO.
  1558. DEFINE VARIABLE lArtikel AS LOG NO-UNDO.
  1559. DEFINE VARIABLE cSort AS CHARACTER NO-UNDO.
  1560. EMPTY TEMP-TABLE tAufze.
  1561. FIND Steuer NO-LOCK
  1562. WHERE Steuer.Firma = cFirma NO-ERROR.
  1563. IF AVAILABLE Steuer THEN iRuestArt = Steuer.RuestArt.
  1564. ASSIGN
  1565. minPos = 0
  1566. maxPos = 9999
  1567. iPlusMinus = 0.
  1568. /* Kommentar zu Beginn eines Auftrages */
  1569. lArtikel = FALSE.
  1570. FOR EACH Aufze NO-LOCK
  1571. WHERE Aufze.Firma = cFirma
  1572. AND Aufze.Aufnr = ipAufnr
  1573. AND Aufze.Pos > minPos:
  1574. IF Aufze.Artnr > 0 THEN
  1575. DO:
  1576. lArtikel = TRUE.
  1577. LEAVE.
  1578. END.
  1579. minPos = Aufze.Pos.
  1580. CREATE tAufze.
  1581. ASSIGN
  1582. tAufze.Aufnr = Aufze.Aufnr
  1583. tAufze.Artnr = Aufze.Artnr
  1584. tAufze.Inhalt = Aufze.Inhalt
  1585. tAufze.Jahr = Aufze.Jahr
  1586. tAufze.Pos = Aufze.Pos
  1587. tAufze.Zeile = RECID(Aufze)
  1588. tAufze.Aktion = Aufze.Aktion
  1589. tAufze.Preis = Aufze.Preis
  1590. tAufze.MGeli = Aufze.MGeli
  1591. tAufze.MRuek = Aufze.MRuek.
  1592. ASSIGN
  1593. tAufze.Sort1 = ''
  1594. tAufze.Sort2 = STRING(tAufze.Artnr ,'999999')
  1595. + STRING(tAufze.Inhalt,'9999')
  1596. + STRING(tAufze.Jahr ,'9999')
  1597. + STRING(iPlusMinus ,'9')
  1598. + STRING(tAufze.Pos ,'99999')
  1599. tAufze.LagOrt = ''.
  1600. END.
  1601. /* Kommentar am Ende eines Auftrages */
  1602. IF lArtikel THEN
  1603. DO:
  1604. FOR EACH Aufze NO-LOCK
  1605. WHERE Aufze.Firma = cFirma
  1606. AND Aufze.Aufnr = ipAufnr
  1607. BY Aufze.Pos DESCENDING:
  1608. IF Aufze.Artnr > 0 THEN LEAVE.
  1609. maxPos = Aufze.Pos.
  1610. CREATE tAufze.
  1611. ASSIGN
  1612. tAufze.Aufnr = Aufze.Aufnr
  1613. tAufze.Artnr = Aufze.Artnr
  1614. tAufze.Inhalt = Aufze.Inhalt
  1615. tAufze.Jahr = Aufze.Jahr
  1616. tAufze.Pos = Aufze.Pos
  1617. tAufze.Zeile = RECID(Aufze)
  1618. tAufze.Aktion = Aufze.Aktion
  1619. tAufze.Preis = Aufze.Preis
  1620. tAufze.MGeli = Aufze.MGeli
  1621. tAufze.MRuek = Aufze.MRuek.
  1622. ASSIGN
  1623. tAufze.Sort1 = 'ZZZ'
  1624. tAufze.Sort2 = STRING(tAufze.Artnr ,'999999')
  1625. + STRING(tAufze.Inhalt,'9999')
  1626. + STRING(tAufze.Jahr ,'9999')
  1627. + STRING(iPlusMinus ,'9')
  1628. + STRING(tAufze.Pos ,'99999')
  1629. tAufze.LagOrt = ''.
  1630. END.
  1631. END.
  1632. /* Artikelzeilen nach WarenGruppe/ProdGruppen/Artikelgruppen */
  1633. cLagOrt = ''.
  1634. cSort = ''.
  1635. FOR EACH Aufze NO-LOCK
  1636. WHERE Aufze.Firma = cFirma
  1637. AND Aufze.Aufnr = ipAufnr
  1638. AND Aufze.Pos > minPos
  1639. AND Aufze.Pos < MaxPos
  1640. BY Aufze.Pos DESCENDING:
  1641. IF Aufze.Artnr > 0 THEN
  1642. DO:
  1643. FIND Artst NO-LOCK
  1644. WHERE Artst.Firma = Aufze.Firma
  1645. AND Artst.Artnr = Aufze.Artnr
  1646. AND Artst.Inhalt = Aufze.Inhalt
  1647. AND Artst.Jahr = Aufze.Jahr NO-ERROR.
  1648. FIND ArtLager NO-LOCK
  1649. WHERE ArtLager.Firma = Aufze.Firma
  1650. AND ArtLager.Artnr = Aufze.Artnr
  1651. AND ArtLager.Inhalt = Aufze.Inhalt
  1652. AND ArtLager.Jahr = Aufze.Jahr
  1653. AND ArtLager.Lager = Aufze.Lager NO-ERROR.
  1654. IF AVAILABLE ArtLager THEN cLagOrt = ArtLager.Ort.
  1655. ASSIGN
  1656. iWgr = Artst.Wg_Grp
  1657. iPgr = Artst.Prod_Grp
  1658. iAgr = Artst.Art_Grp
  1659. iArtnr = Artst.Artnr
  1660. iInhalt = Artst.Inhalt
  1661. iJahr = Artst.Jahr.
  1662. END.
  1663. cSort = STRING(iWgr,'9999')
  1664. + STRING(iPgr,'9999')
  1665. + STRING(iAgr,'9999').
  1666. iPlusMinus = (IF Aufze.MGeli < 0 THEN 1 ELSE 0).
  1667. CREATE tAufze.
  1668. ASSIGN
  1669. tAufze.Aufnr = Aufze.Aufnr
  1670. tAufze.Artnr = Aufze.Artnr
  1671. tAufze.Inhalt = Aufze.Inhalt
  1672. tAufze.Jahr = Aufze.Jahr
  1673. tAufze.Pos = Aufze.Pos
  1674. tAufze.Zeile = RECID(Aufze)
  1675. tAufze.Aktion = Aufze.Aktion
  1676. tAufze.Preis = Aufze.Preis
  1677. tAufze.MGeli = Aufze.MGeli
  1678. tAufze.MRuek = Aufze.MRuek.
  1679. ASSIGN
  1680. tAufze.Sort1 = cSort
  1681. tAufze.Sort2 = STRING(iArtnr ,'999999')
  1682. + STRING(iInhalt ,'9999')
  1683. + STRING(iJahr ,'9999')
  1684. + STRING(iPlusMinus,'9')
  1685. + STRING(tAufze.Pos,'99999')
  1686. tAufze.LagOrt = cLagort.
  1687. END.
  1688. END PROCEDURE.
  1689. /* _UIB-CODE-BLOCK-END */
  1690. &ANALYZE-RESUME
  1691. &ENDIF
  1692. &IF DEFINED(EXCLUDE-PRUEFZIFFER) = 0 &THEN
  1693. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE PRUEFZIFFER Procedure
  1694. PROCEDURE PRUEFZIFFER :
  1695. /*------------------------------------------------------------------------------
  1696. Purpose:
  1697. Parameters: <none>
  1698. Notes:
  1699. ------------------------------------------------------------------------------*/
  1700. /* ------------------------------------------------------------------------- */
  1701. /* Prufziffer MODULO 10, Rekursiv (27 Stellig Ref.-Nr.) */
  1702. /* ------------------------------------------------------------------------- */
  1703. /* */
  1704. /* Uebergabe Variable: 1. String Betrag (12-stellig) */
  1705. /* 2. String Referenz (27-stellig) */
  1706. /* 3. String Teilnehmernummer ( 9-stellig) */
  1707. /* */
  1708. /* Erstellung der VESR-Codierzeile */
  1709. /* */
  1710. /*---------------------------------------------------------------------------*/
  1711. DEFINE INPUT-OUTPUT PARAMETER PZBetrag AS CHARACTER FORMAT "x(13)".
  1712. DEFINE INPUT-OUTPUT PARAMETER PZReferenz AS CHARACTER FORMAT "x(27)".
  1713. DEFINE INPUT-OUTPUT PARAMETER PZTNummer AS CHARACTER FORMAT "x(09)".
  1714. DEFINE OUTPUT PARAMETER VSZeile AS CHARACTER FORMAT "x(58)".
  1715. DEFINE VARIABLE l1 AS INTEGER.
  1716. DEFINE VARIABLE l2 AS INTEGER.
  1717. DEFINE VARIABLE l3 AS INTEGER.
  1718. DEFINE VARIABLE PZ AS INTEGER.
  1719. DEFINE VARIABLE x1 AS INTEGER.
  1720. DEFINE VARIABLE x2 AS INTEGER.
  1721. DEFINE VARIABLE x3 AS INTEGER.
  1722. DEFINE VARIABLE VMOD10 AS CHARACTER FORMAT "x(11)" EXTENT 11.
  1723. VMOD10[01] = "09468271350".
  1724. VMOD10[02] = "94682713509".
  1725. VMOD10[03] = "46827135098".
  1726. VMOD10[04] = "68271350947".
  1727. VMOD10[05] = "82713509466".
  1728. VMOD10[06] = "27135094685".
  1729. VMOD10[07] = "71350946824".
  1730. VMOD10[08] = "13509468273".
  1731. VMOD10[09] = "35094682712".
  1732. VMOD10[10] = "50946827131".
  1733. l1 = 12.
  1734. l2 = 26.
  1735. l3 = 08.
  1736. DO WHILE SUBSTRING(PZBetrag,01,01) <> " ": /* Mit Betrag */
  1737. x2 = 1.
  1738. x1 = INT(SUBSTRING(PZBetrag ,01 ,01)).
  1739. x2 = INT(SUBSTRING(VMOD10[x2],x1 + 1,01)).
  1740. DO x3 = 2 TO 12:
  1741. x1 = INT(SUBSTRING(PZBetrag ,x3 ,01)).
  1742. x2 = INT(SUBSTRING(VMOD10[x2 + 1],x1 + 1,01)).
  1743. END.
  1744. PZ = INT(SUBSTRING(VMOD10[x2 + 1],11,1)).
  1745. SUBSTRING(PZBetrag,13) = STRING(PZ,"9").
  1746. LEAVE.
  1747. END.
  1748. DO WHILE SUBSTRING(PZBetrag,01,01) = " ": /* Ohne Betrag */
  1749. x2 = 11.
  1750. x1 = INT(SUBSTRING(PZBetrag ,01 ,01)).
  1751. x2 = INT(SUBSTRING(VMOD10[x2],x1 + 1,01)).
  1752. DO x3 = 12 TO 12:
  1753. x1 = INT(SUBSTRING(PZBetrag ,x3 ,01)).
  1754. x2 = INT(SUBSTRING(VMOD10[x2 + 1],x1 + 1,01)).
  1755. END.
  1756. PZ = INT(SUBSTRING(VMOD10[x2 + 1],11,1)).
  1757. SUBSTRING(PZBetrag,13) = STRING(PZ,"9").
  1758. LEAVE.
  1759. END.
  1760. DO WHILE l2 = 26:
  1761. x2 = 1.
  1762. x1 = INT(SUBSTRING(PZReferenz,01 ,01)).
  1763. x2 = INT(SUBSTRING(VMOD10[x2],x1 + 1,01)).
  1764. DO x3 = 2 TO 26:
  1765. x1 = INT(SUBSTRING(PZReferenz ,x3 ,01)).
  1766. x2 = INT(SUBSTRING(VMOD10[x2 + 1],x1 + 1,01)).
  1767. END.
  1768. PZ = INT(SUBSTRING(VMOD10[x2 + 1],11,1)).
  1769. SUBSTRING(PZReferenz,27) = STRING(PZ,"9").
  1770. LEAVE.
  1771. END.
  1772. DO WHILE l3 = 08:
  1773. x2 = 1.
  1774. x1 = INT(SUBSTRING(PZTNummer ,01 ,01)).
  1775. x2 = INT(SUBSTRING(VMOD10[x2],x1 + 1,01)).
  1776. DO x3 = 2 TO 08:
  1777. x1 = INT(SUBSTRING(PZTNummer ,x3 ,01)).
  1778. x2 = INT(SUBSTRING(VMOD10[x2 + 1],x1 + 1,01)).
  1779. END.
  1780. PZ = INT(SUBSTRING(VMOD10[x2 + 1],11,1)).
  1781. SUBSTRING(PZTNummer,09) = STRING(PZ,"9").
  1782. LEAVE.
  1783. END.
  1784. VSZeile = "".
  1785. SUBSTRING(VSZeile,01) = PZBetrag.
  1786. SUBSTRING(VSZeile,14) = ">".
  1787. SUBSTRING(VSZeile,15) = PZReferenz.
  1788. SUBSTRING(VSZeile,42) = "+ ".
  1789. SUBSTRING(VSZeile,44) = PZTNummer.
  1790. SUBSTRING(VSZeile,53) = ">".
  1791. /*
  1792. SUBSTRING(VSZeile,58) = "H".
  1793. */
  1794. END PROCEDURE.
  1795. /* _UIB-CODE-BLOCK-END */
  1796. &ANALYZE-RESUME
  1797. &ENDIF
  1798. &IF DEFINED(EXCLUDE-VIPER_CREATE_DOKUMENT) = 0 &THEN
  1799. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE VIPER_CREATE_DOKUMENT Procedure
  1800. PROCEDURE VIPER_CREATE_DOKUMENT :
  1801. /*------------------------------------------------------------------------------
  1802. Purpose:
  1803. Parameters: <none>
  1804. Notes:
  1805. ------------------------------------------------------------------------------*/
  1806. DEFINE INPUT PARAMETER ipGruppe AS CHARACTER NO-UNDO.
  1807. DEFINE INPUT PARAMETER ipZeile AS INTEGER NO-UNDO.
  1808. DEFINE INPUT PARAMETER ipFeld AS CHARACTER NO-UNDO.
  1809. DEFINE INPUT PARAMETER ipInhalt AS CHARACTER NO-UNDO.
  1810. CREATE tDokument.
  1811. ASSIGN
  1812. tDokument.cGruppe = ipGruppe
  1813. tDokument.iZeile = ipZeile
  1814. tDokument.cFeld = ipFeld
  1815. tDokument.cInhalt = ipInhalt.
  1816. END PROCEDURE.
  1817. /* _UIB-CODE-BLOCK-END */
  1818. &ANALYZE-RESUME
  1819. &ENDIF
  1820. &IF DEFINED(EXCLUDE-VIPER_INIT) = 0 &THEN
  1821. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE VIPER_INIT Procedure
  1822. PROCEDURE VIPER_INIT :
  1823. /*------------------------------------------------------------------------------
  1824. Purpose:
  1825. Parameters: <none>
  1826. Notes:
  1827. ------------------------------------------------------------------------------*/
  1828. DEFINE VARIABLE cTemplate AS CHARACTER NO-UNDO.
  1829. DEFINE VARIABLE cDokument AS CHARACTER NO-UNDO.
  1830. DEFINE VARIABLE cZellen AS CHARACTER NO-UNDO.
  1831. DEFINE VARIABLE cZelle AS CHARACTER NO-UNDO.
  1832. DEFINE VARIABLE cGruppe AS CHARACTER NO-UNDO.
  1833. DEFINE VARIABLE ii AS INTEGER NO-UNDO.
  1834. FIND FIRST tParam.
  1835. IF iLauf = iAnzDok AND
  1836. tParam.lCreatePDF THEN
  1837. DO:
  1838. cDokument = tParam.cInstall + '/' + tParam.cDokument + '_pdf.vfr'.
  1839. cTemplate = tParam.cDokument + '_pdf'.
  1840. END.
  1841. ELSE
  1842. DO:
  1843. cDokument = tParam.cInstall + '/' + tParam.cDokument + '.vfr'.
  1844. cTemplate = tParam.cDokument.
  1845. END.
  1846. RUN vpr_LoadVFR (cDokument).
  1847. RUN vpr_ActivateReport (cTemplate).
  1848. RUN vpr_SelectPrinter (tParam.Drucker).
  1849. RUN vpr_setPrinterAttrib('duplex=1').
  1850. RUN vpr_SetPrinterAttrib('copies=1').
  1851. RUN vpr_ResetDoc.
  1852. RUN vpr_SetDocAttrib ('PAPERSIZE=A4').
  1853. RUN vpr_SetPreviewMode ('Direct').
  1854. RUN vpr_setDocTitle (tParam.cDokument).
  1855. IF iLauf = 1 THEN
  1856. DO:
  1857. IF tParam.Schacht_Original > 0 THEN RUN vpr_SetCurrentPageProperties ( "Papertray", tParam.Schacht_Original ).
  1858. END.
  1859. ELSE
  1860. DO:
  1861. IF tParam.Schacht_Kopie > 0 THEN RUN vpr_SetCurrentPageProperties ( "Papertray", tParam.Schacht_Kopie ).
  1862. END.
  1863. RUN vpr_SetGroupAttrib ("Kopf" , "Fixed=true").
  1864. RUN vpr_SetGroupAttrib ("Fusstext" , "Fixed=true").
  1865. RUN vpr_SetGroupAttrib ("Kondition", "Fixed=true").
  1866. iMaxPos = 2750.
  1867. END PROCEDURE.
  1868. /* _UIB-CODE-BLOCK-END */
  1869. &ANALYZE-RESUME
  1870. &ENDIF
  1871. &IF DEFINED(EXCLUDE-VIPER_NEUE_SEITE) = 0 &THEN
  1872. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE VIPER_NEUE_SEITE Procedure
  1873. PROCEDURE VIPER_NEUE_SEITE :
  1874. /*------------------------------------------------------------------------------
  1875. Purpose:
  1876. Parameters: <none>
  1877. Notes:
  1878. ------------------------------------------------------------------------------*/
  1879. DEFINE VARIABLE iPos AS INTEGER NO-UNDO.
  1880. FIND FIRST tParam.
  1881. DO WHILE TRUE:
  1882. IF iSeite = 0 THEN
  1883. DO:
  1884. iSeite = iSeite + 1.
  1885. LEAVE.
  1886. END.
  1887. iPos = vpr_getPageVPos().
  1888. IF (iPos + 160) < iMaxPos THEN
  1889. DO:
  1890. iPos = iPos + 20.
  1891. RUN vpr_setPageVPos ( iPos ).
  1892. RETURN.
  1893. END.
  1894. RUN vpr_NewPage.
  1895. IF iLauf = 1 THEN RUN vpr_SetCurrentPageProperties ( "Papertray", tParam.Schacht_Original ).
  1896. ELSE RUN vpr_SetCurrentPageProperties ( "Papertray", tParam.Schacht_Kopie ).
  1897. iSeite = iSeite + 1.
  1898. LEAVE.
  1899. END.
  1900. RUN vpr_InitGroups ('').
  1901. IF tParam.lCreatePDF THEN
  1902. DO:
  1903. RUN vpr_initGraphObj.
  1904. RUN vpr_FlushGroup ('Fusstext').
  1905. END.
  1906. RUN vpr_setPageVPos ( 1 ).
  1907. END PROCEDURE.
  1908. /* _UIB-CODE-BLOCK-END */
  1909. &ANALYZE-RESUME
  1910. &ENDIF
  1911. /* ************************ Function Implementations ***************** */
  1912. &IF DEFINED(EXCLUDE-calcBlock) = 0 &THEN
  1913. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION calcBlock Procedure
  1914. FUNCTION calcBlock RETURNS INTEGER (ipGruppe AS CHARACTER):
  1915. DEFINE VARIABLE cZellen AS CHARACTER NO-UNDO.
  1916. DEFINE VARIABLE cWerte AS CHARACTER NO-UNDO.
  1917. DEFINE VARIABLE iSpace AS INTEGER NO-UNDO.
  1918. DEFINE VARIABLE iGrpHo AS INTEGER NO-UNDO.
  1919. FOR EACH tDokument
  1920. WHERE tDokument.cGruppe = ipGruppe
  1921. BREAK BY tDokument.cGruppe
  1922. BY tDokument.iZeile :
  1923. IF FIRST-OF ( tDokument.iZeile ) THEN
  1924. DO:
  1925. cZellen = ''.
  1926. cWerte = ''.
  1927. END.
  1928. cWerte = cWerte
  1929. + tDokument.cInhalt.
  1930. cZellen = cZellen
  1931. + tDokument.cFeld.
  1932. IF NOT LAST-OF ( tDokument.iZeile ) THEN
  1933. DO:
  1934. ASSIGN
  1935. cWerte = cWerte + CHR(01)
  1936. cZellen = cZellen + ','.
  1937. NEXT.
  1938. END.
  1939. RUN vpr_setGroupText (ipGruppe, cZellen, cWerte).
  1940. iGrpHo = vpr_getGroupHeight ( ipGruppe ).
  1941. iSpace = iSpace + iGrpHo.
  1942. END.
  1943. RETURN iSpace.
  1944. END FUNCTION.
  1945. /* _UIB-CODE-BLOCK-END */
  1946. &ANALYZE-RESUME
  1947. &ENDIF