/* COPYRIGHT 1996, SAS INSTITUTE INC. */

/*
DISCLAIMER:
1. NEGATIVE VALUES CAN NOT BE USED FOR AXIS RANGES.
2. NEGATIVE VALUES CAN NOT BE USED FOR BY INCREMENTS.
3. NUMERIC MIDPOINT VARIABLES ARE TREATED DISCRETELY.
4. LIMIT OF 4 VALUES FOR GROUP VARIABLE.
5. VMAX,VMIN,AND VINCR ARE REQUIRED.
*/


%MACRO VBAR3D(ds,midpoint,response,group,
              vmax,vmin,vincr,height,length,barwidth,
              fill1,fill2,fill3,fill4,
              cfill1,cfill2,cfill3,cfill4,
              caxis,title,ftitle,ctitle,htitle,
              midlabel,reslabel,grplabel,dispgrp,disresbg,
              cmidlab,creslab,cgrplab,ctickval,
              leglabel,fleglab,hleglab,cleglab,
              flegent,displeg,
              csidegr,cbackgr,
              cback,cbacksg,cbackbg,
              linesg,linebg,sizesg,sizebg,
              dispbotg,faxval,haxval,amidval,
              faxlab,haxlab,horigin,vorigin,hspace,
              libref,catalog,entry);

/* This application will create a 3D VERTICAL BAR CHART. */

/* The following parameters are REQUIRED:
dataset,
midpoint variable,
response variable,
group variable,
max axis value for vaxis,
min axis value for vaxis,
by increment value for vaxis.
*/

/* The following parameters are OPTIONAL:
height of graphics area (inches),
length of axis (percent),
fill pattern for first group value,
fill pattern for second group value,
fill pattern for third group value,
fill pattern for fourth group value,
color of fill pattern for first group value,
color of fill pattern for second group value,
color of fill pattern for third group value,
color of fill pattern for fourth group value,
axis color,
title text,
font used by title text,
color of title text,
height of title text,
midpoint axis label,
response axis label,
group axis label,
display the group ais label, Y/N ,
display response values on back grid, Y/N ,
color of midpoint axis label,
color of response axis label,
color of group axis label,
color of tick mark values on all axes,
legend label text,
font used by legend label text,
height of legend label text,
color of legend label text,
font used by label entry text,
display the legend , Y/N ,
color of side grid lines,
color of back grid lines,
background color,
background color for side grid
background color for back grid
linestyle for side grid,
linestyle for backgrid,
thickness of side grid,
thickness of back grid,
disply bottom grid, Y/N ,
font used by axis values,
height for axis values,
angle of midpoint value text,
font used by labels for all axes,
height of label text for all axes,
horizontal origin(pct),
vertical origin(pct),
space bewteen midpoint bars,
library reference,
catalog name,
entry name.
*/

proc sort data=&ds; by &group;
run;

data grp;
set &ds; by &group;
keep &group;
if first.&group;
run;

proc sort data=&ds; by &midpoint;
run;

/* all midpoint values */
data mid;
set &ds; by &midpoint;
drop &group;
if first.&midpoint then &response=0;
else delete;
run;

data all;
set grp;
do i= 1 to numobs;
set mid nobs=numobs point=i;
output;
end;
run;

proc sort data=all; by &midpoint;
run;

data combine;
set &ds all;
run;

proc sort data=combine; by &group &midpoint &response;

data &ds;
set combine;
by &group &midpoint &response;
drop tally;
if first.&midpoint then tally=&response;
else tally+&response;
if last.&midpoint then do;
&response=tally; output;
end;
run;

proc sort; by &group &midpoint;

data hmax;
set &ds; by &group &midpoint;
if first.&group then cmid=0;
else cmid+1;
run;

proc sort;
by cmid;

data hmax;
set hmax; by cmid;
call symput('hby',1);
if first.cmid then
call symput('hmin',0);
if last.cmid then
call symput('hmax',cmid);
run;

proc sort; by &response;

/* ERRCHECK data set: Checking user parameter specifications for invalid values */

data errcheck;
ERRCHK=0;
blank=" ";

if (blank="&ds") then do;
put "ERROR:INVALID VALUE FOR DATA SET.";
put "WARNING:Check the data set name value,it must be specified.";
ERRCHK+1;
end;

if (blank="&midpoint") then do;
put "ERROR:INVALID VALUE FOR MIDPOINT.";
put "WARNING:Check the midpoint value,it must be specified.";
ERRCHK+1;
end;

if (blank="&response") then do;
put "ERROR:INVALID VALUE FOR RESPONSE.";
put "WARNING:Check the response value,it must be specified.";
ERRCHK+1;
end;

if (blank="&group") then do;
put "ERROR:INVALID VALUE FOR GROUP.";
put "WARNING:Check the group value,it must be specified.";
ERRCHK+1;
end;

if (&vmax<=0) then do;
put "ERROR:INVALID VALUE FOR MAXIMUM VERTICAL AXIS RANGE ENCOUNTERD.";
put "WARNING:Check the vertical axis max value,it must be numeric and > 0.";
ERRCHK+1;
end;

if (&vmin<0)then do;
put "ERROR:INVALID VALUE FOR MINIMUM VERTICAL AXIS RANGE ENCOUNTERD.";
put "WARNING:Check the vertical axis min value,it must be numeric and >= 0.";
ERRCHK+1;
end;

if (&vincr<=0) then do;
put "ERROR:INVALID VALUE FOR VERTICAL AXIS BY INCREMENT ENCOUNTERED.";
put "WARNING:Check the vertical axis by increment value,it must be numeric and > 0.";
put "NOTE: The default value of 1 will be used.";
call symput('vincr',1);
end;

if (&vmax <= 0) then compmax=1;else compmax=0;
if (&vmin < 0) then compmin=1;else compmin=0;
if compmax NE compmin then do;
put "ERROR:THE MAXIMUM AND MINIMUM VERTICAL AXIS VALUES ARE OF DIFFERENT DATA TYPES.";
put "WARNING:Check the vertical axis max and min values and make sure both are numeric.";
ERRCHK+1;
end;

if (&vmax <= &vmin) then do;
put "ERROR:THE MAXIMUM VERTICAL AXIS VALUE IS <= THE MINIMUM VERTICAL AXIS VALUE.";
put "WARNING:Check the vertical axis max and min values.";
ERRCHK+1;
end;

if (&hmax <= 0) then do;
put "ERROR:INVALID VALUE FOR MAXIMUM HORIZONTAL AXIS RANGE ENCOUNTERD.";
put "WARNING:Check the horizontal axis max value,it must be numeric and > 0.";
ERRCHK+1;
end;

if (&hmin < 0) then do;
put "ERROR:INVALID VALUE FOR MINIMUM HORIZONTAL AXIS RANGE ENCOUNTERD.";
put "WARNING:Check the horizontal axis min value,it must be numeric and >= 0.";
ERRCHK+1;
end;

if (&hby <= 0) then do;
put "ERROR:INVALID VALUE FOR HORIZONTAL AXIS BY INCREMENT ENCOUNTERED.";
put "WARNING:Check the horizontal axis by increment value,it must be numeric and > 0.";
put "NOTE: The default value of 1 will be used.";
call symput('hby',1);
end;

