XBNODEL.m

XBNODEL ; IHS/ADC/GTH - PREVENT USER FROM DELETING ENTRIES ; [ 02/07/97   3:02 PM ]

 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 ;

 ; This routine sets FileMan dictionaries so users cannot

 ; delete entries.  Protection is provided by SET'ing the

 ; "DEL" node of the .01 fields in the selected dd's to

 ; "I 1".

 ;

START ;

 I $G(DUZ(0))'="@" W !,*7,"  Insufficient FileMan access.  DUZ(0) is not ""@""." Q

 S U="^",IOP=$I

 D ^%ZIS

 W !!,"^XBNODEL - This program sets FileMan dictionaries so users cannot delete",!,"           entries."

 ;

 D ^XBDSET

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

ASK ;

 S XBNDASK=$$DIR^XBDIR("Y","Do you want to be asked before setting each file","Y","","",2)

 W !

 S XBNDFILE=""

 F XBNDL=0:0 S XBNDFILE=$O(^UTILITY("XBDSET",$J,XBNDFILE)) Q:XBNDFILE=""  D PROCESS

 G EOJ

 ;

PROCESS ;

 S XBNDANS="Y"

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

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

P2 ;

 I XBNDASK R XBNDANS:$G(DTIME,999) S:XBNDANS="" XBNDANS="Y" I "YyNn"'[$E(XBNDANS) D P2ERR G P2

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

 Q

 ;

P2ERR ;

 W *7

 F XBNDI=1:1:$L(XBNDANS) W @IOBS," ",@IOBS

 Q

 ;

EOJ ;

 KILL ^UTILITY("XBDSET",$J)

 KILL XBNDANS,XBNDASK,XBNDFILE,XBNDI,XBNDL

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

 Q

 ;

XBNODEL   ; IHS/ADC/GTH - PREVENT USER FROM DELETING ENTRIES ; [ 02/07/97   3:02 PM ]

 +1       ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 +2       ;

 +3       ; This routine sets FileMan dictionaries so users cannot

 +4       ; delete entries.  Protection is provided by SET'ing the

 +5       ; "DEL" node of the .01 fields in the selected dd's to

 +6       ; "I 1".

 +7       ;

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 !!,"^XBNODEL - This program sets FileMan dictionaries so users cannot delete",!,"           entries."

 +5       ;

 +6        DO ^XBDSET

 +7        IF '$DATA(^UTILITY("XBDSET",$JOB))

               GOTO EOJ

ASK       ;

 +1        SET XBNDASK=$$DIR^XBDIR("Y","Do you want to be asked before setting each file","Y","","",2)

 +2        WRITE !

 +3        SET XBNDFILE=""

 +4        FOR XBNDL=0:0

               SET XBNDFILE=$ORDER(^UTILITY("XBDSET",$JOB,XBNDFILE))

               IF XBNDFILE=""

                   QUIT 

               DO PROCESS

 +5        GOTO EOJ

 +6       ;

PROCESS   ;

 +1        SET XBNDANS="Y"

 +2        IF $GET(@("^DD("_XBNDFILE_",.01,""DEL"",.01,0)"))="I 1"

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

               QUIT 

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

P2        ;

 +1        IF XBNDASK

               READ XBNDANS:$GET(DTIME,999)

               IF XBNDANS=""

                   SET XBNDANS="Y"

               IF "YyNn"'[$EXTRACT(XBNDANS)

                   DO P2ERR

                   GOTO P2

 +2        IF XBNDANS="Y"

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

               WRITE "  Done"

 +3        QUIT 

 +4       ;

P2ERR     ;

 +1        WRITE *7

 +2        FOR XBNDI=1:1:$LENGTH(XBNDANS)

               WRITE @IOBS," ",@IOBS

 +3        QUIT 

 +4       ;

EOJ       ;

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

 +2        KILL XBNDANS,XBNDASK,XBNDFILE,XBNDI,XBNDL

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

 +4        QUIT 

 +5       ;