SammelRechnung.p 78 KB

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