if (&hmax <= 0) then comphmax=1;else comphmax=0;
if (&hmin < 0) then comphmin=1;else comphmin=0;
if comphmax NE comphmin then do;
put "ERROR:THE MAXIMUM AND MINIMUM HORIZONTAL AXIS VALUES ARE OF DIFFERENT DATA TYPES.";
put "WARNING:Check the horizontal axis max and min values and make sure both are numeric.";
ERRCHK+1;
end;

if &hmax <= &hmin then do;
put "ERROR:THE MAXIMUM HORIZONTAL AXIS VALUE IS <= THE MINIMUM HORIZONTAL AXIS VALUE.";
put "WARNING:Check the horizontal axis max and min values.";
ERRCHK+1;
end;

if blank="&height" then do;
put "WARNING: A height value was not specified, the default value of 5 inches will be used.";
height=5;
call symput('height',5);
end;
if blank NE "&height" then do;
height="&height";
end;

if (0 >= height) and (blank NE "&height") then do;
put "ERROR:INVALID VALUE FOR HEIGHT OF GRAPHICS AREA.";
put "WARNING:Check the height value,it must be numeric and > 0.";
put "NOTE: The default value of 5 inches will be used.";
call symput('height',5);
end;

if blank="&length" then do;
put "WARNING: A length value was not specified, the default value of 65 pct will be used.";
length=65;
call symput('length',65);
end;
if blank NE "&length" then do;
length="&length";
end;

if ((0 >= length  or  100 < length) and blank NE "&length") then do;
put "ERROR:INVALID VALUE FOR LENGTH OF AXIS.";
put "WARNING:Check the length value,it must be numeric, > 0, and <= 100.";
put "NOTE: The default value of 65 pct will be used.";
call symput('length',65);
end;

if blank = "&barwidth" then do;
put "WARNING: A barwidth value was not specified, the default value of 3 will be used.";
barwidth=6;
call symput('barwidth',6);
end;
if blank NE "&barwidth" then do;
barwidth="&barwidth";
end;

if (0>=barwidth and blank NE "&barwidth") then do;
put "ERROR:INVALID VALUE FOR BAR WIDTH.";
put "WARNING:Check the bar width value,it must be numeric and > 0.";
put "NOTE: The default value of 3 will be used.";
call symput('barwidth',6);
end;

if blank = "&fill1" then do;
put "WARNING: A pattern fill for GROUP 1 was not specified, the default fill of solid will be used.";
call symput('fill1','solid');
end;
if (upcase("&fill1") NE 'EMPTY' or upcase("&fill1") NE 'E' or
upcase("&fill1") NE "SOLID" or upcase("&fill1") NE 'S' or
upcase("&fill1") NE 'X1' or
upcase("&fill1") NE 'X2' or
upcase("&fill1") NE 'X3' or
upcase("&fill1") NE 'X4' or
upcase("&fill1") NE 'X5' or
upcase("&fill1") NE 'R1' or
upcase("&fill1") NE 'R2' or
upcase("&fill1") NE 'R3' or
upcase("&fill1") NE 'R4' or
upcase("&fill1") NE 'R5' or
upcase("&fill1") NE 'L1' or
upcase("&fill1") NE 'L2' or
upcase("&fill1") NE 'L3' or
upcase("&fill1") NE 'L4' or
upcase("&fill1") NE 'L5')
and (blank NE fill1) then do;
put "ERROR:INVALID VALUE FOR PATTERN FILL for GROUP 1.";
put "WARNING:Check the pattern fill value,it must be EMPTY,SOLID,X1-X5,R1-R5,or L1-L5.";
put "NOTE: The default value of SOLID will be used.";
call symput('fill1','SOLID');
end;

if blank="&fill2" then do;
put "WARNING: A pattern fill for GROUP 2 was not specified, the default fill of X3 will be used.";
call symput('fill2','X3');
end;

if (upcase("&fill2") NE 'EMPTY' or upcase("&fill2") NE 'E' or
upcase("&fill2") NE 'SOLID' or upcase("&fill2") NE 'S' or
upcase("&fill2") NE 'X1' or
upcase("&fill2") NE 'X2' or
upcase("&fill2") NE 'X3' or
upcase("&fill2") NE 'X4' or
upcase("&fill2") NE 'X5' or
upcase("&fill2") NE 'R1' or
upcase("&fill2") NE 'R2' or
upcase("&fill2") NE 'R3' or
upcase("&fill2") NE 'R4' or
upcase("&fill2") NE 'R5' or
upcase("&fill2") NE 'L1' or
upcase("&fill2") NE 'L2' or
upcase("&fill2") NE 'L3' or
upcase("&fill2") NE 'L4' or
upcase("&fill2") NE 'L5')
and (blank NE fill2) then do;
put "ERROR:INVALID VALUE FOR PATTERN FILL for GROUP 2.";
put "WARNING:Check the pattern fill value,it must be EMPTY,SOLID,X1-X5,R1-R5,or L1-L5.";
put "NOTE: The default value of X3 will be used.";
call symput('fill2','X3');
end;

if blank="&fill3" then do;
put "WARNING: A pattern fill for GROUP 3 was not specified, the default fill of R3 will be used.";
call symput('fill3','R3');
end;

if (upcase("&fill3") NE 'EMPTY' or upcase("&fill3") NE 'E' or
upcase("&fill3") NE 'SOLID' or upcase("&fill3") NE 'S' or
upcase("&fill3") NE 'X1' or
upcase("&fill3") NE 'X2' or
upcase("&fill3") NE 'X3' or
upcase("&fill3") NE 'X4' or
upcase("&fill3") NE 'X5' or
upcase("&fill3") NE 'R1' or
upcase("&fill3") NE 'R2' or
upcase("&fill3") NE 'R3' or
upcase("&fill3") NE 'R4' or
upcase("&fill3") NE 'R5' or
upcase("&fill3") NE 'L1' or
upcase("&fill3") NE 'L2' or
upcase("&fill3") NE 'L3' or
upcase("&fill3") NE 'L4' or
upcase("&fill3") NE 'L5')
and (blank NE fill3) then do;
put "ERROR:INVALID VALUE FOR PATTERN FILL for GROUP 3.";
put "WARNING:Check the pattern fill value,it must be EMPTY,SOLID,X1-X5,R1-R5,or L1-L5.";
put "NOTE: The default value of R3 will be used.";
call symput('fill3','R3');
end;

if blank="&fill4" then do;
put "WARNING: A pattern fill for GROUP 4 was not specified, the default fill of L3 will be used.";
call symput('fill4','L3');
end;

if (upcase("&fill4") NE 'EMPTY' or upcase("&fill4") NE 'E' or
upcase("&fill4") NE 'SOLID' or upcase("&fill4") NE 'S' or
upcase("&fill4") NE 'X1' or
upcase("&fill4") NE 'X2' or
upcase("&fill4") NE 'X3' or
upcase("&fill4") NE 'X4' or
upcase("&fill4") NE 'X5' or
upcase("&fill4") NE 'R1' or
upcase("&fill4") NE 'R2' or
upcase("&fill4") NE 'R3' or
upcase("&fill4") NE 'R4' or
upcase("&fill4") NE 'R5' or
upcase("&fill4") NE 'L1' or
upcase("&fill4") NE 'L2' or
upcase("&fill4") NE 'L3' or
upcase("&fill4") NE 'L4' or
upcase("&fill4") NE 'L5')
and (blank NE fill4) then do;
put "ERROR:INVALID VALUE FOR PATTERN FILL for GROUP 4.";
put "WARNING:Check the pattern fill value,it must be EMPTY,SOLID,X1-X5,R1-R5,or L1-L5.";
put "NOTE: The default value of L3 will be used.";
call symput('fill4','L3');
end;

