GeMIS_WEB/GUI/batchdruck_control.p

&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 VARIABLE cUser AS CHARACTER NO-UNDO.
DEFINE VARIABLE iBeg         AS INTEGER   NO-UNDO.
DEFINE VARIABLE iAnzTrans    AS INTEGER   NO-UNDO.
DEFINE VARIABLE lBatch       AS LOG       NO-UNDO INIT TRUE .
DEFINE VARIABLE cLogFile     AS CHARACTER NO-UNDO.
DEFINE VARIABLE cProgramm    AS CHARACTER NO-UNDO.
DEFINE VARIABLE cDruckart    AS CHARACTER NO-UNDO.
DEFINE VARIABLE cLogFileProg AS CHARACTER NO-UNDO.
DEFINE VARIABLE lAnmeldung   AS LOGICAL   NO-UNDO INIT FALSE.
DEFINE VARIABLE cPasswort    AS CHARACTER NO-UNDO.
DEFINE VARIABLE cMandant     AS CHARACTER NO-UNDO.
DEFINE VARIABLE rASMut       AS RECID     NO-UNDO.
DEFINE VARIABLE cMutArten    AS CHARACTER NO-UNDO 
    INIT 'RUESTDRUCK,wsLIEFERSCHEIN,wsLADEPAPIER,wsPALETT'.    

DEFINE STREAM Out_Stream.
DEFINE STREAM LogStream.

DEFINE BUFFER bASMutation FOR ASMutation.
DEFINE BUFFER dASMutation FOR ASMutation.

/*DEFINE TEMP-TABLE tRuestPos*/
/*    FIELD Aufnr  AS INTEGER*/
/*    FIELD Pos    AS INTEGER*/
/*    FIELD Zeit   AS INTEGER*/
/*    FIELD lDruck AS LOGICAL*/
/*    FIELD rASMut AS RECID .*/

{ super/funktionen.i   }
{ incl/windefinition.i }
{ incl/ttdruckparam.i  }
{ incl/properties.i    }

/* _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-checkIsEnde) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD checkIsEnde Procedure
FUNCTION checkIsEnde RETURNS LOGICAL 
    (  ) FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ENDIF


&IF DEFINED(EXCLUDE-checkIsWorking) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD checkIsWorking Procedure
FUNCTION checkIsWorking RETURNS LOGICAL 
    (  ) FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ENDIF


&IF DEFINED(EXCLUDE-clearControlFlags) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD clearControlFlags Procedure
FUNCTION clearControlFlags RETURNS LOGICAL 
    (  ) FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ENDIF


&IF DEFINED(EXCLUDE-getDruckProgramm) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getDruckProgramm Procedure
FUNCTION getDruckProgramm RETURNS CHARACTER 
    (  ) FORWARD.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ENDIF


&IF DEFINED(EXCLUDE-getLogfileName) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD getLogfileName Procedure 
FUNCTION getLogfileName RETURNS CHARACTER
    ( /* parameter-definitions */ )  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  *************************** */

/*  --------------------------------------------------------------  */
/*  Start lesen ASMutation                                          */
/*  --------------------------------------------------------------  */

DEFINE VARIABLE iTime    AS INTEGER   NO-UNDO.
DEFINE VARIABLE cRetVal  AS CHARACTER NO-UNDO.
DEFINE VARIABLE iTrnr    AS INTEGER   NO-UNDO INIT 0.
DEFINE VARIABLE iAblauf  AS INTEGER   NO-UNDO.
DEFINE VARIABLE cMessage AS CHARACTER NO-UNDO.
DEFINE VARIABLE iRecid   AS RECID     NO-UNDO.
DEFINE VARIABLE lRetVal  AS LOGICAL   NO-UNDO.

REPEAT TRANSACTION ON ERROR UNDO, LEAVE:
    RUN ANMELDEN.
    IF NOT lAnmeldung THEN QUIT.
    LEAVE.
END.

cLogFileProg = SEARCH ('writeLogFile.p').
cProgramm    = DYNAMIC-FUNCTION ('makeProgname':U, THIS-PROCEDURE:HANDLE) NO-ERROR.
cLogFile     = DYNAMIC-FUNCTION ('getLogFileName':U IN THIS-PROCEDURE) NO-ERROR.

/*OUTPUT TO 'C:\LogFiles\xxxx.log'.                           */
/*PUT CONTROL cLogFileProg CHR(10) cProgramm CHR(10) cLogFile.*/
/*OUTPUT CLOSE.                                               */
    
SAktiv   = DYNAMIC-FUNCTION('getSuperaktiv':U) NO-ERROR.
IF SAktiv = ? THEN SAktiv = FALSE.

IF NOT sAktiv THEN 
DO:
    cMessage = 'Anmeldung nicht möglich / nicht geklappt '.
    RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, cMessage ) NO-ERROR.
    QUIT.
END.

AdFirma  = DYNAMIC-FUNCTION('getAdMandant':U) NO-ERROR.
FBFirma  = DYNAMIC-FUNCTION('getFBMandant':U) NO-ERROR.
Firma    = DYNAMIC-FUNCTION('getMandant':U)   NO-ERROR.
cUser    = DYNAMIC-FUNCTION('getBenutzer')      NO-ERROR.
lBatch   = DYNAMIC-FUNCTION('getBatch':U)       NO-ERROR.

cMessage = SUBSTITUTE('Programm &1 gestartet', cProgramm).
RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, cMessage ) NO-ERROR.
    
iBeg      = TIME.
iTime     = ETIME(TRUE).
iTrnr     = -1.
iAnzTrans = 0.

RUN REORG_ASMUTATION.
RUN REORG_TABELLEN.
RUN BEREINIGEN_BATCH.

DYNAMIC-FUNCTION ('clearControlFlags':U).

cMessage = 'Reorg ASMutation, Reorg Tabellen und Bereinigung Batch beendet'.
RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, cMessage ) NO-ERROR.

