DIU2 ;SFISC/XAK/GFT-EDIT FILE ;8:03 AM 24 Oct 2001 [ 04/02/2003 8:25 AM ]
;;22.0;VA FileMan;**1001**;APR 1, 2003
;;22.0;VA FileMan;**82**;Mar 30, 1999
;Per VHA Directive 10-93-142, this routine should not be modified.
;
;from DIU0
N S X=$P(^DIC(DA,0),U,1),D=@(DIU_"0)"),^(0)=X_U_$P(D,U,2,9) K ^DD(+$P(D,U,2),0,"NM") S ^("NM",X)="" Q:$D(Y)
I DUZ(0)]"" F DR=1:1:6 S D=$P("DD^RD^WR^DEL^LAYGO^AUDIT",U,DR),Y=$S($D(^DIC(DA,0,D)):^(D),1:"") D RW G Q:X=U
S X=$G(^("AUDIT"))
I X]"",DUZ(0)'="@" G OK:$TR(X,DUZ(0))=X
DDA K DIR S DIR("A")="DD AUDIT",DIR(0)="YO"
S:$D(^DD(DA,0,"DDA")) DIR("B")=$S(^("DDA")["Y":"YES",1:"NO")
S DIR("??")="^W !!?5,""Enter 'Y' (YES) if you want to audit the Data Dictionary changes"",!?5,""for this file."""
D ^DIR K DIR Q:$D(DTOUT)!$D(DUOUT) S ^DD(DA,0,"DDA")=$S(Y=1:"Y",1:"N")
OK S DIU(0)=$P(@(DIU_"0)"),U,2) K DIR
S %=DIU(0)'["O"+1
W !,"ASK 'OK' WHEN LOOKING UP AN ENTRY" D YN^DICN
I %>0 S $P(@(DIU_"0)"),U,2)=$P(DIU(0),"O")_$E("O",%)_$P(DIU(0),"O",2)
I '% W !?5,"Answer YES to cause a lookup into this file to verify the",!?5,"selection by prompting with '...OK? YES//'." G OK
I DUZ(0)="@",%'<0 D ^DIU21
Q K DIR,DIRUT,DTOUT,DUOUT,DIROUT Q
;
K ; CALLED BY ^DD(1,.01,"DEL",1,0)
N DIKREF,DG,DIR
S DIKREF=$$CREF^DILF(DIU),DG=@DIKREF@(0)
I $P($G(^DD(+$P(DG,U,2),0,"DI")),U,2)["Y" W $C(7)," CANNOT DELETE A RESTRICTED"_$S($P($G(^("DI")),U)["Y":" (ARCHIVE)",1:"")_" FILE!" Q
G G:'$O(@DIKREF@(0))
H W $C(7),!,"DO YOU WANT JUST TO DELETE THE "
I $P(DG,U,4)>1 W $P(DG,U,4)," FILE ENTRIES,"
E W "FILE CONTENTS,"
S %=2 W !?9,"& KEEP THE FILE DEFINITION" D YN^DICN
I %=0 W !,"Answer YES if you are just looking for a fast way to get rid of Entries",!! G H
I %<2 D:%=1 Q ;$T left TRUE, so FILE will not be deleted
.N S
.M S=@DIKREF@(0) K @DIKREF
.M @DIKREF@(0)=S ;save back the stuff hanging from zero node
.S $P(@DIKREF@(0),U,3,99)="",^DIC(DA,0,"GL")=DIU
G Q:$G(DIU(0))'["D"
S %=1 I $O(@DIKREF@(0)) W !?3,"IS IT OK TO DELETE THE '"_DIKREF_"' GLOBAL" D YN^DICN
I %=0 W !,"You can abort the deletion process at this point by typing '^'",!,"Answer NO if you want to save ",DIKREF," for redefinition at a later time.",!! G G
S:%=1 DIKLGLBL=DIKREF
I %<1 ;$T true means forget it!
SURE I $D(DDS),$D(DDACT) D
. F D Q:%Y'["?"
.. S %=2 W !,"SURE YOU WANT TO DELETE THE ENTIRE FILE" D YN^DICN
.. I %Y["?" D
... W !,"We are going to ",$S($D(DIKLGLBL):"Delete data associated with File #"_DA,1:"Leave the data associated with File #"_DA)
... W !,"Answer YES if want to continue with the DELETION of the DD, Templates, Forms,"
... W !,"etc. for File #"_DA
I %-1
Q
;
RW W !,$P("DATA DICTIONARY^READ^WRITE^DELETE^LAYGO^AUDIT",U,DR)," ACCESS: " G R:Y="" W Y I DUZ(0)'="@" F X=1:1:$L(Y) Q:DUZ(0)[$E(Y,X) G Q:X=$L(Y)
W "// "
R R X:DTIME S:'$T X=U,DTOUT=1 Q:X=""
I X["@" G V:Y="" W $C(7)," PROTECTION ERASED!" K ^(D) Q
Q:X[U
I X["?" W !,"ENTER CODE(S) TO RESTRICT USER'S ACCESS TO THIS FILE" G RW
V I DUZ(0)'="@" F Z=1:1:$L(X) I DUZ(0)'[$E(X,Z) W $C(7),"??" G RW
S ^(D)=X Q
EN ;
Q:'$D(DIU) G EN^DIU0
DIU2 ;SFISC/XAK/GFT-EDIT FILE ;8:03 AM 24 Oct 2001 [ 04/02/2003 8:25 AM ]
+1 ;;22.0;VA FileMan;**1001**;APR 1, 2003
+2 ;;22.0;VA FileMan;**82**;Mar 30, 1999
+3 ;Per VHA Directive 10-93-142, this routine should not be modified.
+4 ;
+5 ;from DIU0
N SET X=$PIECE(^DIC(DA,0),U,1)
SET D=@(DIU_"0)")
SET ^(0)=X_U_$PIECE(D,U,2,9)
KILL ^DD(+$PIECE(D,U,2),0,"NM")
SET ^("NM",X)=""
IF $DATA(Y)
QUIT
+1 IF DUZ(0)]""
FOR DR=1:1:6
SET D=$PIECE("DD^RD^WR^DEL^LAYGO^AUDIT",U,DR)
SET Y=$SELECT($DATA(^DIC(DA,0,D)):^(D),1:"")
DO RW
IF X=U
GOTO Q
+2 SET X=$GET(^("AUDIT"))
+3 IF X]""
IF DUZ(0)'="@"
IF $TRANSLATE(X,DUZ(0))=X
GOTO OK
DDA KILL DIR
SET DIR("A")="DD AUDIT"
SET DIR(0)="YO"
+1 IF $DATA(^DD(DA,0,"DDA"))
SET DIR("B")=$SELECT(^("DDA")["Y":"YES",1:"NO")
+2 SET DIR("??")="^W !!?5,""Enter 'Y' (YES) if you want to audit the Data Dictionary changes"",!?5,""for this file."""
+3 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
SET ^DD(DA,0,"DDA")=$SELECT(Y=1:"Y",1:"N")
OK SET DIU(0)=$PIECE(@(DIU_"0)"),U,2)
KILL DIR
+1 SET %=DIU(0)'["O"+1
+2 WRITE !,"ASK 'OK' WHEN LOOKING UP AN ENTRY"
DO YN^DICN
+3 IF %>0
SET $PIECE(@(DIU_"0)"),U,2)=$PIECE(DIU(0),"O")_$EXTRACT("O",%)_$PIECE(DIU(0),"O",2)
+4 IF '%
WRITE !?5,"Answer YES to cause a lookup into this file to verify the",!?5,"selection by prompting with '...OK? YES//'."
GOTO OK
+5 IF DUZ(0)="@"
IF %'<0
DO ^DIU21
Q KILL DIR,DIRUT,DTOUT,DUOUT,DIROUT
QUIT
+1 ;
K ; CALLED BY ^DD(1,.01,"DEL",1,0)
+1 NEW DIKREF,DG,DIR
+2 SET DIKREF=$$CREF^DILF(DIU)
SET DG=@DIKREF@(0)
+3 IF $PIECE($GET(^DD(+$PIECE(DG,U,2),0,"DI")),U,2)["Y"
WRITE $CHAR(7)," CANNOT DELETE A RESTRICTED"_$SELECT($PIECE($GET(^("DI")),U)["Y":" (ARCHIVE)",1:"")_" FILE!"
QUIT
+4 IF '$ORDER(@DIKREF@(0))
GOTO G
H WRITE $CHAR(7),!,"DO YOU WANT JUST TO DELETE THE "
+1 IF $PIECE(DG,U,4)>1
WRITE $PIECE(DG,U,4)," FILE ENTRIES,"
+2 IF '$TEST
WRITE "FILE CONTENTS,"
+3 SET %=2
WRITE !?9,"& KEEP THE FILE DEFINITION"
DO YN^DICN
+4 IF %=0
WRITE !,"Answer YES if you are just looking for a fast way to get rid of Entries",!!
GOTO H
+5 ;$T left TRUE, so FILE will not be deleted
IF %<2
IF %=1
Begin DoDot:1
+6 NEW S
+7 MERGE S=@DIKREF@(0)
KILL @DIKREF
+8 ;save back the stuff hanging from zero node
MERGE @DIKREF@(0)=S
+9 SET $PIECE(@DIKREF@(0),U,3,99)=""
SET ^DIC(DA,0,"GL")=DIU
End DoDot:1
QUIT
G IF $GET(DIU(0))'["D"
QUIT
+1 SET %=1
IF $ORDER(@DIKREF@(0))
WRITE !?3,"IS IT OK TO DELETE THE '"_DIKREF_"' GLOBAL"
DO YN^DICN
+2 IF %=0
WRITE !,"You can abort the deletion process at this point by typing '^'",!,"Answer NO if you want to save ",DIKREF," for redefinition at a later time.",!!
GOTO G
+3 IF %=1
SET DIKLGLBL=DIKREF
+4 ;$T true means forget it!
IF %<1
SURE IF $DATA(DDS)
IF $DATA(DDACT)
Begin DoDot:1
+1 FOR
Begin DoDot:2
+2 SET %=2
WRITE !,"SURE YOU WANT TO DELETE THE ENTIRE FILE"
DO YN^DICN
+3 IF %Y["?"
Begin DoDot:3
+4 WRITE !,"We are going to ",$SELECT($DATA(DIKLGLBL):"Delete data associated with File #"_DA,1:"Leave the data associated with File #"_DA)
+5 WRITE !,"Answer YES if want to continue with the DELETION of the DD, Templates, Forms,"
+6 WRITE !,"etc. for File #"_DA
End DoDot:3
End DoDot:2
IF %Y'["?"
QUIT
End DoDot:1
+7 IF %-1
+8 QUIT
+9 ;
RW WRITE !,$PIECE("DATA DICTIONARY^READ^WRITE^DELETE^LAYGO^AUDIT",U,DR)," ACCESS: "
IF Y=""
GOTO R
WRITE Y
IF DUZ(0)'="@"
FOR X=1:1:$LENGTH(Y)
IF DUZ(0)[$EXTRACT(Y,X)
QUIT
IF X=$LENGTH(Y)
GOTO Q
+1 WRITE "// "
R READ X:DTIME
IF '$TEST
SET X=U
SET DTOUT=1
IF X=""
QUIT
+1 IF X["@"
IF Y=""
GOTO V
WRITE $CHAR(7)," PROTECTION ERASED!"
KILL ^(D)
QUIT
+2 IF X[U
QUIT
+3 IF X["?"
WRITE !,"ENTER CODE(S) TO RESTRICT USER'S ACCESS TO THIS FILE"
GOTO RW
V IF DUZ(0)'="@"
FOR Z=1:1:$LENGTH(X)
IF DUZ(0)'[$EXTRACT(X,Z)
WRITE $CHAR(7),"??"
GOTO RW
+1 SET ^(D)=X
QUIT
EN ;
+1 IF '$DATA(DIU)
QUIT
GOTO EN^DIU0
