%let name=cardio;
filename odsout '.';

/* 
Imitation of graphic Mike Zdeb sent me - the original graphic appeared in 
"European Heart Journal (2003) 24, 987-1003
Estimation of ten-year risk of fatal cardiovascular disease in Europe: the sCORE project"

Here's a low-resolution picture (higher-resolution in the actual paper)...
http://www.dartmouth.edu/%7Echance/chance_news/current_news/current.html
*/

%let textsize=2.25;

/*
Sex = F/M
Smoker=N (nonsmoker), S (smoker)
*/
data my_data;
input sex $ 1-1 smoker $ 3-3 agegroup bloodpressure cholesterol risk;
grid_id=sex||'_'||smoker||'_'||trim(left(agegroup))||'_'||trim(left(bloodpressure))||'_'||trim(left(cholesterol));
cards;
F N 65 120 4 2
F N 65 120 5 2
F N 65 120 6 3
F N 65 120 7 3
F N 65 120 8 4
F N 65 140 4 3
F N 65 140 5 3
F N 65 140 6 4
F N 65 140 7 5
F N 65 140 8 6
F N 65 160 4 5
F N 65 160 5 5
F N 65 160 6 6
F N 65 160 7 7
F N 65 160 8 8
F N 65 180 4 7
F N 65 180 5 8
F N 65 180 6 9
F N 65 180 7 10
F N 65 180 8 12
F S 65 120 4 4
F S 65 120 5 5
F S 65 120 6 5
F S 65 120 7 6
F S 65 120 8 7
F S 65 140 4 6
F S 65 140 5 7
F S 65 140 6 8
F S 65 140 7 9
F S 65 140 8 11
F S 65 160 4 9
F S 65 160 5 10
F S 65 160 6 12
F S 65 160 7 13
F S 65 160 8 16
F S 65 180 4 13
F S 65 180 5 15
F S 65 180 6 17
F S 65 180 7 19
F S 65 180 8 22
M N 65 120 4 4
M N 65 120 5 5
M N 65 120 6 6
M N 65 120 7 7
M N 65 120 8 9
M N 65 140 4 6
M N 65 140 5 8
M N 65 140 6 9
M N 65 140 7 11
M N 65 140 8 13
M N 65 160 4 9
M N 65 160 5 11
M N 65 160 6 13
M N 65 160 7 15
M N 65 160 8 16
M N 65 180 4 14
M N 65 180 5 16
M N 65 180 6 19
M N 65 180 7 22
M N 65 180 8 26
M S 65 120 4 9
M S 65 120 5 10
M S 65 120 6 12
M S 65 120 7 14
M S 65 120 8 17
M S 65 140 4 13
M S 65 140 5 15
M S 65 140 6 17
M S 65 140 7 20
M S 65 140 8 24
M S 65 160 4 18
M S 65 160 5 21
M S 65 160 6 25
M S 65 160 7 29
M S 65 160 8 34
M S 65 180 4 26
M S 65 180 5 30
M S 65 180 6 35
M S 65 180 7 41
M S 65 180 8 47
F N 60 120 4 1
F N 60 120 5 1
F N 60 120 6 2
F N 60 120 7 2
F N 60 120 8 2
F N 60 140 4 2
F N 60 140 5 2
F N 60 140 6 2
F N 60 140 7 3
F N 60 140 8 3
F N 60 160 4 3
F N 60 160 5 3
F N 60 160 6 3
F N 60 160 7 4
F N 60 160 8 5
F N 60 180 4 4
F N 60 180 5 4
F N 60 180 6 5
F N 60 180 7 6
F N 60 180 8 7
F S 60 120 4 2
F S 60 120 5 3
F S 60 120 6 3
F S 60 120 7 4
F S 60 120 8 4
F S 60 140 4 3
F S 60 140 5 4
F S 60 140 6 5
F S 60 140 7 5
F S 60 140 8 6
F S 60 160 4 5
F S 60 160 5 6
F S 60 160 6 7
F S 60 160 7 8
F S 60 160 8 9
F S 60 180 4 8
F S 60 180 5 9
F S 60 180 6 10
F S 60 180 7 11
F S 60 180 8 13
M N 60 120 4 3
M N 60 120 5 3
M N 60 120 6 4
M N 60 120 7 5
M N 60 120 8 6
M N 60 140 4 4
M N 60 140 5 5
M N 60 140 6 6
M N 60 140 7 7
M N 60 140 8 9
M N 60 160 4 6
M N 60 160 5 7
M N 60 160 6 9
M N 60 160 7 10
M N 60 160 8 12
M N 60 180 4 9
M N 60 180 5 11
M N 60 180 6 13
M N 60 180 7 15
M N 60 180 8 18
M S 60 120 4 6
M S 60 120 5 7
M S 60 120 6 8
M S 60 120 7 10
M S 60 120 8 12
M S 60 140 4 8
M S 60 140 5 10
M S 60 140 6 12
M S 60 140 7 14
M S 60 140 8 17
M S 60 160 4 12
M S 60 160 5 14
M S 60 160 6 17
M S 60 160 7 20
M S 60 160 8 24
M S 60 180 4 18
M S 60 180 5 21
M S 60 180 6 24
M S 60 180 7 28
M S 60 180 8 33
F N 55 120 4 1
F N 55 120 5 1
F N 55 120 6 1
F N 55 120 7 1
F N 55 120 8 1
F N 55 140 4 1
F N 55 140 5 1
F N 55 140 6 1
F N 55 140 7 1
F N 55 140 8 2
F N 55 160 4 1
F N 55 160 5 2
F N 55 160 6 2
F N 55 160 7 2
F N 55 160 8 3
F N 55 180 4 2
F N 55 180 5 2
F N 55 180 6 3
F N 55 180 7 3
F N 55 180 8 4
F S 55 120 4 1
F S 55 120 5 1
F S 55 120 6 2
F S 55 120 7 2
F S 55 120 8 2
F S 55 140 4 2
F S 55 140 5 2
F S 55 140 6 2
F S 55 140 7 3
F S 55 140 8 3
F S 55 160 4 3
F S 55 160 5 3
F S 55 160 6 4
F S 55 160 7 4
F S 55 160 8 5
F S 55 180 4 4
F S 55 180 5 5
F S 55 180 6 5
F S 55 180 7 6
F S 55 180 8 7
M N 55 120 4 2
M N 55 120 5 2
M N 55 120 6 3
M N 55 120 7 3
M N 55 120 8 4
M N 55 140 4 3
M N 55 140 5 3
M N 55 140 6 4
M N 55 140 7 5
M N 55 140 8 6
M N 55 160 4 4
M N 55 160 5 5
M N 55 160 6 6
M N 55 160 7 7
M N 55 160 8 8
M N 55 180 4 6
M N 55 180 5 7
M N 55 180 6 8
M N 55 180 7 10
M N 55 180 8 12
M S 55 120 4 4
M S 55 120 5 4
M S 55 120 6 5
M S 55 120 7 6
M S 55 120 8 8
M S 55 140 4 5
M S 55 140 5 6
M S 55 140 6 8
M S 55 140 7 9
M S 55 140 8 11
M S 55 160 4 8
M S 55 160 5 9
M S 55 160 6 11
M S 55 160 7 13
M S 55 160 8 16
M S 55 180 4 12
M S 55 180 5 13
M S 55 180 6 16
M S 55 180 7 19
M S 55 180 8 22
F N 50 120 4 0
F N 50 120 5 0
F N 50 120 6 1
F N 50 120 7 1
F N 50 120 8 1
F N 50 140 4 0
F N 50 140 5 1
F N 50 140 6 1
F N 50 140 7 1
F N 50 140 8 1
F N 50 160 4 1
F N 50 160 5 1
F N 50 160 6 1
F N 50 160 7 1
F N 50 160 8 1
F N 50 180 4 1
F N 50 180 5 1
F N 50 180 6 1
F N 50 180 7 2
F N 50 180 8 2
F S 50 120 4 1
F S 50 120 5 1
F S 50 120 6 1
F S 50 120 7 1
F S 50 120 8 1
F S 50 140 4 1
F S 50 140 5 1
F S 50 140 6 1
F S 50 140 7 1
F S 50 140 8 2
F S 50 160 4 1
F S 50 160 5 2
F S 50 160 6 2
F S 50 160 7 2
F S 50 160 8 3
F S 50 180 4 2
F S 50 180 5 2
F S 50 180 6 3
F S 50 180 7 3
F S 50 180 8 4
M N 50 120 4 1
M N 50 120 5 1
M N 50 120 6 2
M N 50 120 7 2
M N 50 120 8 2
M N 50 140 4 2
M N 50 140 5 2
M N 50 140 6 2
M N 50 140 7 3
M N 50 140 8 3
M N 50 160 4 2
M N 50 160 5 3
M N 50 160 6 3
M N 50 160 7 4
M N 50 160 8 5
M N 50 180 4 4
M N 50 180 5 4
M N 50 180 6 5
M N 50 180 7 6
M N 50 180 8 7
M S 50 120 4 2
M S 50 120 5 3
M S 50 120 6 3
M S 50 120 7 4
M S 50 120 8 5
M S 50 140 4 3
M S 50 140 5 4
M S 50 140 6 5
M S 50 140 7 6
M S 50 140 8 7
M S 50 160 4 5
M S 50 160 5 6
M S 50 160 6 7
M S 50 160 7 8
M S 50 160 8 10
M S 50 180 4 7
M S 50 180 5 8
M S 50 180 6 10
M S 50 180 7 12
M S 50 180 8 14
F N 40 120 4 0
F N 40 120 5 0
F N 40 120 6 0
F N 40 120 7 0
F N 40 120 8 0
F N 40 140 4 0
F N 40 140 5 0
F N 40 140 6 0
F N 40 140 7 0
F N 40 140 8 0
F N 40 160 4 0
F N 40 160 5 0
F N 40 160 6 0
F N 40 160 7 0
F N 40 160 8 0
F N 40 180 4 0
F N 40 180 5 0
F N 40 180 6 0
F N 40 180 7 0
F N 40 180 8 0
F S 40 120 4 0
F S 40 120 5 0
F S 40 120 6 0
F S 40 120 7 0
F S 40 120 8 0
F S 40 140 4 0
F S 40 140 5 0
F S 40 140 6 0
F S 40 140 7 0
F S 40 140 8 0
F S 40 160 4 0
F S 40 160 5 0
F S 40 160 6 0
F S 40 160 7 0
F S 40 160 8 0
F S 40 180 4 0
F S 40 180 5 0
F S 40 180 6 0
F S 40 180 7 1
F S 40 180 8 1
M N 40 120 4 0
M N 40 120 5 0
M N 40 120 6 1
M N 40 120 7 1
M N 40 120 8 1
M N 40 140 4 0
M N 40 140 5 1
M N 40 140 6 1
M N 40 140 7 1
M N 40 140 8 1
M N 40 160 4 1
M N 40 160 5 1
M N 40 160 6 1
M N 40 160 7 1
M N 40 160 8 1
M N 40 180 4 1
M N 40 180 5 1
M N 40 180 6 1
M N 40 180 7 2
M N 40 180 8 2
M S 40 120 4 1
M S 40 120 5 1
M S 40 120 6 1
M S 40 120 7 1
M S 40 120 8 1
M S 40 140 4 1
M S 40 140 5 1
M S 40 140 6 1
M S 40 140 7 2
M S 40 140 8 2
M S 40 160 4 1
M S 40 160 5 2
M S 40 160 6 2
M S 40 160 7 2
M S 40 160 8 3
M S 40 180 4 2
M S 40 180 5 2
M S 40 180 6 3
M S 40 180 7 3
M S 40 180 8 4
;
run;

