DIU4.m

DIU4 ;SFISC/XAK-SPECIFIER ;6/11/93  2:29 PM

 ;;22.0;VA FileMan;;Mar 30, 1999

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 W ! S DIU=Y K DIR G S:'$D(^DD(DI,0,"SP",+Y))

 S DIR("A",1)=$P(DIU,U,2)_" is already a specifier."

 S DIR("A")="Do you want to delete it"

 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."""

 S DIR("B")="NO",DIR(0)="Y" D ^DIR G Q:$D(DTOUT)!$D(DUOUT),E:'Y

 K:Y ^DD(DI,0,"SP",+DIU) G Q

S S DIR("A")="Want to make "_$P(Y,U,2)_" a specifier"

 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."""

 S DIR("B")="NO",DIR(0)="Y" D ^DIR G Q:$D(DIRUT)!'Y

E K DIR("A") S DIR("A")="Is the value of this field unique for each entry"

 S DIR("??")="^W !!?5,""If this field is unique, then each entry in the file"",!?5,""has a different "_$P(DIU,U,2)_"."""

 D ^DIR G Q:$D(DIRUT) S:Y!('Y&(+DIU'=.01)) ^DD(DI,0,"SP",+DIU)=$S(Y:Y,1:"") G Q:'Y

 K DIR S DIR(0)="SO^"

 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")_";"

 I $P(DIR(0),U,2)="" K:+DIU=.01 ^DD(DI,0,"SP",+DIU) G Q

 S DIR("?")="Enter one of the cross-references in the list, or press return."

 S DIR("A",1)="If one of the above provides a direct lookup by "_$P(DIU,U,2)_","

 S DIR("A")="please enter its number or name"

 D ^DIR I '$D(DTOUT),'$D(DUOUT) S ^DD(DI,0,"SP",+DIU)="1^"_$S(Y:$P(Y(0)," "),1:"")

 I $D(DIRUT),(+DIU=.01) K ^DD(DI,0,"SP",+DIU)

Q K DUOUT,DTOUT,C,DIR,DIRUT,DIROUT

 Q

DIU4      ;SFISC/XAK-SPECIFIER ;6/11/93  2:29 PM

 +1       ;;22.0;VA FileMan;;Mar 30, 1999

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +3        WRITE !

           SET DIU=Y

           KILL DIR

           IF '$DATA(^DD(DI,0,"SP",+Y))

               GOTO S

 +4        SET DIR("A",1)=$PIECE(DIU,U,2)_" is already a specifier."

 +5        SET DIR("A")="Do you want to delete it"

 +6        SET 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."""

 +7        SET DIR("B")="NO"

           SET DIR(0)="Y"

           DO ^DIR

           IF $DATA(DTOUT)!$DATA(DUOUT)

               GOTO Q

           IF 'Y

               GOTO E

 +8        IF Y

               KILL ^DD(DI,0,"SP",+DIU)

           GOTO Q

S          SET DIR("A")="Want to make "_$PIECE(Y,U,2)_" a specifier"

 +1        SET 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."""

 +2        SET DIR("B")="NO"

           SET DIR(0)="Y"

           DO ^DIR

           IF $DATA(DIRUT)!'Y

               GOTO Q

E          KILL DIR("A")

           SET DIR("A")="Is the value of this field unique for each entry"

 +1        SET DIR("??")="^W !!?5,""If this field is unique, then each entry in the file"",!?5,""has a different "_$PIECE(DIU,U,2)_"."""

 +2        DO ^DIR

           IF $DATA(DIRUT)

               GOTO Q

           IF Y!('Y&(+DIU'=.01))

               SET ^DD(DI,0,"SP",+DIU)=$SELECT(Y:Y,1:"")

           IF 'Y

               GOTO Q

 +3        KILL DIR

           SET DIR(0)="SO^"

 +4        FOR %=0:0

               SET %=$ORDER(^DD(DI,+DIU,1,%))

               IF +%'=%

                   QUIT 

               IF $DATA(^(%,0))

                   IF +^(0)

                       SET DIR(0)=DIR(0)_%_":"_$PIECE(^(0),U,2)_"  "_$SELECT($PIECE(^(0),U,3)]"":$PIECE(^(0),U,3),1:"REGULAR")_";"

 +5        IF $PIECE(DIR(0),U,2)=""

               IF +DIU=.01

                   KILL ^DD(DI,0,"SP",+DIU)

               GOTO Q

 +6        SET DIR("?")="Enter one of the cross-references in the list, or press return."

 +7        SET DIR("A",1)="If one of the above provides a direct lookup by "_$PIECE(DIU,U,2)_","

 +8        SET DIR("A")="please enter its number or name"

 +9        DO ^DIR

           IF '$DATA(DTOUT)

               IF '$DATA(DUOUT)

                   SET ^DD(DI,0,"SP",+DIU)="1^"_$SELECT(Y:$PIECE(Y(0)," "),1:"")

 +10       IF $DATA(DIRUT)

               IF (+DIU=.01)

                   KILL ^DD(DI,0,"SP",+DIU)

Q          KILL DUOUT,DTOUT,C,DIR,DIRUT,DIROUT

 +1        QUIT