/** multi100.mac.sas - modified original macro code on
Aug 2012 by K.Spritzer to accept > 99 items      **/

**********************************************;
options nonumber NOCENTER ls=182
        MPRINT MTRACE SYMBOLGEN NONUMBER NODATE MISSING=' ';
**********************************************;

**********************************************;
%MACRO ALPHA;
******************************************************************;
*  Hays, R. D. & Wang, E.  (1992, April).  Multitrait
*    Scaling Program:  MULTI.  Proceedings of the Seventeenth
*    Annual SAS Users Group International Conference, 1151-1156.
******************************************************************;
PROC CORR DATA=ALPHA1 NOPRINT NOMISS COV OUTP=CORROUT;
VAR
&&ITEMS&i          ;
TITLE1 'ALPHA INTERNAL CONSISTENCY RELIABILITY';
TITLE2 " &&nscal&i" ;
RUN;
**********************************************;
DATA ALPHA;
SET CORROUT;
**********************************************;
ARRAY STOT (I)
&&ITEMS&i        ;
**********************************************;
RETAIN TOT SDTOT VAR SDSUM;
**********************************************;
KK=&&nit&i;
**********************************************;
IF _N_=1 THEN DO;
TOT=0;SDTOT=0;VAR=0;SDSUM=0;
END;
**********************************************;
IF _N_<=KK THEN DO;
DO I=1 TO KK;
  TOT=STOT+TOT;
  IF I=_N_ THEN VAR=STOT+VAR;
  END;
END;
**********************************************;
IF _N_=(KK+2) THEN DO;
DO I=1 TO KK;
  SDSUM=STOT+SDSUM;
END;
END;
**********************************************;
IF _N_>(KK+3) THEN DO;
DO I=1 TO KK;
  SDTOT=STOT+SDTOT;
  END;
END;
**********************************************;
IF _N_=((2*KK)+3) THEN DO;
COV=TOT-VAR;
ALPHA=(KK*COV)/((KK-1)*TOT);
RII=COV/((KK-1)*VAR);
SCOV=SDTOT-KK;
SALPHA=(KK*SCOV)/((KK-1)*SDTOT);
SRII=SCOV/((KK-1)*KK);
SCOTT=COV/((SDSUM*SDSUM)-VAR);
OUTPUT;
END;
RENAME KK=K;
**********************************************;
PROC PRINT NOOBS;
VAR ALPHA SALPHA RII SRII SCOTT K;
RUN;
%MEND ALPHA;

*******************************************;
* saved as map.sas
*******************************************;
%MACRO MULTI(DATA=,
items1 =,
items2 =,
items3 =,
items4 =,
items5 =,
items6 =,
items7 =,
items8 =,
items9 =,
items10=,
items11=,
items12=,
items13=,
items14=,
items15=,
items16=,
items17=,
items18=,
items19=,
nit1=,NIT2=,NIT3=,NIT4=,NIT5=,
NIT6=,NIT7=,NIT8=,NIT9=,
NIT10=,NIT11=,NIT12=,
NIT13=,NIT14=,NIT15=,
NIT16=,NIT17=,NIT18=,
NIT19=,
nSCAL1 =,
nSCAL2 =,
nSCAL3 =,
nSCAL4 =,
nSCAL5 =,
nSCAL6 =,
nSCAL7 =,
nSCAL8 =,
nSCAL9 =,
nSCAL10=,
nSCAL11=,
nSCAL12=,
nSCAL13=,
nSCAL14=,
nSCAL15=,
nSCAL16=,
nSCAL17=,
nSCAL18=,
nSCAL19=,
NSCALES=,BOZO=);
*******************************************;
DATA ALPHA;
SET &DATA;
********************************;
count=0;
do i=1 to 19;
  n=symget('nit'||left(i));
  count=count + n ;
end;
call symput('k',left(put(count,3.)));  **ks changed 2. to 3.;
********************************;
%let scales=;
%do i=1 %to &nscales;
%let scales = &scales &&nscal&i ;
%end;
********************************;
********************************;
%let items =;
%do i=1 %to 19;
%let items  = &items  &&items&i ;
%end;

ARRAY NO (I) &ITEMS &SCALES;
KEEP=1;
DO OVER NO;
IF NO<=.Z THEN KEEP=0;
END;
*****************************************;
DATA ALPHA1;
SET ALPHA;
IF KEEP=1;
*****************************************;
PROC CORR DATA=ALPHA1 NOPRINT OUTP=CORROUT;
VAR
&ITEMS &SCALES;WITH &ITEMS;
RUN;
**********************************************;
DATA ALPHA;
SET CORROUT;
**********************************************;
ARRAY ITEMSD (II)  &ITEMS;
ARRAY ISD (II)    BOZO1-BOZO200;
ARRAY NIT(nscale) NITEM1-NITEM19;
ARRAY SCALESD  (I) S1-S19;
ARRAY CORSCALE (I) &SCALES;
RETAIN SCALESD ISD II WHERE NSCALE NCASES;
**********************************************;
array item{19} nitem1  nitem2  nitem3  nitem4  nitem5  nitem6  nitem7 nitem8
                nitem9  nitem10 nitem11 nitem12 nitem13 nitem14 nitem15
        nitem16 nitem17 nitem18 nitem19 ;
  do i=1 to 19;
  item{i}=symget('nit'||left(i));
  end;
