- 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 ;