Return to DIG.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Annotation of freem_fileman/USER/DIG.m, revision 1.1

1.1     ! snw         1: DIG    ;SFISC/GFT-SCATTERGRAM ;2/24/93  11:01 ;
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        I '$D(^DOSV(0,IO(0),2)) W !,"NO SUB-SUB TOTALS WERE RUN" Q
        !             5:        K ZTSK S:$D(^%ZTSK) %ZIS="QM" D ^%ZIS G ENDK:POP,QUE:$D(IO("Q"))
        !             6: DQ     S C(1)=^DOSV(0,IO,"BY",1),C(2)=^(2),X=$O(^DOSV(0,IO(0),2,"")),(DXMIN,DXMAX)=X,(DYMIN,DYMAX)=$O(^(X,"")),X=""
        !             7:        I $E(IOST)="C" S DIFF=1
        !             8:        F C=1,2 S C(C,0)=$S($D(^DD(+C(C),+$P(C(C),U,2),0)):$P(^(0),U,2),1:$P(C(C),U,7))
        !             9:        F C=0:0 S X=$O(^DOSV(0,IO(0),2,X)) Q:X=""  S:X>DXMAX DXMAX=X S Y=$O(^(X,"")),DY=Y S:Y<DYMIN DYMIN=Y D A S:DYMAX<DY DYMAX=DY
        !            10:        I DXMAX-DXMIN*(DYMAX-DYMIN)=0 W $C(7),!,"NO RANGE OF VARIABLES" G ENDK
        !            11:        S H=DYMAX,L=DYMIN,DYS=IOSL-9,N=DYS/6,C=2 D S S DYMIN=B,DYSC=I/6,DYMAX=T,DYI=X
        !            12: DYI    I T-B/DYI*6'>DYS S DYI=DYI\2 G DYI
        !            13:        S H=DXMAX,L=DXMIN,DXS=IOM-28,N=DXS/6,C=1 D S S DXMIN=B,DXSC=I/6,DXI=X,DXMAX=T,T=X*DXS/(T-B),H=-1
        !            14: LOOP   K ^UTILITY($J) S H=$O(^DOSV(0,IO(0),"F",H)) I H S X=^(H) U IO W:$D(DIFF)&($Y) @IOF S DIFF=1 W ?22,$O(^DD(+X,0,"NM",0))," ",$P(X,U,$P(X,U,2)'=.01*3)," COUNT   " S (B,DX,DY)="" D I2 G LOOP:X'=U
        !            15: END    W:$E(IOST)'="C"&($Y) @IOF K:$D(ZTSK) ^DOSV(0,IO) D CLOSE^DIO4
        !            16: ENDK   K %H,%T,%Y,%D,B,I,L,H,T,C,X,Y,POP,IOP,DX,DY,DXS,DYS,DXSC,DYSC,DXMIN,DYMIN,DXMAX,DYMAX,DXI,N,DYI,DIFF Q
        !            17:        ;
        !            18: I2     S (DX,X)=$O(^DOSV(0,IO(0),2,DX)) I X="" W "(TOTAL = "_B_")",! G O
        !            19:        I C(1,0)["D" D H^%DTC S X=%H
        !            20:        S X=$J(X-DXMIN/DXSC,0,0)
        !            21: I3     S (Y,DY)=$O(^DOSV(0,IO(0),2,DX,DY)) G I2:Y="" I C(2,0)["D" S C=X,X=Y D H^%DTC S Y=%H,X=C
        !            22:        G I3:'$D(^(DY,H,"N")) S C=^("N"),Y=$J(Y-DYMIN/DYSC,0,0),B=B+C,^(X)=C+$S($D(^UTILITY($J,Y,X)):^(X),1:0) G I3
        !            23:        ;
        !            24: A      F C=0:0 S Y=$O(^(DY)) Q:Y=""  S DY=Y
        !            25:        Q
        !            26:        ;
        !            27: O      S X=0 D X W !?12,"." D P K Y S L=0 F B=DYMIN:DYI:DYMAX S C=2,Y=B D Y S Y($J(L,0,0))=Y,L=DYI*DYS/(DYMAX-DYMIN)+L
        !            28:        W ".",! F Y=DYS:-1:0 D LINE W !
        !            29:        W ?13 D P W ! S X=DXI D X W !?22,"X-AXIS: ",$P(C(1),U,3),"    Y-AXIS: ",$P(C(2),U,3) I IOST?1"C".E W $C(7) R X:DTIME S:'$T X=U
        !            30:        Q
        !            31:        ;
        !            32: P      S L=-1,X=0
        !            33: PP     I L<X W "+" S L=L+T
        !            34:        E  W "-"
        !            35:        S X=X+1 G PP:X'>DXS Q
        !            36:        ;
        !            37: X      F B=DXMIN+X:DXI*2:DXMAX S Y=B,C=1 D Y W ?B-DXMIN\DXSC-($L(Y)\2)+13,Y
        !            38:        Q
        !            39: Y      S C=C(C,0) I C["D" S %H=Y D 7^%DTC S Y=X
        !            40:        G S^DIQ
        !            41:        ;
        !            42: LINE   I $D(Y(Y)) W ?12-$L(Y(Y)),Y(Y),"+"
        !            43:        E  W ?12,"|"
        !            44:        S X="" F  S X=$O(^UTILITY($J,Y,X)) Q:X=""  S I=^(X) W ?X+13,$S(I>9:"*",I:I,1:"")
        !            45:        W ?DXS+14 I  W "+",Y(Y) Q
        !            46:        W "|" Q
        !            47:        ;
        !            48: S      I C(C,0)["D" F B="H","L" S X=@B D H^%DTC S @B=%H
        !            49:        S B=H-L,X=1 I B>1 F C=1:1 S X=X*10 Q:B'>X
        !            50:        E  S I=1 Q:'B  F C=0:-1 Q:X/10'>B  S X=X/10
        !            51:        S B=L-X\X*X F I=B:X/10 Q:I'<L  S B=I
        !            52:        S T=H+X\X*X F I=T:-X/10 Q:I'>H  S T=I
        !            53: I      S I=T-B/X*10 I I>N S X=X*2 G I
        !            54:        S X=X/10,I=T-B/N
        !            55:        Q
        !            56: QUE    ;
        !            57:        S ZTSAVE("^DOSV(0,$I,")=""
        !            58:        S ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL,ZTRTN="DQ^DIG"
        !            59:        D ^%ZTLOAD K ZTSK G END