| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394 |
- &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 ************************** */
- DEFINE INPUT PARAMETER iphParam AS HANDLE NO-UNDO.
- DEFINE OUTPUT PARAMETER opcResult AS CHARACTER NO-UNDO.
- DEFINE VARIABLE iSeite AS INTEGER NO-UNDO.
- DEFINE VARIABLE iAnzDok AS INTEGER NO-UNDO.
- DEFINE VARIABLE iLauf AS INTEGER NO-UNDO.
- DEFINE VARIABLE lFirst AS LOG NO-UNDO INIT FALSE.
- DEFINE VARIABLE lLast AS LOG NO-UNDO INIT FALSE.
- DEFINE VARIABLE lPreis AS LOG NO-UNDO.
- DEFINE VARIABLE lEnde AS LOG NO-UNDO INIT FALSE.
- DEFINE VARIABLE cFirma AS CHARACTER NO-UNDO.
- DEFINE VARIABLE AdFirma AS CHARACTER NO-UNDO.
- DEFINE VARIABLE nFakBetr AS DECIMAL NO-UNDO.
- DEFINE VARIABLE dFakDatum AS DATE NO-UNDO.
- DEFINE VARIABLE iFaknr AS INTEGER NO-UNDO.
- DEFINE VARIABLE iSprcd AS INTEGER NO-UNDO.
- DEFINE VARIABLE nTotale AS DECIMAL EXTENT 15 NO-UNDO.
- DEFINE VARIABLE cFormtext AS CHARACTER EXTENT 30 NO-UNDO.
- DEFINE VARIABLE cRabText AS CHARACTER NO-UNDO.
- DEFINE VARIABLE cZusText AS CHARACTER NO-UNDO.
- DEFINE VARIABLE cEpzText AS CHARACTER NO-UNDO.
- DEFINE VARIABLE cBesrKopf AS CHARACTER EXTENT 12 NO-UNDO.
- DEFINE VARIABLE lDebIncl AS LOG NO-UNDO.
- DEFINE VARIABLE Rundbetr AS DECIMAL DECIMALS 4 NO-UNDO.
- DEFINE VARIABLE RundCode AS INTEGER INIT 1 NO-UNDO.
- DEFINE VARIABLE htTabTexte AS HANDLE NO-UNDO.
- DEFINE VARIABLE hAufko AS HANDLE NO-UNDO.
- DEFINE VARIABLE iWgr AS INTEGER NO-UNDO.
- DEFINE VARIABLE iPgr AS INTEGER NO-UNDO.
- DEFINE VARIABLE iAgr AS INTEGER NO-UNDO.
- DEFINE VARIABLE iArtnr AS INTEGER NO-UNDO.
- DEFINE VARIABLE iInhalt AS INTEGER NO-UNDO.
- DEFINE VARIABLE iJahr AS INTEGER NO-UNDO.
- DEFINE VARIABLE iMaxPos AS INTEGER INIT 2650 NO-UNDO.
- DEFINE VARIABLE cvpr_Dokument AS CHARACTER NO-UNDO.
- DEFINE VARIABLE iArtZeile AS INTEGER NO-UNDO.
- DEFINE VARIABLE iVPagePos AS INTEGER NO-UNDO.
- DEFINE VARIABLE iVGroupPos AS INTEGER NO-UNDO.
- DEFINE VARIABLE VWg_Grp AS INTEGER INIT 0 NO-UNDO.
- DEFINE VARIABLE VProd_Grp AS INTEGER INIT 0 NO-UNDO.
- DEFINE VARIABLE VArt_Grp AS INTEGER INIT 0 NO-UNDO.
- DEFINE VARIABLE AArtnr AS INTEGER INIT 0 NO-UNDO.
- DEFINE VARIABLE AInhalt AS INTEGER INIT 0 NO-UNDO.
- DEFINE VARIABLE AJahr AS INTEGER INIT 0 NO-UNDO.
- DEFINE BUFFER bAufko FOR Aufko .
- DEFINE BUFFER bAufze FOR Aufze .
- DEFINE BUFFER FDebst FOR Debst . /* Fakturaadresse */
- DEFINE BUFFER LDebst FOR Debst . /* Lieferadresse */
- DEFINE BUFFER LAdresse FOR Adresse .
- DEFINE BUFFER bAdresse FOR Adresse .
- DEFINE BUFFER bWust FOR Wust .
- DEFINE BUFFER bSteuer FOR Steuer .
- { incl/ttdruckparam.i }
- { incl/properties.i }
- { swissQR/propertiesSwissQR.i }
- DEFINE TEMP-TABLE tDokument
- FIELD cGruppe AS CHARACTER
- FIELD iZeile AS INTEGER
- FIELD cFeld AS CHARACTER
- FIELD cInhalt AS CHARACTER
-
- INDEX tDokument-k1 IS PRIMARY
- cGruppe
- iZeile
- cFeld
- .
- DEFINE TEMP-TABLE tTotale
- FIELD nMwstPfl AS DECIMAL EXTENT 12
- FIELD nMwstBet AS DECIMAL EXTENT 12
- FIELD nSammTot AS DECIMAL
- FIELD nSkBer AS DECIMAL
- FIELD nWW AS DECIMAL
- .
- DEFINE TEMP-TABLE sAufko
- FIELD cFirma AS CHARACTER
- FIELD iAufnr AS INTEGER
- FIELD iFak_Knr AS INTEGER
- FIELD iKnr AS INTEGER
- FIELD iSamm_Nr AS INTEGER
- FIELD iRecid AS RECID
- FIELD iFaknr AS INTEGER
- FIELD dFakDat AS DATE
- .
- DEFINE TEMP-TABLE tAufko LIKE Aufko
- FIELD iRecid AS RECID
- FIELD lBetrag AS LOGICAL
- .
- DEFINE TEMP-TABLE tAufze
- FIELD Aufnr AS INTEGER
- FIELD Sort1 AS CHARACTER
- FIELD Sort2 AS CHARACTER
- FIELD Sort3 AS CHARACTER
- FIELD Artnr AS INTEGER
- FIELD Inhalt AS INTEGER
- FIELD Jahr AS INTEGER
- FIELD Pos AS INTEGER
- FIELD Zeile AS RECID
- FIELD Preis AS DECIMAL DECIMALS 4
- FIELD Aktion AS LOG
- FIELD LagOrt AS CHARACTER
- FIELD MGeli AS DECIMAL
- FIELD MRuek AS DECIMAL
-
- INDEX tAufze-k1 IS PRIMARY
- Aufnr
- Sort1
- Sort2
- Sort3
- .
- DEFINE TEMP-TABLE tRueckst LIKE tAufze
- .
- DEFINE TEMP-TABLE tSpeRab
- FIELD Rab_Grp AS INTEGER
- FIELD Auf_Betr AS DECIMAL DECIMALS 4
- .
- DEFINE TEMP-TABLE tGebKto
- FIELD Sort_Cd AS CHARACTER
- FIELD Geb_Cd AS CHARACTER
- FIELD Bez AS CHARACTER
- FIELD Preis AS DECIMAL
- FIELD A_Anz AS DECIMAL
- FIELD A_Betrag AS DECIMAL
- FIELD E_Anz AS DECIMAL
- FIELD E_Betrag AS DECIMAL
- FIELD MWST_Art AS INTEGER
- FIELD MWST_Cd AS INTEGER
- .
- DEFINE TEMP-TABLE tRabSumm
- FIELD Rab_Summ AS INTEGER
- FIELD Bez AS CHARACTER
- FIELD F_Rab_Art AS INTEGER
- FIELD F_Wert AS DECIMAL DECIMALS 4
- FIELD A_Rab_Art AS INTEGER
- FIELD A_Wert AS DECIMAL DECIMALS 4
- FIELD Auf_Rab AS DECIMAL DECIMALS 4
- FIELD Abh_Rab AS DECIMAL DECIMALS 4
- .
- DEFINE TEMP-TABLE tUmsGrp
- FIELD Ums_Grp AS INTEGER
- FIELD Mwst AS INTEGER
- FIELD Ansatz AS DECIMAL
- FIELD Bez AS CHARACTER
- FIELD Ums_Betr AS DECIMAL DECIMALS 4
- .
- DEFINE TEMP-TABLE tTabTexte
- FIELD cRecArt AS CHARACTER
- FIELD iZeile AS INTEGER
- FIELD cFeld1 AS CHARACTER
- FIELD cFeld2 AS CHARACTER
- FIELD cFeld3 AS CHARACTER
- FIELD iFeld1 AS INTEGER
- FIELD iFeld2 AS INTEGER
- FIELD iFeld3 AS INTEGER
-
- 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-calculateBlock) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD calculateBlock Procedure
- FUNCTION calculateBlock RETURNS INTEGER
- ( ipGruppe AS CHARACTER ) 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 = 15
- WIDTH = 60.
- /* END WINDOW DEFINITION */
- */
- &ANALYZE-RESUME
-
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _CUSTOM _MAIN-BLOCK Procedure
- /* *************************** Main Block *************************** */
- opcResult = ''.
- CREATE tParam.
- htParam:BUFFER-COPY(iphParam).
- IF tParam.lSendMail THEN ASSIGN tParam.lDokDruck = FALSE
- tParam.lCreatePDF = TRUE
- tParam.lOpenPDF = FALSE.
-
- 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 sAufko
- BY sAufko.iFak_Knr:
- FIND bAdresse NO-LOCK
- WHERE bAdresse.Firma = AdFirma
- AND bAdresse.Knr = sAufko.iFak_Knr.
- iSprcd = bAdresse.Sprcd.
- RUN GET_FORMTEXT ( tParam.cInstall, tParam.cDokument, 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 = sAufko.dFakdat.
- iSeite = 0.
- iFaknr = sAufko.iFaknr.
- lFirst = TRUE.
- lLast = FALSE.
- EMPTY TEMP-TABLE tUmsGrp .
- EMPTY TEMP-TABLE tTotale .
-
- CREATE tTotale.
-
- FOR EACH bAufko NO-LOCK
- WHERE bAufko.Firma = sAufko.cFirma
- AND bAufko.Aufnr = sAufko.iAufnr
-
- BREAK BY bAufko.Firma
- BY bAufko.Aufnr :
- EMPTY TEMP-TABLE tAufze .
- EMPTY TEMP-TABLE tGebKto .
- EMPTY TEMP-TABLE tRabSumm .
- EMPTY TEMP-TABLE tSpeRab .
- EMPTY TEMP-TABLE tTabTexte .
- EMPTY TEMP-TABLE tRueckst .
-
- FIND bAdresse NO-LOCK USE-INDEX Adresse-k1
- WHERE bAdresse.Firma = AdFirma
- AND bAdresse.Knr = bAufko.Fak_Knr NO-ERROR.
- FIND LDebst NO-LOCK USE-INDEX Debst-k1
- WHERE LDebst.Firma = cFirma
- AND LDebst.Knr = bAufko.Knr NO-ERROR.
- FIND FDebst NO-LOCK USE-INDEX Debst-k1
- WHERE FDebst.Firma = cFirma
- AND FDebst.Knr = bAufko.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.
- IF AVAILABLE bWust THEN lDebIncl = bWust.Incl.
-
- hAufko = BUFFER bAufko: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 ( hAufko, INPUT-OUTPUT htTabTexte ) NO-ERROR.
-
- RUN FUELLEN_tAufze ( bAufko.Aufnr ) NO-ERROR.
-
- FOR EACH tAufze
- WHERE tAufze.Artnr > 0:
-
- FIND bAufze NO-LOCK WHERE RECID(bAufze) = tAufze.Zeile.
-
- /* Spezial-Auftragsrabatt pro Lieferschein bilden */
-
- IF bAufze.Auf_Sp_Grp > 0 THEN
- DO:
- FIND FIRST tSpeRab
- WHERE tSpeRab.Rab_Grp = bAufze.Auf_Sp_Grp NO-ERROR.
- IF NOT AVAILABLE tSpeRab THEN
- DO:
- CREATE tSpeRab.
- ASSIGN
- tSpeRab.Rab_Grp = bAufze.Auf_Sp_Grp.
- END.
- tSpeRab.Auf_Betr = tSpeRab.Auf_Betr + bAufze.Auf_Sp_Rab.
- END.
-
- /* Summengruppen-Totale pro Lieferschein bilden */
-
- DO WHILE bAufze.Rab_Su_Grp > 0:
- FIND FIRST tRabSumm
- WHERE tRabSumm.Rab_Summ = bAufze.Rab_Su_Grp NO-ERROR.
- IF NOT AVAILABLE tRabSumm THEN
- DO:
- FIND FIRST RabSumm NO-LOCK
- WHERE RabSumm.Firma = bAufze.Firma
- AND RabSumm.Rab_Summ = bAufze.Rab_Su_Grp NO-ERROR.
- IF NOT AVAILABLE RabSumm THEN LEAVE.
- CREATE tRabSumm.
- ASSIGN
- tRabSumm.Rab_Summ = bAufze.Rab_Su_Grp
- tRabSumm.Bez = RabSumm.Bez
- tRabSumm.Auf_Rab = 0
- tRabSumm.Abh_Rab = 0.
- END.
- LEAVE.
- END.
- END.
-
- IF LAST-OF ( bAufko.Aufnr ) THEN lLast = TRUE.
-
- RUN DRUCKEN.
-
- /* Auftragskopf mutieren */
-
- REPEAT TRANSACTION:
- IF iLauf < iAnzDok THEN LEAVE.
- FIND Aufko WHERE RECID(Aufko) = RECID(bAufko).
- ASSIGN
- Aufko.Fak_Datum = dFakDat
- Aufko.Gedruckt = TRUE.
- RELEASE Aufko.
- RUN AUFTRAG_GEDRUCKT ( bAufko.Aufnr ).
- LEAVE.
- END.
-
- END.
- END.
- { vpr.i STOP }
- END.
- PROCEDURE ShellExecuteA EXTERNAL "shell32.dll" :
- DEFINE INPUT PARAMETER lphwnd AS LONG.
- DEFINE INPUT PARAMETER lpOperation AS CHARACTER.
- DEFINE INPUT PARAMETER lpFile AS CHARACTER.
- DEFINE INPUT PARAMETER lpParameters AS CHARACTER.
- DEFINE INPUT PARAMETER lpDirectory AS CHARACTER.
- DEFINE INPUT PARAMETER nShowCmd AS LONG.
- DEFINE RETURN PARAMETER hInstance AS LONG.
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- /* ********************** Internal Procedures *********************** */
- &IF DEFINED(EXCLUDE-ARTIKELZEILE) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE ARTIKELZEILE Procedure
- PROCEDURE ARTIKELZEILE :
- /*------------------------------------------------------------------------------
- Purpose:
- Parameters: <none>
- Notes:
- ------------------------------------------------------------------------------*/
- DEFINE INPUT PARAMETER ipRecid AS RECID NO-UNDO.
-
- DEFINE VARIABLE cString AS CHARACTER NO-UNDO.
- DEFINE VARIABLE nRabWert AS DECIMAL NO-UNDO.
- DEFINE VARIABLE xRabText AS CHARACTER NO-UNDO.
-
- FIND tAufze WHERE RECID(tAufze) = ipRecid NO-LOCK.
- FIND Aufze WHERE RECID(Aufze) = tAufze.Zeile NO-LOCK.
- iArtZeile = iArtZeile + 1.
- DO WHILE Aufze.Artnr = 0:
- cString = Aufze.Bez1.
- IF Aufze.Bez2 <> '' THEN
- DO:
- cString = cString
- + (IF cString = '' THEN '' ELSE CHR(10))
- + Aufze.Bez2.
- END.
- CREATE tDokument.
- ASSIGN
- tDokument.cGruppe = 'ArtikelZeile1'
- tDokument.iZeile = iArtZeile
- tDokument.cFeld = 'Bez1'
- tDokument.cInhalt = cString.
- RETURN.
- END.
- FIND Artst OF Aufze NO-LOCK.
-
- FIND GGebinde NO-LOCK
- WHERE GGebinde.Firma = cFirma
- AND GGebinde.Geb_Cd = Aufze.GGeb_Cd NO-ERROR.
- FIND VGebinde NO-LOCK
- WHERE VGebinde.Firma = cFirma
- AND VGebinde.Geb_Cd = Aufze.VGeb_Cd NO-ERROR.
- FIND KGebinde NO-LOCK
- WHERE KGebinde.Firma = cFirma
- AND KGebinde.Geb_Cd = Aufze.KGeb_Cd NO-ERROR.
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Artnr' , STRING(Aufze.Artnr ,"999999") ).
-
- IF Aufze.VGeb_Me <> 0 THEN
- DO:
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Menge_VGeb', STRING(Aufze.VGeb_Me,'->>,>>9') ).
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'VGebinde' , VGebinde.KBez ).
- END.
-
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Menge' , STRING(Aufze.MGeli,'->>,>>9') ).
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'KGebinde', KGebinde.KBez ).
-
- cString = Aufze.Bez1.
- IF Aufze.Bez2 <> '' THEN
- DO:
- cString = cString
- + (IF cString = '' THEN '' ELSE CHR(10))
- + Aufze.Bez2.
- END.
- IF Aufze.Aktion THEN
- DO:
- cString = cString
- + (IF cString = '' THEN '' ELSE CHR(10))
- + Aufze.Aktion_Text.
- END.
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', cString ).
-
- IF Aufze.Jahr > 9 THEN
- DO:
- cString = STRING(Aufze.Jahr,"9999").
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'JG', cString ).
- END.
-
- IF Aufze.Alk_Gehalt <> 0 THEN
- DO:
- cString = STRING(Aufze.Alk_Gehalt,"zz9.9%").
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Alk%', cString ).
- END.
- DO WHILE lPreis :
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Preis' , STRING(Aufze.Preis ,'>,>>9.99') ).
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', STRING(Aufze.Bru_Betr,'->>>,>>9.99') ).
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'MC' , STRING(Aufze.WuCd ,'z9') ).
-
- IF Aufze.Rab_Betr = 0 THEN LEAVE.
- iArtZeile = iArtZeile + 1.
- nRabWert = ABSOLUTE(Aufze.Rab_Wert).
- IF Aufze.Rab_Art = 3 THEN xRabText = cEpzText.
- ELSE
- DO:
- IF Aufze.Rab_Betr < 0 THEN xRabText = cZusText.
- IF Aufze.Rab_Betr > 0 THEN xRabText = cRabText.
- END.
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', TRIM(xRabText) ).
-
- IF Aufze.Rab_Art = 1 THEN cString = STRING(nRabWert,"->9.9%").
- IF Aufze.Rab_Art = 2 OR
- Aufze.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(- Aufze.Rab_Betr,"->>>,>>9.99")) ).
- LEAVE.
- END.
-
- DO WHILE lPreis:
- IF Aufze.Zus_Betr = 0 THEN LEAVE.
-
- iArtZeile = iArtZeile + 1.
- nRabWert = ABSOLUTE(Aufze.Zus_Wert).
- IF Aufze.Zus_Art = 3 THEN xRabText = cEpzText.
- ELSE
- DO:
- IF Aufze.Zus_Betr < 0 THEN xRabText = cRabText.
- IF Aufze.Zus_Betr > 0 THEN xRabText = cZusText.
- END.
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', TRIM(xRabText) ).
-
- IF Aufze.Zus_Art = 1 THEN cString = STRING(nRabWert,"->9.9%").
- IF Aufze.Zus_Art = 2 OR
- Aufze.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(+ Aufze.Zus_Betr,"->>>,>>9.99")) ).
- LEAVE.
- END.
-
- /* ---- Summengruppen-Total -------------------------------------------- */
-
- IF Aufze.Rab_Su_Grp <> 0 THEN
- DO:
- FIND FIRST TRabSumm WHERE TRabSumm.Rab_Summ = Aufze.Rab_Su_Grp NO-ERROR.
- IF AVAILABLE TRabSumm THEN
- DO:
- TRabSumm.Auf_Rab = TRabSumm.Auf_Rab + Aufze.Auf_Rab.
- TRabSumm.Abh_Rab = TRabSumm.Abh_Rab + Aufze.Abh_Rab.
- END.
- END.
-
- /* ---- Warengruppen-Totale -------------------------------------------- */
-
- FIND FIRST tUmsGrp WHERE tUmsGrp.Ums_Grp = Artst.Wg_Grp
- AND tUmsGrp.MWst = Aufze.WuCd
- AND tUmsGrp.Ansatz = Aufze.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 = Aufze.WuCd
- tUmsGrp.Ansatz = Aufze.MWST%.
- IF AVAILABLE WarenGrp THEN tUmsGrp.Bez = WarenGrp.Bez1.
- ELSE tUmsGrp.Bez = "??????????".
- END.
-
- tUmsGrp.Ums_Betr = tUmsGrp.Ums_Betr
- + Aufze.Net_Betr
- - Aufze.Auf_Rab
- - Aufze.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:
- ------------------------------------------------------------------------------*/
- DEFINE VARIABLE iAufnr AS INTEGER NO-UNDO.
- FIND FIRST tParam.
-
- EMPTY TEMP-TABLE sAufko.
-
- /* Sammeln aller Aufträge */
-
- FOR EACH Aufko NO-LOCK USE-INDEX Aufko-k5
- WHERE Aufko.Firma = tParam.cFirma
- AND Aufko.Aufnr = tParam.iAufnr :
-
- iFaknr = Aufko.Faknr.
- IF iFaknr = 0 THEN
- DO:
- REPEAT TRANSACTION:
- iFaknr = DYNAMIC-FUNCTION('createFaknr':U, Aufko.Firma ).
- IF iFaknr = ? OR
- iFaknr = 0 THEN
- DO:
- MESSAGE 'Es konnte keine Rechnungsnummer gelöst werden' SKIP
- 'Ein Benutzer blockiert die Steuerdatei'
- VIEW-AS ALERT-BOX ERROR.
- NEXT.
- END.
- FIND bAufko WHERE RECID(bAufko) = RECID(Aufko).
- bAufko.Faknr = iFaknr.
- RELEASE bAufko.
- LEAVE.
- END.
- END.
- tParam.iFaknr = iFaknr.
-
- CREATE sAufko.
- ASSIGN
- sAufko.cFirma = Aufko.Firma
- sAufko.iAufnr = Aufko.Aufnr
- sAufko.iFak_Knr = Aufko.Fak_Knr
- sAufko.iKnr = Aufko.Knr
- sAufko.iKnr = Aufko.Knr
- sAufko.iSamm_Nr = 0
- sAufko.iRecid = RECID(Aufko)
- sAufko.iFaknr = iFaknr.
- IF Aufko.Fak_Datum = ? OR
- Aufko.Fak_Datum < TODAY THEN sAufko.dFakDat = TODAY.
- ELSE sAufko.dFakDat = Aufko.Fak_Datum.
- RELEASE Aufko.
- RELEASE bAufko.
- END.
-
- /* Alle Auftragstotale aller Lieferscheine neu rechnen */
-
- FOR EACH sAufko:
- FOR EACH bAufko NO-LOCK
- WHERE bAufko.Firma = sAufko.cFirma
- AND bAufko.Aufnr = sAufko.iAufnr :
- DYNAMIC-FUNCTION('calculateAuftragsTotal':U, bAufko.Firma,
- bAufko.Aufnr,
- OUTPUT nTotale ) NO-ERROR.
- RELEASE bAufko.
- END.
- 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:
- ------------------------------------------------------------------------------*/
- DEFINE VARIABLE cZellen AS CHARACTER NO-UNDO.
- DEFINE VARIABLE cWerte AS CHARACTER NO-UNDO.
- DEFINE VARIABLE iPos AS INTEGER 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().
- RUN vpr_setPageVPos ( iVPagePos ).
- RUN vpr_setGroupVPos ( 'ArtikelZeile1', iVPagePos ).
- END.
- IF FIRST-OF ( tDokument.iZeile ) THEN
- DO:
- cZellen = ''.
- cWerte = ''.
- END.
- /* IF tDokument.cFeld = 'Bez1' THEN RUN vpr_Asc2RTF ( tDokument.cInhalt, '', OUTPUT tDokument.cInhalt).*/
- IF tDokument.cFeld = 'Bez1' THEN tDokument.cInhalt = REPLACE(tDokument.cInhalt, CHR(10), '\par ').
- 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_SetDelimiter (CHR(01)).
- RUN vpr_setGroupText ('ArtikelZeile1', cZellen, cWerte).
- iVPagePos = vpr_getPageVPos().
- iPos = iVPagePos + vpr_getGroupHeight('ArtikelZeile1').
- IF iPos > iMaxPos THEN
- DO:
- RUN VIPER_NEUE_SEITE.
- END.
- RUN vpr_FlushGroup ('ArtikelZeile1').
- iVPagePos = vpr_getPageVPos().
- IF LAST-OF ( tDokument.cGruppe ) THEN LEAVE.
-
- iVPagePos = vpr_getPageVPos().
- RUN vpr_setGroupVPos ( 'ArtikelZeile1', iVPagePos ).
- END.
- 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:
- ------------------------------------------------------------------------------*/
- DEFINE INPUT PARAMETER ipGruppe AS CHARACTER NO-UNDO.
- DEFINE VARIABLE cZellen AS CHARACTER NO-UNDO.
- DEFINE VARIABLE cWerte AS CHARACTER NO-UNDO.
- DEFINE VARIABLE iSpace AS INTEGER NO-UNDO.
-
- FIND FIRST tParam.
-
- 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 VIPER_NEUE_SEITE.
- /* iVPagePos = vpr_getPageVPos(). */
- /* RUN vpr_setPageVPos ( iVPagePos ).*/
- END.
-
- iVPagePos = vpr_getPageVPos().
- CASE ipGruppe:
- WHEN 'Gebindeabrechnung' THEN
- DO:
- iVPagePos = iVPagePos + 20.
- RUN vpr_setGroupVPos ( 'GebindeabrechnungTitel', iVPagePos ).
- RUN vpr_FlushGroup ( 'GebindeabrechnungTitel').
- 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_setGroupVPos ( ipGruppe, iVPagePos ).
- END.
- END.
- 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_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:
- ------------------------------------------------------------------------------*/
- DEFINE VARIABLE cText AS CHARACTER NO-UNDO.
- DEFINE VARIABLE cLAdresse AS CHARACTER NO-UNDO.
- DEFINE VARIABLE RText AS CHARACTER NO-UNDO.
- DEFINE VARIABLE WText AS CHARACTER NO-UNDO.
- DEFINE VARIABLE ii AS INTEGER NO-UNDO.
- DEFINE VARIABLE i1 AS INTEGER NO-UNDO.
- DEFINE VARIABLE nBetrag AS DECIMAL NO-UNDO.
- DEFINE VARIABLE nRabwert AS DECIMAL NO-UNDO.
- DEFINE VARIABLE iMwstCd AS INTEGER NO-UNDO.
- DEFINE VARIABLE nZeiTot AS DECIMAL DECIMALS 4 NO-UNDO.
- DEFINE VARIABLE lJa AS LOG NO-UNDO.
- DEFINE VARIABLE cPDFName AS CHARACTER INIT '' NO-UNDO.
- DEFINE VARIABLE nPfli AS DECIMAL EXTENT 12 NO-UNDO.
- DEFINE VARIABLE nMwst AS DECIMAL EXTENT 12 NO-UNDO.
-
- FIND FIRST tParam.
- IF tParam.lBatch THEN
- DO:
- ASSIGN
- tParam.lOpenPDF = FALSE.
- END.
- lEnde = FALSE.
- FIND FIRST tAufko NO-ERROR.
- IF NOT AVAILABLE tAufko THEN CREATE tAufko.
- BUFFER-COPY bAufko TO tAufko
- ASSIGN
- tAufko.iRecid = RECID(bAufko)
- tAufko.lBetrag = TRUE.
- nFakBetr = 0.
- IF iSeite = 0 THEN RUN VIPER_INIT.
-
- RUN DRUCKEN_KOPF.
- iArtZeile = 0.
- iVPagePos = vpr_getPageVPos() + 50.
- RUN vpr_setGroupVPos ( 'ArtikelZeile1', iVPagePos ).
-
- FOR EACH tAufze NO-LOCK
- BY tAufze.Aufnr
- BY tAufze.Sort1
- BY tAufze.LagOrt
- BY tAufze.Sort2
- BY tAufze.Pos :
-
- FIND Aufze NO-LOCK WHERE RECID(Aufze) = tAufze.Zeile.
-
- RUN ARTIKELZEILE ( RECID(tAufze) ).
- nFakBetr = nFakBetr + Aufze.Net_Betr.
- RELEASE Aufze.
- END.
- iArtZeile = iArtZeile + 1.
- cText = TRIM(SUBSTRING(cFormText[10],41,20)).
- RUN vpr_asc2rtf ( cText, 'bold', OUTPUT cText).
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1' , cText ).
- cText = TRIM(STRING(nFakBetr,'->>>,>>9.99')).
- RUN vpr_asc2rtf ( cText, 'bold', OUTPUT cText).
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', cText ).
- iArtZeile = iArtZeile + 1.
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1' , ' ' ).
-
- RUN AUSGABE_ARTIKELZEILE.
- /* Auftragsrabatt ---------------------------------------------------- */
-
- iArtZeile = 0.
- ii = 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.
- cText = RText
- + " "
- + tRabSumm.Bez.
- iArtZeile = iArtZeile + 1.
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', cText ).
- FIND FIRST AufRabSu NO-LOCK USE-INDEX AufRabSu-k1
- WHERE AufRabSu.Firma = bAufko.Firma
- AND AufRabSu.Aufnr = bAufko.Aufnr
- AND AufRabSu.Rab_Summ = tRabSumm.Rab_Summ.
- nRabWert = ABSOLUT(AufRabSu.F_Wert).
- IF AufRabSu.F_Proz_Betr THEN WText = "%".
- ELSE WText = "Fr.".
- cText = STRING(nRabWert,"z9.99-")
- + WText.
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Preis', cText ).
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', TRIM(STRING(- Rundbetr,'->>>,>>9.99')) ).
- ii = ii + 1.
- END.
- IF ii > 0 THEN RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Preis', ' ' ).
- /* Abholrabatt ------------------------------------------------------- */
-
- ii = 0.
- 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.
- cText = RText
- + " "
- + tRabSumm.Bez.
- iArtZeile = iArtZeile + 1.
- ii = ii + 1.
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', cText ).
- FIND FIRST AufRabSu NO-LOCK USE-INDEX AufRabSu-k1
- WHERE AufRabSu.Firma = bAufko.Firma
- AND AufRabSu.Aufnr = bAufko.Aufnr
- AND AufRabSu.Rab_Summ = tRabSumm.Rab_Summ.
- nRabWert = ABSOLUT(AufRabSu.A_Wert).
- IF AufRabSu.A_Proz_Betr THEN WText = "%".
- ELSE WText = "Fr.".
- cText = STRING(nRabWert,"z9.99-")
- + WText.
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Preis', cText ).
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', TRIM(STRING(- Rundbetr,'->>>,>>9.99')) ).
- END.
-
- /* Spezialpreis-Auftragsrabatte ---------------------------------------- */
-
- ii = 0.
- 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.
- cText = RText
- + " "
- + Tabel.Bez1.
- iArtZeile = iArtZeile + 1.
- ii = ii + 1.
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', cText ).
- FIND FIRST AufSpRab USE-INDEX AufSpRab-k1
- WHERE AufSpRab.Firma = bAufko.Firma
- AND AufSpRab.Aufnr = bAufko.Aufnr
- AND AufSpRab.Rab_Grp = tSpeRab.Rab_Grp NO-LOCK.
- nRabWert = ABSOLUT(AufSpRab.Auf_Wert).
- IF AufSpRab.Auf_Proz_Betr THEN WText = "%".
- ELSE WText = "Fr.".
- cText = STRING(nRabWert,"z9.99-")
- + WText.
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Preis', cText ).
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', TRIM(STRING(- Rundbetr,'->>>,>>9.99')) ).
- END.
-
- /* Total nach Abzug des Auftrag- / Abhol-Rabattes --------------------- */
-
- IF iArtZeile > 0 THEN
- DO:
- iArtZeile = iArtZeile + 1.
- cText = TRIM(SUBSTRING(cFormText[14],21,20)).
- RUN vpr_asc2rtf ( cText, 'bold', OUTPUT cText).
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', cText ).
- cText = TRIM(STRING(nFakBetr,'->>>,>>9.99')).
- RUN vpr_asc2rtf ( cText, 'bold', OUTPUT cText).
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', cText ).
- iArtZeile = iArtZeile + 1.
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', ' ' ).
- END.
- IF iArtZeile > 0 THEN
- DO:
- ii = DYNAMIC-FUNCTION ('calculateBlock':U, 'ArtikelZeile1') NO-ERROR.
- ii = ii + vpr_getPageVPos() + 50.
- IF ii > (iMaxPos) THEN
- DO:
- RUN VIPER_NEUE_SEITE.
- END.
-
- RUN AUSGABE_ARTIKELZEILE.
- END.
-
- /* Recycling-Gebuehren ----------------------------------------------- */
- iArtZeile = 0.
- FOR EACH AufGKon NO-LOCK
- WHERE AufGKon.Firma = bAufko.Firma
- AND AufGKon.Aufnr = bAufko.Aufnr
- AND AufGKon.Gebuehr <> 0
- AND AufGKon.Betrag <> 0 :
-
- FIND GebKonto OF AufGKon NO-LOCK NO-ERROR.
- IF NOT AVAILABLE GebKonto THEN cText = TRIM(SUBSTRING(cFormText[11],41,20)).
- ELSE cText = GebKonto.Bez.
-
- iMwstCd = AufGKon.MWST_Cd.
- nFakBetr = nFakBetr + AufGKon.Betrag.
-
- iArtZeile = iArtZeile + 1.
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', cText ).
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', TRIM(STRING(AufGKon.Betrag,'->>>,>>9.999')) ).
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'MC', STRING(AufGKon.MWSt_Cd,'z9') ).
- END.
- IF iArtZeile > 0 THEN
- DO:
- iArtZeile = iArtZeile + 1.
- cText = TRIM(SUBSTRING(cFormText[14],41,20)).
- RUN vpr_asc2rtf ( cText, 'bold', OUTPUT cText).
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', cText ).
- cText = TRIM(STRING(nFakBetr,'->>>,>>9.999')).
- RUN vpr_asc2rtf ( cText, 'bold', OUTPUT cText).
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', cText ).
- iArtZeile = iArtZeile + 1.
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', ' ' ).
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Betrag', ' ' ).
- END.
- RELEASE AufGKon.
-
- /* Gebinde Aus- und Eingänge ---------------------------------------- */
- IF FDebst.Geb_Rg THEN
- DO:
- FOR EACH AufGKon NO-LOCK
- WHERE AufGKon.Firma = bAufko.Firma
- AND AufGKon.Aufnr = bAufko.Aufnr
- AND AufGKon.Depot <> 0
- AND AufGKon.Betrag <> 0 :
- FIND FIRST tGebKto WHERE tGebKto.Geb_Cd = AufGKon.Geb_Cd NO-ERROR.
- IF NOT AVAILABLE tGebKto THEN
- DO:
- FIND GebKonto NO-LOCK
- WHERE GebKonto.Firma = AufGKon.Firma
- AND GebKonto.Geb_Cd = AufGKon.Geb_Cd.
- CREATE tGebKto.
- ASSIGN
- tGebKto.Sort_Cd = GebKonto.Sort_Cd
- tGebKto.Geb_Cd = GebKonto.Geb_Cd
- tGebKto.Bez = GebKonto.Bez
- tGebKto.Preis = AufGKon.Depot
- tGebKto.MWST_Cd = AufGKon.MWSt_Cd.
- END.
- tGebKto.A_Anz = tGebKto.A_Anz + AufGKon.Ausgang.
- tGebKto.A_Betrag = tGebKto.A_Anz * tGebKto.Preis.
- tGebKto.E_Anz = tGebKto.E_Anz + AufGKon.Eingang.
- tGebKto.E_Betrag = tGebKto.E_Anz * tGebKto.Preis.
- END.
- RELEASE AufGKon.
-
- /* Gebindelieferungen ------------------------------------------------ */
- nBetrag = 0.
- FOR EACH AufGKon NO-LOCK
- WHERE AufGKon.Firma = bAufko.Firma
- AND AufGKon.Aufnr = bAufko.Aufnr
- AND AufGKon.Depot <> 0
- AND (AufGKon.Eingang <> 0 OR
- AufGKon.Ausgang <> 0)
-
- BREAK BY AufgKon.Firma
- BY AufGKon.Aufnr:
- FIND GebKonto NO-LOCK
- WHERE GebKonto.Firma = cFirma
- AND GebKonto.Geb_Cd = AufGKon.Geb_Cd.
- i1 = AufGKon.Ausgang - AufGKon.Eingang.
- Rundbetr = AufGKon.Betrag.
- iMwstCd = AufGKon.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(AufGKon.Ausgang,"->>,>>9")) ).
- RUN VIPER_CREATE_DOKUMENT ( 'Gebindeabrechnung', iArtZeile, 'GebindeRet' , TRIM(STRING(AufGKon.Eingang,"->>,>>9")) ).
- RUN VIPER_CREATE_DOKUMENT ( 'Gebindeabrechnung', iArtZeile, 'GebindeSaldo', TRIM(STRING(i1 ,"->>,>>9")) ).
- IF lPreis THEN
- RUN VIPER_CREATE_DOKUMENT ( 'Gebindeabrechnung', iArtZeile, 'GebindeBetr' , TRIM(STRING(Rundbetr ,"->>,>>9.999")) ).
- END.
- RELEASE AufGKon.
- RELEASE GebKonto.
-
- IF lPreis AND
- iArtZeile > 0 THEN
- DO:
- RUN VIPER_CREATE_DOKUMENT ( 'Gebindeabrechnung', iArtZeile, 'GebindeTot' , TRIM(STRING(nBetrag ,"->>>,>>9.999")) ).
- iArtZeile = iArtZeile + 1.
- RUN VIPER_CREATE_DOKUMENT ( 'Gebindeabrechnung', iArtZeile, 'GebindeTot' , ' ' ).
- END.
- nFakBetr = nFakBetr + nBetrag.
- END.
- IF iArtZeile > 0 THEN
- DO:
- ii = DYNAMIC-FUNCTION ('calculateBlock':U, 'ArtikelZeile1') NO-ERROR.
- ii = ii + DYNAMIC-FUNCTION ('calculateBlock':U, 'Gebindeabrechnung') NO-ERROR.
- ii = ii + vpr_getPageVPos() + 50.
- IF ii > (iMaxPos) THEN
- DO:
- RUN VIPER_NEUE_SEITE.
- END.
- RUN AUSGABE_GRUPPE ( 'ArtikelZeile1' ).
- RUN AUSGABE_GRUPPE ( 'Gebindeabrechnung' ).
- END.
-
- /* Mehrwertsteuer ---------------------------------------------------- */
- nPfli = 0.
- nMwst = 0.
- i1 = 2.
- DO ii = 1 TO 11:
- IF bAufko.WPfl[ii] = 0 THEN NEXT.
- nPfli[ii] = bAufko.Wpfl[ii].
- nMwst[ii] = bAufko.Wust[ii].
- nFakBetr = nFakBetr + nMwst[ii].
- i1 = i1 + 1.
- END.
-
- iArtZeile = 0.
- 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 <= bAufko.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', 'Rechnungsbetrag inkl. Mehrwertsteuer' ).
- RUN VIPER_CREATE_DOKUMENT ( 'RechnungsTotal', iArtZeile, 'EndBetrag', TRIM(STRING(nFakBetr,"->>>,>>9.99")) ).
-
- FIND FIRST Kondi NO-LOCK
- WHERE Kondi.Kond = bAufko.Kond.
- IF Kondi.Skonto[01] <> 0 THEN
- DO:
- Rundbetr = bAufko.Sk_Ber * Kondi.Skonto[01] / 100.
- Rundcode = 1.
- RUN RUNDEN ( Rundcode, INPUT-OUTPUT Rundbetr ).
- iArtZeile = iArtZeile + 1.
- RUN VIPER_CREATE_DOKUMENT ( 'RechnungsTotal', iArtZeile, 'Rechnungsbetrag_T', ' ' ).
- iArtZeile = iArtZeile + 1.
- RUN VIPER_CREATE_DOKUMENT ( 'RechnungsTotal', iArtZeile, 'Rechnungsbetrag_T', 'Skontoabzug' ).
- RUN VIPER_CREATE_DOKUMENT ( 'RechnungsTotal', iArtZeile, 'EndBetrag', TRIM(STRING(Rundbetr,"->>>,>>9.99")) ).
-
- Rundbetr = nFakBetr - Rundbetr.
- iArtZeile = iArtZeile + 1.
- RUN VIPER_CREATE_DOKUMENT ( 'RechnungsTotal', iArtZeile, 'Rechnungsbetrag_T', 'Barzahlungsbetrag' ).
- RUN VIPER_CREATE_DOKUMENT ( 'RechnungsTotal', iArtZeile, 'EndBetrag', TRIM(STRING(Rundbetr,"->>>,>>9.99")) ).
- END.
- iArtZeile = iArtZeile + 1.
- RUN VIPER_CREATE_DOKUMENT ( 'RechnungsTotal', iArtZeile, 'Rechnungsbetrag_T', Kondi.KoText ).
-
- RUN AUSGABE_GRUPPE ( 'RechnungsTotal' ).
- lEnde = TRUE.
- RUN VIPER_NEUE_SEITE.
-
- IF iLauf < iAnzDok THEN
- DO:
- RUN vpr_EndDoc.
- IF tParam.lDokDruck THEN RUN vpr_PrintDoc ( 0, 0 ).
- RETURN.
- END.
-
- /* ------------------------------------------------------ */
- /* Druckausgabe */
- /* ------------------------------------------------------ */
- IF bAufko.Auf_Tot > 0 THEN
- DO:
- RUN vpr_newPage.
- RUN DRUCKEN_QRCODE.
- END.
- RUN vpr_EndDoc.
- IF tParam.lDokDruck THEN RUN vpr_printDoc ( 0, 0 ).
-
- cvpr_Dokument = SUBSTITUTE(cERPDokumente,
- tParam.cInstall,
- 'Rechnungen',
- SUBSTITUTE('&1-&2_&3.vpr',
- STRING(bAufko.Knr ,'999999'),
- STRING(bAufko.Faknr,'9999999'),
- tParam.cDokument) ).
- RUN vpr_SaveDoc ( cvpr_Dokument ).
- IF tParam.lCreatePDF THEN
- DO:
- cPDFName = REPLACE(cvpr_Dokument, '.vpr', '.pdf').
- RUN vpr_printPDF (0, 0, INPUT-OUTPUT cPDFName ).
- END.
- IF tParam.lOpenPDF THEN
- DO:
- DEFINE VARIABLE 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:
- ------------------------------------------------------------------------------*/
- DEFINE VARIABLE cZellen AS CHARACTER NO-UNDO.
- DEFINE VARIABLE cWerte AS CHARACTER NO-UNDO.
- DEFINE VARIABLE iPos AS INTEGER 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.
- iPos = vpr_getGroupVPos('KopfDetail').
- iVPagePos = vpr_getCellVPos('Seite_T', 'Kopf') + vpr_getCellHeight('Seite_T', 'Kopf').
- IF iPos > iVPagePos THEN iVPagePos = iPos.
- iVPagePos = iVPagePos + 20.
- RUN vpr_setGroupVPos ( 'Ueberschrift', iVPagePos ).
- RUN vpr_FlushGroup ( 'Ueberschrift' ).
-
- iPos = vpr_getGroupVPos('Ueberschrift') + vpr_getGroupHeight('Ueberschrift').
- RUN vpr_setPageVPos ( iPos ).
-
- 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:
- ------------------------------------------------------------------------------*/
- DEFINE VARIABLE cText AS CHARACTER NO-UNDO.
- DEFINE VARIABLE ii AS INTEGER NO-UNDO.
- DEFINE VARIABLE i1 AS INTEGER NO-UNDO.
-
- FIND FIRST tParam.
- RUN VIPER_NEUE_SEITE.
- IF iSeite = 1 THEN
- DO:
- iFaknr = tParam.iFaknr.
-
- cBesrKopf = ''.
- IF bAufko.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 = bAufko.Adresse[ii].
- i1 = i1 + 1.
- cBesrKopf[i1] = bAufko.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 = 'T_Dokument'
- tDokument.cInhalt = (IF bAufko.Auf_Tot >= 0
- THEN TRIM(SUBSTRING(cFormText[02],01,20))
- ELSE TRIM(SUBSTRING(cFormText[02],21,20))).
- tDokument.cInhalt = tDokument.cInhalt
- + ' '
- + STRING(iFaknr,'z999999').
-
- CREATE tDokument.
- ASSIGN
- tDokument.cGruppe = 'KOPF'
- tDokument.iZeile = 1
- tDokument.cFeld = 'Ort_Datum'
- tDokument.cInhalt = TRIM(SUBSTRING(cFormText[07],01,20))
- + " "
- + STRING(TODAY,"99.99.9999").
- /* Kundennummer */
- CREATE tDokument.
- ASSIGN
- tDokument.cGruppe = 'KOPFDETAIL'
- tDokument.iZeile = 1
- tDokument.cFeld = 'Knr_T'
- tDokument.cInhalt = ENTRY(1, cFormText[24], ';').
- CREATE tDokument.
- ASSIGN
- tDokument.cGruppe = 'KOPFDETAIL'
- tDokument.iZeile = 1
- tDokument.cFeld = 'Knr'
- tDokument.cInhalt = STRING(bAufko.Knr,'999999').
-
- /* Gewicht */
- CREATE tDokument.
- ASSIGN
- tDokument.cGruppe = 'KOPFDETAIL'
- tDokument.iZeile = 1
- tDokument.cFeld = 'Gewicht_T'
- tDokument.cInhalt = ENTRY(3, cFormText[19], ';').
- CREATE tDokument.
- ASSIGN
- tDokument.cGruppe = 'KOPFDETAIL'
- tDokument.iZeile = 1
- tDokument.cFeld = 'Gewicht'
- tDokument.cInhalt = TRIM(STRING(bAufko.Gewicht,'->>>,>>9.999')).
-
- /* Bestellt am */
- CREATE tDokument.
- ASSIGN
- tDokument.cGruppe = 'KOPFDETAIL'
- tDokument.iZeile = 1
- tDokument.cFeld = 'Bestellt_T'
- tDokument.cInhalt = ENTRY(2, cFormText[20], ';').
- CREATE tDokument.
- ASSIGN
- tDokument.cGruppe = 'KOPFDETAIL'
- tDokument.iZeile = 1
- tDokument.cFeld = 'Auf_Datum'
- tDokument.cInhalt = STRING(bAufko.Auf_Datum,'99.99.9999').
-
- /* Lieferdatum */
- CREATE tDokument.
- ASSIGN
- tDokument.cGruppe = 'KOPFDETAIL'
- tDokument.iZeile = 1
- tDokument.cFeld = 'Geliefert_T'
- tDokument.cInhalt = ENTRY(3, cFormText[20], ';').
- CREATE tDokument.
- ASSIGN
- tDokument.cGruppe = 'KOPFDETAIL'
- tDokument.iZeile = 1
- tDokument.cFeld = 'Lief_Datum'
- tDokument.cInhalt = STRING(bAufko.Lief_Datum,'99.99.9999').
-
- /* Auftragstext, Abladevorschrift, Abholtext */
- cText = ''.
- IF bAufko.Auf_Text <> '' THEN
- cText = cText
- + (IF cText = '' THEN '' ELSE CHR(10) )
- + bAufko.Auf_Text.
-
- FIND FIRST tTabTexte WHERE tTabTexte.cRecArt = 'ABLAD' NO-ERROR.
- IF AVAILABLE tTabTexte THEN
- DO:
- IF tTabTexte.cFeld3 <> '' THEN
- cText = cText
- + (IF cText = '' THEN '' ELSE CHR(10) + CHR(10) )
- + tTabTexte.cFeld3.
- END.
- IF bAufko.Abh_Text <> '' THEN
- cText = cText
- + (IF cText = '' THEN '' ELSE CHR(10) + CHR(10) )
- + bAufko.Abh_Text.
-
- IF cText <> '' THEN
- DO:
- RUN vpr_asc2rtf ( cText, '', OUTPUT cText).
- CREATE tDokument.
- ASSIGN
- tDokument.cGruppe = 'KOPFDETAIL'
- tDokument.iZeile = 1
- tDokument.cFeld = 'Kopftexte'
- tDokument.cInhalt = cText.
- END.
- /* Seitentext */
- CREATE tDokument.
- ASSIGN
- tDokument.cGruppe = 'KOPF'
- tDokument.iZeile = 1
- tDokument.cFeld = 'Seite_T'
- tDokument.cInhalt = ENTRY(2, cFormText[24], ';').
- END.
-
- RUN DRUCKEN_ADRESSE.
-
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ENDIF
- &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 hAufko AS HANDLE NO-UNDO.
- DEFINE VARIABLE cBesrTemplate AS CHARACTER NO-UNDO INIT 'viper/wiederkehr/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.
- hAufko = 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(bAufko.Aufnr,'9999999')).
- RUN 'SwissQR/SwissQRCode.p' ( hAufko, 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
- &IF DEFINED(EXCLUDE-DRUCKEN_RUECKSTAND) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN_RUECKSTAND Procedure
- PROCEDURE DRUCKEN_RUECKSTAND :
- /*------------------------------------------------------------------------------
- Purpose:
- Parameters: <none>
- Notes:
- ------------------------------------------------------------------------------*/
- DEFINE INPUT PARAMETER ipRecid AS RECID NO-UNDO.
-
- DEFINE VARIABLE cString AS CHARACTER NO-UNDO.
-
- FIND tRueckst WHERE RECID(tRueckst) = ipRecid NO-LOCK.
- FIND Aufze WHERE RECID(Aufze) = tRueckst.Zeile NO-LOCK.
- iArtZeile = iArtZeile + 1.
- DO WHILE Aufze.Artnr = 0:
- CREATE tDokument.
- ASSIGN
- tDokument.cGruppe = 'ArtikelZeile1'
- tDokument.iZeile = iArtZeile
- tDokument.cFeld = 'Bez1'
- tDokument.cInhalt = Aufze.Bez1.
-
- IF Aufze.Bez2 <> '' THEN
- DO:
- iArtZeile = iArtZeile + 1.
- CREATE tDokument.
- ASSIGN
- tDokument.cGruppe = 'ArtikelZeile1'
- tDokument.iZeile = iArtZeile
- tDokument.cFeld = 'Bez1'
- tDokument.cInhalt = Aufze.Bez2.
- END.
- RETURN.
- END.
- FIND Artst OF Aufze NO-LOCK.
-
- FIND VGebinde NO-LOCK
- WHERE VGebinde.Firma = cFirma
- AND VGebinde.Geb_Cd = Aufze.VGeb_Cd NO-ERROR.
- FIND KGebinde NO-LOCK
- WHERE KGebinde.Firma = cFirma
- AND KGebinde.Geb_Cd = Aufze.KGeb_Cd NO-ERROR.
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'KGebinde', KGebinde.Kbez ).
-
- IF Aufze.VGeb_Ru <> 0 THEN
- DO:
- cString = STRING(Aufze.VGeb_Ru,'->>>>')
- + 'x '
- + VGebinde.KBez.
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'VGebinde', cString ).
- END.
-
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Menge', STRING(Aufze.MRuek,'->>,>>9') ).
- cString = Aufze.Bez1.
- IF Aufze.Bez2 <> '' THEN cString = cString
- + (IF cString = '' THEN '' ELSE CHR(10))
- + Aufze.Bez2.
- IF Aufze.Aktion THEN cString = cString
- + (IF cString = '' THEN '' ELSE CHR(10))
- + Aufze.Aktion_Text.
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Bez1', cString ).
-
- IF Aufze.Jahr > 9 THEN
- DO:
- cString = STRING(Aufze.Jahr,"9999").
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'JG', cString ).
- END.
-
- IF Aufze.Alk_Gehalt <> 0 THEN
- DO:
- cString = STRING(Aufze.Alk_Gehalt,"zz9.9%").
- RUN VIPER_CREATE_DOKUMENT ( 'ArtikelZeile1', iArtZeile, 'Alk%', cString ).
- END.
- RUN AUSGABE_GRUPPE ( 'ArtikelZeile1' ).
-
- RELEASE Aufze .
- RELEASE Artst .
- RELEASE VGebinde.
- RELEASE KGebinde.
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ENDIF
- &IF DEFINED(EXCLUDE-FUELLEN_tAufze) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE FUELLEN_tAufze Procedure
- PROCEDURE FUELLEN_tAufze :
- /*------------------------------------------------------------------------------
- Purpose:
- Parameters: <none>
- Notes:
- ------------------------------------------------------------------------------*/
- DEFINE INPUT PARAMETER ipAufnr AS INTEGER NO-UNDO.
- DEFINE VARIABLE minPos AS INTEGER NO-UNDO.
- DEFINE VARIABLE maxPos AS INTEGER NO-UNDO.
- DEFINE VARIABLE jPlatz AS INTEGER NO-UNDO INIT 1.
- DEFINE VARIABLE cLagOrt AS CHARACTER NO-UNDO.
- DEFINE VARIABLE iRuestArt AS INTEGER NO-UNDO.
- DEFINE VARIABLE iPlusMinus AS INTEGER NO-UNDO.
- DEFINE VARIABLE lArtikel AS LOG NO-UNDO.
- DEFINE VARIABLE cSort AS CHARACTER NO-UNDO.
- EMPTY TEMP-TABLE tAufze.
-
- 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 Aufze NO-LOCK
- WHERE Aufze.Firma = cFirma
- AND Aufze.Aufnr = ipAufnr
- AND Aufze.Pos > minPos:
-
- IF Aufze.Artnr > 0 THEN
- DO:
- lArtikel = TRUE.
- LEAVE.
- END.
-
- minPos = Aufze.Pos.
- CREATE tAufze.
- ASSIGN
- tAufze.Aufnr = Aufze.Aufnr
- tAufze.Artnr = Aufze.Artnr
- tAufze.Inhalt = Aufze.Inhalt
- tAufze.Jahr = Aufze.Jahr
- tAufze.Pos = Aufze.Pos
- tAufze.Zeile = RECID(Aufze)
- tAufze.Aktion = Aufze.Aktion
- tAufze.Preis = Aufze.Preis
- tAufze.MGeli = Aufze.MGeli
- tAufze.MRuek = Aufze.MRuek.
-
- ASSIGN
- tAufze.Sort1 = ''
- tAufze.Sort2 = ''
- tAufze.Sort3 = STRING(tAufze.Artnr ,'999999')
- + STRING(tAufze.Inhalt,'9999')
- + STRING(tAufze.Jahr ,'9999')
- + STRING(iPlusMinus ,'9')
- + STRING(tAufze.Pos ,'99999')
- tAufze.LagOrt = ''.
- END.
-
- /* Kommentar am Ende eines Auftrages */
- IF lArtikel THEN
- DO:
- FOR EACH Aufze NO-LOCK
- WHERE Aufze.Firma = cFirma
- AND Aufze.Aufnr = ipAufnr
- BY Aufze.Pos DESCENDING:
-
- IF Aufze.Artnr > 0 THEN LEAVE.
-
- maxPos = Aufze.Pos.
- CREATE tAufze.
- ASSIGN
- tAufze.Aufnr = Aufze.Aufnr
- tAufze.Artnr = Aufze.Artnr
- tAufze.Inhalt = Aufze.Inhalt
- tAufze.Jahr = Aufze.Jahr
- tAufze.Pos = Aufze.Pos
- tAufze.Zeile = RECID(Aufze)
- tAufze.Aktion = Aufze.Aktion
- tAufze.Preis = Aufze.Preis
- tAufze.MGeli = Aufze.MGeli
- tAufze.MRuek = Aufze.MRuek.
-
- ASSIGN
- tAufze.Sort1 = 'ZZZ'
- tAufze.Sort2 = ''
- tAufze.Sort3 = STRING(tAufze.Artnr ,'999999')
- + STRING(tAufze.Inhalt,'9999')
- + STRING(tAufze.Jahr ,'9999')
- + STRING(iPlusMinus ,'9')
- + STRING(tAufze.Pos ,'99999')
- tAufze.LagOrt = ''.
- END.
- END.
-
- /* Artikelzeilen nach Lagerort/WarenGruppe/ProdGruppen/Artikelgruppen */
- cLagOrt = ''.
- cSort = ''.
- FOR EACH Aufze NO-LOCK
- WHERE Aufze.Firma = cFirma
- AND Aufze.Aufnr = ipAufnr
- AND Aufze.Pos > minPos
- AND Aufze.Pos < MaxPos
- BY Aufze.Pos DESCENDING:
-
- IF Aufze.Artnr > 0 THEN
- DO:
- FIND Artst NO-LOCK
- WHERE Artst.Firma = Aufze.Firma
- AND Artst.Artnr = Aufze.Artnr
- AND Artst.Inhalt = Aufze.Inhalt
- AND Artst.Jahr = Aufze.Jahr NO-ERROR.
-
- FIND ArtLager NO-LOCK
- WHERE ArtLager.Firma = Aufze.Firma
- AND ArtLager.Artnr = Aufze.Artnr
- AND ArtLager.Inhalt = Aufze.Inhalt
- AND ArtLager.Jahr = Aufze.Jahr
- AND ArtLager.Lager = Aufze.Lager NO-ERROR.
- IF AVAILABLE ArtLager THEN cLagOrt = ArtLager.Ort.
-
- ASSIGN
- iWgr = Artst.Wg_Grp
- iPgr = Artst.Prod_Grp
- iAgr = Artst.Art_Grp
- iArtnr = Artst.Artnr
- iInhalt = Artst.Inhalt
- iJahr = Artst.Jahr.
- END.
- cSort = STRING(iWgr,'9999')
- + STRING(iPgr,'9999')
- + STRING(iAgr,'9999').
-
- iPlusMinus = (IF Aufze.MGeli < 0 THEN 1 ELSE 0).
- CREATE tAufze.
- ASSIGN
- tAufze.Aufnr = Aufze.Aufnr
- tAufze.Artnr = Aufze.Artnr
- tAufze.Inhalt = Aufze.Inhalt
- tAufze.Jahr = Aufze.Jahr
- tAufze.Pos = Aufze.Pos
- tAufze.Zeile = RECID(Aufze)
- tAufze.Aktion = Aufze.Aktion
- tAufze.Preis = Aufze.Preis
- tAufze.MGeli = Aufze.MGeli
- tAufze.MRuek = Aufze.MRuek.
-
- ASSIGN
- tAufze.Sort1 = cLagOrt
- tAufze.Sort2 = cSort
- tAufze.Sort3 = STRING(iArtnr ,'999999')
- + STRING(iInhalt ,'9999')
- + STRING(iJahr ,'9999')
- + STRING(iPlusMinus,'9')
- + STRING(tAufze.Pos,'99999')
- tAufze.LagOrt = cLagort.
- END.
-
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ENDIF
- &IF DEFINED(EXCLUDE-FUELLEN_UEBERSCHRIFT) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE FUELLEN_UEBERSCHRIFT Procedure
- PROCEDURE FUELLEN_UEBERSCHRIFT :
- /*------------------------------------------------------------------------------
- Purpose:
- Notes:
- ------------------------------------------------------------------------------*/
-
- DEFINE VARIABLE cZellen AS CHARACTER NO-UNDO.
- DEFINE VARIABLE cWerte AS CHARACTER NO-UNDO.
- CREATE tDokument.
- ASSIGN
- tDokument.cGruppe = 'UEBERSCHRIFT'
- tDokument.iZeile = 1
- tDokument.cFeld = 'Artnr_T'
- tDokument.cInhalt = ENTRY(1, cFormText[23], ';').
- CREATE tDokument.
- ASSIGN
- tDokument.cGruppe = 'UEBERSCHRIFT'
- tDokument.iZeile = 1
- tDokument.cFeld = 'VGeb_Menge_T'
- tDokument.cInhalt = ENTRY(2, cFormText[23], ';').
- CREATE tDokument.
- ASSIGN
- tDokument.cGruppe = 'UEBERSCHRIFT'
- tDokument.iZeile = 1
- tDokument.cFeld = 'VGeb_T'
- tDokument.cInhalt = ENTRY(3, cFormText[23], ';').
- CREATE tDokument.
- ASSIGN
- tDokument.cGruppe = 'UEBERSCHRIFT'
- tDokument.iZeile = 1
- tDokument.cFeld = 'KGeb_Menge_T'
- tDokument.cInhalt = ENTRY(4, cFormText[23], ';').
- CREATE tDokument.
- ASSIGN
- tDokument.cGruppe = 'UEBERSCHRIFT'
- tDokument.iZeile = 1
- tDokument.cFeld = 'KGeb_T'
- tDokument.cInhalt = ENTRY(5, cFormText[23], ';').
- CREATE tDokument.
- ASSIGN
- tDokument.cGruppe = 'UEBERSCHRIFT'
- tDokument.iZeile = 1
- tDokument.cFeld = 'Bez_T'
- tDokument.cInhalt = ENTRY(6, cFormText[23], ';').
- CREATE tDokument.
- ASSIGN
- tDokument.cGruppe = 'UEBERSCHRIFT'
- tDokument.iZeile = 1
- tDokument.cFeld = 'Alk%_T'
- tDokument.cInhalt = ENTRY(7, cFormText[23], ';').
- CREATE tDokument.
- ASSIGN
- tDokument.cGruppe = 'UEBERSCHRIFT'
- tDokument.iZeile = 1
- tDokument.cFeld = 'JG_T'
- tDokument.cInhalt = ENTRY(8, cFormText[23], ';').
- CREATE tDokument.
- ASSIGN
- tDokument.cGruppe = 'UEBERSCHRIFT'
- tDokument.iZeile = 1
- tDokument.cFeld = 'Preis_T'
- tDokument.cInhalt = ENTRY(9, cFormText[23], ';').
- CREATE tDokument.
- ASSIGN
- tDokument.cGruppe = 'UEBERSCHRIFT'
- tDokument.iZeile = 1
- tDokument.cFeld = 'Betrag_T'
- tDokument.cInhalt = ENTRY(10, cFormText[23], ';').
- CREATE tDokument.
- ASSIGN
- tDokument.cGruppe = 'UEBERSCHRIFT'
- tDokument.iZeile = 1
- tDokument.cFeld = 'MC_T'
- tDokument.cInhalt = ENTRY(11, cFormText[23], ';').
- cZellen = ''.
- cWerte = ''.
- FOR EACH tDokument
- WHERE tDokument.cGruppe = 'Ueberschrift'
- 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 ('Ueberschrift', cZellen, cWerte).
- 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 */
- /* */
- /*---------------------------------------------------------------------------*/
- DEFINE INPUT-OUTPUT PARAMETER PZBetrag AS CHARACTER FORMAT "x(13)".
- DEFINE INPUT-OUTPUT PARAMETER PZReferenz AS CHARACTER FORMAT "x(27)".
- DEFINE INPUT-OUTPUT PARAMETER PZTNummer AS CHARACTER FORMAT "x(09)".
- DEFINE OUTPUT PARAMETER VSZeile AS CHARACTER FORMAT "x(58)".
-
- DEFINE VARIABLE l1 AS INTEGER.
- DEFINE VARIABLE l2 AS INTEGER.
- DEFINE VARIABLE l3 AS INTEGER.
- DEFINE VARIABLE PZ AS INTEGER.
- DEFINE VARIABLE x1 AS INTEGER.
- DEFINE VARIABLE x2 AS INTEGER.
- DEFINE VARIABLE x3 AS INTEGER.
- DEFINE VARIABLE VMOD10 AS CHARACTER 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-SEND_MAIL) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE SEND_MAIL Procedure
- PROCEDURE SEND_MAIL :
- /*------------------------------------------------------------------------------
- Purpose:
- Parameters: <none>
- Notes:
- ------------------------------------------------------------------------------*/
- DEFINE INPUT PARAMETER ipAttachment AS CHARACTER NO-UNDO.
- FIND FIRST tParam.
- DEFINE VARIABLE cTo AS CHARACTER NO-UNDO.
- DEFINE VARIABLE cCc AS CHARACTER NO-UNDO.
- DEFINE VARIABLE lRetValue AS LOG NO-UNDO.
- DEFINE VARIABLE cMeldung AS CHARACTER NO-UNDO.
- DEFINE VARIABLE cSubject AS CHARACTER NO-UNDO.
- DEFINE VARIABLE cBody AS CHARACTER NO-UNDO.
- DEFINE VARIABLE cQuittung AS CHARACTER NO-UNDO.
- DEFINE VARIABLE cName AS CHARACTER NO-UNDO.
- DEFINE VARIABLE ii AS INTEGER NO-UNDO.
- DEFINE VARIABLE iInd AS INTEGER NO-UNDO.
- DEFINE VARIABLE cNamen AS CHARACTER NO-UNDO.
-
- FIND FIRST tParam.
-
- FIND Adresse NO-LOCK
- WHERE Adresse.Firma = AdFirma
- AND Adresse.Knr = tParam.iKnr NO-ERROR.
- cTo = Adresse.Mail.
- cTo = 'rs@adprime.ch'.
- cCc = 'wr@adprime.ch'.
-
- IF cTo = '' THEN RETURN.
- IF INDEX(cTo, '@') = 0 THEN RETURN.
- cSubject = SUBSTITUTE('Rechnung &1 vom &2', tParam.iFaknr, STRING(TODAY,'99.99.9999') ).
- cBody = SUBSTITUTE('Im Anhang die Rechnung von der Lieferung vom &1 ', STRING(TODAY,'99.99.9999') ).
- cQuittung = SUBSTITUTE('&1&2-&3-Quittung.pdf', cPathQuittung, STRING(tParam.iKnr,'999999'), STRING(tParam.iAufnr,'9999999')).
-
- FILE-INFO:FILE-NAME = cQuittung.
- cQuittung = FILE-INFO:FULL-PATHNAME NO-ERROR.
- IF cQuittung = ? THEN cQuittung = ''.
- IF cQuittung <> '' THEN
- DO:
- ipAttachment = ipAttachment
- + (IF ipAttachment = '' THEN '' ELSE ';')
- + cQuittung.
- END.
-
- DO ii = 1 TO NUM-ENTRIES(ipAttachment, ';'):
- cName = ENTRY(ii, ipAttachment, ';').
- cName = REPLACE(cName, '\', '/').
- IF R-INDEX(cName, '/') > 0 THEN cName = SUBSTRING(cName, R-INDEX(cName, '/') + 1).
- cNamen = cNamen
- + (IF cNamen = '' THEN '' ELSE ';')
- + cName.
- END.
- RETURN cMeldung.
- 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:
- ------------------------------------------------------------------------------*/
- DEFINE INPUT PARAMETER ipGruppe AS CHARACTER NO-UNDO.
- DEFINE INPUT PARAMETER ipZeile AS INTEGER NO-UNDO.
- DEFINE INPUT PARAMETER ipFeld AS CHARACTER NO-UNDO.
- DEFINE INPUT PARAMETER ipInhalt AS CHARACTER 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:
- ------------------------------------------------------------------------------*/
- DEFINE VARIABLE cTemplate AS CHARACTER NO-UNDO.
- DEFINE VARIABLE cDokument AS CHARACTER NO-UNDO.
- DEFINE VARIABLE cZellen AS CHARACTER NO-UNDO.
- DEFINE VARIABLE cZelle AS CHARACTER NO-UNDO.
- DEFINE VARIABLE cGruppe AS CHARACTER NO-UNDO.
- DEFINE VARIABLE ii AS INTEGER NO-UNDO.
- DEFINE VARIABLE cString AS CHARACTER NO-UNDO.
- FIND FIRST tParam.
- IF iLauf = iAnzDok AND
- tParam.lCreatePDF THEN
- DO:
- cDokument = tParam.cInstall + '/' + tParam.cDokument + '_pdf.vfr'.
- cTemplate = tParam.cDokument + '_pdf'.
- END.
- ELSE
- DO:
- cDokument = tParam.cInstall + '/' + tParam.cDokument + '.vfr'.
- cTemplate = tParam.cDokument.
- END.
- RUN vpr_LoadVFR (cDokument).
- RUN vpr_ActivateReport (cTemplate).
- 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 iLauf = 1 THEN
- DO:
- IF tParam.Schacht_Original > 0 THEN RUN vpr_SetCurrentPageProperties ( "Papertray", tParam.Schacht_Original ).
- END.
- ELSE
- DO:
- IF tParam.Schacht_Kopie > 0 THEN RUN vpr_SetCurrentPageProperties ( "Papertray", tParam.Schacht_Kopie ).
- END.
- RUN vpr_InitGroups("").
- RUN vpr_InitGraphObj.
-
- RUN vpr_SetGroupAttrib ("Kopf", "Fixed=true").
-
- iMaxPos = 2650.
-
- 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:
- ------------------------------------------------------------------------------*/
- DEFINE VARIABLE iPos AS INTEGER NO-UNDO.
- DEFINE VARIABLE cTempDateiName AS CHARACTER NO-UNDO.
-
- FIND FIRST tParam.
- DO WHILE TRUE:
- IF iSeite = 0 THEN
- DO:
- RUN vpr_InitGroups('').
- iSeite = iSeite + 1.
- RUN FUELLEN_UEBERSCHRIFT.
- LEAVE.
- END.
-
- /* IF tParam.lDokDruck THEN */
- /* DO: */
- /* RUN vpr_SetCurrentPageProperties ( "Papertray", tParam.Schacht_Original ).*/
- /* RUN vpr_printdoc ( iSeite, iSeite ). */
- /* PAUSE 0.2 NO-MESSAGE. */
- /* RUN vpr_SetCurrentPageProperties ( "Papertray", tParam.Schacht_Kopie ).*/
- /* RUN vpr_printdoc ( iSeite, iSeite ). */
- /* END. */
-
- IF NOT lEnde THEN
- DO:
- RUN vpr_NewPage.
- RUN vpr_InitGroups('').
- iSeite = iSeite + 1.
- RUN DRUCKEN_ADRESSE.
- END.
-
- LEAVE.
- END.
-
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ENDIF
- /* ************************ Function Implementations ***************** */
- &IF DEFINED(EXCLUDE-calculateBlock) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION calculateBlock Procedure
- FUNCTION calculateBlock RETURNS INTEGER
- ( ipGruppe AS CHARACTER ):
- /*------------------------------------------------------------------------------
- Purpose:
- Notes:
- ------------------------------------------------------------------------------*/
- DEFINE VARIABLE cZellen AS CHARACTER NO-UNDO.
- DEFINE VARIABLE cWerte AS CHARACTER NO-UNDO.
- DEFINE VARIABLE iSpace AS INTEGER NO-UNDO.
- DEFINE VARIABLE iGrpHo AS INTEGER 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
|