Return to DIDG.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIDG.m, revision 1.1

1.1     ! snw         1: DIDG   ;SFISC/RWF-GLOBAL MAP ;08:03 AM  11 Dec 1994
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        K W S DJ(Z)=D0,F=0,W=F(Z),M=1,DP=0
        !             5:        W !
        !             6: UP     I $D(^DD(W,0,"UP")) S Y=^("UP"),N=$O(^DD(Y,"SB",W,0)) I $D(^DD(Y,N,0)) S F=F+1,W(F)=$P($P(^(0),U,4),";",1),W=Y G UP
        !             7:        S W=$S($D(^DIC(W,0,"GL")):^("GL"),1:"^("),Y=0 F N=F:-1:1 S W=W_"D"_Y_","_$S(+W(N)=W(N):W(N),1:""""_W(N)_"""")_",",Y=Y+1
        !             8:        S DID(Z-1)=W K W
        !             9:        ;
        !            10: L      S DN(Z)=""
        !            11: A      S DN(Z)=$O(^DD(F(Z),"GL",DN(Z))),DP(0)=0 I DN(Z)="" D POP Q
        !            12:        S DID(Z)=DID(Z-1)_"D"_(F+Z-1)_","_DN(Z) I $O(^DD(F(Z),"GL",DN(Z),""))'=0 S W=DID(Z)_")=" W ! D WL Q:M=U
        !            13: B      S DP=$O(^DD(F(Z),"GL",DN(Z),DP)) G PUSH:DP=0,A:DP=""
        !            14:        S DF=$O(^DD(F(Z),"GL",DN(Z),DP,0))
        !            15:        I DP(0)+1<DP F I1=DP(0)+1:1:DP-1 S W=" ^ " D WL Q:M=U
        !            16:        S N=^DD(F(Z),DF,0),DP(0)=DP
        !            17:        S X=$P(N,U,2) I +X S Z=Z+1,F(Z)=+X D L G B
        !            18:        S W="(#"_DF_") "_$P(N,U,1)_" ["_DP
        !            19:        F Y="F","S","D","N","P","W","V","K" I X[Y S W=W_Y
        !            20:        S W=W_"] ^ " D WL Q:M=U  G B
        !            21:        ;
        !            22: PUSH   S N=$O(^DD(F(Z),"GL",DN(Z),DP,0)) S:N="" N=-1 S Y=^DD(F(Z),N,0),DID(Z)=DID(Z)_","
        !            23:        W !,DID(Z)_"0)=^"_$P(Y,U,2)_"^^  (#",N,") "_$P(Y,U,1) S Z=Z+1,F(Z)=+$P(Y,U,2)
        !            24:        D L Q:M=U  G A
        !            25:        ;
        !            26: POP    S Z=Z-1,DID(Z)=$E(DID(Z),1,$L(DID(Z))-1) Q:Z  K DN,W,DP,DG,DID S DN=0 W ! Q
        !            27:        ;
        !            28: END    ;
        !            29:        S S=0,M=1
        !            30: T1     S S=S+1 D:$Y+3>IOSL HDR Q:M=U
        !            31:        W !!,$S(S<4:$P("INPU^PRIN^SOR",U,S)_"T TEMPLATE(S):",1:"FORM(S)/BLOCK(S):")
        !            32:        S DFF="^DI"_$P("E^PT^BT^ST(.403)",U,S),DA=""
        !            33:        F  S DA=$O(@DFF@("F"_F(1),DA)) Q:DA=""  D  Q:M=U
        !            34:        . S DUB=0 F  S DUB=$O(@DFF@("F"_F(1),DA,DUB)) Q:DUB'>0  D  Q:M=U
        !            35:        .. I $D(@DFF@(DUB,0))#2 S %1=^(0) D TEMPL
        !            36:        K %1 Q:M=U  G T1:S<4
        !            37: Q      Q
        !            38: TEMPL  I $Y+3>IOSL D HDR Q:M=U
        !            39:        N % S %=$S($D(^("ROU")):"Compiled: "_^("ROU"),'$D(^("ROU"))&($D(^("ROUOLD"))):"Previously Compiled: "_^("ROUOLD"),1:"")
        !            40:        I %]"",DFF["DIBT" S %=%_"*"
        !            41:        I DFF'["DIST" W !,DFF,"("_DUB_")= ",$P(%1,U)_"    "_%
        !            42:        E  D FORM
        !            43:        Q
        !            44: WL     I $Y+4>IOSL S %1=W D HD Q:M=U  S W=%1 I W[DID(Z) S W=""
        !            45:        F I=1:1 S Y=$P(W," ",I)_" " Q:$P(W," ",I,99)=""  W:$X+$L(Y)+2>IOM !,?$L(DID(Z)),"==>" W Y
        !            46:        Q
        !            47: W      W:$X+$L(W)+3>IOM !,?$S(IOM-$L(W)-5<M:IOM-5-$L(W),1:M),S S %Y=$E(W,IOM-$X,999) W $E(W,1,IOM-$X-1),S Q:%Y=""  S W=%Y G W
        !            48:        ;
        !            49: HD     S DC=DC+1 D ^DIDH Q:M=U  W !,DID(Z),")= " Q
        !            50:        ;
        !            51: HDR    ;
        !            52:        S DC=DC+1 I IOST?1"C".E W $C(7) R M:DTIME S:'$T M=U Q:M=U
        !            53: H1     W:$D(DIFF)&($Y) @IOF S DIFF=1 W "TEMPLATE LIST  --  FILE #"_DIB,?(IOM-20),$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)_"    PAGE "_DC
        !            54:        S M="",$P(M,"-",IOM)="" W !,M
        !            55:        Q
        !            56:        ;
        !            57: FORM   ;
        !            58:        W !,"^DIST(.403,"_DUB_")= ",$P(%1,U)_"    "_%
        !            59:        ;
        !            60:        N B,L,P
        !            61:        S L=1,L(1)=U
        !            62:        S P=0 F  S P=$O(^DIST(.403,DUB,40,P)) Q:'P  D  Q:M=U
        !            63:        . Q:$D(^DIST(.403,DUB,40,P,0))[0  S B=$P(^(0),U,2) D:B BLOCK  Q:M=U
        !            64:        . S B=0 F  S B=$O(^DIST(.403,DUB,40,P,40,B)) Q:'B  D BLOCK  Q:M=U
        !            65:        W !
        !            66:        Q
        !            67: BLOCK  ;
        !            68:        N I
        !            69:        F I=1:1:L I L(I)[(U_B_U) G BLOCKQ
        !            70:        S:$L(L)+$L(B)+1>245 L=L+1,L(L)=U S L(L)=L(L)_B_U
        !            71:        Q:$D(^DIST(.404,B,0))[0  S %1=^(0)
        !            72:        ;
        !            73:        I $Y+3>IOSL D HDR Q:M=U
        !            74:        W !?2,"^DIST(.404,"_B_")= ",$P(%1,U)
        !            75: BLOCKQ Q