/****************************************************************************************
                                                                                 07/14/09

BrCa_MD_RAM : (Br)east (Ca)ncer with (M)ammographic (D)ensity (R)isk (A)ssessment (M)acro

SAS macro to project for BrCa abs risk for white women based on the relative risk model
which includes % mammographic density.

****************************************************************************************/

option   nocenter  ls=100  ps=62  notes;
OPTIONS  FORMCHAR="|----|+|---+=|-/\<>*";


***     BrCa_MD_RAM  start of SAS macro which performs BrCa absolute risk projection

        Modification/change of any code from this point onward should be avoided,
        Any changes to these codes are done at the user's risk, since changes may
        inadvertenly cause the macro to be fundamentally altered resulting in incorrect
        projections and/or abnormal termination

                     macro           all macro parameters need to "point" to appropriate
                     parameters      sas file or sas variable names upon invocation;

%macro  BrCa_MD_RAM (In_File         =,
                     Out_File        =,

                     T1              =,
                     T2              =,

                     PDensty         =,
                     N_Rels          =,
                     N_Biop          =,
                     Age1st          =,
                     BdyWght         =,

                     AbsRsk          =);


   ***   sas system dataset which contains rr covariates for women of interest
         i.e. women whom we wish to project absolute risk based on their relative
         risk covariate values, initial age, projection age and race;

   data  TmpFile;      *** temporary working sas file containing rr covariate data;
   set  &In_File;      *** original  input   sas file containing rr covariate data;

         *** set raw file indicator to default value of 1;
         Raw_Ind = 1;


         title3 'BrCa_MD_RAM,  sas macro to project for BrCa absolute risk with % density';

                 Error_Ind = 0;                       *** error in covariates indicator;
         label   Error_Ind = "If mean not 0, implies ERROR in file  -----> ";

         NT1=int(&T1+0.5);                                 *** round to nearest integer;
         NT2=int(&T2+0.5);                                 *** round to nearest integer;

         if (&T1 eq &T2) then &T1=&T1-1;              *** for example ti=57.51 ts=57.95;


         *** codes to test for consistency of T1 (initial age) and T2 (projection age);
         set_T1_Missing = &T1;
         set_T2_Missing = &T2;

         if (&T1 lt 20 or &T1 gt 85) then do;
            set_T1_Missing = .;
            Error_Ind      = 1;
         end;

         if (&T2 gt 90) then do;
            set_T2_Missing = .;
            Error_Ind      = 1;
         end;

         if (&T1 ge &T2) then do;
            set_T1_Missing = .;
            set_T2_Missing = .;
            Error_Ind      = 1;
         end;



         if (Raw_Ind eq 1) then do;
         *** rr covariates are in raw/original format;

            *** editing and recoding for PDensty;
            if     (&PDensty  eq  0                    )                  then PD_Cat=0;
            else if(&PDensty  gt  0 and &PDensty lt  25)                  then PD_Cat=1;
            else if(&PDensty  ge 25 and &PDensty lt  50)                  then PD_Cat=2;
            else if(&PDensty  ge 50 and &PDensty lt  75)                  then PD_Cat=3;
            else if(&PDensty  ge 75 and &PDensty le 100)                  then PD_Cat=4;
            else                                                               PD_Cat=.;

            *** editing and recoding for N_Rels;
            if     ( &N_Rels eq   0  or &N_Rels eq 99)                    then NR_Cat=0;
            else if( &N_Rels eq   1                  )                    then NR_Cat=1;
            else if( &N_Rels ge   2 and &N_Rels lt 99)                    then NR_Cat=2;
            else                                                               NR_Cat=.;

            *** editing and recoding for N_Biop;
            if     ( &N_Biop eq   0  or &N_Biop eq 99)                    then NB_Cat=0;
            else if( &N_Biop eq   1                  )                    then NB_Cat=1;
            else if( &N_Biop ge   2 and &N_Biop ne 99)                    then NB_Cat=2;
            else                                                               NB_Cat=.;

            if     ( &Age1st gt &T1 and &Age1st ne 98)                    then AF_Cat=.;
            else if( &Age1st le  19  or &Age1st eq 99)                    then AF_Cat=0;
            else if( &Age1st ge  20 and &Age1st le 24)                    then AF_Cat=1;
            else if((&Age1st ge  25 and &Age1st le 29) or &Age1st eq 98)  then AF_Cat=2;
            else if( &Age1st ge  30                  )                    then AF_Cat=3;
            else                                                               AF_Cat=.;

            *** editing and recoding for Age1st;
            if     ( &Age1st gt &T1 and &Age1st ne 98)                    then AF_Cat=.;
            else if( &Age1st le  19  or &Age1st eq 99)                    then AF_Cat=0;
            else if( &Age1st ge  20 and &Age1st le 24)                    then AF_Cat=1;
            else if((&Age1st ge  25 and &Age1st le 29) or &Age1st eq 98)  then AF_Cat=2;
            else if( &Age1st ge  30                  )                    then AF_Cat=3;
            else                                                               AF_Cat=.;

            *** editing and recoding for BdyWght;
            if     (&BdyWght gt   0 and &BdyWght le 100)                  then BW_Cat=0;
            else if(&BdyWght gt 100 and &BdyWght le 125)                  then BW_Cat=1;
            else if(&BdyWght gt 125 and &BdyWght le 150)                  then BW_Cat=2;
            else if(&BdyWght gt 150 and &BdyWght le 175)                  then BW_Cat=3;
            else if(&BdyWght gt 175 and &BdyWght le 200)                  then BW_Cat=4;
            else if(&BdyWght gt 200                    )                  then BW_Cat=5;
            else                                                               BW_Cat=.;
         end;
         else if (Raw_Ind eq 0) then do;

         *** RR covariates have already been re-coded to 0, 1, 2, 3, 4, or 5.
             NOTE: when Raw_Ind=0, edit/consistency checks for all relative risk
                   covariates not performed.  use this option at your own risk;

            PD_Cat = &PDensty;
            NR_Cat = &N_Rels;
            NB_Cat = &N_Biop;
            AF_Cat = &Age1st;
            BW_Cat = &BdyWght;
         end;


         if (PD_Cat eq .  or
             NR_Cat eq .  or
             NB_Cat eq .  or
             AF_Cat eq .  or
             BW_Cat eq .) then  Error_Ind = 1;         *** data error for this women;


         Key = 1;
   run;




   ***   set up h1*, h2, beta & F(t) with known constants used in the nci brca risk disk;

   data  H1_Star;                                  *** h1star, BrCa composite incidences;

         array  White_H1 (II)  WH1_1-WH1_14
        (0.000011418, 0.000076030, 0.000252376, 0.000624990, 0.001242851, 0.002046500,
         0.002780792, 0.003530109, 0.004081204, 0.004630598, 0.005092464, 0.005285006,
         0.005004878, 0.004201459);                     *** SEER9 incidence 1996-2000;

         array  Ages     (II)  A1-A14
        (20, 25, 30, 35, 40, 45, 50, 55, 60, 65, 70, 75, 80, 85);

         II  = .;
         Key = 1;
   run;


   data  H2;                                                *** h2, Competing hazards;

         array  White_H2 (II)  WH2_1-WH2_14
        (0.000422811, 0.000469880, 0.000628599, 0.000906577, 0.001313317, 0.001924433,
         0.003111971, 0.005223987, 0.008737775, 0.013893544, 0.022133616, 0.035656145,
         0.060812477, 0.144259924);                       *** US mortality 1996-2000;

         II  = .;
         Key = 1;
   run;


   data  LN_RR;

         array  White_Beta (JJ)  W_PD_Beta           W_NR_Beta           W_NB_Beta
                                 W_AF_Beta           W_BW_Beta
                                (0.3326293928076363, 0.4435226834226192, 0.2563501206516728,
                                 0.1581289161462119, 0.2155231616277974);         ***  lnRR;


         array  Beta_Name (JJ) $ CBeta1-CBeta5 ('%Dnsty', '# Rels', '# Biop',  'Age1st',
                                                'B Wght');

         JJ  = .;
         Key = 1;
   run;


   data  FofT;                                            *** 1-Attributable Risk = F(t);

         array  White_1_AR (KK)  W_1_AR_1      W_1_AR_2	 (0.2208999829,  0.2525771733);

         KK  = .;
         Key = 1;
   run;




   ***   The following 5 data steps, gathers all the needed parameters/constants
         and the input data set together to get ready for risk projection;

   data  TmpFile;
   merge TmpFile  H1_Star;
   by    Key;
   run;


   data  TmpFile;
   merge TmpFile  H2;
   by    Key;
   run;


   data  TmpFile;
   merge TmpFile  LN_RR;
   by    Key;
   run;


   data  TmpFile  (drop=Key);
   merge TmpFile  FofT;
   by    Key;
   run;


   data  TmpFile;
   set   TmpFile;

         array  White_H1  (II)    WH1_1-WH1_14;     *** h1star, BrCa composite incidences;

         array  White_H2  (II)    WH2_1-WH2_14;     *** h1star, BrCa composite incidences;

         array  Ages      (II)    A1-A14;
         array  AgesP5    (II)    AP1-AP14;


         do II = 1 to 14;
           AgesP5 = Ages + 5;
         end;


         array  White_Beta (JJ)  W_PD_Beta           W_NR_Beta           W_NB_Beta
                                 W_AF_Beta           W_BW_Beta;

         *** 1-Attributable Risk = F(t);
         array  White_1_AR (KK)  W_1_AR_1      W_1_AR_2;



         *** arrays to hold each 5yr age cat rate for each year in the 5yr age cat;
         array  WrkH1_1    (I5)  W1_01_1-W1_01_5;                            *** [20:25);
         array  WrkH1_2    (I5)  W1_02_1-W1_02_5;                            *** [25:30);
         array  WrkH1_3    (I5)  W1_03_1-W1_03_5;                            *** [30:35);
         array  WrkH1_4    (I5)  W1_04_1-W1_04_5;                            *** [35:40);
         array  WrkH1_5    (I5)  W1_05_1-W1_05_5;                            *** [40:45);
         array  WrkH1_6    (I5)  W1_06_1-W1_06_5;                            *** [45:50);
         array  WrkH1_7    (I5)  W1_07_1-W1_07_5;                            *** [50:55);
         array  WrkH1_8    (I5)  W1_08_1-W1_08_5;                            *** [55:60);
         array  WrkH1_9    (I5)  W1_09_1-W1_09_5;                            *** [60:65);
         array  WrkH1_10   (I5)  W1_10_1-W1_10_5;                            *** [65:70);
         array  WrkH1_11   (I5)  W1_11_1-W1_11_5;                            *** [70:75);
         array  WrkH1_12   (I5)  W1_12_1-W1_12_5;                            *** [75:80);
         array  WrkH1_13   (I5)  W1_13_1-W1_13_5;                            *** [80:85);
         array  WrkH1_14   (I5)  W1_14_1-W1_14_5;                            *** [85:90);

         array  Wrk_H1     (II) WrkH1_1-WrkH1_14;               *** h1   for this record;


         array  WrkH2_1    (I5)  W2_01_1-W2_01_5;                            *** [20:25);
         array  WrkH2_2    (I5)  W2_02_1-W2_02_5;                            *** [25:30);
         array  WrkH2_3    (I5)  W2_03_1-W2_03_5;                            *** [30:35);
         array  WrkH2_4    (I5)  W2_04_1-W2_04_5;                            *** [35:40);
         array  WrkH2_5    (I5)  W2_05_1-W2_05_5;                            *** [40:45);
         array  WrkH2_6    (I5)  W2_06_1-W2_06_5;                            *** [45:50);
         array  WrkH2_7    (I5)  W2_07_1-W2_07_5;                            *** [50:55);
         array  WrkH2_8    (I5)  W2_08_1-W2_08_5;                            *** [55:60);
         array  WrkH2_9    (I5)  W2_09_1-W2_09_5;                            *** [60:65);
         array  WrkH2_10   (I5)  W2_10_1-W2_10_5;                            *** [65:70);
         array  WrkH2_11   (I5)  W2_11_1-W2_11_5;                            *** [70:75);
         array  WrkH2_12   (I5)  W2_12_1-W2_12_5;                            *** [75:80);
         array  WrkH2_13   (I5)  W2_13_1-W2_13_5;                            *** [80:85);
         array  WrkH2_14   (I5)  W2_14_1-W2_14_5;                            *** [85:90);

         array  Wrk_H2     (II)  WrkH2_1-WrkH2_14;              *** h2   for this record;


         array  Wrk_Beta   (JJ)  Beta1-Beta5;                   *** beta for this record;
         array  Wrk_1_AR   (KK)  One_AR1 One_AR2;               *** 1-AR for this record;


         do II = 1 to 14;
            tmp1 = White_H1;                      *** brca incidence for the 5yr age cat;
            tmp2 = White_H2;                      *** competing hazs for the 5yr age cat;

            do I5 = 1 to 5;     *** fill in each yr of the 5yr cat with the correct rate;
               Wrk_H1 = tmp1;
               Wrk_H2 = tmp2;
            end;
         end;

         do JJ = 1 to 5;                                                       *** ln RR;
            Wrk_Beta = White_Beta;
         end;

         do KK = 1 to 2;                                                       *** 1- AR;
            Wrk_1_AR = White_1_AR;
         end;
   run;




   *** document all constants;

   data  Dummy;
   set   TmpFile;

         file print;

         array  White_H1  (II)  WH1_1-WH1_14;
         array  White_H2  (II)  WH2_1-WH2_14;

         array  Ages     (II)  A1-A14;
         array  AgesP5   (II)  AP1-AP14;

         do II = 1 to 14;
           AgesP5 = Ages + 5;
         end;

         if (_N_ eq 1) then do;
            put " ";
            put " BrCa";
            put " 5 year   composite h1*   cmptng rsk h2";
            put " AgeGrp   SEER9 1996-00   US    1996-00";
            put " ";

            do II = 1 to 14;
               put "[" Ages 2.0 ":"  AgesP5 2.0 ")"
                   White_H1  16.6
                   White_H2  16.6;
            end;
         end;


         array  White_Beta (JJ)   W_PD_Beta           W_NR_Beta           W_NB_Beta
                                  W_AF_Beta           W_BW_Beta;

         array  Beta_Name  (JJ) $ CBeta1-CBeta5;

         if (_N_ eq 1) then do;
            put " ";
            put "Ln Relative Risk from logistic regressions:       Beta";
            put " ";
            put "  Beta          lnRR";
            put " ";

            do JJ = 1 to 5;
               put  Beta_Name  $char6.
                    White_Beta   14.7;
            end;
         end;



         array  White_1_AR (KK)  W_1_AR_1      W_1_AR_2;

         if (_N_ eq 1) then do;
            put " ";
            put "1-Attributable Risk:  F(t)";
            put " ";
            put "AgeGrp           1-AR";
            put " ";

            do KK = 1 to 2;
               if      (KK eq 1) then
                  put  "Age< 50"
                       White_1_AR   14.7;
               else if (KK eq 2) then
                  put  "Age>=50"
                       White_1_AR   14.7;
            end;
         end;

   title5  "Listing of All constants required for BrCa absolute risk projections";
   run;




   *** BrCa risk projection;

   data  TmpFile;
   set   TmpFile;

         array  h1 (j_intvl) W1_01_1-W1_01_5  W1_02_1-W1_02_5  W1_03_1-W1_03_5
                             W1_04_1-W1_04_5  W1_05_1-W1_05_5  W1_06_1-W1_06_5
                             W1_07_1-W1_07_5  W1_08_1-W1_08_5  W1_09_1-W1_09_5
                             W1_10_1-W1_10_5  W1_11_1-W1_11_5  W1_12_1-W1_12_5
                             W1_13_1-W1_13_5  W1_14_1-W1_14_5;

         array  h2 (j_intvl) W2_01_1-W2_01_5  W2_02_1-W2_02_5  W2_03_1-W2_03_5
                             W2_04_1-W2_04_5  W2_05_1-W2_05_5  W2_06_1-W2_06_5
                             W2_07_1-W2_07_5  W2_08_1-W2_08_5  W2_09_1-W2_09_5
                             W2_10_1-W2_10_5  W2_11_1-W2_11_5  W2_12_1-W2_12_5
                             W2_13_1-W2_13_5  W2_14_1-W2_14_5;

         array  One_AR_RR (j_intvl)  One_AR_RR_01-One_AR_RR_70;

         array  PI_j(j_intvl) Pi1-Pi70;

   /*
         <----- slow ----- fast ------> (changes)
         PDensty, N_Rels, N_Biop, Age1st, BdyWght
         PD_Cat,  NR_Cat, NB_Cat, AF_Cat, BW_Cat

              5*      3*      3*      *4       *6  = 1080 patterns

          PD_Cat  5 levels    5*3*3*4*6 = 1080 patterns
          NR_Cat  3 levels      3*3*4*6 =  216 patterns
          NB_Cat  3 levels        3*4*6 =   72 patterns
          AF_Cat  4 levels          4*6 =   24 patterns
          BW_Cat  6 levels            6 =    6 patterns
   */

         PattrnNumber = PD_Cat * 216  +
                        NR_Cat *  72  +
                        NB_Cat *  24  +
                        AF_Cat *   6  +
                 		BW_Cat *   1  + 1;


         LP1  = PD_Cat * Beta1 +
                NR_Cat * Beta2 +
                NB_Cat * Beta3 +
                AF_Cat * Beta4 +
                BW_Cat * Beta5;

         LP2  = LP1;


         *** double iterated integral ala  eq 2.3  Benichou & Gail Biometrics 46,813-826;

         Strt_Intvl = floor(&T1) - 20 + 1;     *** example:  T1=21 T2=23, Strt_Intvl=21-20+1= 2;
         Endd_Intvl =  ceil(&T2) - 20 + 0;     ***                        EndD_Intvl=23-20+0= 3;
         NumbrIntvl =  ceil(&T2) - floor(&T1); ***                        NumbrIntvl=23-21  = 2;

         RR_Star1   = exp(LP1);               *** RRstar woman of interest at ages lt 50;
         RR_Star2   = exp(LP2);               *** RRstar woman of interest at ages ge 50;

         One_AR_RR1 = One_AR1*RR_Star1;       ***(1-AR)*rr=(1-AR)*exp(xstar*) age lt 50;
         One_AR_RR2 = One_AR2*RR_Star2;       ***(1-AR)*rr=(1-AR)*exp(xstar*) age ge 50;

         do j_intvl = 1 to 70;
            if      (j_intvl le 30) then One_AR_RR = One_AR_RR1;
            else if (j_intvl gt 30) then One_AR_RR = One_AR_RR2;
         end;

         if      (Error_Ind eq 1) then
           &AbsRsk = .;                                      *** erroneous input record
                                                                 set abs risk to missing;

         else if (Error_Ind eq 0) then do; 		             *** error free input record;
           &AbsRsk = 0;                                      *** calculate abs risk from;
            Cum_H  = 0;

            do jj = 1 to NumbrIntvl;
               j_intvl = Strt_Intvl + (jj - 1);

               if      (NumbrIntvl gt 1 and jj gt          1
                                        and jj lt NumbrIntvl) then IntgrlLngth = 1;
               else if (NumbrIntvl gt 1 and jj eq          1) then IntgrlLngth = 1 - (&T1 - floor(&T1));
               else if (NumbrIntvl gt 1 and jj eq NumbrIntvl) then IntgrlLngth =     (&T2 - floor(&T2))*(&T2 gt floor(&T2)) +
                                                                                                        (&T2 eq floor(&T2));
               else if (NumbrIntvl eq 1                     ) then IntgrlLngth =      &T2 - &T1;

               Hj = h1*ONE_AR_RR + h2;

               PI_j   = ((One_AR_RR*h1/Hj)*exp(-Cum_H)) * (1-exp(-Hj*IntgrlLngth));
              &AbsRsk = &AbsRsk + PI_j;
               Cum_H  = Cum_H  + Hj*IntgrlLngth;
            end;
         end;


         Key = 1;


         label Beta1         =  "ln RR of % Density"
               Beta2         =  "ln RR of # of 1st degree relatives with BrCa"
               Beta3         =  "ln RR of # of biopsies"
               Beta4         =  "ln RR of Age 1st live birth"
               Beta5         =  "ln RR of Body weight"

               One_AR1       =  "1-Attributable risk age lt 50"
               One_AR2       =  "1-Attributable risk age ge 50"

               PattrnNumber  =  "Relative risk covariate pattern #"

               RR_Star1      =  "Relative risk age lt 50"
               RR_Star2      =  "Relative risk age ge 50"

               One_AR_RR1    =  "(1-AR)*RelRsk age lt 50"
               One_AR_RR2    =  "(1-AR)*RelRsk age ge 50"

              &AbsRsk        =  "Abs risk of BrCa in age interval [T1,T2)";
   run;


   proc  means  data=TmpFile  mean std n nmiss  maxdec=5;
   var   Error_Ind
        &AbsRsk
         One_AR_RR1
         One_AR_RR2;

   title5  "Quick check for errornous records on input file";
   title6  " ";
   title7  "IF MEAN OF  'Error_Ind'   EQUALS  0,   ERROR  FREE.    ERROR LISTING BELOW "
           "WILL BE EMPTY.";
   title8  "IF MEAN OF  'Error_Ind'   IS NOT  0,   ERRORS EXISTS.  CHECK ERROR LISTING "
           "BELOW.";
   title9  " ";
   title10 "(# of records with errors is the # listed under the NMiss column in the"
           " 'AbsRsk' line)";


   ***   Error listing file when errors detected as well as writing out a sas file which
         contains the projectd absolute risk as well as all the original input variables;

   data &Out_File (drop = Raw_Ind -- Pi70  LP1 -- NumbrIntvl  RR_Star1  RR_Star2
                          Cum_H -- Key);              *** deleting unnecessary variables;
   set   TmpFile;
   by    Key;

         retain  Count_Error 0;

         file print;

         if (_N_ eq 1) then do;
            put " ";
            put " Record                 %    #     #  Age    Body"
                "  (1-ar)RR  (1-ar)RR              Patrn";
            put "      #    T1    T2  Dens  Rel  Biop  1st    Wght"
                "    Age<50    Age>50      AbsRsk      #";
            put " ";
         end;

         if (Error_Ind eq 1) then do;
            put Rec_Num        7.0

               &T1             6.1
               &T2             6.1

               &PDensty        6.0
               &N_Rels         5.0
               &N_Biop         6.0
               &Age1st         5.0
               &BdyWght        8.0

                One_AR_RR1    10.4
                One_AR_RR2    10.4
               &AbsRsk        12.0
                PattrnNumber   7.0;


            put
               "       "
                set_T1_Missing      6.1
                set_T2_Missing      6.1

                PD_Cat              6.0
                NR_Cat              5.0
                NB_Cat              6.0
                AF_Cat              5.0
                BW_Cat              8.0;

            put " ";

            Count_Error = Count_Error + 1;
         end;

         if (last.Key and Count_Error eq 0) then do;
            put " ";
            put "      No errors detected for initial age, projection age "
                "and relative risk covaraites";
            put "      ---------------------------------------------------"
                "----------------------------";
            put " ";
            put "	";
         end;

   title5  "Error listing for the input file";
   run;

   data &Out_File (drop = Count_Error);
   set  &Out_File;
   run;

%mend    BrCa_MD_RAM;          *** end of SAS macro to perform abs risk projection;
