LieferFak.p 83 KB

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