Return to DITR1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

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