LieferFak.p 76 KB

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