- AUKD ; KILLS DICs and GLOBALS [ 08/17/88 4:55 PM ]
- ;
- NOTES ; 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 AUKDLO, AUKDHI, AUKDDEL, AUKDTMP and then D EN1^AUKD,
- ; or by creating the array ^UTILITY("AUDSET",$J) and then D EN2^AUKD.
- ;
- ; The array ^UTILITY("AUDSET",$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 ^AURESID to delete any residual entries
- ; in ^DD if dictionaries are deleted by a range of numbers.
- ;
- BEGIN S DUZ(0)="@",U="^"
- 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: ",AUKDLO G:AUKDLO'=+AUKDLO EOJ
- HI W !,"Enter last dictionary number to be deleted: ",AUKDLO,"//" R AUKDHI S:AUKDHI="" AUKDHI=AUKDLO G:AUKDHI'=+AUKDHI!(AUKDHI<AUKDLO) EOJ
- DEL R !!,"Data globals? [D]elete, [A]sk, [S]ave S//",AUKDDEL G:"DAS"'[AUKDDEL DEL
- S:AUKDDEL="" AUKDDEL="S"
- ;
- TMP W !!,"TEMPLATES and AUTHORITIES? [D]elete, [A]sk, [S]ave "_AUKDDEL_"//" R AUKDTMP G:"DAS"'[AUKDTMP TMP
- S:AUKDTMP="" AUKDTMP=AUKDDEL
- ;
- EN1 ;
- I '$D(AUKDLO)!('$D(AUKDHI)) W !!,"AUKDLO and/or AUKDHI does not exist!" G EOJ
- S DUZ(0)="@",U="^"
- S:'$D(AUKDDEL) AUKDDEL="A"
- S:AUKDDEL="K" AUKDDEL="S" ;***** BACKWARD COMPATABLE *****
- I "DAS"'[AUKDDEL W !!,"Invalid AUKDDEL --->",AUKDDEL,"<---" G EOJ
- S:'$D(AUKDTMP) AUKDTMP="A"
- S:AUKDTMP="K" AUKDTMP="S" ;***** UPWARD COMPATABLE *****
- I "DAS"'[AUKDTMP W !!,"Invalid AUDKTMP --->",AUKDTMP,"<---" G EOJ
- S AUDSLO=AUKDLO,AUDSHI=AUKDHI D EN1^%AUDSET
- S AUKDFILE=(AUKDLO-.00000001) F AUKDL=0:0 S AUKDFILE=$O(^DD(AUKDFILE)) Q:AUKDFILE>AUKDHI!(AUKDFILE'=+AUKDFILE) I '$D(^UTILITY("AUDSET",$J,AUKDFILE)) D CHECKDD
- I '$D(^UTILITY("AUDSET",$J)) W !!,"No dictionaries were selected." G EOJ
- S AUKDFILE=0 F AUKDL=0:0 S AUKDFILE=$O(^UTILITY("AUDSET",$J,AUKDFILE)) Q:AUKDFILE="" S ^(AUKDFILE)=AUKDDEL_U_AUKDTMP
- G EN2
- ;
- CHECKDD ; CHECK ^DD FOR DANGLING ENTRIES
- Q:$D(^DD(AUKDFILE,0,"UP"))
- W "." S ^UTILITY("AUDSET",$J,AUKDFILE)=""
- Q
- ;
- EN2 ;
- I '$D(^UTILITY("AUDSET",$J)) W !!,"^UTILITY(""AUDSET"",$J) is not defined!" G EOJ
- I $O(^UTILITY("AUDSET",$J,""))<2 W !!,"*** Don't mess with files less than 2!! ***",*7 K AUKDLO,AUKDHI G EOJ
- S DUZ(0)="@",U="^"
- S (AUKDFILE,AUKDFLG)=0 F AUKDL=0:0 S AUKDFILE=$O(^UTILITY("AUDSET",$J,AUKDFILE)) Q:AUKDFILE="" S AUKDX=^(AUKDFILE) D CHKVAL
- I AUKDFLG W !!,"One or more invalid GLOBAL^TEMPLATE disposition values encountered!" G EOJ
- K AUKDDEL,AUKDERR,AUKDFLG,AUKDTMP,AUKDX
- D ^%AUKD2
- S AUKDFLG=0 D CONFIRM
- G:AUKDFLG EOJ
- K AUKDASK,AUKDFLG,AUKDX,AUKDY
- D ^%AUKD3
- W !!,"Resetting ^DIC(0) <WAIT>" S (AUKDC,AUKDFILE)=0,AUKDLAST="" F AUKDL=0:0 S AUKDFILE=$O(^DIC(AUKDFILE)) Q:AUKDFILE'=+AUKDFILE S AUKDC=AUKDC+1,AUKDLAST=AUKDFILE
- S $P(^DIC(0),U,3)=AUKDLAST,$P(^DIC(0),U,4)=AUKDC
- G EOJ
- ;
- CHKVAL ; CHECK G^T VALUES
- S AUKDERR=0
- I AUKDX'?1U1"^"1U S AUKDERR=1
- ;***** "K" TO "S" ADDED TO FOLLOWING LINE FOR UPWARD COMPABILITY *****
- I 'AUKDERR S AUKDDEL=$P(AUKDX,U,1),AUKDTMP=$P(AUKDX,U,2) S:AUKDDEL="K" AUKDDEL="S" S:AUKDTMP="K" AUKDTMP="S" S:"ADS"'[AUKDDEL AUKDERR=1 S:"ADS"'[AUKDTMP AUKDERR=1
- I AUKDERR S AUKDFLG=1 W !,"Invalid value ",AUKDFILE,"=",AUKDX
- Q
- ;
- CONFIRM ; SHOW AND ASK
- I '$D(^UTILITY("AUDSET",$J)) S AUKDFLG=1 Q
- W !!," NUMBER",?14,"NAME",?45,"G^T",?50,"DATA GLOBAL",!
- S (AUKDFILE,AUKDASK)=0 F AUKDL=0:0 S AUKDFILE=$O(^UTILITY("AUDSET",$J,AUKDFILE)) Q:AUKDFILE="" S AUKDX=^(AUKDFILE) S:$E(AUKDX,1,3)["A" AUKDASK=1 D LIST
- W !!,"The above list of dictionaries will be deleted in UCI ",AUKDUCI,". 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."
- R !!,"[C]ontinue, [S]top, [M]odify? C//",AUKDX S:AUKDX="^" AUKDX="S"
- I $E(AUKDX)="S" S AUKDFLG=1 Q
- I $E(AUKDX)="M" D MODIFY G CONFIRM
- Q:'AUKDASK
- W ! S AUKDFILE="" F AUKDL=0:0 S AUKDFILE=$O(^UTILITY("AUDSET",$J,AUKDFILE)) Q:AUKDFILE="" S AUKDX=^(AUKDFILE) D:$E(AUKDX,1,3)["A" ASK
- G CONFIRM
- ;
- LIST ; LIST FILE INFO
- W !,$S($P(AUKDX,U,1)="D":"*",1:" "),AUKDFILE,?14,$E($P(^DIC(AUKDFILE,0),U,1),1,30),?45,$E(AUKDX,1,3),?50,$S($P(AUKDX,U,3)="":"<NONE>",1:$P(AUKDX,U,3))
- Q
- ;
- MODIFY ;
- R !!,"Which file? ",AUKDFILE I '$D(^UTILITY("AUDSET",$J,AUKDFILE)) W *7 G MODIFY
- R !," Delete file from list of files to be deleted (Y/N) N//",AUKDY
- I $E(AUKDY)="Y" K ^UTILITY("AUDSET",$J,AUKDFILE) Q
- S $P(^UTILITY("AUDSET",$J,AUKDFILE),U,2)="A",$P(^(AUKDFILE),U,1)=$S($P(^(AUKDFILE),U,1)="?":"?",1:"A")
- W ! S AUKDX=^(AUKDFILE) D ASK
- Q
- ;
- ASK ;
- G:$P(AUKDX,U,1)'="A" ASK2
- W !,"Do you want to delete the data global for ",AUKDFILE," ",$P(^DIC(AUKDFILE,0),U,1)," (Y/N) N//" R AUKDY
- I $E(AUKDY)="Y" S $P(^UTILITY("AUDSET",$J,AUKDFILE),U,1)="D"
- E S $P(^UTILITY("AUDSET",$J,AUKDFILE),U,1)="S"
- ASK2 Q:$P(AUKDX,U,2)'="A"
- W !,"Do you want to delete the TEMPLATES and AUTHORITIES for ",AUKDFILE," ",$P(^DIC(AUKDFILE,0),U,1)," (Y/N) N//" R AUKDY
- I $E(AUKDY)="Y" S $P(^UTILITY("AUDSET",$J,AUKDFILE),U,2)="D"
- E S $P(^UTILITY("AUDSET",$J,AUKDFILE),U,2)="S"
- Q
- ;
- EOJ ;
- I $D(AUKDLO),$D(AUKDHI),AUKDLO=+AUKDLO,AUKDHI=+AUKDHI,AUKDHI>AUKDLO S AURLO=AUKDLO,AURHI=AUKDHI D EN1^AURESID
- I $D(^UTILITY("AUKD",$J)) W !,"Restoring saved ^DD nodes. <WAIT>" S FROM="^UTILITY(""AUKD"",$J,",TO="^DD(" D ^%AUGXFR
- K ^UTILITY("AUDSET",$J),^UTILITY("AUKD",$J)
- K AUKDASK,AUKDC,AUKDDEL,AUKDERR,AUKDFILE,AUKDFLD,AUKDFLG,AUKDG,AUKDHI,AUKDL,AUKDLAST,AUKDLO,AUKDNDIC,AUKDTMP,AUKDUCI,AUKDX,AUKDY
- K FROM,TO
- W !!,"DONE",!!
- Q
- AUKD ; KILLS DICs and GLOBALS [ 08/17/88 4:55 PM ]
- +1 ;
- NOTES ; This routine deletes FileMan dictionaries, and optionally their
- +1 ; globals, TEMPLATES and AUTHORITIES, by a range of dictionary
- +2 ; numbers, or if called from another routine, by a predefined
- +3 ; set of dictionaries. The assumptions made by this routine
- +4 ; are that ^UTILITY, ^DIC, and ^DD are not UCI TRANSLATED.
- +5 ; Any other globals may be translated, but the KILLs will
- +6 ; take place in the current UCI only.
- +7 ;
- +8 ; This routine can be called from another routine by setting the
- +9 ; variables AUKDLO, AUKDHI, AUKDDEL, AUKDTMP and then D EN1^AUKD,
- +10 ; or by creating the array ^UTILITY("AUDSET",$J) and then D EN2^AUKD.
- +11 ;
- +12 ; The array ^UTILITY("AUDSET",$J) is subscripted by the file numbers
- +13 ; and has a value of 'v1^v2' where v1 applies to the data global,
- +14 ; and v2 applies to the TEMPLATES attached to the file. The
- +15 ; allowable values of v1 and v2 are 'S' for save, 'D' for delete,
- +16 ; 'A' for ask.
- +17 ;
- +18 ; This routine will execute ^AURESID to delete any residual entries
- +19 ; in ^DD if dictionaries are deleted by a range of numbers.
- +20 ;
- BEGIN SET DUZ(0)="@"
- SET U="^"
- +1 WRITE !!,"This program deletes FileMan dictionaries, and optionally their"
- +2 WRITE !,"globals, TEMPLATES and AUTHORITIES, by a range of dictionary numbers.",!!
- +3 ;
- LO READ !,"Enter first dictionary number to be deleted: ",AUKDLO
- IF AUKDLO'=+AUKDLO
- GOTO EOJ
- HI WRITE !,"Enter last dictionary number to be deleted: ",AUKDLO,"//"
- READ AUKDHI
- IF AUKDHI=""
- SET AUKDHI=AUKDLO
- IF AUKDHI'=+AUKDHI!(AUKDHI<AUKDLO)
- GOTO EOJ
- DEL READ !!,"Data globals? [D]elete, [A]sk, [S]ave S//",AUKDDEL
- IF "DAS"'[AUKDDEL
- GOTO DEL
- +1 IF AUKDDEL=""
- SET AUKDDEL="S"
- +2 ;
- TMP WRITE !!,"TEMPLATES and AUTHORITIES? [D]elete, [A]sk, [S]ave "_AUKDDEL_"//"
- READ AUKDTMP
- IF "DAS"'[AUKDTMP
- GOTO TMP
- +1 IF AUKDTMP=""
- SET AUKDTMP=AUKDDEL
- +2 ;
- EN1 ;
- +1 IF '$DATA(AUKDLO)!('$DATA(AUKDHI))
- WRITE !!,"AUKDLO and/or AUKDHI does not exist!"
- GOTO EOJ
- +2 SET DUZ(0)="@"
- SET U="^"
- +3 IF '$DATA(AUKDDEL)
- SET AUKDDEL="A"
- +4 ;***** BACKWARD COMPATABLE *****
- IF AUKDDEL="K"
- SET AUKDDEL="S"
- +5 IF "DAS"'[AUKDDEL
- WRITE !!,"Invalid AUKDDEL --->",AUKDDEL,"<---"
- GOTO EOJ
- +6 IF '$DATA(AUKDTMP)
- SET AUKDTMP="A"
- +7 ;***** UPWARD COMPATABLE *****
- IF AUKDTMP="K"
- SET AUKDTMP="S"
- +8 IF "DAS"'[AUKDTMP
- WRITE !!,"Invalid AUDKTMP --->",AUKDTMP,"<---"
- GOTO EOJ
- +9 SET AUDSLO=AUKDLO
- SET AUDSHI=AUKDHI
- DO EN1^%AUDSET
- +10 SET AUKDFILE=(AUKDLO-.00000001)
- FOR AUKDL=0:0
- SET AUKDFILE=$ORDER(^DD(AUKDFILE))
- IF AUKDFILE>AUKDHI!(AUKDFILE'=+AUKDFILE)
- QUIT
- IF '$DATA(^UTILITY("AUDSET",$JOB,AUKDFILE))
- DO CHECKDD
- +11 IF '$DATA(^UTILITY("AUDSET",$JOB))
- WRITE !!,"No dictionaries were selected."
- GOTO EOJ
- +12 SET AUKDFILE=0
- FOR AUKDL=0:0
- SET AUKDFILE=$ORDER(^UTILITY("AUDSET",$JOB,AUKDFILE))
- IF AUKDFILE=""
- QUIT
- SET ^(AUKDFILE)=AUKDDEL_U_AUKDTMP
- +13 GOTO EN2
- +14 ;
- CHECKDD ; CHECK ^DD FOR DANGLING ENTRIES
- +1 IF $DATA(^DD(AUKDFILE,0,"UP"))
- QUIT
- +2 WRITE "."
- SET ^UTILITY("AUDSET",$JOB,AUKDFILE)=""
- +3 QUIT
- +4 ;
- EN2 ;
- +1 IF '$DATA(^UTILITY("AUDSET",$JOB))
- WRITE !!,"^UTILITY(""AUDSET"",$J) is not defined!"
- GOTO EOJ
- +2 IF $ORDER(^UTILITY("AUDSET",$JOB,""))<2
- WRITE !!,"*** Don't mess with files less than 2!! ***",*7
- KILL AUKDLO,AUKDHI
- GOTO EOJ
- +3 SET DUZ(0)="@"
- SET U="^"
- +4 SET (AUKDFILE,AUKDFLG)=0
- FOR AUKDL=0:0
- SET AUKDFILE=$ORDER(^UTILITY("AUDSET",$JOB,AUKDFILE))
- IF AUKDFILE=""
- QUIT
- SET AUKDX=^(AUKDFILE)
- DO CHKVAL
- +5 IF AUKDFLG
- WRITE !!,"One or more invalid GLOBAL^TEMPLATE disposition values encountered!"
- GOTO EOJ
- +6 KILL AUKDDEL,AUKDERR,AUKDFLG,AUKDTMP,AUKDX
- +7 DO ^%AUKD2
- +8 SET AUKDFLG=0
- DO CONFIRM
- +9 IF AUKDFLG
- GOTO EOJ
- +10 KILL AUKDASK,AUKDFLG,AUKDX,AUKDY
- +11 DO ^%AUKD3
- +12 WRITE !!,"Resetting ^DIC(0) <WAIT>"
- SET (AUKDC,AUKDFILE)=0
- SET AUKDLAST=""
- FOR AUKDL=0:0
- SET AUKDFILE=$ORDER(^DIC(AUKDFILE))
- IF AUKDFILE'=+AUKDFILE
- QUIT
- SET AUKDC=AUKDC+1
- SET AUKDLAST=AUKDFILE
- +13 SET $PIECE(^DIC(0),U,3)=AUKDLAST
- SET $PIECE(^DIC(0),U,4)=AUKDC
- +14 GOTO EOJ
- +15 ;
- CHKVAL ; CHECK G^T VALUES
- +1 SET AUKDERR=0
- +2 IF AUKDX'?1U1"^"1U
- SET AUKDERR=1
- +3 ;***** "K" TO "S" ADDED TO FOLLOWING LINE FOR UPWARD COMPABILITY *****
- +4 IF 'AUKDERR
- SET AUKDDEL=$PIECE(AUKDX,U,1)
- SET AUKDTMP=$PIECE(AUKDX,U,2)
- IF AUKDDEL="K"
- SET AUKDDEL="S"
- IF AUKDTMP="K"
- SET AUKDTMP="S"
- IF "ADS"'[AUKDDEL
- SET AUKDERR=1
- IF "ADS"'[AUKDTMP
- SET AUKDERR=1
- +5 IF AUKDERR
- SET AUKDFLG=1
- WRITE !,"Invalid value ",AUKDFILE,"=",AUKDX
- +6 QUIT
- +7 ;
- CONFIRM ; SHOW AND ASK
- +1 IF '$DATA(^UTILITY("AUDSET",$JOB))
- SET AUKDFLG=1
- QUIT
- +2 WRITE !!," NUMBER",?14,"NAME",?45,"G^T",?50,"DATA GLOBAL",!
- +3 SET (AUKDFILE,AUKDASK)=0
- FOR AUKDL=0:0
- SET AUKDFILE=$ORDER(^UTILITY("AUDSET",$JOB,AUKDFILE))
- IF AUKDFILE=""
- QUIT
- SET AUKDX=^(AUKDFILE)
- IF $EXTRACT(AUKDX,1,3)["A"
- SET AUKDASK=1
- DO LIST
- +4 WRITE !!,"The above list of dictionaries will be deleted in UCI ",AUKDUCI,". Data"
- +5 WRITE !,"globals, TEMPLATES and AUTHORITIES, will be kept, deleted, or asked depending"
- +6 WRITE !,"on flag. '?' in G position indicates invalid data global."
- +7 WRITE !!,"[S]ave, [D]elete, [A]sk. Globals to be deleted are also marked"
- +8 WRITE !," by '*' in position 1."
- +9 READ !!,"[C]ontinue, [S]top, [M]odify? C//",AUKDX
- IF AUKDX="^"
- SET AUKDX="S"
- +10 IF $EXTRACT(AUKDX)="S"
- SET AUKDFLG=1
- QUIT
- +11 IF $EXTRACT(AUKDX)="M"
- DO MODIFY
- GOTO CONFIRM
- +12 IF 'AUKDASK
- QUIT
- +13 WRITE !
- SET AUKDFILE=""
- FOR AUKDL=0:0
- SET AUKDFILE=$ORDER(^UTILITY("AUDSET",$JOB,AUKDFILE))
- IF AUKDFILE=""
- QUIT
- SET AUKDX=^(AUKDFILE)
- IF $EXTRACT(AUKDX,1,3)["A"
- DO ASK
- +14 GOTO CONFIRM
- +15 ;
- LIST ; LIST FILE INFO
- +1 WRITE !,$SELECT($PIECE(AUKDX,U,1)="D":"*",1:" "),AUKDFILE,?14,$EXTRACT($PIECE(^DIC(AUKDFILE,0),U,1),1,30),?45,$EXTRACT(AUKDX,1,3),?50,$SELECT($PIECE(AUKDX,U,3)="":"<NONE>",1:$PIECE(AUKDX,U,3))
- +2 QUIT
- +3 ;
- MODIFY ;
- +1 READ !!,"Which file? ",AUKDFILE
- IF '$DATA(^UTILITY("AUDSET",$JOB,AUKDFILE))
- WRITE *7
- GOTO MODIFY
- +2 READ !," Delete file from list of files to be deleted (Y/N) N//",AUKDY
- +3 IF $EXTRACT(AUKDY)="Y"
- KILL ^UTILITY("AUDSET",$JOB,AUKDFILE)
- QUIT
- +4 SET $PIECE(^UTILITY("AUDSET",$JOB,AUKDFILE),U,2)="A"
- SET $PIECE(^(AUKDFILE),U,1)=$SELECT($PIECE(^(AUKDFILE),U,1)="?":"?",1:"A")
- +5 WRITE !
- SET AUKDX=^(AUKDFILE)
- DO ASK
- +6 QUIT
- +7 ;
- ASK ;
- +1 IF $PIECE(AUKDX,U,1)'="A"
- GOTO ASK2
- +2 WRITE !,"Do you want to delete the data global for ",AUKDFILE," ",$PIECE(^DIC(AUKDFILE,0),U,1)," (Y/N) N//"
- READ AUKDY
- +3 IF $EXTRACT(AUKDY)="Y"
- SET $PIECE(^UTILITY("AUDSET",$JOB,AUKDFILE),U,1)="D"
- +4 IF '$TEST
- SET $PIECE(^UTILITY("AUDSET",$JOB,AUKDFILE),U,1)="S"
- ASK2 IF $PIECE(AUKDX,U,2)'="A"
- QUIT
- +1 WRITE !,"Do you want to delete the TEMPLATES and AUTHORITIES for ",AUKDFILE," ",$PIECE(^DIC(AUKDFILE,0),U,1)," (Y/N) N//"
- READ AUKDY
- +2 IF $EXTRACT(AUKDY)="Y"
- SET $PIECE(^UTILITY("AUDSET",$JOB,AUKDFILE),U,2)="D"
- +3 IF '$TEST
- SET $PIECE(^UTILITY("AUDSET",$JOB,AUKDFILE),U,2)="S"
- +4 QUIT
- +5 ;
- EOJ ;
- +1 IF $DATA(AUKDLO)
- IF $DATA(AUKDHI)
- IF AUKDLO=+AUKDLO
- IF AUKDHI=+AUKDHI
- IF AUKDHI>AUKDLO
- SET AURLO=AUKDLO
- SET AURHI=AUKDHI
- DO EN1^AURESID
- +2 IF $DATA(^UTILITY("AUKD",$JOB))
- WRITE !,"Restoring saved ^DD nodes. <WAIT>"
- SET FROM="^UTILITY(""AUKD"",$J,"
- SET TO="^DD("
- DO ^%AUGXFR
- +3 KILL ^UTILITY("AUDSET",$JOB),^UTILITY("AUKD",$JOB)
- +4 KILL AUKDASK,AUKDC,AUKDDEL,AUKDERR,AUKDFILE,AUKDFLD,AUKDFLG,AUKDG,AUKDHI,AUKDL,AUKDLAST,AUKDLO,AUKDNDIC,AUKDTMP,AUKDUCI,AUKDX,AUKDY
- +5 KILL FROM,TO
- +6 WRITE !!,"DONE",!!
- +7 QUIT