MAIN-BLOCK:
REPEAT ON ERROR UNDO MAIN-BLOCK, LEAVE MAIN-BLOCK:
        
    FIND FIRST ASMutation NO-LOCK USE-INDEX ASMutation-k2
        WHERE ASMutation.Aktiv         = TRUE
        AND   ASMutation.asmutation_id > iTrnr
        AND   ASMutation.cStatus       = '' NO-ERROR.
    IF NOT AVAILABLE ASMutation THEN 
    DO:
        iTrnr     = -1.
        iAnzTrans = 0.
        PAUSE 2 NO-MESSAGE.
        
        lRetVal = DYNAMIC-FUNCTION ('checkIsWorking':U) NO-ERROR.
        IF lRetVal THEN NEXT  MAIN-BLOCK.
         
        lRetVal = DYNAMIC-FUNCTION ('checkIsEnde':U)    NO-ERROR.
        IF lRetVal THEN LEAVE MAIN-BLOCK.
        
        NEXT MAIN-BLOCK.
    END.
    IF LOOKUP(ASMutation.MutArt, cMutArten, ',') = 0 THEN 
    DO:
        iTrnr = ASMutation.asmutation_id.
        NEXT MAIN-BLOCK.
    END.
    
    iTime   = ETIME(TRUE).
    iTrnr   = ASMutation.asmutation_id.
    iRecid  = RECID(ASMutation).
    lRetVal = TRUE.
    
    /*  --------------------------------------------------------------  */
    /*  Druck aus TRIGGER t-aufze-write (Aenderung Auftrag)             */
    /*  --------------------------------------------------------------  */
    DO WHILE ASMutation.MutArt = 'RUESTDRUCK':
        
        /*  Druck von Benutzer nach Mutation    */
        IF ASMutation.cFeld_2 <> 'TRIGGER' THEN
        DO:
            REPEAT TRANSACTION ON ERROR UNDO, LEAVE:
                FOR EACH bASMutation NO-LOCK USE-INDEX ASMutation-k2
                    WHERE bASMutation.Aktiv         = TRUE
                    AND   bASMutation.MutArt        = ASMutation.MutArt
                    AND   bASMutation.iKey_1        = ASMutation.iKey_1
                    AND   bASMutation.cFeld_2       = 'TRIGGER':
                        
                    FIND dASMutation WHERE RECID(dASMutation) = RECID(bASMutation) EXCLUSIVE-LOCK NO-WAIT NO-ERROR.
                    IF AVAILABLE dASMutation THEN 
                    DO:
                        DELETE  dASMutation.
                        RELEASE dASMutation.
                        RELEASE bASMutation.
                        NEXT.
                    END.
                    IF LOCKED dASMutation THEN 
                    DO:
                        lRetVal = FALSE.
                        RELEASE bASMutation.
                        LEAVE.
                    END.
                END.
                LEAVE.
            END.
        END.
        IF NOT lRetVal THEN LEAVE.
        /*  ----------------------------------  */
        
        rASMut = ?.
        REPEAT TRANSACTION ON ERROR UNDO, LEAVE:
            FOR EACH bASMutation NO-LOCK USE-INDEX ASMutation-k2
                WHERE bASMutation.Aktiv   = TRUE
                AND   bASMutation.MutArt  = ASMutation.MutArt
                AND   bASMutation.iKey_1  = ASMutation.iKey_1
                AND   bASMutation.cFeld_2 = 'TRIGGER'
                BREAK BY bASMutation.iKey_1
                BY bASMutation.asmutation_id:
            
                IF LAST-OF (bASMutation.iKey_1) THEN 
                DO:
                    rAsMut = RECID(bASMutation).
                    LEAVE.
                END. 

                FIND dASMutation WHERE RECID(dASMutation) = RECID(bASMutation) EXCLUSIVE-LOCK NO-WAIT NO-ERROR.
                IF AVAILABLE dASMutation THEN 
                DO:
                    DELETE  dASMutation.
                    RELEASE dASMutation.
                    RELEASE bASMutation.
                    NEXT.
                END.
                IF LOCKED dASMutation THEN 
                DO:
                    lRetVal = FALSE.
                    RELEASE bASMutation.
                    LEAVE.
                END.
                lRetVal = FALSE.
                DELETE  bASMutation.
            END.
            LEAVE.
        END.
        IF rASMut = ? THEN LEAVE.
        
        FIND bASMutation NO-LOCK WHERE RECID(bASMutation) = rASMut.
        IF  bASMutation.asmutation_id = ASMutation.asmutation_id AND
            bASMutation.iFeld_3 < (TIME - 120)                   THEN LEAVE.
        lRetVal = FALSE.
        LEAVE.            
    END.
    /*  --------------------------------------------------------------  */
        
    IF NOT lRetVal THEN NEXT.
        
    REPEAT TRANSACTION:
        FIND ASMutation EXCLUSIVE-LOCK
            WHERE RECID(ASMutation) = iRecid NO-WAIT NO-ERROR.
        IF  NOT AVAILABLE ASMutation AND
            LOCKED ASMutation        THEN NEXT MAIN-BLOCK.
            
        ASSIGN  
            ASMutation.cStatus = 'A'.
        RELEASE ASMutation.
        LEAVE.
    END.

    cRetVal = 'NULL'.
    FIND ASMutation NO-LOCK WHERE RECID(ASMutation) = iRecid.
    CASE ASMutation.MutArt:
        WHEN 'RUESTDRUCK'     THEN RUN DRUCKEN_RUESTSCHEIN      ( iRecid ).
        WHEN 'wsLADEPAPIER'   THEN RUN DRUCKEN_LADESCHEIN       ( iRecid ).
        WHEN 'wsPALETT'       THEN RUN DRUCKEN_PALETTENSCHEIN   ( iRecid ).
        WHEN 'wsLIEFERSCHEIN' THEN RUN DRUCKEN_LIEFERSCHEIN     ( iRecid ).
    END CASE.
    cRetVal = RETURN-VALUE.

    IF cRetVal BEGINS 'ERROR' THEN 
    DO:
        cMessage = SUBSTITUTE('Fehler &1 beim Drucken von &2', ENTRY(2, cRetVal, ';'), ASMutation.MutArt).
        RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, cMessage ) NO-ERROR.
        
        iAblauf = 0.
        REPEAT TRANSACTION:
            FIND ASMutation EXCLUSIVE-LOCK
                WHERE RECID(ASMutation) = iRecid NO-WAIT NO-ERROR.
            IF  NOT AVAILABLE ASMutation AND
                LOCKED ASMutation        THEN 
            DO:
                PAUSE 1 NO-MESSAGE.
                iAblauf = iAblauf + 1.
                IF iAblauf >= 10 THEN NEXT MAIN-BLOCK.
                NEXT.
            END.
                    
            CASE ASMutation.MutArt:
                WHEN 'wsLIEFERSCHEIN' THEN 
                    DO:
                        ASSIGN  
                            ASMutation.Aktiv   = FALSE
                            ASMutation.cStatus = 'E'.
                    END.
                OTHERWISE 
                DO:
                    ASSIGN  
                        ASMutation.cStatus = ''
                        ASMutation.Aktiv   = TRUE.
                END.
            END CASE.
            RELEASE ASMutation.
            LEAVE.
        END.
        NEXT MAIN-BLOCK.
    END.
    
    iAblauf = 0.
    REPEAT TRANSACTION:
        FIND ASMutation EXCLUSIVE-LOCK
            WHERE RECID(ASMutation) = iRecid NO-WAIT NO-ERROR.
        IF  NOT AVAILABLE ASMutation AND
            LOCKED ASMutation        THEN 
        DO:
            PAUSE 1 NO-MESSAGE.
            iAblauf = iAblauf + 1.
            IF iAblauf >= 10 THEN LEAVE.
            NEXT.
        END.        
        ASSIGN  
            ASMutation.cStatus = 'E'
            ASMutation.Aktiv   = FALSE.
        RELEASE ASMutation.
        LEAVE.
    END.
    
    iAnzTrans = iAnzTrans + 1.
    IF iAnzTrans <= 5 THEN NEXT.

    lRetVal = DYNAMIC-FUNCTION ('checkIsWorking':U) NO-ERROR.
         
    lRetVal = DYNAMIC-FUNCTION ('checkIsEnde':U)    NO-ERROR.
    IF lRetVal THEN LEAVE MAIN-BLOCK.
        
END.

cMessage = SUBSTITUTE('Programm nach einer Laufzeit von &1 Sekunden beendet', (TIME - iBeg) ).
RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, cMessage ) NO-ERROR.


/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


/* ************************  Function Implementations ***************** */

&IF DEFINED(EXCLUDE-checkIsEnde) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION checkIsEnde Procedure
FUNCTION checkIsEnde RETURNS LOGICAL 
    (  ):
    /*------------------------------------------------------------------------------*/
    /*  Purpose:                                                                    */
    /*  Parameters:  <none>                                                         */
    /*  Notes:                                                                      */
    /*------------------------------------------------------------------------------*/
    
    DEFINE VARIABLE lOk AS LOGICAL NO-UNDO INIT FALSE.
    
    DEFINE BUFFER bTabel FOR Tabel.

    RELEASE Tabel .
    RELEASE bTabel.

    DO WHILE TRUE:
        FIND Tabel NO-LOCK 
            WHERE Tabel.Firma  = Firma
            AND   Tabel.Recart = 'BATCHDRUCK'
            AND   Tabel.CodeC  = 'LAGER'
            AND   Tabel.CodeI  = 0
            AND   Tabel.Sprcd  = 0 NO-ERROR.
        IF NOT AVAILABLE Tabel THEN LEAVE. 
        
        IF  Tabel.Flag_2 = FALSE THEN LEAVE.
            
        REPEAT TRANSACTION ON ERROR UNDO, LEAVE:
            FIND bTabel WHERE RECID(bTabel) = RECID(Tabel).
            ASSIGN  
                bTabel.Flag_2 = FALSE.
            RELEASE bTabel.
            
            RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, '' )       NO-ERROR.
            cMessage = 'eine ENDE-Anweisung erhalten'.
            RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, cMessage ) NO-ERROR.
            RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, '' )       NO-ERROR.
        
            LEAVE.
        END. 
        
        lOK = TRUE.
        LEAVE.
    END.
    
    RETURN lOK.

