Return to DITR1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DITR1.m, revision 1.1

1.1     ! snw         1: DITR1  ;SFISC/GFT-FIND ENTRY MATCHES ;10:18 AM  17 May 1994
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        S W=DMRG,X=$P(Z,U),%=DFL\2,Y=@("D"_%),A=1 S:$G(DIFRDKP) DIFRNOAD=$D(@DIFRSA@("^DD",DIFRFILE,DDT(DTL),.01,0))
        !             5:        G WORD:$P(^DD(DDT(DTL),.01,0),U,2)["W",Q:X="",ON:'W
        !             6:        K DINUM I ^(0)["DINUM" S V=+Y G:$P(^(0),U,2)["P" DINUM S V=X,DA=Y,Y=0,D0=$S($D(D0):D0,$D(DFR):DFR,1:"") D DA X $P(^(0),U,5,99) S X=V,Y=DA Q:'$D(DINUM)  S (Y,V)=DINUM K DINUM G DINUM
        !             7:        S V=0 D:'$D(DISYS) OS^DII
        !             8: B      I '$D(^DD(DDT(DTL),0,"IX","B",DDT(DTL),.01)) F A=1:1 S V=$O(@(DTO(DTL)_V_")")) G NEW:V'>0 I $D(^(V,0)),$P(^(0),U)=X D MATCH G OLD:'$D(A) S A=1
        !             9:        S %=+$P(^DD("OS",DISYS,0),U,7) S:'% %=63
        !            10:        S V=$S($O(@(DTO(DTL)_"""B"",$E(X,1,%),V)"))>0:$O(^(V)),1:$O(@(DTO(DTL)_"""B"",$E(X,1,30),V)"))) G NEW:V'>0
        !            11:        I $D(@(DTO(DTL)_V_",0)")),$P(^(0),X)="" D MATCH G OLD:'$D(A)
        !            12:        G B
        !            13:        ;
        !            14: DA     Q:'%  S DA(%)=@("D"_Y),Y=Y+1,%=%-1 G DA
        !            15:        ;
        !            16: DINUM  I @("$D("_DTO(DTL)_"Y))") G:'DKP OLD D MATCH G:'$D(A) OLD S A=1 G Q
        !            17:        G ADD
        !            18:        ;
        !            19: NEW    S W=0
        !            20: ON     I @("$D("_DTO(DTL)_"Y))") G OLD:W S Y=Y+1 G ON
        !            21: ADD    G:$G(DIFRDKP) Q:DIFRNOAD S @("V="_DTO(DTL)_"0)"),^(0)=$P(V,U,1,2)_U_Y_U_($P(V,U,4)+1),^(Y,0)=X
        !            22: OLD    S DTO(DTL+1)=DTO(DTL)_Y_",",DTN(DTL+1)=0,A=0
        !            23: Q      Q
        !            24:        ;
        !            25: WORD   I $G(DIFRDKP) Q:$D(@DIFRSA@("^DD",DIFRFILE,DDT(DTL),.01))
        !            26:        S @("V=$O("_DTO(DTL)_"0))") X:V'>0!'DKP "K "_$E(DTO(DTL),1,$L(DTO(DTL))-1)_") S:$D("_DFR(DFL)_"0)) "_DTO(DTL)_"0)=^(0)","F V=0:0 S V=$O("_DFR(DFL)_"V)) Q:V'>0  S:$D(^(V,0)) "_DTO(DTL)_"V,0)=^(0)" S (DFL,DTL)=DFL-1 Q
        !            27:        ;
        !            28: MATCH  S A=1 I Y'=V,$D(^DD(DDT(DTL),.001,0)) Q
        !            29:        S Y=V,I=.01
        !            30: I      S I=$O(^DD(DDT(DTL),0,"ID",I)) I I'>0 G:$G(DIFRDKPR)&($G(DIFRDKPD))&('DTL) REPLACE K A Q
        !            31:        G I:'$D(^DD(DDT(DTL),I,0)) K B D P G I:W="" S B=W
        !            32:        I DTO S A=$P(A,";",2)_U_$P(A,";",1) F %=0:0 S %=$O(^UTILITY("DITR",$J,DDF(DFL+1),%)) G I:%'>0 Q:^(%)=A
        !            33:        E  S %=I
        !            34:        G I:'$D(^DD(DDF(DFL+1),%,0)) D P G I:W="",I:W=B
        !            35:        S Y=@("D"_(DFL\2)) Q
        !            36:        ;
        !            37: P      S A=$P(^(0),U,4),%=$P(A,";",2),W=$P(A,";",1) I @("'$D("_$S('$D(B):DTO(DTL)_"Y,",DFL:DFR(DFL)_"DFN(DFL),",1:DFR(1))_"W))") S W="" Q
        !            38:        I % S W=$P(^(W),U,%)
        !            39:        E  S W=$E(^(W),+$E(W,2,9),$P(W,",",2))
        !            40:        I W'?.UNP F %=1:1:$L(W) I $E(W,%)?1L S W=$E(W,0,%-1)_$C($A(W,%)-32)_$E(W,%+1,999)
        !            41:        Q
        !            42:        ;
        !            43: REPLACE        ;
        !            44:        N DA,DIK
        !            45:        K @DIFRSA@("TMP")
        !            46:        I DIFRDKPS M @DIFRSA@("TMP",DIFRFILE,Y)=@(DTO(DTL)_Y_")")
        !            47:        S DA=Y,DIK=DIFROOT
        !            48:        N %,A,B,D0,DDF,DDT,DFL,DFR,DINUM,DKPKDMGR,DTL,DTN,DTO,I,W,X,Y,Z
        !            49:        D ^DIK
        !            50:        S DIFRDKPD=0,V="A"
        !            51:        Q