Faktura_pdf.p 76 KB

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