source: IHS-VA_UTILITIES-XB/trunk/XBSAUTH.m@ 973

Last change on this file since 973 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.

File size: 2.2 KB
RevLine 
[641]1XBSAUTH ; IHS/ADC/GTH - SET AUTHORITIES ; [ 02/07/97 3:02 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4 ; This routine sets FileMan dictionary authorities:
5 ; "AUDIT" "DD" "DEL" "LAYGO" "RD" "WR"
6 ;
7START ;
8 I $G(DUZ(0))'="@" W !,*7," Insufficient FileMan access. DUZ(0) is not ""@""." Q
9 S U="^",IOP=$I
10 D ^%ZIS
11 W !!,"^XBSAUTH - This program sets FileMan dictionary authorities."
12 D ^XBDSET
13 Q:'$D(^UTILITY("XBDSET",$J))
14ASK ;
15 W !!,"Do you want to be asked before setting each file? (Y/N) Y// "
16 R XBSAASK:$G(DTIME,999)
17 S:XBSAASK="" XBSAASK="Y"
18 S XBSAASK=$E(XBSAASK)
19 I "YyNn"'[XBSAASK W *7 G ASK
20 S XBSAASK=$S("Yy"[XBSAASK:1,1:0)
21 W !!,"To delete a particular authority enter '@@'",!
22 S XBSAF=0
23 KILL XBSA
24 F XBSAX="AUDIT","DD","DEL","LAYGO","RD","WR" D GETAUTH
25 I 'XBSAF W !!,"Bye" Q
26 W !!,"I am going to set the following authorities:",!
27 F XBSAX="AUDIT","DD","DEL","LAYGO","RD","WR" D:@("XBSA("""_XBSAX_""")")'="" PRTAUTH
28ASK2 ;
29 W !!,"Do you want to continue? (Y/N) N// "
30 R XBSAX:$G(DTIME,999)
31 S:XBSAX="" XBSAX="N"
32 S XBSAX=$E(XBSAX)
33 I "YyNn"'[XBSAX W *7 G ASK2
34 G:"Yy"'[XBSAX EOJ
35 W !
36 S XBSAFILE=""
37 F XBSAL=0:0 S XBSAFILE=$O(^UTILITY("XBDSET",$J,XBSAFILE)) Q:XBSAFILE="" D PROCESS
38 G EOJ
39 ;
40GETAUTH ; GET DICTIONARY AUTHORITIES
41 W !,"Enter ",XBSAX," authority: "
42 R @("XBSA("""_XBSAX_""")")
43 S:@("XBSA("""_XBSAX_""")")'="" XBSAF=1
44 Q
45 ;
46PRTAUTH ; PRINT DICTIONARY AUTHORITIES
47 W !,XBSAX,?6," to """,@("XBSA("""_XBSAX_""")"),""""
48 Q
49 ;
50PROCESS ;
51 S XBSAANS="Y"
52 W !,@("$P(^DIC("_XBSAFILE_",0),U,1)")
53 I XBSAASK W !?4,"Current authorities are: " D W "..OK? Y// "
54 . F XBSAX="AUDIT","DD","DEL","LAYGO","RD","WR" I $D(@("^DIC("_XBSAFILE_",0,"""_XBSAX_""")")),@("^("""_XBSAX_""")")'="" W ?31,XBSAX,?38,@("^("""_XBSAX_""")"),!
55 . Q
56P2 ;
57 I XBSAASK R XBSAANS:$G(DTIME,999) S:XBSAANS="" XBSAANS="Y" S XBSAANS=$E(XBSAANS) I "YyNn"'[XBSAANS D P2ERR G P2
58 I "Yy"[XBSAANS D P2SETS Q
59 W " Skipping"
60 Q
61 ;
62P2SETS ;
63 NEW X
64 F X="AUDIT","DD","DEL","LAYGO","RD","WR" S:XBSA(X)]"" @("^DIC("_XBSAFILE_",0,"""_X_""")")=XBSA(X) KILL:XBSA(X)="@@" @("^DIC("_XBSAFILE_",0,"""_X_""")")
65 Q
66 ;
67P2ERR ;
68 W *7
69 F %=1:1:$L(XBSAANS) W @IOBS," ",@IOBS
70 Q
71 ;
72EOJ ;
73 KILL ^UTILITY("XBDSET",$J),XBSA,XBSAANS,XBSAASK,XBSAF,XBSAFILE,XBSAI,XBSAL,XBSAX
74 Q
75 ;
Note: See TracBrowser for help on using the repository browser.