Return to DICR.m CVS log

Up to [Coherent Logic Development] / freem_fileman

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