****************************************************************************************************
*                                           PROGRAM OVERVIEW
****************************************************************************************************
*
* PROGRAM: ms_cci_elix.sas  
*
* Created (mm/dd/yyyy): 11/17/2014
*
*--------------------------------------------------------------------------------------------------
* PURPOSE:
*   This macro will compute 1 measure of CCI/Elixhauser per unique member-index_dt combination                                       
*   
*  Program inputs:                                                                                   
*     - 4 datasets:                                                                              
*       - One dataset containing PatId and reference date.                                       
*       - A procedure claims table.                                                              
*       - A diagnosis claims table                                                               
*       - A Combinded Comorbidity Score (CCS) lookup table.                                      
*  Program outputs:                                                                                  
*     -SAS data file (.SAS7BDAT) of all relevant claims found based on the CCS lookup table      
*     -SAS data file (.SAS7BDAT) with Combined Comorbidity Scores for all patient-index_dt       
*        combinations in the input dataset                                                         
*                    
*  PARAMETERS:                                                                       
*     COMORBFROM 	= Start of window (relative to index date) to define the lookup period     
*     COMORBTO 		= End of window (relative to index date) to define the lookup period    
*     INFILE    	= The name of the SAS file containing the Patient ID and reference date to compute the  
*                 	  Combined Comorbidity Score                                                            
*     PATID     	= The name of the variable in the INFILE dataset containing the Patient ID              
*     INDEXDT  	 	= The name of the variable containing the reference date                                
*     PREOUTFILE	= Name of the output dataset with only the neccesary data to compute the Combined       
*                 	  Comorbidity Score                                                                     
*     DIAGFILE  	= Name of the file containing the diagnoses                                             
*     DX_DT_VAR 	= Name of the date variable in the diagnosis dataset (DIAGFILE)                         
*     DX_CODETYP	= Name of codetype variable in the diagnosis dataset (DIAGFILE)                         
*     DX_CODE   	= Name of code variable in the diagnosis dataset (DIAGFILE)                             
*     PROCFILE  	= Name of the file containing the procedures                                            
*     PX_DT_VAR 	= Name of the date variable in the procedure dataset (PROCFILE)                         
*     PX_CODETYP	= Name of codetype variable in the procedure dataset (PROCFILE)                         
*     PX_CODE   	= Name of code variable in the procedure dataset (PROCFILE)                             
*     INDEX_LOOKUP 	= Name of Combined Comorbidity Score Lookup table.  It must contain the following       
*                 	  variables: code, codetype, code_grp, group, weight, wildcard                          
*     OUTFILE   	= The final formatted SAS dataset,                                                      
*     INDEXGROUPCAT	= The grouping categories that the user wishes to apply.  Groups need to be separate    
*                 	  by a space, use "low-" if the first group is open ended, and use "+" if the last     
*                 	  group is open ended                                                                               
*     KEEPALLDUM	= set equal to 1 if the user wants to keep all individual Combined Comorbidity Score    
*                 	  dummies (P and I) in the final file                                                   
*                                                                                                  
*  Programming Notes:                                                                                
*         -The input file must contain a PatId and a reference date.                               
*         -Eligibility criteria are assumed to have been satisfied (i.e., that patients are          
*          eligible for medical benefits in the PREINDEXFROM-PREINDEXTO interval and 
*		   the INDEXFROM-INDEXTO interval.
*
*--------------------------------------------------------------------------------------------------
* CONTACT INFO: 
*  Sentinel Coordinating Center
*  info@sentinelsystem.org
*
***************************************************************************************************;

%macro ms_cci_elix(COMORBFROM=,
                   COMORBTO=, 
                   INFILE=, 
                   PATID=,
                   INDEXDT=, 
                   PREOUTFILE=,
                   DIAGFILE=,
                   DX_DT_VAR=,
                   DX_CODETYP=,
                   DX_CODE=,
                   PROCFILE=, 
                   PX_DT_VAR=,
                   PX_CODETYP=,
                   PX_CODE=,
                   INDEX_LOOKUP=, 
                   OUTFILE=,
                   INDEXGROUPCAT=,
                   KEEPALLDUM=);  


	%put =====> MACRO CALLED: ms_cci_elix;

	/*****************************************/
	/* Determine if PROC and DIAG codes      */
	/* exist in the lookup table.  Make sure */
	/* weight exists for every entry. Make   */
	/* sure every entry in a group has same  */
	/* weight.  Make sure code is populated  */
	/* and check to make sure lookup exists  */
	/*****************************************/

	%let diag_check = 0 ;
	%let proc_check = 0 ;
	%let wgt_check = 0 ;
	%let same_wgt_check = 0 ;
	%let code_check = 0 ;

	/* Only run if lookup table exists  */
	%if %sysfunc(exist(&INDEX_LOOKUP.)) %then %do ;
	  data _null_ ;
	    set &INDEX_LOOKUP. ;
	  
	    IF (UPCASE(code_grp) eq 'DIAG') AND (&diag_check. eq 0) THEN call symput('diag_check',trim(put(1, best1.))) ;
	    IF (UPCASE(code_grp) eq 'PROC') AND (&proc_check. eq 0) THEN call symput('proc_check',trim(put(1, best1.))) ;

	    IF (missing(weight)) AND (&wgt_check. eq 0) THEN call symput('wgt_check',trim(put(1, best1.))) ;

	    IF (missing(code)) AND (&code_check. eq 0) THEN call symput('code_check', trim(put(1, best1.))) ;
	  run ;

	  %put &=diag_check. ;
	  %put &=proc_check. ;
	  %put &=wgt_check. ;
	  %put &=code_check. ;
	%end ;
	%else %do ;
	  %put ERROR: (Sentinel) Lookup dataset does not exist ;
	  %abort;
	%end;

	/* Check to make sure there is at least one diag or proc code in lookup */
	%if ^&diag_check. AND ^&proc_check. %then %do;
	  %put ERROR: (Sentinel) No diagnosis or procedure codes in lookup table ;
	  %abort;
	%end;
	  
	/* Check to make sure there are no missing weights in lookup table */
	%if &wgt_check. %then %do;
	  %put ERROR: (Sentinel) At least one row with missing weight in lookup table ;
	  %abort;
	%end;
	  
	/* Check to make sure codes are populated on every row of lookup table */
	%if &code_check. %then %do;
	  %put ERROR: (Sentinel) At least one row with missing code in lookup table ;
	  %abort;
	%end;

	proc summary missing nway data = &INDEX_LOOKUP. ;
	class group weight ;
	output out = tmp_lookup (drop = _:) ;
	run;

	proc summary missing nway data = tmp_lookup ;
	class group ;
	output out = tmp_lookup_summ (drop = _type_ rename = (_freq_ = num_wgts)) ;
	run;

	data _null_ ;
	  set tmp_lookup_summ ;
	  IF (num_wgts > 1) AND (&same_wgt_check. eq 0) THEN call symput('same_wgt_check',trim(put(1, best1.))) ;
	run ; 

	%put &=same_wgt_check. ;
	  
	/* Check to make sure there are not multiple weights for a group */
	%if &same_wgt_check. %then %do;
	  %put ERROR: (Sentinel) At least one group with multiple weights in lookup table ;
	  %abort;
	%end;


	/*****************************************/
	/* If DIAG codes exist in lookup table   */
	/* pull all claims of with a code of     */
	/* interest for index patients. Blow out */
	/* codes with wildcards.                 */
	/*****************************************/

	%if &diag_check. %then %do ;

	  proc contents noprint data = &DIAGFILE. out = diag_contents ;
	  run ;

	  proc sql NOPRINT ;

	    select length into :diag_len
	    from diag_contents 
	    where UPCASE(name) eq %UPCASE("&dx_code.") ;

	  quit ;
	  
	  %let diag_len = %CMPRES(&diag_len.) ;

	  data cci_diag_lookup ;
	    set &INDEX_LOOKUP. ;
	    where (UPCASE(code_grp) eq 'DIAG') ;

	    length code2 $&diag_len. ;

	    code2 = code ;
	    output ;

		if missing(wildcard) then wildcard = 'N' ;

	  	IF (UPCASE(wildcard) eq 'Y') THEN DO ;
	      IF (length(code) eq 4) THEN DO ;
	        DO i = 0 TO 9 ;
	          code2 = compress(code||STRIP(PUT(i, 8.))) ;
	          output ;
	        END ;
	  	  END ;
	  	  ELSE IF (length(code) eq 3) THEN DO ;
	  	    DO i = 0 TO 9 ;
	          code2 = compress(code||STRIP(PUT(i, 8.))) ;
	          output ;
	  	      DO j = 0 TO 9 ;
	  	  	    code2 = compress(code||STRIP(PUT(i, 8.))||STRIP(PUT(j, 8.))) ;
	            output ;
	          END ;
	        END ;
	  	  END ;
	    END ;
	  	drop wildcard code i j ;
	    rename codetype = &dx_codetyp.
	           code2 = code ;
	  run ;

	  data cci_diag_temp (keep=&PATID. &INDEXDT. &dx_dt_var. &dx_code. &dx_codetyp. group weight IDXPRI 
	                      rename = (&dx_dt_var. = adate &dx_code. = code &dx_codetyp. = codetype)) ;
	    IF 0 THEN set &INFILE. ;
	    declare hash ht (hashexp:16, dataset:"&INFILE.", MULTIDATA: "Y") ;
	    ht.definekey("&PATID.") ;
	    ht.definedata(ALL: 'YES') ;
	    ht.definedone() ;

	    IF 0 THEN set cci_diag_lookup ;
	    declare hash cci (hashexp:16, dataset:"cci_diag_lookup", MULTIDATA: "Y") ;
	    cci.definekey("&dx_codetyp.", "code") ;
	    cci.definedata(ALL: 'YES') ;
	    cci.definedone() ;
	    
	    DO UNTIL(eof1);
	    retain &PATID.;
	      set &DIAGFILE.(keep=&PATID. &dx_dt_var. &dx_code. &dx_codetyp.) end=eof1 ;

	      length code $&diag_len. ;
	      code = compress(&dx_code.,'.') ;

	      do rc = cci.find() by 0 while (rc=0);
	        IF ht.find()=0 THEN DO ;
	          format IDXPRI $1. ;
	          IDXPRI='' ;
		          IF &INDEXDT.+&COMORBFROM. <= &dx_dt_var. <= &INDEXDT.+&COMORBTO.  THEN IDXPRI='P' ;  
	          IF IDXPRI ne '' THEN output ;
	        END ;

	        ht.has_next(RESULT: anotherCode) ; 
	        DO WHILE(anotherCode) ;
	          IF ht.find_next()=0 THEN DO ;
	            format IDXPRI $1. ;
	            IDXPRI='' ;
		          IF &INDEXDT.+&COMORBFROM. <= &dx_dt_var. <= &INDEXDT.+&COMORBTO.  THEN IDXPRI='P' ;  
	            IF IDXPRI ne '' THEN output ;
	          END ; 
	          ht.has_next(RESULT: anotherCode) ; 
	        END ;
		    rc=cci.find_next();
	      END ;
	    END ;
	    stop ;
	  run ;
	  
	%end ;

	/*****************************************/
	/* If PROC codes exist in lookup table   */
	/* pull all claims of with a code of     */
	/* interest for index patients.          */
	/*****************************************/

	%IF &proc_check. %THEN %DO ;

	  data cci_proc_lookup ;
	    set &INDEX_LOOKUP. ;
	    where (UPCASE(code_grp) eq 'PROC') ;
	    
	    rename codetype = &px_codetyp. ;
	  run ;


	  proc contents noprint data = &PROCFILE. out = proc_contents ;
	  run ;

	  proc sql NOPRINT ;
	    select length into :proc_len
	    from proc_contents 
	    where UPCASE(name) eq %UPCASE("&px_code.") ;
	  quit ;
	  
	  %let proc_len = %CMPRES(&proc_len.) ;


	  data cci_proc_temp (keep=&PATID. &INDEXDT. &px_dt_var. &px_code. &px_codetyp. group weight IDXPRI 
	                      rename = (&px_dt_var. = adate &px_code. = code &px_codetyp. = codetype));
	    IF 0 THEN set &INFILE. ;
	    declare hash ht (hashexp:16, dataset:"&INFILE.", MULTIDATA: "Y") ;
	    ht.definekey("&PATID.") ;
	    ht.definedata(ALL: 'YES') ;
	    ht.definedone() ;

	    IF 0 THEN set cci_proc_lookup ;
	    declare hash cci (hashexp:16, dataset:"cci_proc_lookup", MULTIDATA: "Y") ;
	    cci.definekey("&px_codetyp.", "code") ;
	    cci.definedata(ALL: 'YES') ;
	    cci.definedone() ;
	    
	    DO UNTIL(eof1);
	    retain &PATID.;
	      set &PROCFILE.(keep=&PATID. &px_dt_var. &px_code. &px_codetyp.) end=eof1 ;

	      length code $&proc_len. ;
	      code = compress(&px_code.,'.') ;
	      do rc = cci.find() by 0 while (rc=0);
	        IF ht.find()=0 THEN DO ;
	          format IDXPRI $1. ;
	          IDXPRI='' ;
		          IF &INDEXDT.+&COMORBFROM. <= &px_dt_var. <= &INDEXDT.+&COMORBTO.  THEN IDXPRI='P' ;  
	          IF IDXPRI ne '' THEN output ;
	        END;

	        ht.has_next(RESULT: anotherCode) ; 
	        DO WHILE(anotherCode) ;
	  	      IF ht.find_next()=0 THEN DO ;
	            format IDXPRI $1. ;
	            IDXPRI='' ;
		          IF &INDEXDT.+&COMORBFROM. <= &px_dt_var. <= &INDEXDT.+&COMORBTO.  THEN IDXPRI='P' ;  
	            IF IDXPRI ne '' THEN output ;
	          END ; 
	          ht.has_next(RESULT: anotherCode) ; 
	  	    END ;
			rc=cci.find_next();
	      END ;
	    END ;
	    stop ;
	  run ;

	%end ;



	/*****************************************/
	/* Stack proc and diag datasets to get   */
	/* final analytic data set needed for    */
	/* score creation.                       */
	/*****************************************/


	data &PREOUTFILE. ;
	  set %IF &diag_check. %THEN %DO ; cci_diag_temp %END ;
	      %IF &proc_check. %THEN %DO ; cci_proc_temp %END ;
	      ;
	run ;

	proc sort data = &PREOUTFILE. nodupkey ;
	by &PATID. &INDEXDT. ADate CodeType Code group weight IDXPRI;
	run;

	/******************************************/
	/* Generate CCS for all patient-index_dt  */
	/* combinations                           */   
	/******************************************/

	** Determine number of groups first  ** ;
	proc sql noprint ;

	  select COUNT(DISTINCT group) into :NUM_GRPS
	  from &INDEX_LOOKUP. ;

	quit ;

	%let NUM_GRPS = %CMPRES(&NUM_GRPS.) ;


	DATA dsout ;
	  RETAIN CVPRIO01-CVPRIO&NUM_GRPS.; 
	  LENGTH DEFAULT=3 ;
	  SET &PREOUTFILE. ;
	  BY &PATID. &INDEXDT. ;
	    
	  /* Flag arrays */
	  ARRAY CLPRIO (&NUM_GRPS.) CVPRIO01-CVPRIO&NUM_GRPS. ;
	           
	  /* Initialization */
	  IF FIRST.&INDEXDT. THEN DO ;
	    DO M=1 TO &NUM_GRPS. ;
	      CLPRIO(M)=0 ;
	    END ;
	  END ;

	  /* Populate Flags  */
	  i = input(GROUP, 5.) ; 
	  IF (CLPRIO(i) eq 0 AND IDXPRI = 'P') THEN CLPRIO(i)= WEIGHT ;


	  IF LAST.&INDEXDT. THEN DO ;
	    /* CALCULATE THE COEFFICIENT FOR COMBINED SCORES */
	    COMBINED_SCORE_NUM = sum(OF CVPRIO01-CVPRIO&NUM_GRPS.) ;
	    OUTPUT ;
	  END ;

	  KEEP &PATID. &INDEXDT. COMBINED_SCORE_NUM CVPRIO01-CVPRIO&NUM_GRPS. ;
	run; 


	/*****************************************/
	/* Merge back with all patient-index_dts */
	/* and group comorbidities for final     */
	/* output dataset.                       */
	/*****************************************/

	  %let ALLVAR= ;
	  data _null_ ;
	    format FMTSTR $300. ;
	    IF &KEEPALLDUM.=1 THEN call symput("ALLVAR","_ALL_") ;
	    numgrp = countw("&INDEXGROUPCAT.", " ") ; 
	    IF (numgrp eq 0) or ("&INDEXGROUPCAT." eq "low+") THEN FMTSTR='low-high = "ALL"' ;
	    ELSE DO i=1 TO numgrp ;
	      word=tranwrd(scan("&INDEXGROUPCAT.",i,' '), "+", "-high")||' = "'|| tranwrd(scan("&INDEXGROUPCAT.",i,' '), "low-", "<=")||'" ' ;
	      FMTSTR=strip(FMTSTR)||" "||trim(left(word)) ;
	      output ;
	    END ;

	    call symput("FMTSTR",FMTSTR) ;
	  run ;
	  %put &=FMTSTR. ;

	  PROC FORMAT ;
	    VALUE CCIGRP &FMTSTR. ;
	  run ;
	  
	  PROC SORT data = &INFILE. out = ccs_infile_sort ;
	  BY &PATID. &INDEXDT. ;
	  run ;

	data &OUTFILE.;
	retain &PATID. &INDEXDT. ccielixgrp COMBINED_SCORE_NUM ;
	format COMBINED_SCORE_NUM  best. ; 
	merge ccs_infile_sort (in=a keep=&PATID. &INDEXDT.) 
	      dsout (in = b) ;
	by &PATID. &INDEXDT. ; 
	if a ;

	%IF (&KEEPALLDUM.=1) %THEN %DO ;

	  ARRAY CLPRIO (&NUM_GRPS.) CVPRIO01-CVPRIO&NUM_GRPS. ;
	       
	  IF ^b THEN DO ;
	    DO M=1 TO &NUM_GRPS. ;
	      CLPRIO(M)=0 ;
	    END ;
	  END ;
	  
	%END ;

	IF ^b THEN DO ;
	  COMBINED_SCORE_NUM=0 ;
	END ;

    format &groupvar. $40.;
    &groupvar.="&ITGROUP."; 

	ccielixgrp=put(COMBINED_SCORE_NUM, CCIGRP.) ;
	label ccielixgrp='Combined comorbidity score' ;
	label COMBINED_SCORE_NUM='Combined comorbidity raw score' ;
	keep &ALLVAR. &PATID. &INDEXDT. &groupvar. ccielixgrp COMBINED_SCORE_NUM ;
	run ;

	proc datasets library=work nolist nowarn;
        delete Dsout Cci_diag_temp Cci_diag_lookup Ccs_infile_sort Diag_contents Tmp_lookup Tmp_lookup_summ;
    quit;

	%put NOTE: ********END OF MACRO: ms_cci_elix ********;

%mend ms_cci_elix ;