*=================================================================;
*  Title:  APR_DRG - ASSIGN APR_DRG TO INPATIENT RECORDS
*
*  Description:;
*         ASSIGNS THE APR_DRG AND RISK OF MORTALITY SUBCLASS 
*         TO INPATIENT RECORDS;
*
*          >>>  VERSION 4.5, May 2013 <<<
*
*=================================================================;
 LIBNAME IN0 "C:\pathname";
 LIBNAME OUT0 "C:\pathname";
 FILENAME SASCBTBL "C:\pathname\SASCBTBL.DAT";

 %LET INFILE0 = SID_yyyy;
 %LET OUTFILE0 = APRDRG_yyyy;


 *** NOTE: 35 is the maximum number of diagnosis codes accepted by the grouper;
 %LET NDX = 35;
 %LET NPR = 30;
 %LET DXPOA = DXPOA1-DXPOA35;

 DATA OUT0.&OUTFILE0.
    (keep=KEY APR_DRG APRDRG_RISK_MORTALITY XPRDRG_RISK_MORTALITY GRC XRC);
 LENGTH codeYear codeQtr grpVersion dxCount dxWidth prCount prWidth ageYears ageDaysAdmit
        ageDaysDisch SEX dischStatus birthWgtOption birthWeight DMV 
        APR_DRG APRDRG_RISK_MORTALITY XPRDRG_RISK_MORTALITY SEVERTY 3 DXPOA1-DXPOA35 $1
        DXARRAY PXARRAY $176 PRARRAY $121 DX1-DX35 PX1-PX35 $5 PR1-PR30 $4 GRC XRC 4 APR $8;
 SET IN0.&INFILE0.
   (KEEP=KEY SEX AGE AGEDAY LOS DISP YEAR DQTR 
         DX1-DX&NDX. &DXPOA. PR1-PR&NPR.) nobs=last;

 * -------------------------------------------------------------- ;
 * --- CALCULATE PERCENT POA                            --------- ;
 * -------------------------------------------------------------- ;

 ARRAY ARRY1{35} DX1-DX35;
 ARRAY ARRY2{35} DXPOA1-DXPOA35;

 MAXDX = 0; ECDDX = 0; 
 PCTPOA = .; CNTPOA = 0; CNTNPOA = 0; NOPOA = 1;
 DO I = 1 TO 35;
    IF ARRY1(I) NOTIN (' ') THEN DO;
       MAXDX + 1;
       IF ARRY2(I) IN ('Y','W','E','1') THEN CNTPOA + 1;
       ELSE IF ARRY2(I) IN ('N','U','0') THEN CNTNPOA + 1;
       IF SUBSTR(ARRY1(I),1,1) IN ('E') THEN ECDDX = 1; 
    END;
 END;
 IF CNTPOA > 0 OR CNTNPOA > 0 THEN DO;
    NOPOA = 0;
    PCTPOA = CNTPOA / MAXDX;
 END;

 ARRAY ARRY3{35} PX1-PX35;

 IF NOPOA = 0 THEN DO;
    PX1 = DX1;
    DO I = 2 TO 35;
       IF ARRY2(I) IN ('N','U','0') THEN ARRY3(I) = "PPPPP"; 
       ELSE ARRY3(I) = ARRY1(I);
    END;
 END;

 retain APR ""; 


