| 1 | XQABTMP ;ISC-SF.SEA/JLI - temporary routine for clean up ;04/16/96 10:49
|
|---|
| 2 | ;;8.0;KERNEL;**28**;Jul 10, 1995
|
|---|
| 3 | ;This routine can be used to remove Packages from Alpha/Beta testing
|
|---|
| 4 | EN ;ask for Package name and remove A/B testing
|
|---|
| 5 | N DA,DIC,DIK,DIR,DIRUT,DIROUT,X,XQ1,XQ2,XQ3,XQ4,XQA,XQDA,XQID,Y
|
|---|
| 6 | S DIC="^XTV(8989.3,1,""ABPKG"",",DIC(0)="AEMQZ"
|
|---|
| 7 | ;don't allow if there is an address, this can be used to only show
|
|---|
| 8 | ;you local packages that you want to remove.
|
|---|
| 9 | ;S DIC("S")="I $P(^(0),U,3)="""""
|
|---|
| 10 | D ^DIC K DIC Q:Y<0
|
|---|
| 11 | S XQDA=+Y,DIR(0)="Y",DIR("A")="You want to remove "_Y(0,0)_" from Alpha/Beta Testing"
|
|---|
| 12 | D ^DIR Q:'Y!$D(DIRUT)
|
|---|
| 13 | D RMVTEST W !,"Done.",!
|
|---|
| 14 | Q
|
|---|
| 15 | ;
|
|---|
| 16 | RMVTEST D GETDATA
|
|---|
| 17 | S DIK="^XTV(8989.3,1,""ABPKG"",",DA(1)=1,DA=XQDA
|
|---|
| 18 | D ^DIK
|
|---|
| 19 | I $O(^XTV(8989.3,1,"ABPKG",0))'>0 K ^XTV(8989.3,1,"ABOPT")
|
|---|
| 20 | Q
|
|---|
| 21 | ;
|
|---|
| 22 | GETDATA ;
|
|---|
| 23 | F XQ1=0:0 S XQ1=$O(^XTV(8989.3,1,"ABPKG",XQDA,1,XQ1)) Q:XQ1'>0 S XQID=$P(^(XQ1,0),U),XQID(XQID)="" D CHECK
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | CHECK S XQA=$E(XQID,1,$L(XQID)-1)_$C($A($E(XQID,$L(XQID)))-1)_"z"
|
|---|
| 27 | F XQ2=0:0 S XQA=$O(^DIC(19,"B",XQA)) Q:XQA=""!($E(XQA,1,$L(XQID))'=XQID) I $E(XQA,$L(XQID)+1)'="Z" D CHK2
|
|---|
| 28 | Q
|
|---|
| 29 | ;
|
|---|
| 30 | CHK2 F XQ3=0:0 S XQ3=$O(^XTV(8989.3,1,"ABPKG",XQDA,1,XQ1,1,XQ3)) Q:XQ3'>0 S XQ4=$P(^(XQ3,0),U) Q:$E(XQA,1,$L(XQ4))=XQ4
|
|---|
| 31 | I XQ3'>0 F XQ4=0:0 S XQ4=$O(^DIC(19,"B",XQA,XQ4)) Q:XQ4'>0 K ^XTV(8989.3,1,"ABOPT",XQ4,0)
|
|---|
| 32 | Q
|
|---|
