XBSAUTH ; IHS/ADC/GTH - SET AUTHORITIES ; [ 02/07/97 3:02 PM ]
;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
;
; This routine sets FileMan dictionary authorities:
; "AUDIT" "DD" "DEL" "LAYGO" "RD" "WR"
;
START ;
I $G(DUZ(0))'="@" W !,*7," Insufficient FileMan access. DUZ(0) is not ""@""." Q
S U="^",IOP=$I
D ^%ZIS
W !!,"^XBSAUTH - This program sets FileMan dictionary authorities."
D ^XBDSET
Q:'$D(^UTILITY("XBDSET",$J))
ASK ;
W !!,"Do you want to be asked before setting each file? (Y/N) Y// "
R XBSAASK:$G(DTIME,999)
S:XBSAASK="" XBSAASK="Y"
S XBSAASK=$E(XBSAASK)
I "YyNn"'[XBSAASK W *7 G ASK
S XBSAASK=$S("Yy"[XBSAASK:1,1:0)
W !!,"To delete a particular authority enter '@@'",!
S XBSAF=0
KILL XBSA
F XBSAX="AUDIT","DD","DEL","LAYGO","RD","WR" D GETAUTH
I 'XBSAF W !!,"Bye" Q
W !!,"I am going to set the following authorities:",!
F XBSAX="AUDIT","DD","DEL","LAYGO","RD","WR" D:@("XBSA("""_XBSAX_""")")'="" PRTAUTH
ASK2 ;
W !!,"Do you want to continue? (Y/N) N// "
R XBSAX:$G(DTIME,999)
S:XBSAX="" XBSAX="N"
S XBSAX=$E(XBSAX)
I "YyNn"'[XBSAX W *7 G ASK2
G:"Yy"'[XBSAX EOJ
W !
S XBSAFILE=""
F XBSAL=0:0 S XBSAFILE=$O(^UTILITY("XBDSET",$J,XBSAFILE)) Q:XBSAFILE="" D PROCESS
G EOJ
;
GETAUTH ; GET DICTIONARY AUTHORITIES
W !,"Enter ",XBSAX," authority: "
R @("XBSA("""_XBSAX_""")")
S:@("XBSA("""_XBSAX_""")")'="" XBSAF=1
Q
;
PRTAUTH ; PRINT DICTIONARY AUTHORITIES
W !,XBSAX,?6," to """,@("XBSA("""_XBSAX_""")"),""""
Q
;
PROCESS ;
S XBSAANS="Y"
W !,@("$P(^DIC("_XBSAFILE_",0),U,1)")
I XBSAASK W !?4,"Current authorities are: " D W "..OK? Y// "
. F XBSAX="AUDIT","DD","DEL","LAYGO","RD","WR" I $D(@("^DIC("_XBSAFILE_",0,"""_XBSAX_""")")),@("^("""_XBSAX_""")")'="" W ?31,XBSAX,?38,@("^("""_XBSAX_""")"),!
. Q
P2 ;
I XBSAASK R XBSAANS:$G(DTIME,999) S:XBSAANS="" XBSAANS="Y" S XBSAANS=$E(XBSAANS) I "YyNn"'[XBSAANS D P2ERR G P2
I "Yy"[XBSAANS D P2SETS Q
W " Skipping"
Q
;
P2SETS ;
NEW X
F X="AUDIT","DD","DEL","LAYGO","RD","WR" S:XBSA(X)]"" @("^DIC("_XBSAFILE_",0,"""_X_""")")=XBSA(X) KILL:XBSA(X)="@@" @("^DIC("_XBSAFILE_",0,"""_X_""")")
Q
;
P2ERR ;
W *7
F %=1:1:$L(XBSAANS) W @IOBS," ",@IOBS
Q
;
EOJ ;
KILL ^UTILITY("XBDSET",$J),XBSA,XBSAANS,XBSAASK,XBSAF,XBSAFILE,XBSAI,XBSAL,XBSAX
Q
;
XBSAUTH ; IHS/ADC/GTH - SET AUTHORITIES ; [ 02/07/97 3:02 PM ]
+1 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
+2 ;
+3 ; This routine sets FileMan dictionary authorities:
+4 ; "AUDIT" "DD" "DEL" "LAYGO" "RD" "WR"
+5 ;
START ;
+1 IF $GET(DUZ(0))'="@"
WRITE !,*7," Insufficient FileMan access. DUZ(0) is not ""@""."
QUIT
+2 SET U="^"
SET IOP=$IO
+3 DO ^%ZIS
+4 WRITE !!,"^XBSAUTH - This program sets FileMan dictionary authorities."
+5 DO ^XBDSET
+6 IF '$DATA(^UTILITY("XBDSET",$JOB))
QUIT
ASK ;
+1 WRITE !!,"Do you want to be asked before setting each file? (Y/N) Y// "
+2 READ XBSAASK:$GET(DTIME,999)
+3 IF XBSAASK=""
SET XBSAASK="Y"
+4 SET XBSAASK=$EXTRACT(XBSAASK)
+5 IF "YyNn"'[XBSAASK
WRITE *7
GOTO ASK
+6 SET XBSAASK=$SELECT("Yy"[XBSAASK:1,1:0)
+7 WRITE !!,"To delete a particular authority enter '@@'",!
+8 SET XBSAF=0
+9 KILL XBSA
+10 FOR XBSAX="AUDIT","DD","DEL","LAYGO","RD","WR"
DO GETAUTH
+11 IF 'XBSAF
WRITE !!,"Bye"
QUIT
+12 WRITE !!,"I am going to set the following authorities:",!
+13 FOR XBSAX="AUDIT","DD","DEL","LAYGO","RD","WR"
IF @("XBSA("""_XBSAX_""")")'=""
DO PRTAUTH
ASK2 ;
+1 WRITE !!,"Do you want to continue? (Y/N) N// "
+2 READ XBSAX:$GET(DTIME,999)
+3 IF XBSAX=""
SET XBSAX="N"
+4 SET XBSAX=$EXTRACT(XBSAX)
+5 IF "YyNn"'[XBSAX
WRITE *7
GOTO ASK2
+6 IF "Yy"'[XBSAX
GOTO EOJ
+7 WRITE !
+8 SET XBSAFILE=""
+9 FOR XBSAL=0:0
SET XBSAFILE=$ORDER(^UTILITY("XBDSET",$JOB,XBSAFILE))
IF XBSAFILE=""
QUIT
DO PROCESS
+10 GOTO EOJ
+11 ;
GETAUTH ; GET DICTIONARY AUTHORITIES
+1 WRITE !,"Enter ",XBSAX," authority: "
+2 READ @("XBSA("""_XBSAX_""")")
+3 IF @("XBSA("""_XBSAX_""")")'=""
SET XBSAF=1
+4 QUIT
+5 ;
PRTAUTH ; PRINT DICTIONARY AUTHORITIES
+1 WRITE !,XBSAX,?6," to """,@("XBSA("""_XBSAX_""")"),""""
+2 QUIT
+3 ;
PROCESS ;
+1 SET XBSAANS="Y"
+2 WRITE !,@("$P(^DIC("_XBSAFILE_",0),U,1)")
+3 IF XBSAASK
WRITE !?4,"Current authorities are: "
Begin DoDot:1
+4 FOR XBSAX="AUDIT","DD","DEL","LAYGO","RD","WR"
IF $DATA(@("^DIC("_XBSAFILE_",0,"""_XBSAX_""")"))
IF @("^("""_XBSAX_""")")'=""
WRITE ?31,XBSAX,?38,@("^("""_XBSAX_""")"),!
+5 QUIT
End DoDot:1
WRITE "..OK? Y// "
P2 ;
+1 IF XBSAASK
READ XBSAANS:$GET(DTIME,999)
IF XBSAANS=""
SET XBSAANS="Y"
SET XBSAANS=$EXTRACT(XBSAANS)
IF "YyNn"'[XBSAANS
DO P2ERR
GOTO P2
+2 IF "Yy"[XBSAANS
DO P2SETS
QUIT
+3 WRITE " Skipping"
+4 QUIT
+5 ;
P2SETS ;
+1 NEW X
+2 FOR X="AUDIT","DD","DEL","LAYGO","RD","WR"
IF XBSA(X)]""
SET @("^DIC("_XBSAFILE_",0,"""_X_""")")=XBSA(X)
IF XBSA(X)="@@"
KILL @("^DIC("_XBSAFILE_",0,"""_X_""")")
+3 QUIT
+4 ;
P2ERR ;
+1 WRITE *7
+2 FOR %=1:1:$LENGTH(XBSAANS)
WRITE @IOBS," ",@IOBS
+3 QUIT
+4 ;
EOJ ;
+1 KILL ^UTILITY("XBDSET",$JOB),XBSA,XBSAANS,XBSAASK,XBSAF,XBSAFILE,XBSAI,XBSAL,XBSAX
+2 QUIT
+3 ;
