LieferFak.p 77 KB

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