Return to DIXC.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIXC.m, revision 1.1

1.1     ! snw         1: DIXC   ;SFISC/GFT-DESCRIPTIVE STATS, CORRELATION MATRIX ;2/24/93  14:52 ;
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: D      D DESC G DESCX
        !             5: C      D CORR G CORRX
        !             6:        ;
        !             7: SQR    S Y=0 Q:X'>0  S Y=1+X/2
        !             8: L      S T=Y,Y=X/T+T/2 G L:Y<T
        !             9:        K T Q
        !            10: DLCOR  S DJ=IO(0),U="^",SZ=0
        !            11:        F SZT=1:1 S:$D(^DOSV(0,DJ,"CP",SZT)) SZ=SZT Q:'$D(^DOSV(0,DJ,0,SZT,"S"))  S DN(SZT)=$E($P(^DOSV(0,IO(0),"F",SZT),U,3),1,8)
        !            12:        S SZT=SZT-1 Q
        !            13: DESC   ;CALCULATE THE DESCRIPTIVE STATISTICS.
        !            14:        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
        !            15:        Q
        !            16: DESCX  ;PRINT DESCRIPTIVE STATS
        !            17:        K DHDR S DHDR="77CUST",DHDR(1)="DESCRIPTIVE STATISTICS" D DHDR^DIX G Q:POP,QUE:$D(IO("Q"))
        !            18: D1     W !!,?13,"N OF",?39,"STANDARD"
        !            19:        W !,?13,"CASES",?25,"MEAN",?39,"DEVIATION",?54,"MINIMUM",?69,"MAXIMUM"
        !            20:        F I=1:1:SZT D D10
        !            21:        G KL
        !            22: D10    W !,DN(I),?10 I $D(^DOSV(0,DJ,0,I,"N")) W $J(^("N"),6) W:^("N") $J(^("S")/^("N"),15,4)
        !            23:        F X="D","L","H" W $S($D(^(X)):$J(^(X),15,4),1:$J("",15))
        !            24:        Q
        !            25: CORR   ;CALCULATE THE CORRELATION MATRIX
        !            26:        K ^UTILITY($J),ERR I $O(^DOSV(0,IO(0),1))'>0 W !!,"*****     AT LEAST TWO VARIABLES MUST BE DEFINED     *****" S ERR=1 Q
        !            27:        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
        !            28:        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
        !            29:        G KL
        !            30: C1     S X=N*C-(S*S)*(N*^DOSV(0,DJ,"CP",J,J))-(^DOSV(0,DJ,0,J,"S")*^("S"))
        !            31:        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
        !            32:        Q
        !            33: CORRX  ;OUTPUT THE CORRELATION MATRIX
        !            34:        G:$D(ERR) KL K DHDR S DHDR="72TSU",DHDR(1)="CORRELATION MATRIX",DHDR(2)="" D DHDR^DIX G Q:POP
        !            35:        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)
        !            36:        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)
        !            37:        W !!
        !            38: KL     W:$E(IOST)'="C"&($Y) @IOF I IO(0)'=IO D CLOSE^DIO4
        !            39: Q      U IO(0) K C,DHDR,I,II,J,JJ,N,POP,S,X,Y,Z,DJ,DN,SZ,SZT,DIFF
        !            40:        Q
        !            41: QUE    ;
        !            42:        F I="DHDR*","^DOSV(0,$I,","SZT","DN*" S ZTSAVE(I)=""
        !            43:        S ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL,ZTRTN="DQ^DIXC"
        !            44:        D ^%ZTLOAD G KL
        !            45:        ;
        !            46: DQ     S DJ=$I D DQ^DIX G D1