LieferFak.p 77 KB

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