data my_data; set my_data;
length myhtml $500;
 myhtml='title='|| quote(
  'Sex (M/F):      '||trim(left(sex))||'0D'x||
  'Smoker (S/N):   '||trim(left(smoker))||'0D'x||
  'Agegroup:       '||trim(left(agegroup))||'0D'x||
  'Blood Pressure: '||trim(left(bloodpressure))||'0D'x||
  'Cholesterol:    '||trim(left(cholesterol))||'0D'x||
  'Risk Score:     '||trim(left(risk))||'% '
  );
run;

data my_data; set my_data;
if risk eq 0 then risk_color=0;  /* green */
if risk eq 1 then risk_color=1;  /* lighter green */
if risk eq 2 then risk_color=2;  /* yellow/orange */
if risk ge 3 and risk le 4 then risk_color=3; /* orange */
if risk ge 5 and risk le 9 then risk_color=4; /* red */
if risk ge 10 and risk le 14 then risk_color=5; /* dark red */
if risk ge 15 then risk_color=6; /* very dark red */
run;

/* Create a sas/graph gmap map dataset, with 4 coordinates for each data obsn */
data my_map; set my_data;
x=cholesterol-4;
if smoker eq 'S' then x=x+6;
if sex eq 'M' then x=x+14;
y=((bloodpressure-120)/20);
if agegroup gt 40 then y=y + ((agegroup-45)/5 * 5);
       output;
