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

    1: DIU4	;SFISC/XAK-SPECIFIER ;6/11/93  2:29 PM
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	W ! S DIU=Y K DIR G S:'$D(^DD(DI,0,"SP",+Y))
    5: 	S DIR("A",1)=$P(DIU,U,2)_" is already a specifier."
    6: 	S DIR("A")="Do you want to delete it"
    7: 	S DIR("??")="^W !!?5,""Deleting a specifier means that this field will not be used"",!?5,""in trying to match entries going from one system to another."""
    8: 	S DIR("B")="NO",DIR(0)="Y" D ^DIR G Q:$D(DTOUT)!$D(DUOUT),E:'Y
    9: 	K:Y ^DD(DI,0,"SP",+DIU) G Q
   10: S	S DIR("A")="Want to make "_$P(Y,U,2)_" a specifier"
   11: 	S DIR("??")="^W !!?5,""Making this field a specifier means that it will be used in"",!?5,""finding a specific entry when it is sent from one system to another."""
   12: 	S DIR("B")="NO",DIR(0)="Y" D ^DIR G Q:$D(DIRUT)!'Y
   13: E	K DIR("A") S DIR("A")="Is the value of this field unique for each entry"
   14: 	S DIR("??")="^W !!?5,""If this field is unique, then each entry in the file"",!?5,""has a different "_$P(DIU,U,2)_"."""
   15: 	D ^DIR G Q:$D(DIRUT) S:Y!('Y&(+DIU'=.01)) ^DD(DI,0,"SP",+DIU)=$S(Y:Y,1:"") G Q:'Y
   16: 	K DIR S DIR(0)="SO^"
   17: 	F %=0:0 S %=$O(^DD(DI,+DIU,1,%)) Q:+%'=%  I $D(^(%,0)),+^(0) S DIR(0)=DIR(0)_%_":"_$P(^(0),U,2)_"  "_$S($P(^(0),U,3)]"":$P(^(0),U,3),1:"REGULAR")_";"
   18: 	I $P(DIR(0),U,2)="" K:+DIU=.01 ^DD(DI,0,"SP",+DIU) G Q
   19: 	S DIR("?")="Enter one of the cross-references in the list, or press return."
   20: 	S DIR("A",1)="If one of the above provides a direct lookup by "_$P(DIU,U,2)_","
   21: 	S DIR("A")="please enter its number or name"
   22: 	D ^DIR I '$D(DTOUT),'$D(DUOUT) S ^DD(DI,0,"SP",+DIU)="1^"_$S(Y:$P(Y(0)," "),1:"")
   23: 	I $D(DIRUT),(+DIU=.01) K ^DD(DI,0,"SP",+DIU)
   24: Q	K DUOUT,DTOUT,C,DIR,DIRUT,DIROUT
   25: 	Q

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>