*******
******* CALCUL D'UNE DATE (FONCTION D'UNE DATE ET D'UN NOMBRE DE JOURS EN +/-)
*******
*******        CE PGM ATTEND 1/ UNE DATE 7 C (SIECLE + DATE)
*******                         CE PARAMÈTRE CONTIENDRA LA DATE CALCULEE
*******
*******                      2/ LE FORMAT DE LA DATE *YMD,*DMY,...,*JOB
*******
*******                      3/ UN NOMBRE DE JOUR (5 DT 0) POSITIF (AJOUT)
*******                                                    NEGATIF (RETRAIT)
********************************************************************************
     E                    MTYP        2 10
     IMSGTB       DS
     I                                        1  20 MTYP
     IMSGDS       DS
     I                                    B   1   40STACK
     I                                    B   5   80NBTYP
     IMSGERR      DS
     I I            16                    B   1   40LGCOD
     I                                    B   5   80LGUTIL
     I                                        9  15 MSGID
     I                                       16  16 RESERV
     IDAT16       DS
     I I            0                         1   10SIECLE
     I                                        2   7 DATDS
     I I            '235959001'               8  16 HMS
     IDATJUL      DS
     I                                        1   10SIECLJ
     I                                        2   30AJ
     I                                        4   60JJ
     I                                        7   7 FILLER
     I I            '235959001'               8  16 HMSJ
     ICODERR      DS
     I I            0                     B   1   40LGERR
      *
     C           *ENTRY    PLIST
     C                     PARM           DATE    7
     C                     PARM           FMT    10
     C                     PARM           NBJOUR  50
      *
     C                     MOVELDATE      DAT16
      *
     C                     CALL 'QWCCVTDT'
     C                     PARM FMT       INFMT  10

     C                     PARM           DAT16
     C                     PARM '*JUL'    OUTFMT 10
     C                     PARM           DATJUL
     C                     PARM           CODERR
      *
     C                     Z-ADDJJ        WJJ     70
     C                     ADD  NBJOUR    WJJ
     C           NBJOUR    IFLT 0
     C           WJJ       DOWLT0
     C                     EXSR BISEX
     C                     ADD  FIN       WJJ
     C           AJ        IFEQ 1
     C                     SUB  1         SIECLJ
     C                     ENDIF
     C                     SUB  1         AJ
     C                     ENDDO
     C                     ELSE
     C                     EXSR BISEX
     C           WJJ       DOWGTFIN
     C                     SUB  FIN       WJJ
     C           AJ        IFEQ 99
     C                     ADD  1         SIECLJ
     C                     ENDIF
     C                     ADD  1         AJ
     C                     EXSR BISEX
     C                     ENDDO
     C                     ENDIF
      *
     C                     Z-ADDWJJ       JJ
      *
     C                     CALL 'QWCCVTDT'
     C                     PARM '*JUL'    INFMT
     C                     PARM           DATJUL
     C                     PARM FMT       OUTFMT
     C                     PARM           DAT16
     C                     PARM           CODERR
      *
     C                     MOVELDAT16     DATE
     C                     MOVE *ON       *INLR
     C                     RETRN
      *
     C           BISEX     BEGSR
     C           SIECLJ    IFEQ 0
     C                     Z-ADD1900      AAAA    40

     C                     ELSE
     C                     Z-ADD2000      AAAA
     C                     ENDIF
     C                     ADD  AJ        AAAA
      *
     C           AAAA      DIV  4         AAA     30
     C                     MVR            RRR     30
     C           RRR       IFGT 0
      * NON BISEXTILE
     C                     Z-ADD365       FIN     30
     C                     ELSE
     C           AAAA      DIV  100       AAA     30
     C                     MVR            RRR     30
     C           RRR       IFGT 0
      * NON MULTIPLE DE CENT ==> BISEXTILE
     C                     Z-ADD366       FIN
     C                     ELSE
     C           AAAA      DIV  400       AAA     30
     C                     MVR            RRR     30
     C           RRR       IFEQ 0
      * MULTIPLE DE CENT ET DE QUATRE CENT ==> BISEXTILE
     C                     Z-ADD366       FIN
     C                     ELSE
      * MULTIPLE DE CENT, PAS DE QUATRE CENT ==> NON BISEXTILE
     C                     Z-ADD365       FIN
     C                     ENDIF
     C                     ENDIF
     C                     ENDIF
     C                     ENDSR
      *
      * EN CAS D'ERREUR ==> RENVOI DES MESSAGES ET CANCEL DU PGM
      *
     C           *PSSR     BEGSR
     C                     MOVEL'*DIAG'   MTYP,1
     C                     MOVEL'*ESCAPE' MTYP,2
     C                     CALL 'QMHMOVPM'
     C                     PARM           MSGCLE  4
     C                     PARM           MSGTB
     C                     PARM 2         NBTYP
     C                     PARM '*'       PGMQ   10
     C                     PARM 1         STACK
     C                     PARM           MSGERR
     C                     ENDSR'*CANCL'