Sav_LieferFak.p 84 KB

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