source: IHS-VA_UTILITIES-XB/trunk/XBKD.m@ 1799

Last change on this file since 1799 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.

File size: 6.6 KB
Line 
1XBKD ; IHS/ADC/GTH - KILLS DICs and GLOBALS ; [ 02/07/97 3:02 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4 ; This routine deletes FileMan dictionaries, and optionally
5 ; their globals, TEMPLATES and AUTHORITIES, by a range of
6 ; dictionary numbers, or if called from another routine, by
7 ; a predefined set of dictionaries. The assumptions made
8 ; by this routine are that ^UTILITY, ^DIC, and ^DD are not
9 ; UCI TRANSLATED. Any other globals may be translated, but
10 ; the KILLs will take place in the current UCI only.
11 ;
12 ; This routine can be called from another routine by setting
13 ; the variables XBKDLO, XBKDHI, XBKDDEL, XBKDTMP and then
14 ; D EN1^XBKD, or by creating the array ^UTILITY("XBDSET",$J)
15 ; and then D EN2^XBKD.
16 ;
17 ; The array ^UTILITY("XBDSET",$J) is subscripted by the file
18 ; numbers and has a value of 'v1^v2' where v1 applies to the
19 ; data global, and v2 applies to the TEMPLATES attached to
20 ; the file. The allowable values of v1 and v2 are 'S' for
21 ; save, 'D' for delete, 'A' for ask.
22 ;
23 ; This routine will execute ^XBRESID to delete any residual
24 ; entries in ^DD if dictionaries are deleted by a range of
25 ; numbers.
26 ;
27BEGIN ;
28 D ^XBKVAR
29 W !!,"This program deletes FileMan dictionaries, and optionally their"
30 W !,"globals, TEMPLATES and AUTHORITIES, by a range of dictionary numbers.",!!
31 ;
32LO ;
33 R !,"Enter first dictionary number to be deleted: ",XBKDLO:$G(DTIME,999)
34 G:XBKDLO'=+XBKDLO EOJ
35HI ;
36 W !,"Enter last dictionary number to be deleted: ",XBKDLO,"//"
37 R XBKDHI:$G(DTIME,999)
38 S:XBKDHI="" XBKDHI=XBKDLO
39 G:XBKDHI'=+XBKDHI!(XBKDHI<XBKDLO) EOJ
40DEL ;
41 R !!,"Data globals? [D]elete, [A]sk, [S]ave S//",XBKDDEL:$G(DTIME,999)
42 G:"DAS"'[XBKDDEL DEL
43 S:XBKDDEL="" XBKDDEL="S"
44 ;
45TMP ;
46 W !!,"TEMPLATES and AUTHORITIES? [D]elete, [A]sk, [S]ave ",XBKDDEL,"//"
47 R XBKDTMP:$G(DTIME,999)
48 G:"DAS"'[XBKDTMP TMP
49 S:XBKDTMP="" XBKDTMP=XBKDDEL
50 ;
51EN1 ;PEP - Variables XBKDLO, XBKDHI, XBKDDEL, XBKDTMP must be set when entering here.
52 I '$D(XBKDLO)!('$D(XBKDHI)) W !!,"XBKDLO and/or XBKDHI does not exist!" G EOJ
53 D ^XBKVAR
54 S:'$D(XBKDDEL) XBKDDEL="A"
55 S:XBKDDEL="K" XBKDDEL="S" ;***** BACKWARD COMPATABLE *****
56 I "DAS"'[XBKDDEL W !!,"Invalid XBKDDEL --->",XBKDDEL,"<---" G EOJ
57 S:'$D(XBKDTMP) XBKDTMP="A"
58 S:XBKDTMP="K" XBKDTMP="S" ;***** UPWARD COMPATABLE *****
59 I "DAS"'[XBKDTMP W !!,"Invalid XBKDTMP --->",XBKDTMP,"<---" G EOJ
60 S XBDSLO=XBKDLO,XBDSHI=XBKDHI
61 D EN1^XBDSET
62 S XBKDFILE=(XBKDLO-.00000001)
63 F XBKDL=0:0 S XBKDFILE=$O(^DD(XBKDFILE)) Q:XBKDFILE>XBKDHI!(XBKDFILE'=+XBKDFILE) I '$D(^UTILITY("XBDSET",$J,XBKDFILE)) D CHECKDD
64 I '$D(^UTILITY("XBDSET",$J)) W !!,"No dictionaries were selected." G EOJ
65 S XBKDFILE=0
66 F XBKDL=0:0 S XBKDFILE=$O(^UTILITY("XBDSET",$J,XBKDFILE)) Q:XBKDFILE="" S ^(XBKDFILE)=XBKDDEL_U_XBKDTMP
67 G EN2
68 ;
69CHECKDD ; CHECK ^DD FOR DANGLING ENTRIES
70 Q:$D(^DD(XBKDFILE,0,"UP"))
71 W "."
72 S ^UTILITY("XBDSET",$J,XBKDFILE)=""
73 Q
74 ;
75EN2 ;PEP - Array ^UTILITY("XBDSET",$J) must exist when entering here.
76 I '$D(^UTILITY("XBDSET",$J)) W !!,"^UTILITY(""XBDSET"",$J) is not defined!" G EOJ
77 I $O(^UTILITY("XBDSET",$J,""))<2 W !!,"*** Don't mess with files less than 2!! ***",*7 KILL XBKDLO,XBKDHI G EOJ
78 D ^XBKVAR
79 S (XBKDFILE,XBKDFLG)=0
80 F XBKDL=0:0 S XBKDFILE=$O(^UTILITY("XBDSET",$J,XBKDFILE)) Q:XBKDFILE="" S XBKDX=^(XBKDFILE) D CHKVAL
81 I XBKDFLG W !!,"One or more invalid GLOBAL^TEMPLATE disposition values encountered!" G EOJ
82 KILL XBKDDEL,XBKDERR,XBKDFLG,XBKDTMP,XBKDX
83 D ^XBKD2
84 S XBKDFLG=0
85 D CONFIRM
86 G:XBKDFLG EOJ
87 KILL XBKDASK,XBKDFLG,XBKDX,XBKDY
88 D ^XBKD3
89 W !!,"Resetting ^DIC(0) <WAIT>"
90 S (XBKDC,XBKDFILE)=0,XBKDLAST=""
91 F XBKDL=0:0 S XBKDFILE=$O(^DIC(XBKDFILE)) Q:XBKDFILE'=+XBKDFILE S XBKDC=XBKDC+1,XBKDLAST=XBKDFILE
92 S $P(^DIC(0),"^",3)=XBKDLAST,$P(^DIC(0),"^",4)=XBKDC
93 G EOJ
94 ;
95CHKVAL ; CHECK G^T VALUES
96 S XBKDERR=0
97 I XBKDX'?1U1"^"1U S XBKDERR=1
98 ;***** "K" TO "S" ADDED TO FOLLOWING LINE FOR UPWARD COMPABILITY *****
99 I 'XBKDERR S XBKDDEL=$P(XBKDX,U,1),XBKDTMP=$P(XBKDX,U,2) S:XBKDDEL="K" XBKDDEL="S" S:XBKDTMP="K" XBKDTMP="S" S:"ADS"'[XBKDDEL XBKDERR=1 S:"ADS"'[XBKDTMP XBKDERR=1
100 I XBKDERR S XBKDFLG=1 W !,"Invalid value ",XBKDFILE,"=",XBKDX
101 Q
102 ;
103CONFIRM ; SHOW AND ASK
104 I '$D(^UTILITY("XBDSET",$J)) S XBKDFLG=1 Q
105 W !!," NUMBER",?14,"NAME",?45,"G^T",?50,"DATA GLOBAL",!
106 S (XBKDFILE,XBKDASK)=0
107 F XBKDL=0:0 S XBKDFILE=$O(^UTILITY("XBDSET",$J,XBKDFILE)) Q:XBKDFILE="" S XBKDX=^(XBKDFILE) S:$E(XBKDX,1,3)["A" XBKDASK=1 D LIST
108 W !!,"The above list of dictionaries will be deleted in UCI ",XBKDUCI,". Data"
109 W !,"globals, TEMPLATES and AUTHORITIES, will be kept, deleted, or asked depending"
110 W !,"on flag. '?' in G position indicates invalid data global."
111 W !!,"[S]ave, [D]elete, [A]sk. Globals to be deleted are also marked"
112 W !," by '*' in position 1."
113 I $D(ADIFROM("IHS")) S XBKDX=""
114 E R !!,"[C]ontinue, [S]top, [M]odify? C//",XBKDX:$G(DTIME,999) S:XBKDX="^" XBKDX="S"
115 I $E(XBKDX)="S" S XBKDFLG=1 Q
116 I $E(XBKDX)="M" D MODIFY G CONFIRM
117 Q:'XBKDASK
118 W !
119 S XBKDFILE=""
120 F XBKDL=0:0 S XBKDFILE=$O(^UTILITY("XBDSET",$J,XBKDFILE)) Q:XBKDFILE="" S XBKDX=^(XBKDFILE) D:$E(XBKDX,1,3)["A" ASK
121 G CONFIRM
122 ;
123LIST ; LIST FILE INFO
124 W !,$S($P(XBKDX,U,1)="D":"*",1:" "),XBKDFILE,?14,$E($P(^DIC(XBKDFILE,0),U,1),1,30),?45,$E(XBKDX,1,3),?50,$S($P(XBKDX,U,3)="":"<NONE>",1:$P(XBKDX,U,3))
125 Q
126 ;
127MODIFY ;
128 R !!,"Which file? ",XBKDFILE:$G(DTIME,999)
129 Q:XBKDFILE'=+XBKDFILE
130 I '$D(^UTILITY("XBDSET",$J,XBKDFILE)) W *7 G MODIFY
131 R !," Delete file from list of files to be deleted (Y/N) N//",XBKDY:$G(DTIME,999)
132 I $E(XBKDY)="Y" KILL ^UTILITY("XBDSET",$J,XBKDFILE) Q
133 S $P(^UTILITY("XBDSET",$J,XBKDFILE),U,2)="A",$P(^(XBKDFILE),U,1)=$S($P(^(XBKDFILE),U,1)="?":"?",1:"A"),XBKDX=^(XBKDFILE)
134 W !
135 D ASK
136 Q
137 ;
138ASK ;
139 G:$P(XBKDX,U,1)'="A" ASK2
140 W !,"Do you want to delete the data global for ",XBKDFILE," ",$P(^DIC(XBKDFILE,0),U,1)," (Y/N) N//"
141 R XBKDY:$G(DTIME,999)
142 I $E(XBKDY)="Y" S $P(^UTILITY("XBDSET",$J,XBKDFILE),U,1)="D"
143 E S $P(^UTILITY("XBDSET",$J,XBKDFILE),U,1)="S"
144ASK2 ;
145 Q:$P(XBKDX,U,2)'="A"
146 W !,"Do you want to delete the TEMPLATES and AUTHORITIES for ",XBKDFILE," ",$P(^DIC(XBKDFILE,0),U,1)," (Y/N) N//"
147 R XBKDY:$G(DTIME,999)
148 I $E(XBKDY)="Y" S $P(^UTILITY("XBDSET",$J,XBKDFILE),U,2)="D"
149 E S $P(^UTILITY("XBDSET",$J,XBKDFILE),U,2)="S"
150 Q
151 ;
152EOJ ;
153 I $D(XBKDLO),$D(XBKDHI),XBKDLO=+XBKDLO,XBKDHI=+XBKDHI,XBKDHI>XBKDLO S XBRLO=XBKDLO,XBRHI=XBKDHI D EN1^XBRESID
154 I $D(^UTILITY("XBKD",$J)) W !,"Restoring saved ^DD nodes. <WAIT>" S FROM="^UTILITY(""XBKD"",$J,",TO="^DD(" D ^XBGXFR
155 KILL ^UTILITY("XBDSET",$J),^UTILITY("XBKD",$J)
156 KILL %,DA,DIK,Y
157 KILL XBKDASK,XBKDC,XBKDDEL,XBKDERR,XBKDFILE,XBKDFLD,XBKDFLG,XBKDG,XBKDHI,XBKDL,XBKDLAST,XBKDLO,XBKDNDIC,XBKDTMP,XBKDUCI,XBKDX,XBKDY
158 KILL FROM,TO
159 W !!,"DONE",!!
160 Q
161 ;
Note: See TracBrowser for help on using the repository browser.