//XXXX    JOB XXXX
//LIBRARY DD DSN=file containing SAS formats
//SASLIB  DD DSN=file containing SAS formats
//WORK   DD SPACE=(CYL,(900,50)),UNIT=WORKDA
//WORK1  DD SPACE=(CYL,(1500,50)),UNIT=WORKDA
//WORK2  DD SPACE=(CYL,(1500,50)),UNIT=WORKDA
//WORK3  DD SPACE=(CYL,(1500,50)),UNIT=WORKDA
//****************************************************************
//IN1  DD DISP=SHR,DSN=file of person demographic information
//IN2  DD DISP=SHR,DSN=fileof inpatient encounter records
//OUT DD DISP=(NEW,CATLG,KEEP),
//       DSN=output file
//SYSIN DD *;
/**********************************************************************
*            DATE: 10/24/2001
*         PROGRAM: CMS PIPDCG PUBLIC USE PAYMENT MODEL SOFTWARE FOR 2003
*     DESCRIPTION: THIS PROGRAM READS IN PERSON LEVEL AND ADMISSION
*                  LEVEL FILES AND DOES THE FOLLOWING:
*                    - ASSIGNS PIPDCG TO EACH CONTINUING BENEFICIARY.
*                    - COMPUTES PREDICTED ANNUAL EXPENDITURES FOR
*                      YEAR 2 FOR EACH PERSON.
*                    - ADJUSTS PREDICTED ANNUAL EXPENDITURES FOR
*                      WORKING AGED.
*                    - ADJUSTS PREDICTED ANNUAL EXPENDITURES FOR
*                      PRIOR CONGESTIVE HEART FAILURE (CHF) DIAGNOSES.
*                    - COMPUTES RELATIVE RISK SCORE FOR EACH PERSON.
*                  THE OUTPUT FILE IS A PERSON LEVEL FILE WITH
*                  COMPUTED VARIABLES DESCRIBED EARLIER.
*
*	      CHANGES: 10/16/2002, 10/24/2002 - LS
*					PER 2003 CMS PAYMENT CHANGE AS OF OCTOBER 2002
**********************************************************************/;
*======================================================================
* PART1: set parameters,macros and macro variables                    *
*=====================================================================;
***********************************************************************
* STEP1: set 9 global parameters:                                     *
*  - LOS01 switch    = 1 if diagnoses from all hospital admissions    *
*                        should be included.                          *
*                    = 0 to ignore diagnoses from all hospital        *
*                        admissions with LOS of less than 2.          *
*            Default = 0                                              *
*                                                                     *
*  - PIPADJ switch   = 1 if HER PIPDXG age/sex edits for invalid      *
*                        diagnoses should be done.                    *
*                    = 0 not to make HER age/sex edits.               *
*            Default = 0                                              *
*                                                                     *
*  - MAXDIAG = maximum number of diagnoses in an admission record.    *
*            Default = 10                                             *
*                                                                     *
*  - YEAR2  - the year for which expenditures are being predicted.    *
*            Default = 2003                                           *
*                                                                     *
*  - YR2MONTH - First month of Year2 (1=Jan, 2=Feb,..., 12=Dec).      *
*            Default = 1                                              *
*                                                                     *
*  - FAGESEX switch  = 1 if output file should have 34 variables with *
*                        fractional age/sex values.                   *
*                    = 0 not to include fractional age/sex vars in the*
*                        output file.                                 *
*            Default = 1                                              *
*                                                                     *
*  - WAM - working aged multiplier for continuing enrollees.          *
*            Default = 0.21                                           *
*                                                                     *
*  - WAM_NE - working aged multiplier for new enrollees               *
*            Default = 0.21                                           *
***********************************************************************;

%LET LOS01    = 0;
%LET PIPADJ   = 0;
%LET MAXDIAG  = 10;
%LET YEAR2    = 2003;
%LET YR2MONTH = 1;
%LET FAGESEX  = 1;
%LET WAM      = 0.21;
%LET WAM_NE   = 0.21;

***********************************************************************
* STEP2: create macro variables to drop or not drop length of stay 0,1*
*        and include or not include fractional age/sex vars in the    *
*        output file.                                                 *
***********************************************************************;

DATA _NULL_;
     IF NOT &LOS01 THEN
        CALL SYMPUT('PARAM1','WHERE=(LOS > 1)');
     ELSE
        CALL SYMPUT('PARAM1','');

     IF &FAGESEX THEN
        CALL SYMPUT('PARAM2','W0_34--W95_GT M0_34--M95_GT');
     ELSE
        CALL SYMPUT('PARAM2','');

