GeMIS_WEB/GUI/batchDrucken.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  ************************** */

{ super/funktionen.i }

DEF VAR cUser       AS CHAR                     NO-UNDO.
DEF VAR cBenutzer   AS CHAR                     NO-UNDO.
DEF VAR cPasswort   AS CHAR                     NO-UNDO.
DEF VAR cFirma      AS CHAR                     NO-UNDO.
DEF VAR cLogName    AS CHAR                     NO-UNDO.
DEF VAR cParam      AS CHAR                     NO-UNDO.
DEF VAR Progname    AS CHAR                     NO-UNDO.
DEF VAR iJobNr      AS INT                      NO-UNDO.

DEF STREAM LogFile.

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION-FORWARD writeLogFile Procedure 
FUNCTION writeLogFile RETURNS LOGICAL
  ( ipText AS CHAR )  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  *************************** */

    DEF VAR iTime       AS INT                      NO-UNDO.
    DEF VAR iRecId      AS RECID                    NO-UNDO.
    DEF VAR iTrnr       AS INT  INIT 0              NO-UNDO.
    DEF VAR lReorg      AS LOG  INIT FALSE          NO-UNDO.
    DEF VAR iHH         AS INT                      NO-UNDO.
    DEF VAR cCommand    AS CHAR                     NO-UNDO.
    DEF VAR cString     AS CHAR                     NO-UNDO.
    DEF VAR iAnzInstanz AS INT  INIT 0              NO-UNDO.
    DEF VAR iMaxInstanz AS INT  INIT 1              NO-UNDO.
    DEF VAR iAnzJobs    AS INT                      NO-UNDO.
    DEF VAR iMaxJobs    AS INT  INIT 4              NO-UNDO.
    DEF VAR ii          AS INT                      NO-UNDO.
    DEF VAR jj          AS INT                      NO-UNDO.

    Progname = 'batchdrucken'.
    iJobNr   = TIME.

    cLogName = SUBSTITUTE('&1BatchDrucken.Log', SESSION:TEMP-DIR ).
    cString = 'Start mit Parameter -> ' + SESSION:PARAMETER + ' in Logfile ' + cLogName.
    DYNAMIC-FUNCTION('writeLogFile':U, cString ) NO-ERROR.
    
    DO WHILE SESSION:PARAMETER <> '':
        cBenutzer = ENTRY(1, SESSION:PARAMETER, ';') NO-ERROR.
        cPasswort = ENTRY(2, SESSION:PARAMETER, ';') NO-ERROR.
        cFirma    = ENTRY(3, SESSION:PARAMETER, ';') NO-ERROR.
        LEAVE.
    END.
    
    cParam = SUBSTITUTE('&1&4&2&4&3', cBenutzer, cPasswort, cFirma, CHR(01) ).
    RUN ANMELDUNG ( cParam ).
    
    RUN REORG_ASMUTATION.
    RUN REORG_TABELLEN.
    
    iTime = ETIME(TRUE).
    
    MAIN-BLOCK:
    REPEAT:
        FIND FIRST ASMutation NO-lOCK USE-INDEX ASMutation-k2
                WHERE ASMutation.Aktiv         = TRUE
                AND   ASMutation.asmutation_id > iTrnr
                AND   ASMutation.cStatus       = ''
                AND   ASMutation.MutArt       <> 'MAIL' NO-ERROR.
                
        IF NOT AVAILABLE ASMutation THEN DO:
            ASSIGN  iTrnr       = 0.
                    iAnzInstanz = 0.
            IF (ETIME(FALSE) - iTime) >= 600000 THEN PAUSE 10 NO-MESSAGE.
            ELSE                                     PAUSE 2  NO-MESSAGE.
            
            iHH = INTEGER(SUBSTRING(STRING(TIME,'HH:MM:SS'),01,02)).
            IF iHH <> 04 AND
               iHH <> 12 THEN lReorg = FALSE.
            IF lReorg    THEN NEXT MAIN-BLOCK.
            
            RUN REORG_TABELLEN.
            RUN REORG_ASMUTATION.
            
            lReorg = TRUE.
            NEXT MAIN-BLOCK.
        END.
        
        REPEAT TRANSACTION:
            IF ASMutation.MutArt <> 'ENDE' THEN LEAVE.
            FIND CURRENT ASMutation.
            DELETE  ASMutation.
            LEAVE MAIN-BLOCK.
        END.

        iTime = ETIME(TRUE).
        iTrnr = ASMutation.asmutation_id.
        
        iAnzJobs = 0.
        FOR EACH ASMutation NO-LOCK
                WHERE ASMutation.Aktiv    = TRUE
                AND   ASMutation.cStatus  = 'A'
                AND   ASMutation.Datum   >= TODAY - 1
                AND   ASMutation.MutArt  <> 'MAIL'  :
            iAnzJobs = iAnzJobs + 1.
        END.
        IF iAnzJobs >= iMaxJobs THEN NEXT.
        
        IF iAnzInstanz < iMaxInstanz THEN DO:
            iAnzInstanz = iAnzInstanz + 1.
            cCommand = 'C:\windows\system32\schtasks /run /tn "DruckenAuftragsPapiere" '.
            DYNAMIC-FUNCTION('writeLogFile':U, cCommand ) NO-ERROR.
            OS-COMMAND SILENT VALUE(cCommand).
            PAUSE 2 NO-MESSAGE.
        END.

        DO WHILE iAnzJobs > 0:
            PAUSE 10 NO-MESSAGE.
            ii = 0.
            FOR EACH ASMutation NO-LOCK
                    WHERE ASMutation.Aktiv         = TRUE
                    AND   ASMutation.cStatus       = 'A'
                    AND   ASMutation.Datum         = TODAY - 1
                AND   ASMutation.MutArt           <> 'MAIL'  :
                ii = ii + 1.
            END.
            IF ii = 0        THEN LEAVE.
            IF ii = iAnzJobs THEN jj = jj + 1.
            IF jj = 10 THEN DO:     /*  Immer die gleiche Anzahl aktiver Jobs = "Hängende" */
                RUN REORG_ASMUTATION.
                RUN REORG_TABELLEN.
                iAnzInstanz = iAnzInstanz - 1.
                LEAVE.
            END.
        END.
        iTrnr = 0.
    END.
    
   QUIT.

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


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

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

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

    DEF VAR aRecid      AS RECID                    NO-UNDO.

    DEF BUFFER bASMut       FOR ASMutation.


    FOR EACH ASMutation NO-LOCK
            WHERE ASMutation.Aktiv   = FALSE
            AND   ASMutation.cStatus = 'E'
            AND   ASMutation.Datum   < (TODAY - 7) TRANSACTION:
        aRecid = RECID(ASMutation).
        FIND bASMut EXCLUSIVE-LOCK WHERE RECID(bASMut) = aRecid NO-WAIT NO-ERROR.
        IF LOCKED bASMut THEN NEXT.
        DELETE  bASMut.
    END.

    FOR EACH ASMutation NO-LOCK
            WHERE ASMutation.Aktiv    = TRUE
            AND   ASMutation.cStatus <> ''
            AND   ASMutation.Datum    < (TODAY - 7) TRANSACTION:
        aRecid = RECID(ASMutation).
        FIND bASMut EXCLUSIVE-LOCK WHERE RECID(bASMut) = aRecid NO-WAIT NO-ERROR.
        IF LOCKED bASMut THEN NEXT.
        DELETE  bASMut.
    END.
    FOR EACH ASMutation NO-LOCK
            WHERE ASMutation.Aktiv   = TRUE
            AND   ASMutation.cStatus = 'A'
            AND   ASMutation.Datum  >= TODAY - 1 TRANSACTION:
        aRecid = RECID(ASMutation).
        FIND bASMut EXCLUSIVE-LOCK WHERE RECID(bASMut) = aRecid NO-WAIT NO-ERROR.
        IF LOCKED bASMut THEN NEXT.
        ASSIGN  bASMut.cStatus = ''.
    END.
     
    FOR EACH Tabel
            WHERE Tabel.Firma  = cFirma
            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.

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:       
------------------------------------------------------------------------------*/

    DEF VAR iRecid      AS RECID                    NO-UNDO.
    DEF VAR iAnz        AS INT                      NO-UNDO.
    
    DEF BUFFER bRuestAuf    FOR RuestAuf.
    DEF BUFFER bTabel       FOR Tabel.

    iAnz = 0.
    FOR EACH RuestAuf NO-LOCK
           WHERE RuestAuf.Firma = cFirma
           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  = cFirma
            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).
        DELETE  bTabel.
        iAnz = iAnz + 1.
    END.
    RELEASE bTabel.

