Methods for dealing with Non Gregorian Calendars in SAS

jalali_fcmp.sas

proc fcmp;
 
 
    function to_jalali(sasdate) $ 200;
 
 
        y=year(sasdate)-1600;
        m=month(sasdate)-1;
        d=day(sasdate)-1;
 
 
        gd=365*y+floor((y+3)/4)-floor((y+99)/100)+floor((y+399)/400);
        array gmond[12] _temporary_ (31, 28, 31, 30, 31, 30, 31, 31,30, 31, 30, 31);
  
        do i=1 to m;
            gd+gmond[i];
        end;
        if m>1 and ((mod(y,4)=0 and mod(y,100)^=0) or (mod(y,400)=0)) then gd+1;
        gd+d;
 
 
        jd=gd-79;
        jnp=floor(jd/12053);
        jd=mod(jd,12053);
        jy=979+33*jnp+4*floor(jd/1461);
        jd=mod(jd,1461);
        if jd>=366 then do;
            jy+floor((jd-1)/365);
            jd=mod(jd-1,365);
        end;
        array jmond[12] _temporary_ (31, 31, 31, 31, 31, 31, 30, 30, 30, 30, 30, 29);
        do i=1 by 1 while(i<12 and jd>=jmond[i]);
            jd+-jmond[i];
        end;
        jm=i;
        jd=jd+1;
        return (catx('-',jy,jm,jd));
    endsub;
 
 
    function from_jalali(_jy, _jm, _jd);
        jy = _jy-979;
        jm = _jm-1;
        jd = _jd-1;
 
 
        jdn=365*jy+floor(jy/33)*8+floor((mod(jy,33)+3)/4);
 
 
        array jmond[12] _temporary_ (31, 31, 31, 31, 31, 31, 30, 30, 30, 30, 30, 29);
 
 
        do i=1 to jm;
            jdn+jmond[i];
        end;
        jdn+jd;
 
 
        gd=jdn+79;
 
 
        gy=1600+400*floor(gd/146097);
        gd=mod(gd,146097);
 
 
        leap=1;
        if gd>=36525 then do;
            gd+-1;
            gy+100*floor(gd/36524);
            gd=mod(gd,36524);
            if gd>=365 then gd+1;
            else leap=0;
        end;
       
        gy+4*floor(gd/1461);
        gd = mod(gd, 1461);
 
 
        if gd>=366 then do;
            leap=0;
            gd+-1;
            gy+floor(gd/365);
            gd=mod(gd,365);
        end;
 
 
        array gmond[12] _temporary_ (31, 28, 31, 30, 31, 30, 31, 31,30, 31, 30, 31);
 
 
        do i=1 by 1 while(gd>=gmond[i]+(i=2 and leap));
            gd+-gmond[i]+(i=2 and leap);
        end;
        gm=i;
        gd=gd+1;
 
 
        return(mdy(gm,gd,gy));
    endsub;
 
 
length x $200;
x=to_jalali('27OCT2014'd);
put x=;
 
 
y=from_jalali(1393,8,5);
put y= date9.;
 
 
quit;

jalali_macro.sas

%macro to_jalali(in, out);
    %local lidx y m d gd gmond i jd jdn jy jm jmond;
    %let lidx=&sysindex.;
    %let y=__y&lidx.;
    %let m=__m&lidx.;
    %let d=__d&lidx.;
    %let gd=__gd&lidx.;
    %let gmond=__gmond&lidx.;
    %let i=__i&lidx.;
    %let jd=__jd&lidx.;
    %let jdn=__jdn&lidx.;
    %let jy=__jy&lidx.;
    %let jm=__jm&lidx.;
    %let jmond=__jmond&lidx.;
    &y.=year(&in.)-1600;
    &m.=month(&in.)-1;
    &d.=day(&in.)-1;
    &gd.=365*&y.+floor((&y.+3)/4)-floor((&y.+99)/100)+floor((&y.+399)/400);
    array &gmond.[12] _temporary_ (31, 28, 31, 30, 31, 30, 31, 31,30, 31, 30, 31);
    do &i.=1 to &m.;
        &gd.+&gmond.[&i.];
    end;
    if &m.>1 and ((mod(&y.,4)=0 and mod(&y.,100)^=0) or (mod(&y.,400)=0)) then &gd.+1;
    &gd.+&d.;
    &jd.=&gd.-79;
    &jdn.=floor(&jd./12053);
    &jd.=mod(&jd.,12053);
    &jy.=979+33*&jdn.+4*floor(&jd./1461);
    &jd.=mod(&jd.,1461);
    if &jd.>=366 then do;
        &jy.+floor((&jd.-1)/365);
        &jd.=mod(&jd.-1,365);
    end;
    array &jmond.[12] _temporary_ (31, 31, 31, 31, 31, 31, 30, 30, 30, 30, 30, 29);
    do &i.=1 by 1 while(&i.<12 and &jd.>=&jmond.[&i.]);
        &jd.+-&jmond.[&i.];
    end;
    &jm.=&i.;
    &jd.=&jd.+1;
    &out.=catx('-',&jy.,&jm.,&jd.);
 
    drop &y. &m. &d. &gd. &i. &jd. &jdn. &jy. &jm.;
%mend;
 
