12:49 PM  22-MAY-97
XB/ZIB v 3.0, Patch 4.  Restore 6 routines.
XBVK
XBVK ; IHS/ADC/GTH - LOCAL VARIABLE KILLER FRONT END ;  [ 05/22/97  12:28 PM ]
 ;;3.0;IHS/VA UTILITIES;**4**;FEB 07, 1997
 ; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err.
 ;
 ; This is the front end for killing local variables in the
 ; namespaced parameter.  Implementation specific routines
 ; are called from this routine.  Those routines are in the
 ; ZIBVK* namespace.
 ;
 ; This routine is intended to be called by applications
 ; that are thru executing, in order to KILL any remaining
 ; namespaced local variables.  E.g., D EN^XBVK("AG") will
 ; KILL any local variables that exist in the AG namespace.
 ;
 ; Notice that if called in background, and the OS is not
 ; supported, the routine will quit, unpleasantly.  If your
 ; implementation is other than what is supported, below,
 ; and your vendor has implemented all Type A extensions to
 ; the 1990 ANSI M standard, you can safely remove the two
 ; lines that check for OS, and use the existing call to
 ; the MSM-specific routine.
 ;
 Q
 ;
EN(XBVK) ;PEP - Kill vars in namespace of parameter variable.
 ;
 ; I '$L($T(@$P(^%ZOSF("OS"),"-",1))) W !,*7,"OPERATING SYSTEM '",$P(^%ZOSF("OS"),"-",1),"' NOT SUPPORTED." Q ; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err.
 ; G @$P(^%ZOSF("OS"),"-",1) ; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err.
 I $P(^%ZOSF("OS"),"^",1)["MSM" G MSM ; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err.
 W !,*7,"OPERATING SYSTEM '",$P(^%ZOSF("OS"),"^",1),"' NOT SUPPORTED." ; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err.
 Q  ; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err.
 ;
MSM ; Micronetics Standard MUMPS.
 D EN^ZIBVKMSM(XBVK)
 Q
 ;

XBVL
XBVL ; IHS/ADC/GTH - LOCAL VARIABLE LISTER FRONT END ; [ 05/22/97  12:30 PM ]
 ;;3.0;IHS/VA UTILITIES;**4**;FEB 07, 1997
 ; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err.
 ;
 ; This is the front end for listing local variables.
 ; Implementation specific routines are called from this
 ; routine.  Those routines are in the ZIBVL* namespace.
 ;
 ; I '$L($T(@$P(^%ZOSF("OS"),"-",1))) W !,*7,"OPERATING SYSTEM '",$P(^%ZOSF("OS"),"-",1),"' NOT SUPPORTED." Q ; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err.
 ; G @$P(^%ZOSF("OS"),"-",1) ; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err.
 I $P(^%ZOSF("OS"),"^",1)["MSM" G MSM ; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err.
 W !,*7,"OPERATING SYSTEM '",$P(^%ZOSF("OS"),"^",1),"' NOT SUPPORTED." ; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err.
 Q  ; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err.
 ;
MSM ; Micronetics Standard MUMPS.
 G ^ZIBVLMSM
 ;
MESSAGE ;EP - Tell user of limitations.
 W !!?5,"DO routine ^XBVL from programmer mode."
 W !?5,"Not all local variables are available thru the XB menu.",!!
 Q
 ;

ZIBGCHAR
ZIBGCHAR ; IHS/ADC/GTH - NONINTERACTIVE MODIFICATIONS OF GLOBAL CHARACTERISTICS ; [ 05/22/97  12:37 PM ]
 ;;3.0;IHS/VA UTILITIES;**4**;FEB 07, 1997
 ; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err.
 ;
 ; Not all capabilities of the implementation-specific global
 ; characteristics routines are reflected in this routine.
 ;
 ; The argument for each entry point is the unsubscripted
 ; name of the global whose characteristics you want to
 ; change, with NO leading circumflex.  
 ;
 ; If the call is successful, 0 is returned.
 ;
 ; If the call is not successful, a positive integer is
 ; returned, and the cause can be retrieved at the ERR()
 ; entry point.
 ;
 ; E.g's: 
 ;          S %=$$NOJOURN^ZIBGCHAR("AUTTSITE")
 ;          I % W !,$$ERR^ZIBGCHAR(%)
 ;
 Q
 ;
KILLOK(ZIBGLOB) ;PEP - Allow kill of global.
 Q $$PROCESS("D","N")
 ;
KILLNO(ZIBGLOB) ;PEP - Prevent kill'ing of global.
 Q $$PROCESS("D","Y")
 ;
JOURN(ZIBGLOB) ;PEP - Set Journaling to ALWAYS.
 Q $$PROCESS("J","A")
 ;
NOJOURN(ZIBGLOB) ;PEP - Set Journaling for global to NEVER.
 Q $$PROCESS("J","N")
 ;
UCIJOURN(ZIBGLOB) ;PEP - Journal when UCI is Journaled.
 Q $$PROCESS("J","U")
 ;
PROCESS(ZIBFLAG,ZIBVAL) ;
 I '$L($G(ZIBGLOB)) Q 1
 I '(ZIBGLOB?1.8U) Q 5
 I '$D(@("^"_ZIBGLOB)) Q 2
 ; NEW O ; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err.
 ; S O=$P(^%ZOSF("OS"),"-",1) ; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err.
 ; I '$L($T(@O)) Q 3 ; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err.
 ; G @O ; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err.
 I $P(^%ZOSF("OS"),"^",1)["MSM" G MSM ; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err.
 Q 3 ; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err.
 ;
MSM ; Micronetics Standard MUMPS.
 I '$L($T(CALL^%GCH)) Q 4
 S:$D(ZTQUEUED) CALL="" ; Tell ^%GCH not to talk if errors.
 KILL O
 D CALL^%GCH(ZIBFLAG,ZIBGLOB,ZIBVAL)
 KILL CALL
 Q 0
 ;
ERR(Z) ;PEP - Return cause of error.
 Q $P($T(@Z),";;",2)
1 ;;NO GLOBAL SPECIFIED IN PARAMETER
2 ;;GLOBAL DOES NOT EXIST
3 ;;OPERATING SYSTEM NOT SUPPORTED
4 ;;WRONG VERSION OF MSM'S ^%GCH
5 ;;BAD GLOBAL NAME
 ;
 ;
TEST ;    
 NEW AZHB,AZHB1
 F AZHBCTR=1:1 S AZHB=$P($T(DATA+AZHBCTR),";",3) Q:AZHB="###"  D T1(AZHB),T2(AZHB)
 Q
 ;
T1(AZHB) ;
 W !,"No Journaling For '",AZHB,"'"
 S AZHB1=$$NOJOURN(AZHB)
 W ?28," : ",AZHB1
 I AZHB1 W " : ",$$ERR(AZHB1)
 E  W " : <kool>"
 Q
 ;
T2(AZHB) ;
 W !,"No Killing For '",AZHB,"'"
 S AZHB1=$$KILLNO(AZHB)
 W ?28," : ",AZHB1
 I AZHB1 W " : ",$$ERR(AZHB1)
 E  W " : <kool>"
 Q
 ;
DATA ;
 ;;
 ;;FREDDATA
 ;;ACHSDATA
 ;;AUTTSITE
 ;;^AUTTLOC
 ;;jen
 ;;44
 ;;DIC(4,
 ;;###

ZIBRPI
ZIBRPI ; IHS/ADC/GTH - REMOTE PATCH INSTALLATION ; [ 04/25/97  12:37 PM ]
 ;;3.0;IHS/VA UTILITIES;**1,2,3**;FEB 07, 1997
 ; XB*3*1 IHS/ADC/GTH 03-07-97 Correct spelling of uucppublic.
 ; XB*3*2 IHS/ADC/GTH 04-21-97 Correct patch file pattern match.
 ; XB*3*3 IHS/ADC/GTH 04-25-97 Correct patch file name handling.
 ;
 ; For a description of this utility, see the text in routine
 ; ZIBRPI2.
 ;
 ; D = Directory containing patch files
 ; D("OUT") = Directory with results files
 ; E = "Action" routine, named (A/B)9<namespace><patch_number>
 ; F = Name of a file containing a patch
 ; J = Today's Julian date
 ; L = Facility's Pseudo Prefix
 ; N = Namespace derived from the name of the file
 ; O = Operating System, and OS-specific commands
 ; P = PACKAGE file IEN
 ; V = Version derived from the name of the file
 ; W = Work file
 ;
 W !!,"EXECUTION UNAUTHORIZED.",!
 Q
 ;
OPT ;EP - Set option in OPTION file.  Called by a programmer.
 D OPT^ZIBRPI1
 Q
 ;
START ;EP - From TaskMan.
 NEW %ZIS,D,DA,DIC,E,F,I,J,L,N,O,P,POP,V,W,XMSUB,XMTEXT,XMY
 D HFS
 Q:POP
 D OS
 KILL ^TMP($J)
 ; rm xmit files over 2 weeks old.
 S L=$P(^AUTTLOC($P(^AUTTSITE(1,0),U),1),U,2) I '($L(L)=3) S L="RPI"
 D HC(O("LS")_D("OUT")_O("NS")_L_".* > "_W)
 S IOP=I,%ZIS("IOPAR")="("""_W_""":""R"")"
 D ZIS,JDT
 U IO
 ; Comment next line to keep xmit ("rpi") files over 2 wks old.
 F  R %:300 Q:%=""  S %=$P(%,"/",$L(%,"/")),X=+$P(%,".",2) I $P(%,".")=O("NS")_L,((+X>+J)!(+X<(+J-14))) D HC(O("RM")_D("OUT")_%)
 D HC(O("RM")_W)
 ; Initialize namespace, systems, and frequency.
 S %=+$P(^DIC(19,$O(^DIC(19,"B","ZIB REMOTE PATCH INSTALLATION",0)),20)," ",2),D=$P($P(^(20),"""",2),U)
 S:'("/\"[$E(D,$L(D))) D=D_$S(O["UNIX":"/",1:"\")
 D HC(O("LS")_D_"*.*"_" > "_W)
 S IOP=I,%ZIS("IOPAR")="("""_W_""":""R"")"
 D ZIS
 U IO
 ; The Q:%="" in the following line is non-standard MUMPS.
 F  R %:300 Q:%=""  S %=$P(%,"/",$L(%,"/")) I %?@O("PF") S ^TMP($J,"ZIBRPI",%)=""
 S F=""
 I '$L($O(^TMP($J,"ZIBRPI",""))) D ZISC D HC(O("RM")_W) KILL ^TMP($J) S:$D(ZTQUEUED) ZTREQ="@" Q
MAIN ;
 F  S F=$O(^TMP($J,"ZIBRPI",F)) Q:F=""  D  S ^TMP($J,"ZIBRPI",F)=% D:%="INSTALLED" HC(O("RM")_D_F)
 . S X=$E(F,1,4),X=$P(X,"_"),N=$$UP^XLFSTR(X)
 . I '$D(^DIC(9.4,"C",N)) S %="FAILED - Not an Installed Package" Q
 . S P=$O(^DIC(9.4,"C",N,0))
 . I 'P S %="FAILED - Bad ""C"" x-ref for "_N Q
 . I '$D(^DIC(9.4,P,"VERSION")) S %="FAILED - 'VERSION' Node Missing" Q
 . S V=+($E(F,5,6)_"."_$E(F,7,8))
 . I (+V)'=(+^DIC(9.4,P,"VERSION")) S %="FAILED - V "_^("VERSION")_" of "_N_" is Installed" Q
 . ; S E=$S("AB"[$E(N):$E(N),1:"B")_"9"_N_$P($P(F,".",2),"p",2) ; XB*3*3 IHS/ADC/GTH 04-25-97 Correct patch file name handling.
 . S E=$S("AB"[$E(N):$E(N),1:"B")_"9"_N_(+$P($P(F,".",2),"p",1)) ; XB*3*3 IHS/ADC/GTH 04-25-97 Correct patch file name handling.
 . U IO:(D_F)
 . R %:300
 . R %:300
 . ; The ZL and ZS in the following line are non-standard M commands.
 . F  R %:300 Q:%=""  S:%=E ^TMP($J,"B9",%)="" X "ZL  ZS @%"
 . S DA(1)=^DIC(9.4,P,"VERSION"),DA(1)=$O(^DIC(9.4,P,22,"B",DA(1)_$S(DA(1)[".":"",1:".0"),0))
 . I 'DA(1) S DA(1)=$P(^DIC(9.4,P,22,0),U,3)
 . S:'$D(^DIC(9.4,P,22,DA(1),"PAH",0)) ^(0)="^9.4901^^"
 . ; S X=N_"*"_V_"*"_$P($P(F,".",2),"p",2),DIC="^DIC(9.4,"_P_",22,"_DA(1)_",""PAH"",",DIC(0)="",DIC("DR")=".02///"_DT_";.03///.5",DA(2)=P ; XB*3*3 IHS/ADC/GTH 04-25-97 Correct patch file name handling.
 . S X=N_"*"_V_"*"_(+$P($P(F,".",2),"p",1)),DIC="^DIC(9.4,"_P_",22,"_DA(1)_",""PAH"",",DIC(0)="",DIC("DR")=".02///"_DT_";.03///.5",DA(2)=P ; XB*3*3 IHS/ADC/GTH 04-25-97 Correct patch file name handling.
 . D FILE
 . S %="INSTALLED"
 . Q
ENDMAIN ;
 D OS
 S %=0,F="",D=D("OUT")_O("NS")_L_"."_J
 U IO:(D:"W")
 F  S F=$O(^TMP($J,"ZIBRPI",F)) Q:F=""  W L,U,F,U,^(F),U,DT,! S %=%+1,XMTEXT(%)="Restore from file "_$E(F_$J("",14),1,14)_": "_^(F)
 U IO:(W)
 D ZISC,HC(O("RM")_W)
 ; uucp according to parameter: ENTRY ACTION of option.
 S %=+$P(^DIC(19,$O(^DIC(19,"B","ZIB REMOTE PATCH INSTALLATION",0)),20)," ",2),E=$P($P(^(20),"""",2),U,2)
 I O["UNIX" D
 . I '(%=2) D HC("uucp -r "_D_" "_$P($T(SYTM),";",3)_"!~")
 . I %>1 D HC("uucp -r -nroot "_D_" "_$P(^AUTTSITE(1,0),U,14)_"!~")
 . Q
 S XMTEXT="XMTEXT(",XMSUB=$P($P($T(ZIBRPI),";",2),"-",2),XMY(1)=""
 D XMD
 I E S %="" F  S %=$O(^TMP($J,"B9",%)) Q:%=""  D RTN(U_%)
 KILL ^TMP($J)
 S ZTREQ="@"
Q ;
 Q
 ;
DIE NEW D,E,F,I,J,L,N,O,P,V,W D ^DIE Q
DIR NEW D,E,F,I,J,L,N,O,P,V,W D ^DIR Q
DTC NEW D,E,F,I,J,L,N,O,P,V,W D ^%DTC Q
FILE NEW D,E,F,I,J,L,N,O,P,V,W KILL DD,DO D FILE^DICN Q
HC(%) NEW D,E,F,I,J,L,N,O,P,V,W S %=$$JOBWAIT^%HOSTCMD(%) Q
RTN(%) NEW D,E,F,I,J,L,N,O,P,V,W D @(%) Q
XMD NEW D,E,F,I,J,L,N,O,P,V,W D ^XMD Q
ZIS NEW D,E,F,I,J,L,N,O,P,V,W D ^%ZIS Q
ZISC NEW D,E,F,I,J,L,N,O,P,V,W D ^%ZISC Q
 ;
HFS ;
 ; F I=0:0 S I=$O(^%ZIS(1,I)) Q:'I  I ^(I,"TYPE")="HFS" S IOP=$P(^%ZIS(1,I,0),U),%ZIS("IOPAR")="(""/usr/spool/uucpublic/work.zib"":""W"")" D ZIS Q:'POP ; XB*3*1 IHS/ADC/GTH 03-07-97 Correct spelling of uucppublic.
 F I=0:0 S I=$O(^%ZIS(1,I)) Q:'I  I ^(I,"TYPE")="HFS" S IOP=$P(^%ZIS(1,I,0),U),%ZIS("IOPAR")="(""/usr/spool/uucppublic/work.zib"":""W"")" D ZIS Q:'POP  ; XB*3*1 IHS/ADC/GTH 03-07-97 Correct spelling of uucppublic.
 I 'I,'$D(POP) S POP=1
 Q:POP
 S I=$P(^%ZIS(1,I,0),U)
 Q
 ;
JDT ;
 NEW X1,X2
 S X2=$E(DT,1,3)_"0101",X1=DT
 D DTC
 S X=X+1,X="00"_X,J=$E(X,$L(X)-2,$L(X))
 Q
 ;
OS ; The "IN" directory is retrieved from the OPTION entry.
 S O=$P($P(^%ZOSF("OS"),","),"-",2),O("PF")=$P($T(PATTERN),";",3)
 S W=$P($T(WORK),";",3),O("NS")=$P($T(NS),";",3)
 I O["UNIX" S (D("IN"),D("OUT"))=$P($T(PUB),";",3),O("RM")="rm ",O("LS")="ls -l ",W=D("OUT")_W Q
 S %=$G(^AUTTSITE(1,1)),D("IN")=$P(%,U),D("OUT")=$P(%,U,2),O("RM")="DEL ",O("LS")="DIR /B "
 Q
 ;
 ; XB*3*2 IHS/ADC/GTH 04-21-97 Correct patch file pattern match.
 ;  Old PATTERN:
 ;;2.4L.2"_"4N1"."1"p"1.2N
SYTM ;;dpssyg
PATTERN ;;2.4L.2"_"4N1"."1.2N1"p"; XB*3*2 IHS/ADC/GTH 04-21-97 Correct patch file pattern match.
WORK ;;ZIBRPI.WRK
PUB ;;/usr/spool/uucppublic/
NS ;;ZIB_P

ZIBRSEL
ZIBRSEL ; IHS/ADC/GTH - NONINTERACTIVE ROUTINE SELECT ; [ 05/22/97  12:44 PM ]
 ;;3.0;IHS/VA UTILITIES;**4**;FEB 07, 1997
 ; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err.
 ;
 ; Return the number of selected routines set into the
 ; indicated variable.
 ;
 ; E.g.:
 ; I '$$RSEL^ZIBRSEL("B-BZZZZZZZ","ARRAY(") W "NONE SELECTED" Q
 ;
 ; If routines exists in the list or range, their name will
 ; be returned as the last subscript of indicated variable in
 ; the 2nd parameter.  The default is ^TMP("ZIBRSEL",$J,
 ;
 ; If routine B exists, then node ^TMP("ZIBRSEL",$J,"B") will
 ; be null.
 ;
 ; It is the programmer's responsibility to ensure the name
 ; of the array is correctly formed.
 ;
 ;        Variables used:
 ; X = String indicating list or range of routines.
 ; Y = String indicating variable into which to set the
 ;     selected routines.  Default = ^TMP("ZIBRSEL",$J,
 ; F = First routine, if range.
 ; L = Last routine, if range.
 ; N = Number of routines returned.
 ; Q = Quote character.
 ;
 Q
 ;
RSEL(X,Y) ;PEP - Select a list or range of routines, return in Y, # sel in N.
 I '$L($G(X)) Q "NO ROUTINES SPECIFIED IN PARAMETER"
 NEW F,L,N,O,Q
 ; S O=$P(^%ZOSF("OS"),"-",1) ; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err.
 S O=$P(^%ZOSF("OS"),"^",1) ; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err.
 I O["MSM" S O="MSM" ; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err.
 E  S O="unknown" ; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err.
 I '$L($T(@O)) Q "OPERATING SYSTEM '"_O_"' NOT SUPPORTED."
 I '$L($G(Y)) KILL ^TMP("ZIBRSEL",$J) S Y="^TMP(""ZIBRSEL"","_$J_","
 S F=$P(X,"-"),L=$P(X,"-",2),N=0,Q=""""
 I '(F]"") Q 0
 I F["*" S F=$P(F,"*"),L="*",X=$P(X,"*")
 D @O
 Q N
 ;
MSM ; Micronetics Standard MUMPS.
 I F]"",$D(^ (F)) S N=N+1,@(Y_Q_F_Q_")")=""
 I L="*" D  Q
 . F  S F=$O(^ (F)) Q:F=""!('(X=$E(F,1,$L(X))))  S N=N+1,@(Y_Q_F_Q_")")=""
 .Q
 F  S F=$O(^ (F)) Q:F=""!(F]L)  S N=N+1,@(Y_Q_F_Q_")")="" Q:L=""
 Q
 ;

ZIBVKIL
ZIBVKIL ; IHS/ADC/GTH - BUILD A KILL VARIABLE ROUTINE ; [ 05/22/97  12:47 PM ]
 ;;3.0;IHS/VA UTILITIES;**4**;FEB 07, 1997
 ; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err.
 ;
 ; Build a name space variable killer routine in ^.ns.KVAR.
 ;
 ; Select a %INDEX host file summary from which to build the
 ; routine.  Select a name space for the variables and the
 ; routine to be built.  Enter any package wide variables.
 ;
 ; Add D ^.ns.VKL0 to all menu exit actions where package
 ; variables are to remain.
 ;
 ; Add D KILL^XUSCLEAN to the exit of all other menus.
 ;
 ; 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.
 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.
 ;
 D HOME^%ZIS
 NEW XBNS
NS ;
 KILL DIR
 S DIR(0)="F^2:4",DIR("A")="Name Space - or ' ^ 'to exit"
 D ^DIR
 I X="^" G EXIT
 I Y="" G NS
 I '$D(^DIC(9.4,"C",Y)) W !,"NO PACKAGE ??",! G NS
 S XBNS=Y
PKGVAR ;
 KILL DIR
 S DIR(0)="F^0:235",DIR("A")="List of Package Wide Variables or '^' to bypass",DIR("?")="LIST var1,var2, ... "
 D ^DIR
 I Y'="^" F XBI=1:1 S X=$P(Y,",",XBI) Q:X=""  S XBVPKG(X)=""
KROU ;
 KILL DIR
 S DIR(0)="F^0:235",DIR("A")="List of other Kill routines to chain",DIR("?")=" ^ROU1,^ROU2, ... with '^'s"
 D ^DIR
 I Y]"",Y'="^"  F XBI=1:1 S XBROU=$P(Y,",",XBI) Q:XBROU=""  S X=$P(XBROU,"^",2) D
 . I X="" W !,XBROU,"   error in list >> ",Y G KROU
 . X ^%ZOSF("TEST")
 . I '$T W !,X,"   error in list >> ",Y G KROU
 .Q
 I Y]"" S XBKROU=" D "_Y
 D ^XBVCHV
 I '$D(^XBVROU($J)) W !,"NO FILE ??",! G NS
S ;
 F I=1:1 Q:'$T(@I)  S XBLD(I)=$P($T(@I),";;",2,99)
 X XBLD(1)
EXIT ;
 D KILL^XUSCLEAN
 KILL ^XBVROU($J),XBKROU,XBLD
 W !,"REMEMBER TO EDIT THE TOP LINES OF THE ROUTINES CREATED !",!!
 Q
 ;
1 ;;S XBNUM=0 X XBLD(2),XBLD(3),XBLD(4),XBLD(6) ZS @XBROU W !,XBROU," Saved ",!!
2 ;;ZR  S XBROU=XBNS_"VKL"_XBNUM,X=XBROU_" ; - kill variables",XBLNS=$L(XBNS) ZI X S X=" ;;" ZI X
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)
4 ;;S XBLX=$L(X) I XBLX>3 S X=$E(X,1,XBLX-1) ZI X
5 ;;S XBNUM=XBNUM+1 S X=" D ^"_XBNS_"VKL"_XBNUM ZI X ZS @XBROU W !,XBROU," Saved",!!
6 ;;I $D(XBKROU) S X=XBKROU ZI X W !,"ADDING ",X,!