| 1 | DIVU ;SFISC/DCM-VERIFY FIELDS UTILITIES ;8/1/95 1:02 PM
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | Q
|
|---|
| 5 | DE(FI,FD,N,G,S) ;
|
|---|
| 6 | Q:'$D(^DD($G(FI),0)) I $G(FD) Q:'$D(^(FD,0))
|
|---|
| 7 | I $G(G)']"" S G="DE"
|
|---|
| 8 | N Z,X,Y,%,H,D,I,J,V,K
|
|---|
| 9 | I $G(^DIC(FI,0))]"" S I(0)=^(0,"GL"),J(0)=+FI,V=0
|
|---|
| 10 | E D IJ(FI)
|
|---|
| 11 | S Y=I(0),X=V,H="",Z=0
|
|---|
| 12 | I +$G(S),V S S=$S('$P(S,U,2):V,1:$P(S,U,2)) S Z=S,X=X-S F %=0:1 S Y=Y_"D"_%_","_I(%+1)_"," I %=(S-1) Q
|
|---|
| 13 | L S D="D" S D=D_Z S Y=Y_D,H=H_"S "_D_"=0 F ",%="S "_D_"=$O("_Y_"))" I V>1 S @G@(Z)=%,H=H_"X "_G_"("_(Z)_")"
|
|---|
| 14 | E S H=H_%
|
|---|
| 15 | S H=H_" Q:"_D_"'>0 "
|
|---|
| 16 | S X=X-1,Z=Z+1
|
|---|
| 17 | L1 I X<0 D Q
|
|---|
| 18 | .I $G(N)]"",$G(FD)]"" D S H=H_" X "_G_"(99)",@G=H,@G@(99)=Y Q
|
|---|
| 19 | . . N DN,%,%N,%P,%4,Q
|
|---|
| 20 | . . S Q=";",%=^DD(FI,FD,0),%(2)=$G(^(2)),%4=$P(%,U,4),%N=$P(%4,Q),%P=$P(%4,Q,2)
|
|---|
| 21 | . . I FD=.001,%P="" S Y="S "_N_"=D"_V Q
|
|---|
| 22 | . . I %P=" " D CAL Q
|
|---|
| 23 | . . I $G(%P)]"" S Y=Y_","_%N_")"
|
|---|
| 24 | . . I %P S DN="$P(",%P="),U,"_%P_")"
|
|---|
| 25 | . . I $E(%P)="E" S DN="$E(",%P="),"_$E(%P,2,9)_")"
|
|---|
| 26 | . . I $G(DN)="" Q
|
|---|
| 27 | . . S Y="S "_N_"="_DN_"$G("_Y_%P
|
|---|
| 28 | . . I %(2)]"",$P(%,U,2)["O",$P(%,U,2)'["D" S Y=Y_",Y="_N_" "_%(2)_" S "_N_"=Y"
|
|---|
| 29 | . . Q
|
|---|
| 30 | . S @G=H Q
|
|---|
| 31 | S Y=Y_","_I(V-X)_"," G L
|
|---|
| 32 | ;
|
|---|
| 33 | CAL S Y=$P(%,U,5,99)_" S "_N_"=X" Q
|
|---|
| 34 | Q
|
|---|
| 35 | IJ(FI) ;set I( and J( and V=level
|
|---|
| 36 | Q:'$D(^DD($G(FI),0))
|
|---|
| 37 | N X,Y,S,Q,F S X=0,(S,Y)=FI,Q="""" F Q:'$D(^DD(Y,0,"UP")) S X=X+1,Y=^("UP")
|
|---|
| 38 | S V=X I X'=0 F X=X:-1 S Y=$G(^DD(S,0,"UP")) Q:'Y S F=$O(^DD(Y,"SB",S,0)) Q:'F S I(X)=$P($P($G(^DD(Y,F,0)),U,4),";"),K(X)=$O(^DD(S,0,"NM","")),J(X)=S,S=Y S:I(X)'=+I(X) I(X)=Q_I(X)_Q
|
|---|
| 39 | S I(0)=$G(^DIC(S,0,"GL")),J(0)=S
|
|---|
| 40 | Q
|
|---|
| 41 | DA(Z) ;convert D0,D1... to DA()
|
|---|
| 42 | N A,B,C,D K Z
|
|---|
| 43 | F A=0:1 S D="D"_A Q:'$D(@D)
|
|---|
| 44 | S C=0,A=A-1 F B=A:-1:0 S Z(B)=@("D"_C),C=C+1
|
|---|
| 45 | S Z=Z(0) K Z(0)
|
|---|
| 46 | Q
|
|---|
| 47 | DIBT(X,%,S) ;lookup sort template, return template's IEN
|
|---|
| 48 | N DIC,Y
|
|---|
| 49 | S X=$E(X,2,$L(X)-1),DIC="^DIBT(",DIC("S")="I $P(^(0),U,4)="_S,DIC(0)="ZM" D ^DIC
|
|---|
| 50 | S %=+Y
|
|---|
| 51 | Q
|
|---|
