| 1 | ZIBVKIL ; IHS/ADC/GTH - BUILD A KILL VARIABLE ROUTINE ; [ 11/04/97 10:26 AM ]
|
|---|
| 2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
|---|
| 3 | ; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err.
|
|---|
| 4 | ;
|
|---|
| 5 | ; Build a name space variable killer routine in ^.ns.KVAR.
|
|---|
| 6 | ;
|
|---|
| 7 | ; Select a %INDEX host file summary from which to build the
|
|---|
| 8 | ; routine. Select a name space for the variables and the
|
|---|
| 9 | ; routine to be built. Enter any package wide variables.
|
|---|
| 10 | ;
|
|---|
| 11 | ; Add D ^.ns.VKL0 to all menu exit actions where package
|
|---|
| 12 | ; variables are to remain.
|
|---|
| 13 | ;
|
|---|
| 14 | ; Add D KILL^XUSCLEAN to the exit of all other menus.
|
|---|
| 15 | ;
|
|---|
| 16 | ; I $P(^%ZOSF("OS"),"-",1)'="MSM" W !,*7,"OPERATING SYSTEM '",$P(^%ZOSF("OS"),"-",1),"' NOT SUPPORTED." Q ; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err.
|
|---|
| 17 | I $P(^%ZOSF("OS"),"^",1)'["MSM" W !,*7,"OPERATING SYSTEM '",$P(^%ZOSF("OS"),"^",1),"' NOT SUPPORTED." Q ; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err.
|
|---|
| 18 | ;
|
|---|
| 19 | D HOME^%ZIS
|
|---|
| 20 | NEW XBNS
|
|---|
| 21 | NS ;
|
|---|
| 22 | KILL DIR
|
|---|
| 23 | S DIR(0)="F^2:4",DIR("A")="Name Space - or ' ^ 'to exit"
|
|---|
| 24 | D ^DIR
|
|---|
| 25 | I X="^" G EXIT
|
|---|
| 26 | I Y="" G NS
|
|---|
| 27 | I '$D(^DIC(9.4,"C",Y)) W !,"NO PACKAGE ??",! G NS
|
|---|
| 28 | S XBNS=Y
|
|---|
| 29 | PKGVAR ;
|
|---|
| 30 | KILL DIR
|
|---|
| 31 | S DIR(0)="F^0:235",DIR("A")="List of Package Wide Variables or '^' to bypass",DIR("?")="LIST var1,var2, ... "
|
|---|
| 32 | D ^DIR
|
|---|
| 33 | I Y'="^" F XBI=1:1 S X=$P(Y,",",XBI) Q:X="" S XBVPKG(X)=""
|
|---|
| 34 | KROU ;
|
|---|
| 35 | KILL DIR
|
|---|
| 36 | S DIR(0)="F^0:235",DIR("A")="List of other Kill routines to chain",DIR("?")=" ^ROU1,^ROU2, ... with '^'s"
|
|---|
| 37 | D ^DIR
|
|---|
| 38 | I Y]"",Y'="^" F XBI=1:1 S XBROU=$P(Y,",",XBI) Q:XBROU="" S X=$P(XBROU,"^",2) D
|
|---|
| 39 | . I X="" W !,XBROU," error in list >> ",Y G KROU
|
|---|
| 40 | . X ^%ZOSF("TEST")
|
|---|
| 41 | . I '$T W !,X," error in list >> ",Y G KROU
|
|---|
| 42 | .Q
|
|---|
| 43 | I Y]"" S XBKROU=" D "_Y
|
|---|
| 44 | D ^XBVCHV
|
|---|
| 45 | I '$D(^XBVROU($J)) W !,"NO FILE ??",! G NS
|
|---|
| 46 | S ;
|
|---|
| 47 | F I=1:1 Q:'$T(@I) S XBLD(I)=$P($T(@I),";;",2,99)
|
|---|
| 48 | X XBLD(1)
|
|---|
| 49 | EXIT ;
|
|---|
| 50 | D KILL^XUSCLEAN
|
|---|
| 51 | KILL ^XBVROU($J),XBKROU,XBLD
|
|---|
| 52 | W !,"REMEMBER TO EDIT THE TOP LINES OF THE ROUTINES CREATED !",!!
|
|---|
| 53 | Q
|
|---|
| 54 | ;
|
|---|
| 55 | 1 ;;S XBNUM=0 X XBLD(2),XBLD(3),XBLD(4),XBLD(6) ZS @XBROU W !,XBROU," Saved ",!!
|
|---|
| 56 | 2 ;;ZR S XBROU=XBNS_"VKL"_XBNUM,X=XBROU_" ; - kill variables",XBLNS=$L(XBNS) ZI X S X=" ;;" ZI X
|
|---|
| 57 | 3 ;;S XBVAR=XBNS,XBHD=" K ",X=" K " F S XBVAR=$O(^XBVROU($J,"V",XBVAR)) Q:$E(XBVAR,1,XBLNS)'=XBNS I '$D(XBVPKG(XBVAR)) S X=X_XBVAR_"," S XBLX=$L(X) I XBLX>235 S X=$E(X,1,XBLX-1) ZI X S X=" K " X ^%ZOSF("SIZE") I Y>3000 X XBLD(5),XBLD(2)
|
|---|
| 58 | 4 ;;S XBLX=$L(X) I XBLX>3 S X=$E(X,1,XBLX-1) ZI X
|
|---|
| 59 | 5 ;;S XBNUM=XBNUM+1 S X=" D ^"_XBNS_"VKL"_XBNUM ZI X ZS @XBROU W !,XBROU," Saved",!!
|
|---|
| 60 | 6 ;;I $D(XBKROU) S X=XBKROU ZI X W !,"ADDING ",X,!
|
|---|
