Kasse.p 82 KB

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