END FUNCTION.
    
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ENDIF


&IF DEFINED(EXCLUDE-checkIsWorking) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION checkIsWorking Procedure
FUNCTION checkIsWorking RETURNS LOGICAL 
    (  ):
    /*------------------------------------------------------------------------------*/
    /*  Purpose:                                                                    */
    /*  Parameters:  <none>                                                         */
    /*  Notes:                                                                      */
    /*------------------------------------------------------------------------------*/
    
    DEFINE VARIABLE lOk AS LOGICAL NO-UNDO INIT FALSE.
    
    DEFINE BUFFER bTabel FOR Tabel.

    RELEASE Tabel .
    RELEASE bTabel.

    DO WHILE TRUE:
        FIND Tabel NO-LOCK 
            WHERE Tabel.Firma  = Firma
            AND   Tabel.Recart = 'BATCHDRUCK'
            AND   Tabel.CodeC  = 'LAGER'
            AND   Tabel.CodeI  = 0
            AND   Tabel.Sprcd  = 0 NO-ERROR.
        IF NOT AVAILABLE Tabel THEN LEAVE. 
        
        IF  Tabel.Flag_1 = FALSE THEN LEAVE.
            
        REPEAT TRANSACTION ON ERROR UNDO, LEAVE:
            FIND bTabel WHERE RECID(bTabel) = RECID(Tabel).
            ASSIGN
                bTabel.Flag_1 = FALSE.
            RELEASE bTabel.
            LEAVE.
        END.
        
        RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, '' ) NO-ERROR.
        cMessage = 'eine isWorking-Anfrage erhalten'.
        RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, cMessage ) NO-ERROR.
        
        lOK = TRUE.
        LEAVE.
    END.
    
    RETURN lOK.

END FUNCTION.
    
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ENDIF


&IF DEFINED(EXCLUDE-clearControlFlags) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION clearControlFlags Procedure
FUNCTION clearControlFlags RETURNS LOGICAL 
    (  ):
    /*------------------------------------------------------------------------------*/
    /*  Purpose:                                                                    */
    /*  Parameters:  <none>                                                         */
    /*  Notes:                                                                      */
    /*------------------------------------------------------------------------------*/
    
    DEFINE BUFFER bTabel FOR Tabel.

    DO WHILE TRUE:
        FIND Tabel NO-LOCK 
            WHERE Tabel.Firma  = Firma
            AND   Tabel.Recart = 'BATCHDRUCK'
            AND   Tabel.CodeC  = 'LAGER'
            AND   Tabel.CodeI  = 0
            AND   Tabel.Sprcd  = 0 NO-ERROR.
        IF NOT AVAILABLE Tabel THEN 
        DO:
            REPEAT TRANSACTION ON ERROR UNDO, LEAVE:
                CREATE  Tabel.
                ASSIGN
                    Tabel.Firma  = Firma
                    Tabel.Recart = 'BATCHDRUCK'
                    Tabel.CodeC  = 'LAGER'
                    Tabel.CodeI  = 0
                    Tabel.Sprcd  = 0
                    Tabel.Flag_1 = FALSE
                    Tabel.Flag_2 = FALSE. 
                RELEASE Tabel.
                LEAVE.
            END.
            NEXT.
        END.
        
        IF  Tabel.Flag_1 = FALSE AND 
            Tabel.Flag_2 = FALSE THEN LEAVE.
            
        REPEAT TRANSACTION ON ERROR UNDO, LEAVE:
            FIND bTabel WHERE RECID(bTabel) = RECID(Tabel).
            ASSIGN  
                bTabel.Flag_1 = FALSE
                bTabel.Flag_2 = FALSE.
            RELEASE bTabel.
            LEAVE.
        END. 
        LEAVE.
    END.
    
    RETURN TRUE.

END FUNCTION.
    
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ENDIF


&IF DEFINED(EXCLUDE-getDruckProgramm) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getDruckProgramm Procedure
FUNCTION getDruckProgramm RETURNS CHARACTER 
    (  ):
    /*------------------------------------------------------------------------------*/
    /*  Purpose:                                                                    */
    /*  Parameters:  <none>                                                         */
    /*  Notes:                                                                      */
    /*------------------------------------------------------------------------------*/
    
    DEFINE VARIABLE cDruckProgramm AS CHARACTER NO-UNDO.

    DO WHILE TRUE:
        cDruckProgramm = SUBSTITUTE('DruckProgramme/&1/&2', cInstallation, cDruckart).
        cDruckProgramm = SEARCH(cDruckProgramm).
        LEAVE.
    END.
    IF cDruckProgramm = ? THEN cDruckProgramm = ''.
    RETURN cDruckProgramm.

END FUNCTION.
    
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ENDIF


&IF DEFINED(EXCLUDE-getLogfileName) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION getLogfileName Procedure 
FUNCTION getLogfileName RETURNS CHARACTER
    ( /* parameter-definitions */ ) :
    /*------------------------------------------------------------------------------*/
    /*  Purpose:                                                                    */
    /*  Parameters:  <none>                                                         */
    /*  Notes:                                                                      */
    /*------------------------------------------------------------------------------*/

    DEFINE VARIABLE cPath AS CHARACTER NO-UNDO.
    
    cPath = DYNAMIC-FUNCTION ('getLogFilePfad':U) NO-ERROR.
    IF cPath = ?  OR
        cPath = '' THEN cPath = SESSION:TEMP-DIRECTORY.
        
    cPath = cPath
        + cProgramm
        + '_'
        + REPLACE(STRING(TODAY,'99.99.9999'), '.', '')
        + '.Log'.

    RETURN cPath.

END FUNCTION.

/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME

&ENDIF



/* **********************  Internal Procedures  *********************** */


&IF DEFINED(EXCLUDE-ANMELDEN) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE ANMELDEN Procedure
PROCEDURE ANMELDEN:
    /*------------------------------------------------------------------------------*/
    /*  Purpose:                                                                    */
    /*  Parameters:  <none>                                                         */
    /*  Notes:                                                                      */
    /*------------------------------------------------------------------------------*/

    DEFINE VARIABLE cString AS CHARACTER NO-UNDO.
    DEFINE VARIABLE ix      AS INTEGER   NO-UNDO.
    
    DO WHILE TRUE:

        IF ENTRY(1, SESSION:PARAMETER, ';') <> 'batch' THEN LEAVE.
    
        ASSIGN  
            cBenutzer = ''
            cPasswort = ''
            cMandant  = ''.
            
        DO ix = 1 TO NUM-ENTRIES(SESSION:PARAMETER, ';'):
            CASE ix:
                WHEN 2 THEN 
                    cBenutzer = ENTRY(ix, SESSION:PARAMETER, ';') NO-ERROR.
                WHEN 3 THEN 
                    cPasswort = ENTRY(ix, SESSION:PARAMETER, ';') NO-ERROR.
                WHEN 4 THEN 
                    cMandant  = ENTRY(ix, SESSION:PARAMETER, ';') NO-ERROR.
                WHEN 5 THEN 
                    lBatch    = FALSE                             NO-ERROR.
            END CASE.
        END.
        DYNAMIC-FUNCTION('setBatch':U, lBatch) NO-ERROR.
    
        FIND FIRST Benutzer NO-LOCK USE-INDEX Benutzer-k1
            WHERE Benutzer.Benutzer = cBenutzer
            AND   Benutzer.Kennwort = cPasswort NO-ERROR.
        IF NOT AVAILABLE Benutzer THEN 
        DO:
            cString = SUBSTITUTE('Benutzer &1 mit Kennwort &2 ungültig', cBenutzer, cPasswort).
            RUN VALUE(cLogFileProg) (cProgramm, cLogFile, cString) NO-ERROR.
            LEAVE.
        END.
    
        FIND Mandant NO-LOCK USE-INDEX Mandant-k1
            WHERE Mandant.Firma = cMandant NO-ERROR.
        IF NOT AVAILABLE Mandant THEN 
        DO:
            cString = SUBSTITUTE('Mandat &1 ungültig', cMandant).
            RUN VALUE(cLogFileProg) (cProgramm, cLogFile, cString) NO-ERROR.
            LEAVE.
        END.
    
        cString = cBenutzer + CHR(01) + cPasswort + CHR(01) + cMandant.
        RUN ANMELDUNG ( INPUT cString ).
        RUN AUFTRAGFUNKTIONENINIT.
    
        cInstallation = DYNAMIC-FUNCTION('getInstallation':U) NO-ERROR.
        lAnmeldung    = TRUE.
        LEAVE.
    END.