RUN;
***********************************************************************
* STEP3: macro to perform edits for pediatric DXGROUPs, by age,       *
* for "male only" and for "female only".                              *
* NOTE: some of the edits include diagnoses check. But because these  *
*       edits do not include cases of chemotherapy  or AIDS it is not *
*       necessary to consider secondary diagnoses.                    *
***********************************************************************;

     %MACRO PIPEDIT;
        IF AGE >=2 &  PIPDXG IN ('166','167','168','169','170')
        THEN DO;
            IF SEX='1' THEN PIPDXG='-1';
            ELSE            PIPDXG='130';
        END;

        IF SEX='2'
         & (PIPDXG IN ('18','121','122')
             OR (PIPDXG='31' & DIAG1=:'257'))
        THEN PIPDXG='-1';
        ELSE
        IF SEX='1'
         & (PIPDXG IN ('16','17','123','124','125')
             OR (PIPDXG='31' & DIAG1=:'256'))
        THEN PIPDXG='-1';
        ELSE
        IF (PIPDXG IN ('126','127','128','129','130','131','132')
             OR (PIPDXG='124' & DIAG1=:'628'))
         &  (SEX='1' OR AGE < 8 OR AGE > 59)
        THEN PIPDXG='-1';

     %MEND PIPEDIT;

*======================================================================
* PART2: create PIPDCG for each IDNO                                  *
*=====================================================================;
***********************************************************************
* STEP1: read in Person-level file in a temporary dataset named       *
* WORK1.PERSON. Compute a person's age and sex cells, which are       *
* defined as fraction of eligible months in YEAR2 that are spent in   *
* each cell.                                                          *
* Age in each month is age as of the first day of the following month,*
* e.g. a person's age for February is his/her age as of March 1.      *
***********************************************************************;

  DATA WORK1.PERSON(KEEP=IDNO AGE SEX OREC
                    EVERDISM DOB MCAID MSP NEWENROL
                    CHFYEAR3 CHFYEAR4 W0_34--M95_GT);
       SET IN1.PERSON;

       OPTIONS YEARCUTOFF=19800;
       YEARN   = &YEAR2 + 1;
       SAS_DOB = INPUT(PUT(DOB,8.),YYMMDD8.);
       YBEGIN  = INPUT(PUT(
       (&YEAR2*10000 + &YR2MONTH*100 + 1),8.),YYMMDD8.);
       YNBEGIN = INPUT(PUT(
       (YEARN*10000 + &YR2MONTH*100 + 1),8.),YYMMDD8.);

       IF DAY(SAS_DOB) = 1 THEN SAS_DOB=SAS_DOB-1;

       AGE  = INT((YBEGIN - SAS_DOB)/ 365.25);
       AGEN = INT((YNBEGIN - SAS_DOB)/ 365.25);

       ATTRIB AGE AGEN LENGTH=3.;

       *array to keep date of first day of each month;
       ARRAY MON(12);
       J=0;
       MB = &YR2MONTH + 1;
       DO I=MB TO 12;
          J = J + 1;
          MON(J) =
             INPUT(PUT((&YEAR2*10000 + I*100 + 1),8.),YYMMDD8.);
       END;
       DO I=1 TO &YR2MONTH;
          J = J + 1;
          MON(J) =
             INPUT(PUT((YEARN*10000 + I*100 + 1),8.),YYMMDD8.);
       END;

       FR1=1;
       FR2=0;

       DO I=1 TO 12 WHILE(FR2=0);
          MAGE=INT(( MON(I) - SAS_DOB)/ 365.25);

          IF MAGE > AGE THEN DO;
             FR1=(I - 1) / 12;
             FR2=1 - FR1;
          END;
       END;

       ARRAY CELL
             W0_34  W35_44 W45_54 W55_59 W60_64 W65_69
             W65 W66 W67 W68 W69
             W70_74 W75_79 W80_84 W85_89 W90_94 W95_GT
             M0_34  M35_44 M45_54 M55_59 M60_64 M65_69
             M65 M66 M67 M68 M69
             M70_74 M75_79 M80_84 M85_89 M90_94 M95_GT
             ;
       DO OVER CELL; CELL=0; END;

       SELECT;
          WHEN(SEX='2' & 0<= AGE <=34)  W0_34 =FR1;
          WHEN(SEX='2' & 34< AGE <=44)  W35_44=FR1;
          WHEN(SEX='2' & 44< AGE <=54)  W45_54=FR1;
          WHEN(SEX='2' & 54< AGE <=59)  W55_59=FR1;
          WHEN(SEX='2' & 59< AGE <=64)  W60_64=FR1;
          WHEN(SEX='2' & 64< AGE <=69)  W65_69=FR1;
          WHEN(SEX='2' & 69< AGE <=74)  W70_74=FR1;
          WHEN(SEX='2' & 74< AGE <=79)  W75_79=FR1;
          WHEN(SEX='2' & 79< AGE <=84)  W80_84=FR1;
          WHEN(SEX='2' & 84< AGE <=89)  W85_89=FR1;
          WHEN(SEX='2' & 89< AGE <=94)  W90_94=FR1;
          WHEN(SEX='2' & AGE >94)       W95_GT=FR1;
          WHEN(SEX='1' & 0<= AGE <=34)  M0_34 =FR1;
          WHEN(SEX='1' & 34< AGE <=44)  M35_44=FR1;
          WHEN(SEX='1' & 44< AGE <=54)  M45_54=FR1;
          WHEN(SEX='1' & 54< AGE <=59)  M55_59=FR1;
          WHEN(SEX='1' & 59< AGE <=64)  M60_64=FR1;
          WHEN(SEX='1' & 64< AGE <=69)  M65_69=FR1;
          WHEN(SEX='1' & 69< AGE <=74)  M70_74=FR1;
          WHEN(SEX='1' & 74< AGE <=79)  M75_79=FR1;
          WHEN(SEX='1' & 79< AGE <=84)  M80_84=FR1;
          WHEN(SEX='1' & 84< AGE <=89)  M85_89=FR1;
          WHEN(SEX='1' & 89< AGE <=94)  M90_94=FR1;
          WHEN(SEX='1' & AGE > 94)      M95_GT=FR1;
          OTHERWISE;
       END;

       SELECT;
          WHEN(SEX='2' &  0< AGEN <=34) W0_34  =W0_34   + FR2;
          WHEN(SEX='2' & 34< AGEN <=44) W35_44 =W35_44  + FR2;
          WHEN(SEX='2' & 44< AGEN <=54) W45_54 =W45_54  + FR2;
          WHEN(SEX='2' & 54< AGEN <=59) W55_59 =W55_59  + FR2;
          WHEN(SEX='2' & 59< AGEN <=64) W60_64 =W60_64  + FR2;
          WHEN(SEX='2' & 64< AGEN <=69) W65_69 =W65_69  + FR2;
          WHEN(SEX='2' & 69< AGEN <=74) W70_74 =W70_74  + FR2;
          WHEN(SEX='2' & 74< AGEN <=79) W75_79 =W75_79  + FR2;
          WHEN(SEX='2' & 79< AGEN <=84) W80_84 =W80_84  + FR2;
          WHEN(SEX='2' & 84< AGEN <=89) W85_89 =W85_89  + FR2;
          WHEN(SEX='2' & 89< AGEN <=94) W90_94 =W90_94  + FR2;
          WHEN(SEX='2' & AGEN >94)      W95_GT =W95_GT  + FR2;
          WHEN(SEX='1' &  0< AGEN <=34) M0_34  =M0_34   + FR2;
          WHEN(SEX='1' & 34< AGEN <=44) M35_44 =M35_44  + FR2;
          WHEN(SEX='1' & 44< AGEN <=54) M45_54 =M45_54  + FR2;
          WHEN(SEX='1' & 54< AGEN <=59) M55_59 =M55_59  + FR2;
          WHEN(SEX='1' & 59< AGEN <=64) M60_64 =M60_64  + FR2;
          WHEN(SEX='1' & 64< AGEN <=69) M65_69 =M65_69  + FR2;
          WHEN(SEX='1' & 69< AGEN <=74) M70_74 =M70_74  + FR2;
          WHEN(SEX='1' & 74< AGEN <=79) M75_79 =M75_79  + FR2;
          WHEN(SEX='1' & 79< AGEN <=84) M80_84 =M80_84  + FR2;
          WHEN(SEX='1' & 84< AGEN <=89) M85_89 =M85_89  + FR2;
          WHEN(SEX='1' & 89< AGEN <=94) M90_94 =M90_94  + FR2;
          WHEN(SEX='1' & AGEN > 94)     M95_GT =M95_GT  + FR2;
          OTHERWISE;
       END;

