Sav_FestSammelRechnung.p 80 KB

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