if blank="&cfill1" then do;
put "WARNING: A pattern color for GROUP 1 was not specified, the default color of blue will be used.";
call symput('cfill1','blue');
end;

if blank="&cfill2" then do;
put "WARNING: A pattern color for GROUP 2 was not specified, the default color of green will be used.";
call symput('cfill2','green');
end;

if blank="&cfill3" then do;
put "WARNING: A pattern color for GROUP 3 was not specified, the default color of red will be used.";
call symput('cfill3','red');
end;

if blank="&cfill4" then do;
put "WARNING: A pattern color for GROUP 4 was not specified, the default color of cyan will be used.";
call symput('cfill4','cyan');
end;

if blank="&caxis" then do;
put "WARNING: A color has not been specified for the axis lines, the default color of black will be used.";
call symput('caxis','black');
end;

if blank="&cback" then do;
put "WARNING: A background color has not been specified, the default color of white will be used.";
call symput('cback','white');
end;

if blank="&ctitle" then
call symput('ctitle','black');

if blank="&title" then do;
put "WARNING: A Title has not been specified for the graph, no title will be generated.";
call symput('title',' ');
call symput('ctitle',"&cback");
end;

if blank="&ftitle" then do;
put "WARNING: A Font has not been specified for the title, the default SWISS font will be used.";
call symput('ftitle','swiss');
end;

if blank="&htitle" then do;
put "WARNING: A height was not specified for the title, the default of 2 cells will be used.";
htitle=2;
call symput('htitle',2);
end;
if blank NE "&htitle" then do;
htitle="&htitle";
end;

if (0 >= htitle) and (blank NE "&htitle") then do;
put "ERROR:INVALID VALUE FOR TITLE HEIGHT.";
put "WARNING:Check the title height value,it must be numeric and > 0.";
put "NOTE: The default value of 2 cells will be used.";
call symput('htitle',2);
end;

if blank="&midlabel" then do;
put "WARNING: A label has not been specified for the midpoint axis, midpoint variable will be used.";
call symput('midlabel',upcase("&midpoint"));
end;

if blank="&reslabel" then do;
put "WARNING: A label has not been specified for the response axis, response variable will be used.";
call symput('reslabel',upcase("&response"));
end;

if blank="&grplabel" then do;
put "WARNING: A label has not been specified for the group axis, group variable will be used.";
call symput('grplabel',upcase("&group"));
end;

if blank="&dispgrp" then do;
put "WARNING: No repsonse given for display of group values, the default value of Y will be used.";
call symput('dispgrp','Y');
end;

if   ("&dispgrp"  NE  "Y"  and  "&dispgrp"  NE  "y")   and
     ("&dispgrp"  NE  "N"  and  "&dispgrp"  NE  "n") and (blank NE "&dispgrp")  then do;
put "ERROR:INVALID RESPONSE FOR REQUEST OF GROUP AXIS VALUES.";
put "WARNING:Check the group axis value response,it must be Y or N.";
put "NOTE: The default value of Y will be used.";
call symput('grpval','Y');
end;

if blank="&disresbg" then do;
put "WARNING: No repsonse given for display of response values on back grid, the default of N will be used.";
call symput('disresbg','N');
end;

if   ("&disresbg"  NE  "Y"  and  "&disresbg"  NE  "y")   and
     ("&disresbg"  NE  "N"  and  "&disresbg"  NE  "n") and (blank NE "&disresbg")   then do;
put "ERROR:INVALID RESPONSE FOR REQUEST OF LABELS ON THE BACK GRID.";
put "WARNING:Check the back grid response,it must be Y or N.";
put "NOTE: The default value of Y will be used.";
call symput('disresbg','Y');
end;

if blank="&cmidlab" then do;
put "WARNING: A color was not specified for the midpoint axis label, the default of BLACK will be used.";
call symput('cmidlab','black');
end;

if blank="&creslab" then do;
put "WARNING: A color was not specified for the response axis label, the default of BLACK will be used.";
call symput('creslab','black');
end;

if blank="&cgrplab" then do;
put "WARNING: A color was not specified for the group axis label, the default of BLACK will be used.";
call symput('cgrplab','black');
end;

if blank="&ctickval" then do;
put "WARNING: A color was not specified for the tickmark values, the default of BLACK will be used.";
call symput('ctickval','black');
end;

if blank="&leglabel" then do;
put "WARNING: A label was not specified for the legend, the default of LEGEND will be used.";
call symput('leglabel','LEGEND');
end;

if blank="&fleglab" then do;
put "WARNING: A font was not specified for the legend label, the default of SWISS will be used.";
call symput('fleglab','swiss');
end;

if blank="&hleglab" then do;
put "WARNING: A height was not specified for the legend label, the default of 1.5 cells will be used.";
hleglab=1.5;
call symput('hleglab',1.5);
end;
if blank NE "&hleglab" then do;
hleglab="&hleglab";
end;

if (0 >= hleglab) and (blank NE "&hleglab") then do;
put "ERROR:INVALID VALUE FOR LEGEND LABEL HEIGHT.";
put "WARNING:Check the legend label height value,it must be numeric and > 0.";
put "NOTE: The default value of 1.5 cells will be used.";
call symput('htitle',1.5);
end;

if blank="&cleglab" then do;
put "WARNING: A color was not specified for the legend label, the default color of BLACK will be used.";
call symput('cleglab','black');
end;

if blank="&flegent" then do;
put "WARNING: A font was not specified for the text entries in the Legend, the default of SWISS will be used.";
call symput('flegent','swiss');
end;

if blank="&displeg" then do;
put "WARNING: No repsonse given for display of Legend, the default of N will be used.";
call symput('displeg','N');
end;

if   ("&displeg"  NE  "Y"  and  "&displeg"  NE  "y")   and
     ("&displeg"  NE  "N"  and  "&displeg"  NE  "n") and (blank NE "&displeg")  then do;
put "ERROR:INVALID RESPONSE FOR REQUEST OF LEGEND.";
put "WARNING:Check the legend response,it must be Y or N.";
put "NOTE: The default value of N will be used.";
call symput('displeg','N');
end;

if blank="&csidegr" then do;
put "WARNING: A color was not specified for the side grid, the default of BLACK will be used.";
call symput('csidegr','black');
end;

if blank="&cbackgr" then do;
put "WARNING: A color was not specified for the back grid, the default of BLACK will be used.";
call symput('cbackgr','black');
end;

if blank="&cback" then do;
put "WARNING: A background color was not specified for the graphics area, the default of WHITE will be used.";
call symput('cback','white');
end;

if blank="&cbacksg" then do;
put "WARNING: A background color was not specified for the side grid, the default of WHITE will be used.";
call symput('cbacksg','white');
end;

