source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIU2.m@ 691

Last change on this file since 691 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.9 KB
RevLine 
[613]1DIU2 ;SFISC/XAK/GFT-EDIT FILE ;8:03 AM 24 Oct 2001
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
6N 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)
7 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
8 S X=$G(^("AUDIT"))
9 I X]"",DUZ(0)'="@" G OK:$TR(X,DUZ(0))=X
10DDA K DIR S DIR("A")="DD AUDIT",DIR(0)="YO"
11 S:$D(^DD(DA,0,"DDA")) DIR("B")=$S(^("DDA")["Y":"YES",1:"NO")
12 S DIR("??")="^W !!?5,""Enter 'Y' (YES) if you want to audit the Data Dictionary changes"",!?5,""for this file."""
13 D ^DIR K DIR Q:$D(DTOUT)!$D(DUOUT) S ^DD(DA,0,"DDA")=$S(Y=1:"Y",1:"N")
14OK S DIU(0)=$P(@(DIU_"0)"),U,2) K DIR
15 S %=DIU(0)'["O"+1
16 W !,"ASK 'OK' WHEN LOOKING UP AN ENTRY" D YN^DICN
17 I %>0 S $P(@(DIU_"0)"),U,2)=$P(DIU(0),"O")_$E("O",%)_$P(DIU(0),"O",2)
18 I '% W !?5,"Answer YES to cause a lookup into this file to verify the",!?5,"selection by prompting with '...OK? YES//'." G OK
19 I DUZ(0)="@",%'<0 D ^DIU21
20Q K DIR,DIRUT,DTOUT,DUOUT,DIROUT Q
21 ;
22K ; CALLED BY ^DD(1,.01,"DEL",1,0)
23 N DIKREF,DG,DIR
24 S DIKREF=$$CREF^DILF(DIU),DG=@DIKREF@(0)
25 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
26 G G:'$O(@DIKREF@(0))
27H W $C(7),!,"DO YOU WANT JUST TO DELETE THE "
28 I $P(DG,U,4)>1 W $P(DG,U,4)," FILE ENTRIES,"
29 E W "FILE CONTENTS,"
30 S %=2 W !?9,"& KEEP THE FILE DEFINITION" D YN^DICN
31 I %=0 W !,"Answer YES if you are just looking for a fast way to get rid of Entries",!! G H
32 I %<2 D:%=1 Q ;$T left TRUE, so FILE will not be deleted
33 .N S
34 .M S=@DIKREF@(0) K @DIKREF
35 .M @DIKREF@(0)=S ;save back the stuff hanging from zero node
36 .S $P(@DIKREF@(0),U,3,99)="",^DIC(DA,0,"GL")=DIU
37G Q:$G(DIU(0))'["D"
38 S %=1 I $O(@DIKREF@(0)) W !?3,"IS IT OK TO DELETE THE '"_DIKREF_"' GLOBAL" D YN^DICN
39 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
40 S:%=1 DIKLGLBL=DIKREF
41 I %<1 ;$T true means forget it!
42SURE I $D(DDS),$D(DDACT) D
43 . F D Q:%Y'["?"
44 .. S %=2 W !,"SURE YOU WANT TO DELETE THE ENTIRE FILE" D YN^DICN
45 .. I %Y["?" D
46 ... W !,"We are going to ",$S($D(DIKLGLBL):"Delete data associated with File #"_DA,1:"Leave the data associated with File #"_DA)
47 ... W !,"Answer YES if want to continue with the DELETION of the DD, Templates, Forms,"
48 ... W !,"etc. for File #"_DA
49 I %-1
50 Q
51 ;
52RW 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)
53 W "// "
54R R X:DTIME S:'$T X=U,DTOUT=1 Q:X=""
55 I X["@" G V:Y="" W $C(7)," PROTECTION ERASED!" K ^(D) Q
56 Q:X[U
57 I X["?" W !,"ENTER CODE(S) TO RESTRICT USER'S ACCESS TO THIS FILE" G RW
58V I DUZ(0)'="@" F Z=1:1:$L(X) I DUZ(0)'[$E(X,Z) W $C(7),"??" G RW
59 S ^(D)=X Q
60EN ;
61 Q:'$D(DIU) G EN^DIU0
Note: See TracBrowser for help on using the repository browser.