Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XBKD

XBKD.m

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