H DATEDIT(*YMD) GENLVL(20) OPTION(*NOSHOWCPY : *NODEBUGIO)
H ccsid(*ucs2:13488)
H DECEDIT('0,') DATEDIT(*ymd/)
* FMITBAL00 UF A E K DISK F RENAME(ITBAL:Format01) F Prefix(W_) FTMP031I0 O E PRINTER OFLIND(*IN72)
*
*----------------------------------------------------------
* Tableau des touches de fonction
* Permet de tester dans le programme If F3 etc .....
* ---------------------------------------------------------
*
D P_INKA s * INZ(%ADDR(*INKA))
D F1 s N BASED(P_INKA)
D P_INKB s * INZ(%ADDR(*INKB))
D F2 s N BASED(P_INKB)
D P_INKC s * INZ(%ADDR(*INKC))
D F3 s N BASED(P_INKC)
D P_INKD s * INZ(%ADDR(*INKD))
D F4 s N BASED(P_INKD)
D P_INKE s * INZ(%ADDR(*INKE))
D F5 s N BASED(P_INKE)
D P_INKF s * INZ(%ADDR(*INKF))
D F6 s N BASED(P_INKF)
D P_INKG s * INZ(%ADDR(*INKG))
D F7 s N BASED(P_INKG)
D P_INKH s * INZ(%ADDR(*INKH))
D F8 s N BASED(P_INKH)
D P_INKI s * INZ(%ADDR(*INKI))
D F9 s N BASED(P_INKI)
D P_INKJ s * INZ(%ADDR(*INKJ))
D F10 s N BASED(P_INKJ)
D P_INKK s * INZ(%ADDR(*INKK))
D F11 s N BASED(P_INKK)
D P_INKL s * INZ(%ADDR(*INKL))
D F12 s N BASED(P_INKL)
D P_INKM s * INZ(%ADDR(*INKM))
D F13 s N BASED(P_INKM)
D P_INKN s * INZ(%ADDR(*INKN))
D F14 s N BASED(P_INKN)
D P_INKP s * INZ(%ADDR(*INKP))
D F15 s N BASED(P_INKP)
D P_INKQ s * INZ(%ADDR(*INKQ))
D F16 s N BASED(P_INKQ)
D P_INKR s * INZ(%ADDR(*INKR))
D F17 s N BASED(P_INKR)
D P_INKS s * INZ(%ADDR(*INKS))
D F18 s N BASED(P_INKS)
D P_INKT s * INZ(%ADDR(*INKT))
D F19 s N BASED(P_INKT)
D P_INKU s * INZ(%ADDR(*INKU))
D F20 s N BASED(P_INKU)
D P_INKV s * INZ(%ADDR(*INKV))
D F21 s N BASED(P_INKV)
D P_INKW s * INZ(%ADDR(*INKW))
D F22 s N BASED(P_INKW)
D P_INKX s * INZ(%ADDR(*INKX))
D F23 s N BASED(P_INKX)
D P_INKY s * INZ(%ADDR(*INKY))
D F24 s N BASED(P_INKY)
*===================================================================== * Exemple de DS et de zone de travail ET TABLEAU *===================================================================== * DS - For CTPARM D DS D CTPARM 1 200 D INVPER 97 97 D NBCOLS 98 100 D NBCOLS_num 98 100 0 D NBCNLS 101 103 D NBCNLS_num 101 103 0 * * Variable de travail D Nbr_lig_IDstk s 6 0 D Nbr_Page s 6 0
D Dernier_Env s 8S 0 * * DS pour la gestion des dates * ---------------------------- Ddsdate DS D date_trav d inz D annee_trav 4 0 overlay(date_trav:1) D moi_trav 2 0 overlay(date_trav:6) D jour_trav 2 0 overlay(date_trav:9) * D OH S 15 DIM(5) CTDATA PERRCD(1) D ACT S 5 DIM(20) * D MIN C 'abcdefghijklmnopqrstuvwxyz{}ê' D MAJ C 'ABCDEFGHIJKLMNOPQRSTUVWXYZEEE' D acc C 'àâäãéèêëôöüùûîïì' D std C 'aaaaeeeeoouuuiii' * =================================== * * Déclaration des zones de travail * * =================================== * dlibelle s 70a dnewlib s 70a dnewlib2 s 100a dorigine s 50a dreplace s 15a dNom s 20a dposdeb s 4s 0 dwren s like(rent) ddatejour s d inz(*sys) ddatejour s d inz(d'2000-08-15') dvalhexa s 1a inz(x'25') dval_lf s 3a inz('&LF') dmessage s 256a dposdeb s 4s 0 * c Eval libelle = 'Bonjour Me &nom, veuillez trouver+ c ci-joint la main de ma soeur.' C Eval nom = 'DANLOUP jean-Marc' * c eval posdeb = %scan('&nom' : libelle) * c if posdeb > 0 c eval newlib = %replace(%trim(nom) : libelle: c posdeb : 4) * c eval newlib2 = %subst(libelle:1:(posdeb-1)) + c %trim(nom) + %subst(libelle:(posdeb+4): c (%len(libelle)-(posdeb+4))) c endif c eval *inlr = *on *=====================================================================
* Récupération du numéro de semaine de début de campagne * A utiliser avec le programme ZRTVWEEK. * DATDEB format yyyymmdd *===================================================================== D Sem_Debut s 2 0 * C Movel DATDEB ZRDATE C Movel *blanks ZRSEM C Call 'ZRTVWEEK' C Parm ZRSEM 2 C Parm ZRDATE 8 C Movel ZRSEM Sem_Debut *===================================================================== * Transformation de date. * Datdeb => date au format jjmmaa (écran) * Wrkdt1 => zone numérique de 8/0 *===================================================================== D Wdtiso s d D Wrkdt1 s 8 0 * * Tranformation dates début C Eval Wdtiso = %date(%dec(datdeb:6:0):*dmy) C Eval Wrkdt1 = %dec(%char(Wdtiso:*iso0):8:0) * * Transformation date YYYYMMDD en DDMMYY * £DTLIV = 6/0 et ECDTL 8/0 C Eval £DTLIV = %dec(%char(%date(ECDTL:*iso) C :*dmy0):6:0) * *=====================================================================
* Gestion de l'heure
* WHeure_Depart => on renseigne Whdep avec une heure en 2/0,
* Wmdep avec un nombre de minute en 2/
* Trdimh => un nombre d'heure en 2/0
* Trdimm => un nombre de minute en 2/0
* En sortie Rthlim => zone heure/minute en 4/0 (1215 pour 12h15)
*===================================================================== D WHeure_Limite S T * * Decoupage de l'heure limite D DS D WHeure_Depart 1 6 0 D Whdep 1 2 0 D Wmdep 3 4 0 D Wsdep 5 6 0 inz(00)
* C Eval WHeure_Limite = %time(WHeure_depart:*hms) C - %hours(trdimh) - %minutes(trdimm) C Eval RTHLIM = %DEC(%subst(%CHAR(WHeure_Limite: C *iso0):1:4):4:0)
*
*=====================================================================
* Exemple de lecture de fichier
*===================================================================== * Lecture sans positionnement C Read(n) INVHES C Dow Not %Eof(INVHES) C Read(n) INVHES C Enddo * * Lecture avec positionnement tant que. C KITLOC Setll MITLOC00 C KITLOC Reade(n) MITLOC00 C Dow not %eof(MITLOC00) C Exsr Traitement C KITLOC Reade(n) MITLOC00 C Enddo * * Lecture direct sur clé C KITTKH Chain(n) MITTKH00 C If Not %Found(MITTKH00) C Exsr Traitement C Endif * *=====================================================================
* Exemple de Subtring *===================================================================== * Comparer l'année de deux dates au format YYYYMMDD C If %subst(%char(zcdebd):1:4) = C %subst(%char(zcfind):1:4) * * Exemple N° 2 c eval jjmmaa = '01'+'/'+$mm1 c +'/'+%subst($aaaa1:3:2) * * Exemple N° 3 c read qtxtsrc c dow not %eof c eval posdeb = %scan(%trim(origine) : srcdta) c if posdeb > 0 c eval srcdta = %replace(%trim(replace) : srcdta : c posdeb : c %len(%trim(origine))) c update f01 c endif c read qtxtsrc c enddo * *===================================================================== * Exemple de REPLACE dans un libéllé. * Attention à la taille du libellé en sortie si on ne veux pas * qu'il y ai troncage. *===================================================================== dlibelle s 70a dnewlib s 70a dnewlib2 s 100a dorigine s 50a dreplace s 15a dNom s 20a dposdeb s 4s 0 * c Eval libelle = 'Bonjour Me &nom, veuillez trouver+ c ci-joint la main de ma soeur.' C Eval nom = 'DANLOUP jean-Marc' * c eval posdeb = %scan('&nom' : libelle) * c if posdeb > 0 c eval newlib = %replace(%trim(nom) : libelle: c posdeb : 4) * Ou c eval newlib2 = %subst(libelle:1:(posdeb-1)) + c %trim(nom) + %subst(libelle:(posdeb+4): c (%len(libelle)-(posdeb+4))) c endif * *===================================================================== * Exemple de gestion de tableau *===================================================================== * Stockage des actes émis. D ACT S 5 DIM(20) * ======= * * TABLEAU * * ======= * * Stockage des actes émis. C Z-ADD 0 C1 3 0 C Z-ADD 1 $Z 3 0 C BZMESS LOOKUP ACT($Z) 95 C *IN95 IFEQ '0' C ADD 1 C1 C MOVEL BZMESS ACT(C1) C ENDIF * * Soumission traitement d'extraction * ---------------------------------- C Z-ADD 1 £J 3 0 C DO C1 £J C MOVEL(P) ACT(£J) R3ACTE C ENDDO * *===================================================================== * Remise à blanc d'un DS de fichier et sauvegarde d'un fichier dans DS *===================================================================== FCLIENTP1 IF E K DISK prefix(a_) FCLIENTPX IF E DISK * D CLIPX E DS EXTNAME(CLIENTPX) D SAVPX DS 1024 * * Sauvegarde de la DS du ficher CLIENTPX
C CLEAR SAVPX C MOVEL CLIPX SAVPX * *=====================================================================
* Gestion d'une DTAARA DTINVBO de 8 alpha qui contient une date
* au format 20140101
*=====================================================================
* lecture des DTAARA
C In DSLDA
C In DTINVBO
*
C Move DTINVBO Dernier_Env
*
* Mise à jour de la Dtaara avec la date
C *lock In DTINVBO
C Move Cudate DTINVBO
C Out DTINVBO
C Unlock DTINVBO
*=====================================================================
* Remplacement des caractères accentués d'une zone par un caractère
* standard => Voir tableau en carte D plus haut
*=====================================================================
C eval MASNAM = %xlate(acc:std:wwsnam)
* ou aussi
C Eval %Subst(MASUBJ: 1:50) = %xlate(
C acc:std:wwsubj)
C Eval %Subst(MASUBJ: 51:50) = %xlate(
C acc:std:wwsub2)
*=====================================================================
* Traduction du code "&LF" de la zone message par sa valeur
* en hexadécimal pour que la mise en forme se fasse bien
* dans le mail.
* Mise en majuscule de la zone message car l'utilisateur peut
* saisir en minuscule (&Lf ou &lF ou &lf) et il faut pouvoir
* traiter tous les cas.
*=====================================================================
C Eval message = mamess
C Eval len = 256
C Eval val = message
C Eval tbl = 'QSYSTRNTBL'
C Eval tbllib = '*LIBL'
C call 'QDCXLATE'
C parm len 5 0
C parm val 256
C parm tbl 10
C parm tbllib 10
*
* Le test de remplacement se fait sur la zone "message" passée en
* majuscule et l'on se sert de la position trouvée pour faire la
* mise à jour dans zone du fichier (mamess), cela permettant de conserver
* les minuscules dans cette zone.
C eval posdeb = %scan('&LF' : val)
C Dow posdeb > 0
C eval Val = %replace(%trim(valhexa) : Val :
C posdeb : 3)
C eval mamess = %replace(%trim(valhexa) : mamess :
C posdeb : 3)
C eval posdeb = %scan('&LF' : val)
C Enddo
*=====================================================================
* Gestion des messages d'erreur dans Movex
*=====================================================================
C If Not %equal(zwkfro00)
C Eval x0pic2 = 'D'
C Eval *In60 = *On
C Eval wwclin = 06
C Eval wwcpos = 16
C Eval msgf = 'MZZMSG'
* Rôle n'existe pas
C Eval msgid = 'WRO0103'
C Eval msgdta = w1role
C Exsr compmq
C Eval msgf = 'MVXMSG'
C Goto pbchkx
C Endif
*=====================================================================