162 lines
6.6 KiB
Mathematica
162 lines
6.6 KiB
Mathematica
|
XBKD ; IHS/ADC/GTH - KILLS DICs and GLOBALS ; [ 02/07/97 3:02 PM ]
|
||
|
|
;;4.0;XB;;Jul 20, 2009;Build 2
|
||
|
|
;
|
||
|
|
; This routine deletes FileMan dictionaries, and optionally
|
||
|
|
; their globals, TEMPLATES and AUTHORITIES, by a range of
|
||
|
|
; dictionary numbers, or if called from another routine, by
|
||
|
|
; a predefined set of dictionaries. The assumptions made
|
||
|
|
; by this routine are that ^UTILITY, ^DIC, and ^DD are not
|
||
|
|
; UCI TRANSLATED. Any other globals may be translated, but
|
||
|
|
; the KILLs will take place in the current UCI only.
|
||
|
|
;
|
||
|
|
; This routine can be called from another routine by setting
|
||
|
|
; the variables XBKDLO, XBKDHI, XBKDDEL, XBKDTMP and then
|
||
|
|
; D EN1^XBKD, or by creating the array ^UTILITY("XBDSET",$J)
|
||
|
|
; and then D EN2^XBKD.
|
||
|
|
;
|
||
|
|
; The array ^UTILITY("XBDSET",$J) is subscripted by the file
|
||
|
|
; numbers and has a value of 'v1^v2' where v1 applies to the
|
||
|
|
; data global, and v2 applies to the TEMPLATES attached to
|
||
|
|
; the file. The allowable values of v1 and v2 are 'S' for
|
||
|
|
; save, 'D' for delete, 'A' for ask.
|
||
|
|
;
|
||
|
|
; This routine will execute ^XBRESID to delete any residual
|
||
|
|
; entries in ^DD if dictionaries are deleted by a range of
|
||
|
|
; numbers.
|
||
|
|
;
|
||
|
|
BEGIN ;
|
||
|
|
D ^XBKVAR
|
||
|
|
W !!,"This program deletes FileMan dictionaries, and optionally their"
|
||
|
|
W !,"globals, TEMPLATES and AUTHORITIES, by a range of dictionary numbers.",!!
|
||
|
|
;
|
||
|
|
LO ;
|
||
|
|
R !,"Enter first dictionary number to be deleted: ",XBKDLO:$G(DTIME,999)
|
||
|
|
G:XBKDLO'=+XBKDLO EOJ
|
||
|
|
HI ;
|
||
|
|
W !,"Enter last dictionary number to be deleted: ",XBKDLO,"//"
|
||
|
|
R XBKDHI:$G(DTIME,999)
|
||
|
|
S:XBKDHI="" XBKDHI=XBKDLO
|
||
|
|
G:XBKDHI'=+XBKDHI!(XBKDHI<XBKDLO) EOJ
|
||
|
|
DEL ;
|
||
|
|
R !!,"Data globals? [D]elete, [A]sk, [S]ave S//",XBKDDEL:$G(DTIME,999)
|
||
|
|
G:"DAS"'[XBKDDEL DEL
|
||
|
|
S:XBKDDEL="" XBKDDEL="S"
|
||
|
|
;
|
||
|
|
TMP ;
|
||
|
|
W !!,"TEMPLATES and AUTHORITIES? [D]elete, [A]sk, [S]ave ",XBKDDEL,"//"
|
||
|
|
R XBKDTMP:$G(DTIME,999)
|
||
|
|
G:"DAS"'[XBKDTMP TMP
|
||
|
|
S:XBKDTMP="" XBKDTMP=XBKDDEL
|
||
|
|
;
|
||
|
|
EN1 ;PEP - Variables XBKDLO, XBKDHI, XBKDDEL, XBKDTMP must be set when entering here.
|
||
|
|
I '$D(XBKDLO)!('$D(XBKDHI)) W !!,"XBKDLO and/or XBKDHI does not exist!" G EOJ
|
||
|
|
D ^XBKVAR
|
||
|
|
S:'$D(XBKDDEL) XBKDDEL="A"
|
||
|
|
S:XBKDDEL="K" XBKDDEL="S" ;***** BACKWARD COMPATABLE *****
|
||
|
|
I "DAS"'[XBKDDEL W !!,"Invalid XBKDDEL --->",XBKDDEL,"<---" G EOJ
|
||
|
|
S:'$D(XBKDTMP) XBKDTMP="A"
|
||
|
|
S:XBKDTMP="K" XBKDTMP="S" ;***** UPWARD COMPATABLE *****
|
||
|
|
I "DAS"'[XBKDTMP W !!,"Invalid XBKDTMP --->",XBKDTMP,"<---" G EOJ
|
||
|
|
S XBDSLO=XBKDLO,XBDSHI=XBKDHI
|
||
|
|
D EN1^XBDSET
|
||
|
|
S XBKDFILE=(XBKDLO-.00000001)
|
||
|
|
F XBKDL=0:0 S XBKDFILE=$O(^DD(XBKDFILE)) Q:XBKDFILE>XBKDHI!(XBKDFILE'=+XBKDFILE) I '$D(^UTILITY("XBDSET",$J,XBKDFILE)) D CHECKDD
|
||
|
|
I '$D(^UTILITY("XBDSET",$J)) W !!,"No dictionaries were selected." G EOJ
|
||
|
|
S XBKDFILE=0
|
||
|
|
F XBKDL=0:0 S XBKDFILE=$O(^UTILITY("XBDSET",$J,XBKDFILE)) Q:XBKDFILE="" S ^(XBKDFILE)=XBKDDEL_U_XBKDTMP
|
||
|
|
G EN2
|
||
|
|
;
|
||
|
|
CHECKDD ; CHECK ^DD FOR DANGLING ENTRIES
|
||
|
|
Q:$D(^DD(XBKDFILE,0,"UP"))
|
||
|
|
W "."
|
||
|
|
S ^UTILITY("XBDSET",$J,XBKDFILE)=""
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
EN2 ;PEP - Array ^UTILITY("XBDSET",$J) must exist when entering here.
|
||
|
|
I '$D(^UTILITY("XBDSET",$J)) W !!,"^UTILITY(""XBDSET"",$J) is not defined!" G EOJ
|
||
|
|
I $O(^UTILITY("XBDSET",$J,""))<2 W !!,"*** Don't mess with files less than 2!! ***",*7 KILL XBKDLO,XBKDHI G EOJ
|
||
|
|
D ^XBKVAR
|
||
|
|
S (XBKDFILE,XBKDFLG)=0
|
||
|
|
F XBKDL=0:0 S XBKDFILE=$O(^UTILITY("XBDSET",$J,XBKDFILE)) Q:XBKDFILE="" S XBKDX=^(XBKDFILE) D CHKVAL
|
||
|
|
I XBKDFLG W !!,"One or more invalid GLOBAL^TEMPLATE disposition values encountered!" G EOJ
|
||
|
|
KILL XBKDDEL,XBKDERR,XBKDFLG,XBKDTMP,XBKDX
|
||
|
|
D ^XBKD2
|
||
|
|
S XBKDFLG=0
|
||
|
|
D CONFIRM
|
||
|
|
G:XBKDFLG EOJ
|
||
|
|
KILL XBKDASK,XBKDFLG,XBKDX,XBKDY
|
||
|
|
D ^XBKD3
|
||
|
|
W !!,"Resetting ^DIC(0) <WAIT>"
|
||
|
|
S (XBKDC,XBKDFILE)=0,XBKDLAST=""
|
||
|
|
F XBKDL=0:0 S XBKDFILE=$O(^DIC(XBKDFILE)) Q:XBKDFILE'=+XBKDFILE S XBKDC=XBKDC+1,XBKDLAST=XBKDFILE
|
||
|
|
S $P(^DIC(0),"^",3)=XBKDLAST,$P(^DIC(0),"^",4)=XBKDC
|
||
|
|
G EOJ
|
||
|
|
;
|
||
|
|
CHKVAL ; CHECK G^T VALUES
|
||
|
|
S XBKDERR=0
|
||
|
|
I XBKDX'?1U1"^"1U S XBKDERR=1
|
||
|
|
;***** "K" TO "S" ADDED TO FOLLOWING LINE FOR UPWARD COMPABILITY *****
|
||
|
|
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
|
||
|
|
I XBKDERR S XBKDFLG=1 W !,"Invalid value ",XBKDFILE,"=",XBKDX
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
CONFIRM ; SHOW AND ASK
|
||
|
|
I '$D(^UTILITY("XBDSET",$J)) S XBKDFLG=1 Q
|
||
|
|
W !!," NUMBER",?14,"NAME",?45,"G^T",?50,"DATA GLOBAL",!
|
||
|
|
S (XBKDFILE,XBKDASK)=0
|
||
|
|
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
|
||
|
|
W !!,"The above list of dictionaries will be deleted in UCI ",XBKDUCI,". Data"
|
||
|
|
W !,"globals, TEMPLATES and AUTHORITIES, will be kept, deleted, or asked depending"
|
||
|
|
W !,"on flag. '?' in G position indicates invalid data global."
|
||
|
|
W !!,"[S]ave, [D]elete, [A]sk. Globals to be deleted are also marked"
|
||
|
|
W !," by '*' in position 1."
|
||
|
|
I $D(ADIFROM("IHS")) S XBKDX=""
|
||
|
|
E R !!,"[C]ontinue, [S]top, [M]odify? C//",XBKDX:$G(DTIME,999) S:XBKDX="^" XBKDX="S"
|
||
|
|
I $E(XBKDX)="S" S XBKDFLG=1 Q
|
||
|
|
I $E(XBKDX)="M" D MODIFY G CONFIRM
|
||
|
|
Q:'XBKDASK
|
||
|
|
W !
|
||
|
|
S XBKDFILE=""
|
||
|
|
F XBKDL=0:0 S XBKDFILE=$O(^UTILITY("XBDSET",$J,XBKDFILE)) Q:XBKDFILE="" S XBKDX=^(XBKDFILE) D:$E(XBKDX,1,3)["A" ASK
|
||
|
|
G CONFIRM
|
||
|
|
;
|
||
|
|
LIST ; LIST FILE INFO
|
||
|
|
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))
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
MODIFY ;
|
||
|
|
R !!,"Which file? ",XBKDFILE:$G(DTIME,999)
|
||
|
|
Q:XBKDFILE'=+XBKDFILE
|
||
|
|
I '$D(^UTILITY("XBDSET",$J,XBKDFILE)) W *7 G MODIFY
|
||
|
|
R !," Delete file from list of files to be deleted (Y/N) N//",XBKDY:$G(DTIME,999)
|
||
|
|
I $E(XBKDY)="Y" KILL ^UTILITY("XBDSET",$J,XBKDFILE) Q
|
||
|
|
S $P(^UTILITY("XBDSET",$J,XBKDFILE),U,2)="A",$P(^(XBKDFILE),U,1)=$S($P(^(XBKDFILE),U,1)="?":"?",1:"A"),XBKDX=^(XBKDFILE)
|
||
|
|
W !
|
||
|
|
D ASK
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
ASK ;
|
||
|
|
G:$P(XBKDX,U,1)'="A" ASK2
|
||
|
|
W !,"Do you want to delete the data global for ",XBKDFILE," ",$P(^DIC(XBKDFILE,0),U,1)," (Y/N) N//"
|
||
|
|
R XBKDY:$G(DTIME,999)
|
||
|
|
I $E(XBKDY)="Y" S $P(^UTILITY("XBDSET",$J,XBKDFILE),U,1)="D"
|
||
|
|
E S $P(^UTILITY("XBDSET",$J,XBKDFILE),U,1)="S"
|
||
|
|
ASK2 ;
|
||
|
|
Q:$P(XBKDX,U,2)'="A"
|
||
|
|
W !,"Do you want to delete the TEMPLATES and AUTHORITIES for ",XBKDFILE," ",$P(^DIC(XBKDFILE,0),U,1)," (Y/N) N//"
|
||
|
|
R XBKDY:$G(DTIME,999)
|
||
|
|
I $E(XBKDY)="Y" S $P(^UTILITY("XBDSET",$J,XBKDFILE),U,2)="D"
|
||
|
|
E S $P(^UTILITY("XBDSET",$J,XBKDFILE),U,2)="S"
|
||
|
|
Q
|
||
|
|
;
|
||
|
|
EOJ ;
|
||
|
|
I $D(XBKDLO),$D(XBKDHI),XBKDLO=+XBKDLO,XBKDHI=+XBKDHI,XBKDHI>XBKDLO S XBRLO=XBKDLO,XBRHI=XBKDHI D EN1^XBRESID
|
||
|
|
I $D(^UTILITY("XBKD",$J)) W !,"Restoring saved ^DD nodes. <WAIT>" S FROM="^UTILITY(""XBKD"",$J,",TO="^DD(" D ^XBGXFR
|
||
|
|
KILL ^UTILITY("XBDSET",$J),^UTILITY("XBKD",$J)
|
||
|
|
KILL %,DA,DIK,Y
|
||
|
|
KILL XBKDASK,XBKDC,XBKDDEL,XBKDERR,XBKDFILE,XBKDFLD,XBKDFLG,XBKDG,XBKDHI,XBKDL,XBKDLAST,XBKDLO,XBKDNDIC,XBKDTMP,XBKDUCI,XBKDX,XBKDY
|
||
|
|
KILL FROM,TO
|
||
|
|
W !!,"DONE",!!
|
||
|
|
Q
|
||
|
|
;
|