DIXC ;SFISC/GFT-DESCRIPTIVE STATS, CORRELATION MATRIX ;11:36 AM 12 Jul 1999; [ 04/02/2003 8:25 AM ]
;;22.0;VA FileMan;**1001**;APR 1, 2003
;;22.0;VA FileMan;**2**;Mar 30, 1999
;Per VHA Directive 10-93-142, this routine should not be modified.
D N SZ,SZT,DJ,DN,DHDR,DS
D DESC G DESCX
;
C D CORR G CORRX
;
SQR S Y=0 Q:X'>0 S Y=1+X/2
L S T=Y,Y=X/T+T/2 G L:Y<T
K T Q
;
DLCOR S DJ=IO(0),U="^",SZ=0
F SZT=1:1 S:$D(^DOSV(0,DJ,"CP",SZT)) SZ=SZT Q:'$D(^DOSV(0,DJ,0,SZT,"S")) Q:'$D(^DOSV(0,DJ,"F",SZT)) S DN(SZT)=$E($P(^(SZT),U,3),1,8)
S SZT=SZT-1 Q
;
DESC ;CALCULATE THE DESCRIPTIVE STATISTICS
D DLCOR K DS F I=1:1:SZT I $D(^DOSV(0,DJ,0,I,"Q")) S X=^("Q")-((^("S")*^("S"))/^("N"))/(^("N")) D SQR S ^("D")=Y
Q
;
DESCX ;PRINT DESCRIPTIVE STATS
K DHDR S DHDR="77CUST",DHDR(1)="DESCRIPTIVE STATISTICS" D DHDR^DIX G Q:POP,QUE:$D(IO("Q"))
D1 D:SZT G KL:'$D(^DOSV(0,DJ,1))&'$D(^(2))&'$D(^(3)) D STATS^DIG($NA(^DOSV(0,DJ))) Q
.W !!,?13,"N OF",?39,"STANDARD"
.W !,?13,"CASES",?25,"MEAN",?39,"DEVIATION",?54,"MINIMUM",?69,"MAXIMUM"
.F I=1:1:SZT D
..W !,DN(I),?10
..I $D(^DOSV(0,DJ,0,I,"N")) W $J(^("N"),6) W:^("N") $J(^("S")/^("N"),15,4)
..F X="D","L","H" W $S($D(^(X)):$J(^(X),15,4),1:$J("",15))
.D EOP^DIG Q
;
CORR ;CALCULATE THE CORRELATION MATRIX
K ^UTILITY($J),ERR I $O(^DOSV(0,IO(0),1))'>0 W !!,"***** AT LEAST TWO VARIABLES MUST BE DEFINED *****" S ERR=1 Q
D DLCOR ;F I=1:1:SZ I ^DOSV(0,IO(0),"BY",I,"H")=^("L") W $C(7),!,"CAN'T COMPUTE CORRELATION MATRIX--",DN(I+100)," IS SINGLE-VALUED" S ERR=1 G KL
F I=2:1:SZ S N=^DOSV(0,DJ,0,I,"N"),S=^("S"),C=^DOSV(0,DJ,"CP",I,I) F J=1:1:I-1 I $D(^DOSV(0,DJ,"CP",I,J)) D C1
G KL
C1 S X=N*C-(S*S)*(N*^DOSV(0,DJ,"CP",J,J))-(^DOSV(0,DJ,0,J,"S")*^("S"))
D SQR S (^UTILITY($J,J,I),^UTILITY($J,I,J))=(N*^DOSV(0,DJ,"CP",I,J))-(S*^DOSV(0,DJ,0,J,"S"))/Y
Q
CORRX ;OUTPUT THE CORRELATION MATRIX
G:$D(ERR) KL K DHDR S DHDR="72TSU",DHDR(1)="CORRELATION MATRIX",DHDR(2)="" D DHDR^DIX G Q:POP
F I=1:1:SZ S ^UTILITY($J,I,I)=1 I $D(^UTILITY($J,I,I)) W ?I*10-2,$J(DN(I),10)
F I=1:1:SZ I $D(^UTILITY($J,I,I)) W !,DN(I) F J=1:1:I I $D(^UTILITY($J,I,J)) W ?J*10,$J(^UTILITY($J,I,J),8,4)
W !!
KL W:$E(IOST)'="C"&($Y) @IOF I IO(0)'=IO D CLOSE^DIO4
Q U IO(0) K C,DHDR,I,II,J,JJ,N,POP,S,X,Y,Z,DJ,DN,SZ,SZT,DIFF
Q
QUE ;
F I="DHDR*","^DOSV(0,$I,","SZT","DN*" S ZTSAVE(I)=""
S ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL,ZTRTN="DQ^DIXC"
D ^%ZTLOAD G KL
;
DQ S DJ=$I D DQ^DIX G D1
DIXC ;SFISC/GFT-DESCRIPTIVE STATS, CORRELATION MATRIX ;11:36 AM 12 Jul 1999; [ 04/02/2003 8:25 AM ]
+1 ;;22.0;VA FileMan;**1001**;APR 1, 2003
+2 ;;22.0;VA FileMan;**2**;Mar 30, 1999
+3 ;Per VHA Directive 10-93-142, this routine should not be modified.
D NEW SZ,SZT,DJ,DN,DHDR,DS
+1 DO DESC
GOTO DESCX
+2 ;
C DO CORR
GOTO CORRX
+1 ;
SQR SET Y=0
IF X'>0
QUIT
SET Y=1+X/2
L SET T=Y
SET Y=X/T+T/2
IF Y<T
GOTO L
+1 KILL T
QUIT
+2 ;
DLCOR SET DJ=IO(0)
SET U="^"
SET SZ=0
+1 FOR SZT=1:1
IF $DATA(^DOSV(0,DJ,"CP",SZT))
SET SZ=SZT
IF '$DATA(^DOSV(0,DJ,0,SZT,"S"))
QUIT
IF '$DATA(^DOSV(0,DJ,"F",SZT))
QUIT
SET DN(SZT)=$EXTRACT($PIECE(^(SZT),U,3),1,8)
+2 SET SZT=SZT-1
QUIT
+3 ;
DESC ;CALCULATE THE DESCRIPTIVE STATISTICS
+1 DO DLCOR
KILL DS
FOR I=1:1:SZT
IF $DATA(^DOSV(0,DJ,0,I,"Q"))
SET X=^("Q")-((^("S")*^("S"))/^("N"))/(^("N"))
DO SQR
SET ^("D")=Y
+2 QUIT
+3 ;
DESCX ;PRINT DESCRIPTIVE STATS
+1 KILL DHDR
SET DHDR="77CUST"
SET DHDR(1)="DESCRIPTIVE STATISTICS"
DO DHDR^DIX
IF POP
GOTO Q
IF $DATA(IO("Q"))
GOTO QUE
D1 IF SZT
Begin DoDot:1
+1 WRITE !!,?13,"N OF",?39,"STANDARD"
+2 WRITE !,?13,"CASES",?25,"MEAN",?39,"DEVIATION",?54,"MINIMUM",?69,"MAXIMUM"
+3 FOR I=1:1:SZT
Begin DoDot:2
+4 WRITE !,DN(I),?10
+5 IF $DATA(^DOSV(0,DJ,0,I,"N"))
WRITE $JUSTIFY(^("N"),6)
IF ^("N")
WRITE $JUSTIFY(^("S")/^("N"),15,4)
+6 FOR X="D","L","H"
WRITE $SELECT($DATA(^(X)):$JUSTIFY(^(X),15,4),1:$JUSTIFY("",15))
End DoDot:2
+7 DO EOP^DIG
QUIT
End DoDot:1
IF '$DATA(^DOSV(0,DJ,1))&'$DATA(^(2))&'$DATA(^(3))
GOTO KL
DO STATS^DIG($NAME(^DOSV(0,DJ)))
QUIT
+8 ;
CORR ;CALCULATE THE CORRELATION MATRIX
+1 KILL ^UTILITY($JOB),ERR
IF $ORDER(^DOSV(0,IO(0),1))'>0
WRITE !!,"***** AT LEAST TWO VARIABLES MUST BE DEFINED *****"
SET ERR=1
QUIT
+2 ;F I=1:1:SZ I ^DOSV(0,IO(0),"BY",I,"H")=^("L") W $C(7),!,"CAN'T COMPUTE CORRELATION MATRIX--",DN(I+100)," IS SINGLE-VALUED" S ERR=1 G KL
DO DLCOR
+3 FOR I=2:1:SZ
SET N=^DOSV(0,DJ,0,I,"N")
SET S=^("S")
SET C=^DOSV(0,DJ,"CP",I,I)
FOR J=1:1:I-1
IF $DATA(^DOSV(0,DJ,"CP",I,J))
DO C1
+4 GOTO KL
C1 SET X=N*C-(S*S)*(N*^DOSV(0,DJ,"CP",J,J))-(^DOSV(0,DJ,0,J,"S")*^("S"))
+1 DO SQR
SET (^UTILITY($JOB,J,I),^UTILITY($JOB,I,J))=(N*^DOSV(0,DJ,"CP",I,J))-(S*^DOSV(0,DJ,0,J,"S"))/Y
+2 QUIT
CORRX ;OUTPUT THE CORRELATION MATRIX
+1 IF $DATA(ERR)
GOTO KL
KILL DHDR
SET DHDR="72TSU"
SET DHDR(1)="CORRELATION MATRIX"
SET DHDR(2)=""
DO DHDR^DIX
IF POP
GOTO Q
+2 FOR I=1:1:SZ
SET ^UTILITY($JOB,I,I)=1
IF $DATA(^UTILITY($JOB,I,I))
WRITE ?I*10-2,$JUSTIFY(DN(I),10)
+3 FOR I=1:1:SZ
IF $DATA(^UTILITY($JOB,I,I))
WRITE !,DN(I)
FOR J=1:1:I
IF $DATA(^UTILITY($JOB,I,J))
WRITE ?J*10,$JUSTIFY(^UTILITY($JOB,I,J),8,4)
+4 WRITE !!
KL IF $EXTRACT(IOST)'="C"&($Y)
WRITE @IOF
IF IO(0)'=IO
DO CLOSE^DIO4
Q USE IO(0)
KILL C,DHDR,I,II,J,JJ,N,POP,S,X,Y,Z,DJ,DN,SZ,SZT,DIFF
+1 QUIT
QUE ;
+1 FOR I="DHDR*","^DOSV(0,$I,","SZT","DN*"
SET ZTSAVE(I)=""
+2 SET ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL
SET ZTRTN="DQ^DIXC"
+3 DO ^%ZTLOAD
GOTO KL
+4 ;
DQ SET DJ=$IO
DO DQ^DIX
GOTO D1