if blank="&cbackbg" then do;
put "WARNING: A background color was not specified for the back grid, the default of WHITE will be used.";
call symput('cbackbg','white');
end;

if blank="&linesg" then do;
put "WARNING: A linestyle was not specified for the side grid, the default of 1 will be used.";
linesg=1;
call symput('linesg',1);
end;
if blank NE "&linesg" then do;
linesg="&linesg";
end;

if (((1 > linesg) or (linesg > 46)) and blank NE "&linesg")  then do;
put "ERROR:INVALID VALUE FOR SIDE GRID LINESTYLE.";
put "WARNING:Check the linstyle side grid value,it can be 1-46.";
put "NOTE: The default value of 1 will be used.";
call symput('linesg',1);
end;

if blank="&linebg" then do;
put "WARNING: A linestyle was not specified for the back grid, the default of 1 will be used.";
linebg=1;
call symput('linebg',1);
end;
if blank NE "&linebg" then do;
linebg="&linebg";
end;

if (((1 > linebg) or (linebg > 46)) and blank NE "&linebg")  then do;
put "ERROR:INVALID VALUE FOR BACK GRID LINESTYLE.";
put "WARNING:Check the linestyle back grid value,it can be 1-46.";
put "NOTE: The default value of 1 will be used.";
call symput('linebg',1);
end;

if blank="&sizesg" then do;
put "WARNING: A line thickness was not specified for the side grid, the default of 2 will be used.";
sizesg=2;
call symput('sizesg',2);
end;
if blank NE "&sizesg" then do;
sizesg="&sizesg";
end;

if (sizesg<=0) and (blank NE "&sizesg") then do;
put "ERROR:INVALID VALUE FOR LINE THICKNESS FOR THE SIDE GRID.";
put "WARNING:Check the line thickness value for the side grid,it must be numeric and >0.";
put "NOTE: The default value of 2 will be used.";
call symput('sizesg',2);
end;

if blank="&sizebg" then do;
put "WARNING: A line thickness was not specified for the back grid, the default of 2 will be used.";
sizebg=2;
call symput('sizebg',2);
end;
if blank NE "&sizebg" then do;
sizebg="&sizebg";
end;

if (sizebg<=0) and (blank NE "&sizebg") then do;
put "ERROR:INVALID VALUE FOR LINE THICKNESS FOR THE BACK GRID.";
put "WARNING:Check the line thickness value for the back grid,it must be numeric and >0.";
put "NOTE: The default value of 2 will be used.";
call symput('sizebg',2);
end;

if blank="&dispbotg" then do;
put "WARNING: No repsonse given for display of the bottom grid, the default of N will be used.";
call symput('dispbotg','N');
end;

if   ("&dispbotg"  NE  "Y"  and  "&dispbotg"  NE  "y")   and
     ("&dispbotg"  NE  "N"  and  "&dispbotg"  NE  "n") and (blank NE "&dispbotg")  then do;
put "ERROR:INVALID RESPONSE FOR REQUEST OF BOTTOM GRID.";
put "WARNING:Check the bottom grid response,it must be Y or N.";
put "NOTE: The default value of N will be used.";
call symput('dispbotg','N');
end;

if blank="&faxval" then do;
put "WARNING: A font was not specified for the axis values, the default of SWISS will be used.";
call symput('faxval','swiss');
end;

if blank="&haxval" then do;
put "WARNING: A height was not specified for the axis values, the default of 1 will be used.";
haxval=1;
call symput('haxval',1);
end;
if blank NE "&haxval" then do;
haxval="&haxval";
end;

if (haxval<=0) and (blank NE "&haxval") then do;
put "ERROR:INVALID VALUE FOR AXIS VALUE TEXT HEIGHT.";
put "WARNING:Check the axis value text height value,it must be numeric and >0.";
put "NOTE: The default value of 1 will be used.";
call symput('haxval',1);
end;

if blank="&amidval" then do;
put "WARNING: An angle was not specified for the axis values on the midpoint axis,the default of -45 will be used.";
amidval=-45;
call symput('amidval',-45);
end;
if blank NE "&amidval" then do;
amidval="&amidval";
end;

if (-360 >= amidval) and (blank NE "&amidval") then do;
put "ERROR:INVALID VALUE FOR ANGLE OF MIDPOINT AXIS VALUE TEXT.";
put "WARNING:Check the angle of midpoint axis value text,it must be numeric and > -360.";
put "NOTE: The default value of -45 will be used.";
call symput('amidval',-45);
end;

if blank="&faxlab" then do;
put "WARNING: A font was not specified for the axis labels, the default of SWISS will be used.";
call symput('faxlab','swiss');
end;

if blank="&haxlab" then do;
put "WARNING: A height was not specified for the axis labels, the default of 1 will be used.";
haxlab=1;
call symput('haxlab',1);
end;
if blank NE "&haxlab" then do;
haxlab="&haxlab";
end;

if (haxlab<=0) and (blank NE "&haxlab") then do;
put "ERROR:INVALID VALUE FOR AXIS LABEL TEXT HEIGHT.";
put "WARNING:Check the axis label text height value,it must be numeric and >0.";
put "NOTE: The default value of 1 will be used.";
call symput('haxlab',1);
end;

if blank="&horigin" then do;
put "WARNING: A horizontal offset was not specified, the default of 23 will be used.";
horigin=23;
call symput('horigin',23);
end;
if blank NE "&horigin" then do;
horigin="&horigin";
end;

if (horigin<=0) and (blank NE "&horigin") then do;
put "ERROR:INVALID VALUE FOR HORIONTAL OFFSET.";
put "WARNING:Check the horizontal offset value,it must be numeric and >0.";
put "NOTE: The default value of 23 will be used.";
call symput('horigin',23);
end;

if blank="&vorigin" then do;
put "WARNING: A vertical offset was not specified, the default of 20 will be used.";
vorigin=20;
call symput('vorigin',20);
end;
if blank NE "&vorigin" then do;
vorigin="&vorigin";
end;

if (vorigin<=0) and (blank NE "&vorigin") then do;
put "ERROR:INVALID VALUE FOR VERTICAL OFFSET.";
put "WARNING:Check the vertical offset value,it must be numeric and >0.";
put "NOTE: The default value of 20 will be used.";
call symput('vorigin',20);
end;

if blank="&hspace" then do;
put "WARNING: A value to control the space between bars was not specified, the default of 1.5 will be used.";
hspace=1.5;
call symput('hspace',1.5);
end;
if blank NE "&hspace" then do;
hspace="&hspace";
end;

if (hspace<=0) and (blank NE "&hspace") then do;
put "ERROR:INVALID VALUE FOR SPACE BETWEEN BARS.";
put "WARNING:Check the space between bars value,it must be numeric and >0.";
put "NOTE: The default value of 1.5 will be used.";
call symput('hspace',1.5);
end;

if blank="&libref" then do;
put "WARNING: A libref was not specified, the default of WORK will be used.";
call symput('libref','WORK');
end;

if blank="&catalog" then do;
put "WARNING: A catalog was not specified, the default of GSEG will be used.";
call symput('catalog','GSEG');
end;

