- 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 ;