***********************************************************************
* STEP2: compute "ever disabled", which is defined as the fraction of *
* YEAR2 eligible months spent in ever disabled status,                *
* create yearly age/sex cells for new enrollees and make some age/sex *
* cells adjustment for them so that all age/sex cell values sum to 1  *
* for each person.                                                    *
***********************************************************************;
       IF OREC IN ('1','2','3') THEN DO;

          IF AGE >= 65  THEN EVERDISM=1;
          ELSE
          IF AGEN < 65  THEN EVERDISM=0;
          ELSE               EVERDISM=FR2;
       END;
       ELSE EVERDISM=0;

       * for new enrolees;
       IF NEWENROL THEN DO;
          SELECT;
             WHEN(SEX='2' & 64< AGE <=65)  W65   =FR1;
             WHEN(SEX='2' & 65< AGE <=66)  W66   =FR1;
             WHEN(SEX='2' & 66< AGE <=67)  W67   =FR1;
             WHEN(SEX='2' & 67< AGE <=68)  W68   =FR1;
             WHEN(SEX='2' & 68< AGE <=69)  W69   =FR1;
             WHEN(SEX='1' & 64< AGE <=65)  M65   =FR1;
             WHEN(SEX='1' & 65< AGE <=66)  M66   =FR1;
             WHEN(SEX='1' & 66< AGE <=67)  M67   =FR1;
             WHEN(SEX='1' & 67< AGE <=68)  M68   =FR1;
             WHEN(SEX='1' & 68< AGE <=69)  M69   =FR1;
             OTHERWISE;
          END;
          SELECT;
             WHEN(SEX='2' & 64< AGEN <=65) W65    =W65 + FR2;
             WHEN(SEX='2' & 65< AGEN <=66) W66    =W66 + FR2;
             WHEN(SEX='2' & 66< AGEN <=67) W67    =W67 + FR2;
             WHEN(SEX='2' & 67< AGEN <=68) W68    =W68 + FR2;
             WHEN(SEX='2' & 68< AGEN <=69) W69    =W69 + FR2;
             WHEN(SEX='1' & 64< AGEN <=65) M65    =M65 + FR2;
             WHEN(SEX='1' & 65< AGEN <=66) M66    =M66 + FR2;
             WHEN(SEX='1' & 66< AGEN <=67) M67    =M67 + FR2;
             WHEN(SEX='1' & 67< AGEN <=68) M68    =M68 + FR2;
             WHEN(SEX='1' & 68< AGEN <=69) M69    =M69 + FR2;
             OTHERWISE;
          END;

          * fix W65-69 & M65_69 cells to avoid double-counting of
          age cells;
          IF SUM(W65,W66,W67,W68,W69)>0 THEN W65_69=0;
          ELSE
          IF SUM(M65,M66,M67,M68,M69)>0 THEN M65_69=0;

          * fix new aged 65 year olds to get 100% of 65 rate except
            in case of new 64 disabled person;
          IF (W65>0 & W60_64>0 & EVERDISM<=0) THEN DO;
                   W65=1 ; W60_64=0 ;
          END;
          ELSE
          IF (M65>0 & M60_64>0 & EVERDISM<=0) THEN DO;
                   M65=1 ; M60_64=0 ;
          END;
       END;
  RUN;
