| 
h nomain * prototypes ========================================================= d dat6_char8 pr 8 d 6 0 d dat6_char10 pr 10 d 6 0 d dat7_char10 pr 10 d 7 0 d dat8_char10 pr 10 d 8 0 ddayofweek pr 1p 0 d d const ddebutannee pr D d d const dfinannee pr D d d const djourjulien pr 3P 0 d d const dweek pr 4P 0 d d const dweek2 pr 2P 0 d d const dweekofyear pr 2P 0 d d const * fonctions ========================================================== Pdat6_char8 b export d pi 8 d dt6_recue 6 0 d date s D datfmt(*dmy/) c *ymd test(d e) dt6_recue c if %error c return '01/01/40' c else c *ymd move dt6_recue date c return %char(date) c endif c P e |
|
Pdat6_char10 b export d pi 10 d dt6_recue 6 0 d date s D datfmt(*iso) c *ymd test(d e) dt6_recue c if %error c return '0001-01-01' c else c *ymd move dt6_recue date c return %char(date) c endif c P e Pdat7_char10 b export d pi 10 d dt7_recue 7 0 d date s D datfmt(*iso) c *cymd test(d e) dt7_recue c if %error c return '0001-01-01' c else c *cymd move dt7_recue date c return %char(date) c endif c P e Pdat8_char10 b export d pi 10 d dt8_recue 8 0 d date s D datfmt(*iso) c *iso test(d e) dt8_recue c if %error |
|
c return '0001-01-01' c else c *iso move dt8_recue date c return %char(date) c endif c P e pdayofweek b export d pi 1p 0 d datein d const dwdate s d dundimanche s d inz(d'1980-01-06') dnbjours s 15p 0 djoursem s 1p 0 c eval wdate = datein c wdate subdur undimanche nbjours:*d c nbjours div 7 nbjours c mvr joursem * année < à 06/01/80 c if joursem < 0 c eval joursem = joursem + 7 c endif * dimanche c if joursem = 0 c return 7 c else c return joursem c endif pdayofweek e pdebutannee b export d pi D d datein d const d DS d wdate d d mois 2S 0 overlay(wdate:6) d jour 2S 0 overlay(wdate:9) c eval wdate = datein c eval mois = 1 c eval jour = 1 c return wdate pdebutannee e |
|
pfinannee b export d pi D d datein d const d DS d wdate d d mois 2S 0 overlay(wdate:6) d jour 2S 0 overlay(wdate:9) c eval wdate = datein c eval mois = 12 c eval jour = 31 c return wdate pfinannee e pjourjulien b export d pi 3P 0 d datein d const dwdate s d dwdatedeb s d djnum s 3S 0 c eval wdate = datein c eval wdatedeb = debutannee(wdate) c wdate subdur wdatedeb jnum:*d c return jnum + 1 pjourjulien e pweek b export d pi 4P 0 d datein d const d DS dwdate d d numan 2S 0 overlay(wdate:3) dnbjours s 5 0 dnumsem s 2 0 dreste s 1 0 dsemaine0 s n c eval wdate = datein |
|
c dou not semaine0 c eval nbjours = dayofweek(debutannee(wdate)) c - 1 + jourjulien(wdate) c nbjours div 7 numsem c mvr reste c if reste <> 0 c eval numsem = numsem + 1 c endif c if dayofweek(debutannee(wdate)) > 4 c eval numsem = numsem - 1 c endif c if numsem < 1 c eval semaine0 = *on c subdur 1:*Y wdate c eval wdate = finannee(wdate) c else c eval semaine0 = *off c endif c enddo c if dayofweek(finannee(wdate)) < 4 AND c numsem = 53 c eval numsem = 1 c eval numan = numan + 1 c endif c return numan * 100 + numsem pweek e pweek2 b export d pi 2P 0 d datein d const c return %rem(week(datein) : 100) pweek2 e |
|
* autre version de la fonction N° de semaine pweekofyear b export d pi 2P 0 d datein D const d DS d janvier4 D INZ(D'0001-01-04') d ANjanvier4 4 0 OVERLAY(janvier4) d Lundi S D /free // calcul du 4 janvier de l'année traitée ANjanvier4 = %SUBDT(DateIn : *Y); // calcul du Lundi précédent le 4 janvier Lundi = janvier4 - %DAYS(dayofweek(janvier4)-1) ; // si date recue < au lundi ==> premier lundi,année précédente if DateIn < Lundi; ANjanvier4 -= 1; Lundi = janvier4 - %DAYS(dayofweek(janvier4)+1); endif; // nombre de semaine entières return %DIV( %DIFF(DateIn:Lundi:*DAYS) : 7) +1; /end-free |
