Faktura.p 72 KB

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