END PROCEDURE.

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

&ENDIF

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

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

&ANALYZE-SUSPEND _UIB-CODE-BLOCK _FUNCTION writeLogFile Procedure 
FUNCTION writeLogFile RETURNS LOGICAL
  ( ipText AS CHAR ) :
/*------------------------------------------------------------------------------
  Purpose:  
    Notes:  
------------------------------------------------------------------------------*/

    DEF VAR cTime       AS CHAR                     NO-UNDO.
    DEF VAR iHH         AS INT                      NO-UNDO.
    DEF VAR iMM         AS INT                      NO-UNDO.
    DEF VAR iSS         AS INT                      NO-UNDO.

    IF ipText = '' THEN RETURN FALSE.
    /*
    OUTPUT STREAM LogFile TO VALUE(cLogName) APPEND NO-MAP NO-CONVERT.
    PUT STREAM LogFile CONTROL '--> '
                               STRING(TODAY,'99.99.9999')
                               '  '
                               STRING(TIME ,'HH:MM:SS')
                               ' -> '
                               ipText   
                               CHR(13) CHR(10).
    OUTPUT STREAM LogFile CLOSE.
    */
    cTime = STRING(TIME,'HH:MM:SS').
    iHH   = INTEGER(SUBSTRING(cTime,01,02)).
    iMM   = INTEGER(SUBSTRING(cTime,04,02)).
    iSS   = INTEGER(SUBSTRING(cTime,07,02)).
    REPEAT TRANSACTION:
        CREATE  LogDatei.
        ASSIGN  LogDatei.Firma      = cFirma
                LogDatei.Log_Id     = NEXT-VALUE(Log_Id)
                LogDatei.JobId      = iJobNr
                LogDatei.DatumZeit  = DATETIME(MONTH(TODAY), DAY(TODAY), YEAR(TODAY), iHH, iMM, iSS, 0)
                LogDatei.LogProg    = Progname
                LogDatei.LogText    = ipText.
        RELEASE LogDatei.
        LEAVE.
    END.
            
    RETURN TRUE.

END FUNCTION.

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

&ENDIF