END PROCEDURE.
    
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ENDIF


&IF DEFINED(EXCLUDE-BEREINIGEN_BATCH) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE BEREINIGEN_BATCH Procedure
PROCEDURE BEREINIGEN_BATCH:
    /*------------------------------------------------------------------------------*/
    /*  Purpose:                                                                    */
    /*  Parameters:  <none>                                                         */
    /*  Notes:                                                                      */
    /*------------------------------------------------------------------------------*/


    DEFINE VARIABLE iRecid AS RECID NO-UNDO.
    
    DEFINE BUFFER bASMutation FOR ASMutation.
    
    BEREINIGEN:
    FOR EACH ASMutation NO-LOCK
        WHERE ASMutation.cStatus = 'A':
    
        iRecid = RECID(ASMutation).
        
        CASE ASMutation.MutArt:
            WHEN 'RUESTDRUCK'     THEN RUN BEREINIGEN_RUESTDRUCK       ( iRecid ).
            WHEN 'wsLADEPAPIER'   THEN RUN BEREINIGEN_LADEPAPIER       ( iRecid ).
            WHEN 'wsPALETT'       THEN RUN BEREINIGEN_PALETTENDOKUMENT ( iRecid ).
            WHEN 'wsLIEFERSCHEIN' THEN RUN BEREINIGEN_LIEFERSCHEIN     ( iRecid ).
        END.
    
        REPEAT TRANSACTION:
            FIND bASMutation EXCLUSIVE-LOCK
                WHERE RECID(bASMutation) = iRecid NO-WAIT NO-ERROR.
            IF LOCKED bASMutation THEN 
            DO:
                RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, 'ASMutation ist locked' ) NO-ERROR.
                NEXT BEREINIGEN.
            END.
            IF NOT AVAILABLE bASMutation THEN LEAVE.
            
            DELETE  bASMutation.
            LEAVE.
        END.
        
    END.
    
END PROCEDURE.
    
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ENDIF

&IF DEFINED(EXCLUDE-BEREINIGEN_LADEPAPIER) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE BEREINIGEN_LADEPAPIER Procedure
PROCEDURE BEREINIGEN_LADEPAPIER:
    /*------------------------------------------------------------------------------*/
    /*  Purpose:                                                                    */
    /*  Parameters:  <none>                                                         */
    /*  Notes:                                                                      */
    /*------------------------------------------------------------------------------*/

    DEFINE INPUT PARAMETER ipRecid  AS RECID            NO-UNDO.
   
    DEFINE VARIABLE iAufnr    AS INTEGER   NO-UNDO.
    DEFINE VARIABLE iRuestArt AS INTEGER   NO-UNDO.
    DEFINE VARIABLE cFirma    AS CHARACTER NO-UNDO.
   
    DEFINE BUFFER bAS    FOR ASMutation.
    DEFINE BUFFER bTabel FOR Tabel.
   
    FIND bAS NO-LOCK WHERE RECID(bAS) = ipRecid NO-ERROR.
    IF NOT AVAILABLE bAS THEN RETURN.
    IF bAS.cStatus = 'E' THEN RETURN.

    ASSIGN  
        cBenutzer = bAS.cFeld_2
        iAufnr    = bAS.iKey_1
        iRuestArt = bAS.iKey_2
        cFirma    = bAS.Firma.
            
    FIND FIRST bTabel EXCLUSIVE-LOCK
        WHERE bTabel.Firma  = cFirma
        AND   bTabel.RecArt = 'wsLADEPAPIER'
        AND   bTabel.Sprcd  = 1
        AND   bTabel.Int_1  = iAufnr
        AND   bTabel.Int_3  = iRuestArt NO-WAIT NO-ERROR.
    IF NOT AVAILABLE bTabel THEN RETURN.
    
    DELETE  bTabel.
    RETURN.

END PROCEDURE.
    
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ENDIF

&IF DEFINED(EXCLUDE-BEREINIGEN_LIEFERSCHEIN) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE BEREINIGEN_LIEFERSCHEIN Procedure
PROCEDURE BEREINIGEN_LIEFERSCHEIN:
    /*------------------------------------------------------------------------------*/
    /*  Purpose:                                                                    */
    /*  Parameters:  <none>                                                         */
    /*  Notes:                                                                      */
    /*------------------------------------------------------------------------------*/

    DEFINE INPUT PARAMETER ipRecid  AS RECID            NO-UNDO.
   
    DEFINE VARIABLE iAufnr    AS INTEGER   NO-UNDO.
    DEFINE VARIABLE iRuestArt AS INTEGER   NO-UNDO.
    DEFINE VARIABLE cFirma    AS CHARACTER NO-UNDO.
   
    DEFINE BUFFER bAS    FOR ASMutation.
    DEFINE BUFFER bTabel FOR Tabel.
   
    FIND bAS NO-LOCK WHERE RECID(bAS) = ipRecid NO-ERROR.
    IF NOT AVAILABLE bAS THEN RETURN.
    IF bAS.cStatus = 'E' THEN RETURN.

    ASSIGN  
        cBenutzer = bAS.cFeld_2
        iAufnr    = bAS.iKey_1
        iRuestArt = bAS.iKey_2
        cFirma    = bAS.Firma.
            
    FIND FIRST bTabel EXCLUSIVE-LOCK
        WHERE bTabel.Firma  = cFirma
        AND   bTabel.RecArt = 'wsLIEFERSCHEIN'
        AND   bTabel.Sprcd  = 1
        AND   bTabel.Int_1  = iAufnr
        AND   bTabel.Int_3  = iRuestArt NO-WAIT NO-ERROR.
    IF NOT AVAILABLE bTabel THEN RETURN.
    
    DELETE  bTabel.
    RETURN.

END PROCEDURE.
    
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ENDIF

&IF DEFINED(EXCLUDE-BEREINIGEN_PALETTENDOKUMENT) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE BEREINIGEN_PALETTENDOKUMENT Procedure
PROCEDURE BEREINIGEN_PALETTENDOKUMENT:
    /*------------------------------------------------------------------------------*/
    /*  Purpose:                                                                    */
    /*  Parameters:  <none>                                                         */
    /*  Notes:                                                                      */
    /*------------------------------------------------------------------------------*/

    DEFINE INPUT PARAMETER ipRecid  AS RECID            NO-UNDO.
   
    DEFINE VARIABLE iAufnr    AS INTEGER   NO-UNDO.
    DEFINE VARIABLE iRuestArt AS INTEGER   NO-UNDO.
    DEFINE VARIABLE cFirma    AS CHARACTER NO-UNDO.
   
    DEFINE BUFFER bAS    FOR ASMutation.
    DEFINE BUFFER bTabel FOR Tabel.
   
    FIND bAS NO-LOCK WHERE RECID(bAS) = ipRecid NO-ERROR.
    IF NOT AVAILABLE bAS THEN RETURN.
    IF bAS.cStatus = 'E' THEN RETURN.

    ASSIGN  
        cBenutzer = bAS.cFeld_2
        iAufnr    = bAS.iKey_1
        iRuestArt = bAS.iKey_2
        cFirma    = bAS.Firma.
            
    FIND FIRST bTabel EXCLUSIVE-LOCK
        WHERE bTabel.Firma  = cFirma
        AND   bTabel.RecArt = 'wsPALETT'
        AND   bTabel.Sprcd  = 1
        AND   bTabel.Int_1  = iAufnr
        AND   bTabel.Int_3  = iRuestArt NO-WAIT NO-ERROR.
    IF NOT AVAILABLE bTabel THEN RETURN.
    
    DELETE  bTabel.
    RETURN.
    
