| 1 | DIUTL ;GFT;01:02 PM 8 Apr 2001
|
|---|
| 2 | ;;22.0;VA FileMan;**76**;Mar 30, 1999
|
|---|
| 3 | ;
|
|---|
| 4 | WP(DIRF,DIWL,DIWR) ;Write out WP field (if any) stored at DIRF
|
|---|
| 5 | N DIWF,Z,A1,D,X,DIW,DIWT,DN,I
|
|---|
| 6 | K ^UTILITY($J,"W")
|
|---|
| 7 | S DIWF="W|" S:'$G(IOM) IOM=80 S:'$G(DIWR) DIWR=IOM S:'$G(DIWL) DIWL=1
|
|---|
| 8 | S A1=$P($G(@DIRF@(0)),U,3) F D=0:0 S D=$O(@DIRF@(D)) Q:D>A1&A1!'D S X=^(D,0) D ^DIWP G QWP:$G(DN)=0
|
|---|
| 9 | D ^DIWW
|
|---|
| 10 | QWP I $G(DN)'=0 Q 1
|
|---|
| 11 | K DIOEND Q 0
|
|---|
| 12 | ;
|
|---|
| 13 | IJ(N) ;build I & J arrays given subfile number N
|
|---|
| 14 | N A K I,J
|
|---|
| 15 | S J(0)=N,N=0
|
|---|
| 16 | 0 I $D(^DIC(J(0),0,"GL")) S I(0)=^("GL") Q
|
|---|
| 17 | S A=$G(^DD(J(0),0,"UP")) Q:A=""
|
|---|
| 18 | S I=$O(^DD(A,"SB",J(0),0)) Q:'I
|
|---|
| 19 | S I=$P($P($G(^DD(A,I,0)),U,4),";") Q:I=""
|
|---|
| 20 | I +I'=I S I=""""_I_""""
|
|---|
| 21 | F J=N:-1:0 S J(J+1)=J(J) S:J I(J+1)=I(J)
|
|---|
| 22 | S J(0)=A,I(1)=I,N=N+1 G 0
|
|---|
| 23 | ;
|
|---|
| 24 | ;
|
|---|
| 25 | DIVR(DI,DIFLD) ;verify
|
|---|
| 26 | N DIVZ,S,A,DA,DICL,V,Z,DDC,DR,N,Y,I,J,Q,W,V,T,DQI
|
|---|
| 27 | K ^UTILITY("DIVR",$J),^DD(U,$J)
|
|---|
| 28 | D IJ(DI)
|
|---|
| 29 | I '$O(@(I(0)_"0)")) Q ;File must have some entries!
|
|---|
| 30 | S S=";",Q="""",V=$O(J(""),-1),A=DI,DA=DIFLD
|
|---|
| 31 | S DR=$P(^DD(DI,DIFLD,0),U,2),Z=$P(^(0),U,3),$P(Y(0),U,4)=$P(^(0),U,4),DDC=$P(^(0),U,5,999)
|
|---|
| 32 | Q:DR["W"!(DR["C")
|
|---|
| 33 | F T="N","S","V","P","K","F" Q:DR[T
|
|---|
| 34 | W !!,"SINCE YOU HAVE CHANGED THE FIELD DEFINITION,",!,"EXISTING '",$P(^(0),U),"' DATA WILL NOW BE CHECKED FOR INCONSISTENCIES",!,"OK"
|
|---|
| 35 | S %=1 D YN^DICN Q:%-1
|
|---|
| 36 | ;D ^%ZIS Q:POP
|
|---|
| 37 | ;U IO WON'T WORK BECAUSE Q+3^DIVR ASKS TO STORE IN TEMPLATE
|
|---|
| 38 | D ^DIVR
|
|---|
| 39 | ;D ^%ZISC
|
|---|
| 40 | Q
|
|---|
