Faktura.p 80 KB

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