File:  [Coherent Logic Development] / freem_fileman / USER / DDSFO.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:19 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    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>