if blank="&entry" then do;
put "WARNING: An entry name was not specified, the default of VBAR3D will be used.";
call symput('entry','VBAR3D');
end;

call symput('ERRCHK',ERRCHK);
run;

/* setting the limits for the axis */
data limits;
%let angle=45;
fend=(&vmax+(&vmax/2));
pfend=(&vmax+(&vmax/2)+&vincr);
call symput('end',fend);
if mod(fend,&vincr)=0 then do;
call symput('fend',fend);
end;
if mod(fend,&vincr)^=0 then do;
call symput('fend',pfend);
end;
hend=(&hmax+round((&hmax/2),1));
phend=(&hmax+(&hmax/2)+&hby);
call symput('phend',phend);
call symput('enda',hend);
if mod(hend,&hby)=0 then do;
call symput('hend',hend);
end;
if mod(hend,&hby)^=0 then do;
call symput('hend',phend);
end;
bby=(&vincr/2);
call symput('bby',bby);
OT=(((&vmax-&vmin)/&vincr) + 2);
call symput('OT',ot);
AT=(((&vmax/2)/&vincr) + OT);
call symput('AT',round(at,1));
HOT=(((&hmax-&hmin)/&hby) + 2);
call symput('HOT',hot);
HAT=(((&hmax/2)/&hby) + HOT);
call symput('HAT',round(hat,1));
sz=&height + (&height/3);
call symput('size',sz);
store=("&libref"||'.'||"&catalog");
call symput('store',store);
run;


/* creating macro variables to be used in axis statement
   to remove unneeded tick marks. vaxis*/
data axis;
do c=&OT to &AT;
call symput('z'||left(c),"'"||' '||"'");
call symput('t'||left(c),'t='||left(c));
end;

/* creating macro variables to be used in axis statement
   to remove unneeded tick marks. haxis*/
data axis;
do d=&HOT to &HAT;
call symput('z'||left(d),"'"||' '||"'");
call symput('t'||left(d),'t='||left(d));
end;

data one;
set hmax; by &response;
if cmid=. then catch=0;
if &response=. then catch=0;
pi=arcos(-1);
rads=(&angle*pi)/180;
cosine=cos(rads);
sin=sin(rads);
tan=tan(rads);
call symput('tan',tan);
xpos=((&end-&vmax)/tan);
call symput('xpos',xpos);
ppos=((xpos/&end)*100);
call symput('ppos',ppos);
pmax=((&hmax/&hend)*100);
call symput('pmax',pmax);
c=(&vmax/2)/cosine;
a=sqrt(((c*c)-((&vmax/2)* (&vmax/2))));
catch=&response;
calc=catch/tan;
if catch=0 then pt+1;
if _n_=pt+1 then
call symput('hstpos',calc);

data anno;
set one;
if &ERRCHK>0 then do;
stop;
end;
retain hsys '4';
length function color style $8 text $50;
if &angle >= 45 then do;

do i= &vmin to &vmax by &vincr;

/*left side bottom solid line*/
function='move'; xsys='1'; ysys='1'; x=0;y=0;color="&caxis";output;
function='draw'; xsys='1'; ysys='2';
x=ppos;
y=(tan*xpos);
output;

/*side grid*/

/* side grid background color */
function='poly'; xsys='3'; ysys='3';x=&horigin;y=&vorigin;color="&cbacksg";style='solid';output;
function='polycont'; xsys='1';ysys='2'; x=0; y=&vmax;output;
function='polycont'; xsys='1';ysys='2'; x=ppos; y=&fend;output;
function='polycont'; xsys='1';ysys='2'; x=ppos; y=(tan*xpos);output;
function='polycont'; xsys='3'; ysys='3';x=&horigin;y=&vorigin;output;

/* side grid grid lines */
function='move'; xsys='1'; ysys='2'; x=0;y=i; color="&csidegr";
if i=&vmax then line=1; else line=&linesg;size=&sizesg;output;
function='draw'; xsys='1'; ysys='2';
x=ppos;
y=(tan*xpos)+i;
output;

/*left back solid line*/
function='move'; xsys='1'; ysys='2'; x=ppos;
y=(tan*xpos);
color="&caxis";output;
function='draw'; xsys='1'; ysys='2';
x=ppos;
y=&end;
line=1;output;
end;

/* RESPONSE axis label. */
function='move'; xsys='1'; ysys='2';
y=&vmax; x=0;output;
function='cntl2txt';output;
function='label'; xsys='9'; ysys='2';hsys='4';angle=-90;rotate=90;
text="&reslabel"; y=&vmax/2; x=-7; color="&creslab";
style="&faxlab";size=&haxlab;output;

/* MIDPOINT axis label. */
function='label'; xsys='1'; ysys='3';hsys='4';angle=0;rotate=0;
text="&midlabel"; x=pmax/2; y=%eval(&vorigin-13);color="&cmidlab";
style="&faxlab";size=&haxlab;output;


/* title */
function='move'; xsys='1'; ysys='2';
x=&ppos; y=&end;output;
function='cntl2txt';output;
function='label'; xsys='9'; ysys='9';hsys='4';angle=0;rotate=0;
text="&title";x=0;y=10;color="&ctitle";position='6';
style="&ftitle";size=&htitle;output;

/* vertical axis */
function='move'; xsys='1'; ysys='1'; x=0;y=0;color="&caxis";output;
function='draw'; xsys='1'; ysys='2'; x=0; y=&vmax;
size=&sizesg;output;

end;

proc sort data=&ds;
by &group;
run;

data _null_;
set &ds; by &group;
call symput('spot',left(trim("&leglabel")));
if first.&group then grpnum+1;
if grpnum=1 then
call symput('spot1',left(trim(&group)));
if grpnum=2 then
call symput('spot2',left(trim(&group)));
if grpnum=3 then
call symput('spot3',left(trim(&group)));
run;

data anno1;
length function color style text $ 16;
set &ds; by &group;
retain when 'a';
if &ERRCHK>0 then do;
stop;
end;
if first.&group then grpnum+1;

if grpnum=1 then do;

/* haxis */
hstpos=&hstpos;
harea=&length-hstpos;
barwidth=&barwidth/2;
htottick=(((&hmax-&hmin)/&hby)+1);
hspace=&hspace+&barwidth+barwidth;

pi=arcos(-1);
rads=(&angle*pi)/180;
tan=tan(rads);
ypos=(barwidth)*tan;

/*vaxis*/
vstpos=13+0;
varea=&length-vstpos;
vtottick=((&vmax-&vmin)/&vincr);
eachtick=varea/vtottick;
respct=((&response/&fend)*100);
if first.&group then tot=0;
else tot+hspace;

/* MIDPOINT axis values */
function='label'; text=put(&midpoint,8.); xsys='1'; ysys='1';hsys='4';
x=hstpos+tot+(barwidth/2); y=0; position='9'; color="&ctickval"; angle=&amidval;
style="&faxval";size=&haxval;output;

/* GROUP axis label */
if "&dispgrp"='Y' or "&dispgrp"='y' then do;
function='move'; xsys='1'; ysys='1';
x=&ppos+(5*hspace)+(2.5*barwidth)+hstpos;
y=(&ppos/4)*1.5;output;
function='cntl2txt';output;
function='label'; text="&grplabel"; xsys='9'; ysys='1';hsys='4';
x=8;y=(&ppos/4);position='4';color="&cgrplab"; angle=0;
style="&faxlab";size=&haxlab;output;
end;

