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