x=x+1; output;
y=y+1; output;
x=x-1; output;
run;

/* These are the annotated numbers inside the colored boxes */
proc sql;
create table my_anno as 
select unique grid_id, avg(x) as x, avg(y) as y, risk, risk_color
from my_map 
group by grid_id;
quit; run;
data my_anno; set my_anno;
   length function style color $ 8 position $ 1 text $ 30 html $1024;
   retain xsys ysys '2' hsys '3' when 'a' position '5';
length color $ 12;
if risk_color in (0 5 6) then color='yellow';
else color='black';
function='label';
style='"arial"';
size=&textsize;
text=trim(left(risk));
run;

proc sql;
create table anno_left as
select unique 0 as x, avg(y) as y, bloodpressure, agegroup
from my_map 
group by bloodpressure, agegroup;
quit; run;
data anno_left; set anno_left;
   length function style color $ 8 position $ 1 text $ 30 html $1024;
   retain xsys ysys '2' hsys '3' when 'a' position '4';
color='black';
function='label';
style='"arial"';
size=&textsize;
text=trim(left(bloodpressure));
run;

proc sql;
create table anno_middle as
select unique 13 as x, avg(y) as y, agegroup
from my_map 
group by agegroup;
quit; run;
data anno_middle; set anno_middle;
   length function style color $ 8 position $ 1 text $ 30 html $1024;
   retain xsys ysys '2' hsys '3' when 'a' position '4';
