Sav_LieferFak.p 77 KB

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