aprfilename ="C:\\pathname\\gapr.ctl";
umapfilename ="C:\\pathname\\umap.ctl";

 if _n_ = 1 then do;
    grc = modulen('*e','AprLimOpen',aprfilename,umapfilename,APR);
    put 'Return Code from Open ' grc;
 end;

 codeYear=YEAR;
 codeQtr=DQTR;

 if codeQtr notin (1,2,3,4) then delete;
 if (codeYear in (2013) and codeQtr in (1,2,3)) or
    (codeYear in (2012) and codeQtr in (4)) 
 then grpVersion=300;
 else
 if (codeYear in (2012) and codeQtr in (1,2,3)) or
    (codeYear in (2011) and codeQtr in (4)) 
 then grpVersion=290;
 else 
 if (codeYear in (2011) and codeQtr in (1,2,3)) or
    (codeYear in (2010) and codeQtr in (4)) 
 then grpVersion=280;
 else 
 if (codeYear in (2010) and codeQtr in (1,2,3)) or
    (codeYear in (2009) and codeQtr in (4)) 
 then grpVersion=270;
 else 
 if (codeYear in (2009) and codeQtr in (1,2,3)) or
    (codeYear in (2008) and codeQtr in (4)) 
 then grpVersion=260;
 else 
 if (codeYear in (2008) and codeQtr in (1,2,3)) or
    (codeYear in (2007) and codeQtr in (4)) 
 then grpVersion=250;
 else 
 if (codeYear in (2007) and codeQtr in (1,2,3)) or
    (codeYear in (2006) and codeQtr in (4)) 
 then grpVersion=240;
 else
 if (codeYear in (2006) and codeQtr in (1,2,3)) or
    (codeYear in (2005) and codeQtr in (4)) 
 then grpVersion=230;
 else grpVersion=200;
 dxCount=35;
 dxWidth=5;
 DXARRAY=DX1||DX2||DX3||DX4||DX5||DX6||DX7||DX8||DX9||DX10||
         DX11||DX12||DX13||DX14||DX15||DX16||DX17||DX18||DX19||DX20||
         DX21||DX22||DX23||DX24||DX25||DX26||DX27||DX28||DX29||DX30|| 
         DX31||DX32||DX33||DX34||DX35||'x'; 
 PXARRAY=PX1||PX2||PX3||PX4||PX5||PX6||PX7||PX8||PX9||PX10||
         PX11||PX12||PX13||PX14||PX15||PX16||PX17||PX18||PX19||PX20||
         PX21||PX22||PX23||PX24||PX25||PX26||PX27||PX28||PX29||PX30|| 
         PX31||PX32||PX33||PX34||PX35||'x'; 
 prCount=30;
 prWidth=4;
 PRARRAY=PR1||PR2||PR3||PR4||PR5||PR6||PR7||PR8||PR9||PR10||
         PR11||PR12||PR13||PR14||PR15||PR16||PR17||PR18||PR19||PR20||
         PR21||PR22||PR23||PR24||PR25||PR26||PR27||PR28||PR29||PR30||'x'; 
 ageYears=AGE;
 if ageYears<0 or ageYears>120 then ageYears=-1;
 ageDaysAdmit=AGEDAY;
 if ageDaysAdmit<0 or ageDaysAdmit>365 then ageDaysAdmit=-1;
 if ageDaysAdmit>-1 and LOS>=0 then ageDaysDisch=ageDaysAdmit+LOS;
 if ageDaysDisch<0 or ageDaysDisch>730 then ageDaysDisch=-1;
 if SEX not in (1,2) then SEX = -1;
 select(DISP);
 when (1) dischStatus= 1;
 when (2) dischStatus= 2;
 when (3) dischStatus= 3;
 when (4) dischStatus= 4;
 when (5) dischStatus= 5;
 when (6) dischStatus= 6;
 when (7) dischStatus= 7;
 when (20) dischStatus= 20;
 otherwise dischStatus= 99;
 end;
 birthWgtOption=5;
 birthWeight=-1;
 DMV=-1;
 APR_DRG=-1;
 SEVERTY=-1;
 APRDRG_RISK_MORTALITY=-1;
 XPRDRG_RISK_MORTALITY=-1;

 IF NOPOA = 0 THEN DO;
    xrc = modulen('*e','AprLimGroup',APR,codeYear,codeQtr,grpVersion,
    dxCount,dxWidth,PXARRAY,prCount,prWidth,PRARRAY,ageYears,ageDaysAdmit,ageDaysDisch,
    SEX,dischStatus,birthWgtOption,birthWeight,DMV,APR_DRG,SEVERTY,XPRDRG_RISK_MORTALITY);
 END;
 ELSE XPRDRG_RISK_MORTALITY=.;

 grc = modulen('*e','AprLimGroup',APR,codeYear,codeQtr,grpVersion,
 dxCount,dxWidth,DXARRAY,prCount,prWidth,PRARRAY,ageYears,ageDaysAdmit,ageDaysDisch,
 SEX,dischStatus,birthWgtOption,birthWeight,DMV,APR_DRG,SEVERTY,APRDRG_RISK_MORTALITY);

 if _n_ = last then call module('*/','AprLimClose',APR);

 run;

 proc freq data=OUT0.&OUTFILE0.;
 tables GRC XRC / missing;
 tables APRDRG_RISK_MORTALITY * XPRDRG_RISK_MORTALITY / missing;
 run;

 PROC SORT DATA=IN0.&INFILE0.;
 BY KEY;
 RUN;

 PROC SORT DATA=OUT0.&OUTFILE0. NODUPKEY;
 BY KEY;
 RUN;

 DATA IN0.&INFILE0.;
 MERGE IN0.&INFILE0.(IN=X)
       OUT0.&OUTFILE0.;
 BY KEY;

 IF X;

 RUN;