***********************************************************************
* STEP3: merge Admission-level file with Person-level file taking     *
* admissions only for people who are present in Person-level file.    *
* Create a temporary dataset named WORK2.TEMP1.                       *
* Declare arrays to create temporary PIPDXG for each not missing      *
* diagnosis and declare PIPDCG.                                       *
***********************************************************************;

  DATA WORK2.TEMP1(KEEP=IDNO PIPDXG);
       MERGE IN2.ADMISSN(IN=IN2 &PARAM1)
             WORK1.PERSON(IN=IN1 KEEP=IDNO AGE SEX);
       BY IDNO;
       IF IN1 & IN2;

       ATTRIB PIPTMP1-PIPTMP&MAXDIAG PIPDXG LENGTH=$3.;


       ARRAY D(&MAXDIAG) $ DIAG1-DIAG&MAXDIAG;           * DIAGs;
       ARRAY PIPTMP(&MAXDIAG) $ PIPTMP1-PIPTMP&MAXDIAG;  * PIPDXGs;

***********************************************************************
* STEP4: assign each diagnosis a PIPTMP group by crosswalking         *
* diagnoses into PIPTMP using SAS formats which were previously       *
* stored in the FORMAT library. If DIAG diagnoses is not valid (has   *
* no corresponding format), the format assigns PIPTMP a value of "-1".*
***********************************************************************;

       NDIAG=0;            *# OF non blank diag;

       DO I=1 TO &MAXDIAG WHILE(D(I) NOT='     ');
          NDIAG=I;
          D(I) = UPCASE ( LEFT(D(I)));

          * format $PIPDXG. returns '-1' if DIAG is not valid;
          PIPTMP(I) = PUT(D(I),$PIPDXG.);

       END;

***********************************************************************
* STEP5: assign PIPTMP(1) created from the first diagnosis to PIPDXG. *
* If no diagnoses are present for a person then PIPDXG is set to "0". *
* If PIPDXG=162 - chemotherapy group then replace PIP diagnosis       *
* by the highest-ranked secondary cancer PIPDXG. If there is no cancer*
* PIPDXG present assign PIPDXG to be PIPDXG 14 "breast cancer". If any*
* secondary PIPTMP(I)=3 - HIV/AIDS is present then set PIPDXG to 3.   *
***********************************************************************;

       PIPDXG = PIPTMP(1);

       *no inpatient admissions;
       IF (FIRST.IDNO AND LAST.IDNO) & PIPDXG = ''
       THEN PIPDXG = '0';

       *chemotheraphy;
       IF PIPDXG = '162' THEN DO;
          IF NDIAG>=2 THEN
             DO I=2 TO NDIAG;
             IF PIPTMP(I) IN ('7','8','9','10','11','12',
             '13','14','15','16','17','18','19','20','21')
             THEN DO;
                *create temp PIPDCG;
                DCGTMP1= INPUT(PUT(PIPDXG,$DCGDXGE.),2.);
                DCGTMP2= INPUT(PUT(PIPTMP(I),$DCGDXGE.),2.);
                IF DCGTMP2 > DCGTMP1
                THEN PIPDXG= PIPTMP(I);
                END;
             END;
             IF PIPDXG='162' THEN PIPDXG='14';
          END;

       *HIV/AIDS;
       DO I=2 TO NDIAG;
          IF  PIPTMP(I)='3' THEN PIPDXG='3';
          END;

***********************************************************************
* STEP6: call macro to edit PIPDXG for invalid diagnoses.             *
***********************************************************************;

       IF &PIPADJ THEN DO;
          %PIPEDIT;
          END;

RUN;

