DIU4 ;SFISC/XAK-SPECIFIER ;6/11/93 2:29 PM
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIU4 1914 printed Nov 22, 2024@18:04:35 Page 2
DIU4 ;SFISC/XAK-SPECIFIER ;6/11/93 2:29 PM
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
+7 WRITE !
SET DIU=Y
KILL DIR
if '$DATA(^DD(DI,0,"SP",+Y))
GOTO S
+8 SET DIR("A",1)=$PIECE(DIU,U,2)_" is already a specifier."
+9 SET DIR("A")="Do you want to delete it"
+10 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."""
+11 SET DIR("B")="NO"
SET DIR(0)="Y"
DO ^DIR
if $DATA(DTOUT)!$DATA(DUOUT)
GOTO Q
if 'Y
GOTO E
+12 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
