- DIU3 ;SFISC/GFT-IDENTIFIERS ;6/22/98 12:25
- ;;22.0;VA FileMan;;Mar 30, 1999
- ;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- 3 ;
- S %=2,X="W """"",DA=+Y
- I $D(^DD(DI,0,"ID",+Y)) W !,"'",$P(Y,U,2),"' is already an Identifier; Want to delete it" D YN^DICN Q:%'=1 K ^DD(DI,0,"ID",+Y) D:$D(DDA) A Q
- S %=$O(^DD("KEY","AP",DI,"P",0)) I %,$O(^DD("KEY",%,2,"B",+Y,0)) D
- . W !!,$C(7)," **NOTE:'"_$P(Y,U,2)_"' is part of the PRIMARY KEY for this file."
- . W !," Making it an Identifier is redundant.",! Q
- S %=2 W !,"Want to make '",$P(Y,U,2),"' an Identifier" D YN^DICN Q:%-1
- S %=$O(^DD(DI,0,"NM",0))
- W !,"Want to display "_$P(Y,U,2)_" whenever a lookup is done",!," on an entry in the '"_%_"' File" S %=1 D YN^DICN
- I %-1 G S:%=2&(Y-.001) W $C(7),"??" Q
- S V=$P(Y(0),U,2),X=$P(Y(0),U,4),D="W",%="(^(0)",%Y=$P(X,";")
- I %Y'=0 S D=$S(+%Y=%Y:"",V["S":"""""",1:""""),%="(^("_D_%Y_D_")",D="W"_$S(+Y'=.001:":$D(^("_$E(D)_%Y_$E(D)_"))",1:"")
- S %Y=$P(X,";",2),X=$S(+Y=.001:"Y",%Y:"$P"_%_",U,"_%Y_")",1:"$E"_%_","_+$E(%Y,2,9)_","_$P(%Y,",",2)_")")
- I V["D" N DIRUT D Q:$D(DIRUT)
- . N DIR,DIOUT,DTOUT,DUOUT,DIROUT,Y,DISAVX S DISAVX=X
- . S DIR(0)="S^1:MM-DD-YY (ex. 06-01-00);2:MM-DD-YYYY (ex. 06-01-2000);3:MMM DD,YYYY (ex. Jun 1,2000)"
- . S DIR("A")="Select date format",DIR("B")=1
- . D ^DIR S X=DISAVX
- . I Y=2!(Y=3) S X="$$FMTE^DILIBF("_X_","_$S(Y=2:6,1:5)_")" Q
- . S X="$E("_X_",4,5)_""-""_$E("_X_",6,7)_""-""_$E("_X_",2,3)" Q
- I V["P" S X="S %I=Y,Y=$S('$D"_%_"):"""",$D(^"_$P(Y(0),U,3)_"+"_X_",0))#2:$P(^(0),U,1),1:""""),C=$P(^DD("_+$P(V,"P",2)_",.01,0),U,2) D Y^DIQ:Y]"""" W "" "",Y,@(""$E(""_DIC_""%I,0),0)"") S Y=%I K %I" G S
- I V["V" S X=$P(Y(0),U,4),X="S DIY=$S($D(@(DIC_(+Y)_"","""""_$P(X,";",1)_""""")"")):$P(^("""_$P(X,";",1)_"""),U,"_$P(X,";",2)_"),1:"""") D NAME^DICM2 W "" "",DINAME,@(""$E(""_DIC_""Y,0),0)"")" G S
- I V["S" S X="@(""$P($P($C(59)_$S($D(^DD("_DI_","_+Y_",0)):$P(^(0),U,3),1:0)_$E(""_DIC_""Y,0),0),$C(59)_"_X_"_"""":"""",2),$C(59),1)"")"
- S X=D_" "" "","_X
- S S ^DD(DI,0,"ID",+Y)=X,X=DIU I $D(DDA) S A0="IDENTIFIER^",A1="",A2="ID" D IT^DICATTA
- I N S V=N,P=$O(^DD(J(N-1),"SB",DI,0)) S:P="" P=-1 S X="^DD(J(N-1),P,"
- S @("X="_X_"0)"),%=$P(X,U,2) I %'["I" S ^(0)=$P(X,U)_U_%_"I"_U_$P(X,U,3,99)
- I N S DIFLD=+Y D WAIT^DICD,0^DIVR S:DE?.E1" " DE=$E(DE,1,$L(DE)-2) X DE K DE,DA,X,W,DIFLD
- Q
- ;
- A S A0="IDENTIFIER^",A1="ID",A2="" D IT^DICATTA K A0,A1,A2 Q
- ;
- DIU3 ;SFISC/GFT-IDENTIFIERS ;6/22/98 12:25
- +1 ;;22.0;VA FileMan;;Mar 30, 1999
- +2 ;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- 3 ;
- +1 SET %=2
- SET X="W """""
- SET DA=+Y
- +2 IF $DATA(^DD(DI,0,"ID",+Y))
- WRITE !,"'",$PIECE(Y,U,2),"' is already an Identifier; Want to delete it"
- DO YN^DICN
- IF %'=1
- QUIT
- KILL ^DD(DI,0,"ID",+Y)
- IF $DATA(DDA)
- DO A
- QUIT
- +3 SET %=$ORDER(^DD("KEY","AP",DI,"P",0))
- IF %
- IF $ORDER(^DD("KEY",%,2,"B",+Y,0))
- Begin DoDot:1
- +4 WRITE !!,$CHAR(7)," **NOTE:'"_$PIECE(Y,U,2)_"' is part of the PRIMARY KEY for this file."
- +5 WRITE !," Making it an Identifier is redundant.",!
- QUIT
- End DoDot:1
- +6 SET %=2
- WRITE !,"Want to make '",$PIECE(Y,U,2),"' an Identifier"
- DO YN^DICN
- IF %-1
- QUIT
- +7 SET %=$ORDER(^DD(DI,0,"NM",0))
- +8 WRITE !,"Want to display "_$PIECE(Y,U,2)_" whenever a lookup is done",!," on an entry in the '"_%_"' File"
- SET %=1
- DO YN^DICN
- +9 IF %-1
- IF %=2&(Y-.001)
- GOTO S
- WRITE $CHAR(7),"??"
- QUIT
- +10 SET V=$PIECE(Y(0),U,2)
- SET X=$PIECE(Y(0),U,4)
- SET D="W"
- SET %="(^(0)"
- SET %Y=$PIECE(X,";")
- +11 IF %Y'=0
- SET D=$SELECT(+%Y=%Y:"",V["S":"""""",1:"""")
- SET %="(^("_D_%Y_D_")"
- SET D="W"_$SELECT(+Y'=.001:":$D(^("_$EXTRACT(D)_%Y_$EXTRACT(D)_"))",1:"")
- +12 SET %Y=$PIECE(X,";",2)
- SET X=$SELECT(+Y=.001:"Y",%Y:"$P"_%_",U,"_%Y_")",1:"$E"_%_","_+$EXTRACT(%Y,2,9)_","_$PIECE(%Y,",",2)_")")
- +13 IF V["D"
- NEW DIRUT
- Begin DoDot:1
- +14 NEW DIR,DIOUT,DTOUT,DUOUT,DIROUT,Y,DISAVX
- SET DISAVX=X
- +15 SET DIR(0)="S^1:MM-DD-YY (ex. 06-01-00);2:MM-DD-YYYY (ex. 06-01-2000);3:MMM DD,YYYY (ex. Jun 1,2000)"
- +16 SET DIR("A")="Select date format"
- SET DIR("B")=1
- +17 DO ^DIR
- SET X=DISAVX
- +18 IF Y=2!(Y=3)
- SET X="$$FMTE^DILIBF("_X_","_$SELECT(Y=2:6,1:5)_")"
- QUIT
- +19 SET X="$E("_X_",4,5)_""-""_$E("_X_",6,7)_""-""_$E("_X_",2,3)"
- QUIT
- End DoDot:1
- IF $DATA(DIRUT)
- QUIT
- +20 IF V["P"
- SET X="S %I=Y,Y=$S('$D"_%_"):"""",$D(^"_$PIECE(Y(0),U,3)_"+"_X_",0))#2:$P(^(0),U,1),1:""""),C=$P(^DD("_+$PIECE(V,"P",2)_",.01,0),U,2) D Y^DIQ:Y]"""" W "" "",Y,@(""$E(""_DIC_""%I,0),0)"") S Y=%I K %I"
- GOTO S
- +21 IF V["V"
- SET X=$PIECE(Y(0),U,4)
- SET X="S DIY=$S($D(@(DIC_(+Y)_"","""""_$PIECE(X,";",1)_""""")"")):$P(^("""_$PIECE(X,";",1)_"""),U,"_$PIECE(X,";",2)_"),1:"""") D NAME^DICM2 W "" "",DINAME,@(""$E(""_DIC_""Y,0),0)"")"
- GOTO S
- +22 IF V["S"
- SET X="@(""$P($P($C(59)_$S($D(^DD("_DI_","_+Y_",0)):$P(^(0),U,3),1:0)_$E(""_DIC_""Y,0),0),$C(59)_"_X_"_"""":"""",2),$C(59),1)"")"
- +23 SET X=D_" "" "","_X
- S SET ^DD(DI,0,"ID",+Y)=X
- SET X=DIU
- IF $DATA(DDA)
- SET A0="IDENTIFIER^"
- SET A1=""
- SET A2="ID"
- DO IT^DICATTA
- +1 IF N
- SET V=N
- SET P=$ORDER(^DD(J(N-1),"SB",DI,0))
- IF P=""
- SET P=-1
- SET X="^DD(J(N-1),P,"
- +2 SET @("X="_X_"0)")
- SET %=$PIECE(X,U,2)
- IF %'["I"
- SET ^(0)=$PIECE(X,U)_U_%_"I"_U_$PIECE(X,U,3,99)
- +3 IF N
- SET DIFLD=+Y
- DO WAIT^DICD
- DO 0^DIVR
- IF DE?.E1" "
- SET DE=$EXTRACT(DE,1,$LENGTH(DE)-2)
- XECUTE DE
- KILL DE,DA,X,W,DIFLD
- +4 QUIT
- +5 ;
- A SET A0="IDENTIFIER^"
- SET A1="ID"
- SET A2=""
- DO IT^DICATTA
- KILL A0,A1,A2
- QUIT
- +1 ;