**********************************************;
IF _N_=2 THEN DO I=1 TO &NSCALES;
SCALESD=CORSCALE;
END;
**********************************************;
IF _N_=2 THEN DO II=1 TO &K;
ISD=ITEMSD;
END;
**********************************************;
IF _N_=3 THEN DO II=1 TO 1;
NCASES=ITEMSD;
END;
**********************************************;
IF _N_=3 THEN II=1;
**********************************************;
IF _N_>3 THEN DO;
IF _N_=4 THEN NSCALE=1;
IF _N_=4 THEN WHERE=1;
IF WHERE<=NIT THEN WHERE=WHERE+1;
**********************************************;
DO I=1 TO &NSCALES;
IF I=NSCALE THEN DO;
DENO=(SCALESD*SCALESD+ISD*ISD)-(2*CORSCALE*SCALESD*ISD);
DENOM=sqrt(DENO);
CORSCAL=(CORSCALE*SCALESD)-ISD;
CORSCALE=CORSCAL/DENOM;
END;
END;
OUTPUT;
II=II+1;
IF WHERE=NIT+1 THEN DO;
  NSCALE=NSCALE+1;
  WHERE=1;
END;
END;
**********************************************;
PROC MEANS DATA=ALPHA NOPRINT;
VAR NCASES;
OUTPUT OUT=ONE MEAN=SAMPSIZE;
TITLE1 'MULTI -- MULTITRAIT SCALING PROGRAM';
TITLE2 'NUMBER OF CASES IN ANALYSIS';
RUN;
**********************************************;
DATA;
SET ONE(KEEP=SAMPSIZE);
SEOFCORR=1/SQRT(SAMPSIZE);
PROC PRINT NOOBS;RUN;
**********************************************;
data a;
length s1  s2  s3  s4  s5  s6  s7  s8  s9  s10
      s11 s12 s13 s14 s15 s16 s17 s18 s19 $ 1;
SET ALPHA(KEEP=_NAME_ &SCALES NITEM1-NITEM19 );

IF _N_<=&K;
RENAME _NAME_=ITEM;

*****************************************************;
array s{19} $ s1 s2  s3  s4  s5  s6  s7  s8  s9  s10
          s11 s12 s13 s14 s15 s16 s17 s18 s19;
array t{19} nitem1  nitem2  nitem3  nitem4  nitem5  nitem6  nitem7 nitem8
            nitem9  nitem10 nitem11 nitem12 nitem13 nitem14 nitem15
        nitem16 nitem17 nitem18 nitem19 ;
nt=0;
do i=1 to 19;
ot=nt;
nt=ot + t{i};
if ot<  _N_ <= nt then s{i}='*' ;
end;
*****************************************************;
%let put=@2 item $8. +2;
%do i=1 %to &nscales;
%let put= &put &&nscal&i 4.2  s&i $ 1. +4 ;
%end;

data _null_;
set a  end=endfile;
file print notitles header=hd;
put  &put;
RETURN;
hd:
put / @1 'MULTITRAIT MULTITEM CORRELATION MATRIX ' ;

PUT //
@2  'item '
@12  "&nscal1"
@21  "&nscal2"
@30  "&nscal3"
@39  "&nscal4"
@48  "&nscal5"
@57  "&nscal6"
@66  "&nscal7"
@75  "&nscal8"
@84  "&nscal9"
@93  "&nscal10"
@102 "&nscal11"
@111 "&nscal12"
@120 "&nscal13"
@129 "&nscal14"
@138 "&nscal15"
@147 "&nscal16"
@156 "&nscal17"
@165 "&nscal18"
@174 "&nscal19"
/ ;
PROC CORR DATA=ALPHA1 NOPRINT OUTP=CORROUT;
VAR
&SCALES;
RUN;
**********************************************;
DATA;
SET CORROUT(KEEP=_NAME_ &SCALES);
IF _N_>3;
RENAME _NAME_=SCALE;
TITLE 'INTERCORRELATIONS AMONG SCALES';
PROC PRINT;
RUN;
***************************************************************;
PROC MEANS DATA=ALPHA1 MAXDEC=2 FW=10;
VAR
&ITEMS &SCALES;
TITLE 'ITEM AND SCALE MEANS AND STANDARD DEVIATIONS';
RUN;
***************************************************************;
PROC UNIVARIATE DATA=ALPHA1 NOPRINT NORMAL;
VAR
&SCALES;
OUTPUT OUT=ONE SKEWNESS=&SCALES;
TITLE 'SKEWNESS OF SCALE SCORES (unbounded)';
RUN;
**********************************************;
DATA;
SET ONE;
PROC PRINT NOOBS;RUN;
**********************************************;
PROC UNIVARIATE DATA=ALPHA1 NOPRINT NORMAL;
VAR
&SCALES;
OUTPUT OUT=ONE KURTOSIS=&SCALES;
TITLE 'KURTOSIS OF SCALE SCORES (-2 --> +infinity)';
RUN;
**********************************************;
DATA;
SET ONE;
PROC PRINT NOOBS;RUN;
**********************************************;
PROC UNIVARIATE DATA=ALPHA1 NOPRINT NORMAL;
VAR
&SCALES;
OUTPUT OUT=ONE NORMAL=&SCALES;
TITLE1 'NORMALITY OF SCALE SCORES';
TITLE2 'Shapiro-Wilk statistic if n <= 2000';
TITLE3 'Kolomogorov D statistic if n > 2000';
RUN;
**********************************************;
DATA;
SET ONE;
PROC PRINT NOOBS;RUN;
**********************************************;
DATA;
SET ALPHA(KEEP=_NAME_ &ITEMS);
IF _N_<=&K;
RENAME _NAME_=ITEMS;
TITLE 'INTERCORRELATIONS AMONG ITEMS';
TITLE2 ' ';
TITLE3 ' ';
PROC PRINT;
%do i=1 %to &nscales;
%ALPHA;
%end;
***************************************************************;
%MEND MULTI;
***************************************************************;