| 1 | DDSFO ;SFISC/MKO-FORM ONLY FIELDS ;1:52 PM 19 Jun 1998
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | DIR ;Setup input variables to DIR
|
|---|
| 5 | N I,J
|
|---|
| 6 | S DIR(0)=$P(DDSO(20),U)_$P(DDSO(20),U,2,3)
|
|---|
| 7 | S:DIR(0)?1"DD".E DIR(0)=$P(DIR(0),U,2,999)
|
|---|
| 8 | S:$P(DIR(0),U)'["O" $P(DIR(0),U)=$P(DIR(0),U)_"O"
|
|---|
| 9 | I $P(DIR(0),U)["P",$P($P(DIR(0),U,2),":",2)'["Z" D
|
|---|
| 10 | . S I=$P(DIR(0),U,2) Q:$P(I,":",2)["Z"
|
|---|
| 11 | . S $P(I,":",2)=$P(I,":",2)_"Z"
|
|---|
| 12 | . S $P(DIR(0),U,2)=I
|
|---|
| 13 | S:$G(^DIST(.404,DDSBK,40,DDO,22))'?."^" $P(DIR(0),U,3)=^(22)
|
|---|
| 14 | I $D(^DIST(.404,DDSBK,40,DDO,21)) D
|
|---|
| 15 | . S (I,J)=0
|
|---|
| 16 | . F S I=$O(^DIST(.404,DDSBK,40,DDO,21,I)) Q:I="" I $D(^(I,0))#2 S J=J+1,DIR("?",J)=^(0)
|
|---|
| 17 | . I J>0 S DIR("?")=DIR("?",J) K DIR("?",J)
|
|---|
| 18 | X:$G(^DIST(.404,DDSBK,40,DDO,24))'?."^" ^(24)
|
|---|
| 19 | Q
|
|---|
