Lieferschein.p 60 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872
  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 iMaxPos AS INTEGER INIT 2650 NO-UNDO.
  42. DEFINE VARIABLE cvpr_Dokument AS CHARACTER NO-UNDO.
  43. DEFINE VARIABLE iArtZeile AS INTEGER NO-UNDO.
  44. DEFINE VARIABLE iVPagePos AS INTEGER NO-UNDO.
  45. DEFINE VARIABLE iVGroupPos AS INTEGER NO-UNDO.
  46. DEFINE BUFFER bAufko FOR Aufko .
  47. DEFINE BUFFER bAufze FOR Aufze .
  48. DEFINE BUFFER FDebst FOR Debst . /* Fakturaadresse */
  49. DEFINE BUFFER LDebst FOR Debst . /* Lieferadresse */
  50. DEFINE BUFFER LAdresse FOR Adresse .
  51. DEFINE BUFFER bAdresse FOR Adresse .
  52. DEFINE BUFFER bWust FOR Wust .
  53. DEFINE BUFFER bSteuer FOR Steuer .
  54. { incl/ttsendmail.i }
  55. { incl/properties.i }
  56. { incl/ttdruckparam.i }
  57. DEFINE TEMP-TABLE tDokument
  58. FIELD cGruppe AS CHARACTER
  59. FIELD iZeile AS INTEGER
  60. FIELD cFeld AS CHARACTER
  61. FIELD cInhalt AS CHARACTER
  62. INDEX tDokument-k1 IS PRIMARY
  63. cGruppe
  64. iZeile
  65. cFeld
  66. .
  67. DEFINE TEMP-TABLE tTotale
  68. FIELD nMwstPfl AS DECIMAL EXTENT 12
  69. FIELD nMwstBet AS DECIMAL EXTENT 12
  70. FIELD nSammTot AS DECIMAL
  71. FIELD nSkBer AS DECIMAL
  72. FIELD nWW AS DECIMAL
  73. .
  74. DEFINE TEMP-TABLE sAufko
  75. FIELD cFirma AS CHARACTER
  76. FIELD iAufnr AS INTEGER
  77. FIELD iFak_Knr AS INTEGER
  78. FIELD iKnr AS INTEGER
  79. FIELD iSamm_Nr AS INTEGER
  80. FIELD iRecid AS RECID
  81. FIELD iFaknr AS INTEGER
  82. FIELD lMail AS LOGICAL
  83. FIELD rAdresse AS RECID
  84. FIELD rDebst AS RECID
  85. .
  86. DEFINE TEMP-TABLE tAufko LIKE Aufko
  87. FIELD iRecid AS RECID
  88. .
  89. DEFINE TEMP-TABLE tAufze
  90. FIELD Aufnr AS INTEGER
  91. FIELD Sort1 AS CHARACTER
  92. FIELD Sort2 AS CHARACTER
  93. FIELD Sort3 AS CHARACTER
  94. FIELD Artnr AS INTEGER
  95. FIELD Inhalt AS INTEGER
  96. FIELD Jahr AS INTEGER
  97. FIELD Pos AS INTEGER
  98. FIELD Zeile AS RECID
  99. FIELD Preis AS DECIMAL DECIMALS 4
  100. FIELD Aktion AS LOG
  101. FIELD LagOrt AS CHARACTER
  102. FIELD MGeli AS DECIMAL
  103. FIELD MRuek AS DECIMAL
  104. INDEX tAufze-k1 IS PRIMARY
  105. Aufnr
  106. Sort1
  107. Sort2
  108. Sort3
  109. .
  110. DEFINE TEMP-TABLE tRueckst LIKE tAufze
  111. .
  112. DEFINE TEMP-TABLE tSpeRab
  113. FIELD Rab_Grp AS INTEGER
  114. FIELD Auf_Betr AS DECIMAL DECIMALS 4
  115. .
  116. DEFINE TEMP-TABLE tGebKto
  117. FIELD Sort_Cd AS CHARACTER
  118. FIELD Geb_Cd AS CHARACTER
  119. FIELD Bez AS CHARACTER
  120. FIELD Preis AS DECIMAL
  121. FIELD A_Anz AS DECIMAL
  122. FIELD A_Betrag AS DECIMAL
  123. FIELD E_Anz AS DECIMAL
  124. FIELD E_Betrag AS DECIMAL
  125. FIELD MWST_Art AS INTEGER
  126. FIELD MWST_Cd AS INTEGER
  127. .
  128. DEFINE TEMP-TABLE tRabSumm
  129. FIELD Rab_Summ AS INTEGER
  130. FIELD Bez AS CHARACTER
  131. FIELD F_Rab_Art AS INTEGER
  132. FIELD F_Wert AS DECIMAL DECIMALS 4
  133. FIELD A_Rab_Art AS INTEGER
  134. FIELD A_Wert AS DECIMAL DECIMALS 4
  135. FIELD Auf_Rab AS DECIMAL DECIMALS 4
  136. FIELD Abh_Rab AS DECIMAL DECIMALS 4
  137. .
  138. DEFINE TEMP-TABLE tUmsGrp
  139. FIELD Ums_Grp AS INTEGER
  140. FIELD Mwst AS INTEGER
  141. FIELD Ansatz AS DECIMAL
  142. FIELD Bez AS CHARACTER
  143. FIELD Ums_Betr AS DECIMAL DECIMALS 4
  144. .
  145. DEFINE TEMP-TABLE tTabTexte
  146. FIELD cRecArt AS CHARACTER
  147. FIELD iZeile AS INTEGER
  148. FIELD cFeld1 AS CHARACTER
  149. FIELD cFeld2 AS CHARACTER
  150. FIELD cFeld3 AS CHARACTER
  151. FIELD iFeld1 AS INTEGER
  152. FIELD iFeld2 AS INTEGER
  153. FIELD iFeld3 AS INTEGER
  154. INDEX tTabTexte-k1 IS PRIMARY
  155. cRecArt
  156. iZeile.
  157. /* _UIB-CODE-BLOCK-END */
  158. &ANALYZE-RESUME
  159. &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
  160. /* ******************** Preprocessor Definitions ******************** */
  161. &Scoped-define PROCEDURE-TYPE Procedure
  162. &Scoped-define DB-AWARE no
  163. /* _UIB-PREPROCESSOR-BLOCK-END */
  164. &ANALYZE-RESUME
  165. /* ************************ Function Prototypes ********************** */
  166. &IF DEFINED(EXCLUDE-generateLSMail) = 0 &THEN
  167. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD generateLSMail Procedure
  168. FUNCTION generateLSMail RETURNS LOGICAL
  169. (iprsAufko AS RECID) FORWARD.
  170. /* _UIB-CODE-BLOCK-END */
  171. &ANALYZE-RESUME
  172. &ENDIF
  173. /* *********************** Procedure Settings ************************ */
  174. &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
  175. /* Settings for THIS-PROCEDURE
  176. Type: Procedure
  177. Allow:
  178. Frames: 0
  179. Add Fields to: Neither
  180. Other Settings: CODE-ONLY COMPILE
  181. */
  182. &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
  183. /* ************************* Create Window ************************** */
  184. &ANALYZE-SUSPEND _CREATE-WINDOW
  185. /* DESIGN Window definition (used by the UIB)
  186. CREATE WINDOW Procedure ASSIGN
  187. HEIGHT = 15
  188. WIDTH = 60.
  189. /* END WINDOW DEFINITION */
  190. */
  191. &ANALYZE-RESUME
  192. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
  193. /* *************************** Main Block *************************** */
  194. opcResult = ''.
  195. CREATE tParam.
  196. htParam:BUFFER-COPY(iphParam).
  197. IF tParam.lSendMail THEN
  198. ASSIGN
  199. tParam.lDokDruck = FALSE
  200. tParam.lCreatePDF = TRUE
  201. tParam.lOpenPDF = FALSE.
  202. ASSIGN
  203. cFirma = tParam.cFirma
  204. iAnzDok = tParam.Anzahl
  205. lPreis = tParam.lPreis.
  206. FIND bSteuer NO-LOCK WHERE bSteuer.Firma = cFirma.
  207. AdFirma = bSteuer.AdFirma.
  208. RUN AUFTRAG_ERMITTELN.
  209. IF opcResult <> '' THEN RETURN 'Kein Auftrag'.
  210. FOR EACH sAufko
  211. BY sAufko.iKnr:
  212. FIND bAdresse NO-LOCK
  213. WHERE bAdresse.Firma = AdFirma
  214. AND bAdresse.Knr = sAufko.iKnr.
  215. iSprcd = bAdresse.Sprcd.
  216. RUN GET_FORMTEXT ( tParam.cInstall, tParam.cDokument, iSprcd,
  217. OUTPUT cFormText ) NO-ERROR.
  218. cRabText = TRIM(SUBSTRING(cFormText[21],01,20)).
  219. cZusText = TRIM(SUBSTRING(cFormText[21],21,20)).
  220. cEpzText = TRIM(SUBSTRING(cFormText[21],41,20)).
  221. RELEASE bAdresse.
  222. { vpr.i INIT }
  223. { vpr.i START }
  224. DO iLauf = 1 TO iAnzDok:
  225. dFakDatum = TODAY.
  226. iSeite = 0.
  227. iFaknr = sAufko.iFaknr.
  228. lFirst = TRUE.
  229. lLast = FALSE.
  230. EMPTY TEMP-TABLE tUmsGrp .
  231. EMPTY TEMP-TABLE tTotale .
  232. CREATE tTotale.
  233. FOR EACH bAufko NO-LOCK
  234. WHERE bAufko.Firma = sAufko.cFirma
  235. AND bAufko.Aufnr = sAufko.iAufnr
  236. BREAK BY bAufko.Firma
  237. BY bAufko.Aufnr :
  238. EMPTY TEMP-TABLE tAufze .
  239. EMPTY TEMP-TABLE tGebKto .
  240. EMPTY TEMP-TABLE tRabSumm .
  241. EMPTY TEMP-TABLE tSpeRab .
  242. EMPTY TEMP-TABLE tTabTexte .
  243. EMPTY TEMP-TABLE tRueckst .
  244. FIND bAdresse NO-LOCK USE-INDEX Adresse-k1
  245. WHERE bAdresse.Firma = AdFirma
  246. AND bAdresse.Knr = bAufko.Knr NO-ERROR.
  247. FIND LDebst NO-LOCK USE-INDEX Debst-k1
  248. WHERE LDebst.Firma = cFirma
  249. AND LDebst.Knr = bAufko.Knr NO-ERROR.
  250. FIND FDebst NO-LOCK USE-INDEX Debst-k1
  251. WHERE FDebst.Firma = cFirma
  252. AND FDebst.Knr = bAufko.Fak_Knr NO-ERROR.
  253. FIND bWust NO-LOCK USE-INDEX Wust-k1
  254. WHERE bWust.CodeK = LDebst.MWST
  255. AND bWust.CodeA = 99 NO-ERROR.
  256. lDebIncl = FALSE.
  257. IF AVAILABLE bWust THEN lDebIncl = bWust.Incl.
  258. dFakDatum = (IF bAufko.Lief_Datum < TODAY THEN TODAY ELSE bAufko.Lief_Datum).
  259. hAufko = BUFFER bAufko:HANDLE.
  260. htTabTexte = TEMP-TABLE tTabTexte:DEFAULT-BUFFER-HANDLE.
  261. ASSIGN
  262. sAufko.lMail = (IF lDebIncl THEN FALSE ELSE TRUE)
  263. sAufko.rAdresse = RECID(bAdresse)
  264. sAufko.rDebst = RECID(LDebst).
  265. /* Texte und Werte aus Tabelle 'Tabel' laden für RecArt */
  266. /* FAKART, AUFSTATUS, LIEFART, FAHRER, WISO, ABLAD */
  267. RUN CREATE_TABTEXTE ( hAufko, INPUT-OUTPUT htTabTexte ) NO-ERROR.
  268. RUN FUELLEN_tAufze ( bAufko.Aufnr ) NO-ERROR.
  269. FOR EACH tAufze
  270. WHERE tAufze.Artnr > 0:
  271. FIND bAufze NO-LOCK WHERE RECID(bAufze) = tAufze.Zeile.
  272. /* Spezial-Auftragsrabatt pro Lieferschein bilden */
  273. IF bAufze.Auf_Sp_Grp > 0 THEN
  274. DO:
  275. FIND FIRST tSpeRab
  276. WHERE tSpeRab.Rab_Grp = bAufze.Auf_Sp_Grp NO-ERROR.
  277. IF NOT AVAILABLE tSpeRab THEN
  278. DO:
  279. CREATE tSpeRab.
  280. ASSIGN
  281. tSpeRab.Rab_Grp = bAufze.Auf_Sp_Grp.
  282. END.
  283. tSpeRab.Auf_Betr = tSpeRab.Auf_Betr + bAufze.Auf_Sp_Rab.
  284. END.
  285. /* Summengruppen-Totale pro Lieferschein bilden */
  286. DO WHILE bAufze.Rab_Su_Grp > 0:
  287. FIND FIRST tRabSumm
  288. WHERE tRabSumm.Rab_Summ = bAufze.Rab_Su_Grp NO-ERROR.
  289. IF NOT AVAILABLE tRabSumm THEN
  290. DO:
  291. FIND FIRST RabSumm NO-LOCK
  292. WHERE RabSumm.Firma = bAufze.Firma
  293. AND RabSumm.Rab_Summ = bAufze.Rab_Su_Grp NO-ERROR.
  294. IF NOT AVAILABLE RabSumm THEN LEAVE.
  295. CREATE tRabSumm.
  296. ASSIGN
  297. tRabSumm.Rab_Summ = bAufze.Rab_Su_Grp
  298. tRabSumm.Bez = RabSumm.Bez
  299. tRabSumm.Auf_Rab = 0
  300. tRabSumm.Abh_Rab = 0.
  301. END.
  302. LEAVE.
  303. END.
  304. END.
  305. IF LAST-OF ( bAufko.Aufnr ) THEN lLast = TRUE.
  306. RUN DRUCKEN.
  307. /* Auftragskopf mutieren */
  308. REPEAT TRANSACTION:
  309. IF iLauf < iAnzDok THEN LEAVE.
  310. RUN AUFTRAG_GEDRUCKT ( bAufko.Aufnr ).
  311. IF sAufko.lMail THEN
  312. DO:
  313. DYNAMIC-FUNCTION ('generateLSMail':U, RECID(sAufko)) NO-ERROR.
  314. END.
  315. LEAVE.
  316. END.
  317. END.
  318. END.
  319. { vpr.i STOP }
  320. END.
  321. PROCEDURE ShellExecuteA EXTERNAL "shell32.dll" :
  322. DEFINE INPUT PARAMETER lphwnd AS LONG.
  323. DEFINE INPUT PARAMETER lpOperation AS CHARACTER.
  324. DEFINE INPUT PARAMETER lpFile AS CHARACTER.
  325. DEFINE INPUT PARAMETER lpParameters AS CHARACTER.
  326. DEFINE INPUT PARAMETER lpDirectory AS CHARACTER.
  327. DEFINE INPUT PARAMETER nShowCmd AS LONG.
  328. DEFINE RETURN PARAMETER hInstance AS LONG.
  329. END PROCEDURE.
  330. /* _UIB-CODE-BLOCK-END */
  331. &ANALYZE-RESUME
  332. &IF DEFINED(EXCLUDE-GETMAILBODY) = 0 &THEN
  333. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE GETMAILBODY Procedure
  334. PROCEDURE GETMAILBODY:
  335. /*------------------------------------------------------------------------------
  336. Purpose:
  337. Notes:
  338. ------------------------------------------------------------------------------*/
  339. DEFINE INPUT PARAMETER ipiSprcd AS CHARACTER NO-UNDO.
  340. DEFINE OUTPUT PARAMETER opcBody AS CHARACTER NO-UNDO.
  341. DEFINE VARIABLE cBodyDatei AS CHARACTER NO-UNDO INIT ?.
  342. DEFINE VARIABLE cBody AS CHARACTER NO-UNDO INIT ''.
  343. DEFINE VARIABLE lBody AS LONGCHAR NO-UNDO.
  344. FIND FIRST tParam.
  345. DO WHILE cBodyDatei = ?:
  346. cBodyDatei = SUBSTITUTE('druckprogramme/&1/Mail-Lieferschein-&2.html', tParam.cInstall, ipiSprcd).
  347. cBodyDatei = SEARCH(cBodyDatei).
  348. LEAVE.
  349. END.
  350. IF cBodydatei = ? THEN cBody = ''.
  351. ELSE
  352. DO:
  353. FILE-INFO:FILE-NAME = cBodyDatei.
  354. cBodyDatei = FILE-INFO:FULL-PATHNAME.
  355. COPY-LOB FILE cBodydatei TO lBody NO-CONVERT.
  356. cBody = lBody.
  357. END.
  358. opcBody = cBody.
  359. END PROCEDURE.
  360. /* _UIB-CODE-BLOCK-END */
  361. &ANALYZE-RESUME
  362. &ENDIF
  363. /* ********************** Internal Procedures *********************** */
  364. &IF DEFINED(EXCLUDE-ARTIKELZEILE) = 0 &THEN
  365. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE ARTIKELZEILE Procedure
  366. PROCEDURE ARTIKELZEILE :
  367. /*------------------------------------------------------------------------------
  368. Purpose:
  369. Parameters: <none>
  370. Notes:
  371. ------------------------------------------------------------------------------*/
  372. DEFINE INPUT PARAMETER ipRecid AS RECID NO-UNDO.
  373. DEFINE VARIABLE cString AS CHARACTER NO-UNDO.
  374. DEFINE VARIABLE nRabWert AS DECIMAL NO-UNDO.
  375. DEFINE VARIABLE xRabText AS CHARACTER NO-UNDO.
  376. FIND tAufze WHERE RECID(tAufze) = ipRecid NO-LOCK.
  377. FIND Aufze WHERE RECID(Aufze) = tAufze.Zeile NO-LOCK.
  378. iArtZeile = iArtZeile + 1.
  379. DO WHILE Aufze.Artnr = 0:
  380. cString = Aufze.Bez1.
  381. IF Aufze.Bez1 <> '' THEN
  382. DO:
  383. cString = cString
  384. + (IF cString = '' THEN '' ELSE CHR(10))
  385. + Aufze.Bez2.
  386. END.
  387. CREATE tDokument.
  388. ASSIGN
  389. tDokument.cGruppe = 'ArtikelZeile1'
  390. tDokument.iZeile = iArtZeile
  391. tDokument.cFeld = 'Bez1'
  392. tDokument.cInhalt = cString.
  393. RETURN.
  394. END.
  395. FIND Artst OF Aufze NO-LOCK.
  396. FIND GGebinde NO-LOCK
  397. WHERE GGebinde.Firma = cFirma
  398. AND GGebinde.Geb_Cd = Aufze.GGeb_Cd NO-ERROR.
  399. FIND VGebinde NO-LOCK
  400. WHERE VGebinde.Firma = cFirma
  401. AND VGebinde.Geb_Cd = Aufze.VGeb_Cd NO-ERROR.
  402. FIND KGebinde NO-LOCK
  403. WHERE KGebinde.Firma = cFirma
  404. AND KGebinde.Geb_Cd = Aufze.KGeb_Cd NO-ERROR.
  405. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'KGebinde', KGebinde.Kbez ).
  406. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Artnr' , STRING(Aufze.Artnr ,"999999") ).
  407. IF Aufze.VGeb_Me <> 0 THEN
  408. DO:
  409. cString = STRING(Aufze.VGeb_Me,'->>>>')
  410. + 'x '
  411. + VGebinde.KBez.
  412. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'VGebinde', cString ).
  413. END.
  414. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Menge', STRING(Aufze.MGeli,'->>,>>9') ).
  415. cString = Aufze.Bez1.
  416. IF Aufze.Bez2 <> '' THEN
  417. DO:
  418. cString = cString
  419. + (IF cString = '' THEN '' ELSE CHR(10))
  420. + Aufze.Bez2.
  421. END.
  422. IF Aufze.Aktion THEN
  423. DO:
  424. cString = cString
  425. + (IF cString = '' THEN '' ELSE CHR(10))
  426. + Aufze.Aktion_Text.
  427. END.
  428. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', cString ).
  429. IF Aufze.Jahr > 9 THEN
  430. DO:
  431. cString = STRING(Aufze.Jahr,"9999").
  432. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'JG', cString ).
  433. END.
  434. IF Aufze.Alk_Gehalt <> 0 THEN
  435. DO:
  436. cString = STRING(Aufze.Alk_Gehalt,"zz9.9%").
  437. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Alk%', cString ).
  438. END.
  439. DO WHILE lPreis :
  440. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Preis' , STRING(Aufze.Preis ,'>>>,>>9.99') ).
  441. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', STRING(Aufze.Bru_Betr,'->>>,>>9.99') ).
  442. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'MC' , STRING(Aufze.WuCd ,'z9') ).
  443. IF Aufze.Rab_Betr = 0 THEN LEAVE.
  444. iArtZeile = iArtZeile + 1.
  445. nRabWert = ABSOLUTE(Aufze.Rab_Wert).
  446. IF Aufze.Rab_Art = 3 THEN xRabText = cEpzText.
  447. ELSE
  448. DO:
  449. IF Aufze.Rab_Betr < 0 THEN xRabText = cZusText.
  450. IF Aufze.Rab_Betr > 0 THEN xRabText = cRabText.
  451. END.
  452. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', TRIM(xRabText) ).
  453. IF Aufze.Rab_Art = 1 THEN cString = STRING(nRabWert,"->9.9%").
  454. IF Aufze.Rab_Art = 2 OR
  455. Aufze.Rab_Art = 3 THEN cString = STRING(nRabWert,"-9.99").
  456. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Preis', cString ).
  457. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', TRIM(STRING(- Aufze.Rab_Betr,"->>>,>>9.99")) ).
  458. LEAVE.
  459. END.
  460. DO WHILE lPreis:
  461. IF Aufze.Zus_Betr = 0 THEN LEAVE.
  462. iArtZeile = iArtZeile + 1.
  463. nRabWert = ABSOLUTE(Aufze.Zus_Wert).
  464. IF Aufze.Zus_Art = 3 THEN xRabText = cEpzText.
  465. ELSE
  466. DO:
  467. IF Aufze.Zus_Betr < 0 THEN xRabText = cRabText.
  468. IF Aufze.Zus_Betr > 0 THEN xRabText = cZusText.
  469. END.
  470. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', TRIM(xRabText) ).
  471. IF Aufze.Zus_Art = 1 THEN cString = STRING(nRabWert,"->9.9%").
  472. IF Aufze.Zus_Art = 2 OR
  473. Aufze.Zus_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.Zus_Betr,"->>>,>>9.99")) ).
  476. LEAVE.
  477. END.
  478. /* ---- Summengruppen-Total -------------------------------------------- */
  479. IF Aufze.Rab_Su_Grp <> 0 THEN
  480. DO:
  481. FIND FIRST tRabSumm WHERE tRabSumm.Rab_Summ = Aufze.Rab_Su_Grp NO-ERROR.
  482. IF AVAILABLE tRabSumm THEN
  483. DO:
  484. tRabSumm.Auf_Rab = tRabSumm.Auf_Rab + Aufze.Auf_Rab.
  485. tRabSumm.Abh_Rab = tRabSumm.Abh_Rab + Aufze.Abh_Rab.
  486. END.
  487. END.
  488. /* ---- Warengruppen-Totale -------------------------------------------- */
  489. FIND FIRST TUmsGrp WHERE TUmsGrp.Ums_Grp = Artst.Wg_Grp
  490. AND TUmsGrp.MWst = Aufze.WuCd
  491. AND TUmsGrp.Ansatz = Aufze.Mwst% NO-ERROR.
  492. IF NOT AVAILABLE TUmsGrp THEN
  493. DO:
  494. FIND WarenGrp NO-LOCK USE-INDEX WarenGrp-k1
  495. WHERE WarenGrp.Firma = cFirma
  496. AND WarenGrp.Wgr = Artst.Wg_Grp NO-ERROR.
  497. CREATE TUmsGrp.
  498. ASSIGN
  499. TUmsGrp.Ums_Grp = Artst.Wg_Grp
  500. TUmsGrp.Mwst = Aufze.WuCd
  501. TUmsGrp.Ansatz = Aufze.MWST%.
  502. IF AVAILABLE WarenGrp THEN TUmsGrp.Bez = WarenGrp.Bez1.
  503. ELSE TUmsGrp.Bez = "??????????".
  504. END.
  505. TUmsGrp.Ums_Betr = TUmsGrp.Ums_Betr
  506. + Aufze.Net_Betr
  507. - Aufze.Auf_Rab
  508. - Aufze.Abh_Rab.
  509. END PROCEDURE.
  510. /* _UIB-CODE-BLOCK-END */
  511. &ANALYZE-RESUME
  512. &ENDIF
  513. &IF DEFINED(EXCLUDE-AUFTRAG_ERMITTELN) = 0 &THEN
  514. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE AUFTRAG_ERMITTELN Procedure
  515. PROCEDURE AUFTRAG_ERMITTELN :
  516. /*------------------------------------------------------------------------------
  517. Purpose:
  518. Parameters: <none>
  519. Notes:
  520. ------------------------------------------------------------------------------*/
  521. DEFINE VARIABLE iAufnr AS INTEGER NO-UNDO.
  522. FIND FIRST tParam.
  523. EMPTY TEMP-TABLE sAufko.
  524. /* Sammeln aller Aufträge pro Sammelnummer */
  525. FOR EACH Aufko NO-LOCK USE-INDEX Aufko-k5
  526. WHERE Aufko.Firma = tParam.cFirma
  527. AND Aufko.Aufnr = tParam.iAufnr :
  528. CREATE sAufko.
  529. ASSIGN
  530. sAufko.cFirma = Aufko.Firma
  531. sAufko.iAufnr = Aufko.Aufnr
  532. sAufko.iFak_Knr = Aufko.Fak_Knr
  533. sAufko.iKnr = Aufko.Knr
  534. sAufko.iSamm_Nr = 0
  535. sAufko.iRecid = RECID(Aufko)
  536. sAufko.iFaknr = 0.
  537. END.
  538. /* Alle Auftragstotale aller Lieferscheine neu rechnen */
  539. FOR EACH sAufko:
  540. FOR EACH bAufko NO-LOCK
  541. WHERE bAufko.Firma = sAufko.cFirma
  542. AND bAufko.Aufnr = sAufko.iAufnr :
  543. DYNAMIC-FUNCTION('calculateAuftragsTotal':U, bAufko.Firma,
  544. bAufko.Aufnr,
  545. OUTPUT nTotale ) NO-ERROR.
  546. RELEASE bAufko.
  547. END.
  548. END.
  549. END PROCEDURE.
  550. /* _UIB-CODE-BLOCK-END */
  551. &ANALYZE-RESUME
  552. &ENDIF
  553. &IF DEFINED(EXCLUDE-AUSGABE_ARTIKELZEILE) = 0 &THEN
  554. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE AUSGABE_ARTIKELZEILE Procedure
  555. PROCEDURE AUSGABE_ARTIKELZEILE :
  556. /*------------------------------------------------------------------------------
  557. Purpose:
  558. Parameters: <none>
  559. Notes:
  560. ------------------------------------------------------------------------------*/
  561. DEFINE VARIABLE cZellen AS CHARACTER NO-UNDO.
  562. DEFINE VARIABLE cWerte AS CHARACTER NO-UNDO.
  563. DEFINE VARIABLE iPos AS INTEGER NO-UNDO.
  564. FOR EACH tDokument
  565. WHERE tDokument.cGruppe = 'ArtikelZeile1'
  566. BREAK BY tDokument.cGruppe
  567. BY tDokument.iZeile:
  568. IF FIRST-OF ( tDokument.cGruppe ) THEN
  569. DO:
  570. iVPagePos = vpr_getPageVPos() + 20.
  571. RUN vpr_setPageVPos ( iVPagePos ).
  572. RUN vpr_setGroupVPos ( 'ArtikelZeile1', iVPagePos ).
  573. END.
  574. IF FIRST-OF ( tDokument.iZeile ) THEN
  575. DO:
  576. cZellen = ''.
  577. cWerte = ''.
  578. END.
  579. cWerte = cWerte
  580. + tDokument.cInhalt.
  581. cZellen = cZellen
  582. + tDokument.cFeld.
  583. IF NOT LAST-OF ( tDokument.iZeile ) THEN
  584. DO:
  585. ASSIGN
  586. cWerte = cWerte + CHR(01)
  587. cZellen = cZellen + ','.
  588. NEXT.
  589. END.
  590. RUN vpr_SetDelimiter (CHR(01)).
  591. RUN vpr_setGroupText ('ArtikelZeile1', cZellen, cWerte).
  592. iVPagePos = vpr_getPageVPos().
  593. iPos = iVPagePos + vpr_getGroupHeight('ArtikelZeile1').
  594. IF iPos > iMaxPos THEN
  595. DO:
  596. RUN VIPER_NEUE_SEITE.
  597. RUN DRUCKEN_ADRESSE.
  598. iVPagePos = vpr_getPageVPos() + 20.
  599. RUN vpr_setPageVPos ( iVPagePos ).
  600. RUN vpr_setGroupText ('ArtikelZeile1', cZellen, cWerte).
  601. END.
  602. RUN vpr_FlushGroup ('ArtikelZeile1').
  603. iVPagePos = vpr_getPageVPos().
  604. IF LAST-OF ( tDokument.cGruppe ) THEN LEAVE.
  605. iVPagePos = vpr_getPageVPos().
  606. RUN vpr_setGroupVPos ( 'ArtikelZeile1', iVPagePos ).
  607. END.
  608. FOR EACH tDokument
  609. WHERE tDokument.cGruppe = 'ArtikelZeile1':
  610. DELETE tDokument.
  611. END.
  612. END PROCEDURE.
  613. /* _UIB-CODE-BLOCK-END */
  614. &ANALYZE-RESUME
  615. &ENDIF
  616. &IF DEFINED(EXCLUDE-AUSGABE_GRUPPE) = 0 &THEN
  617. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE AUSGABE_GRUPPE Procedure
  618. PROCEDURE AUSGABE_GRUPPE :
  619. /*------------------------------------------------------------------------------
  620. Purpose:
  621. Parameters: <none>
  622. Notes:
  623. ------------------------------------------------------------------------------*/
  624. DEFINE INPUT PARAMETER ipGruppe AS CHARACTER NO-UNDO.
  625. DEFINE VARIABLE cZellen AS CHARACTER NO-UNDO.
  626. DEFINE VARIABLE cWerte AS CHARACTER NO-UNDO.
  627. DEFINE VARIABLE iSpace AS INTEGER NO-UNDO.
  628. FIND FIRST tParam.
  629. iSpace = vpr_getPageVPos().
  630. FOR EACH tDokument NO-LOCK
  631. WHERE tDokument.cGruppe = ipGruppe
  632. BREAK BY tDokument.cGruppe
  633. BY tDokument.iZeile:
  634. IF FIRST-OF ( tDokument.iZeile ) THEN iSpace = iSpace + 40.
  635. END.
  636. IF iSpace > iMaxPos THEN
  637. DO:
  638. RUN vpr_NewPage.
  639. RUN vpr_InitGroups('').
  640. IF iLauf = iAnzDok THEN RUN vpr_initGraphObj.
  641. iSeite = iSeite + 1.
  642. RUN DRUCKEN_ADRESSE.
  643. END.
  644. iVPagePos = vpr_getPageVPos().
  645. CASE ipGruppe:
  646. WHEN 'Gebindeabrechnung' THEN
  647. DO:
  648. iVPagePos = iVPagePos + 20.
  649. RUN vpr_setGroupVPos ( 'GebindeabrechnungTitel', iVPagePos ).
  650. RUN vpr_FlushGroup ( 'GebindeabrechnungTitel').
  651. iVPagePos = vpr_getPageVPos().
  652. END.
  653. OTHERWISE
  654. DO:
  655. END.
  656. END CASE.
  657. FOR EACH tDokument
  658. WHERE tDokument.cGruppe = ipGruppe
  659. BREAK BY tDokument.cGruppe
  660. BY tDokument.iZeile:
  661. IF FIRST-OF ( tDokument.cGruppe ) THEN
  662. DO:
  663. IF ipGruppe <> 'Kondition' AND
  664. ipGruppe <> 'BESR' AND
  665. ipGruppe <> 'ADRESSE' THEN
  666. DO:
  667. iVPagePos = vpr_getPageVPos().
  668. RUN vpr_setGroupVPos ( ipGruppe, iVPagePos ).
  669. END.
  670. END.
  671. IF FIRST-OF ( tDokument.iZeile ) THEN
  672. DO:
  673. cZellen = ''.
  674. cWerte = ''.
  675. END.
  676. cWerte = cWerte
  677. + tDokument.cInhalt.
  678. cZellen = cZellen
  679. + tDokument.cFeld.
  680. IF NOT LAST-OF ( tDokument.iZeile ) THEN
  681. DO:
  682. ASSIGN
  683. cWerte = cWerte + CHR(01)
  684. cZellen = cZellen + ','.
  685. NEXT.
  686. END.
  687. RUN vpr_SetDelimiter (CHR(01)).
  688. RUN vpr_setGroupText (ipGruppe, cZellen, cWerte).
  689. RUN vpr_FlushGroup (ipGruppe).
  690. END.
  691. FOR EACH tDokument
  692. WHERE tDokument.cGruppe = ipGruppe:
  693. DELETE tDokument.
  694. END.
  695. END PROCEDURE.
  696. /* _UIB-CODE-BLOCK-END */
  697. &ANALYZE-RESUME
  698. &ENDIF
  699. &IF DEFINED(EXCLUDE-DRUCKEN) = 0 &THEN
  700. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN Procedure
  701. PROCEDURE DRUCKEN :
  702. /*------------------------------------------------------------------------------
  703. Purpose:
  704. Parameters: <none>
  705. Notes:
  706. ------------------------------------------------------------------------------*/
  707. DEFINE VARIABLE cText AS CHARACTER NO-UNDO.
  708. DEFINE VARIABLE cLAdresse AS CHARACTER NO-UNDO.
  709. DEFINE VARIABLE RText AS CHARACTER NO-UNDO.
  710. DEFINE VARIABLE WText AS CHARACTER NO-UNDO.
  711. DEFINE VARIABLE ii AS INTEGER NO-UNDO.
  712. DEFINE VARIABLE i1 AS INTEGER NO-UNDO.
  713. DEFINE VARIABLE nBetrag AS DECIMAL NO-UNDO.
  714. DEFINE VARIABLE iMwstCd AS INTEGER NO-UNDO.
  715. DEFINE VARIABLE nZeiTot AS DECIMAL DECIMALS 4 NO-UNDO.
  716. DEFINE VARIABLE lJa AS LOG NO-UNDO.
  717. DEFINE VARIABLE cPDFName AS CHARACTER INIT '' NO-UNDO.
  718. FIND FIRST tParam.
  719. IF tParam.lBatch THEN
  720. DO:
  721. ASSIGN
  722. tParam.lOpenPDF = FALSE.
  723. END.
  724. nFakBetr = 0.
  725. IF iSeite = 0 THEN RUN VIPER_INIT.
  726. RUN DRUCKEN_KOPF.
  727. iArtZeile = 0.
  728. iVPagePos = vpr_getPageVPos().
  729. RUN vpr_setGroupVPos ( 'ArtikelZeile1', iVPagePos ).
  730. FOR EACH tAufze NO-LOCK
  731. BY tAufze.Aufnr
  732. BY tAufze.Sort1
  733. BY tAufze.LagOrt
  734. BY tAufze.Sort2
  735. BY tAufze.Pos :
  736. FIND Aufze NO-LOCK WHERE RECID(Aufze) = tAufze.Zeile.
  737. RUN ARTIKELZEILE ( RECID(tAufze) ).
  738. nFakBetr = nFakBetr + Aufze.Net_Betr.
  739. RELEASE Aufze.
  740. END.
  741. IF lPreis THEN
  742. DO:
  743. iArtZeile = iArtZeile + 1.
  744. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1' , ' ' ).
  745. iArtZeile = iArtZeile + 1.
  746. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1' , TRIM(SUBSTRING(cFormText[10],41,20)) ).
  747. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', TRIM(STRING(nFakBetr,'->>>,>>9.99')) ).
  748. END.
  749. iArtZeile = iArtZeile + 1.
  750. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1' , ' ' ).
  751. RUN AUSGABE_ARTIKELZEILE.
  752. /* Auftragsrabatt ---------------------------------------------------- */
  753. FOR EACH tRabSumm
  754. WHERE tRabSumm.Auf_Rab <> 0
  755. BY tRabSumm.Rab_Summ:
  756. Rundbetr = tRabSumm.Auf_Rab.
  757. nFakBetr = nFakBetr - Rundbetr.
  758. END.
  759. /* Abholrabatt ------------------------------------------------------- */
  760. FOR EACH tRabSumm
  761. WHERE tRabSumm.Abh_Rab <> 0
  762. BY tRabSumm.Rab_Summ:
  763. Rundbetr = tRabSumm.Abh_Rab.
  764. nFakBetr = nFakBetr - Rundbetr.
  765. END.
  766. /* Spezialpreis-Auftragsrabatte ---------------------------------------- */
  767. FOR EACH tSpeRab WHERE tSpeRab.Auf_Betr <> 0
  768. BY tSpeRab.Rab_Grp:
  769. Rundbetr = tSpeRab.Auf_Betr.
  770. nFakBetr = nFakBetr - Rundbetr.
  771. END.
  772. /* Recycling-Gebuehren ----------------------------------------------- */
  773. FOR EACH AufGKon NO-LOCK
  774. WHERE AufGKon.Firma = BAufko.Firma
  775. AND AufGKon.Aufnr = BAufko.Aufnr
  776. AND AufGKon.Gebuehr <> 0
  777. AND AufGKon.Betrag <> 0 :
  778. iMwstCd = AufGKon.MWST_Cd.
  779. nFakBetr = nFakBetr + AufGKon.Betrag.
  780. END.
  781. RELEASE AufGKon.
  782. /* Gebinde Aus- und Eingänge ---------------------------------------- */
  783. IF FDebst.Geb_Rg THEN
  784. DO:
  785. FOR EACH AufGKon NO-LOCK
  786. WHERE AufGKon.Firma = BAufko.Firma
  787. AND AufGKon.Aufnr = BAufko.Aufnr
  788. AND AufGKon.Depot <> 0
  789. AND AufGKon.Betrag <> 0 :
  790. FIND FIRST tGebKto WHERE tGebKto.Geb_Cd = AufGKon.Geb_Cd NO-ERROR.
  791. IF NOT AVAILABLE tGebKto THEN
  792. DO:
  793. FIND GebKonto NO-LOCK
  794. WHERE GebKonto.Firma = AufGKon.Firma
  795. AND GebKonto.Geb_Cd = AufGKon.Geb_Cd.
  796. CREATE tGebKto.
  797. ASSIGN
  798. tGebKto.Sort_Cd = GebKonto.Sort_Cd
  799. tGebKto.Geb_Cd = GebKonto.Geb_Cd
  800. tGebKto.Bez = GebKonto.Bez
  801. tGebKto.Preis = AufGKon.Depot
  802. tGebKto.MWST_Cd = AufGKon.MWSt_Cd.
  803. END.
  804. tGebKto.A_Anz = tGebKto.A_Anz + AufGKon.Ausgang.
  805. tGebKto.A_Betrag = tGebKto.A_Anz * tGebKto.Preis.
  806. tGebKto.E_Anz = tGebKto.E_Anz + AufGKon.Eingang.
  807. tGebKto.E_Betrag = tGebKto.E_Anz * tGebKto.Preis.
  808. END.
  809. RELEASE AufGKon.
  810. /* Gebindelieferungen ------------------------------------------------ */
  811. nBetrag = 0.
  812. iArtZeile = 0.
  813. FOR EACH AufGKon NO-LOCK
  814. WHERE AufGKon.Firma = BAufko.Firma
  815. AND AufGKon.Aufnr = BAufko.Aufnr
  816. AND AufGKon.Depot <> 0
  817. AND (AufGKon.Eingang <> 0 OR
  818. AufGKon.Ausgang <> 0)
  819. BREAK BY AufgKon.Firma
  820. BY AufGKon.Aufnr:
  821. FIND GebKonto NO-LOCK
  822. WHERE GebKonto.Firma = cFirma
  823. AND GebKonto.Geb_Cd = AufGKon.Geb_Cd.
  824. i1 = AufGKon.Ausgang - AufGKon.Eingang.
  825. Rundbetr = AufGKon.Betrag.
  826. iMwstCd = AufGKon.MWSt_Cd.
  827. nBetrag = nBetrag + Rundbetr.
  828. iArtZeile = iArtZeile + 1.
  829. RUN VIPER_CREATE_DOKUMENT ( 'Gebindeabrechnung', iArtZeile, 'Gebindetext' , GebKonto.Bez ).
  830. RUN VIPER_CREATE_DOKUMENT ( 'Gebindeabrechnung', iArtZeile, 'GebindeGel' , TRIM(STRING(AufGKon.Ausgang,"->>,>>9")) ).
  831. RUN VIPER_CREATE_DOKUMENT ( 'Gebindeabrechnung', iArtZeile, 'GebindeRet' , TRIM(STRING(AufGKon.Eingang,"->>,>>9")) ).
  832. RUN VIPER_CREATE_DOKUMENT ( 'Gebindeabrechnung', iArtZeile, 'GebindeSaldo', TRIM(STRING(i1 ,"->>,>>9")) ).
  833. IF lPreis THEN
  834. RUN VIPER_CREATE_DOKUMENT ( 'Gebindeabrechnung', iArtZeile, 'GebindeBetr' , TRIM(STRING(Rundbetr ,"->>,>>9.999")) ).
  835. END.
  836. RELEASE AufGKon.
  837. RELEASE GebKonto.
  838. IF lPreis AND
  839. iArtZeile > 0 THEN
  840. RUN VIPER_CREATE_DOKUMENT ( 'Gebindeabrechnung', iArtZeile, 'GebindeTot' , TRIM(STRING(nBetrag ,"->>>,>>9.999")) ).
  841. nFakBetr = nFakBetr + nBetrag.
  842. IF iArtZeile > 0 THEN RUN AUSGABE_GRUPPE ('Gebindeabrechnung').
  843. END.
  844. /* ------ RUECKSTAENDE ---------------------------------------------------- */
  845. DO WHILE TRUE:
  846. FIND FIRST tRueckst NO-ERROR.
  847. IF NOT AVAILABLE tRueckst THEN LEAVE.
  848. iVPagePos = vpr_getPageVPos() + 150.
  849. IF iVPagePos > iMaxPos THEN
  850. DO:
  851. RUN VIPER_NEUE_SEITE.
  852. RUN DRUCKEN_ADRESSE.
  853. END.
  854. cText = 'Rückstände bitte neu bestellen'.
  855. iVPagePos = vpr_getPageVPos() + 50.
  856. RUN vpr_setGroupVPos ('Rueckstand', iVPagePos ).
  857. RUN vpr_setCellText ('RueckTitel', 'Rueckstand', cText ).
  858. RUN vpr_flushGroup ('Rueckstand').
  859. iArtZeile = 1.
  860. FOR EACH tRueckst:
  861. RUN DRUCKEN_RUECKSTAND ( RECID(tRueckst) ).
  862. END.
  863. RUN AUSGABE_ARTIKELZEILE.
  864. LEAVE.
  865. END.
  866. /* Gebinderücknahmetabelle ------------------------------------------- */
  867. iVPagePos = vpr_getPageVPos().
  868. iVGroupPos = vpr_getGroupVPos('Gebindetabelle').
  869. IF iVPagePos < iVGroupPos THEN RUN vpr_flushGroup('Gebindetabelle').
  870. ELSE
  871. DO:
  872. RUN VIPER_NEUE_SEITE.
  873. RUN DRUCKEN_ADRESSE.
  874. RUN vpr_flushGroup('Gebindetabelle').
  875. END.
  876. /* ------------------------------------------------------ */
  877. /* Druckausgabe */
  878. /* ------------------------------------------------------ */
  879. RUN vpr_EndDoc.
  880. cvpr_Dokument = SUBSTITUTE('Lieferscheine\&1-&2_&3.vpr',
  881. STRING(bAufko.Knr ,'999999'),
  882. STRING(bAufko.Aufnr,'9999999'),
  883. tParam.cDokument).
  884. RUN vpr_SaveDoc ( cvpr_Dokument ).
  885. DO WHILE tParam.lDokDruck:
  886. IF NOT tParam.lBatch THEN
  887. DO:
  888. SESSION:PRINTER-NAME = tParam.Drucker NO-ERROR.
  889. IF ERROR-STATUS:ERROR OR
  890. SESSION:PRINTER-NAME <> tParam.Drucker THEN
  891. DO:
  892. RUN vpr_printerDialog ( OUTPUT lJa ).
  893. IF NOT lJa THEN LEAVE.
  894. END.
  895. END.
  896. RUN vpr_printDoc (0, 0).
  897. LEAVE.
  898. END.
  899. IF tParam.lCreatePDF THEN
  900. DO:
  901. /* IF tParam.lBatch THEN RUN vpr_SetPrinterAttrib('copies=1').*/
  902. RUN vpr_SetPrinterAttrib('copies=1').
  903. cPDFName = REPLACE(cvpr_Dokument, '.vpr', '.pdf').
  904. RUN vpr_printPDF (0, 0, INPUT-OUTPUT cPDFName ).
  905. END.
  906. IF tParam.lOpenPDF THEN
  907. DO:
  908. DEFINE VARIABLE o-i AS i NO-UNDO.
  909. FILE-INFO:FILE-NAME = cPDFName.
  910. cPDFName = FILE-INFO:FULL-PATHNAME.
  911. RUN shellExecuteA (0,
  912. "open",
  913. cPDFName,
  914. "",
  915. "",
  916. 0,
  917. OUTPUT o-i).
  918. END.
  919. IF tParam.lSendMail THEN RUN SEND_MAIL ( cPDFName ).
  920. END PROCEDURE.
  921. /* _UIB-CODE-BLOCK-END */
  922. &ANALYZE-RESUME
  923. &ENDIF
  924. &IF DEFINED(EXCLUDE-DRUCKEN_ADRESSE) = 0 &THEN
  925. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN_ADRESSE Procedure
  926. PROCEDURE DRUCKEN_ADRESSE :
  927. /*------------------------------------------------------------------------------
  928. Purpose:
  929. Parameters: <none>
  930. Notes:
  931. ------------------------------------------------------------------------------*/
  932. DEFINE VARIABLE cZellen AS CHARACTER NO-UNDO.
  933. DEFINE VARIABLE cWerte AS CHARACTER NO-UNDO.
  934. FIND FIRST tParam.
  935. FIND FIRST tDokument
  936. WHERE tDokument.cGruppe = 'KOPF'
  937. AND tDokument.iZeile = 1
  938. AND tDokument.cFeld = 'Seite' NO-ERROR.
  939. IF NOT AVAILABLE tDokument THEN
  940. DO:
  941. CREATE tDokument.
  942. ASSIGN
  943. tDokument.cGruppe = 'KOPF'
  944. tDokument.iZeile = 1
  945. tDokument.cFeld = 'Seite'.
  946. END.
  947. tDokument.cInhalt = STRING(iSeite,'z9').
  948. cZellen = ''.
  949. cWerte = ''.
  950. FOR EACH tDokument
  951. WHERE tDokument.cGruppe = 'Kopf'
  952. BREAK BY tDokument.cGruppe
  953. BY tDokument.cFeld:
  954. cWerte = cWerte
  955. + tDokument.cInhalt.
  956. cZellen = cZellen
  957. + tDokument.cFeld.
  958. IF NOT LAST-OF ( tDokument.cGruppe ) THEN ASSIGN cWerte = cWerte + CHR(01)
  959. cZellen = cZellen + ','.
  960. END.
  961. RUN vpr_SetDelimiter (CHR(01)).
  962. RUN vpr_setGroupText ('Kopf', cZellen, cWerte).
  963. RUN vpr_FlushGroup ('Kopf').
  964. IF iSeite = 1 THEN
  965. DO:
  966. cZellen = ''.
  967. cWerte = ''.
  968. FOR EACH tDokument
  969. WHERE tDokument.cGruppe = 'KopfDetail'
  970. BREAK BY tDokument.cGruppe
  971. BY tDokument.cFeld:
  972. cWerte = cWerte
  973. + tDokument.cInhalt.
  974. cZellen = cZellen
  975. + tDokument.cFeld.
  976. IF NOT LAST-OF ( tDokument.cGruppe ) THEN ASSIGN cWerte = cWerte + CHR(01)
  977. cZellen = cZellen + ','.
  978. END.
  979. RUN vpr_SetDelimiter (CHR(01)).
  980. RUN vpr_setGroupText ('KopfDetail', cZellen, cWerte).
  981. RUN vpr_FlushGroup ('KopfDetail').
  982. END.
  983. RUN vpr_FlushGroup ('Fusstext').
  984. RUN vpr_FlushGroup ('Ueberschrift').
  985. END PROCEDURE.
  986. /* _UIB-CODE-BLOCK-END */
  987. &ANALYZE-RESUME
  988. &ENDIF
  989. &IF DEFINED(EXCLUDE-DRUCKEN_KOPF) = 0 &THEN
  990. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN_KOPF Procedure
  991. PROCEDURE DRUCKEN_KOPF :
  992. /*------------------------------------------------------------------------------
  993. Purpose:
  994. Parameters: <none>
  995. Notes:
  996. ------------------------------------------------------------------------------*/
  997. DEFINE VARIABLE cText AS CHARACTER NO-UNDO.
  998. DEFINE VARIABLE ii AS INTEGER NO-UNDO.
  999. DEFINE VARIABLE i1 AS INTEGER NO-UNDO.
  1000. FIND FIRST tParam.
  1001. RUN VIPER_NEUE_SEITE.
  1002. IF iSeite = 1 THEN
  1003. DO:
  1004. iFaknr = tParam.iAufnr.
  1005. cBesrKopf = ''.
  1006. IF bAufko.Adresse[05] <> '' THEN
  1007. DO:
  1008. i1 = 6.
  1009. DO ii = 1 TO 5:
  1010. CREATE tDokument.
  1011. ASSIGN
  1012. tDokument.cGruppe = 'KOPF'
  1013. tDokument.iZeile = 1
  1014. tDokument.cFeld = 'Adresse_' + STRING((6 + ii),'99')
  1015. tDokument.cInhalt = bAufko.Adresse[ii].
  1016. i1 = i1 + 1.
  1017. cBesrKopf[i1] = bAufko.Adresse[ii].
  1018. END.
  1019. END.
  1020. ELSE
  1021. DO:
  1022. DO ii = 5 TO 11:
  1023. CREATE tDokument.
  1024. ASSIGN
  1025. tDokument.cGruppe = 'KOPF'
  1026. tDokument.iZeile = 1
  1027. tDokument.cFeld = 'Adresse_' + STRING(ii,'99')
  1028. tDokument.cInhalt = bAdresse.Anschrift[ii].
  1029. cBesrKopf[ii] = bAdresse.Anschrift[ii].
  1030. END.
  1031. END.
  1032. CREATE tDokument.
  1033. ASSIGN
  1034. tDokument.cGruppe = 'KOPF'
  1035. tDokument.iZeile = 1
  1036. tDokument.cFeld = 'Ort_Datum'
  1037. tDokument.cInhalt = TRIM(SUBSTRING(cFormText[07],01,20))
  1038. + " "
  1039. + STRING(TODAY,"99.99.9999").
  1040. CREATE tDokument.
  1041. ASSIGN
  1042. tDokument.cGruppe = 'KOPF'
  1043. tDokument.iZeile = 1
  1044. tDokument.cFeld = 'T_Dokument'
  1045. tDokument.cInhalt = (IF bAufko.Auf_Tot >= 0
  1046. THEN TRIM(SUBSTRING(cFormText[02],01,20))
  1047. ELSE TRIM(SUBSTRING(cFormText[02],21,20))).
  1048. CREATE tDokument.
  1049. ASSIGN
  1050. tDokument.cGruppe = 'KOPF'
  1051. tDokument.iZeile = 1
  1052. tDokument.cFeld = 'Aufnr'
  1053. tDokument.cInhalt = STRING(iFaknr,'z999999').
  1054. FIND FIRST tTabTexte WHERE tTabTexte.cRecArt = 'WISO' NO-ERROR.
  1055. CREATE tDokument.
  1056. ASSIGN
  1057. tDokument.cGruppe = 'KOPFDETAIL'
  1058. tDokument.iZeile = 1
  1059. tDokument.cFeld = 'Wirtesonntag'
  1060. tDokument.cInhalt = (IF AVAILABLE tTabTexte THEN tTabTexte.cFeld3 ELSE ' ').
  1061. FIND FIRST tTabTexte WHERE tTabTexte.cRecArt = 'ABLAD' NO-ERROR.
  1062. CREATE tDokument.
  1063. ASSIGN
  1064. tDokument.cGruppe = 'KOPFDETAIL'
  1065. tDokument.iZeile = 1
  1066. tDokument.cFeld = 'Ablade'
  1067. tDokument.cInhalt = (IF AVAILABLE tTabTexte THEN tTabTexte.cFeld3 ELSE ' ').
  1068. FIND FIRST tTabTexte WHERE tTabTexte.cRecArt = 'FAHRER' NO-ERROR.
  1069. CREATE tDokument.
  1070. ASSIGN
  1071. tDokument.cGruppe = 'KOPFDETAIL'
  1072. tDokument.iZeile = 1
  1073. tDokument.cFeld = 'Chauffeur'
  1074. tDokument.cInhalt = (IF AVAILABLE tTabTexte THEN tTabTexte.cFeld1 ELSE ' ').
  1075. CREATE tDokument.
  1076. ASSIGN
  1077. tDokument.cGruppe = 'KOPFDETAIL'
  1078. tDokument.iZeile = 1
  1079. tDokument.cFeld = 'Auf_Datum'
  1080. tDokument.cInhalt = STRING(bAufko.Auf_Datum,'99.99.9999').
  1081. CREATE tDokument.
  1082. ASSIGN
  1083. tDokument.cGruppe = 'KOPFDETAIL'
  1084. tDokument.iZeile = 1
  1085. tDokument.cFeld = 'Lief_Datum'
  1086. tDokument.cInhalt = STRING(bAufko.Lief_Datum,'99.99.9999').
  1087. CREATE tDokument.
  1088. ASSIGN
  1089. tDokument.cGruppe = 'KOPFDETAIL'
  1090. tDokument.iZeile = 1
  1091. tDokument.cFeld = 'U_Ref'
  1092. tDokument.cInhalt = bAufko.U_Ref.
  1093. CREATE tDokument.
  1094. ASSIGN
  1095. tDokument.cGruppe = 'KOPFDETAIL'
  1096. tDokument.iZeile = 1
  1097. tDokument.cFeld = 'Knr'
  1098. tDokument.cInhalt = STRING(bAufko.Knr,'999999').
  1099. cText = ''.
  1100. cText = (IF bAdresse.Tel-1 <> '' THEN bAdresse.Tel-1 ELSE bAdresse.Tel-2).
  1101. IF bAdresse.Natel <> '' THEN cText = cText
  1102. + (IF cText = '' THEN '' ELSE ' / ')
  1103. + bAdresse.Natel.
  1104. CREATE tDokument.
  1105. ASSIGN
  1106. tDokument.cGruppe = 'KOPFDETAIL'
  1107. tDokument.iZeile = 1
  1108. tDokument.cFeld = 'Telefon'
  1109. tDokument.cInhalt = cText.
  1110. CREATE tDokument.
  1111. ASSIGN
  1112. tDokument.cGruppe = 'KOPFDETAIL'
  1113. tDokument.iZeile = 1
  1114. tDokument.cFeld = 'Gewicht'
  1115. tDokument.cInhalt = TRIM(STRING(bAufko.Gewicht,'->>>,>>9.999')).
  1116. END.
  1117. RUN DRUCKEN_ADRESSE.
  1118. IF iSeite <> 1 THEN RETURN.
  1119. cText = bAufko.Abh_Text
  1120. + (IF bAufko.Abh_Text <> '' THEN CHR(10) + CHR(10) ELSE '')
  1121. + bAufko.Auf_Text.
  1122. IF cText = '' THEN RETURN.
  1123. iVPagePos = vpr_getPageVPos() + 20.
  1124. RUN vpr_setGroupVPos ( 'Zusatztext' , iVPagePos ).
  1125. RUN vpr_setCellText ( 'Bemerkung_1', 'Zusatztext', cText ).
  1126. RUN vpr_flushGroup ( 'Zusatztext' ).
  1127. END PROCEDURE.
  1128. /* _UIB-CODE-BLOCK-END */
  1129. &ANALYZE-RESUME
  1130. &ENDIF
  1131. &IF DEFINED(EXCLUDE-DRUCKEN_RUECKSTAND) = 0 &THEN
  1132. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN_RUECKSTAND Procedure
  1133. PROCEDURE DRUCKEN_RUECKSTAND :
  1134. /*------------------------------------------------------------------------------
  1135. Purpose:
  1136. Parameters: <none>
  1137. Notes:
  1138. ------------------------------------------------------------------------------*/
  1139. DEFINE INPUT PARAMETER ipRecid AS RECID NO-UNDO.
  1140. DEFINE VARIABLE cString AS CHARACTER NO-UNDO.
  1141. FIND tRueckst WHERE RECID(tRueckst) = ipRecid NO-LOCK.
  1142. FIND Aufze WHERE RECID(Aufze) = tRueckst.Zeile NO-LOCK.
  1143. iArtZeile = iArtZeile + 1.
  1144. DO WHILE Aufze.Artnr = 0:
  1145. CREATE tDokument.
  1146. ASSIGN
  1147. tDokument.cGruppe = 'ArtikelZeile1'
  1148. tDokument.iZeile = iArtZeile
  1149. tDokument.cFeld = 'Bez1'
  1150. tDokument.cInhalt = Aufze.Bez1.
  1151. IF Aufze.Bez2 <> '' THEN
  1152. DO:
  1153. iArtZeile = iArtZeile + 1.
  1154. CREATE tDokument.
  1155. ASSIGN
  1156. tDokument.cGruppe = 'ArtikelZeile1'
  1157. tDokument.iZeile = iArtZeile
  1158. tDokument.cFeld = 'Bez1'
  1159. tDokument.cInhalt = Aufze.Bez2.
  1160. END.
  1161. RETURN.
  1162. END.
  1163. FIND Artst OF Aufze NO-LOCK.
  1164. FIND VGebinde NO-LOCK
  1165. WHERE VGebinde.Firma = cFirma
  1166. AND VGebinde.Geb_Cd = Aufze.VGeb_Cd NO-ERROR.
  1167. FIND KGebinde NO-LOCK
  1168. WHERE KGebinde.Firma = cFirma
  1169. AND KGebinde.Geb_Cd = Aufze.KGeb_Cd NO-ERROR.
  1170. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'KGebinde', KGebinde.Kbez ).
  1171. IF Aufze.VGeb_Ru <> 0 THEN
  1172. DO:
  1173. cString = STRING(Aufze.VGeb_Ru,'->>>>')
  1174. + 'x '
  1175. + VGebinde.KBez.
  1176. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'VGebinde', cString ).
  1177. END.
  1178. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Menge', STRING(Aufze.MRuek,'->>,>>9') ).
  1179. cString = Aufze.Bez1.
  1180. IF Aufze.Bez2 <> '' THEN cString = cString
  1181. + (IF cString = '' THEN '' ELSE CHR(10))
  1182. + Aufze.Bez2.
  1183. IF Aufze.Aktion THEN cString = cString
  1184. + (IF cString = '' THEN '' ELSE CHR(10))
  1185. + Aufze.Aktion_Text.
  1186. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', cString ).
  1187. IF Aufze.Jahr > 9 THEN
  1188. DO:
  1189. cString = STRING(Aufze.Jahr,"9999").
  1190. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'JG', cString ).
  1191. END.
  1192. IF Aufze.Alk_Gehalt <> 0 THEN
  1193. DO:
  1194. cString = STRING(Aufze.Alk_Gehalt,"zz9.9%").
  1195. RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Alk%', cString ).
  1196. END.
  1197. RUN AUSGABE_GRUPPE ( 'ArtikelZeile1' ).
  1198. RELEASE Aufze .
  1199. RELEASE Artst .
  1200. RELEASE VGebinde.
  1201. RELEASE KGebinde.
  1202. END PROCEDURE.
  1203. /* _UIB-CODE-BLOCK-END */
  1204. &ANALYZE-RESUME
  1205. &ENDIF
  1206. &IF DEFINED(EXCLUDE-FUELLEN_tAufze) = 0 &THEN
  1207. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE FUELLEN_tAufze Procedure
  1208. PROCEDURE FUELLEN_tAufze :
  1209. /*------------------------------------------------------------------------------
  1210. Purpose:
  1211. Parameters: <none>
  1212. Notes:
  1213. ------------------------------------------------------------------------------*/
  1214. DEFINE INPUT PARAMETER ipAufnr AS INTEGER NO-UNDO.
  1215. DEFINE VARIABLE minPos AS INTEGER NO-UNDO.
  1216. DEFINE VARIABLE maxPos AS INTEGER NO-UNDO.
  1217. DEFINE VARIABLE jPlatz AS INTEGER NO-UNDO.
  1218. DEFINE VARIABLE cLagOrt AS CHARACTER NO-UNDO.
  1219. DEFINE VARIABLE iRuestArt AS INTEGER NO-UNDO.
  1220. DEFINE VARIABLE iPlusMinus AS INTEGER NO-UNDO.
  1221. DEFINE VARIABLE lArtikel AS LOG NO-UNDO.
  1222. EMPTY TEMP-TABLE tAufze.
  1223. FIND Steuer NO-LOCK
  1224. WHERE Steuer.Firma = cFirma NO-ERROR.
  1225. IF AVAILABLE Steuer THEN iRuestArt = Steuer.RuestArt.
  1226. ASSIGN
  1227. minPos = 0
  1228. maxPos = 9999
  1229. iPlusMinus = 0.
  1230. /* Kommentar zu Beginn eines Auftrages */
  1231. lArtikel = FALSE.
  1232. FOR EACH Aufze NO-LOCK
  1233. WHERE Aufze.Firma = cFirma
  1234. AND Aufze.Aufnr = ipAufnr
  1235. AND Aufze.Pos > minPos:
  1236. IF Aufze.Artnr > 0 THEN
  1237. DO:
  1238. lArtikel = TRUE.
  1239. LEAVE.
  1240. END.
  1241. minPos = Aufze.Pos.
  1242. CREATE tAufze.
  1243. ASSIGN
  1244. tAufze.Aufnr = Aufze.Aufnr
  1245. tAufze.Artnr = Aufze.Artnr
  1246. tAufze.Inhalt = Aufze.Inhalt
  1247. tAufze.Jahr = Aufze.Jahr
  1248. tAufze.Pos = Aufze.Pos
  1249. tAufze.Zeile = RECID(Aufze)
  1250. tAufze.Aktion = Aufze.Aktion
  1251. tAufze.Preis = Aufze.Preis
  1252. tAufze.MGeli = Aufze.MGeli
  1253. tAufze.MRuek = Aufze.MRuek.
  1254. ASSIGN
  1255. tAufze.Sort1 = STRING(0,'99')
  1256. tAufze.Sort2 = ''
  1257. tAufze.Sort3 = STRING(tAufze.Artnr ,'999999')
  1258. + STRING(tAufze.Inhalt,'9999')
  1259. + STRING(tAufze.Jahr ,'9999')
  1260. + STRING(iPlusMinus ,'9')
  1261. + STRING(tAufze.Pos ,'99999').
  1262. tAufze.LagOrt = ''.
  1263. END.
  1264. /* Kommentar am Ende eines Auftrages */
  1265. IF lArtikel THEN
  1266. DO:
  1267. FOR EACH Aufze NO-LOCK
  1268. WHERE Aufze.Firma = cFirma
  1269. AND Aufze.Aufnr = ipAufnr
  1270. BY Aufze.Pos DESCENDING:
  1271. IF Aufze.Artnr > 0 THEN LEAVE.
  1272. maxPos = Aufze.Pos.
  1273. CREATE tAufze.
  1274. ASSIGN
  1275. tAufze.Aufnr = Aufze.Aufnr
  1276. tAufze.Artnr = Aufze.Artnr
  1277. tAufze.Inhalt = Aufze.Inhalt
  1278. tAufze.Jahr = Aufze.Jahr
  1279. tAufze.Pos = Aufze.Pos
  1280. tAufze.Zeile = RECID(Aufze)
  1281. tAufze.Aktion = Aufze.Aktion
  1282. tAufze.Preis = Aufze.Preis
  1283. tAufze.MGeli = Aufze.MGeli
  1284. tAufze.MRuek = Aufze.MRuek.
  1285. ASSIGN
  1286. tAufze.Sort1 = STRING(0,'99')
  1287. tAufze.Sort2 = ''
  1288. tAufze.Sort3 = STRING(tAufze.Artnr ,'999999')
  1289. + STRING(tAufze.Inhalt,'9999')
  1290. + STRING(tAufze.Jahr ,'9999')
  1291. + STRING(iPlusMinus ,'9')
  1292. + STRING(tAufze.Pos ,'99999').
  1293. tAufze.LagOrt = ''.
  1294. END.
  1295. END.
  1296. /* Artikelzeilen nach Ruestplatz und Ort */
  1297. cLagOrt = ''.
  1298. FOR EACH Aufze NO-LOCK
  1299. WHERE Aufze.Firma = cFirma
  1300. AND Aufze.Aufnr = ipAufnr
  1301. AND Aufze.Pos > minPos
  1302. AND Aufze.Pos < MaxPos
  1303. BY Aufze.Pos DESCENDING:
  1304. IF Aufze.Artnr > 0 THEN
  1305. DO:
  1306. FIND ArtLager NO-LOCK
  1307. WHERE ArtLager.Firma = Aufze.Firma
  1308. AND ArtLager.Artnr = Aufze.Artnr
  1309. AND ArtLager.Inhalt = Aufze.Inhalt
  1310. AND ArtLager.Jahr = Aufze.Jahr
  1311. AND ArtLager.Lager = Aufze.Lager.
  1312. cLagOrt = ArtLager.Ort.
  1313. END.
  1314. iPlusMinus = (IF Aufze.MGeli < 0 THEN 1 ELSE 0).
  1315. FIND LAST RuestPlatz USE-INDEX RuestPlatz-k2
  1316. WHERE RuestPlatz.Firma = Aufze.Firma
  1317. AND RuestPlatz.RuestArt = iRuestArt
  1318. AND RuestPlatz.abLagOrt <= cLagOrt NO-ERROR.
  1319. IF NOT AVAILABLE RuestPlatz THEN jPlatz = 90.
  1320. ELSE jPlatz = RuestPlatz.Platz.
  1321. CREATE tAufze.
  1322. ASSIGN
  1323. tAufze.Aufnr = Aufze.Aufnr
  1324. tAufze.Artnr = Aufze.Artnr
  1325. tAufze.Inhalt = Aufze.Inhalt
  1326. tAufze.Jahr = Aufze.Jahr
  1327. tAufze.Pos = Aufze.Pos
  1328. tAufze.Zeile = RECID(Aufze)
  1329. tAufze.Aktion = Aufze.Aktion
  1330. tAufze.Preis = Aufze.Preis
  1331. tAufze.MGeli = Aufze.MGeli
  1332. tAufze.MRuek = Aufze.MRuek.
  1333. ASSIGN
  1334. tAufze.Sort1 = STRING(jPlatz,'99')
  1335. tAufze.Sort2 = cLagOrt
  1336. tAufze.Sort3 = STRING(tAufze.Artnr ,'999999')
  1337. + STRING(tAufze.Inhalt,'9999')
  1338. + STRING(tAufze.Jahr ,'9999')
  1339. + STRING(iPlusMinus ,'9')
  1340. + STRING(tAufze.Pos ,'99999').
  1341. tAufze.LagOrt = cLagort.
  1342. IF tAufze.MRuek > 0 THEN
  1343. DO:
  1344. CREATE tRueckst.
  1345. BUFFER-COPY tAufze
  1346. TO tRueckst
  1347. ASSIGN
  1348. tRueckst.Zeile = RECID(Aufze).
  1349. END.
  1350. IF tAufze.Artnr > 0 AND
  1351. tAufze.MGeli = 0 THEN DELETE tAufze.
  1352. END.
  1353. END PROCEDURE.
  1354. /* _UIB-CODE-BLOCK-END */
  1355. &ANALYZE-RESUME
  1356. &ENDIF
  1357. &IF DEFINED(EXCLUDE-SEND_MAIL) = 0 &THEN
  1358. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE SEND_MAIL Procedure
  1359. PROCEDURE SEND_MAIL :
  1360. /*------------------------------------------------------------------------------
  1361. Purpose:
  1362. Parameters: <none>
  1363. Notes:
  1364. ------------------------------------------------------------------------------*/
  1365. DEFINE INPUT PARAMETER ipAttachment AS CHARACTER NO-UNDO.
  1366. FIND FIRST tParam.
  1367. DEFINE VARIABLE cTo AS CHARACTER NO-UNDO.
  1368. DEFINE VARIABLE cCc AS CHARACTER NO-UNDO.
  1369. DEFINE VARIABLE lRetValue AS LOG NO-UNDO.
  1370. DEFINE VARIABLE cMeldung AS CHARACTER NO-UNDO.
  1371. DEFINE VARIABLE cSubject AS CHARACTER NO-UNDO.
  1372. DEFINE VARIABLE cBody AS CHARACTER NO-UNDO.
  1373. DEFINE VARIABLE cQuittung AS CHARACTER NO-UNDO.
  1374. DEFINE VARIABLE cName AS CHARACTER NO-UNDO.
  1375. DEFINE VARIABLE ii AS INTEGER NO-UNDO.
  1376. DEFINE VARIABLE iInd AS INTEGER NO-UNDO.
  1377. DEFINE VARIABLE cNamen AS CHARACTER NO-UNDO.
  1378. FIND FIRST tParam.
  1379. FIND Adresse NO-LOCK
  1380. WHERE Adresse.Firma = AdFirma
  1381. AND Adresse.Knr = tParam.iKnr NO-ERROR.
  1382. cTo = Adresse.Mail.
  1383. cCc = 'wr@adprime.ch'.
  1384. IF cTo = '' THEN RETURN.
  1385. IF INDEX(cTo, '@') = 0 THEN RETURN.
  1386. cSubject = SUBSTITUTE('Lieferschein &1 vom &2', tParam.iAufnr, STRING(TODAY,'99.99.9999') ).
  1387. cBody = SUBSTITUTE('Im Anhang den Lieferschein/die Rechnung von der Lieferung vom &1 ', STRING(TODAY,'99.99.9999') ).
  1388. cQuittung = SUBSTITUTE('&1&2-&3-Quittung.pdf', cPathQuittung, STRING(tParam.iKnr,'999999'), STRING(tParam.iAufnr,'9999999')).
  1389. FILE-INFO:FILE-NAME = cQuittung.
  1390. cQuittung = FILE-INFO:FULL-PATHNAME NO-ERROR.
  1391. IF cQuittung = ? THEN cQuittung = ''.
  1392. IF cQuittung <> '' THEN
  1393. DO:
  1394. ipAttachment = ipAttachment
  1395. + (IF ipAttachment = '' THEN '' ELSE ';')
  1396. + cQuittung.
  1397. END.
  1398. DO ii = 1 TO NUM-ENTRIES(ipAttachment, ';'):
  1399. cName = ENTRY(ii, ipAttachment, ';').
  1400. cName = REPLACE(cName, '\', '/').
  1401. IF R-INDEX(cName, '/') > 0 THEN cName = SUBSTRING(cName, R-INDEX(cName, '/') + 1).
  1402. cNamen = cNamen
  1403. + (IF cNamen = '' THEN '' ELSE ';')
  1404. + cName.
  1405. END.
  1406. EMPTY TEMP-TABLE ttSendMail.
  1407. CREATE ttSendMail.
  1408. ASSIGN
  1409. ttSendMail.cFrom = cMailFromFreigabe
  1410. ttSendMail.cTo = cTo
  1411. ttSendMail.cCC = cCC /* cMailCCFreigabe*/
  1412. ttSendMail.cSubject = cSubject
  1413. ttSendMail.cBody = cBody
  1414. ttSendMail.cAttachedName = cNamen
  1415. ttSendMail.cAttachedFile = ipAttachment
  1416. ttSendMail.cMailServer = cMailServer
  1417. ttSendMail.cMailPort = cMailPort
  1418. ttSendMail.cMailKonto = cMailKonto
  1419. ttSendMail.cMailPassw = cMailPassw
  1420. ttSendMail.cDomaine = cMailDomaine
  1421. ttsendmail.lAuth = lMailAuth
  1422. ttSendMail.lSSLEnabled = lSSLEnabled.
  1423. RUN sendsmtpmail.p ( httSendMail, OUTPUT cMeldung, OUTPUT lRetValue ).
  1424. RETURN cMeldung.
  1425. END PROCEDURE.
  1426. /* _UIB-CODE-BLOCK-END */
  1427. &ANALYZE-RESUME
  1428. &ENDIF
  1429. &IF DEFINED(EXCLUDE-VIPER_CREATE_DOKUMENT) = 0 &THEN
  1430. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE VIPER_CREATE_DOKUMENT Procedure
  1431. PROCEDURE VIPER_CREATE_DOKUMENT :
  1432. /*------------------------------------------------------------------------------
  1433. Purpose:
  1434. Parameters: <none>
  1435. Notes:
  1436. ------------------------------------------------------------------------------*/
  1437. DEFINE INPUT PARAMETER ipGruppe AS CHARACTER NO-UNDO.
  1438. DEFINE INPUT PARAMETER ipZeile AS INTEGER NO-UNDO.
  1439. DEFINE INPUT PARAMETER ipFeld AS CHARACTER NO-UNDO.
  1440. DEFINE INPUT PARAMETER ipInhalt AS CHARACTER NO-UNDO.
  1441. CREATE tDokument.
  1442. ASSIGN
  1443. tDokument.cGruppe = ipGruppe
  1444. tDokument.iZeile = ipZeile
  1445. tDokument.cFeld = ipFeld
  1446. tDokument.cInhalt = ipInhalt.
  1447. END PROCEDURE.
  1448. /* _UIB-CODE-BLOCK-END */
  1449. &ANALYZE-RESUME
  1450. &ENDIF
  1451. &IF DEFINED(EXCLUDE-VIPER_INIT) = 0 &THEN
  1452. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE VIPER_INIT Procedure
  1453. PROCEDURE VIPER_INIT :
  1454. /*------------------------------------------------------------------------------
  1455. Purpose:
  1456. Parameters: <none>
  1457. Notes:
  1458. ------------------------------------------------------------------------------*/
  1459. DEFINE VARIABLE cTemplate AS CHARACTER NO-UNDO.
  1460. DEFINE VARIABLE cDokument AS CHARACTER NO-UNDO.
  1461. DEFINE VARIABLE cZellen AS CHARACTER NO-UNDO.
  1462. DEFINE VARIABLE cZelle AS CHARACTER NO-UNDO.
  1463. DEFINE VARIABLE cGruppe AS CHARACTER NO-UNDO.
  1464. DEFINE VARIABLE ii AS INTEGER NO-UNDO.
  1465. DEFINE VARIABLE cString AS CHARACTER NO-UNDO.
  1466. FIND FIRST tParam.
  1467. IF iLauf = 1 THEN
  1468. DO:
  1469. cTemplate = tParam.cInstall + '/' + tParam.cDokument + '.vfr'.
  1470. RUN vpr_LoadVFR (cTemplate).
  1471. RUN vpr_ActivateReport (tParam.cDokument).
  1472. RUN vpr_SelectPrinter (tParam.Drucker).
  1473. RUN vpr_setPrinterAttrib('duplex=1').
  1474. /* cString = SUBSTITUTE('copies=&1', tParam.Anzahl). */
  1475. /* IF tParam.lBatch THEN RUN vpr_SetPrinterAttrib('copies=1').*/
  1476. /* ELSE RUN vpr_SetPrinterAttrib('copies=2').*/
  1477. RUN vpr_SetPrinterAttrib('copies=2').
  1478. RUN vpr_ResetDoc.
  1479. RUN vpr_SetDocAttrib ('PAPERSIZE=A4').
  1480. RUN vpr_SetPreviewMode ('Direct').
  1481. RUN vpr_setDocTitle (tParam.cDokument).
  1482. IF tParam.Schacht_Original > 0 THEN RUN vpr_SetCurrentPageProperties ( "Papertray", tParam.Schacht_Original ).
  1483. END.
  1484. ELSE
  1485. DO:
  1486. RUN vpr_NewPage.
  1487. IF tParam.Schacht_Kopie > 0 THEN RUN vpr_SetCurrentPageProperties ( "Papertray", tParam.Schacht_Kopie ).
  1488. END.
  1489. RUN vpr_InitGroups("").
  1490. RUN vpr_InitGraphObj.
  1491. RUN vpr_SetGroupAttrib ("Kopf" , "Fixed=true").
  1492. RUN vpr_SetGroupAttrib ("Fusstext" , "Fixed=true").
  1493. RUN vpr_SetGroupAttrib ("Kondition", "Fixed=true").
  1494. iMaxPos = 2650.
  1495. END PROCEDURE.
  1496. /* _UIB-CODE-BLOCK-END */
  1497. &ANALYZE-RESUME
  1498. &ENDIF
  1499. &IF DEFINED(EXCLUDE-VIPER_NEUE_SEITE) = 0 &THEN
  1500. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE VIPER_NEUE_SEITE Procedure
  1501. PROCEDURE VIPER_NEUE_SEITE :
  1502. /*------------------------------------------------------------------------------
  1503. Purpose:
  1504. Parameters: <none>
  1505. Notes:
  1506. ------------------------------------------------------------------------------*/
  1507. DEFINE VARIABLE iPos AS INTEGER NO-UNDO.
  1508. FIND FIRST tParam.
  1509. DO WHILE TRUE:
  1510. IF iSeite = 0 THEN
  1511. DO:
  1512. RUN vpr_InitGroups('').
  1513. IF iLauf = iAnzDok THEN RUN vpr_initGraphObj.
  1514. iSeite = iSeite + 1.
  1515. LEAVE.
  1516. END.
  1517. RUN vpr_NewPage.
  1518. RUN vpr_InitGroups('').
  1519. IF iLauf = 1 THEN RUN vpr_SetCurrentPageProperties ( "Papertray", tParam.Schacht_Original ).
  1520. ELSE RUN vpr_SetCurrentPageProperties ( "Papertray", tParam.Schacht_Kopie ).
  1521. RUN vpr_initGraphObj.
  1522. iSeite = iSeite + 1.
  1523. LEAVE.
  1524. END.
  1525. END PROCEDURE.
  1526. /* _UIB-CODE-BLOCK-END */
  1527. &ANALYZE-RESUME
  1528. &ENDIF
  1529. /* ************************ Function Implementations ***************** */
  1530. &IF DEFINED(EXCLUDE-generateLSMail) = 0 &THEN
  1531. &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION generateLSMail Procedure
  1532. FUNCTION generateLSMail RETURNS LOGICAL
  1533. ( iprsAufko AS RECID ):
  1534. /*------------------------------------------------------------------------------
  1535. Purpose:
  1536. Notes:
  1537. ------------------------------------------------------------------------------*/
  1538. DEFINE BUFFER bsAufko FOR sAufko.
  1539. DEFINE BUFFER mAdresse FOR Adresse.
  1540. DEFINE BUFFER mDebst FOR Debst.
  1541. FIND bsAufko WHERE RECID(bsAufko) = iprsAufko.
  1542. END FUNCTION.
  1543. /* _UIB-CODE-BLOCK-END */
  1544. &ANALYZE-RESUME
  1545. &ENDIF