Annotation of freem_fileman/DDSFO.m, revision 1.1
1.1 ! snw 1: DDSFO ;SFISC/MKO-FORM ONLY FIELDS ;02:46 PM 8 Sep 1994
! 2: ;;21.0;VA FileMan;;Dec 28, 1994
! 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))'?."^" DIR(0)=DIR(0)_U_^(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
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>