color='cx7e0517';
function='label';
style='"arial"';
size=&textsize;
text=trim(left(agegroup));
run;

data anno_legendtitle;
   length function style color $ 8 position $ 1 text $ 30 html $1024;
   retain xsys ysys '2' hsys '3' when 'a' position '5';
x=29; y=16.6;
color='black';
function='label';
style='"arial"';
size=&textsize;
size=size*1.5;
text='SCORE'; output;
/* Now, put a bit '+' in the middle of the 'O' in the legend title */
size=size;
text='+'; output;
run;

data anno_comment;
   length function style color $ 8 position $ 1 text $ 30 html $1024;
   retain xsys ysys '2' hsys '3' when 'a' position '5';
color='black';
function='label';
style='"arial"';
size=&textsize;
x=29; y=6;
text='10-year risk of'; output;
y=y-.9;
text='fatal CVD in'; output;
y=y-.9;
text='populations at'; output;
y=y-.9;
text='high CVD risk'; output;
run;

data anno_mgdl;
   length function style color $ 8 position $ 1 text $ 30 html $1024;
   retain xsys ysys '2' hsys '3' when 'a' position '5';
color='cx7e0517';
size=.25;
y=-1.25; x=20; function='move'; output;
y=-1.25; x=25; function='draw'; output;
y=-1.25; x=21; function='move'; output;
y=-1.50; x=21; function='draw'; output;
y=-1.25; x=22; function='move'; output;
y=-1.50; x=22; function='draw'; output;
y=-1.25; x=23; function='move'; output;
y=-1.50; x=23; function='draw'; output;
y=-1.25; x=24; function='move'; output;
y=-1.50; x=24; function='draw'; output;
color='black';
function='label';
style='"arial"';
size=1.5;
position='5';
x=21; y=-1.75; text='150'; output;
x=22; y=-1.75; text='200'; output;
x=23; y=-1.75; text='250'; output;
x=24; y=-1.75; text='300'; output;
x=22.5; y=-2.5; text='mg/dl'; output;
run;

data anno_middle2;
   length function style color $ 8 position $ 1 text $ 30 html $1024;
   retain xsys ysys '2' hsys '3' when 'a' position '4';
x=13; y=25;
color='cx7e0517';
function='label';
style='"arial"';
size=&textsize;
text='Age';
run;

proc sql;
create table anno_bottom as
select unique avg(x) as x, 0 as y, sex, smoker, cholesterol
from my_map group by sex, smoker, cholesterol;
quit; run;
data anno_bottom; set anno_bottom;
   length function style color $ 8 position $ 1 text $ 30 html $1024;
   retain xsys ysys '2' hsys '3' when 'a' position 'E';
