Lieferschein.p 59 KB

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