/* bottom grid */
if "&dispbotg"='Y' or "&dispbotg"='y' then do;
function='move'; xsys='1'; ysys='1';when='b';line=&linesg;
size=&sizesg; color="&cbackgr"; x=hstpos+tot-barwidth; y=0;output;

function='draw'; xsys='1'; ysys='2';
x=&ppos+tot-barwidth+hstpos;
y=(&xpos*&tan);output;
end;

if last.&group then do;

/* GROUP axis value text */
if "&dispgrp"='Y' or "&dispgrp"='y' then do;
function='move'; xsys='1';ysys='1';
x=hstpos+tot+(2.5*barwidth); y=0;output;
function='cntl2txt';output;
function='label'; text=left(trim(put(&group,16.)));xsys='9'; ysys='1';hsys='4';
x=2;y=0;position='6';color="&ctickval";angle=0;
style="&faxval";size=&haxval;output;
end;

/*right side solid line*/
function='move'; xsys='1'; ysys='1'; hsys='4';
x=hstpos+tot+(2.5*barwidth);
y=0; size=&sizesg;
color="&caxis";output;
function='draw'; xsys='1'; ysys='2';
x=&ppos+(5*hspace)+(2.5*barwidth)+hstpos;
y=(&tan*&xpos);
line=1;output;

/* horizontal axis*/
function='move'; xsys='1'; ysys='1'; x=0;y=0;line=1;
color="&caxis";size=&sizesg;output;
function='draw'; xsys='1'; ysys='1';
x=hstpos+tot+(2.5*barwidth);
y=0;output;

/*right back solid line*/
function='move'; xsys='1'; ysys='2'; hsys='4';
x=&ppos+(5*hspace)+(2.5*barwidth)+hstpos;
when='b';
y=(&tan*&xpos);size=&sizesg;
color="&caxis";output;
function='draw'; xsys='1'; ysys='2';
x=&ppos+(5*hspace)+(2.5*barwidth)+hstpos;
y=&end;
line=1;output;

/*back solid line*/
function='move'; xsys='1'; ysys='2'; x=&ppos;
y=(&tan*&xpos);
color="&caxis";output;
function='draw'; xsys='1'; ysys='2';
x=&ppos+(5*hspace)+(2.5*barwidth)+hstpos;
y=(&tan*&xpos);
output;

/*back grid*/

/* background color for back grid */
function='move'; xsys='1'; ysys='2'; style='solid'; color="&cbackbg";
x=&ppos;y=&fend; output;
function='bar'; xsys='1'; ysys='2';
x=&ppos+(5*hspace)+(2.5*barwidth)+hstpos;
y=(&tan*&xpos);output;

do i=&vmin to &vmax by &vincr;

/* back grid grid lines */
function='move'; xsys='1'; ysys='2'; x=&ppos; color="&cbackgr";
y=(&tan*&xpos)+i;
if i=&vmax then line=1; else line=&linebg; size=&sizebg;output;
function='draw'; xsys='1'; ysys='2'; color="&cbackgr";
x=&ppos+(5*hspace)+(2.5*barwidth)+hstpos;
y=(&tan*&xpos)+i;
if i=&vmax then line=1; else line=&linebg; size=&sizebg;output;

/*back grid axis value labels*/
if "&disresbg"='Y' or "&disresbg"='y' then do;
function='move';position='5';xsys='1';ysys='2';
x=&ppos+(5*hspace)+(2.5*barwidth)+hstpos;
y=(&tan*&xpos)+i;
output;
function='cntl2txt'; output;
function='label';text=left(trim(put(i,4.)));xsys='9'; position='A';
x=4;
style="&faxval";size=&haxval;color="&ctickval";output;
end;
end;
end;

/*front bar fill background*/
if (&midpoint NE ' ' or &midpoint NE .) then do;
if &response>0 then do;
function='move';xsys='1';ysys='1';when='a';
x=hstpos+tot;y=0;color="white";
output;

function='bar';xsys='1';ysys='1';
style="solid"; line=0;
x=(hstpos+(barwidth*2)+tot);y=respct;
output;

/*front bar fill */
function='move';xsys='1';ysys='1';when='a';
x=hstpos+tot;y=0;color="&cfill1";
output;

function='bar';xsys='1';ysys='1';
style="&fill1"; line=0;
x=(hstpos+(barwidth*2)+tot);y=respct;
output;

/* top bar */
function='poly'; xsys='1'; ysys='1';
x=hstpos+tot; y=respct;size=1;
style="solid";color="&cfill1"; line=1;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+barwidth+tot; y=respct+ypos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*3)+tot; y=respct+ypos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*2)+tot; y=respct;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+tot;y=respct;
output;

/*side bar background*/
function='poly'; xsys='1'; ysys='1';
x=hstpos+(barwidth*2)+tot; y=respct;
style="solid"; color='white';
output;

function='polycont';xsys='1';ysys='1';
x=(hstpos+(barwidth*2)+tot);y=0;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*3)+tot; y=ypos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*3)+tot; y=respct+ypos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*2)+tot; y=respct;
output;

/*side bar*/
function='poly'; xsys='1'; ysys='1';
x=hstpos+(barwidth*2)+tot; y=respct;
style="&fill1"; color="&cfill1";
output;

function='polycont';xsys='1';ysys='1';
x=(hstpos+(barwidth*2)+tot);y=0;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*3)+tot; y=ypos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*3)+tot; y=respct+ypos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*2)+tot; y=respct;
output;
/*top bar side outline */
function='poly'; xsys='1'; ysys='1';color='black';style='solid';
x=hstpos+(barwidth*3)+tot; y=respct+ypos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*2)+tot; y=respct;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*2)+tot-.1; y=respct;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*3)+tot-.1; y=respct+ypos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*3)+tot; y=respct+ypos;
output;

/*front bar fill outline*/
function='move';xsys='1';ysys='1';
x=hstpos+tot;y=0;color='black';
output;

function='bar';xsys='1';ysys='1';
style='empty'; line=0;
x=hstpos+(barwidth*2)+tot;y=respct;
output;

end;
end;
end;

if grpnum=2 then do;

/* haxis */
hstpos=&hstpos+(&ppos/4);
ystpos=&ppos/4;
harea=&length-hstpos;
barwidth=&barwidth/2;
htottick=(((&hmax-&hmin)/&hby)+1);
hspace=&hspace+&barwidth+barwidth;

pi=arcos(-1);
rads=(&angle*pi)/180;
tan=tan(rads);
ypos=(barwidth)*tan;

/*vaxis*/
vstpos=13+0;
varea=&length-vstpos;
vtottick=((&vmax-&vmin)/&vincr);
eachtick=varea/vtottick;
respct=((&response/&fend)*100)+ystpos;
if first.&group then tot=0;
else tot+hspace;


if last.&group then do;