color='black';
function='label';
style='"arial"';
size=&textsize;
text=trim(left(cholesterol));
run;

data anno_left2;
   length function style color cbox cborder $ 8 position $ 1 text $ 30 html $1024;
   retain xsys ysys '2' hsys '3' when 'a' position '6';
x=-2.5;
y=0;
color='black';
cbox='cornsilk';
cborder='cx7e0517';
/*
*/
function='label';
style='"arial"';
size=&textsize;
text=' Systolic blood pressure ';
angle=90;
run;

proc sql;
create table anno_bottom2 as
select unique avg(x) as x, -2 as y
from my_map;
quit; run;
data anno_bottom2; set anno_bottom2;
   length function style color cbox cborder $ 8 position $ 1 text $ 30 html $1024;
   retain xsys ysys '2' hsys '3' when 'a' position '5';
color='black';
cbox='cornsilk';
cborder='cx7e0517';
function='label';
style='"arial"';
size=&textsize;
text=' Cholesterol mmol ';
run;

proc sql;
create table anno_top as
select unique avg(x) as x, 25 as y, sex, smoker
from my_map group by sex, smoker;
quit; run;
data anno_top; set anno_top;
   length function style color cbox cborder $ 8 position $ 1 text $ 30 html $1024;
   retain xsys ysys '2' hsys '3' when 'a' position '5';
color='black';
cbox='cornsilk';
cborder='cx7e0517';
function='label';
style='"arial"';
size=&textsize;
if smoker eq 'N' then text=' Non-Smoker ';
if smoker eq 'S' then text=' Smoker ';
run;

proc sql;
create table anno_top2 as
select unique avg(x) as x, 26.5 as y, sex
from my_map group by sex;
quit; run;
data anno_top2; set anno_top2;
   length function style color cbox cborder $ 8 position $ 1 text $ 30 html $1024;
   retain xsys ysys '2' hsys '3' when 'a' position '5';
color='black';
cbox='cornsilk';
cborder='cx7e0517';
function='label';
style='"arial"';
size=&textsize;
size=size*1.3;
if sex eq 'M' then text=' Men ';
if sex eq 'F' then text=' Women ';
run;

/* Various annotation that goes around the main chart */
data around_anno; 
 set anno_left anno_left2 anno_middle anno_middle2 anno_bottom anno_bottom2 
     anno_top anno_top2 anno_legendtitle anno_comment anno_mgdl;
run;

/* Add a fake map area to the bottom/left, to guarantee some space */
data fake_space;
grid_id='foo1';
x=-3; y=-3; output;
x=x+.01; output;
y=y+.01; output;
grid_id='foo2';
x=26; y=26.5; output;
x=x+.01; output;
y=y+.01; output;
run;
data my_map; set my_map fake_space;
run;



 GOPTIONS DEVICE=gif;
 goptions xpixels=1000 ypixels=1000;
 
 ODS LISTING CLOSE;
 ODS HTML path=odsout body="&name..htm"
 style=minimal
 gtitle gfootnote
 ;
 
 goptions ftitle="arial" ftext="arial" gunit=pct htitle=3.25 htext=1.75;
 title "Estimation of ten-year risk of fatal cardiovascular";
 title2 h=3.25 "disease in Europe: the SCORE project";
 title3 a=-90 h=2 " ";

pattern1 v=s c=cx4cc417;
pattern2 v=s c=cxbce954;
pattern3 v=s c=cxfdd017;
pattern4 v=s c=cxfa9b17;
pattern5 v=s c=cxf63817;
pattern6 v=s c=cxc22817;
pattern7 v=s c=cx7e0517;

goptions cback=white;

legend1 label=none
 value=(j=l '< 1%' '1%' '2%' '3%-4%' '5%-9%' '10%-14%' '15% and over  ')
 frame cframe=cornsilk cborder=cx7e0517
 position=(right middle) across=1 shape=bar(.2in,.2in);

 proc gmap data=my_data map=my_map anno=around_anno all; 
 id grid_id;
 choro risk_color /
 anno=my_anno
 coutline=gray
 legend=legend1
 html=myhtml
 cempty=white /* for the small 'fake' map areas in the corners */
 des="" name="&name"; 
 run;

 quit;
 ODS HTML CLOSE;
 ODS LISTING;