***********************************************************************
* STEP7: exclude uncompleted pregnancy   PIPDXGs if a person had      *
* completed pregnancy   PIPDXGs.                                      *
* Create a temporary dataset named WORK2.TEMP2.                       *
***********************************************************************;

PROC SORT DATA=WORK2.TEMP1;
     BY IDNO PIPDXG;
RUN;

DATA WORK2.TEMP2;
     SET WORK2.TEMP1;
     BY IDNO;

     RETAIN FLAG 0;
     IF FIRST.IDNO THEN FLAG=0;
     IF PIPDXG IN ('126','127','128','129','130') THEN FLAG=1;
     IF PIPDXG IN ('131','132') & FLAG=1 THEN DELETE;


***********************************************************************
* STEP8: create PIPDCG by crosswalking PIPDXG into PIPDCG using SAS   *
* format library. Assign PIPDCG=4 for people without any admission    *
* and for those with invalid diagnoses.                               *
***********************************************************************;

     ATTRIB PIPDCG LENGTH= 3.;
     PIPDCG = INPUT(PUT(PIPDXG,$DCGDXGE.),2.);
     IF PIPDCG=. OR PIPDCG=0 OR PIPDCG=-1 THEN PIPDCG=4;

  RUN;

***********************************************************************
* STEP9: select admission for each IDNO with maximum PIPDCG.          *
* Create a temporary dataset named WORK2.TEMP3.                       *
***********************************************************************;

  PROC SORT DATA=WORK2.TEMP2(KEEP=IDNO PIPDCG);
       BY IDNO PIPDCG;
  RUN;
  DATA WORK2.TEMP3;
       SET WORK2.TEMP2;
       BY IDNO;
       IF LAST.IDNO;
  RUN;

***********************************************************************
* STEP10: merge pipdcg onto a person-level file                       *
* Create a temporary dataset named WORK3.TEMP4.                       *
***********************************************************************;

DATA WORK3.TEMP4;
     MERGE WORK1.PERSON(IN=IN1)
           WORK2.TEMP3(IN=IN2);
     BY IDNO;
     IF NEWENROL THEN PIPDCG=.;
     ELSE
     IF IN1 & NOT IN2 THEN PIPDCG=4;
     IF IN1;
RUN;

*======================================================================
* PART3: compute predicted annual expenditures and relative risk score*
*=====================================================================;

**********************************************************************
* STEP1: the following coefficient values for the "continuing        *
* enrollee" model were published in the March 15, 2000, Report to    *
* Congress.                                                          *
* The step creates MODEL1 temporary dataset.                         *
*********************************************************************;
 %LET NUMPE=78;
  DATA MODEL1(DROP=I);
       ARRAY PAREST(&NUMPE)   PAREST1-PAREST&NUMPE;
       DO I=1 TO &NUMPE;
          INPUT PAREST(I) 5.3;
       END;
       OUTPUT;
 CARDS;
0.367
0.380
0.487
0.615
0.760
0.541
0.705
0.907
1.077
1.258
1.376
1.357
0.362
0.403
0.526
0.643
0.891
0.453
0.588
0.747
0.918
1.096
1.162
1.128
0.375
0.458
0.697
0.822
0.915
1.170
1.271
1.662
2.000
2.438
2.656
3.392
3.823
4.375
5.189
0.000
0.125
0.283
0.370
0.397
0.418
0.440
0.457
0.461
0.445
0.404
0.331
0.242
0.192
0.312
0.367
0.397
0.412
0.433
0.440
0.454
0.423
0.327
0.231
0.168
0.415
0.398
0.334
0.287
0.237
0.189
0.141
0.605
0.576
0.519
0.415
0.313
0.232
0.152
;
**********************************************************************
* STEP2: the following coefficient values for the "new enrollee"     *
* model were published in the March 15, 2000, Report to Congress.    *
* The step creates MODEL2 temporary dataset.                         *
*********************************************************************;
 %LET NUMNB=64;

 DATA MODEL2(DROP=I);
      ARRAY PARNB(&NUMNB)   PARNB1-PARNB&NUMNB;
      DO I=1 TO &NUMNB;
         INPUT PARNB(I) 5.3;
      END;
      OUTPUT;
 CARDS;
0.512
0.559
0.649
0.810
0.959
0.525
0.573
0.620
0.667
0.715
0.847
1.086
1.307
1.518
1.666
1.668
0.535
0.579
0.696
0.840
1.110
0.446
0.484
0.522
0.559
0.597
0.703
0.899
1.111
1.328
1.429
1.381
0.223
0.386
0.464
0.499
0.506
0.653
0.646
0.640
0.634
0.628
0.594
0.616
0.612
0.609
0.386
0.354
0.261
0.423
0.426
0.542
0.451
0.603
0.603
0.603
0.602
0.602
0.577
0.594
0.589
0.424
0.328
0.180
;
**********************************************************************
* STEP3: merge MODEL1 & MODEL2                                       *
* The step creates MODEL temporary dataset.                          *
*********************************************************************;
DATA MODEL;
     MERGE MODEL1 MODEL2;
