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

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
        ;