| 1 | DITR ;SFISC/GFT-FIND FLDS TO XRF ;1:35 PM 30 Jul 2001
|
|---|
| 2 | ;;22.0;VA FileMan;**41**;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | N DITRCNT
|
|---|
| 5 | LOOP S (DFL,DTL)=DFL-1 Q:'$D(DFN(DFL))
|
|---|
| 6 | N S @("DFN(DFL)=$O("_DFR(DFL)_"DFN(DFL)))")
|
|---|
| 7 | I DFN(DFL)]"",$D(^(DFN(DFL)))#2 S Z=^(DFN(DFL)),A="" D:$G(DIFRFRV) SFRV1 G NS
|
|---|
| 8 | G LOOP:DFN(DFL)="",1:DFL#2,LOOP:$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
|
|---|
| 9 | I $P(^DD(DDT(DTL),.01,0),U,2)["W" D ^DITR1 G N
|
|---|
| 10 | D ^DITR1 I A D:$G(DIFRSA)]"" ERR G N
|
|---|
| 11 | I $G(DIFRSA)]"",'DKP,@("$D("_DTO(DTL)_"Y))") D KILLIDX
|
|---|
| 12 | D D,SFRV1:$G(DIFRFRV)
|
|---|
| 13 | NS S A=$O(^DD(DDF(DFL),"GL",DFN(DFL),A)) G N:A=""
|
|---|
| 14 | 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=""
|
|---|
| 15 | 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)
|
|---|
| 16 | I DTO G NS:'$D(^UTILITY("DITR",$J,DDF(DFL),W)) S B=^(W),DTN(DTL)=$P(B,U,2)
|
|---|
| 17 | E S B=A,DTN(DTL)=DFN(DFL)
|
|---|
| 18 | S X="" I @("$D("_DTO(DTL)_"DTN(DTL)))#2") S X=^(DTN(DTL))
|
|---|
| 19 | I 'B D G NS
|
|---|
| 20 | .S W=$E(B,2,9),B=$P(B,",",2)
|
|---|
| 21 | .I $E(X,+W,B)'?." "&DKP D:$G(DIFRFRV) KFRV1 Q
|
|---|
| 22 | .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))_%
|
|---|
| 23 | .I $G(DIFRFRV) D SFRVL
|
|---|
| 24 | .Q
|
|---|
| 25 | I DKP,$P(X,U,B)]"" D:$G(DIFRFRV) KFRV1 G NS
|
|---|
| 26 | P S $P(^(DTN(DTL)),U,B)=Y D:$G(DIFRFRV) SFRVL G NS
|
|---|
| 27 | ;
|
|---|
| 28 | 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)
|
|---|
| 29 | 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)_""","
|
|---|
| 30 | 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) LOOP:DIFRX S ^(0)=U_Y
|
|---|
| 31 | G N
|
|---|
| 32 | ;
|
|---|
| 33 | SFRV1 S DIFRFRV1=$P($NA(@("DIFRFRV(D0,"_$P(DFR(DFL),DFR(1),2,255)_""""_DFN(DFL)_""")")),"DIFRFRV(",2,255),$E(DIFRFRV1,$L(DIFRFRV1))=""
|
|---|
| 34 | Q
|
|---|
| 35 | SFRVL Q:'$D(@DIFRSA@("FRV1",DIFRFILE,DIFRFRV1))
|
|---|
| 36 | S @DIFRSA@("FRVL",DIFRFILE,DIFRFRV1)=$NA(@(DTO(DTL)_""""_DFN(DFL)_""")"))
|
|---|
| 37 | Q
|
|---|
| 38 | KFRV1 K @DIFRSA@("FRV1",DIFRFILE,DIFRFRV1,B)
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | D S DTL=DFL+1
|
|---|
| 42 | S X=""""_DFN(DFL)_""",",DFR(DFL+1)=DFR(DFL)_X,DFL=DFL+1,DFN(DFL)=0 Q
|
|---|
| 43 | ;
|
|---|
| 44 | F ;
|
|---|
| 45 | S A=1,@("Z="_DIK_"D0,0)") W !,$P(^(0),U,1) G I:'DTO!'$D(DITF)
|
|---|
| 46 | S Z=$P(DITF,";",1) I Z=" " S Z=D0 G I
|
|---|
| 47 | Q:'$D(^(Z)) S X=$P(DITF,";",2) I X S Z=$P(^(Z),U,X) G I
|
|---|
| 48 | S Z=$E(^(Z),+$E(X,2,9),+$P(X,",",2))
|
|---|
| 49 | I ;
|
|---|
| 50 | S DFL=0,DTL=0,DA=D0 D ^DITR1
|
|---|
| 51 | I A D:$G(DIFRSA)]"" ERR Q
|
|---|
| 52 | I $G(DIFRSA)]"" S DIFRND0=Y I 'DKP,@("$D("_DTO(DTL)_"Y))") D KILLIDX
|
|---|
| 53 | GO ;
|
|---|
| 54 | S DFL=1,DTL=1,DFN(1)=-1 D N
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
| 57 | KILLIDX ; Kill the old index for single entry (overwrite mode only).
|
|---|
| 58 | N DIK,DA,% S DA=Y,DIK=DTO(DTL),DIK(0)="ABs"
|
|---|
| 59 | N Y S %=DFL\2 I % S Y=0 D DA^DITR1
|
|---|
| 60 | N %,A,B,D0,DDF,DDT,DFL,DFR,DINUM,DTL,DTN,DTO,I,W,X,Z
|
|---|
| 61 | D IX2^DIK Q
|
|---|
| 62 | ;
|
|---|
| 63 | ERR N DIPAR S DIPAR(.01)=X,DIPAR("IEN")=Y,DIPAR("FILE")=DDT(DFL)
|
|---|
| 64 | D BLD^DIALOG(9513.1,.DIPAR) Q
|
|---|
| 65 | ;
|
|---|