RUN;

**********************************************************************
* STEP4: compute the predicted expenditures (PREDEXPB, PREDEXPA) and *
* predicted relative score (RSKSCORB, RSKSCORA).                     *
* Compute perdicted expenditure and relative score adjusted for      *
* Congestive Heart Failure (PREDEXPC, CHFRSKSC).                     *
* Output a file with person ID, PREDEXPB, PREDEXPA, PREDEXPC,        *
* MPRDEXPB, MPRDEXPA, MPRDEXPC, RSKSCORB, RSCSCORA. CHFRSKSC         *
**********************************************************************;

DATA OUT.OUTPUT(KEEP=IDNO SEX DOB OREC MCAID MSP  EVERDISM NEWENROL
                     PIPDCG AGE PREDEXPB PREDEXPA RSKSCORA RSKSCORB
                     MPRDEXPB MPRDEXPA
                     CHFYEAR3 CHFYEAR4 CHFRSKSC PREDEXPC MPRDEXPC
                     &PARAM2);
     IF _N_=1 THEN SET MODEL;
     SET WORK3.TEMP4;

     IF NOT NEWENROL THEN
        RSKSCORB= M0_34             * PAREST1
               +  M35_44            * PAREST2
               +  M45_54            * PAREST3
               +  M55_59            * PAREST4
               +  M60_64            * PAREST5
               +  M65_69            * PAREST6
               +  M70_74            * PAREST7
               +  M75_79            * PAREST8
               +  M80_84            * PAREST9
               +  M85_89            * PAREST10
               +  M90_94            * PAREST11
               +  M95_GT            * PAREST12
               +  W0_34             * PAREST13
               +  W35_44            * PAREST14
               +  W45_54            * PAREST15
               +  W55_59            * PAREST16
               +  W60_64            * PAREST17
               +  W65_69            * PAREST18
               +  W70_74            * PAREST19
               +  W75_79            * PAREST20
               +  W80_84            * PAREST21
               +  W85_89            * PAREST22
               +  W90_94            * PAREST23
               +  W95_GT            * PAREST24
               +  (PIPDCG = 5)      * PAREST25
               +  (PIPDCG = 6)      * PAREST26
               +  (PIPDCG = 7)      * PAREST27
               +  (PIPDCG = 8)      * PAREST28
               +  (PIPDCG = 9)      * PAREST29
               +  (PIPDCG = 10)     * PAREST30
               +  (PIPDCG = 11)     * PAREST31
               +  (PIPDCG = 12)     * PAREST32
               +  (PIPDCG = 14)     * PAREST33
               +  (PIPDCG = 16)     * PAREST34
               +  (PIPDCG = 18)     * PAREST35
               +  (PIPDCG = 20)     * PAREST36
               +  (PIPDCG = 23)     * PAREST37
               +  (PIPDCG = 26)     * PAREST38
               +  (PIPDCG = 29)     * PAREST39
               +  (PIPDCG =  4)     * PAREST40
               +   M0_34*MCAID      * PAREST41
               +   M35_44*MCAID     * PAREST42
               +   M45_54*MCAID     * PAREST43
               +   M55_59*MCAID     * PAREST44
               +   M60_64*MCAID     * PAREST45
               +   M65_69*MCAID     * PAREST46
               +   M70_74*MCAID     * PAREST47
               +   M75_79*MCAID     * PAREST48
               +   M80_84*MCAID     * PAREST49
               +   M85_89*MCAID     * PAREST50
               +   M90_94*MCAID     * PAREST51
               +   M95_GT*MCAID     * PAREST52
               +   W0_34*MCAID      * PAREST53
               +   W35_44*MCAID     * PAREST54
               +   W45_54*MCAID     * PAREST55
               +   W55_59*MCAID     * PAREST56
               +   W60_64*MCAID     * PAREST57
               +   W65_69*MCAID     * PAREST58
               +   W70_74*MCAID     * PAREST59
               +   W75_79*MCAID     * PAREST60
               +   W80_84*MCAID     * PAREST61
               +   W85_89*MCAID     * PAREST62
               +   W90_94*MCAID     * PAREST63
               +   W95_GT*MCAID     * PAREST64
               +   M65_69*EVERDISM  * PAREST65
               +   M70_74*EVERDISM  * PAREST66
               +   M75_79*EVERDISM  * PAREST67
               +   M80_84*EVERDISM  * PAREST68
               +   M85_89*EVERDISM  * PAREST69
               +   M90_94*EVERDISM  * PAREST70
               +   M95_GT*EVERDISM  * PAREST71
               +   W65_69*EVERDISM  * PAREST72
               +   W70_74*EVERDISM  * PAREST73
               +   W75_79*EVERDISM  * PAREST74
               +   W80_84*EVERDISM  * PAREST75
               +   W85_89*EVERDISM  * PAREST76
               +   W90_94*EVERDISM  * PAREST77
               +   W95_GT*EVERDISM  * PAREST78 ;
     ELSE
        RSKSCORB= M0_34             * PARNB1
               +  M35_44            * PARNB2
               +  M45_54            * PARNB3
               +  M55_59            * PARNB4
               +  M60_64            * PARNB5
               +  M65               * PARNB6
               +  M66               * PARNB7
               +  M67               * PARNB8
               +  M68               * PARNB9
               +  M69               * PARNB10
               +  M70_74            * PARNB11
               +  M75_79            * PARNB12
               +  M80_84            * PARNB13
               +  M85_89            * PARNB14
               +  M90_94            * PARNB15
               +  M95_GT            * PARNB16
               +  W0_34             * PARNB17
               +  W35_44            * PARNB18
               +  W45_54            * PARNB19
               +  W55_59            * PARNB20
               +  W60_64            * PARNB21
               +  W65               * PARNB22
               +  W66               * PARNB23
               +  W67               * PARNB24
               +  W68               * PARNB25
               +  W69               * PARNB26
               +  W70_74            * PARNB27
               +  W75_79            * PARNB28
               +  W80_84            * PARNB29
               +  W85_89            * PARNB30
               +  W90_94            * PARNB31
               +  W95_GT            * PARNB32
               +  M0_34*MCAID       * PARNB33
               +  M35_44*MCAID      * PARNB34
               +  M45_54*MCAID      * PARNB35
               +  M55_59*MCAID      * PARNB36
               +  M60_64*MCAID      * PARNB37
               +  M65   *MCAID      * PARNB38
               +  M66   *MCAID      * PARNB39
               +  M67   *MCAID      * PARNB40
               +  M68   *MCAID      * PARNB41
               +  M69   *MCAID      * PARNB42
               +  M70_74*MCAID      * PARNB43
               +  M75_79*MCAID      * PARNB44
               +  M80_84*MCAID      * PARNB45
               +  M85_89*MCAID      * PARNB46
               +  M90_94*MCAID      * PARNB47
               +  M95_GT*MCAID      * PARNB48
               +  W0_34*MCAID       * PARNB49
               +  W35_44*MCAID      * PARNB50
               +  W45_54*MCAID      * PARNB51
               +  W55_59*MCAID      * PARNB52
               +  W60_64*MCAID      * PARNB53
               +  W65   *MCAID      * PARNB54
               +  W66   *MCAID      * PARNB55
               +  W67   *MCAID      * PARNB56
               +  W68   *MCAID      * PARNB57
               +  W69   *MCAID      * PARNB58
               +  W70_74*MCAID      * PARNB59
               +  W75_79*MCAID      * PARNB60
               +  W80_84*MCAID      * PARNB61
               +  W85_89*MCAID      * PARNB62
               +  W90_94*MCAID      * PARNB63
               +  W95_GT*MCAID      * PARNB64;

     RSKSCORB = ROUND(RSKSCORB,.001);
     PREDEXPB = ROUND((RSKSCORB * 5100),.01);
     MPRDEXPB = ROUND((PREDEXPB / 12),.01);

     IF NOT NEWENROL THEN
        RSKSCORA  = ROUND(RSKSCORB*(1-MSP*(1-&WAM)),.001);
     ELSE
        RSKSCORA  = ROUND(RSKSCORB*(1-MSP*(1-&WAM_NE)),.001);
     PREDEXPA = ROUND((RSKSCORA * 5100),.01);
     MPRDEXPA = ROUND((PREDEXPA / 12),.01);

   * adjust predicted risk score when CHF status is TRUE;

   IF PIPDCG <= 11 AND NOT NEWENROL AND
     ((CHFYEAR3 = '1' AND CHFYEAR4 = '0') OR
      (CHFYEAR3 = '0' AND CHFYEAR4 = '1') OR
      (CHFYEAR3 = '1' AND CHFYEAR4 = '1')) THEN DO;
     CHFRSKSC =  M0_34             * PAREST1
              +  M35_44            * PAREST2
              +  M45_54            * PAREST3
              +  M55_59            * PAREST4
              +  M60_64            * PAREST5
              +  M65_69            * PAREST6
              +  M70_74            * PAREST7
              +  M75_79            * PAREST8
              +  M80_84            * PAREST9
              +  M85_89            * PAREST10
              +  M90_94            * PAREST11
              +  M95_GT            * PAREST12
              +  W0_34             * PAREST13
              +  W35_44            * PAREST14
              +  W45_54            * PAREST15
              +  W55_59            * PAREST16
              +  W60_64            * PAREST17
              +  W65_69            * PAREST18
              +  W70_74            * PAREST19
              +  W75_79            * PAREST20
              +  W80_84            * PAREST21
              +  W85_89            * PAREST22
              +  W90_94            * PAREST23
              +  W95_GT            * PAREST24
              +                      PAREST34 * (.66)
              +   M0_34 *MCAID     * PAREST41
              +   M35_44*MCAID     * PAREST42
              +   M45_54*MCAID     * PAREST43
              +   M55_59*MCAID     * PAREST44
              +   M60_64*MCAID     * PAREST45
              +   M65_69*MCAID     * PAREST46
              +   M70_74*MCAID     * PAREST47
              +   M75_79*MCAID     * PAREST48
              +   M80_84*MCAID     * PAREST49
              +   M85_89*MCAID     * PAREST50
              +   M90_94*MCAID     * PAREST51
              +   M95_GT*MCAID     * PAREST52
              +   W0_34 *MCAID     * PAREST53
              +   W35_44*MCAID     * PAREST54
              +   W45_54*MCAID     * PAREST55
              +   W55_59*MCAID     * PAREST56
              +   W60_64*MCAID     * PAREST57
              +   W65_69*MCAID     * PAREST58
              +   W70_74*MCAID     * PAREST59
              +   W75_79*MCAID     * PAREST60
              +   W80_84*MCAID     * PAREST61
              +   W85_89*MCAID     * PAREST62
              +   W90_94*MCAID     * PAREST63
              +   W95_GT*MCAID     * PAREST64
              +   M65_69*EVERDISM  * PAREST65
              +   M70_74*EVERDISM  * PAREST66
              +   M75_79*EVERDISM  * PAREST67
              +   M80_84*EVERDISM  * PAREST68
              +   M85_89*EVERDISM  * PAREST69
              +   M90_94*EVERDISM  * PAREST70
              +   M95_GT*EVERDISM  * PAREST71
              +   W65_69*EVERDISM  * PAREST72
              +   W70_74*EVERDISM  * PAREST73
              +   W75_79*EVERDISM  * PAREST74
              +   W80_84*EVERDISM  * PAREST75
              +   W85_89*EVERDISM  * PAREST76
              +   W90_94*EVERDISM  * PAREST77
              +   W95_GT*EVERDISM  * PAREST78 ;

     CHFRSKSC  = ROUND(CHFRSKSC,.001);
   END;
   ELSE CHFRSKSC = RSKSCORB;

   PREDEXPC = ROUND((CHFRSKSC * 5100),.01);
   MPRDEXPC = ROUND((PREDEXPC / 12),.01);

     LABEL IDNO = 'The person"s ID number'
            AGE = 'Age in years on First month of YEAR2'
            SEX  = 'Sex: 1-Male, 2-Female'
            DOB  = 'Date of birth (YYYYMMDD)'
            OREC = 'Original reason for Medicare entitlement'
            MCAID= 'Medicaid status'
            MSP  = 'Working aged status'
            EVERDISM = 'Ever disabled status'
            NEWENROL = '1 for new enrollee, 0 otherwise'
            PIPDCG = 'Principal Inpat. Diagnostic Cost Group'
            PREDEXPB = 'Annualized base pred. expend. in 1996 $'
            PREDEXPA = 'Pred. expend. adjusted for working aged'
            MPRDEXPB = 'Monthly base predicted expenditures'
            MPRDEXPA = 'Monthly pred. exp. adjusted for w.aged'
            RSKSCORB = 'Base relative risk score'
            RSKSCORA = 'Relative risk score adjusted for w.aged'
            CHFYEAR3 = 'CHF PIP diagnosis 7/01/99 - 6/30/00'
            CHFYEAR4 = 'CHF PIP diagnosis 7/01/00 - 6/30/01'
            CHFRSKSC = 'CHF adjusted risk score'
            PREDEXPC = 'Pred. expend. adjusted for CHF'
            MPRDEXPC = 'Monthly pred. exp. adjusted for CHF'
     ;