/* GROUP axis value text */
if "&dispgrp"='Y' or "&dispgrp"='y' then do;
function='move'; xsys='1';ysys='1';
x=hstpos+tot+(2.5*barwidth); y=ystpos;output;
function='cntl2txt';output;
function='label'; text=left(trim(put(&group,16.)));xsys='9'; ysys='1';hsys='4';
x=2;y=ystpos;position='6';color="&ctickval";angle=0;
style="&faxval";size=&haxval;output;
end;
end;

/*front bar fill background*/
if (&midpoint NE ' ' or &midpoint NE .) then do;
if &response>0 then do;
function='move';xsys='1';ysys='1'; when='a';
x=hstpos+tot;y=ystpos;color="white";
output;

function='bar';xsys='1';ysys='1';
style="solid"; line=0;
x=(hstpos+(barwidth*2)+tot);y=respct;
output;

/*front bar fill */
function='move';xsys='1';ysys='1'; when='a';
x=hstpos+tot;y=ystpos;color="&cfill2";
output;

function='bar';xsys='1';ysys='1';
style="&fill2"; line=0;
x=(hstpos+(barwidth*2)+tot);y=respct;
output;

/* top bar */
function='poly'; xsys='1'; ysys='1';
x=hstpos+tot; y=respct;
style="solid";color="&cfill2"; line=1;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+barwidth+tot; y=respct+ypos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*3)+tot; y=respct+ypos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*2)+tot; y=respct;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+tot;y=respct;
output;

/*side bar background*/
function='poly'; xsys='1'; ysys='1';
x=hstpos+(barwidth*2)+tot; y=respct;color="white";
style="solid";
output;

function='polycont';xsys='1';ysys='1';
x=(hstpos+(barwidth*2)+tot);y=ystpos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*3)+tot; y=ypos+ystpos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*3)+tot; y=respct+ypos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*2)+tot; y=respct;
output;

/*side bar*/
function='poly'; xsys='1'; ysys='1';
x=hstpos+(barwidth*2)+tot; y=respct;color="&cfill2";
style="&fill2";
output;

function='polycont';xsys='1';ysys='1';
x=(hstpos+(barwidth*2)+tot);y=ystpos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*3)+tot; y=ypos+ystpos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*3)+tot; y=respct+ypos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*2)+tot; y=respct;
output;

/*top bar side outline */
function='poly'; xsys='1'; ysys='1';color='black';style='solid';
x=hstpos+(barwidth*3)+tot; y=respct+ypos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*2)+tot; y=respct;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*2)+tot-.1; y=respct;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*3)+tot-.1; y=respct+ypos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*3)+tot; y=respct+ypos;
output;

/*front bar fill outline*/
function='move';xsys='1';ysys='1';
x=hstpos+tot;y=ystpos;color='black';
output;

function='bar';xsys='1';ysys='1';
style='empty'; line=0;
x=hstpos+(barwidth*2)+tot;y=respct;
output;

end;
end;
end;

if grpnum=3 then do;

/* haxis */
hstpos=&hstpos+((&ppos/4)*2);
ystpos=(&ppos/4)*2;
harea=&length-hstpos;
barwidth=&barwidth/2;
htottick=(((&hmax-&hmin)/&hby)+1);
hspace=&hspace+&barwidth+barwidth;

pi=arcos(-1);
rads=(&angle*pi)/180;
tan=tan(rads);
ypos=(barwidth)*tan;

/*vaxis*/
vstpos=13+0;
varea=&length-vstpos;
vtottick=((&vmax-&vmin)/&vincr);
eachtick=varea/vtottick;
respct=((&response/&fend)*100)+ystpos;
if first.&group then tot=0;
else tot+hspace;

if last.&group then do;

/* GROUP axis value text */
if "&dispgrp"='Y' or "&dispgrp"='y' then do;
function='move'; xsys='1';ysys='1';
x=hstpos+tot+(2.5*barwidth); y=ystpos;output;
function='cntl2txt';output;
function='label'; text=left(trim(put(&group,16.)));xsys='9'; ysys='1';hsys='4';
x=2;y=ystpos;position='6';color="&ctickval";angle=0;
style="&faxval";size=&haxval;output;
end;
end;

if (&midpoint NE ' ' or &midpoint NE .) then do;
if &response >0 then do;

/*front bar fill background*/
function='move';xsys='1';ysys='1'; when='a';
x=hstpos+tot;y=ystpos;color="white";
output;

function='bar';xsys='1';ysys='1';
style="solid"; line=0;
x=(hstpos+(barwidth*2)+tot);y=respct;
output;

/*front bar fill */
function='move';xsys='1';ysys='1'; when='a';
x=hstpos+tot;y=ystpos;color="&cfill3";
output;

function='bar';xsys='1';ysys='1';
style="&fill3"; line=0;
x=(hstpos+(barwidth*2)+tot);y=respct;
output;

/* top bar */
function='poly'; xsys='1'; ysys='1';
x=hstpos+tot; y=respct;
style="solid";color="&cfill3"; line=1;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+barwidth+tot; y=respct+ypos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*3)+tot; y=respct+ypos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*2)+tot; y=respct;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+tot;y=respct;
output;

/*side bar background*/
function='poly'; xsys='1'; ysys='1';
x=hstpos+(barwidth*2)+tot; y=respct;color="white";
style="solid"; /*line=0;*/
output;

function='polycont';xsys='1';ysys='1';
x=(hstpos+(barwidth*2)+tot);y=ystpos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*3)+tot; y=ypos+ystpos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*3)+tot; y=respct+ypos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*2)+tot; y=respct;
output;

/*side bar*/
function='poly'; xsys='1'; ysys='1';
x=hstpos+(barwidth*2)+tot; y=respct;color="&cfill3";
style="&fill3"; /*line=0;*/
output;

function='polycont';xsys='1';ysys='1';
x=(hstpos+(barwidth*2)+tot);y=ystpos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*3)+tot; y=ypos+ystpos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*3)+tot; y=respct+ypos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*2)+tot; y=respct;
output;
/*top bar side outline */
function='poly'; xsys='1'; ysys='1';color='black';style='solid';
x=hstpos+(barwidth*3)+tot; y=respct+ypos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*2)+tot; y=respct;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*2)+tot-.1; y=respct;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*3)+tot-.1; y=respct+ypos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*3)+tot; y=respct+ypos;
output;

/*front bar fill outline*/
function='move';xsys='1';ysys='1';
x=hstpos+tot;y=ystpos;color='black';
output;

function='bar';xsys='1';ysys='1';
style='empty'; line=0;
x=hstpos+(barwidth*2)+tot;y=respct;
output;

end;
end;
end;

if grpnum=4 then do;

/* haxis */
hstpos=&hstpos+((&ppos/4)*3);
ystpos=(&ppos/4)*3;
harea=&length-hstpos;
barwidth=&barwidth/2;
htottick=(((&hmax-&hmin)/&hby)+1);
hspace=&hspace+&barwidth+barwidth;

pi=arcos(-1);
rads=(&angle*pi)/180;
tan=tan(rads);
ypos=(barwidth)*tan;

/*vaxis*/
vstpos=13+0;
varea=&length-vstpos;
vtottick=((&vmax-&vmin)/&vincr);
eachtick=varea/vtottick;
respct=((&response/&fend)*100)+ystpos;
if first.&group then tot=0;
else tot+hspace;

if last.&group then do;

