Return to DIDC.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIDC.m, revision 1.1

1.1     ! snw         1: DIDC   ;SFISC/XAK-CONDENSED DD ;7/29/94  10:49
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        S DM="",DAT=$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3),X="I $Y+3>IOSL W $C(7) D P"
        !             5: EN     S N(0)=X1-.0000001,I=0 F  S N(0)=$O(^DD(N(0))) Q:N(0)'>0!(N(0)>X2)  S NAME=$O(^DD(N(0),0,"NM",0)) I NAME'="" S P=0 D P,P2 G:DM["^" EXIT
        !             6: EXIT   K %DT,%ZIS,DAT,I,J,K,K1,M,N,N1,NAME,MO,P,X,X1,X2,Y,KK,NF,NY,POP S D0="B",M=DM K DM Q
        !             7: P      S P=P+1 I IOST?1"C-".E R:P'=1 DM:DTIME Q:DM["^"!'$T
        !             8:        W:$D(DIFF)&($Y) @IOF S DIFF=1 W !!,"CONDENSED DATA DICTIONARY---",NAME," FILE"," (#",N(0),")" I $D(^%ZOSF("UCI"))#2 X ^("UCI") W ?47,"UCI: "_Y
        !             9:        W ?63,$S($G(^DD(N(0),0,"VR"))]"":"   VERSION: "_$P(^("VR"),U),1:" ") W !!,"STORED IN: ",$S($D(^DIC(N(0),0,"GL")):^("GL"),1:""),?58,DAT,?70,"PAGE ",P W ! F I=0:1:IOM-1 W "-"
        !            10:        G P1:P'=1 W !!,?50,"FILE SECURITY"
        !            11:        W !,?35,"DD SECURITY    : ",$S($D(^DIC(N(0),0,"DD")):^("DD"),1:""),?58,"DELETE SECURITY: ",$S($D(^("DEL")):^("DEL"),1:"")
        !            12:        W !,?35,"READ SECURITY  : ",$S($D(^("RD")):^("RD"),1:""),?58,"LAYGO SECURITY : ",$S($D(^("LAYGO")):^("LAYGO"),1:"")
        !            13:        W !,?35,"WRITE SECURITY : ",$S($D(^("WR")):^("WR"),1:"")
        !            14:        W !,"CROSS REFERENCED BY:",!,?5
        !            15:        S NY="" F KK=1:1 S NY=$O(^DD(N(0),0,"IX",NY)) Q:NY=""  S NF=+$O(^(NY,0)),N1=+$O(^(NF,0)) D
        !            16:        .N % S %=0 F  S %=$O(^DD(NF,N1,1,%)) Q:'%  I $D(^(%,0)),+^(0)=N(0),$P(^(0),U,2)=NY W:$X>50&($L($P(^DD(NF,N1,0),"^",1)>20)) !,?5 W " ",$P(^DD(NF,N1,0),"^",1),"(",NY,") "
        !            17: P1     W !!!,?33,"FILE STRUCTURE",!! W "FIELD",?10,"FIELD",!,"NUMBER",?10,"NAME",! Q
        !            18: P2     S M(0)=0 F K1=0:0 S M(0)=$O(^DD(N(0),M(0))),K=0 Q:+M(0)'>0!(M(0)?1U.U)  X X Q:DM["^"  W !,M(0),?10,$P(^DD(N(0),M(0),0),U,1)," " D M I J S K=K+1 D MO Q:DM["^"
        !            19:        Q
        !            20: MO     X X Q:DM["^"  S N(K)=+$P(^DD(N(K-1),M(K-1),0),U,2) S M(K)=0
        !            21:        F L=0:0 S M(K)=$O(^DD(N(K),M(K))) Q:M(K)'>0  X X Q:DM["^"  W !,?10+((K-1)*5),M(K),?15+((K-1)*5),$P(^DD(N(K),M(K),0),U,1)," " D M I J S K=K+1 D MO Q:DM["^"
        !            22:        Q:DM["^"  X X Q:DM["^"  S K=K-1 Q
        !            23: M      S J=$P(^(0),U,2) W $S(+J:"(Multiple-"_+J,1:"("_J),"), [",$P(^(0),U,4),"]"
        !            24:        Q
        !            25: PTR    ;
        !            26:        S F=0,I=0 F  S F=$O(^UTILITY($J,"P",F)) Q:F=""  D PT
        !            27:        S F=-1 Q
        !            28: PT     W !,F_" " W:$X>24 !?19 W "(#"_^(F,0)_") "
        !            29:        S %=0 F  S %=$O(^UTILITY($J,"P",F,%)) Q:%=""  W ?33," ",$S(%=F(1):"",1:$P(^DD(%,0)," SUB-FIELD",1)_":") S S=0 F  S S=$O(^UTILITY($J,"P",F,%,S)) Q:S=""  W ?34,$P(^DD(%,S,0),U)," (#"_S_")",!
        !            30:        S (%,S)=-1 Q
        !            31:        ;
        !            32: L      ; CUSTOM LOOP
        !            33:        I $G(Y)=U!($G(M)=U) G Q
        !            34:        I DJ,IOST?1"C-".E W $C(7) R X:DTIME I X[U!'$T G Q
        !            35:        K ^UTILITY($J,0)
        !            36:        S DIB=$O(^DIC(+DIB)) G:DIB>DIB(1)!(+DIB'=DIB) Q
        !            37:        I $G(DIPP(0,"IX"))["^DD(DFF,""AUDIT""",$O(^DD(DIB,"AUDIT",""))="" D  G:'DIB!(DIB>DIB(1)) Q
        !            38:        . F  S DIB=$O(^DIC(+DIB)) Q:'DIB!(DIB>DIB(1))  Q:$O(^DD(DIB,"AUDIT",""))]""
        !            39:        S %X="DIPP(",%Y="DPP(" D %XY^%RCR S DPP=DIPP,L=0
        !            40:        S DFF=DIB,DJ=DIJS,DPQ=DIPQ,M=DIMS S:'$D(DIA) DC="," G ^DIO
        !            41: Q      S DFF=DIB(1) G STOP^DIO4