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