source: IHS-VA_UTILITIES-XB/XBNODEL.m@ 641

Last change on this file since 641 was 641, checked in by Sam Habiel, 14 years ago

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.

File size: 1.3 KB
Line 
1XBNODEL ; IHS/ADC/GTH - PREVENT USER FROM DELETING ENTRIES ; [ 02/07/97 3:02 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4 ; This routine sets FileMan dictionaries so users cannot
5 ; delete entries. Protection is provided by SET'ing the
6 ; "DEL" node of the .01 fields in the selected dd's to
7 ; "I 1".
8 ;
9START ;
10 I $G(DUZ(0))'="@" W !,*7," Insufficient FileMan access. DUZ(0) is not ""@""." Q
11 S U="^",IOP=$I
12 D ^%ZIS
13 W !!,"^XBNODEL - This program sets FileMan dictionaries so users cannot delete",!," entries."
14 ;
15 D ^XBDSET
16 G:'$D(^UTILITY("XBDSET",$J)) EOJ
17ASK ;
18 S XBNDASK=$$DIR^XBDIR("Y","Do you want to be asked before setting each file","Y","","",2)
19 W !
20 S XBNDFILE=""
21 F XBNDL=0:0 S XBNDFILE=$O(^UTILITY("XBDSET",$J,XBNDFILE)) Q:XBNDFILE="" D PROCESS
22 G EOJ
23 ;
24PROCESS ;
25 S XBNDANS="Y"
26 I $G(@("^DD("_XBNDFILE_",.01,""DEL"",.01,0)"))="I 1" W !,@("$P(^DIC("_XBNDFILE_",0),U,1)")," is already protected." Q
27 W !,@("$P(^DIC("_XBNDFILE_",0),U,1)"),$S(XBNDASK:"..OK? Y// ",1:"")
28P2 ;
29 I XBNDASK R XBNDANS:$G(DTIME,999) S:XBNDANS="" XBNDANS="Y" I "YyNn"'[$E(XBNDANS) D P2ERR G P2
30 I XBNDANS="Y" S @("^DD("_XBNDFILE_",.01,""DEL"",.01,0)")="I 1" W " Done"
31 Q
32 ;
33P2ERR ;
34 W *7
35 F XBNDI=1:1:$L(XBNDANS) W @IOBS," ",@IOBS
36 Q
37 ;
38EOJ ;
39 KILL ^UTILITY("XBDSET",$J)
40 KILL XBNDANS,XBNDASK,XBNDFILE,XBNDI,XBNDL
41 KILL BS,FF,RM,SL,SUB,XY
42 Q
43 ;
Note: See TracBrowser for help on using the repository browser.