END PROCEDURE.
    
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ENDIF

&IF DEFINED(EXCLUDE-BEREINIGEN_RUESTDRUCK) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE BEREINIGEN_RUESTDRUCK Procedure
PROCEDURE BEREINIGEN_RUESTDRUCK:
    /*------------------------------------------------------------------------------*/
    /*  Purpose:                                                                    */
    /*  Parameters:  <none>                                                         */
    /*  Notes:                                                                      */
    /*------------------------------------------------------------------------------*/

    DEFINE INPUT PARAMETER ipRecid  AS RECID            NO-UNDO.
   
    DEFINE VARIABLE iAufnr    AS INTEGER   NO-UNDO.
    DEFINE VARIABLE iRuestArt AS INTEGER   NO-UNDO.
    DEFINE VARIABLE cFirma    AS CHARACTER NO-UNDO.
   
    DEFINE BUFFER bAS    FOR ASMutation.
    DEFINE BUFFER bTabel FOR Tabel.
   
    FIND bAS NO-LOCK WHERE RECID(bAS) = ipRecid NO-ERROR.
    IF NOT AVAILABLE bAS THEN RETURN.
    IF bAS.cStatus = 'E' THEN RETURN.

    ASSIGN  
        cBenutzer = bAS.cFeld_2
        iAufnr    = bAS.iKey_1
        iRuestArt = bAS.iKey_2
        cFirma    = bAS.Firma.
            
    FIND FIRST bTabel EXCLUSIVE-LOCK
        WHERE bTabel.Firma  = cFirma
        AND   bTabel.RecArt = 'AUFDRUCK'
        AND   bTabel.Sprcd  = 1
        AND   bTabel.Int_1  = iAufnr
        AND   bTabel.Int_3  = iRuestArt NO-WAIT NO-ERROR.
    IF NOT AVAILABLE bTabel THEN RETURN.
    
    DELETE  bTabel.
    RETURN.
    
END PROCEDURE.
    
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ENDIF

&IF DEFINED(EXCLUDE-DRUCKEN_LADEPAPIER) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN_LADEPAPIER Procedure
PROCEDURE DRUCKEN_LADESCHEIN:
    /*------------------------------------------------------------------------------*/
    /*  Purpose:                                                                    */
    /*  Parameters:  <none>                                                         */
    /*  Notes:                                                                      */
    /*------------------------------------------------------------------------------*/

    DEFINE INPUT PARAMETER ipRecid     AS RECID            NO-UNDO.
    
    DEFINE VARIABLE cRuester       AS CHARACTER NO-UNDO.
    DEFINE VARIABLE iKopien        AS INTEGER   NO-UNDO.
    DEFINE VARIABLE iAufnr         AS INTEGER   NO-UNDO.
    DEFINE VARIABLE iPlatz         AS INTEGER   NO-UNDO.
    DEFINE VARIABLE iRuestArt      AS INTEGER   NO-UNDO.
    DEFINE VARIABLE ix             AS INTEGER   NO-UNDO.
    DEFINE VARIABLE cStockwerk     AS CHARACTER INIT ';;;;;;;;;;' NO-UNDO.
    DEFINE VARIABLE cDruckProgramm AS CHARACTER NO-UNDO.
    DEFINE VARIABLE iRecid         AS RECID     NO-UNDO.
    DEFINE VARIABLE cString        AS CHARACTER NO-UNDO.
    
    FIND ASMutation NO-LOCK
        WHERE RECID(ASMutation) = ipRecid.
    ASSIGN  
        cRuester  = ASMutation.cFeld_2
        iAufnr    = ASMutation.iKey_1
        iRuestArt = ASMutation.iKey_2
        Firma     = ASMutation.Firma.
    FIND Aufko NO-LOCK USE-INDEX Aufko-k1
        WHERE Aufko.Firma = Firma
        AND   Aufko.Aufnr = iAufnr NO-ERROR.
    IF NOT AVAILABLE Aufko THEN RETURN ''.
    
    cDruckart      = 'Ladeschein.r'.
    cDruckProgramm = DYNAMIC-FUNCTION('getDruckProgramm':U) NO-ERROR.
    IF cDruckProgramm = '' THEN RETURN 'ERROR;Fehler! Kein Programm für den Ausdruck gefunden'.
    
    REPEAT TRANSACTION ON ERROR UNDO, LEAVE:
        FIND LAST Tabel NO-LOCK
            WHERE Tabel.Firma  = Firma
            AND   Tabel.RecArt = 'wsLADEPAPIER'
            AND   Tabel.CodeC  = cRuester
            AND   Tabel.Sprcd  = 1 NO-ERROR.
        IF NOT AVAILABLE Tabel THEN ix = 1.
        ELSE                        ix = Tabel.CodeI + 1.
        CREATE  Tabel.
        ASSIGN  
            Tabel.Firma  = Firma
            Tabel.RecArt = 'wsLADEPAPIER'
            Tabel.CodeC  = cRuester
            Tabel.CodeI  = ix
            Tabel.Sprcd  = 1
            Tabel.Int_1  = iAufnr
            Tabel.Int_2  = 3
            Tabel.Int_3  = iRuestArt
            Tabel.Dec_1  = ASMutation.iFeld_1
            Tabel.Dec_2  = 1
            Tabel.Bez2   = cRuester.
        iRecid = RECID(Tabel).
        RELEASE Tabel.
        LEAVE.
    END.
    
    cString = SUBSTITUTE('Programm &1/&2 gestartet mit Aufnr &3, Rüstart &4, Benutzer &5',
        cDruckProgramm, 'wsLADEPAPIER', iAufnr, iRuestArt, cRuester).
    RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, cString ) NO-ERROR.

    RUN VALUE(cDruckProgramm) NO-ERROR.
    
    RETURN RETURN-VALUE.

END PROCEDURE.
    
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ENDIF


