Return to DITR.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DITR.m, revision 1.1

1.1     ! snw         1: DITR   ;SFISC/GFT-FIND FLDS TO XRF ;02:25 PM  4 Sept 1994
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        S (DFL,DTL)=DFL-1 Q:'$D(DFN(DFL))
        !             5: N      S @("DFN(DFL)=$O("_DFR(DFL)_"DFN(DFL)))")
        !             6:        I DFN(DFL)]"",$D(^(DFN(DFL)))#2 S Z=^(DFN(DFL)),A="" G NS
        !             7:        G DITR:DFN(DFL)="",1:DFL#2,DITR:$D(^(DFN(DFL),0))-1 S Z=^(0),X="D"_(DFL\2),@X=DFN(DFL) I DTO,$D(DSC(DDF(DFL+1))) X DSC(DDF(DFL+1)) E  G N
        !             8:        D ^DITR1 G N:A D D
        !             9: NS     I $G(DIFRFRV) D
        !            10:        .S DIFRFRV1=$P($NA(@("DIFRFRV(D0,"_$P(DFR(DFL),DFR(1),2,255)_DFN(DFL)_")")),"DIFRFRV(",2,255),$E(DIFRFRV1,$L(DIFRFRV1))=""
        !            11:        .Q:DIFRFRV1=$G(DIFRFRV2)
        !            12:        .S DIFRFRV2=DIFRFRV1
        !            13:        .Q:'$D(@DIFRSA@("FRV1",DIFRFILE,DIFRFRV1))
        !            14:        .S @DIFRSA@("FRVL",DIFRFILE,DIFRFRV1)=$NA(@(DTO(DTL)_DFN(DFL)_")"))
        !            15:        .Q
        !            16:        S A=$O(^DD(DDF(DFL),"GL",DFN(DFL),A)) G N:A=""
        !            17:        S W=$O(^(A,0)) S:W="" W=-1 G:$G(DIFRDKP) NS:$D(@DIFRSA@("^DD",DIFRFILE,DDF(DFL),W)) I A S Y=$P(Z,U,A) G NS:Y=""
        !            18:        E  S Y=$E(Z,+$E(A,2,9),$P(A,",",2)) F %=$L(Y):-1 Q:" "'[$E(Y,%)  G NS:'% S Y=$E(Y,1,%-1)
        !            19:        I DTO G NS:'$D(^UTILITY("DITR",$J,DDF(DFL),W)) S B=^(W),DTN(DTL)=$P(B,U,2)
        !            20:        E  S B=A,DTN(DTL)=DFN(DFL)
        !            21:        S X="" I @("$D("_DTO(DTL)_"DTN(DTL)))#2") S X=^(DTN(DTL))
        !            22:        I 'B S W=$E(B,2,9),B=$P(B,",",2) G NS:$E(X,+W,B)'?." "&DKP S %=$E(X,B+1,999),V=W-$L(X)-1,^(DTN(DTL))=$E(X,0,W-1)_$J("",$S(V>0:V,1:0))_Y S:%'?." " ^(DTN(DTL))=^(DTN(DTL))_$J("",B+1-W-$L(Y))_% G NS
        !            23:        I DKP,$P(X,U,B)]"" G NS
        !            24: P      S $P(^(DTN(DTL)),U,B)=Y G NS
        !            25:        ;
        !            26: 1      G N:$O(^(DFN(DFL),0))'>0 S Z=$O(^DD(DDF(DFL),"GL",DFN(DFL),0,0)) G N:Z'>0 I DTO G N:'$D(^UTILITY("DITR",$J,DDF(DFL),Z)) S B=^(Z)
        !            27:        D D S Y=$P(^DD(DDF(DFL-1),Z,0),U,2),DDF(DFL+1)=+Y I DTO S Y=$P(B,U,3),X=""""_$P(B,U,2)_""","
        !            28:        S DDT(DTL)=+Y,DTO(DTL)=DTO(DTL-1)_X S:$G(DIFRDKP) DIFRX=$D(@DIFRSA@("^DD",DIFRFILE,+Y)) I @("'$D("_DTO(DTL)_"0))") G:$G(DIFRDKP) DITR:DIFRX S ^(0)=U_Y
        !            29:        G N
        !            30:        ;
        !            31: D      S DTL=DFL+1
        !            32:        S X=""""_DFN(DFL)_""",",DFR(DFL+1)=DFR(DFL)_X,DFL=DFL+1,DFN(DFL)=0 Q
        !            33:        ;
        !            34: F      ;
        !            35:        S A=1,@("Z="_DIK_"D0,0)") W !,$P(^(0),U,1) G I:'DTO!'$D(DITF)
        !            36:        S Z=$P(DITF,";",1) I Z=" " S Z=D0 G I
        !            37:        Q:'$D(^(Z))  S X=$P(DITF,";",2) I X S Z=$P(^(Z),U,X) G I
        !            38:        S Z=$E(^(Z),+$E(X,2,9),+$P(X,",",2))
        !            39: I      ;
        !            40:        S DFL=0,DTL=0,DA=D0 D ^DITR1 I $G(DIFRSA)]"" S:$D(@DIFRSA@("TMP"))>9 DIFRND0=Y
        !            41:        Q:A
        !            42: GO     ;
        !            43:        S DFL=1,DTL=1,DFN(1)=-1 D N