Sav_Faktura.p 80 KB

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