&IF DEFINED(EXCLUDE-DRUCKEN_LIEFERSCHEIN) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN_LIEFERSCHEIN Procedure
PROCEDURE DRUCKEN_LIEFERSCHEIN:
    /*------------------------------------------------------------------------------*/
    /*  Purpose:                                                                    */
    /*  Parameters:  <none>                                                         */
    /*  Notes:                                                                      */
    /*------------------------------------------------------------------------------*/

    DEFINE INPUT PARAMETER ipRecid     AS RECID            NO-UNDO.
    
    DEFINE VARIABLE cRuester       AS CHARACTER NO-UNDO.
    DEFINE VARIABLE iKopien        AS INTEGER   NO-UNDO.
    DEFINE VARIABLE iAufnr         AS INTEGER   NO-UNDO.
    DEFINE VARIABLE iPlatz         AS INTEGER   NO-UNDO.
    DEFINE VARIABLE iRuestArt      AS INTEGER   NO-UNDO.
    DEFINE VARIABLE ix             AS INTEGER   NO-UNDO.
    DEFINE VARIABLE cStockwerk     AS CHARACTER INIT ';;;;;;;;;' NO-UNDO.
    DEFINE VARIABLE cDruckProgramm AS CHARACTER NO-UNDO.
    DEFINE VARIABLE iRecid         AS RECID     NO-UNDO.
    DEFINE VARIABLE lSammFak       AS LOG       NO-UNDO.
    DEFINE VARIABLE cResult        AS CHARACTER NO-UNDO.
    DEFINE VARIABLE cString        AS CHARACTER NO-UNDO.
    
    DEFINE BUFFER bViperDoc FOR ViperDoc.
    
    FIND ASMutation NO-LOCK
        WHERE RECID(ASMutation) = ipRecid.
    ASSIGN  
        cRuester  = ASMutation.cFeld_2
        iAufnr    = ASMutation.iKey_1
        iRuestArt = ASMutation.iKey_2
        Firma     = ASMutation.Firma.
    FIND Aufko NO-LOCK USE-INDEX Aufko-k1
        WHERE Aufko.Firma = Firma
        AND   Aufko.Aufnr = iAufnr NO-ERROR.
    IF NOT AVAILABLE Aufko THEN RETURN ''.

    EMPTY TEMP-TABLE tParam.
    CREATE tParam.
    
    FIND Steuer NO-LOCK
        WHERE Steuer.Firma = Firma.
    ASSIGN  
        iRuestArt = Steuer.RuestArt.
    
    ASSIGN  
        tParam.cFirma    = Aufko.Firma
        tParam.iRecid    = RECID(Aufko)
        tParam.iAufnr    = iAufnr
        tParam.iKnr      = Aufko.Knr
        tParam.iFak_Knr  = Aufko.Fak_Knr
        tParam.iFakArt   = Aufko.Fak_Art
        tParam.iAufSta   = Aufko.Auf_Sta
        tParam.cBenutzer = DYNAMIC-FUNCTION('getBenutzer':U)
        tParam.cDBUser   = DYNAMIC-FUNCTION('getDBUser':U)
        tParam.cWinUser  = DYNAMIC-FUNCTION('getSysUser':U)
        tParam.cInstall  = DYNAMIC-FUNCTION('getInstallation':U)
        tParam.lPreis    = FALSE
        tParam.lBatch    = TRUE
        tParam.Programm  = ''.
    IF ASMutation.iFeld_1 = 1 THEN 
    DO:  /*  Abschluss (Ablieferung Fahrer)  */
        ASSIGN  
            tParam.cBenutzer = 'Fahrer'
            tParam.cDBUser   = 'Fahrer'
            tParam.cWinUser  = 'Fahrer'.
    END.
    
    IF Aufko.AlsOfferte THEN RETURN 'Error;Offerte'.
    
    FIND FIRST Tabel NO-LOCK
        WHERE Tabel.Firma  = tParam.cFirma
        AND   Tabel.RecArt = 'FAKART'
        AND   Tabel.CodeI  = Aufko.Fak_Art NO-ERROR.
    IF NOT AVAILABLE Tabel THEN RETURN ''.

    tParam.cDokument = Tabel.Bez2.
    lSammFak         = (IF Tabel.Int_3 = 4 THEN TRUE ELSE FALSE).
    IF lSammFak THEN RETURN 'Error;Sammelrechnung'.
    
    iVDRecid = ?.
    DO ix = 1 TO 3:
        CASE ix:
            WHEN 1 THEN 
                cUser = tParam.cBenutzer.
            WHEN 2 THEN 
                cUser = tParam.cDBUser.
            WHEN 3 THEN 
                cUser = tParam.cWinUser.
        END CASE.
        
        FIND FIRST ViperDoc NO-LOCK
            WHERE ViperDoc.Firma    = Aufko.Firma
            AND   ViperDoc.Benutzer = cUser
            AND   ViperDoc.Formular = tParam.cDokument
            AND   ViperDoc.DokArt   = 0 NO-ERROR.
        IF AVAILABLE ViperDoc THEN 
        DO:
            iVDRecid = RECID(ViperDoc).
            LEAVE.
        END.
    END.
    DO WHILE iVDRecid = ?:
        FIND FIRST ViperDoc NO-LOCK
            WHERE ViperDoc.Firma    = Aufko.Firma
            AND   ViperDoc.Formular = tParam.cDokument
            AND   ViperDoc.DokArt   = 0 NO-ERROR.
        IF NOT AVAILABLE ViperDoc THEN RETURN ''.
        REPEAT TRANSACTION ON ERROR UNDO, LEAVE:
            CREATE  bViperDoc.
            BUFFER-COPY ViperDoc
                EXCEPT  Benutzer
                TO      bViperDoc
                ASSIGN  
                bViperDoc.Benutzer = tParam.cBenutzer.
            iVDRecid = RECID(bViperDoc).
            RELEASE bViperDoc.
            RELEASE ViperDoc.
            LEAVE.
        END.
        LEAVE.
    END.
    
    FIND ViperDoc NO-LOCK WHERE RECID(ViperDoc) = iVDRecid.
    ASSIGN  
        tParam.iVDRecid   = iVDRecid
        tParam.Programm   = ViperDoc.Programm
        tParam.Anzahl     = ViperDoc.Anzahl
        tParam.Drucker    = ViperDoc.Drucker
        tParam.lCreatePDF = ViperDoc.lCreatePDF
        tParam.lDokDruck  = ViperDoc.lDokDruck
        tParam.lSendMail  = FALSE.
    
    RELEASE Aufko.
    RELEASE ViperDoc.
    RELEASE Tabel.
    
    cDruckProgramm = SUBSTITUTE('DruckProgramme/&1/&2', tParam.cInstall, tParam.Programm ).
    cDruckProgramm = SEARCH(cDruckProgramm).
    IF cDruckProgramm = ? THEN RETURN 'ERROR;Fehler! Kein Programm für den Ausdruck gefunden'.
    
    cString = SUBSTITUTE('Programm &1 gestartet mit Aufnr &2, Benutzer &3',
        cDruckProgramm, tParam.iAufnr, tParam.cBenutzer).
    RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, cString ) NO-ERROR.

    RUN VALUE(cDruckProgramm) ( htParam, OUTPUT cResult ).
    
    IF cResult BEGINS 'ERROR'  THEN RETURN cResult.
    IF ASMutation.iFeld_1 <> 1 THEN RETURN cResult.
    
    DO WHILE TRUE:  /*  Mailversand bei Nettokunden mit LS-Mailadresse  */
        FIND FIRST tParam.
        FIND Aufko NO-LOCK 
            WHERE Aufko.Firma = tParam.cFirma
            AND   Aufko.Aufnr = tParam.iAufnr NO-ERROR.
        FIND FIRST Ansprech NO-LOCK 
            WHERE Ansprech.Firma        = AdFirma
            AND   Ansprech.Knr          = Aufko.Knr
            AND   Ansprech.Lieferschein = TRUE NO-ERROR.
        IF NOT AVAILABLE Ansprech THEN LEAVE.
        FIND Debst NO-LOCK 
            WHERE Debst.Firma = Aufko.Firma
            AND   Debst.Knr   = Aufko.Knr NO-ERROR.
            
        RUN FIND_PREISGRUPPE ( Debst.Preis_Grp, OUTPUT cString ) NO-ERROR.
        IF NUM-ENTRIES(cString, CHR(01)) < 4       THEN LEAVE.
        IF INTEGER(ENTRY(3, cString, CHR(01))) > 0 THEN LEAVE.  /*  0 = Nettokunde (exkl. Mwst) */
     
        RUN SEND_MAIL ( Aufko.Knr, Aufko.Aufnr, Aufko.Lief_Datum, Ansprech.Mail, Ansprech.Sprcd ) NO-ERROR.
        
        RELEASE Aufko   .
        RELEASE Ansprech.
        RELEASE Debst.
        LEAVE.
    END.
    
    RETURN cResult.

END PROCEDURE.
    
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ENDIF


