| 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942 |
- &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 ipParam AS CHARACTER NO-UNDO.
- DEFINE VARIABLE cFirma AS CHARACTER NO-UNDO.
- DEFINE VARIABLE ivKnr AS INTEGER NO-UNDO.
- DEFINE VARIABLE ibKnr AS INTEGER NO-UNDO.
- DEFINE VARIABLE ivStufe AS INTEGER NO-UNDO.
- DEFINE VARIABLE ibStufe AS INTEGER NO-UNDO.
- DEFINE VARIABLE dDatum AS DATE NO-UNDO.
- DEFINE VARIABLE AdFirma AS CHARACTER NO-UNDO.
- DEFINE VARIABLE iSeite AS INTEGER NO-UNDO.
- DEFINE VARIABLE iStartPos AS INTEGER INIT 1050 NO-UNDO.
- DEFINE VARIABLE iKnr AS INTEGER NO-UNDO.
- DEFINE VARIABLE iSprcd AS INTEGER NO-UNDO.
- DEFINE VARIABLE cSeite AS CHARACTER NO-UNDO.
- DEFINE VARIABLE iTage AS INTEGER NO-UNDO.
- DEFINE VARIABLE iTind AS INTEGER NO-UNDO.
- DEFINE VARIABLE cStern AS CHARACTER NO-UNDO.
- DEFINE VARIABLE nTotal AS DECIMAL EXTENT 10 NO-UNDO.
- DEFINE VARIABLE nZinsProz AS DECIMAL NO-UNDO.
- DEFINE VARIABLE nZinsMin AS DECIMAL NO-UNDO.
- DEFINE VARIABLE nZinsBetr AS DECIMAL NO-UNDO.
- DEFINE VARIABLE nSaldo AS DECIMAL NO-UNDO.
- DEFINE VARIABLE lGleicheStufe AS LOGICAL NO-UNDO.
- DEFINE VARIABLE cvpr_DokTitel AS CHARACTER NO-UNDO.
- DEFINE VARIABLE cvpr_Dokument AS CHARACTER NO-UNDO.
- DEFINE VARIABLE cPDF_Dokument AS CHARACTER NO-UNDO.
- DEFINE VARIABLE iSubZeile AS INTEGER NO-UNDO.
- DEFINE VARIABLE iArtZeile AS INTEGER NO-UNDO.
- DEFINE VARIABLE iVPagePos AS INTEGER NO-UNDO.
- DEFINE VARIABLE cTexte AS CHARACTER EXTENT 10 NO-UNDO.
- DEFINE VARIABLE lok AS LOG INIT FALSE NO-UNDO.
- DEFINE VARIABLE iPageLimitter AS INTEGER NO-UNDO.
- DEFINE VARIABLE cDateiVpr AS CHARACTER NO-UNDO.
- DEFINE VARIABLE cDateiPDF AS CHARACTER NO-UNDO.
- DEFINE TEMP-TABLE tDokument
- FIELD cGruppe AS CHARACTER
- FIELD iZeile AS INTEGER
- FIELD iSubZeile AS INTEGER
- FIELD cFeld AS CHARACTER
- FIELD cInhalt AS CHARACTER
- FIELD lDelete AS LOG INIT TRUE
-
- INDEX tDokument-k1 IS PRIMARY
- cGruppe
- iZeile
- cFeld.
- DEFINE BUFFER btDokument FOR tDokument.
- DEFINE TEMP-TABLE tTexte NO-UNDO
- FIELD iSprcd AS INTEGER
- FIELD iStufe AS INTEGER
- FIELD iArt AS INTEGER
- FIELD cInhalt AS CHARACTER
- .
-
- DEFINE TEMP-TABLE tMahnung LIKE Mahnung.
-
- DEFINE BUFFER bDebop FOR Debop .
- DEFINE BUFFER bAdresse FOR Adresse.
- DEFINE BUFFER bMahnung FOR Mahnung.
- /* _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 CHARACTER ) FORWARD.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ENDIF
- &IF DEFINED(EXCLUDE-getParameter) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getParameter Procedure
- FUNCTION getParameter RETURNS LOGICAL
- ( /* parameter-definitions */ ) FORWARD.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ENDIF
- &IF DEFINED(EXCLUDE-getSaldoMahnung) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getSaldoMahnung Procedure
- FUNCTION getSaldoMahnung RETURNS DECIMAL
- ( ipKnr AS INTEGER, ipMahStu AS INTEGER, ipFaknr AS INTEGER, ipPassant AS LOG ) FORWARD.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ENDIF
- &IF DEFINED(EXCLUDE-getText) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getText Procedure
- FUNCTION getText RETURNS CHARACTER
- ( ipSprcd AS INTEGER, ipStufe AS INTEGER, ipArt AS INTEGER, ipEntry AS INTEGER ) FORWARD.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ENDIF
- &IF DEFINED(EXCLUDE-putDokument) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD putDokument Procedure
- FUNCTION putDokument RETURNS LOGICAL
- (ipGruppe AS CHARACTER,
- ipBlock AS LOG,
- ipNeuPos AS LOG,
- ipAbstand AS INTEGER ) 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 *************************** */
- DEFINE VARIABLE cText AS CHARACTER NO-UNDO.
- DEFINE VARIABLE ii AS INTEGER NO-UNDO.
- DEFINE VARIABLE nBetrag AS DECIMAL NO-UNDO.
- DYNAMIC-FUNCTION('getParameter':U) NO-ERROR.
- { viper/vpr.i INIT }
- { viper/vpr.i START }
- RUN VIPER_INIT.
- EMPTY TEMP-TABLE tMahnung.
- FOR EACH bMahnung NO-LOCK
- WHERE bMahnung.Firma = cFirma
- AND bMahnung.Knr >= ivKnr
- AND bMahnung.Knr <= ibKnr
- AND bMahnung.MahStu >= ivStufe
- AND bMahnung.MahStu <= ibStufe:
-
- CREATE tMahnung.
- BUFFER-COPY bMahnung
- TO tMahnung.
- IF lGleicheStufe THEN tMahnung.MahStu = 0.
- END.
- FOR EACH tMahnung NO-LOCK,
- FIRST bAdresse NO-LOCK
- WHERE bAdresse.Firma = AdFirma
- AND bAdresse.Knr = tMahnung.Knr
-
- BREAK BY tMahnung.Knr
- BY tMahnung.MahStu
- BY tMahnung.Faknr :
-
- IF FIRST-OF ( tMahnung.MahStu ) OR
- tMahnung.Passant THEN
- DO:
- nSaldo = DYNAMIC-FUNCTION('getSaldoMahnung':U, tMahnung.Knr, tMahnung.MahStu, tMahnung.Faknr, tMahnung.Passant) NO-ERROR.
- iSeite = 0.
- RUN VIPER_FILL_DOKUMENT.
- RUN VIPER_NEUE_SEITE.
- nTotal = 0.
- iArtZeile = 0.
- nZinsBetr = 0.
- iSubZeile = 1.
- EMPTY TEMP-TABLE tDokument.
- END.
-
- iTage = TODAY - tMahnung.Faellig.
- iTind = 1.
- cStern = ''.
- IF iTage >= 001 THEN ASSIGN iTind = 2
- cStern = cStern + '*'.
- IF iTage >= 031 THEN ASSIGN iTind = 3
- cStern = cStern + '*'.
- IF iTage >= 061 THEN ASSIGN iTind = 4
- cStern = cStern + '*'.
- IF iTage >= 091 THEN ASSIGN iTind = 5
- cStern = cStern + '*'.
- nTotal[iTind] = nTotal[iTind] + tMahnung.Saldo.
- nTotal[08] = nTotal[08] + tMahnung.Saldo.
- nTotal[06] = nTotal[06]
- + (IF iTind > 1 THEN tMahnung.Saldo ELSE 0.00).
- IF iTage >= 061 AND
- nZinsProz <> 0 AND
- tMahnung.Saldo > 0 THEN
- DO:
- nBetrag = tMahnung.Saldo * nZinsProz / 100 * (iTage - 60) / 360.
- RUN RUNDEN ( 1, INPUT-OUTPUT nBetrag ).
- nZinsBetr = nZinsBetr + nBetrag.
- nTotal[08] = nTotal[08] + nBetrag.
- END.
-
- iArtZeile = iArtZeile + 1.
- RUN VIPER_CREATE_DOKUMENT ( 'Daten', iArtZeile, iSubZeile, 'Daten_Faknr' , TRIM(STRING(tMahnung.Faknr ,'>999999')) ).
- RUN VIPER_CREATE_DOKUMENT ( 'Daten', iArtZeile, iSubZeile, 'Daten_Fakdatum', TRIM(STRING(tMahnung.Fakdat ,'99.99.9999')) ).
- RUN VIPER_CREATE_DOKUMENT ( 'Daten', iArtZeile, iSubZeile, 'Daten_Faellig' , TRIM(STRING(tMahnung.Faellig,'99.99.9999')) ).
- RUN VIPER_CREATE_DOKUMENT ( 'Daten', iArtZeile, iSubZeile, 'Daten_Betrag' , TRIM(STRING(tMahnung.Fakbetr,'->>>,>>>,>>9.99')) ).
- IF tMahnung.Zahbetr <> 0 THEN RUN VIPER_CREATE_DOKUMENT ( 'Daten', iArtZeile, iSubZeile, 'Daten_Bezahlt' , TRIM(STRING(tMahnung.Zahbetr,'->>>,>>>,>>9.99')) ).
- RUN VIPER_CREATE_DOKUMENT ( 'Daten', iArtZeile, iSubZeile, 'Daten_Saldo' , TRIM(STRING(tMahnung.Saldo ,'->>>,>>>,>>9.99')) ).
- RUN VIPER_CREATE_DOKUMENT ( 'Daten', iArtZeile, iSubZeile, 'Daten_Stern' , cStern ).
-
- IF NOT LAST-OF ( tMahnung.MahStu ) AND
- NOT tMahnung.Passant THEN NEXT.
-
- DYNAMIC-FUNCTION('putDokument':U, 'Daten', FALSE, TRUE, 50).
-
- cText = DYNAMIC-FUNCTION('getText':U , bAdresse.Sprcd, tMahnung.MahStu, 4, 0 ) NO-ERROR.
- IF cText <> '' THEN
- DO:
- RUN vpr_Asc2RTF (cText, '', OUTPUT cText ).
- RUN VIPER_CREATE_DOKUMENT ( 'Schlusstext', iArtZeile, iSubZeile, 'Schluss_Text', cText ).
- END.
-
- iArtZeile = 0.
- iSubZeile = 1.
- IF (nTotal[04] + nTotal[05]) > nZinsMin THEN nTotal[07] = nZinsBetr.
- DO ii = 1 TO 8:
- IF nTotal[ii] = 0 THEN NEXT.
- iArtZeile = iArtZeile + 1.
- cText = DYNAMIC-FUNCTION ( 'getText':U , bAdresse.Sprcd, tMahnung.MahStu, 5, ii ) NO-ERROR.
- RUN VIPER_CREATE_DOKUMENT ( 'Rekapitulation', iArtZeile, iSubZeile, 'Rekap_Text' , cText ).
- RUN VIPER_CREATE_DOKUMENT ( 'Rekapitulation', iArtZeile, iSubZeile, 'Rekap_Saldo' , TRIM(STRING(nTotal[ii],'->>>,>>>,>>9.99')) ).
- cStern = ''.
- IF ii > 1 AND
- ii < 6 THEN cStern = FILL('*', (ii - 1)).
- RUN VIPER_CREATE_DOKUMENT ( 'Rekapitulation', iArtZeile, iSubZeile, 'Rekap_Stern' , cStern ).
- END.
-
- ii = DYNAMIC-FUNCTION('calcBlock':U, '') NO-ERROR.
- ii = ii + vpr_getPageVPos().
- IF ii >= iPageLimitter THEN
- DO:
- RUN VIPER_NEUE_SEITE.
- END.
-
- DYNAMIC-FUNCTION('putDokument':U, 'Rekapitulation', FALSE, TRUE , 50).
- DYNAMIC-FUNCTION('putDokument':U, 'Schlusstext' , FALSE, TRUE , 50).
-
- IF NOT LAST ( tMahnung.Knr ) THEN RUN vpr_newPage.
- END.
-
-
- RUN vpr_EndDoc.
- /*
- RUN vpr_PrintDoc (0, 0).
- */
- cDateiVpr = SUBSTITUTE('&1Mahnungen_&2_&3_.vpr',
- SESSION:TEMP-DIR,
- REPLACE(STRING(TODAY,'99.99.9999'), '.', ''),
- REPLACE(STRING(TIME ,'HH:MM:SS') , ':', '') ).
- RUN vpr_saveDoc ( cDateiVpr ).
- cDateiPDF = REPLACE(cDateiVpr, '.vpr', '.pdf').
- RUN vpr_printPDF ( 0, 0, INPUT-OUTPUT cDateiPDF ).
- { viper/vpr.i STOP }
- DEFINE VARIABLE o-i AS i NO-UNDO.
- RUN shellExecuteA (0,
- "open",
- cDateiPDF,
- "",
- "",
- 0,
- OUTPUT o-i).
- 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-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 ipSubZeile 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.iSubZeile = ipSubZeile
- tDokument.cFeld = ipFeld
- tDokument.cInhalt = ipInhalt.
-
- END PROCEDURE.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ENDIF
- &IF DEFINED(EXCLUDE-VIPER_FILL_DOKUMENT) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE VIPER_FILL_DOKUMENT Procedure
- PROCEDURE VIPER_FILL_DOKUMENT :
- /*------------------------------------------------------------------------------
- Purpose:
- Parameters: <none>
- Notes:
- ------------------------------------------------------------------------------*/
- DEFINE VARIABLE cString AS CHARACTER NO-UNDO.
- DEFINE VARIABLE cText AS CHARACTER NO-UNDO.
- DEFINE VARIABLE cBetrag AS CHARACTER NO-UNDO.
- DEFINE VARIABLE i1 AS INTEGER NO-UNDO.
- DEFINE VARIABLE i2 AS INTEGER NO-UNDO.
- DEFINE VARIABLE iStufe AS INTEGER NO-UNDO.
- DEFINE VARIABLE cAdr AS CHARACTER EXTENT 12 NO-UNDO.
- iSprcd = bAdresse.Sprcd.
- iStufe = tMahnung.MahStu.
-
- /* Firmen-Anschrift */
- cText = DYNAMIC-FUNCTION('getText':U , iSprcd, iStufe, 0, 1 ) NO-ERROR.
- RUN vpr_setCellText ( 'Firma_Name-1' , 'FirmenKopf', cText ).
- cText = DYNAMIC-FUNCTION('getText':U , iSprcd, iStufe, 0, 2 ) NO-ERROR.
- RUN vpr_setCellText ( 'Firma_Name-2' , 'FirmenKopf', cText ).
- cText = DYNAMIC-FUNCTION('getText':U , iSprcd, iStufe, 0, 3 ) NO-ERROR.
- RUN vpr_setCellText ( 'Firma_Strasse', 'FirmenKopf', cText ).
- cText = DYNAMIC-FUNCTION('getText':U , iSprcd, iStufe, 0, 4 ) NO-ERROR.
- RUN vpr_setCellText ( 'Firma_Ort' , 'FirmenKopf', cText ).
- cText = DYNAMIC-FUNCTION('getText':U , iSprcd, iStufe, 0, 5 ) NO-ERROR.
- RUN vpr_setCellText ( 'Firma_Tel' , 'FirmenKopf', cText ).
- cText = DYNAMIC-FUNCTION('getText':U , iSprcd, iStufe, 0, 6 ) NO-ERROR.
- RUN vpr_setCellText ( 'Firma_Fax' , 'FirmenKopf', cText ).
-
- /* Adresse */
- DO WHILE TRUE:
- IF tMahnung.Passant THEN
- DO:
- FIND Passant NO-LOCK
- WHERE Passant.Firma = cFirma
- AND Passant.Knr = tMahnung.Knr
- AND Passant.Faknr = tMahnung.Faknr NO-ERROR.
- IF AVAILABLE Passant THEN
- DO:
- i2 = 11.
- DO i1 = 5 TO 1 BY -1:
- IF Passant.Adr[i1] = '' THEN NEXT.
- cAdr[i2] = Passant.Adr[i1].
- i2 = i2 - 1.
- END.
- LEAVE.
- END.
- END.
- DO i1 = 1 TO 12:
- cAdr[i1] = bAdresse.Anschrift[i1].
- END.
- LEAVE.
- END.
-
- DO i1 = 1 TO 12:
- cString = SUBSTITUTE('Adresse-&1', TRIM(STRING(i1,'>9')) ).
- RUN vpr_setCellText (cString , 'Adresse', cAdr[i1] ).
- END.
- cText = DYNAMIC-FUNCTION('getText':U , iSprcd, iStufe, 1, 1 ) NO-ERROR. /* Ort */
- cText = cText + ' ' + STRING(TODAY,'99.99.9999').
- RUN vpr_setCellText ('Ort_Datum' , 'Adresse', cText ).
-
- cText = DYNAMIC-FUNCTION('getText':U , iSprcd, iStufe, 1, 2 ) NO-ERROR. /* Kundennummer */
- RUN vpr_setCellText ('Knr_Text', 'Adresse', cText ).
- RUN vpr_setCellText ('Knr_Nr' , 'Adresse', TRIM(STRING(tMahnung.Knr,'>999999')) ).
-
- /* Kopf */
- cText = DYNAMIC-FUNCTION('getText':U , iSprcd, iStufe, 1, 3 ) NO-ERROR. /* Titel */
- cText = REPLACE (cText, ',', ';').
- ii = NUM-ENTRIES(cText, ';').
- IF ii = 1 THEN RUN vpr_setCellText ('Kopf_Titel', 'Kopf', cText ).
- ELSE
- DO:
- IF nSaldo < 0 THEN cText = ENTRY(2, cText, ';').
- ELSE cText = ENTRY(1, ctext, ';').
- RUN vpr_setCellText ('Kopf_Titel', 'Kopf', cText ).
- END.
- /* Kopftext */
- cText = DYNAMIC-FUNCTION('getText':U , iSprcd, iStufe, 2, 0 ) NO-ERROR. /* Kopftext */
- ii = NUM-ENTRIES(cText, ';').
- IF ii = 1 THEN RUN vpr_setCellText ('Kopf_Text', 'Kopf', cText ).
- ELSE
- DO:
- IF nSaldo < 0 THEN cText = ENTRY(2, cText, ';').
- ELSE cText = ENTRY(1, ctext, ';').
- /* RUN vpr_setCellText ('Kopf_Titel', 'Kopf', cText ).*/
- END.
- RUN vpr_Asc2RTF(cText, '', OUTPUT cText ).
- RUN vpr_setCellText ('Kopf_Text', 'Kopf', cText ).
-
- /* Ueberschrift Detail */
- cText = DYNAMIC-FUNCTION('getText':U , iSprcd, iStufe, 3, 1 ) NO-ERROR. /* Berücksichtig */
- cText = cText + ' ' + STRING(dDatum,'99.99.9999').
- RUN vpr_setCellText ('Ueberschrift_Zahlungen_Bis', 'Ueberschrift', cText ).
-
- cText = DYNAMIC-FUNCTION('getText':U , iSprcd, iStufe, 3, 2 ) NO-ERROR. /* Seite */
- cSeite = cText.
-
- cText = DYNAMIC-FUNCTION('getText':U , iSprcd, iStufe, 3, 3 ) NO-ERROR. /* Faknr */
- RUN vpr_setCellText ('Ueber_Faknr_Text' , 'Ueberschrift', cText ).
- cText = DYNAMIC-FUNCTION('getText':U , iSprcd, iStufe, 3, 4 ) NO-ERROR. /* Fakdat */
- RUN vpr_setCellText ('Ueber_Fakdatum_Text', 'Ueberschrift', cText ).
- cText = DYNAMIC-FUNCTION('getText':U , iSprcd, iStufe, 3, 5 ) NO-ERROR. /* Faellig */
- RUN vpr_setCellText ('Ueber_Faellig_Text' , 'Ueberschrift', cText ).
- cText = DYNAMIC-FUNCTION('getText':U , iSprcd, iStufe, 3, 6 ) NO-ERROR. /* Betrag */
- RUN vpr_setCellText ('Ueber_Betrag_Text' , 'Ueberschrift', cText ).
- cText = DYNAMIC-FUNCTION('getText':U , iSprcd, iStufe, 3, 7 ) NO-ERROR. /* Bezahlt */
- RUN vpr_setCellText ('Ueber_Bezahlt_Text' , 'Ueberschrift', cText ).
- cText = DYNAMIC-FUNCTION('getText':U , iSprcd, iStufe, 3, 8 ) NO-ERROR. /* Saldo */
- RUN vpr_setCellText ('Ueber_Saldo_Text' , 'Ueberschrift', cText ).
-
- /* Schlusstext */
- cText = DYNAMIC-FUNCTION('getText':U , iSprcd, iStufe, 4, 0 ) NO-ERROR. /* Kopftext */
- RUN vpr_Asc2RTF(cText, '', OUTPUT cText ).
- RUN vpr_setCellText ('Schluss_Text', 'Schlusstext', cText ).
-
- 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 cDocname AS CHARACTER NO-UNDO.
- DEFINE VARIABLE cInstall AS CHARACTER NO-UNDO.
- DEFINE VARIABLE cParam AS CHARACTER NO-UNDO.
- cInstall = DYNAMIC-FUNCTION('getInstallation':U) NO-ERROR.
-
- cDocName = SUBSTITUTE('Mahnung').
-
- iPageLimitter = 2700.
- cvpr_DokTitel = cDocname.
- cvpr_Dokument = SUBSTITUTE('&1/&2/&3.vfr', 'viper', cInstall, cDocname).
- RUN vpr_LoadVFR (cvpr_Dokument).
- RUN vpr_ActivateReport (cvpr_DokTitel).
- RUN vpr_SelectPrinter (SESSION:PRINTER-NAME).
- cParam = 'duplex=1,copies=1'.
- RUN vpr_SetPrinterAttrib(cParam).
- RUN vpr_ResetDoc.
- RUN vpr_SetPrinterAttrib("Papersize=A4").
- RUN vpr_SetPreviewMode ('Direct').
- RUN vpr_setDocTitle (cvpr_DokTitel).
- RUN vpr_SetDelimiter (CHR(01)).
- RUN vpr_InitGroups ("").
- RUN vpr_InitGraphObj.
-
- 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 cString AS CHARACTER NO-UNDO.
- iSeite = iSeite + 1.
-
- IF iSeite > 1 THEN
- DO:
- RUN vpr_newPage.
- RUN vpr_InitGroups("").
- END.
- RUN vpr_initGraphObj.
- /* Seite */
- cString = cSeite + STRING(iSeite,'zz9').
- RUN vpr_setCellText ( 'Ueberschrift_Seite', 'Ueberschrift', cString ).
-
- RUN vpr_FlushGroup('Firmenkopf').
- IF iSeite = 1 THEN
- DO:
- RUN vpr_FlushGroup('Adresse').
- RUN vpr_FlushGroup('Kopf').
- END.
-
- IF iSeite > 1 THEN iVPagePos = vpr_getPageVPos() + 200.
- ELSE iVPagePos = vpr_getPageVPos() + 050.
- RUN vpr_SetGroupVPos( 'Ueberschrift', iVPagePos ).
- RUN vpr_FlushGroup('Ueberschrift').
-
- iVPagePos = vpr_getPageVPos().
- RUN vpr_FlushGroup('Fusstext').
- RUN vpr_setPageVPos(iVPagePos).
- 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 CHARACTER ) :
- /*------------------------------------------------------------------------------
- Purpose:
- Notes:
- ------------------------------------------------------------------------------*/
- DEFINE VARIABLE cZellen AS CHARACTER NO-UNDO.
- DEFINE VARIABLE cWerte AS CHARACTER NO-UNDO.
- DEFINE VARIABLE iSpace AS INTEGER INIT 0 NO-UNDO.
- DEFINE VARIABLE iGrpHo AS INTEGER INIT 0 NO-UNDO.
- DEFINE VARIABLE iAnzGrp AS INTEGER INIT 0 NO-UNDO.
-
- FOR EACH tDokument
- WHERE tDokument.cGruppe BEGINS ipGruppe
- BREAK BY tDokument.cGruppe
- BY tDokument.iZeile
- BY tDokument.iSubZeile:
- IF FIRST-OF ( tDokument.cGruppe ) THEN
- DO:
- iAnzGrp = iAnzGrp + 1.
- END.
- IF FIRST-OF ( tDokument.iSubZeile ) THEN
- DO:
- cZellen = ''.
- cWerte = ''.
- END.
- cWerte = cWerte
- + (IF cWerte = '' THEN '' ELSE CHR(01))
- + tDokument.cInhalt.
- cZellen = cZellen
- + (IF cZellen = '' THEN '' ELSE ',')
- + tDokument.cFeld.
- IF NOT LAST-OF ( tDokument.iSubZeile ) THEN NEXT.
- RUN vpr_setGroupText (tDokument.cGruppe, cZellen, cWerte).
-
- iGrpHo = vpr_getGroupHeight ( tDokument.cGruppe ).
- iSpace = iSpace + iGrpHo.
- END.
-
- iSpace = iSpace + (iAnzGrp * 40).
-
- RETURN iSpace.
-
- END FUNCTION.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ENDIF
- &IF DEFINED(EXCLUDE-getParameter) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getParameter Procedure
- FUNCTION getParameter RETURNS LOGICAL
- ( /* parameter-definitions */ ) :
- /*------------------------------------------------------------------------------
- Purpose:
- Notes:
- ------------------------------------------------------------------------------*/
- DEFINE VARIABLE ii AS INTEGER NO-UNDO.
- DEFINE VARIABLE iArt AS INTEGER NO-UNDO.
- DEFINE VARIABLE iStufe AS INTEGER NO-UNDO.
-
- DO ii = 1 TO NUM-ENTRIES(ipParam, CHR(01)):
- CASE ii:
- WHEN 01 THEN
- cFirma = ENTRY(ii, ipParam, CHR(01)) .
- WHEN 02 THEN
- ivKnr = INTEGER(ENTRY(ii, ipParam, CHR(01))).
- WHEN 03 THEN
- ibKnr = INTEGER(ENTRY(ii, ipParam, CHR(01))).
- WHEN 04 THEN
- ivStufe = INTEGER(ENTRY(ii, ipParam, CHR(01))).
- WHEN 05 THEN
- ibStufe = INTEGER(ENTRY(ii, ipParam, CHR(01))).
- WHEN 06 THEN
- dDatum = DATE (ENTRY(ii, ipParam, CHR(01))).
- WHEN 07 THEN
- lGleicheStufe = (IF ENTRY(ii, ipParam, CHR(01)) BEGINS 'n' THEN FALSE ELSE TRUE).
- END CASE.
- END.
- FIND Steuer NO-LOCK
- WHERE Steuer.Firma = cFirma NO-ERROR.
- AdFirma = Steuer.AdFirma.
- nZinsProz = Steuer.Fwi07.
- nZinsMin = Steuer.Fwi08.
- EMPTY TEMP-TABLE tTexte.
- FOR EACH TabTexte NO-LOCK
- WHERE TabTexte.Firma = cFirma
- AND TabTexte.TextArt BEGINS 'MAHN':
- ASSIGN
- iStufe = INTEGER(SUBSTRING(TabTexte.TextArt,05,02))
- iArt = INTEGER(SUBSTRING(TabTexte.TextArt,07,02)).
- CREATE tTexte.
- ASSIGN
- tTexte.iSprcd = TabTexte.Sprcd
- tTexte.iStufe = iStufe
- tTexte.iArt = iArt
- tTexte.cInhalt = TabTexte.Inhalt.
- END.
- END FUNCTION.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ENDIF
- &IF DEFINED(EXCLUDE-getSaldoMahnung) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getSaldoMahnung Procedure
- FUNCTION getSaldoMahnung RETURNS DECIMAL
- ( ipKnr AS INTEGER, ipMahStu AS INTEGER, ipFaknr AS INTEGER, ipPassant AS LOG ) :
- /*------------------------------------------------------------------------------
- Purpose:
- Notes:
- ------------------------------------------------------------------------------*/
- DEFINE VARIABLE nBetrag AS DECIMAL NO-UNDO.
-
- DEFINE BUFFER tMahnung FOR Mahnung.
- nBetrag = 0.
- FOR EACH tMahnung NO-LOCK
- WHERE tMahnung.Firma = cFirma
- AND tMahnung.Knr = ipKnr
- AND tMahnung.MahStu = ipMahStu
- AND ((NOT ipPassant)
- OR (ipPassant
- AND tMahnung.Faknr = ipFaknr))
- :
- nBetrag = nBetrag + tMahnung.Saldo.
- END.
- RETURN nBetrag.
- END FUNCTION.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ENDIF
- &IF DEFINED(EXCLUDE-getText) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getText Procedure
- FUNCTION getText RETURNS CHARACTER
- ( ipSprcd AS INTEGER, ipStufe AS INTEGER, ipArt AS INTEGER, ipEntry AS INTEGER ) :
- /*------------------------------------------------------------------------------
- Purpose:
- Notes:
- ------------------------------------------------------------------------------*/
- DEFINE VARIABLE cText AS CHARACTER INIT '' NO-UNDO.
- FIND FIRST tTexte NO-LOCK
- WHERE tTexte.iSprcd = ipSprcd
- AND tTexte.iStufe = ipStufe
- AND tTexte.iArt = ipArt NO-ERROR.
- IF NOT AVAILABLE tTexte THEN
- DO:
- FIND FIRST tTexte NO-LOCK
- WHERE tTexte.iSprcd = 1
- AND tTexte.iStufe = ipStufe
- AND tTexte.iArt = ipArt NO-ERROR.
- END.
- IF NOT AVAILABLE tTexte THEN RETURN cText.
- IF ipEntry = 0 THEN
- DO:
- cText = tTexte.cInhalt.
- RETURN cText.
- END.
-
- IF ipEntry > NUM-ENTRIES(tTexte.cInhalt, CHR(10)) THEN RETURN cText.
- DO WHILE TRUE:
- IF ipArt <> 1 THEN LEAVE.
- IF ipEntry <> 3 THEN LEAVE.
- cText = ENTRY(ipEntry, tTexte.cInhalt, CHR(10)).
- IF NUM-ENTRIES(cText, ';') < 2 THEN LEAVE.
-
- IF nSaldo < 0 THEN cText = ENTRY(2, cText, ';').
- ELSE cText = ENTRY(1, cText, ';').
-
- RETURN cText.
- END.
-
- cText = ENTRY(ipEntry, tTexte.cInhalt, CHR(10)).
- RETURN cText.
- END FUNCTION.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ENDIF
- &IF DEFINED(EXCLUDE-putDokument) = 0 &THEN
- &ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION putDokument Procedure
- FUNCTION putDokument RETURNS LOGICAL
- (ipGruppe AS CHARACTER,
- ipBlock AS LOG,
- ipNeuPos AS LOG,
- ipAbstand AS INTEGER ):
- /*------------------------------------------------------------------------------
- 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.
- DEFINE VARIABLE lNeuStart AS LOG INIT FALSE NO-UNDO.
- DEFINE VARIABLE ii AS INTEGER NO-UNDO.
-
- iSpace = vpr_getPageVPos().
- iVPagePos = vpr_getPageVPos().
- IF ipBlock THEN
- DO:
- FOR EACH tDokument
- WHERE tDokument.cGruppe = ipGruppe
- BREAK BY tDokument.cGruppe
- BY tDokument.iZeile
- BY tDokument.iSubZeile:
- IF FIRST-OF ( tDokument.iSubZeile ) THEN
- DO:
- cZellen = ''.
- cWerte = ''.
- END.
- cWerte = cWerte
- + (IF cWerte = '' THEN '' ELSE CHR(01) )
- + tDokument.cInhalt.
- cZellen = cZellen
- + (IF cZellen = '' THEN '' ELSE ',' )
- + tDokument.cFeld.
- IF NOT LAST-OF ( tDokument.iSubZeile ) THEN NEXT.
- RUN vpr_setGroupText (ipGruppe, cZellen, cWerte).
- iGrpHo = vpr_getGroupHeight ( ipGruppe ).
- iSpace = iSpace + iGrpHo.
- END.
- IF iSpace > iPageLimitter THEN RUN VIPER_NEUE_SEITE.
- iSpace = vpr_getPageVPos().
- iVPagePos = vpr_getPageVPos().
- ipNeuPos = TRUE.
- END.
- DO WHILE TRUE:
- lNeuStart = FALSE.
- FOR EACH btDokument
- WHERE btDokument.cGruppe = ipGruppe
- BREAK BY btDokument.cGruppe
- BY btDokument.iZeile
- BY btDokument.iSubZeile:
- IF FIRST-OF ( btDokument.iSubZeile ) THEN
- DO:
- cZellen = ''.
- cWerte = ''.
- iSpace = vpr_getPageVPos().
- iVPagePos = vpr_getPageVPos().
- END.
- cWerte = cWerte
- + (IF cWerte = '' THEN '' ELSE CHR(01))
- + btDokument.cInhalt.
- cZellen = cZellen
- + (IF cZellen = '' THEN '' ELSE ',')
- + btDokument.cFeld.
- IF NOT LAST-OF ( btDokument.iSubZeile ) THEN NEXT.
-
- RUN vpr_setGroupText (ipGruppe, cZellen, cWerte).
- iGrpHo = vpr_getGroupHeight ( ipGruppe ).
- iSpace = iSpace + iGrpHo.
- IF iSpace > iPageLimitter AND
- INDEX (ipGruppe, 'Footer') = 0 AND
- INDEX (ipGruppe, 'ItemCo') = 0 THEN
- DO:
- RUN VIPER_NEUE_SEITE.
- iSpace = vpr_getPageVPos().
- iVPagePos = vpr_getPageVPos().
- ipNeuPos = TRUE.
- lNeuStart = TRUE.
- LEAVE.
- END.
- IF ipNeuPos THEN
- DO:
- iVPagePos = iVPagePos + ipAbstand.
- RUN vpr_setGroupVPos ( ipGruppe, iVPagePos ).
- ipNeuPos = FALSE.
- END.
- RUN vpr_FlushGroup (ipGruppe).
- FOR EACH tDokument
- WHERE tDokument.cGruppe = btDokument.cGruppe
- AND tDokument.iZeile = btDokument.iZeile
- AND tDokument.iSubZeile = btDokument.iSubZeile
- AND tDokument.lDelete = TRUE:
- DELETE tDokument.
- END.
- iSpace = vpr_getPageVPos().
- iVPagePos = vpr_getPageVPos().
- END.
- IF NOT lNeuStart THEN LEAVE.
- END.
- RETURN TRUE.
- END FUNCTION.
- /* _UIB-CODE-BLOCK-END */
- &ANALYZE-RESUME
- &ENDIF
|