RUN;
PROC CONTENTS DATA=OUT.OUTPUT;
     TITLE '*** OUTPUT FILE ***';
RUN;

**********************************************************************
* STEP5: print summary of program parameters                         *
**********************************************************************;

 DATA TEMPPR;
      INFORMAT DESC $80.   PARAM $6.;

      PARAM="&YEAR2";
      DESC='Year for which expenditures are predicted = '!!PARAM;
      OUTPUT;
      PARAM="&YR2MONTH";
      DESC='First month of Year2 = '!!PARAM;
      OUTPUT;
      PARAM="&WAM";
      DESC='Working aged multiplier for continuing enrollees= '!!PARAM;
      OUTPUT;
      PARAM="&WAM_NE";
      DESC='Working aged multiplier for new enrollees = '!!PARAM;
      OUTPUT;
      IF &PIPADJ THEN PARAM= 'yes'; ELSE PARAM='no';
      DESC='HER data edits used = '!!PARAM;
      OUTPUT;
      IF &LOS01 THEN PARAM='yes'; ELSE PARAM='no';
      DESC='Short stay diagnoses included = '!!PARAM;
      OUTPUT;
      PARAM="&MAXDIAG";
      DESC='Maximum number of diagnoses on an inpatient record = '
      !!PARAM;
      OUTPUT;

      IF &FAGESEX THEN PARAM='yes'; ELSE PARAM='no';
      DESC='Output 34 fractional age/sex variables = '!!PARAM;
      OUTPUT;
 RUN;

 PROC PRINT NOOBS label DATA=TEMPPR SPLIT='*';
      VAR DESC ;
	  TITLE1 'Summary of Program Parameters';
      TITLE2 '-----------------------------';
      LABEL desc='';
 RUN;