&IF DEFINED(EXCLUDE-DRUCKEN_PALETTENDOKUMENT) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN_PALETTENDOKUMENT Procedure
PROCEDURE DRUCKEN_PALETTENSCHEIN:
    /*------------------------------------------------------------------------------*/
    /*  Purpose:                                                                    */
    /*  Parameters:  <none>                                                         */
    /*  Notes:                                                                      */
    /*------------------------------------------------------------------------------*/

    DEFINE INPUT PARAMETER ipRecid     AS RECID            NO-UNDO.
    
    DEFINE VARIABLE cRuester       AS CHARACTER NO-UNDO.
    DEFINE VARIABLE iKopien        AS INTEGER   NO-UNDO.
    DEFINE VARIABLE iAufnr         AS INTEGER   NO-UNDO.
    DEFINE VARIABLE iPlatz         AS INTEGER   NO-UNDO.
    DEFINE VARIABLE iRuestArt      AS INTEGER   NO-UNDO.
    DEFINE VARIABLE ix             AS INTEGER   NO-UNDO.
    DEFINE VARIABLE cStockwerk     AS CHARACTER INIT ';;;;;;;;;' NO-UNDO.
    DEFINE VARIABLE cDruckProgramm AS CHARACTER NO-UNDO.
    DEFINE VARIABLE iRecid         AS RECID     NO-UNDO.
    DEFINE VARIABLE cString        AS CHARACTER NO-UNDO.
    
    FIND ASMutation NO-LOCK
        WHERE RECID(ASMutation) = ipRecid.
    ASSIGN  
        cRuester  = ASMutation.cFeld_2
        iPlatz    = ASMutation.iFeld_1
        iKopien   = ASMutation.iFeld_2
        iAufnr    = ASMutation.iKey_1
        iRuestArt = ASMutation.iKey_2
        Firma     = ASMutation.Firma.
    FIND Aufko NO-LOCK USE-INDEX Aufko-k1
        WHERE Aufko.Firma = Firma
        AND   Aufko.Aufnr = iAufnr NO-ERROR.
    IF NOT AVAILABLE Aufko THEN RETURN ''.
    
    cDruckart      = 'Palettenschein.r'.
    cDruckProgramm = DYNAMIC-FUNCTION('getDruckProgramm':U) NO-ERROR.
    IF cDruckProgramm = '' THEN RETURN 'ERROR;Fehler! Kein Programm für den Ausdruck gefunden'.
    
    REPEAT TRANSACTION ON ERROR UNDO, LEAVE:
        FIND LAST Tabel NO-LOCK
            WHERE Tabel.Firma  = Firma
            AND   Tabel.RecArt = 'wsPALETT'
            AND   Tabel.CodeC  = ASMutation.cFeld_2
            AND   Tabel.Sprcd  = 1 NO-ERROR.
        IF NOT AVAILABLE Tabel THEN ix = 1.
        ELSE                        ix = Tabel.CodeI + 1.
        CREATE  Tabel.
        ASSIGN  
            Tabel.Firma  = Firma
            Tabel.RecArt = 'wsPALETT'
            Tabel.CodeC  = ASMutation.cFeld_2
            Tabel.CodeI  = ix
            Tabel.Sprcd  = 1
            Tabel.Int_1  = iAufnr
            Tabel.Int_2  = 2
            Tabel.Int_3  = iRuestArt
            Tabel.Dec_1  = iPlatz
            Tabel.Dec_2  = (IF iKopien > 10 THEN 1 ELSE iKopien)
            Tabel.Bez2   = cRuester.
        iRecid = RECID(Tabel).
        RELEASE Tabel.
        LEAVE.
    END.

    cString = SUBSTITUTE('Programm &1/&2 gestartet mit Aufnr &3, Rüstart &4, Rüstplatz &5, Benutzer &6',
        cDruckProgramm, 'wsPALETT', iAufnr, iRuestArt, iPlatz, cRuester).
    RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, cString ) NO-ERROR.

    RUN VALUE(cDruckProgramm) NO-ERROR.
    
    RETURN RETURN-VALUE.

END PROCEDURE.
    
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ENDIF


&IF DEFINED(EXCLUDE-DRUCKEN_RUESTSCHEIN) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE DRUCKEN_RUESTSCHEIN Procedure
PROCEDURE DRUCKEN_RUESTSCHEIN:
    /*------------------------------------------------------------------------------*/
    /*  Purpose:                                                                    */
    /*  Parameters:  <none>                                                         */
    /*  Notes:                                                                      */
    /*------------------------------------------------------------------------------*/

    DEFINE INPUT PARAMETER ipRecid     AS RECID            NO-UNDO.
    
    DEFINE VARIABLE iKopien        AS INTEGER   NO-UNDO.
    DEFINE VARIABLE iAufnr         AS INTEGER   NO-UNDO.
    DEFINE VARIABLE iPlatz         AS INTEGER   NO-UNDO.
    DEFINE VARIABLE iRuestArt      AS INTEGER   NO-UNDO.
    DEFINE VARIABLE ix             AS INTEGER   NO-UNDO.
    DEFINE VARIABLE cStockwerk     AS CHARACTER INIT ';;;;;;;;;' NO-UNDO.
    DEFINE VARIABLE cDruckProgramm AS CHARACTER NO-UNDO.
    DEFINE VARIABLE iRecid         AS RECID     NO-UNDO.
    DEFINE VARIABLE cString        AS CHARACTER NO-UNDO.
    DEFINE VARIABLE cStatus        AS CHARACTER NO-UNDO.
    
    FIND ASMutation NO-LOCK
        WHERE RECID(ASMutation) = ipRecid.
    ASSIGN  
        cBenutzer = ASMutation.cFeld_2
        iAufnr    = ASMutation.iKey_1
        iRuestArt = ASMutation.iKey_2
        Firma     = ASMutation.Firma
        cStatus   = ASMutation.cFeld_3.
        
    FIND Aufko NO-LOCK USE-INDEX Aufko-k1
        WHERE Aufko.Firma = Firma
        AND   Aufko.Aufnr = iAufnr NO-ERROR.
    IF NOT AVAILABLE Aufko THEN RETURN ''.
    
    cDruckart      = 'Auftragsschein.r'.
    cDruckProgramm = DYNAMIC-FUNCTION('getDruckProgramm':U) NO-ERROR.
    
    IF cDruckProgramm = '' THEN RETURN 'ERROR;Fehler! Kein Programm für den Ausdruck gefunden'.

    REPEAT TRANSACTION:
        FIND LAST Tabel NO-LOCK
            WHERE Tabel.Firma  = Firma
            AND   Tabel.RecArt = 'AUFDRUCK'
            AND   Tabel.CodeC  = cBenutzer
            AND   Tabel.Sprcd  = 1 NO-ERROR.
        IF NOT AVAILABLE Tabel THEN ix = 1.
        ELSE                        ix = Tabel.CodeI + 1.
        CREATE  Tabel.
        ASSIGN  
            Tabel.Firma  = Firma
            Tabel.RecArt = 'AUFDRUCK'
            Tabel.CodeC  = cBenutzer
            Tabel.CodeI  = ix
            Tabel.Sprcd  = 1
            Tabel.Int_1  = iAufnr
            Tabel.Int_2  = 1
            Tabel.Int_3  = iRuestArt
            Tabel.Dec_1  = 0
            Tabel.Dec_2  = 1
            Tabel.Bez2   = cBenutzer
            Tabel.Flag_3 = (IF ASMutation.cFeld_2 = 'TRIGGER' THEN FALSE ELSE TRUE).
        iRecid = RECID(Tabel).
        RELEASE Tabel.
        LEAVE.
    END.
    RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, ASMutation.cFeld_2 ) NO-ERROR.

    cString = SUBSTITUTE('Programm &1 (Auftragspapier/Rüstschein) gestartet mit Aufnr &2, Rüstart &3, Benutzer &4',
        cDruckProgramm, iAufnr, iRuestArt, cBenutzer).
    RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, cString ) NO-ERROR.

    REPEAT TRANSACTION:
        RUN VALUE(cDruckProgramm) NO-ERROR.
        LEAVE.
    END.
    
    RETURN RETURN-VALUE.

END PROCEDURE.
    
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ENDIF

