FestFaktura.p 70 KB

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