AUSAUTH.m

AUSAUTH ;SET AUTHORITIES [ 06/06/87  1:53 PM ]

 ;

BEGIN S DUZ(0)="@",U="^" D CURRENT^%ZIS

 W !!,"This program sets FileMan dictionary authorities by a range"

 W !,"of dictionary numbers.",!!

 ;

 D ^%AUDSET

 G:'$D(^UTILITY("AUDSET",$J)) EOJ

ASK W !!,"Do you want to be asked before setting each file? (Y/N) Y// " R AUSAASK S:AUSAASK="" AUSAASK="Y" S AUSAASK=$E(AUSAASK) I "YyNn"'[AUSAASK W *7 G ASK

 S AUSAASK=$S("Yy"[AUSAASK:1,1:0)

 W !

 K AUSA F AUSAX="DD","DEL","LAYGO","RD","WR" D GETAUTH

 W !!,"I am going to set the following authorities:",!

 F AUSAX="DD","DEL","LAYGO","RD","WR" D PRTAUTH

ASK2 W !!,"Do you want to continue? (Y/N) N// " R AUSAX S:AUSAX="" AUSAX="N" S AUSAX=$E(AUSAX) I "YyNn"'[AUSAX W *7 G ASK2

 G:"Yy"'[AUSAX EOJ

 W !

 S AUSAFILE="" F AUSAL=0:0 S AUSAFILE=$O(^UTILITY("AUDSET",$J,AUSAFILE)) Q:AUSAFILE=""  D PROCESS

 G EOJ

 ;

GETAUTH ; GET DICTIONARY AUTHORITIES

 W !,"Enter ",AUSAX," authority: " R @("AUSA("""_AUSAX_""")")

 Q

 ;

PRTAUTH ; PRINT DICTIONARY AUTHORITIES

 W !,AUSAX,?6," to """,@("AUSA("""_AUSAX_""")"),""""

 Q

 ;

PROCESS ;

 S AUSAANS="Y"

 W !,@("$P(^DIC("_AUSAFILE_",0),U,1)"),$S(AUSAASK:"..OK? Y// ",1:"")

P2 I AUSAASK R AUSAANS S:AUSAANS="" AUSAANS="Y" S AUSAANS=$E(AUSAANS) I "YyNn"'[AUSAANS D P2ERR G P2

 I "Yy"[AUSAANS D P2SETS Q

 W "  Skipping"

 Q

P2SETS ;

 S @("^DIC("_AUSAFILE_",0,""DD"")")=AUSA("DD")

 S ^("DEL")=AUSA("DEL")

 S ^("LAYGO")=AUSA("LAYGO")

 S ^("RD")=AUSA("RD")

 S ^("WR")=AUSA("WR")

 W "  Done"

 Q

P2ERR W *7 F AUSAI=1:1:$L(AUSAANS) W @BS," ",@BS

 Q

 ;

EOJ ;

 K ^UTILITY("AUDSET",$J)

 K AUSA

 K AUSAANS,AUSAASK,AUSAFILE,AUSAI,AUSAL,AUSAX

 K BS,FF,RM,SL,SUB,XY

 W !!,"Bye",!!

 Q

AUSAUTH   ;SET AUTHORITIES [ 06/06/87  1:53 PM ]

 +1       ;

BEGIN      SET DUZ(0)="@"

           SET U="^"

           DO CURRENT^%ZIS

 +1        WRITE !!,"This program sets FileMan dictionary authorities by a range"

 +2        WRITE !,"of dictionary numbers.",!!

 +3       ;

 +4        DO ^%AUDSET

 +5        IF '$DATA(^UTILITY("AUDSET",$JOB))

               GOTO EOJ

ASK        WRITE !!,"Do you want to be asked before setting each file? (Y/N) Y// "

           READ AUSAASK

           IF AUSAASK=""

               SET AUSAASK="Y"

           SET AUSAASK=$EXTRACT(AUSAASK)

           IF "YyNn"'[AUSAASK

               WRITE *7

               GOTO ASK

 +1        SET AUSAASK=$SELECT("Yy"[AUSAASK:1,1:0)

 +2        WRITE !

 +3        KILL AUSA

           FOR AUSAX="DD","DEL","LAYGO","RD","WR"

               DO GETAUTH

 +4        WRITE !!,"I am going to set the following authorities:",!

 +5        FOR AUSAX="DD","DEL","LAYGO","RD","WR"

               DO PRTAUTH

ASK2       WRITE !!,"Do you want to continue? (Y/N) N// "

           READ AUSAX

           IF AUSAX=""

               SET AUSAX="N"

           SET AUSAX=$EXTRACT(AUSAX)

           IF "YyNn"'[AUSAX

               WRITE *7

               GOTO ASK2

 +1        IF "Yy"'[AUSAX

               GOTO EOJ

 +2        WRITE !

 +3        SET AUSAFILE=""

           FOR AUSAL=0:0

               SET AUSAFILE=$ORDER(^UTILITY("AUDSET",$JOB,AUSAFILE))

               IF AUSAFILE=""

                   QUIT 

               DO PROCESS

 +4        GOTO EOJ

 +5       ;

GETAUTH   ; GET DICTIONARY AUTHORITIES

 +1        WRITE !,"Enter ",AUSAX," authority: "

           READ @("AUSA("""_AUSAX_""")")

 +2        QUIT 

 +3       ;

PRTAUTH   ; PRINT DICTIONARY AUTHORITIES

 +1        WRITE !,AUSAX,?6," to """,@("AUSA("""_AUSAX_""")"),""""

 +2        QUIT 

 +3       ;

PROCESS   ;

 +1        SET AUSAANS="Y"

 +2        WRITE !,@("$P(^DIC("_AUSAFILE_",0),U,1)"),$SELECT(AUSAASK:"..OK? Y// ",1:"")

P2         IF AUSAASK

               READ AUSAANS

               IF AUSAANS=""

                   SET AUSAANS="Y"

               SET AUSAANS=$EXTRACT(AUSAANS)

               IF "YyNn"'[AUSAANS

                   DO P2ERR

                   GOTO P2

 +1        IF "Yy"[AUSAANS

               DO P2SETS

               QUIT 

 +2        WRITE "  Skipping"

 +3        QUIT 

P2SETS    ;

 +1        SET @("^DIC("_AUSAFILE_",0,""DD"")")=AUSA("DD")

 +2        SET ^("DEL")=AUSA("DEL")

 +3        SET ^("LAYGO")=AUSA("LAYGO")

 +4        SET ^("RD")=AUSA("RD")

 +5        SET ^("WR")=AUSA("WR")

 +6        WRITE "  Done"

 +7        QUIT 

P2ERR      WRITE *7

           FOR AUSAI=1:1:$LENGTH(AUSAANS)

               WRITE @BS," ",@BS

 +1        QUIT 

 +2       ;

EOJ       ;

 +1        KILL ^UTILITY("AUDSET",$JOB)

 +2        KILL AUSA

 +3        KILL AUSAANS,AUSAASK,AUSAFILE,AUSAI,AUSAL,AUSAX

 +4        KILL BS,FF,RM,SL,SUB,XY

 +5        WRITE !!,"Bye",!!

 +6        QUIT