Return to DICR.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DICR.m, revision 1.1

1.1     ! snw         1: DICR   ;SFISC/GFT-RECURSIVE CALL FOR X-REFS ON TRIGGERED FLDS ;4/17/89  11:05 ;
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        I DIU]"" F DIW=0:0 S DIW=$O(^DD(DIH,DIG,1,DIW)),X=DIU Q:'DIW  I $P(^(DIW,0),U,3)=""!'$D(DB(0,DIH,DIG,DIW,2)) S DB(0,DIH,DIG,DIW,2)=1 D SAVE X ^(2) D RESTORE
        !             5:        I DIV]"" F DIW=0:0 S DIW=$O(^DD(DIH,DIG,1,DIW)),X=DIV Q:'DIW  I $P(^(DIW,0),U,3)=""!'$D(DB(0,DIH,DIG,DIW,1)) S DB(0,DIH,DIG,DIW,1)=1 D SAVE X ^(1) D RESTORE
        !             6: Q      Q
        !             7:        ;
        !             8: SAVE   F DB=1:1 Q:'$D(DB(DB))
        !             9:        F Y="DIC","DIV","DA" S %="" F DB=DB:0 S @("%=$O("_Y_"(%))") Q:%=""  S DB(DB,Y,%)=@(Y_"(%)")
        !            10:        F %="DIC","DIW","DIU","DIV","DIH","DIG","DB","DG","DA","DICR" S DB(DB,%)="" I $D(@%)#2 S DB(DB,%)=@%
        !            11:        K DA F Y=-1:1 Q:'$D(DIV(Y+1))
        !            12:        I Y+1 S DA=DIV(Y) F %=Y-1:-1:0 S DA(Y-%)=DIV(%)
        !            13:        Q
        !            14:        ;
        !            15: RESTORE        F DB=1:1 Q:'$D(DB(DB+1))
        !            16:        F Y="DIC","DIV","DA" K @Y S %="" F DB=DB:0 S %=$O(DB(DB,Y,%)) Q:%=""  S @(Y_"(%)=DB(DB,Y,%)")
        !            17:        S Y="" F %=0:0 S Y=$O(DB(DB,Y)) Q:Y=""  S @Y=DB(DB,Y)
        !            18:        K DB(DB) K:DB=1 DB Q
        !            19:        ;
        !            20: DICL   N I
        !            21:        K DIC("S"),DLAYGO I '$P(Y,U,3) K DIC Q
        !            22: DICADD ;
        !            23:        S (D0,DIV(0))=+Y,DIV(U)=Y
        !            24:        I DIC S DIH=DIC,DIC=^DIC(DIC,0,"GL")
        !            25:        E  S @("DIH=+$P("_DIC_"0),U,2)")
        !            26:        S DICR=$S($D(DA)#2:DA,1:0),DA=D0 F DIG=.001:0 S DIG=$O(DIC(DIG)) Q:DIG'>0  D U:DIC(DIG)]""
        !            27:        S DA=DICR,Y=DIV(U) K DIC Q
        !            28:        ;
        !            29: U      S %=$P(^DD(DIH,DIG,0),U,4),Y=$P(%,";",2),%=$P(%,";",1),X="",DIV=DIC(DIG) I @("$D("_DIC_DIV(0)_",%))") S X=^(%)
        !            30:        G P:Y,Q:Y'?1"E"1N.NP S D=+$E(Y,2,9),Y=$P(Y,",",2),DIU=$E(X,D,Y) I DIU?." " S DIU="" S:$L(X)+1<D X=X_$J("",D-1-$L(X))
        !            31:        S ^(%)=$E(X,1,D-1)_DIV_$E(X,Y+1,999)
        !            32:        G DICR
        !            33: P      S DIU=$P(X,U,Y),$P(^(%),U,Y)=DIV
        !            34:        G DICR
        !            35: CONV   ;
        !            36:        K DA F %=0:1 Q:'$D(@("D"_%))
        !            37:        S %=%-1 I '% S DA=D0 K % Q
        !            38:        S DA=@("D"_%),%=%-1,Y=0
        !            39:        F %1=%:-1:0 S Y=Y+1,DA(Y)=@("D"_%1)
        !            40:        K %,%1,Y
        !            41:        Q
        !            42: SD     ;
        !            43:        S DIV(0)=DA D U K DA,DIH,DIG,DIV Q