AUNODEL.m

AUNODEL ;PREVENT USER FROM DELETING ENTRIES [ 06/05/87  2:39 PM ]

 ;

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

 W !!,"This program sets FileMan dictionaries so users cannot delete"

 W !,"entries.  Files are set by a range 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 AUNDASK S:AUNDASK="" AUNDASK="Y" I "YyNn"'[AUNDASK W *7 G ASK

 W !

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

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

 G EOJ

 ;

PROCESS ;

 S AUNDANS="Y"

 I $D(@("^DD("_AUNDFILE_",.01,""DEL"",.01,0)")) W !,@("$P(^DIC("_AUNDFILE_",0),U,1)")," is already protected." Q

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

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

 I AUNDANS="Y" S @("^DD("_AUNDFILE_",.01,""DEL"",.01,0)")="I 1" W "  Done"

 Q

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

 Q

 ;

EOJ ;

 K ^UTILITY("AUDSET",$J)

 K AUNDANS,AUNDASK,AUNDFILE,AUNDI,AUNDL

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

 W !!,"Bye",!!

 Q

AUNODEL   ;PREVENT USER FROM DELETING ENTRIES [ 06/05/87  2:39 PM ]

 +1       ;

BEGIN      SET DUZ(0)="@"

           SET U="^"

           DO CURRENT^%ZIS

 +1        WRITE !!,"This program sets FileMan dictionaries so users cannot delete"

 +2        WRITE !,"entries.  Files are set by a range 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 AUNDASK

           IF AUNDASK=""

               SET AUNDASK="Y"

           IF "YyNn"'[AUNDASK

               WRITE *7

               GOTO ASK

 +1        WRITE !

 +2        SET AUNDASK=$SELECT("Yy"[$EXTRACT(AUNDASK):1,1:0)

 +3        SET AUNDFILE=""

           FOR AUNDL=0:0

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

               IF AUNDFILE=""

                   QUIT 

               DO PROCESS

 +4        GOTO EOJ

 +5       ;

PROCESS   ;

 +1        SET AUNDANS="Y"

 +2        IF $DATA(@("^DD("_AUNDFILE_",.01,""DEL"",.01,0)"))

               WRITE !,@("$P(^DIC("_AUNDFILE_",0),U,1)")," is already protected."

               QUIT 

 +3        WRITE !,@("$P(^DIC("_AUNDFILE_",0),U,1)"),$SELECT(AUNDASK:"..OK? Y// ",1:"")

P2         IF AUNDASK

               READ AUNDANS

               IF AUNDANS=""

                   SET AUNDANS="Y"

               IF "YyNn"'[$EXTRACT(AUNDANS)

                   DO P2ERR

                   GOTO P2

 +1        IF AUNDANS="Y"

               SET @("^DD("_AUNDFILE_",.01,""DEL"",.01,0)")="I 1"

               WRITE "  Done"

 +2        QUIT 

P2ERR      WRITE *7

           FOR AUNDI=1:1:$LENGTH(AUNDANS)

               WRITE @BS," ",@BS

 +1        QUIT 

 +2       ;

EOJ       ;

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

 +2        KILL AUNDANS,AUNDASK,AUNDFILE,AUNDI,AUNDL

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

 +4        WRITE !!,"Bye",!!

 +5        QUIT