&IF DEFINED(EXCLUDE-REORG_ASMUTATION) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE REORG_ASMUTATION Procedure
PROCEDURE REORG_ASMUTATION:
    /*------------------------------------------------------------------------------*/
    /*  Purpose:                                                                    */
    /*  Parameters:  <none>                                                         */
    /*  Notes:                                                                      */
    /*------------------------------------------------------------------------------*/

    cMessage = 'Reorg ASMutation gestartet'.
    RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, cMessage ) NO-ERROR.
    
    FOR EACH ASMutation
        WHERE ASMutation.Datum = ? TRANSACTION:
        ASMutation.Datum = TODAY.
    END.
    
    FOR EACH ASMutation
        WHERE ASMutation.Aktiv   = FALSE
        AND   ASMutation.cStatus = 'E'
        AND   ASMutation.Datum   < (TODAY - 30) TRANSACTION:
        DELETE  ASMutation.
    END.

    FOR EACH ASMutation
        WHERE ASMutation.Aktiv    = TRUE
        AND   ASMutation.cStatus <> ''
        AND   ASMutation.Datum    < (TODAY - 30) TRANSACTION:
        DELETE  ASMutation.
    END.
    
    FOR EACH ASMutation
        WHERE ASMutation.Aktiv    = TRUE
        AND   ASMutation.cStatus <> '' TRANSACTION:
        ASMutation.cStatus = ''.
    END.
    
    FOR EACH Tabel
        WHERE Tabel.Firma  = Firma
        AND   Tabel.RecArt = 'GERUEST':
        FIND Aufko NO-LOCK
            WHERE Aufko.Firma = Tabel.Firma
            AND   Aufko.Aufnr = Tabel.CodeI NO-ERROR.
        IF AVAILABLE Aufko THEN NEXT.
        DELETE  Tabel.
    END.

    cMessage = 'Reorg ASMutation beendet'.
    RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, cMessage ) NO-ERROR.
    
END PROCEDURE.
    
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ENDIF


&IF DEFINED(EXCLUDE-REORG_TABELLEN) = 0 &THEN

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _PROCEDURE REORG_TABELLEN Procedure
PROCEDURE REORG_TABELLEN:
    /*------------------------------------------------------------------------------*/
    /*  Purpose:                                                                    */
    /*  Parameters:  <none>                                                         */
    /*  Notes:                                                                      */
    /*------------------------------------------------------------------------------*/

    DEFINE VARIABLE iRecid AS RECID   NO-UNDO.
    DEFINE VARIABLE iAnz   AS INTEGER NO-UNDO.
    
    DEFINE BUFFER bRuestAuf FOR RuestAuf.
    DEFINE BUFFER bTabel    FOR Tabel.

    cMessage = 'Reorg Tabellen gestartet'.
    RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, cMessage ) NO-ERROR.
    
    iAnz = 0.
    FOR EACH RuestAuf NO-LOCK
        WHERE RuestAuf.Firma = Firma
        AND   iAnz           < 100:
        FIND Aufko NO-LOCK
            WHERE Aufko.Firma = RuestAuf.Firma
            AND   Aufko.Aufnr = RuestAuf.Aufnr NO-ERROR.
        IF AVAILABLE Aufko THEN NEXT.
        FIND bRuestAuf WHERE RECID(bRuestAuf) = RECID(RuestAuf).
        DELETE  RuestAuf.
        iAnz = iAnz + 1.
    END.
    RELEASE bRuestAuf.

    FOR EACH Tabel NO-LOCK
        WHERE Tabel.Firma  = Firma
        AND   Tabel.RecArt = 'AUFDRUCK'
        AND   iAnz         < 100:
        iRecid = Tabel.Int_3.
        FIND Aufko NO-LOCK WHERE RECID(Aufko) = iRecid NO-ERROR.
        IF AVAILABLE Aufko THEN NEXT.
        FIND bTabel WHERE RECID(bTabel) = RECID(Tabel) NO-ERROR.
        IF AVAILABLE bTabel THEN DELETE  bTabel.
        iAnz = iAnz + 1.
    END.
    RELEASE bTabel.

    cMessage = 'Reorg Tabellen beendet'.
    RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, cMessage ) NO-ERROR.
    
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 ipiKnr   AS INTEGER      NO-UNDO.
    DEFINE INPUT PARAMETER ipiAufnr AS INTEGER      NO-UNDO.
    DEFINE INPUT PARAMETER ipdDatum AS DATE         NO-UNDO.
    DEFINE INPUT PARAMETER ipcMail  AS CHARACTER    NO-UNDO.
    DEFINE INPUT PARAMETER ipiSprcd AS INTEGER      NO-UNDO.

    DEFINE VARIABLE cTo       AS CHARACTER NO-UNDO.
    DEFINE VARIABLE cCC       AS CHARACTER NO-UNDO.
    DEFINE VARIABLE cFrom     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 lBody     AS LONGCHAR  NO-UNDO.
    DEFINE VARIABLE cBodyName AS CHARACTER NO-UNDO.
    DEFINE VARIABLE cPDFName  AS CHARACTER NO-UNDO.
    DEFINE VARIABLE ii        AS INTEGER   NO-UNDO.
    
    FIND FIRST tParam.

    cTo       = ipcMail.
    cBodyName = SUBSTITUTE ('DruckProgramme/&1/Mail-Lieferschein-&2.html', cInstallation, ipiSprcd ). 
    cPDFName  = SUBSTITUTE (cMailVersandPathLS, STRING(ipiKnr,'999999'), STRING(ipiAufnr,'9999999'), 'Lieferschein').
    
    IF cTo             = '' THEN RETURN.
    IF INDEX(cTo, '@') = 0  THEN RETURN.
    
    /*    cFrom    = cMailFromLS.*/
    cSubject = SUBSTITUTE('Lieferschein &1 vom &2', ipiAufnr, STRING(ipdDatum,'99.99.9999') ).
    COPY-LOB FROM FILE cBodyName TO lBody.
    cBody = lBody.
    
    ii = 0.
    FOR EACH Ansprech NO-LOCK 
        WHERE Ansprech.Firma        = AdFirma
        AND   Ansprech.Knr          = tParam.iKnr
        AND   Ansprech.Lieferschein = TRUE
        AND   Ansprech.Mail        <> ''
        AND   INDEX(Ansprech.Mail, '@') > 0 :
            
        ii = ii + 1.
        IF ii = 1 THEN 
        DO:
            cBody = SUBSTITUTE(cBody, Ansprech.BriefAnr ) NO-ERROR.
            cTo   = Ansprech.Mail.
        END.
        ELSE 
        DO:
            cCC = cCC
                + (IF cCC = '' THEN '' ELSE ';')
                + Ansprech.Mail.
        END.
    END.
    cCC = cCC
        + (IF cCC = '' THEN '' ELSE ';')
        + cMailCCLS.

    RUN VALUE(cLogFileProg) ( cProgramm, cLogFile, SUBSTITUTE ('Mail in ASMutation From &1 TO &2 CC &3 &5 Subject &4 ', cFrom, cTo, cCC, cSubject ) ).
    
    FIND FIRST ASMutation NO-LOCK 
        WHERE ASMutation.Firma   = Firma
        AND   ASMutation.Aktiv   = TRUE 
        AND   ASMutation.cStatus = ''
        AND   ASMutation.MutArt  = 'MAIL'
        AND   ASMutation.cKey_2  = cPDFName
        AND   ASMutation.Aktiv   = TRUE
        AND   ASMutation.cStatus = ''  NO-ERROR.
    IF AVAILABLE ASMutation THEN RETURN cMeldung. 
    
    REPEAT TRANSACTION ON ERROR UNDO, LEAVE:
        CREATE  ASMutation.
        ASSIGN  
            ASMutation.asmutation_id = NEXT-VALUE(asmutation_id)
            ASMutation.MutArt        = 'MAIL'
            ASMutation.Aktiv         = TRUE
            ASMutation.cStatus       = ''
            ASMutation.Datum         = TODAY
            ASMutation.Firma         = tParam.cFirma
            ASMutation.cFeld_1       = SUBSTITUTE('TO:&1;CC:&2', cTo, cCC)
            ASMutation.cFeld_2       = cSubject
            ASMutation.cFeld_3       = cBody
            ASMutation.cKey_1        = ''
            ASMutation.cKey_2        = cPDFName
            ASMutation.cKey_3        = 'LIEFERSCHEIN'
            ASMutation.iFeld_1       = TIME.
        RELEASE ASMutation.
        LEAVE.
    END.
    
    RETURN cMeldung.

END PROCEDURE.
    
/* _UIB-CODE-BLOCK-END */
&ANALYZE-RESUME


&ENDIF