Sav_Faktura.p 79 KB

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