Return to DIG.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIG.m, revision 1.1.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