| 1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317 |
- &ANALYZE-SUSPEND _VERSION-NUMBER AB_v10r12
- &ANALYZE-RESUME
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _DEFINITIONS Procedure
- /*------------------------------------------------------------------------
- File :
- Purpose :
- Syntax :
- Description :
- Author(s) :
- Created :
- Notes :
- ----------------------------------------------------------------------*/
- /* This .W file was created with the Progress AppBuilder. */
- /*----------------------------------------------------------------------*/
- /* *************************** Definitions ************************** */
- DEF INPUT PARAMETER iphParam AS HANDLE NO-UNDO.
- DEF OUTPUT PARAMETER opcResult AS CHAR NO-UNDO.
- DEF VAR iSeite AS INT NO-UNDO.
- DEF VAR iAnzDok AS INT NO-UNDO.
- DEF VAR iLauf AS INT NO-UNDO.
- DEF VAR lFirst AS LOG INIT FALSE NO-UNDO.
- DEF VAR lLast AS LOG INIT FALSE NO-UNDO.
- DEF VAR lPreis AS LOG NO-UNDO.
- DEF VAR cFirma AS CHAR NO-UNDO.
- DEF VAR AdFirma AS CHAR NO-UNDO.
- DEF VAR nFakBetr AS DEC NO-UNDO.
- DEF VAR dFakDatum AS DATE NO-UNDO.
- DEF VAR iFaknr AS INT NO-UNDO.
- DEF VAR iSprcd AS INT NO-UNDO.
- DEF VAR nTotale AS DEC EXTENT 15 NO-UNDO.
- DEF VAR cFormtext AS CHAR EXTENT 30 NO-UNDO.
- DEF VAR cRabText AS CHAR NO-UNDO.
- DEF VAR cZusText AS CHAR NO-UNDO.
- DEF VAR cEpzText AS CHAR NO-UNDO.
- DEF VAR cBesrKopf AS CHAR EXTENT 12 NO-UNDO.
- DEF VAR lDebIncl AS LOG NO-UNDO.
- DEF VAR Rundbetr AS DEC DECIMALS 4 NO-UNDO.
- DEF VAR RundCode AS INT INIT 1 NO-UNDO.
- DEF VAR htTabTexte AS HANDLE NO-UNDO.
- DEF VAR hSavko AS HANDLE NO-UNDO.
- DEF VAR cInstallation AS CHAR NO-UNDO.
- DEF VAR iBesrArt AS INT NO-UNDO.
- DEF VAR iMaxPos AS INT INIT 2650 NO-UNDO.
- DEF VAR cvpr_Dokument AS CHAR NO-UNDO.
- DEF VAR iArtZeile AS INT NO-UNDO.
- DEF VAR iVPagePos AS INT NO-UNDO.
- DEF VAR iVGroupPos AS INT NO-UNDO.
- DEF BUFFER bSavko FOR Savko .
- DEF BUFFER bSavze FOR Savze .
- DEF BUFFER FDebst FOR Debst . /* Fakturaadresse */
- DEF BUFFER LDebst FOR Debst . /* Lieferadresse */
- DEF BUFFER LAdresse FOR Adresse .
- DEF BUFFER bAdresse FOR Adresse .
- DEF BUFFER bWust FOR Wust .
- DEF BUFFER bSteuer FOR Steuer .
- { incl/properties.i }
- { incl/ttdruckparam.i }
- { swissqr/propertiesSwissQR.i }
- DEF TEMP-TABLE tDokument
- FIELD cGruppe AS CHAR
- FIELD iZeile AS INT
- FIELD cFeld AS CHAR
- FIELD cInhalt AS CHAR
-
- INDEX tDokument-k1 IS PRIMARY
- cGruppe
- iZeile
- cFeld
- .
- DEF TEMP-TABLE tTotale
- FIELD nMwstPfl AS DEC EXTENT 12
- FIELD nMwstBet AS DEC EXTENT 12
- FIELD nSammTot AS DEC
- FIELD nSkBer AS DEC
- FIELD nWW AS DEC
- .
- DEF TEMP-TABLE sSavko
- FIELD cFirma AS CHAR
- FIELD iAufnr AS INT
- FIELD iFak_Knr AS INT
- FIELD iKnr AS INT
- FIELD iSamm_Nr AS INT
- FIELD iRecid AS RECID
- FIELD iFaknr AS INT
- FIELD dFakDat AS DATE
- .
- DEF TEMP-TABLE tSavko LIKE Savko
- FIELD iRecid AS RECID
- FIELD lBetrag AS LOGICAL
- .
- DEF TEMP-TABLE tAufko LIKE Savko
- FIELD iRecid AS RECID
- FIELD lBetrag AS LOGICAL
- .
- DEF TEMP-TABLE tSavze
- FIELD Aufnr AS INT
- FIELD Sort1 AS CHAR
- FIELD Sort2 AS CHAR
- FIELD Sort3 AS CHAR
- FIELD Artnr AS INT
- FIELD Inhalt AS INT
- FIELD Jahr AS INT
- FIELD Pos AS INT
- FIELD Zeile AS RECID
- FIELD Preis AS DEC DECIMALS 4
- FIELD Aktion AS LOG
- FIELD LagOrt AS CHAR
- FIELD MGeli AS DEC
- FIELD MRuek AS DEC
-
- INDEX tSavze-k1 IS PRIMARY
- Aufnr
- Sort1
- Sort2
- Sort3
- .
- DEF TEMP-TABLE tRueckst LIKE tSavze
- .
- DEF TEMP-TABLE tSpeRab
- FIELD Rab_Grp AS INT
- FIELD Auf_Betr AS DEC DECIMALS 4
- .
- DEF TEMP-TABLE tGebKto
- FIELD Sort_Cd AS CHAR
- FIELD Geb_Cd AS CHAR
- FIELD Bez AS CHAR
- FIELD Preis AS DEC
- FIELD A_Anz AS DEC
- FIELD A_Betrag AS DEC
- FIELD E_Anz AS DEC
- FIELD E_Betrag AS DEC
- FIELD MWST_Art AS INT
- FIELD MWST_Cd AS INT
- .
- DEF TEMP-TABLE tRabSumm
- FIELD Rab_Summ AS INT
- FIELD Bez AS CHAR
- FIELD F_Rab_Art AS INT
- FIELD F_Wert AS DEC DECIMALS 4
- FIELD A_Rab_Art AS INT
- FIELD A_Wert AS DEC DECIMALS 4
- FIELD Auf_Rab AS DEC DECIMALS 4
- FIELD Abh_Rab AS DEC DECIMALS 4
- .
- DEF TEMP-TABLE tUmsGrp
- FIELD Ums_Grp AS INT
- FIELD Mwst AS INT
- FIELD Ansatz AS DEC
- FIELD Bez AS CHAR
- FIELD lInkl AS LOG
- FIELD Ums_Betr AS DEC DECIMALS 4
- .
- DEF TEMP-TABLE tTabTexte
- FIELD cRecArt AS CHAR
- FIELD iZeile AS INT
- FIELD cFeld1 AS CHAR
- FIELD cFeld2 AS CHAR
- FIELD cFeld3 AS CHAR
- FIELD iFeld1 AS INT
- FIELD iFeld2 AS INT
- FIELD iFeld3 AS INT
-
- INDEX tTabTexte-k1 IS PRIMARY
- cRecArt
- iZeile.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ANALYZE-SUSPEND _UIB-PREPROCESSOR-BLOCK
- /* ******************** Preprocessor Definitions ******************** */
- &Scoped-define PROCEDURE-TYPE Procedure
- &Scoped-define DB-AWARE no
- /* _UIB-PREPROCESSOR-BLOCK-END */
- &ANALYZE-RESUME
- /* ************************ Function Prototypes ********************** */
- &IF DEFINED(EXCLUDE-calcBlock) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD calcBlock Procedure
- FUNCTION calcBlock RETURNS INTEGER (ipGruppe AS CHAR) FORWARD.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ENDIF
- &IF DEFINED(EXCLUDE-fillFormular) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD fillFormular Procedure
- FUNCTION fillFormular RETURNS LOGICAL
- ( ) FORWARD.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ENDIF
- /* *********************** Procedure Settings ************************ */
- &ANALYZE-SUSPEND _PROCEDURE-SETTINGS
- /* Settings for THIS-PROCEDURE
- Type: Procedure
- Allow:
- Frames: 0
- Add Fields to: Neither
- Other Settings: CODE-ONLY COMPILE
- */
- &ANALYZE-RESUME _END-PROCEDURE-SETTINGS
- /* ************************* Create Window ************************** */
- &ANALYZE-SUSPEND _CREATE-WINDOW
- /* DESIGN Window definition (used by the UIB)
- CREATE WINDOW Procedure ASSIGN
- HEIGHT = 18.62
- WIDTH = 59.4.
- /* END WINDOW DEFINITION */
- */
- &ANALYZE-RESUME
-
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
- /* *************************** Main Block *************************** */
- opcResult = ''.
- cInstallation = DYNAMIC-FUNCTION('getInstallation':U).
- CREATE tParam.
- htParam:BUFFER-COPY(iphParam).
- ASSIGN cFirma = tParam.cFirma
- iAnzDok = tParam.Anzahl
- lPreis = TRUE.
-
- FIND bSteuer NO-LOCK WHERE bSteuer.Firma = cFirma.
- AdFirma = bSteuer.AdFirma.
- RUN AUFTRAG_ERMITTELN.
- IF opcResult <> '' THEN RETURN.
- FOR EACH sSavko
- BY sSavko.iFak_Knr:
- FIND bAdresse NO-LOCK
- WHERE bAdresse.Firma = AdFirma
- AND bAdresse.Knr = sSavko.iFak_Knr.
- iSprcd = bAdresse.Sprcd.
- RUN GET_FORMTEXT ( tParam.cInstall, tParam.Template, iSprcd,
- OUTPUT cFormText ) NO-ERROR.
- cRabText = TRIM(SUBSTRING(cFormText[21],01,20)).
- cZusText = TRIM(SUBSTRING(cFormText[21],21,20)).
- cEpzText = TRIM(SUBSTRING(cFormText[21],41,20)).
- RELEASE bAdresse.
-
- { vpr.i INIT }
- { vpr.i START }
-
- DO iLauf = 1 TO iAnzDok:
-
- dFakDatum = sSavko.dFakDat.
- iSeite = 0.
- iFaknr = sSavko.iFaknr.
- lFirst = TRUE.
- lLast = FALSE.
-
- EMPTY TEMP-TABLE tUmsGrp .
- EMPTY TEMP-TABLE tTotale .
-
- CREATE tTotale.
-
- FOR EACH bSavko NO-LOCK
- WHERE bSavko.Firma = sSavko.cFirma
- AND bSavko.Aufnr = sSavko.iAufnr
-
- BREAK BY bSavko.Firma
- BY bSavko.Aufnr :
- EMPTY TEMP-TABLE tSavze .
- EMPTY TEMP-TABLE tGebKto .
- EMPTY TEMP-TABLE tRabSumm .
- EMPTY TEMP-TABLE tSpeRab .
- EMPTY TEMP-TABLE tTabTexte .
- EMPTY TEMP-TABLE tRueckst .
- EMPTY TEMP-TABLE tAufko .
-
- CREATE tAufko.
- BUFFER-COPY bSavko TO tAufko
- ASSIGN tAufko.lBetrag = TRUE.
-
- FIND bAdresse NO-LOCK USE-INDEX Adresse-k1
- WHERE bAdresse.Firma = AdFirma
- AND bAdresse.Knr = bSavko.Fak_Knr NO-ERROR.
- FIND LDebst NO-LOCK USE-INDEX Debst-k1
- WHERE LDebst.Firma = cFirma
- AND LDebst.Knr = bSavko.Knr NO-ERROR.
- FIND FDebst NO-LOCK USE-INDEX Debst-k1
- WHERE FDebst.Firma = cFirma
- AND FDebst.Knr = bSavko.Fak_Knr NO-ERROR.
- FIND bWust NO-LOCK USE-INDEX Wust-k1
- WHERE bWust.CodeK = LDebst.MWST
- AND bWust.CodeA = 99 NO-ERROR.
- lDebIncl = FALSE.
- iBesrArt = FDebst.Besr_Art.
- IF AVAILABLE bWust THEN lDebIncl = bWust.Incl.
-
- hSavko = BUFFER bSavko:HANDLE.
- htTabTexte = TEMP-TABLE tTabTexte:DEFAULT-BUFFER-HANDLE.
-
- /* Texte und Werte aus Tabelle 'Tabel' laden für RecArt */
- /* FAKART, AUFSTATUS, LIEFART, FAHRER, WISO, ABLAD */
-
- RUN CREATE_TABTEXTE ( hSavko, INPUT-OUTPUT htTabTexte ) NO-ERROR.
-
- RUN FUELLEN_tSavze ( bSavko.Aufnr ) NO-ERROR.
-
- FOR EACH tSavze
- WHERE tSavze.Artnr > 0:
-
- FIND bSavze NO-LOCK WHERE RECID(bSavze) = tSavze.Zeile.
-
- /* Spezial-Auftragsrabatt pro Lieferschein bilden */
-
- IF bSavze.Auf_Sp_Grp > 0 THEN DO:
- FIND FIRST tSpeRab
- WHERE tSpeRab.Rab_Grp = bSavze.Auf_Sp_Grp NO-ERROR.
- IF NOT AVAILABLE tSpeRab THEN DO:
- CREATE tSpeRab.
- ASSIGN tSpeRab.Rab_Grp = bSavze.Auf_Sp_Grp.
- END.
- tSpeRab.Auf_Betr = tSpeRab.Auf_Betr + bSavze.Auf_Sp_Rab.
- END.
-
- /* Summengruppen-Totale pro Lieferschein bilden */
-
- DO WHILE bSavze.Rab_Su_Grp > 0:
- FIND FIRST tRabSumm
- WHERE tRabSumm.Rab_Summ = bSavze.Rab_Su_Grp NO-ERROR.
- IF NOT AVAILABLE tRabSumm THEN DO:
- FIND FIRST RabSumm NO-LOCK
- WHERE RabSumm.Firma = bSavze.Firma
- AND RabSumm.Rab_Summ = bSavze.Rab_Su_Grp NO-ERROR.
- IF NOT AVAILABLE RabSumm THEN LEAVE.
- CREATE tRabSumm.
- ASSIGN tRabSumm.Rab_Summ = bSavze.Rab_Su_Grp
- tRabSumm.Bez = RabSumm.Bez
- tRabSumm.Auf_Rab = 0
- tRabSumm.Abh_Rab = 0.
- END.
- LEAVE.
- END.
- END.
-
- IF LAST-OF ( bSavko.Aufnr ) THEN lLast = TRUE.
-
- RUN DRUCKEN.
- END.
- END.
- { vpr.i STOP }
- END.
- PROCEDURE ShellExecuteA EXTERNAL "shell32.dll" :
- DEFINE INPUT PARAMETER lphwnd AS LONG.
- DEFINE INPUT PARAMETER lpOperation AS CHAR.
- DEFINE INPUT PARAMETER lpFile AS CHAR.
- DEFINE INPUT PARAMETER lpParameters AS CHAR.
- DEFINE INPUT PARAMETER lpDirectory AS CHAR.
- DEFINE INPUT PARAMETER nShowCmd AS LONG.
- DEFINE RETURN PARAMETER hInstance AS LONG.
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &IF DEFINED(EXCLUDE-DRUCKEN_QRCODE) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN_QRCODE Procedure
- PROCEDURE DRUCKEN_QRCODE:
- /*------------------------------------------------------------------------------*/
- /* Purpose: */
- /* Parameters: <none> */
- /* Notes: */
- /*------------------------------------------------------------------------------*/
-
- DEFINE VARIABLE cFileName AS CHARACTER NO-UNDO.
- DEFINE VARIABLE cString AS CHARACTER NO-UNDO.
- DEFINE VARIABLE hSavko AS HANDLE NO-UNDO.
- DEFINE VARIABLE cBesrTemplate AS CHARACTER NO-UNDO INIT 'viper/latorre/BESR_QR.vfr'.
- DEFINE VARIABLE cWerbung AS CHARACTER NO-UNDO.
- DEFINE VARIABLE cConString AS CHARACTER NO-UNDO.
- DEFINE VARIABLE i1 AS INTEGER NO-UNDO.
- FIND FIRST tAufko.
- hSavko = TEMP-TABLE tAufko:DEFAULT-BUFFER-HANDLE.
-
- FIND FIRST tParam.
-
- FIND FIRST ViperDoc NO-LOCK
- WHERE ViperDoc.Firma = tAufko.Firma
- AND ViperDoc.Benutzer = ''
- AND ViperDoc.Formular = 'BESR_QR'
- AND ViperDoc.DokArt = 0 NO-ERROR.
- IF NOT AVAILABLE ViperDoc THEN RETURN.
-
- RUN vpr_LoadVFR (cBesrTemplate).
- RUN vpr_ActivateReport ('BESR_QR').
- RUN vpr_SelectPrinter (ViperDoc.Drucker).
- RUN vpr_SetDocAttrib ('PAPERSIZE=A4').
- RUN vpr_SetPreviewMode ('Direct').
- RUN vpr_InitGroups ("").
- RUN vpr_initGraphObj.
- RUN vpr_SetCurrentPageProperties("Papertray", ViperDoc.Schacht_BESR).
- cFileName = SUBSTITUTE('&1&2_&3', cPathQRCodes, 'QR_CODE', STRING(tAufko.Aufnr,'9999999')).
- RUN 'SwissQR/SwissQRCode.p' ( hSavko, cFileName ).
-
- cFilename = cFileName + '.jpg'.
- IF SEARCH(cFileName) <> ? THEN
- DO:
- cFileName = 'FILENAME=' + cFileName.
- RUN vpr_setGraphObjAttrib ( 'QRCode', 'QRCODE', cFileName ).
- END.
- /* FILE-INFO:FILE-NAME = cFileName. */
- /* cFileName = FILE-INFO:FULL-PATHNAME.*/
- cWerbung = SUBSTITUTE(cPathWerbung, tParam.cInstall).
- cWerbung = SUBSTITUTE('&1Werbung_&2.jpg', cWerbung, tAufko.Firma).
- IF SEARCH(cWerbung) <> ? THEN
- DO:
- cWerbung = SUBSTITUTE('FILENAME=&1', cWerbung).
- RUN vpr_setGraphObjAttrib ( 'Werbung', 'QRCODE', cWerbung ).
- END.
-
- RUN vpr_InitGraphObj.
- RUN vpr_flushGroup('QRCODE').
- /* RUN vpr_printdoc ( vpr_getPageNo(), vpr_getPageNo() ).*/
- /* RUN vpr_ActivateReport (tParam.cDokument).*/
- END PROCEDURE.
-
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ENDIF
- /* ********************** Internal Procedures *********************** */
- &IF DEFINED(EXCLUDE-ARTIKELZEILE) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE ARTIKELZEILE Procedure
- PROCEDURE ARTIKELZEILE :
- /*------------------------------------------------------------------------------
- Purpose:
- Parameters: <none>
- Notes:
- ------------------------------------------------------------------------------*/
- DEF INPUT PARAMETER ipRecid AS RECID NO-UNDO.
-
- DEF VAR cString AS CHAR NO-UNDO.
- DEF VAR nRabWert AS DEC NO-UNDO.
- DEF VAR xRabText AS CHAR NO-UNDO.
-
- FIND tSavze WHERE RECID(tSavze) = ipRecid NO-LOCK.
- FIND Savze WHERE RECID(Savze) = tSavze.Zeile NO-LOCK.
- iArtZeile = iArtZeile + 1.
- DO WHILE Savze.Artnr = 0:
- cString = Savze.Bez1.
- IF Savze.Bez1 <> '' THEN DO:
- cString = cString
- + (IF cString = '' THEN '' ELSE CHR(10))
- + Savze.Bez2.
- END.
- CREATE tDokument.
- ASSIGN tDokument.cGruppe = 'ArtikelZeile1'
- tDokument.iZeile = iArtZeile
- tDokument.cFeld = 'Bez1'
- tDokument.cInhalt = cString.
- RETURN.
- END.
- FIND Artst OF Savze NO-LOCK.
-
- FIND GGebinde NO-LOCK
- WHERE GGebinde.Firma = cFirma
- AND GGebinde.Geb_Cd = Savze.GGeb_Cd NO-ERROR.
- FIND VGebinde NO-LOCK
- WHERE VGebinde.Firma = cFirma
- AND VGebinde.Geb_Cd = Savze.VGeb_Cd NO-ERROR.
- FIND KGebinde NO-LOCK
- WHERE KGebinde.Firma = cFirma
- AND KGebinde.Geb_Cd = Savze.KGeb_Cd NO-ERROR.
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Artnr' , STRING(Savze.Artnr ,"999999") ).
-
- IF Savze.VGeb_Me <> 0 THEN DO:
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Menge_VGeb', TRIM(STRING(Savze.VGeb_Me,'->>>>>9')) ).
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'VGebinde' , VGebinde.KBez ).
- END.
-
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'KGebinde', KGebinde.Kbez ).
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Menge' , TRIM(STRING(Savze.MGeli,'->>,>>9')) ).
-
- cString = Savze.Bez1.
- IF Savze.Bez2 <> '' THEN DO:
- cString = cString
- + (IF cString = '' THEN '' ELSE CHR(10))
- + Savze.Bez2.
- END.
- IF Savze.Aktion THEN DO:
- cString = cString
- + (IF cString = '' THEN '' ELSE CHR(10))
- + Savze.Aktion_Text.
- END.
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', cString ).
-
- IF Savze.Alk_Gehalt <> 0 THEN DO:
- cString = STRING(Savze.Alk_Gehalt,"zz9.9%").
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Alk%', cString ).
- END.
- IF Savze.Jahr > 9 THEN DO:
- cString = STRING(Savze.Jahr,"9999").
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'JG', cString ).
- END.
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Preis' , STRING(Savze.Preis ,'>,>>9.99') ).
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', STRING(Savze.Bru_Betr,'->>>,>>9.99') ).
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'MC' , STRING(Savze.WuCd ,'z9') ).
-
-
- IF Savze.Rab_Betr <> 0 THEN DO:
- iArtZeile = iArtZeile + 1.
- nRabWert = ABSOLUTE(Savze.Rab_Wert).
- IF Savze.Rab_Art = 3 THEN xRabText = cEpzText.
- ELSE DO:
- IF Savze.Rab_Betr < 0 THEN xRabText = cZusText.
- IF Savze.Rab_Betr > 0 THEN xRabText = cRabText.
- END.
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', TRIM(xRabText) ).
-
- IF Savze.Rab_Art = 1 THEN cString = STRING(nRabWert,"->9.9%").
- IF Savze.Rab_Art = 2 OR
- Savze.Rab_Art = 3 THEN cString = STRING(nRabWert,"-9.99").
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Preis', cString ).
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', TRIM(STRING(- Savze.Rab_Betr,"->>>,>>9.99")) ).
- END.
-
- DO WHILE TRUE:
- IF Savze.Zus_Betr = 0 THEN LEAVE.
-
- iArtZeile = iArtZeile + 1.
- nRabWert = ABSOLUTE(Savze.Zus_Wert).
- IF Savze.Zus_Art = 3 THEN xRabText = cEpzText.
- ELSE DO:
- IF Savze.Zus_Betr < 0 THEN xRabText = cRabText.
- IF Savze.Zus_Betr > 0 THEN xRabText = cZusText.
- END.
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', TRIM(xRabText) ).
-
- IF Savze.Zus_Art = 1 THEN cString = STRING(nRabWert,"->9.9%").
- IF Savze.Zus_Art = 2 OR
- Savze.Zus_Art = 3 THEN cString = STRING(nRabWert,"-9.99").
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Preis', cString ).
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', TRIM(STRING(+ Savze.Zus_Betr,"->>>,>>9.99")) ).
- LEAVE.
- END.
-
- /* ---- Summengruppen-Total -------------------------------------------- */
-
- IF Savze.Rab_Su_Grp <> 0 THEN DO:
- FIND FIRST TRabSumm WHERE TRabSumm.Rab_Summ = Savze.Rab_Su_Grp NO-ERROR.
- IF AVAILABLE TRabSumm THEN DO:
- TRabSumm.Auf_Rab = TRabSumm.Auf_Rab + Savze.Auf_Rab.
- TRabSumm.Abh_Rab = TRabSumm.Abh_Rab + Savze.Abh_Rab.
- END.
- END.
-
- /* ---- Warengruppen-Totale -------------------------------------------- */
-
- FIND FIRST TUmsGrp WHERE TUmsGrp.Ums_Grp = Artst.Wg_Grp
- AND TUmsGrp.MWst = Savze.WuCd
- AND TUmsGrp.Ansatz = Savze.Mwst% NO-ERROR.
- IF NOT AVAILABLE TUmsGrp THEN DO:
- FIND WarenGrp NO-LOCK USE-INDEX WarenGrp-k1
- WHERE WarenGrp.Firma = cFirma
- AND WarenGrp.Wgr = Artst.Wg_Grp NO-ERROR.
- CREATE TUmsGrp.
- ASSIGN TUmsGrp.Ums_Grp = Artst.Wg_Grp
- TUmsGrp.Mwst = Savze.WuCd
- tUmsGrp.lInkl = Savze.Mwst_Inkl
- TUmsGrp.Ansatz = Savze.MWST%.
- IF AVAILABLE WarenGrp THEN TUmsGrp.Bez = WarenGrp.Bez1.
- ELSE TUmsGrp.Bez = "??????????".
- END.
-
- TUmsGrp.Ums_Betr = TUmsGrp.Ums_Betr
- + Savze.Net_Betr
- - Savze.Auf_Rab
- - Savze.Abh_Rab.
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ENDIF
- &IF DEFINED(EXCLUDE-AUFTRAG_ERMITTELN) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE AUFTRAG_ERMITTELN Procedure
- PROCEDURE AUFTRAG_ERMITTELN :
- /*------------------------------------------------------------------------------
- Purpose:
- Parameters: <none>
- Notes:
- ------------------------------------------------------------------------------*/
- DEF VAR iAufnr AS INT NO-UNDO.
-
- DEF BUFFER bDebst FOR Debst.
- FIND FIRST tParam.
-
- EMPTY TEMP-TABLE sSavko.
-
- /* Sammeln aller Aufträge */
-
- FOR EACH Savko NO-LOCK USE-INDEX Savko-k5
- WHERE Savko.Firma = tParam.cFirma
- AND Savko.Aufnr = tParam.iAufnr :
- IF tParam.iVerband <> 999999 THEN DO:
- FIND bDebst NO-LOCK
- WHERE bDebst.Firma = Savko.Firma
- AND bDebst.Knr = Savko.Fak_Knr NO-ERROR.
- IF NOT AVAILABLE bDebst THEN NEXT.
- IF bDebst.Verband_Grp <> tParam.iVerband THEN NEXT.
- RELEASE bDebst.
- END.
- iFaknr = Savko.Faknr.
- CREATE sSavko.
- ASSIGN sSavko.cFirma = Savko.Firma
- sSavko.iAufnr = Savko.Aufnr
- sSavko.iFak_Knr = Savko.Fak_Knr
- sSavko.iKnr = Savko.Knr
- sSavko.iSamm_Nr = 0
- sSavko.iRecid = RECID(Savko)
- sSavko.iFaknr = iFaknr.
- IF Savko.Fak_Datum = ? THEN sSavko.dFakDat = TODAY.
- ELSE sSavko.dFakDat = Savko.Fak_Datum.
- END.
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ENDIF
- &IF DEFINED(EXCLUDE-AUSGABE_ARTIKELZEILE) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE AUSGABE_ARTIKELZEILE Procedure
- PROCEDURE AUSGABE_ARTIKELZEILE :
- /*------------------------------------------------------------------------------
- Purpose:
- Parameters: <none>
- Notes:
- ------------------------------------------------------------------------------*/
- DEF VAR cZellen AS CHAR NO-UNDO.
- DEF VAR cWerte AS CHAR NO-UNDO.
- DEF VAR iPos AS INT NO-UNDO.
- DEF VAR lArtnr AS LOG NO-UNDO.
-
- FOR EACH tDokument
- WHERE tDokument.cGruppe = 'ArtikelZeile1'
- BREAK BY tDokument.cGruppe
- BY tDokument.iZeile:
- IF FIRST-OF ( tDokument.cGruppe ) THEN DO:
- iVPagePos = vpr_getPageVPos() + 20.
- RUN vpr_setPageVPos ( iVPagePos ).
- RUN vpr_setGroupVPos ( 'ArtikelZeile1', iVPagePos ).
- END.
- IF FIRST-OF ( tDokument.iZeile ) THEN DO:
- cZellen = ''.
- cWerte = ''.
- lArtnr = FALSE.
- END.
- cWerte = cWerte
- + tDokument.cInhalt.
- cZellen = cZellen
- + tDokument.cFeld.
-
- CASE tDokument.cFeld:
- WHEN 'Bez1' THEN cWerte = REPLACE(cWerte, CHR(10), ' \par ').
- WHEN 'Artnr' THEN lArtnr = TRUE.
- END CASE.
- IF NOT LAST-OF ( tDokument.iZeile ) THEN DO:
- ASSIGN cWerte = cWerte + CHR(01)
- cZellen = cZellen + ','.
- NEXT.
- END.
-
- RUN vpr_SetDelimiter (CHR(01)).
- RUN vpr_setGroupText ('ArtikelZeile1', cZellen, cWerte).
- iVPagePos = vpr_getPageVPos().
- IF lArtnr THEN iVPagePos = iVPagePos + 20.
- iPos = iVPagePos + vpr_getGroupHeight('ArtikelZeile1').
- IF iPos > iMaxPos THEN DO:
- RUN vpr_setPageVPos ( iMaxPos ).
- RUN VIPER_NEUE_SEITE.
- RUN DRUCKEN_ADRESSE.
- END.
- RUN vpr_setGroupVPos ('ArtikelZeile1', iVPagePos).
- RUN vpr_FlushGroup ('ArtikelZeile1').
- END.
-
- iVPagePos = vpr_getPageVPos() + 10.
- RUN vpr_setPageVPos ( iVPagePos ).
-
- FOR EACH tDokument
- WHERE tDokument.cGruppe = 'ArtikelZeile1':
- DELETE tDokument.
- END.
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ENDIF
- &IF DEFINED(EXCLUDE-AUSGABE_GRUPPE) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE AUSGABE_GRUPPE Procedure
- PROCEDURE AUSGABE_GRUPPE :
- /*------------------------------------------------------------------------------
- Purpose:
- Parameters: <none>
- Notes:
- ------------------------------------------------------------------------------*/
- DEF INPUT PARAMETER ipGruppe AS CHAR NO-UNDO.
- DEF VAR cZellen AS CHAR NO-UNDO.
- DEF VAR cWerte AS CHAR NO-UNDO.
- DEF VAR iSpace AS INT NO-UNDO.
-
- iSpace = vpr_getPageVPos().
- FOR EACH tDokument NO-LOCK
- WHERE tDokument.cGruppe = ipGruppe
- BREAK BY tDokument.cGruppe
- BY tDokument.iZeile:
- IF FIRST-OF ( tDokument.iZeile ) THEN iSpace = iSpace + 40.
- END.
- IF iSpace > iMaxPos THEN DO:
- RUN vpr_setPageVPos ( iMaxPos ).
- RUN VIPER_NEUE_SEITE.
- RUN DRUCKEN_ADRESSE.
- END.
-
- iVPagePos = vpr_getPageVPos().
- CASE ipGruppe:
- WHEN 'Gebindeabrechnung' THEN DO:
- iVPagePos = iVPagePos + 20.
- RUN vpr_setPageVPos ( iVPagePos ).
- RUN vpr_setGroupVPos ( 'GebindeTitel', iVPagePos ).
- RUN vpr_FlushGroup ( 'GebindeTitel' ).
- iVPagePos = vpr_getPageVPos().
- END.
- OTHERWISE DO:
- END.
- END CASE.
-
- FOR EACH tDokument
- WHERE tDokument.cGruppe = ipGruppe
- BREAK BY tDokument.cGruppe
- BY tDokument.iZeile:
- IF FIRST-OF ( tDokument.cGruppe ) THEN DO:
- IF ipGruppe <> 'Kondition' AND
- ipGruppe <> 'BESR' AND
- ipGruppe <> 'ADRESSE' THEN DO:
- iVPagePos = vpr_getPageVPos().
- RUN vpr_setPageVPos ( iVPagePos ).
- RUN vpr_setGroupVPos ( ipGruppe, iVPagePos ).
- END.
- END.
- IF FIRST-OF ( tDokument.iZeile ) THEN DO:
- cZellen = ''.
- cWerte = ''.
- END.
- cWerte = cWerte
- + tDokument.cInhalt.
- cZellen = cZellen
- + tDokument.cFeld.
-
- CASE tDokument.cFeld:
- WHEN 'Bez1' THEN cWerte = REPLACE(cWerte, CHR(10), ' \par ').
- END CASE.
-
- IF NOT LAST-OF ( tDokument.iZeile ) THEN DO:
- ASSIGN cWerte = cWerte + CHR(01)
- cZellen = cZellen + ','.
- NEXT.
- END.
-
- RUN vpr_SetDelimiter (CHR(01)).
- RUN vpr_SetGroupText (ipGruppe, cZellen, cWerte).
- RUN vpr_FlushGroup (ipGruppe).
- END.
-
- FOR EACH tDokument
- WHERE tDokument.cGruppe = ipGruppe:
- DELETE tDokument.
- END.
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ENDIF
- &IF DEFINED(EXCLUDE-DRUCKEN) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN Procedure
- PROCEDURE DRUCKEN :
- /*------------------------------------------------------------------------------
- Purpose:
- Parameters: <none>
- Notes:
- ------------------------------------------------------------------------------*/
- DEF VAR cText AS CHAR NO-UNDO.
- DEF VAR xString AS CHAR NO-UNDO.
- DEF VAR cLAdresse AS CHAR NO-UNDO.
- DEF VAR RText AS CHAR NO-UNDO.
- DEF VAR WText AS CHAR NO-UNDO.
- DEF VAR ii AS INT NO-UNDO.
- DEF VAR i1 AS INT NO-UNDO.
- DEF VAR nBetrag AS DEC NO-UNDO.
- DEF VAR nRabWert AS DEC NO-UNDO.
- DEF VAR iMwstCd AS INT NO-UNDO.
- DEF VAR nZeiTot AS DEC DECIMALS 4 NO-UNDO.
- DEF VAR lJa AS LOG NO-UNDO.
- DEF VAR cPDFName AS CHAR INIT '' NO-UNDO.
- DEF VAR nPfli AS DEC EXTENT 12 NO-UNDO.
- DEF VAR nMwst AS DEC EXTENT 12 NO-UNDO.
-
- DEF BUFFER bDebst FOR Debst.
-
- FIND FIRST tParam.
- nFakBetr = 0.
- IF iSeite = 0 THEN DO:
- RUN VIPER_INIT.
- SESSION:PRINTER-NAME = tParam.Drucker.
- END.
- FIND bDebst NO-LOCK
- WHERE bDebst.Firma = bSavko.Firma
- AND bDebst.Knr = bSavko.Fak_Knr.
- iBesrArt = bDebst.BESR_Art.
-
- RUN DRUCKEN_KOPF.
- FOR EACH tSavze NO-LOCK
- BY tSavze.Aufnr
- BY tSavze.Sort1
- BY tSavze.LagOrt
- BY tSavze.Sort2
- BY tSavze.Pos :
-
- FIND Savze NO-LOCK WHERE RECID(Savze) = tSavze.Zeile.
-
- RUN ARTIKELZEILE ( RECID(tSavze) ).
- nFakBetr = nFakBetr + Savze.Net_Betr.
- RELEASE Savze.
- END.
- iArtZeile = iArtZeile + 1.
- RUN vpr_Asc2RTF(TRIM(SUBSTRING(cFormText[10],41,20)), 'bold', OUTPUT xString ).
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1' , xString ).
- RUN vpr_Asc2RTF(TRIM(STRING(nFakBetr,'->>>,>>9.99')), 'bold', OUTPUT xString ).
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', xString ).
- iArtZeile = iArtZeile + 1.
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1' , ' ' ).
-
- RUN AUSGABE_ARTIKELZEILE.
- /* Auftragsrabatt ---------------------------------------------------- */
-
- iArtZeile = 0.
- FOR EACH tRabSumm
- WHERE tRabSumm.Auf_Rab <> 0
- BY tRabSumm.Rab_Summ:
- Rundbetr = tRabSumm.Auf_Rab.
- nFakBetr = nFakBetr - Rundbetr.
- /* IF Rundbetr < 0 THEN RText = cZusText. */
- /* ELSE RText = cRabText. */
- xString = RText
- + " "
- + tRabSumm.Bez.
- xString = TRIM(xString).
- iArtZeile = iArtZeile + 1.
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', xString ).
- FIND FIRST SavRabSu NO-LOCK USE-INDEX SavRabSu-k1
- WHERE SavRabSu.Firma = bSavko.Firma
- AND SavRabSu.Aufnr = bSavko.Aufnr
- AND SavRabSu.Rab_Summ = tRabSumm.Rab_Summ.
- nRabWert = ABSOLUT(SavRabSu.F_Wert).
- IF SavRabSu.F_Proz_Betr THEN WText = "%".
- ELSE WText = "Fr.".
- xString = STRING(nRabWert,"z9.99-")
- + WText.
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Preis', xString ).
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', TRIM(STRING(- Rundbetr,'->>>,>>9.99')) ).
- END.
- /* Abholrabatt ------------------------------------------------------- */
-
- FOR EACH tRabSumm WHERE tRabSumm.Abh_Rab <> 0
- BY tRabSumm.Rab_Summ:
- Rundbetr = tRabSumm.Abh_Rab.
- nFakBetr = nFakBetr - Rundbetr.
- /* IF Rundbetr < 0 THEN RText = cZusText. */
- /* ELSE RText = cRabText. */
- xString = RText
- + " "
- + tRabSumm.Bez.
- xString = TRIM(xString).
- iArtZeile = iArtZeile + 1.
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', xString ).
- FIND FIRST SavRabSu NO-LOCK USE-INDEX SavRabSu-k1
- WHERE SavRabSu.Firma = bSavko.Firma
- AND SavRabSu.Aufnr = bSavko.Aufnr
- AND SavRabSu.Rab_Summ = tRabSumm.Rab_Summ.
- nRabWert = ABSOLUT(SavRabSu.A_Wert).
- IF SavRabSu.A_Proz_Betr THEN WText = "%".
- ELSE WText = "Fr.".
- xString = STRING(nRabWert,"z9.99-")
- + WText.
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Preis', xString ).
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', TRIM(STRING(- Rundbetr,'->>>,>>9.99')) ).
- END.
-
- /* Spezialpreis-Auftragsrabatte ---------------------------------------- */
-
- FOR EACH tSpeRab WHERE tSpeRab.Auf_Betr <> 0
- BY tSpeRab.Rab_Grp:
- FIND Tabel USE-INDEX Tabel-k1
- WHERE Tabel.Firma = cFirma
- AND Tabel.RecArt = 'ARABGRP'
- AND Tabel.CodeC = ''
- AND Tabel.CodeI = tSpeRab.Rab_Grp
- AND Tabel.Sprcd = 1 NO-LOCK.
- Rundbetr = tSpeRab.Auf_Betr.
- nFakBetr = nFakBetr - Rundbetr.
- IF Rundbetr < 0 THEN RText = cZusText.
- ELSE RText = cRabText.
- xString = RText
- + " "
- + Tabel.Bez1.
- iArtZeile = iArtZeile + 1.
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', xString ).
- FIND FIRST SavSpRab USE-INDEX SavSpRab-k1
- WHERE SavSpRab.Firma = bSavko.Firma
- AND SavSpRab.Aufnr = bSavko.Aufnr
- AND SavSpRab.Rab_Grp = tSpeRab.Rab_Grp NO-LOCK.
- nRabWert = ABSOLUT(SavSpRab.Auf_Wert).
- IF SavSpRab.Auf_Proz_Betr THEN WText = "%".
- ELSE WText = "Fr.".
- xString = STRING(nRabWert,"z9.99-")
- + WText.
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Preis', xString ).
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', TRIM(STRING(- Rundbetr,'->>>,>>9.99')) ).
- END.
-
- IF iArtZeile > 0 THEN DO:
- iArtZeile = iArtZeile + 1.
- RUN vpr_Asc2RTF(TRIM(SUBSTRING(cFormText[14],21,20)), 'bold', OUTPUT xString ).
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1' , xString ).
- RUN vpr_Asc2RTF(TRIM(STRING(nFakBetr,'->>>,>>9.99')), 'bold', OUTPUT xString ).
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', xString ).
- iArtZeile = iArtZeile + 1.
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1' , ' ' ).
- END.
- RUN AUSGABE_GRUPPE ('ArtikelZeile1').
-
- /* Recycling-Gebuehren ----------------------------------------------- */
- iArtZeile = 0.
- FOR EACH SavGKon NO-LOCK
- WHERE SavGKon.Firma = bSavko.Firma
- AND SavGKon.Aufnr = bSavko.Aufnr
- AND SavGKon.Gebuehr <> 0
- AND SavGKon.Betrag <> 0 :
-
- FIND GebKonto OF SavGKon NO-LOCK NO-ERROR.
- IF NOT AVAILABLE GebKonto THEN xString = TRIM(SUBSTRING(cFormText[11],41,20)).
- ELSE xString = GebKonto.Bez.
-
- iMwstCd = SavGKon.MWST_Cd.
- nFakBetr = nFakBetr + SavGKon.Betrag.
- FIND LAST MwstAns NO-LOCK
- WHERE MwstAns.Mwst_Cd = iMwstCd
- AND MwstAns.Datum <= bSavko.Fak_Datum NO-ERROR.
-
- iArtZeile = iArtZeile + 1.
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1' , xString ).
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', TRIM(STRING(SavGKon.Betrag,'->>>,>>9.99')) ).
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'MC' , STRING(SavGKon.MWSt_Cd,'z9') ).
-
- FIND FIRST tUmsGrp
- WHERE tUmsGrp.Ums_Grp = 1000
- AND tUmsGrp.Mwst = iMwstCd
- AND tUmsGrp.Ansatz = MwstAns.Ansatz NO-ERROR.
- IF NOT AVAILABLE tUmsGrp THEN DO:
- FIND WarenGrp USE-INDEX WarenGrp-k1
- WHERE WarenGrp.Firma = cFirma
- AND WarenGrp.Wgr = 1000 NO-LOCK NO-ERROR.
- CREATE tUmsGrp.
- ASSIGN tUmsGrp.Ums_Grp = 1000
- tUmsGrp.Mwst = iMwstCd
- tUmsGrp.Ansatz = MwstAns.Ansatz
- tUmsGrp.lInkl = lDebIncl
- tUmsGrp.Bez = (IF AVAILABLE WarenGrp THEN WarenGrp.Bez1 ELSE 'Recyclinggebühren').
- END.
- tUmsGrp.Ums_Betr = tUmsGrp.Ums_Betr + SavGKon.Betrag.
- END.
- IF iArtZeile > 0 THEN DO:
- iArtZeile = iArtZeile + 1.
- RUN vpr_Asc2RTF(TRIM(SUBSTRING(cFormText[14],41,20)), 'bold', OUTPUT xString ).
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1' , xString ).
- RUN vpr_Asc2RTF(TRIM(STRING(nFakBetr,'->>>,>>9.99')), 'bold', OUTPUT xString ).
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', xString ).
- iArtZeile = iArtZeile + 1.
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1' , ' ' ).
- END.
- RELEASE SavGKon.
- RUN AUSGABE_GRUPPE ('ArtikelZeile1').
- /* Gebinde Aus- und Eingänge ---------------------------------------- */
- IF FDebst.Geb_Rg THEN DO:
- FOR EACH SavGKon NO-LOCK
- WHERE SavGKon.Firma = bSavko.Firma
- AND SavGKon.Aufnr = bSavko.Aufnr
- AND SavGKon.Depot <> 0
- AND SavGKon.Betrag <> 0 :
-
- FIND FIRST tGebKto WHERE tGebKto.Geb_Cd = SavGKon.Geb_Cd NO-ERROR.
- IF NOT AVAILABLE tGebKto THEN DO:
- FIND GebKonto NO-LOCK
- WHERE GebKonto.Firma = SavGKon.Firma
- AND GebKonto.Geb_Cd = SavGKon.Geb_Cd.
- CREATE tGebKto.
- ASSIGN tGebKto.Sort_Cd = GebKonto.Sort_Cd
- tGebKto.Geb_Cd = GebKonto.Geb_Cd
- tGebKto.Bez = GebKonto.Bez
- tGebKto.Preis = SavGKon.Depot
- tGebKto.MWST_Cd = SavGKon.MWSt_Cd.
- END.
- tGebKto.A_Anz = tGebKto.A_Anz + SavGKon.Ausgang.
- tGebKto.A_Betrag = tGebKto.A_Anz * tGebKto.Preis.
- tGebKto.E_Anz = tGebKto.E_Anz + SavGKon.Eingang.
- tGebKto.E_Betrag = tGebKto.E_Anz * tGebKto.Preis.
- END.
- RELEASE SavGKon.
-
- /* Gebindelieferungen ------------------------------------------------ */
-
- nBetrag = 0.
- iArtZeile = 0.
- FOR EACH SavGKon NO-LOCK
- WHERE SavGKon.Firma = bSavko.Firma
- AND SavGKon.Aufnr = bSavko.Aufnr
- AND SavGKon.Depot <> 0
- AND (SavGKon.Eingang <> 0 OR
- SavGKon.Ausgang <> 0)
-
- BREAK BY SavGKon.Firma
- BY SavGKon.Aufnr:
-
- iMwstCd = SavGKon.MWSt_Cd.
- FIND LAST MwstAns NO-LOCK
- WHERE MwstAns.Mwst_Cd = iMwstCd
- AND MwstAns.Datum <= bSavko.Fak_Datum NO-ERROR.
- FIND FIRST tUmsGrp
- WHERE tUmsGrp.Ums_Grp = 1001
- AND tUmsGrp.Mwst = iMwstCd
- AND tUmsGrp.Ansatz = MwstAns.Ansatz NO-ERROR.
- IF NOT AVAILABLE tUmsGrp THEN DO:
- FIND WarenGrp NO-LOCK USE-INDEX WarenGrp-k1
- WHERE WarenGrp.Firma = cFirma
- AND WarenGrp.Wgr = 1001 NO-ERROR.
- CREATE tUmsGrp.
- ASSIGN tUmsGrp.Ums_Grp = 1001
- tUmsGrp.Mwst = iMwstCd
- tUmsGrp.Ansatz = MwstAns.Ansatz
- tUmsGrp.lInkl = lDebIncl
- tUmsGrp.Bez = (IF AVAILABLE WarenGrp THEN WarenGrp.Bez1 ELSE 'Gebindesaldo').
- END.
- tUmsGrp.Ums_Betr = tUmsGrp.Ums_Betr + SavGKon.Betrag.
-
- FIND GebKonto NO-LOCK
- WHERE GebKonto.Firma = cFirma
- AND GebKonto.Geb_Cd = SavGKon.Geb_Cd.
- i1 = SavGKon.Ausgang - SavGKon.Eingang.
- Rundbetr = SavGKon.Betrag.
- iMwstCd = SavGKon.MWSt_Cd.
- nBetrag = nBetrag + Rundbetr.
- iArtZeile = iArtZeile + 1.
- RUN VIPER_CREATE_DOKUMENT ( 'Gebindeabrechnung', iArtZeile, 'Gebindetext' , GebKonto.Bez ).
- RUN VIPER_CREATE_DOKUMENT ( 'Gebindeabrechnung', iArtZeile, 'GebindeGel' , TRIM(STRING(SavGKon.Ausgang,"->>,>>9")) ).
- RUN VIPER_CREATE_DOKUMENT ( 'Gebindeabrechnung', iArtZeile, 'GebindeRet' , TRIM(STRING(SavGKon.Eingang,"->>,>>9")) ).
- RUN VIPER_CREATE_DOKUMENT ( 'Gebindeabrechnung', iArtZeile, 'GebindeSaldo', TRIM(STRING(i1 ,"->>,>>9")) ).
- RUN VIPER_CREATE_DOKUMENT ( 'Gebindeabrechnung', iArtZeile, 'GebindeBetr' , TRIM(STRING(Rundbetr ,"->>,>>9.99")) ).
- RUN VIPER_CREATE_DOKUMENT ( 'Gebindeabrechnung', iArtZeile, 'MC' , TRIM(STRING(SavGKon.MWSt_Cd,"z9")) ).
- END.
- RELEASE SavGKon.
- RELEASE GebKonto.
-
- IF iArtZeile > 0 THEN RUN VIPER_CREATE_DOKUMENT ( 'Gebindeabrechnung', iArtZeile, 'GebindeTot', TRIM(STRING(nBetrag,"->>>,>>9.99")) ).
-
- nFakBetr = nFakBetr + nBetrag.
- IF iArtZeile > 0 THEN RUN AUSGABE_GRUPPE ('Gebindeabrechnung').
- END.
- /* Mehrwertsteuer ---------------------------------------------------- */
- nPfli = 0.
- nMwst = 0.
- i1 = 2.
- DO ii = 1 TO 11:
- IF bSavko.WPfl[ii] = 0 THEN NEXT.
- nPfli[ii] = bSavko.Wpfl[ii].
- nMwst[ii] = bSavko.Wust[ii].
- nFakBetr = nFakBetr + nMwst[ii].
- i1 = i1 + 1.
- END.
-
- iVPagePos = vpr_getPageVPos().
- IF (iVPagePos + (i1 * 40) + 120) > iMaxPos THEN DO:
- RUN vpr_SetPageVPos ( iMaxPos ).
- RUN VIPER_NEUE_SEITE.
- RUN DRUCKEN_ADRESSE.
- END.
-
- iArtZeile = 1.
- RUN VIPER_CREATE_DOKUMENT ( 'Mehrwertsteuer', 1, 'MwstBez' , ' ' ).
- DO ii = 1 TO 11:
- IF nPfli[ii] = 0 THEN NEXT.
- FIND LAST MWSTAns USE-INDEX MWSTAns-k1
- WHERE MWSTAns.MWST_Cd = ii
- AND MWSTAns.Datum <= bSavko.Kond_Datum NO-LOCK.
- iArtZeile = iArtZeile + 1.
- RUN VIPER_CREATE_DOKUMENT ( 'Mehrwertsteuer', iArtZeile, 'MwstBez' , MWStAns.Bez ).
- RUN VIPER_CREATE_DOKUMENT ( 'Mehrwertsteuer', iArtZeile, 'MwstPfl' , TRIM(STRING(nPfli[ii],"->>,>>9.99")) ).
- RUN VIPER_CREATE_DOKUMENT ( 'Mehrwertsteuer', iArtZeile, 'MwstBetr', TRIM(STRING(nMwst[ii],"->>>,>>9.99")) ).
- RUN VIPER_CREATE_DOKUMENT ( 'Mehrwertsteuer', iArtZeile, 'MwstCd' , TRIM(STRING(ii ,"->>,>>9")) ).
- END.
- RUN AUSGABE_GRUPPE ( 'Mehrwertsteuer' ).
-
- /* Rechnungsbetrag --------------------------------------------------- */
- Rundbetr = nFakBetr.
- Rundcode = 1.
- RUN RUNDEN ( Rundcode, INPUT-OUTPUT Rundbetr ).
- nFakBetr = Rundbetr.
-
- iArtZeile = 1.
- RUN VIPER_CREATE_DOKUMENT ( 'RechnungsTotal', iArtZeile, 'Rechnungsbetrag_T', TRIM(cFormText[16]) ).
- RUN VIPER_CREATE_DOKUMENT ( 'RechnungsTotal', iArtZeile, 'EndBetrag' , TRIM(STRING(nFakBetr,"->,>>>,>>9.99")) ).
- iArtZeile = 2.
- RUN VIPER_CREATE_DOKUMENT ( 'RechnungsTotal', iArtZeile, 'EndBetrag' , '' ).
- iArtZeile = 3.
- RUN VIPER_CREATE_DOKUMENT ( 'RechnungsTotal', iArtZeile, 'Rechnungsbetrag_T', cFormText[27] ).
- iArtZeile = 4.
- RUN VIPER_CREATE_DOKUMENT ( 'RechnungsTotal', iArtZeile, 'EndBetrag' , '' ).
- RUN AUSGABE_GRUPPE ( 'RechnungsTotal' ).
-
- RUN SCHLUSSTEXT.
- RUN UMSATZVERTEILUNG.
- /* Zahlungskondition ------------------------------------------------- */
- FIND Kondi USE-INDEX Kondi-k1
- WHERE Kondi.Kond = bSavko.Kond
- AND Kondi.Sprcd = iSprcd NO-LOCK NO-ERROR.
- IF AVAILABLE Kondi THEN DO:
- iArtZeile = 1.
- RUN VIPER_CREATE_DOKUMENT ( 'Kondition', iArtZeile, 'Zahkond', Kondi.KoText ).
- RUN VIPER_CREATE_DOKUMENT ( 'Kondition', iArtZeile, 'Faellig', STRING((dFakDatum + Kondi.Faellig),"99.99.9999") ).
- IF Kondi.Skonto[01] <> 0 THEN DO:
- Rundbetr = bSavko.Sk_Ber * Kondi.Skonto[01] / 100.
- Rundcode = 1.
- RUN RUNDEN ( Rundcode, INPUT-OUTPUT Rundbetr ).
- RUN VIPER_CREATE_DOKUMENT ( 'Kondition', iArtZeile, 'Skonto', TRIM(STRING(Rundbetr,"->>>,>>9.99")) ).
- END.
- END.
- ELSE DO:
- iArtZeile = 1.
- RUN VIPER_CREATE_DOKUMENT ( 'Kondition', iArtZeile, 'Zahkond', FILL('?', 29) ).
- END.
- IF bSavko.Bar_Betr <> 0.00 THEN DO:
- RUN VIPER_CREATE_DOKUMENT ( 'Kondition', iArtZeile, 'Barbetrag_T', TRIM(ENTRY(4, cFormText[26], ';')) ).
- RUN VIPER_CREATE_DOKUMENT ( 'Kondition', iArtZeile, 'Skonto_T' , TRIM(ENTRY(5, cFormText[26], ';')) ).
- RUN VIPER_CREATE_DOKUMENT ( 'Kondition', iArtZeile, 'Barbetrag' , TRIM(STRING(bSavko.Bar_Betr ,"->>>,>>9.99")) ).
- RUN VIPER_CREATE_DOKUMENT ( 'Kondition', iArtZeile, 'Skonto' , TRIM(STRING(bSavko.Bar_Skonto,"->>>,>>9.99")) ).
- END.
- nFakBetr = nFakBetr - bSavko.Bar_Betr - bSavko.Bar_Skonto.
- RUN VIPER_CREATE_DOKUMENT ( 'Kondition', iArtZeile, 'Netto', TRIM(STRING(nFakBetr,"->>>,>>9.99")) ).
- RUN AUSGABE_GRUPPE ( 'Kondition' ).
-
- RUN vpr_FlushGroup ( 'Fusstext' ).
- IF nFakBetr = 0 THEN Rundbetr = -1.
- ELSE Rundbetr = nFakBetr.
- IF AVAILABLE Kondi AND
- Kondi.Skonto[01] <> 0 THEN Rundbetr = 0.
- IF iLauf < iAnzDok THEN RETURN.
-
- /* BESR DRUCKEN ---------------------------- */
- FIND Bankst NO-LOCK
- WHERE Bankst.Bank = iBESRArt NO-ERROR.
- IF Bankst.QR-IBAN <> '' THEN
- DO:
- IF bSavko.Auf_Tot > 0 THEN
- DO:
- RUN vpr_newPage.
- RUN DRUCKEN_QRCODE.
- END.
- END.
- ELSE
- DO:
- RUN DRUCKEN_BESR ( 'BESR' ).
- END.
-
- /* ------------------------------------------------------ */
- /* Druckausgabe */
- /* ------------------------------------------------------ */
-
- RUN vpr_EndDoc.
- cvpr_Dokument = SUBSTITUTE('&1-&2_&3_Kopie.vpr',
- STRING(bSavko.Fak_Knr,'999999'),
- STRING(bSavko.Aufnr ,'9999999'),
- tParam.cDokument).
- cvpr_Dokument = SUBSTITUTE(cERPDokumente, cInstallation, 'Rechnungen', cvpr_Dokument).
- RUN vpr_saveDoc ( cvpr_Dokument ).
- DO WHILE tParam.lDokDruck:
- SESSION:PRINTER-NAME = tParam.Drucker NO-ERROR.
- IF SESSION:PRINTER-NAME <> tParam.Drucker THEN DO:
- RUN vpr_printerDialog ( OUTPUT lJa ).
- IF NOT lJa THEN LEAVE.
- END.
- RUN vpr_printDoc (0, 0).
- RUN vpr_resetDoc.
-
- LEAVE.
- END.
-
- IF tParam.lCreatePDF THEN DO:
- cPDFName = REPLACE(cvpr_Dokument, '.vpr', '.pdf').
- RUN vpr_openDoc ( cvpr_Dokument ).
- RUN vpr_printPDF ( 0, 0, INPUT-OUTPUT cPDFName ).
- END.
- IF tParam.lOpenPDF THEN DO:
- DEF VAR o-i AS i NO-UNDO.
- FILE-INFO:FILE-NAME = cPDFName.
- cPDFName = FILE-INFO:FULL-PATHNAME.
- RUN ShellExecuteA (0,
- "open",
- cPDFName,
- "",
- "",
- 0,
- OUTPUT o-i).
- END.
-
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ENDIF
- &IF DEFINED(EXCLUDE-DRUCKEN_ADRESSE) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN_ADRESSE Procedure
- PROCEDURE DRUCKEN_ADRESSE :
- /*------------------------------------------------------------------------------
- Purpose:
- Parameters: <none>
- Notes:
- ------------------------------------------------------------------------------*/
- DEF VAR cZellen AS CHAR NO-UNDO.
- DEF VAR cWerte AS CHAR NO-UNDO.
-
- FIND FIRST tParam.
- FIND FIRST tDokument
- WHERE tDokument.cGruppe = 'KOPF'
- AND tDokument.iZeile = 1
- AND tDokument.cFeld = 'Seite' NO-ERROR.
- IF NOT AVAILABLE tDokument THEN DO:
- CREATE tDokument.
- ASSIGN tDokument.cGruppe = 'KOPF'
- tDokument.iZeile = 1
- tDokument.cFeld = 'Seite'.
- END.
- tDokument.cInhalt = STRING(iSeite,'z9').
- cZellen = ''.
- cWerte = ''.
- FOR EACH tDokument
- WHERE tDokument.cGruppe = 'Kopf'
- BREAK BY tDokument.cGruppe
- BY tDokument.cFeld:
- cWerte = cWerte
- + tDokument.cInhalt.
- cZellen = cZellen
- + tDokument.cFeld.
- IF NOT LAST-OF ( tDokument.cGruppe ) THEN ASSIGN cWerte = cWerte + CHR(01)
- cZellen = cZellen + ','.
- END.
- RUN vpr_SetDelimiter (CHR(01)).
- RUN vpr_setGroupText ('Kopf', cZellen, cWerte).
- RUN vpr_FlushGroup ('Kopf').
-
- IF iSeite = 1 THEN DO:
- cZellen = ''.
- cWerte = ''.
- FOR EACH tDokument
- WHERE tDokument.cGruppe = 'KopfDetail'
- BREAK BY tDokument.cGruppe
- BY tDokument.cFeld:
- cWerte = cWerte
- + tDokument.cInhalt.
- cZellen = cZellen
- + tDokument.cFeld.
- IF NOT LAST-OF ( tDokument.cGruppe ) THEN ASSIGN cWerte = cWerte + CHR(01)
- cZellen = cZellen + ','.
- END.
- RUN vpr_SetDelimiter (CHR(01)).
- RUN vpr_setGroupText ('KopfDetail', cZellen, cWerte).
- RUN vpr_FlushGroup ('KopfDetail').
- END.
-
- RUN vpr_FlushGroup ('Ueberschrift').
-
- iVPagePos = vpr_getPageVPos() + 20.
- RUN vpr_setPageVPos ( iVPagePos ).
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ENDIF
- &IF DEFINED(EXCLUDE-DRUCKEN_BESR) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN_BESR Procedure
- PROCEDURE DRUCKEN_BESR :
- /*------------------------------------------------------------------------------
- Purpose:
- Parameters: <none>
- Notes:
- ------------------------------------------------------------------------------*/
- DEF INPUT PARAMETER ipDokument AS CHAR NO-UNDO.
- DEF VAR ix AS INT NO-UNDO.
- DEF VAR i1 AS INT NO-UNDO.
- DEF VAR cFeld AS CHAR NO-UNDO.
- DEF VAR cInhalt AS CHAR NO-UNDO.
- DEF VAR cVorlage AS CHAR NO-UNDO.
- DEF VAR iKopfZeile AS INT NO-UNDO.
-
- DEF VAR PZBetrag AS CHAR NO-UNDO.
- DEF VAR PZReferenz AS CHAR NO-UNDO.
- DEF VAR PZTNNummer AS CHAR NO-UNDO.
- DEF VAR cReferenz AS CHAR NO-UNDO.
- DEF VAR cBESRBank AS CHAR NO-UNDO.
-
- DEF BUFFER BESRTabel FOR Tabel.
-
- FIND FIRST tParam.
-
- /* IF Rundbetr < 0 THEN RETURN. */
-
- RUN vpr_NewPage.
-
- cVorlage = tParam.cInstall + '/' + ipDokument + '.vfr'.
- RUN vpr_LoadVFR (cVorlage).
- RUN vpr_ActivateReport (ipDokument).
- RUN vpr_setPrinterAttrib("duplex=1").
- RUN vpr_SetDocAttrib ("PAPERSIZE=A4").
- RUN vpr_SetPrinterAttrib("copies=1").
- RUN vpr_InitGroups ("").
- RUN vpr_initGraphObj.
- IF tParam.Schacht_Besr > 0 THEN RUN vpr_SetCurrentPageProperties ( "Papertray", tParam.Schacht_Besr ).
- RUN vpr_SetGroupAttrib ("BESR" , "Fixed=true").
-
- FIND Adresse NO-LOCK USE-INDEX Adresse-k1
- WHERE Adresse.Firma = AdFirma
- AND Adresse.Knr = bSavko.Fak_Knr NO-ERROR.
- FIND Kondi NO-LOCK
- WHERE Kondi.Kond = bSavko.Kond
- AND Kondi.Sprcd = Adresse.Sprcd NO-ERROR.
- IF NOT AVAILABLE Kondi THEN DO:
- FIND FIRST Kondi NO-LOCK
- WHERE Kondi.Kond = bSavko.Kond NO-ERROR.
- END.
- IF AVAILABLE Kondi THEN DO:
- IF Kondi.Skonto[01] <> 0 THEN Rundbetr = 0.
- END.
- FOR EACH BESRTabel USE-INDEX Tabel-k1
- WHERE BESRTabel.Firma = tParam.cFirma
- AND BESRTabel.RecArt = 'EZ'
- AND BESRTabel.CodeC = STRING(iBesrArt,'999999')
- AND BESRTabel.Sprcd = 1 NO-LOCK:
- CASE BESRTabel.CodeI:
- WHEN 0 THEN DO:
- RUN vpr_setGroupText ( 'BESR', 'Konto_L', BESRTabel.Bez1 ).
- RUN vpr_setGroupText ( 'BESR', 'Konto_R', BESRTabel.Bez2 ).
- cBESRBank = STRING(BESRTabel.Dec_1,'99999999999999').
- PZTNNummer = BESRTabel.BezL.
- END.
- OTHERWISE DO:
- cFeld = SUBSTITUTE('Firma_Adr_&1_L', STRING(BESRTabel.CodeI,'99')).
- RUN vpr_setGroupText ( 'BESR', cFeld, BESRTabel.Bez1 ).
- cFeld = SUBSTITUTE('Firma_Adr_&1_R', STRING(BESRTabel.CodeI,'99')).
- RUN vpr_setGroupText ( 'BESR', cFeld, BESRTabel.Bez2 ).
- END.
- END CASE.
- END.
- iKopfZeile = 1.
- cBesrKopf = ''.
- IF bSavko.Adresse[05] <> '' THEN DO:
- i1 = 6.
- DO ix = 1 TO 5:
- /* CREATE tDokument. */
- /* ASSIGN tDokument.cGruppe = 'ADRESSE' */
- /* tDokument.iZeile = 1 */
- /* tDokument.cFeld = 'Adresse_' + STRING((6 + ix),'99') */
- /* tDokument.cInhalt = bSavko.Adresse[ix]. */
- i1 = i1 + 1.
- cBesrKopf[i1] = bSavko.Adresse[ix].
- END.
- END.
- ELSE DO:
- DO ix = 6 TO 11:
- /* CREATE tDokument. */
- /* ASSIGN tDokument.cGruppe = 'ADRESSE' */
- /* tDokument.iZeile = 1 */
- /* tDokument.cFeld = 'Adresse_' + STRING(ix,'99') */
- /* tDokument.cInhalt = Adresse.Anschrift[ix]. */
- cBesrKopf[ix] = Adresse.Anschrift[ix].
- END.
- END.
- DO ix = 6 TO 11:
- CREATE tDokument.
- ASSIGN tDokument.cGruppe = 'BESR'
- tDokument.iZeile = 1
- tDokument.cFeld = 'Adresse_R_' + STRING(ix,'99')
- tDokument.cInhalt = cBesrKopf[ix].
- IF ix < 7 THEN NEXT.
- CREATE tDokument.
- ASSIGN tDokument.cGruppe = 'BESR'
- tDokument.iZeile = 1
- tDokument.cFeld = 'Adresse_L_' + STRING(ix,'99')
- tDokument.cInhalt = cBesrKopf[ix].
- END.
- cFeld = ''.
- IF Rundbetr > 0.00 THEN DO:
- cFeld = STRING(Rundbetr,'zzzzzz9.99').
- cFeld = REPLACE(cFeld, '.', ' ').
- cFeld = STRING(cFeld,'XXXXXXXX XX').
- END.
- IF Rundbetr < 0.00 THEN cFeld = '**********'.
- RUN VIPER_CREATE_DOKUMENT ( 'BESR', iKopfZeile, 'Betrag_L', cFeld ).
- RUN VIPER_CREATE_DOKUMENT ( 'BESR', iKopfZeile, 'Betrag_R', cFeld ).
-
- IF Rundbetr > 0 THEN PZBetrag = '01' + STRING(Rundbetr * 100,'9999999999 ').
- ELSE PZBetrag = ' 04 '.
- PZReferenz = SUBSTRING(cBESRBank,01,12)
- + STRING(bSavko.Fak_Knr,"999999")
- + "0"
- + STRING(bSavko.Faknr,"9999999")
- + " ".
- RUN PRUEFZIFFER ( INPUT-OUTPUT PZBetrag, INPUT-OUTPUT PZReferenz, INPUT-OUTPUT PZTNNummer, OUTPUT cReferenz ).
- RUN VIPER_CREATE_DOKUMENT ( 'BESR', iKopfZeile, 'Referenz_OCRB', cReferenz ).
- RUN VIPER_CREATE_DOKUMENT ( 'BESR', iKopfZeile, 'Referenz_R', STRING(PZReferenz,'XX XXXXX XXXXX XXXXX XXXXX XXXXX') ).
- RUN VIPER_CREATE_DOKUMENT ( 'BESR', iKopfZeile, 'Referenz_L', STRING(PZReferenz,'XX XXXXX XXXXX XXXXX XXXXX XXXXX') ).
-
- RUN AUSGABE_GRUPPE ( 'BESR' ).
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ENDIF
- &IF DEFINED(EXCLUDE-DRUCKEN_KOPF) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN_KOPF Procedure
- PROCEDURE DRUCKEN_KOPF :
- /*------------------------------------------------------------------------------
- Purpose:
- Parameters: <none>
- Notes:
- ------------------------------------------------------------------------------*/
- DEF VAR cText AS CHAR NO-UNDO.
- DEF VAR cString AS CHAR NO-UNDO.
- DEF VAR ii AS INT NO-UNDO.
- DEF VAR i1 AS INT NO-UNDO.
-
- FIND FIRST tParam.
- iFaknr = bSavko.Faknr.
- RUN VIPER_NEUE_SEITE.
- IF iSeite = 1 THEN DO:
-
- FIND bSteuer NO-LOCK WHERE bSteuer.Firma = cFirma.
-
- RUN VIPER_CREATE_DOKUMENT ( 'Kopf', 1, 'MWST_T', Steuer.Mwst_Nr ).
-
- cBesrKopf = ''.
- IF bSavko.Adresse[05] <> '' THEN DO:
- i1 = 6.
- DO ii = 1 TO 5:
- CREATE tDokument.
- ASSIGN tDokument.cGruppe = 'KOPF'
- tDokument.iZeile = 1
- tDokument.cFeld = 'Adresse_' + STRING((6 + ii),'99')
- tDokument.cInhalt = bSavko.Adresse[ii].
- i1 = i1 + 1.
- cBesrKopf[i1] = bSavko.Adresse[ii].
- END.
- END.
- ELSE DO:
- DO ii = 5 TO 11:
- CREATE tDokument.
- ASSIGN tDokument.cGruppe = 'KOPF'
- tDokument.iZeile = 1
- tDokument.cFeld = 'Adresse_' + STRING(ii,'99')
- tDokument.cInhalt = bAdresse.Anschrift[ii].
- cBesrKopf[ii] = bAdresse.Anschrift[ii].
- END.
- END.
- CREATE tDokument.
- ASSIGN tDokument.cGruppe = 'KOPF'
- tDokument.iZeile = 1
- tDokument.cFeld = 'Ort_Datum'
- tDokument.cInhalt = TRIM(SUBSTRING(cFormText[07],01,20))
- + " "
- + STRING(dFakDatum,"99.99.9999").
- cString = (IF bSavko.Auf_Tot >= 0
- THEN TRIM(SUBSTRING(cFormText[02],01,20))
- ELSE TRIM(SUBSTRING(cFormText[02],21,20))).
- cString = cString
- + ' '
- + TRIM(STRING(iFaknr,'>>>>>>9')).
- CREATE tDokument.
- ASSIGN tDokument.cGruppe = 'KOPF'
- tDokument.iZeile = 1
- tDokument.cFeld = 'T_Dokument'
- tDokument.cInhalt = cString.
-
- CREATE tDokument.
- ASSIGN tDokument.cGruppe = 'KOPFDETAIL'
- tDokument.iZeile = 1
- tDokument.cFeld = 'Auf_Datum'
- tDokument.cInhalt = STRING(bSavko.Auf_Datum,'99.99.9999').
-
- CREATE tDokument.
- ASSIGN tDokument.cGruppe = 'KOPFDETAIL'
- tDokument.iZeile = 1
- tDokument.cFeld = 'Lief_Datum'
- tDokument.cInhalt = STRING(bSavko.Lief_Datum,'99.99.9999')
- + ' / '
- + TRIM(STRING(bSavko.Aufnr,'zzzzzz9')).
-
- CREATE tDokument.
- ASSIGN tDokument.cGruppe = 'KOPFDETAIL'
- tDokument.iZeile = 1
- tDokument.cFeld = 'U_Ref'
- tDokument.cInhalt = bSavko.U_Ref.
-
- CREATE tDokument.
- ASSIGN tDokument.cGruppe = 'KOPFDETAIL'
- tDokument.iZeile = 1
- tDokument.cFeld = 'Knr'
- tDokument.cInhalt = STRING(bSavko.Knr,'999999').
-
- cText = ''.
- cText = (IF bAdresse.Tel-1 <> '' THEN bAdresse.Tel-1 ELSE bAdresse.Tel-2).
- IF bAdresse.Natel <> '' THEN cText = cText
- + (IF cText = '' THEN '' ELSE ' / ')
- + bAdresse.Natel.
- CREATE tDokument.
- ASSIGN tDokument.cGruppe = 'KOPFDETAIL'
- tDokument.iZeile = 1
- tDokument.cFeld = 'Telefon'
- tDokument.cInhalt = cText.
-
- CREATE tDokument.
- ASSIGN tDokument.cGruppe = 'KOPFDETAIL'
- tDokument.iZeile = 1
- tDokument.cFeld = 'Gewicht'
- tDokument.cInhalt = TRIM(STRING(bSavko.Gewicht,'->>>,>>9.999')).
- CREATE tDokument.
- ASSIGN tDokument.cGruppe = 'KOPFDETAIL'
- tDokument.iZeile = 1
- tDokument.cFeld = 'I_Best'
- tDokument.cInhalt = TRIM(bSavko.I_Best).
- END.
-
- RUN DRUCKEN_ADRESSE.
-
- IF iSeite <> 1 THEN RETURN.
-
- cText = ''.
- IF bSavko.Abh_Text <> '' THEN DO:
- cText = bSavko.Abh_Text.
- END.
- IF bSavko.Auf_Text <> '' THEN DO:
- cText = cText
- + (IF cText <> '' THEN CHR(10) + CHR(10) ELSE '')
- + bSavko.Auf_Text.
- END.
- IF cText = '' THEN RETURN.
-
- CREATE tDokument.
- ASSIGN tDokument.cGruppe = 'ZusatzText'
- tDokument.iZeile = 1
- tDokument.cFeld = 'Bemerkung_1'
- tDokument.cInhalt = cText.
-
- iVPagePos = vpr_getPageVPos() + 30.
- RUN vpr_setPageVPos ( iVPagePos ).
- RUN vpr_setGroupVPos ( 'ZusatzText' , iVPagePos ).
- RUN AUSGABE_GRUPPE ( 'ZusatzText' ).
-
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ENDIF
- &IF DEFINED(EXCLUDE-FUELLEN_tSavze) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE FUELLEN_tSavze Procedure
- PROCEDURE FUELLEN_tSavze :
- /*------------------------------------------------------------------------------
- Purpose:
- Parameters: <none>
- Notes:
- ------------------------------------------------------------------------------*/
- DEF INPUT PARAMETER ipAufnr AS INT NO-UNDO.
- DEF VAR minPos AS INT NO-UNDO.
- DEF VAR maxPos AS INT NO-UNDO.
- DEF VAR jPlatz AS INT NO-UNDO.
- DEF VAR cLagOrt AS CHAR NO-UNDO.
- DEF VAR iRuestArt AS INT NO-UNDO.
- DEF VAR iPlusMinus AS INT NO-UNDO.
- DEF VAR lArtikel AS LOG NO-UNDO.
- DEF VAR cSort AS CHAR NO-UNDO.
- EMPTY TEMP-TABLE tSavze.
-
- FIND Steuer NO-LOCK
- WHERE Steuer.Firma = cFirma NO-ERROR.
- IF AVAILABLE Steuer THEN iRuestArt = Steuer.RuestArt.
-
- ASSIGN minPos = 0
- maxPos = 9999
- iPlusMinus = 0.
-
- /* Kommentar zu Beginn eines Auftrages */
- lArtikel = FALSE.
- FOR EACH Savze NO-LOCK
- WHERE Savze.Firma = cFirma
- AND Savze.Aufnr = ipAufnr
- AND Savze.Pos > minPos:
- IF Savze.Artnr > 0 THEN DO:
- lArtikel = TRUE.
- LEAVE.
- END.
-
- minPos = Savze.Pos.
- CREATE tSavze.
- ASSIGN tSavze.Aufnr = Savze.Aufnr
- tSavze.Artnr = Savze.Artnr
- tSavze.Inhalt = Savze.Inhalt
- tSavze.Jahr = Savze.Jahr
- tSavze.Pos = Savze.Pos
- tSavze.Zeile = RECID(Savze)
- tSavze.Aktion = Savze.Aktion
- tSavze.Preis = Savze.Preis
- tSavze.MGeli = Savze.MGeli
- tSavze.MRuek = Savze.MRuek.
-
- ASSIGN tSavze.Sort1 = ''
- tSavze.Sort2 = ''
- tSavze.Sort3 = STRING(iPlusMinus ,'9')
- + STRING(tSavze.Pos ,'9999').
- tSavze.LagOrt = ''.
- END.
-
- /* Kommentar am Ende eines Auftrages */
- IF lArtikel THEN DO:
- FOR EACH Savze NO-LOCK
- WHERE Savze.Firma = cFirma
- AND Savze.Aufnr = ipAufnr
- BY Savze.Pos DESCENDING:
- IF Savze.Artnr > 0 THEN LEAVE.
-
- maxPos = Savze.Pos.
- CREATE tSavze.
- ASSIGN tSavze.Aufnr = Savze.Aufnr
- tSavze.Artnr = Savze.Artnr
- tSavze.Inhalt = Savze.Inhalt
- tSavze.Jahr = Savze.Jahr
- tSavze.Pos = Savze.Pos
- tSavze.Zeile = RECID(Savze)
- tSavze.Aktion = Savze.Aktion
- tSavze.Preis = Savze.Preis
- tSavze.MGeli = Savze.MGeli
- tSavze.MRuek = Savze.MRuek.
-
- ASSIGN tSavze.Sort1 = 'ZZZ'
- tSavze.Sort2 = ''
- tSavze.Sort3 = STRING(iPlusMinus ,'9')
- + STRING(tSavze.Pos ,'9999').
- tSavze.LagOrt = ''.
- END.
- END.
-
- cLagOrt = ''.
- cSort = ''.
- FOR EACH Savze NO-LOCK
- WHERE Savze.Firma = cFirma
- AND Savze.Aufnr = ipAufnr
- AND Savze.Pos > minPos
- AND Savze.Pos < MaxPos
-
- BY Savze.Pos DESCENDING:
-
- IF Savze.Artnr > 0 THEN DO:
- FIND Artst NO-LOCK
- WHERE Artst.Firma = Savze.Firma
- AND Artst.Artnr = Savze.Artnr
- AND Artst.Inhalt = Savze.Inhalt
- AND Artst.Jahr = Savze.Jahr NO-ERROR.
- IF AVAILABLE Artst THEN cSort = 'Artikel'.
- END.
- iPlusMinus = (IF Savze.MGeli < 0 THEN 1 ELSE 0).
- CREATE tSavze.
- ASSIGN tSavze.Aufnr = Savze.Aufnr
- tSavze.Artnr = Savze.Artnr
- tSavze.Inhalt = Savze.Inhalt
- tSavze.Jahr = Savze.Jahr
- tSavze.Pos = Savze.Pos
- tSavze.Zeile = RECID(Savze)
- tSavze.Aktion = Savze.Aktion
- tSavze.Preis = Savze.Preis
- tSavze.MGeli = Savze.MGeli
- tSavze.MRuek = Savze.MRuek.
-
- ASSIGN tSavze.Sort1 = cSort
- tSavze.Sort2 = ''
- tSavze.Sort3 = STRING(iPlusMinus ,'9')
- + STRING(tSavze.Pos ,'9999').
- tSavze.LagOrt = cLagort.
- END.
-
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ENDIF
- &IF DEFINED(EXCLUDE-PRUEFZIFFER) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE PRUEFZIFFER Procedure
- PROCEDURE PRUEFZIFFER :
- /*------------------------------------------------------------------------------
- Purpose:
- Parameters: <none>
- Notes:
- ------------------------------------------------------------------------------*/
- /* ------------------------------------------------------------------------- */
- /* Prufziffer MODULO 10, Rekursiv (27 Stellig Ref.-Nr.) */
- /* ------------------------------------------------------------------------- */
- /* */
- /* Uebergabe Variable: 1. String Betrag (12-stellig) */
- /* 2. String Referenz (27-stellig) */
- /* 3. String Teilnehmernummer ( 9-stellig) */
- /* */
- /* Erstellung der VESR-Codierzeile */
- /* */
- /*---------------------------------------------------------------------------*/
- DEF INPUT-OUTPUT PARAMETER PZBetrag AS CHAR FORMAT "x(13)".
- DEF INPUT-OUTPUT PARAMETER PZReferenz AS CHAR FORMAT "x(27)".
- DEF INPUT-OUTPUT PARAMETER PZTNummer AS CHAR FORMAT "x(09)".
- DEF OUTPUT PARAMETER VSZeile AS CHAR FORMAT "x(58)".
-
- DEF VAR l1 AS INT.
- DEF VAR l2 AS INT.
- DEF VAR l3 AS INT.
- DEF VAR PZ AS INT.
- DEF VAR x1 AS INT.
- DEF VAR x2 AS INT.
- DEF VAR x3 AS INT.
- DEF VAR VMOD10 AS CHAR FORMAT "x(11)" EXTENT 11.
- VMOD10[01] = "09468271350".
- VMOD10[02] = "94682713509".
- VMOD10[03] = "46827135098".
- VMOD10[04] = "68271350947".
- VMOD10[05] = "82713509466".
- VMOD10[06] = "27135094685".
- VMOD10[07] = "71350946824".
- VMOD10[08] = "13509468273".
- VMOD10[09] = "35094682712".
- VMOD10[10] = "50946827131".
- l1 = 12.
- l2 = 26.
- l3 = 08.
- DO WHILE SUBSTRING(PZBetrag,01,01) <> " ": /* Mit Betrag */
- x2 = 1.
- x1 = INT(SUBSTRING(PZBetrag ,01 ,01)).
- x2 = INT(SUBSTRING(VMOD10[x2],x1 + 1,01)).
- DO x3 = 2 TO 12:
- x1 = INT(SUBSTRING(PZBetrag ,x3 ,01)).
- x2 = INT(SUBSTRING(VMOD10[x2 + 1],x1 + 1,01)).
- END.
- PZ = INT(SUBSTRING(VMOD10[x2 + 1],11,1)).
- SUBSTRING(PZBetrag,13) = STRING(PZ,"9").
- LEAVE.
- END.
- DO WHILE SUBSTRING(PZBetrag,01,01) = " ": /* Ohne Betrag */
- x2 = 11.
- x1 = INT(SUBSTRING(PZBetrag ,01 ,01)).
- x2 = INT(SUBSTRING(VMOD10[x2],x1 + 1,01)).
- DO x3 = 12 TO 12:
- x1 = INT(SUBSTRING(PZBetrag ,x3 ,01)).
- x2 = INT(SUBSTRING(VMOD10[x2 + 1],x1 + 1,01)).
- END.
- PZ = INT(SUBSTRING(VMOD10[x2 + 1],11,1)).
- SUBSTRING(PZBetrag,13) = STRING(PZ,"9").
- LEAVE.
- END.
- DO WHILE l2 = 26:
- x2 = 1.
- x1 = INT(SUBSTRING(PZReferenz,01 ,01)).
- x2 = INT(SUBSTRING(VMOD10[x2],x1 + 1,01)).
- DO x3 = 2 TO 26:
- x1 = INT(SUBSTRING(PZReferenz ,x3 ,01)).
- x2 = INT(SUBSTRING(VMOD10[x2 + 1],x1 + 1,01)).
- END.
- PZ = INT(SUBSTRING(VMOD10[x2 + 1],11,1)).
- SUBSTRING(PZReferenz,27) = STRING(PZ,"9").
- LEAVE.
- END.
- DO WHILE l3 = 08:
- x2 = 1.
- x1 = INT(SUBSTRING(PZTNummer ,01 ,01)).
- x2 = INT(SUBSTRING(VMOD10[x2],x1 + 1,01)).
- DO x3 = 2 TO 08:
- x1 = INT(SUBSTRING(PZTNummer ,x3 ,01)).
- x2 = INT(SUBSTRING(VMOD10[x2 + 1],x1 + 1,01)).
- END.
- PZ = INT(SUBSTRING(VMOD10[x2 + 1],11,1)).
- SUBSTRING(PZTNummer,09) = STRING(PZ,"9").
- LEAVE.
- END.
- VSZeile = "".
- SUBSTRING(VSZeile,01) = PZBetrag.
- SUBSTRING(VSZeile,14) = ">".
- SUBSTRING(VSZeile,15) = PZReferenz.
- SUBSTRING(VSZeile,42) = "+ ".
- SUBSTRING(VSZeile,44) = PZTNummer.
- SUBSTRING(VSZeile,53) = ">".
- /*
- SUBSTRING(VSZeile,58) = "H".
- */
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ENDIF
- &IF DEFINED(EXCLUDE-SCHLUSSTEXT) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE SCHLUSSTEXT Procedure
- PROCEDURE SCHLUSSTEXT :
- /*------------------------------------------------------------------------------
- Purpose:
- Parameters: <none>
- Notes:
- ------------------------------------------------------------------------------*/
- FIND TabTexte NO-LOCK USE-INDEX TabTexte-k1
- WHERE TabTexte.Firma = bSavko.Firma
- AND TabTexte.TextArt = 'DOK' + STRING(bSavko.Fak_Art,'99')
- AND TabTexte.Sprcd = iSprcd NO-ERROR.
- IF NOT AVAILABLE TabTexte THEN DO:
- FIND TabTexte NO-LOCK USE-INDEX TabTexte-k1
- WHERE TabTexte.Firma = bSavko.Firma
- AND TabTexte.TextArt = 'DOK' + STRING(bSavko.Fak_Art,'99')
- AND TabTexte.Sprcd = 1 NO-ERROR.
- END.
-
- IF NOT AVAILABLE TabTexte THEN RETURN.
- iArtZeile = 1.
- RUN VIPER_CREATE_DOKUMENT ( 'Zusatztext', iArtZeile, 'Bemerkung_1', TabTexte.Inhalt ).
- RUN AUSGABE_GRUPPE ( 'Zusatztext' ).
-
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ENDIF
- &IF DEFINED(EXCLUDE-UMSATZVERTEILUNG) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE UMSATZVERTEILUNG Procedure
- PROCEDURE UMSATZVERTEILUNG :
- /*------------------------------------------------------------------------------
- Purpose:
- Parameters: <none>
- Notes:
- ------------------------------------------------------------------------------*/
- DEF VAR nNetto AS DEC NO-UNDO.
- DEF VAR nMwst AS DEC NO-UNDO.
- DEF VAR nBrutto AS DEC NO-UNDO.
- DEF VAR nTNetto AS DEC NO-UNDO.
- DEF VAR nTMwst AS DEC NO-UNDO.
- DEF VAR nTBrutto AS DEC NO-UNDO.
- DEF VAR cText AS CHAR NO-UNDO.
- DEF VAR ix AS INT NO-UNDO.
- iArtZeile = 1.
- RUN vpr_Asc2RTF(TRIM(SUBSTRING(cFormText[15],41,20)), 'bold', OUTPUT cText).
- RUN VIPER_CREATE_DOKUMENT ( 'Umsatzverteilung', iArtZeile, 'Umsatzgruppe', cText ).
- RUN VIPER_CREATE_DOKUMENT ( 'Umsatzverteilung', iArtZeile, 'Frw' , ' ' ).
- RUN VIPER_CREATE_DOKUMENT ( 'Umsatzverteilung', iArtZeile, 'Netto' , ' ' ).
- RUN VIPER_CREATE_DOKUMENT ( 'Umsatzverteilung', iArtZeile, 'Ansatz' , ' ' ).
- RUN VIPER_CREATE_DOKUMENT ( 'Umsatzverteilung', iArtZeile, 'Mwst' , ' ' ).
- RUN VIPER_CREATE_DOKUMENT ( 'Umsatzverteilung', iArtZeile, 'Brutto' , ' ' ).
- RUN VIPER_CREATE_DOKUMENT ( 'Umsatzverteilung', iArtZeile, 'MC' , ' ' ).
- ASSIGN nTNetto = 0
- nTMwst = 0
- nTBrutto = 0.
- FOR EACH TUmsGrp NO-LOCK
- BY TUmsGrp.Ums_Grp
- BY TUmsGrp.Mwst :
- IF tUmsGrp.lInkl THEN DO:
- nNetto = tUmsGrp.Ums_Betr * 100 / (100 + tUmsGrp.Ansatz).
- nBrutto = tUmsGrp.Ums_Betr.
- nMwst = nBrutto - nNetto.
- END.
- ELSE DO:
- nNetto = tUmsGrp.Ums_Betr.
- nBrutto = tUmsGrp.Ums_Betr * (100 + tUmsGrp.Ansatz) / 100.
- nMwst = nBrutto - nNetto.
- END.
- ASSIGN nTNetto = nTNetto + nNetto
- nTMwst = nTMwst + nMwst
- nTBrutto = nTBrutto + nBrutto.
- iArtZeile = iArtZeile + 1.
- RUN VIPER_CREATE_DOKUMENT ( 'Umsatzverteilung', iArtZeile, 'Umsatzgruppe' , TUmsGrp.Bez ).
- RUN VIPER_CREATE_DOKUMENT ( 'Umsatzverteilung', iArtZeile, 'Frw' , BSteuer.Fwc03 ).
- RUN VIPER_CREATE_DOKUMENT ( 'Umsatzverteilung', iArtZeile, 'Netto' , TRIM(STRING(nNetto ,"->>>,>>9.99")) ).
- RUN VIPER_CREATE_DOKUMENT ( 'Umsatzverteilung', iArtZeile, 'Ansatz' , TRIM(STRING(TUmsGrp.Ansatz,">9.99%")) ).
- RUN VIPER_CREATE_DOKUMENT ( 'Umsatzverteilung', iArtZeile, 'Mwst' , TRIM(STRING(nMwst ,"->>>,>>9.99")) ).
- RUN VIPER_CREATE_DOKUMENT ( 'Umsatzverteilung', iArtZeile, 'Brutto' , TRIM(STRING(nBrutto ,"->>>,>>9.99")) ).
- RUN VIPER_CREATE_DOKUMENT ( 'Umsatzverteilung', iArtZeile, 'MC' , TRIM(STRING(tUmsGrp.Mwst ,"z9")) ).
- END.
- iArtZeile = iArtZeile + 1.
- RUN vpr_Asc2RTF('Total', 'bold', OUTPUT cText).
- RUN VIPER_CREATE_DOKUMENT ( 'Umsatzverteilung', iArtZeile, 'Umsatzgruppe' , cText ).
- RUN VIPER_CREATE_DOKUMENT ( 'Umsatzverteilung', iArtZeile, 'Netto' , TRIM(STRING(nTNetto ,"->>>,>>9.99")) ).
- RUN VIPER_CREATE_DOKUMENT ( 'Umsatzverteilung', iArtZeile, 'Mwst' , TRIM(STRING(nTMwst ,"->>>,>>9.99")) ).
- RUN VIPER_CREATE_DOKUMENT ( 'Umsatzverteilung', iArtZeile, 'Brutto' , TRIM(STRING(nTBrutto,"->>>,>>9.99")) ).
-
- ix = DYNAMIC-FUNCTION('calcBlock':U, 'Umsatzverteilung' )
- + 30
- + vpr_getPageVPos().
- IF ix >= iMaxPos THEN DO:
- RUN vpr_setPageVPos ( iMaxPos ).
- RUN VIPER_NEUE_SEITE.
- RUN DRUCKEN_ADRESSE.
- END.
- RUN AUSGABE_GRUPPE ( 'Umsatzverteilung' ).
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ENDIF
- &IF DEFINED(EXCLUDE-VIPER_CREATE_DOKUMENT) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE VIPER_CREATE_DOKUMENT Procedure
- PROCEDURE VIPER_CREATE_DOKUMENT :
- /*------------------------------------------------------------------------------
- Purpose:
- Parameters: <none>
- Notes:
- ------------------------------------------------------------------------------*/
- DEF INPUT PARAMETER ipGruppe AS CHAR NO-UNDO.
- DEF INPUT PARAMETER ipZeile AS INT NO-UNDO.
- DEF INPUT PARAMETER ipFeld AS CHAR NO-UNDO.
- DEF INPUT PARAMETER ipInhalt AS CHAR NO-UNDO.
-
- CREATE tDokument.
- ASSIGN tDokument.cGruppe = ipGruppe
- tDokument.iZeile = ipZeile
- tDokument.cFeld = ipFeld
- tDokument.cInhalt = ipInhalt.
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ENDIF
- &IF DEFINED(EXCLUDE-VIPER_INIT) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE VIPER_INIT Procedure
- PROCEDURE VIPER_INIT :
- /*------------------------------------------------------------------------------
- Purpose:
- Parameters: <none>
- Notes:
- ------------------------------------------------------------------------------*/
- DEF VAR cTemplate AS CHAR NO-UNDO.
- DEF VAR cDokument AS CHAR NO-UNDO.
- DEF VAR cZellen AS CHAR NO-UNDO.
- DEF VAR cZelle AS CHAR NO-UNDO.
- DEF VAR cGruppe AS CHAR NO-UNDO.
- DEF VAR ii AS INT NO-UNDO.
- DEF VAR cString AS CHAR NO-UNDO.
-
- FIND FIRST tParam.
- IF iLauf = 1 THEN DO:
- IF tParam.lCreatePDF THEN cDokument = tParam.cInstall + '/' + tParam.Template + '.vfr'.
- ELSE cDokument = tParam.cInstall + '/' + tParam.Template + '.vfr'.
- RUN vpr_ResetDoc.
- RUN vpr_LoadVFR (cDokument).
- RUN vpr_ActivateReport (tParam.Template).
- RUN vpr_SelectPrinter (tParam.Drucker).
- RUN vpr_setPrinterAttrib('duplex=1').
- RUN vpr_SetPrinterAttrib('copies=1').
- RUN vpr_ResetDoc.
- RUN vpr_SetDocAttrib ('PAPERSIZE=A4').
- RUN vpr_SetPreviewMode ('Direct').
- RUN vpr_setDocTitle (tParam.cDokument).
- IF tParam.Schacht_Original > 0 THEN RUN vpr_SetCurrentPageProperties ( "Papertray", tParam.Schacht_Original ).
- END.
- ELSE DO:
- RUN vpr_NewPage.
- IF tParam.Schacht_Kopie > 0 THEN RUN vpr_SetCurrentPageProperties ( "Papertray", tParam.Schacht_Kopie ).
- END.
- RUN vpr_initGroups ('').
- RUN vpr_SetGroupAttrib ("Kopf" , "Fixed=true").
- RUN vpr_SetGroupAttrib ("Fusstext" , "Fixed=true").
- RUN vpr_SetGroupAttrib ("Kondition", "Fixed=true").
-
- iMaxPos = 2600.
-
- DYNAMIC-FUNCTION('fillFormular':U) NO-ERROR.
-
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ENDIF
- &IF DEFINED(EXCLUDE-VIPER_NEUE_SEITE) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE VIPER_NEUE_SEITE Procedure
- PROCEDURE VIPER_NEUE_SEITE :
- /*------------------------------------------------------------------------------
- Purpose:
- Parameters: <none>
- Notes:
- ------------------------------------------------------------------------------*/
- DEF VAR iPos AS INT NO-UNDO.
-
- FIND FIRST tParam.
- DO WHILE TRUE:
- IF iSeite = 0 THEN DO:
- iSeite = iSeite + 1.
- LEAVE.
- END.
-
- /* iPos = vpr_getPageVPos(). */
- /* IF (iPos + 160) < iMaxPos THEN DO: */
- /* iPos = iPos + 20. */
- /* RUN vpr_setPageVPos ( iPos ). */
- /* RETURN. */
- /* END. */
-
- RUN vpr_NewPage.
- IF iLauf = 1 THEN RUN vpr_SetCurrentPageProperties ( "Papertray", tParam.Schacht_Original ).
- ELSE RUN vpr_SetCurrentPageProperties ( "Papertray", tParam.Schacht_Kopie ).
- iSeite = iSeite + 1.
- LEAVE.
- END.
-
- RUN vpr_InitGroups ('').
- RUN vpr_initGraphObj.
-
- RUN vpr_setPageVPos ( 1 ).
-
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ENDIF
- /* ************************ Function Implementations ***************** */
- &IF DEFINED(EXCLUDE-calcBlock) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION calcBlock Procedure
- FUNCTION calcBlock RETURNS INTEGER (ipGruppe AS CHAR):
- DEF VAR cZellen AS CHAR NO-UNDO.
- DEF VAR cWerte AS CHAR NO-UNDO.
- DEF VAR iSpace AS INT NO-UNDO.
- DEF VAR iGrpHo AS INT NO-UNDO.
- FOR EACH tDokument
- WHERE tDokument.cGruppe = ipGruppe
- BREAK BY tDokument.cGruppe
- BY tDokument.iZeile :
- IF FIRST-OF ( tDokument.iZeile ) THEN DO:
- cZellen = ''.
- cWerte = ''.
- END.
- cWerte = cWerte
- + tDokument.cInhalt.
- cZellen = cZellen
- + tDokument.cFeld.
- IF NOT LAST-OF ( tDokument.iZeile ) THEN DO:
- ASSIGN cWerte = cWerte + CHR(01)
- cZellen = cZellen + ','.
- NEXT.
- END.
- RUN vpr_setGroupText (ipGruppe, cZellen, cWerte).
- iGrpHo = vpr_getGroupHeight ( ipGruppe ).
- iSpace = iSpace + iGrpHo.
- END.
-
- RUN vpr_InitGroups(ipGruppe).
-
- RETURN iSpace.
-
- END FUNCTION.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ENDIF
- &IF DEFINED(EXCLUDE-fillFormular) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION fillFormular Procedure
- FUNCTION fillFormular RETURNS LOGICAL
- ( ) :
- /*------------------------------------------------------------------------------
- Purpose:
- Notes:
- ------------------------------------------------------------------------------*/
- DEF VAR cZellen AS CHAR NO-UNDO.
- DEF VAR cWerte AS CHAR NO-UNDO.
- RUN vpr_SetGroupText ( 'Ueberschrift', 'Artnr_T' , ENTRY( 1, cFormText[23], ';') ).
- RUN vpr_SetGroupText ( 'Ueberschrift', 'VGeb_Menge_T' , ENTRY( 2, cFormText[23], ';') ).
- RUN vpr_SetGroupText ( 'Ueberschrift', 'VGeb_T' , ENTRY( 3, cFormText[23], ';') ).
- RUN vpr_SetGroupText ( 'Ueberschrift', 'KGeb_Menge_T' , ENTRY( 4, cFormText[23], ';') ).
- RUN vpr_SetGroupText ( 'Ueberschrift', 'KGeb_T' , ENTRY( 5, cFormText[23], ';') ).
- RUN vpr_SetGroupText ( 'Ueberschrift', 'Bez_T' , ENTRY( 6, cFormText[23], ';') ).
- RUN vpr_SetGroupText ( 'Ueberschrift', 'Alk%_T' , ENTRY( 7, cFormText[23], ';') ).
- RUN vpr_SetGroupText ( 'Ueberschrift', 'JG_T' , ENTRY( 8, cFormText[23], ';') ).
- RUN vpr_SetGroupText ( 'Ueberschrift', 'Preis_T' , ENTRY( 9, cFormText[23], ';') ).
- RUN vpr_SetGroupText ( 'Ueberschrift', 'Betrag_T' , ENTRY(10, cFormText[23], ';') ).
- RUN vpr_SetGroupText ( 'Ueberschrift', 'MC_T' , ENTRY(11, cFormText[23], ';') ).
- RUN vpr_SetGroupText ( 'Kopf' , 'Seite_T' , ENTRY( 2, cFormText[24], ';') ).
- RUN vpr_SetGroupText ( 'KopfDetail' , 'Knr_T' , ENTRY( 1, cFormText[20], ';') ).
- RUN vpr_SetGroupText ( 'KopfDetail' , 'Bestellt_T' , ENTRY( 2, cFormText[20], ';') ).
- RUN vpr_SetGroupText ( 'KopfDetail' , 'Geliefert_T' , ENTRY( 3, cFormText[20], ';') ).
- RUN vpr_SetGroupText ( 'KopfDetail' , 'URef_T' , ENTRY( 1, cFormText[19], ';') ).
- RUN vpr_SetGroupText ( 'KopfDetail' , 'Telefon_T' , ENTRY( 2, cFormText[19], ';') ).
- RUN vpr_SetGroupText ( 'KopfDetail' , 'Gewicht_T' , ENTRY( 3, cFormText[19], ';') ).
- RUN vpr_SetGroupText ( 'KopfDetail' , 'IBest_T' , ENTRY( 4, cFormText[19], ';') ).
-
- RUN vpr_SetGroupText ( 'GebindeTitel', 'GebindeText_T' , ENTRY( 1, cFormText[25], ';') ).
- RUN vpr_SetGroupText ( 'GebindeTitel', 'GebindeGel_T' , ENTRY( 2, cFormText[25], ';') ).
- RUN vpr_SetGroupText ( 'GebindeTitel', 'GebindeRet_T' , ENTRY( 3, cFormText[25], ';') ).
- RUN vpr_SetGroupText ( 'GebindeTitel', 'GebindeSaldo_T', ENTRY( 4, cFormText[25], ';') ).
- RUN vpr_SetGroupText ( 'GebindeTitel', 'GebindeBetr_T' , ENTRY( 5, cFormText[25], ';') ).
- RUN vpr_SetGroupText ( 'GebindeTitel', 'GebindeTot_T' , ENTRY( 6, cFormText[25], ';') ).
-
- RUN vpr_SetGroupText ( 'Kondition' , 'Kondition_T' , ENTRY( 1, cFormText[26], ';') ).
- RUN vpr_SetGroupText ( 'Kondition' , 'Faellig_T' , ENTRY( 2, cFormText[26], ';') ).
- RUN vpr_SetGroupText ( 'Kondition' , 'Total_T' , ENTRY( 3, cFormText[26], ';') ).
- RETURN TRUE.
- END FUNCTION.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ENDIF
|