%macro from_jalali(year, month, day, out);
    %local lidx jy jm jd jdn jmond i gd gy gmond leap;
    %let lidx=&sysindex.;
    %let jy=__jy&lidx.;
    %let jm=__jm&lidx.;
    %let jd=__jd&lidx.;
    %let jdn=__jdn&lidx.;
    %let jmond=__jmond&lidx.;
    %let i=__i&lidx.;
    %let gd=__gd&lidx.;
    %let gy=__gy&lidx.;
    %let gm=__gm&lidx.;
    %let leap=__leap&lidx.;
    %let gmond=__gmond&lidx.;
 
    &jy.=&year.-979;
    &jm.=&month.-1;
    &jd.=&day.-1;
 
    &jdn.=365*&jy.+floor(&jy./33)*8+floor((mod(&jy.,33)+3)/4);
 
    array &jmond.[12] _temporary_ (31, 31, 31, 31, 31, 31, 30, 30, 30, 30, 30, 29);
 
    do &i.=1 to &jm.;
        &jdn.+&jmond.[&i.];
    end;
    &jdn.+&jd.;
 
    &gd.=&jdn.+79;
 
    &gy.=1600+400*floor(&gd./146097);
    &gd.=mod(&gd.,146097);
 
    &leap.=1;
    if &gd.>=36525 then do;
        &gd.+-1;
        &gy.+100*floor(&gd/36524);
        &gd.=mod(&gd.,36524);
        if &gd.>=365 then &gd.+1;
        else &leap.=0;
    end;
    
    &gy.+4*floor(&gd./1461);
    &gd. = mod(&gd., 1461);
 
    if &gd.>=366 then do;
        &leap.=0;
        &gd.+-1;
        &gy.+floor(&gd./365);
        &gd.=mod(&gd.,365);
    end;
 
    array &gmond.[0:11] _temporary_ (31, 28, 31, 30, 31, 30, 31, 31,30, 31, 30, 31);
 
    do &i.=0 to 11 by 1 while(&gd.>=&gmond.[&i.]+(&i.=2 and &leap.));
        &gd.+-&gmond.[&i.]+(&i.=2 and &leap.);
    end;
    &gm.=&i.+1;
    &gd.=&gd.+1;
 
    &out.=mdy(&gm.,&gd.,&gy.);
 
    drop &jy. &jm. &jd. &jdn. &i. &gd. &gm. &gy. &leap.;
%mend;
 
data foo;
    format from_jalali date9.;
    array jmond[12] _temporary_ (31, 31, 31, 31, 31, 31, 30, 30, 30, 30, 30, 29);
    do year=1393 to 1393;
    do month=1 to 12;
    do day=1 to jmond[month];
    if year=1393 and month=8 and day>5 then stop;
    %from_jalali(year, month, day, from_jalali)
    output;
    end;
    end;
    end;
run;

kuwaiti_hijri_fcmp.sas

proc fcmp outlib=work.func.kuwaiti;
 
 
subroutine _kuwaiti(sasdate, imDate[3]);
    outargs imDate;
 
 
    d=day(sasdate);
    m=month(sasdate);
    y=year(sasdate);
    if (m<3) then do;
        y+-1;
        m++12;
    end;
 
 
    a=floor(y/100);
    b=2-a+floor(a/4);
    if (y<1583) then b=0;
    else if (y=1582) then do;
        if (m>10) then b=-10;
        else if (m=10) then do;
            b=0;
            if (d>4) then b=-10;
        end;
    end;
 
 
    jd=floor(365.25*(y+4716))+floor(30.6001*(m+1))+d+b-1524;
 
 
    b=0;
    if jd>2299160 then do;
        a=floor((jd-1867216.25)/36524.25);
        b=1+a-floor(a/4);
    end;
 
 
    bb=jd+b+1524;
    cc=floor((bb-122.1)/365.25);
    dd=floor(365.25*cc);
    ee=floor((bb-dd)/30.6001);
    day=(bb-dd)-floor(30.6001*ee);
    month=ee-1;
 
 
    if(ee>13) then do;
        cc+1;
        month=ee-13;
    end;
 
 
    year=cc-4716;
    wd=mod((mod(jd+1,7)+7),7);
    iyear = 10631/30;
    epochastro = 1948084;
    epochcivil = 1948085; /*alternate epoch*/
 
 
    shift1 = 8.01/60;
 
 
    z = jd-epochastro;
    cyc=floor(z/10631);
    z=z-10631*cyc;
    j=floor((z-shift1)/iyear);
    iy=30*cyc+j;
    z=z-floor(j*iyear+shift1);
    im=floor((z+28.5001)/29.5);
    if im=13 then im=12;
    id=z-floor(29.5001*im-29);
 
 
    imDate[1]=iy; /*islamic year*/
    imDate[2]=im; /*islamic month*/
    imDate[3]=id; /*islamic day of month*/
endsub;
 
 
function kuwaitidate(sasdate) $ 200;
    array iDate[3] / nosymbols;
    array iMon[12] $ 14 _temporary_ ("Muharram","Safar","Rabi'ul Awwal","Rabi'ul Akhir",
  "Jumadal Ula","Jumadal Akhira","Rajab","Sha'ban",
  "Ramadan","Shawwal","Dhul Qa'ada","Dhul Hijja");
    call _kuwaiti(sasdate, iDate);
    return (put(sasdate,downame.) || ', ' || strip(put(iDate[3],best.)) || ' ' || strip(iMon[iDate[2]]) || ' ' || strip(put(iDate[1],best.)) || ' AH');
endsub;
 
/*example usage*/
length x $2000;
x=kuwaitidate('27OCT2014'd);
put x=;
quit;
 
options cmplib=(work.func);
 
proc format;
  value kuwaitidate other=[kuwaitidate()];
run;
 
%put %sysfunc(today(), kuwaitidate.);
 
/*   Monday, 4 Muharram 1436 AH   */