/* GROUP axis value text */
if "&dispgrp"='Y' or "&dispgrp"='y' then do;
function='move'; xsys='1';ysys='1';
x=hstpos+tot+(2.5*barwidth); y=ystpos;output;
function='cntl2txt';output;
function='label'; text=left(trim(put(&group,16.)));xsys='9'; ysys='1';hsys='4';
x=2;y=ystpos;position='6';color="&ctickval";angle=0;
style="&faxval";size=&haxval;output;
end;
end;

if (&midpoint NE ' ' or &midpoint NE .) then do;
if &response>0 then do;

/*front bar fill background*/
function='move';xsys='1';ysys='1'; when='a';
x=hstpos+tot;y=ystpos;color="white";
output;

function='bar';xsys='1';ysys='1';
style="solid"; line=0;
x=(hstpos+(barwidth*2)+tot);y=respct;
output;

/*front bar fill */
function='move';xsys='1';ysys='1'; when='a';
x=hstpos+tot;y=ystpos;color="&cfill4";
output;

function='bar';xsys='1';ysys='1';
style="&fill4"; line=0;
x=(hstpos+(barwidth*2)+tot);y=respct;
output;

/* top bar */
function='poly'; xsys='1'; ysys='1';
x=hstpos+tot; y=respct;
style="solid";color="&cfill4"; line=1;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+barwidth+tot; y=respct+ypos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*3)+tot; y=respct+ypos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*2)+tot; y=respct;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+tot;y=respct;
output;

/*side bar background*/
function='poly'; xsys='1'; ysys='1';
x=hstpos+(barwidth*2)+tot; y=respct;color="white";
style="solid";
output;

function='polycont';xsys='1';ysys='1';
x=(hstpos+(barwidth*2)+tot);y=ystpos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*3)+tot; y=ypos+ystpos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*3)+tot; y=respct+ypos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*2)+tot; y=respct;
output;

/*side bar*/
function='poly'; xsys='1'; ysys='1';
x=hstpos+(barwidth*2)+tot; y=respct;color="&cfill4";
style="&fill4"; /*line=0;*/
output;

function='polycont';xsys='1';ysys='1';
x=(hstpos+(barwidth*2)+tot);y=ystpos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*3)+tot; y=ypos+ystpos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*3)+tot; y=respct+ypos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*2)+tot; y=respct;
output;

/*top bar side outline */
function='poly'; xsys='1'; ysys='1';color='black';style='solid';
x=hstpos+(barwidth*3)+tot; y=respct+ypos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*2)+tot; y=respct;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*2)+tot-.1; y=respct;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*3)+tot-.1; y=respct+ypos;
output;

function='polycont'; xsys='1'; ysys='1';
x=hstpos+(barwidth*3)+tot; y=respct+ypos;
output;

/*front bar fill outline*/
function='move';xsys='1';ysys='1';
x=hstpos+tot;y=ystpos;color='black';
output;

function='bar';xsys='1';ysys='1';
style='empty'; line=0;
x=hstpos+(barwidth*2)+tot;y=respct;
output;

end;
end;
end;

/*LEGEND*/

if "&displeg"='Y' or "&displeg"='y' then do;

function='label'; xsys='4';ysys='3';x=10;y=4;position='5'; angle=0;
text=left(trim("&leglabel"));color="&cleglab";style="&fleglab";size=&hleglab;output;

if first.&group then do;

spot=length("&spot");
spot1=length("&spot1");
spot2=length("&spot2");
spot3=length("&spot3");

if grpnum=1 then do;
function='move';xsys='4';ysys='3';x=10+spot+2;y=2;output;
function='bar';xsys='A';ysys='3';x=+3;y=4;style="&fill1";
line=0;color="&cfill1";output;
function='move';xsys='A';ysys='3';x=-3;y=2;output;
function='bar';xsys='A';ysys='3';x=+3;y=4;style="empty";
line=0;color="black";output;

function='label';xsys='4';ysys='3';text=left(trim(&group)); x=10+spot+2+3+2;y=3.5;
style="&flegent"; color="&cfill1";position='6';angle=0;size=&haxval;output;

end;

if grpnum=2 then do;
function='move';xsys='4';ysys='3';x=10+spot+2+3+2+spot1+2;y=2;output;
function='bar';xsys='A';ysys='3';x=+3;y=4;style="&fill2";
line=0;color="&cfill2";output;
function='move';xsys='A';ysys='3';x=-3;y=2;output;
function='bar';xsys='A';ysys='3';x=+3;y=4;style="empty";
line=0;color="black";output;

function='label';xsys='4';ysys='3';text=left(trim(&group));
x=10+spot+2+3+2+spot1+2+3+2;y=3.5;
style="&flegent"; color="&cfill2";position='6';size=&haxval;output;

end;

if grpnum=3 then do;
function='move';xsys='4';ysys='3';
x=10+spot+2+3+2+spot1+2+3+2+spot2+2; y=2;output;
function='bar';xsys='A';ysys='3';x=+3;y=4;style="&fill3";
line=0;color="&cfill3";output;
function='move';xsys='A';ysys='3';x=-3;y=2;output;
function='bar';xsys='A';ysys='3';x=+3;y=4;style="empty";
line=0;color="black";output;

function='label';xsys='4';ysys='3';text=left(trim(&group));
x=10+spot+2+3+2+spot1+2+3+2+spot2+2+3+2;y=3.5;
style="&flegent"; color="&cfill3";position='6';size=&haxval;output;

end;

if grpnum=4 then do;
function='move';xsys='4';ysys='3';
x=10+spot+2+3+2+spot1+2+3+2+spot2+2+3+2+spot3+2; y=2;output;
function='bar';xsys='A';ysys='3';x=+3;y=4;style="&fill4";
line=0;color="&cfill4";output;
function='move';xsys='A';ysys='3';x=-3;y=2;output;
function='bar';xsys='A';ysys='3';x=+3;y=4;style="empty";
line=0;color="black";output;

function='label';xsys='4';ysys='3';text=left(trim(&group));
x=10+spot+2+3+2+spot1+2+3+2+spot2+2+3+2+spot3+2+3+2; y=3.5;
style="&flegent"; color="&cfill4";position='6';size=&haxval;output;

end;
end;
end;
run;

proc sort data=anno1; by descending grpnum; run;quit;

data anno2;
length color style function $8;
set anno1; by descending grpnum;
if &ERRCHK>0 then do;
stop;
end;
run;quit;


%macro get;
%do i=&OT %to &AT;
  &&t&i
  &&z&i
%end;
%mend get;

goptions hsize=&size vsize=&size cback=&cback;

proc gplot anno=anno2 gout=&store;

plot &response*&midpoint/ vaxis=axis1 anno=anno name="&entry"
                          haxis=axis2;
symbol1 v=none i=none c="&caxis";
axis1 order=( &vmin to &fend by &vincr) style=0 major=none minor=none
      value=(f=&faxval h=&haxval c=&ctickval %get)
      label=none offset=(0,0)pct origin=(&horigin,&vorigin)pct
      length=&length pct;
axis2 style=0 major=none minor=none
      value=none
      label=none offset=(0,0)pct origin=(&horigin,&vorigin)pct
      length=&length pct;
run;
quit;
%MEND VBAR3D;