ZTMGRSET ;SF/RWF,PUG/TOAD - SET UP THE MGR ACCOUNT FOR THE SYSTEM ;02/13/2008
;;8.0;KERNEL;**34,36,69,94,121,127,136,191,275,355,446,584**;JUL 10, 1995;Build 7
;Per VHA Directive 2004-038, this routine should not be modified
;
N %D,%S,I,OSMAX,U,X,X1,X2,Y,Z1,Z2,ZTOS,ZTMODE,SCR
S ZTMODE=0
A W !!,"ZTMGRSET Version ",$P($T(+2),";",3)," Patch level ",$P($T(+2),";",5)
W !,"HELLO! I exist to assist you in correctly initializing the current account."
I $D(^%ZOSF("UCI")) X ^%ZOSF("UCI") D G A:"YNyn"'[$E(X) Q:"Nn"[$E(X)
. I ZTMODE=2 S X="Y" Q
. W $C(7),!!,"This is namespace or uci ",Y,".",!
. R "Should I continue? N//",X:120
. Q
S ZTOS=$$OS() I ZTOS'>0 W !,"OS type not selected. Exiting ZTMGRSET." Q
I ZTMODE D I (PCNM<1)!(PCNM>999) W !,"Need a Patch number to load." Q
. I ZTMODE<2 R !!,"Patch number to load: ",PCNM:120 Q:(PCNM<1)!(PCNM>999)
. S SCR="I $P($T(+2^@X),"";"",5)?.E1P1"_$C(34)_PCNM_$C(34)_"1P.E"
;
K ^%ZOSF("MASTER"),^("SIGNOFF") ;Remove old nodes.
;
DOIT D MES("I will now rename a group of routines specific to your operating system.",1)
D @ZTOS,ALL,GLOBALS:'ZTMODE D MES("ALL DONE",1)
Q
;========================================
RELOAD ;Reload any patched routines
N %D,%S,I,OSMAX,U,X,X1,X2,Y,Z1,Z2,ZTOS,ZTMODE,SCR
S ZTMODE=1 G A
Q
;
PATCH(PCNM) ;Post install Reload any patched routines
N %D,%S,I,OSMAX,U,X,X1,X2,Y,Z1,Z2,ZTOS,ZTMODE,SCR
I (1>PCNM)!(PCNM>999) D MES("PATCH NUMBER OUT OF RANGE",1) Q
D MES("Rename the routines in Patch "_PCNM,1)
S ZTMODE=2 G A
Q
;
MES(T,B) ;Write message.
S B=$G(B)
I $L($T(BMES^XPDUTL)) D BMES^XPDUTL(T):B,MES^XPDUTL(T):'B Q
W:B ! W !,T
Q
;
OS() ;Select the OS
N Y,X1,X,OSMAX
S U="^",SCR="I 1" F I=1:1:20 S X=$T(@I) Q:X="" S OSMAX=I
B S Y=0,ZTOS=0 I $D(^%ZOSF("OS")) D
. S X1=$P(^%ZOSF("OS"),U),ZTOS=$$OSNUM W !,"I think you are using ",X1
I ZTMODE=2,ZTOS>0 Q ZTOS
W !,"Which MUMPS system should I install?",!
F I=1:1:OSMAX W !,I," = ",$P($T(@I),";",3)
W !,"System: " W:ZTOS ZTOS,"//"
R X:300 S:X="" X=ZTOS
I $S(X<1!(X>OSMAX):1,1:$P($T(@X),";",3)="") W !,"NOT A VALID CHOICE" Q:X[U 0 G B
Q X
;
OSNUM() ;Return the OS number
N I,X1,X2,Y S Y=0,X1=$P($G(^%ZOSF("OS")),"^")
F I=1:1 S X2=$T(@I) Q:X2="" I X2[X1 S Y=I Q
Q Y
;
ALL W !!,"Now to load routines common to all systems."
D TM,ETRAP,DEV,OTHER,FM
I ZTOS=7!(ZTOS=8) D
. S ^%ZE="D ^ZE"
E D ;With ZLoad, ZSave, ZInsert
. W !,"Installing ^%Z editor"
. D ^ZTEDIT
I 'ZTMODE W !,"Setting ^%ZIS('C')" K ^%ZIS("C") S ^%ZIS("C")="G ^%ZISC"
Q
;
TM ;Taskman
S %S="ZTLOAD^ZTLOAD1^ZTLOAD2^ZTLOAD3^ZTLOAD4^ZTLOAD5^ZTLOAD6^ZTLOAD7"
S %D="%ZTLOAD^%ZTLOAD1^%ZTLOAD2^%ZTLOAD3^%ZTLOAD4^%ZTLOAD5^%ZTLOAD6^%ZTLOAD7"
D MOVE
S %S="ZTM^ZTM0^ZTM1^ZTM2^ZTM3^ZTM4^ZTM5^ZTM6"
S %D="%ZTM^%ZTM0^%ZTM1^%ZTM2^%ZTM3^%ZTM4^%ZTM5^%ZTM6"
D MOVE
S %S="ZTMS^ZTMS0^ZTMS1^ZTMS2^ZTMS3^ZTMS4^ZTMS5^ZTMS7^ZTMSH"
S %D="%ZTMS^%ZTMS0^%ZTMS1^%ZTMS2^%ZTMS3^%ZTMS4^%ZTMS5^%ZTMS7^%ZTMSH"
D MOVE
Q
FM ;Rename the FileMan routines
I ZTMODE>0 Q ;Only ask on full install
R !,"Want to rename the FileMan routines: No//",X:600 Q:"Yy"'[$E(X_"N")
S %S="DIDT^DIDTC^DIRCR",%D="%DT^%DTC^%RCR"
D MOVE
Q
;
ETRAP ;Error Trap
S %S="ZTER^ZTER1",%D="%ZTER^%ZTER1"
D MOVE
Q
OTHER S %S="ZTPP^ZTP1^ZTPTCH^ZTRDEL^ZTMOVE^ZTBKC"
S %D="%ZTPP^%ZTP1^%ZTPTCH^%ZTRDEL^%ZTMOVE^%ZTBKC"
D MOVE
Q
DEV S %S="ZIS^ZIS1^ZIS2^ZIS3^ZIS5^ZIS6^ZIS7^ZISC^ZISP^ZISS^ZISS1^ZISS2^ZISTCP^ZISUTL"
S %D="%ZIS^%ZIS1^%ZIS2^%ZIS3^%ZIS5^%ZIS6^%ZIS7^%ZISC^%ZISP^%ZISS^%ZISS1^%ZISS2^%ZISTCP^%ZISUTL"
D MOVE
Q
RUM ;Build the routines for Capacity Management (CM)
S %S=""
I ZTOS=1 S %S="ZOSVKRV^ZOSVKSVE^ZOSVKSVS^ZOSVKSD" ;DSM
I ZTOS=2 S %S="ZOSVKRM^ZOSVKSME^ZOSVKSMS^ZOSVKSD" ;MSM
I ZTOS=3 S %S="ZOSVKRO^ZOSVKSOE^ZOSVKSOS^ZOSVKSD" ;OpenM
I ZTOS=7!(ZTOS=8) S %S="ZOSVKRG^ZOSVKSGE^ZOSVKSGS^ZOSVKSD" ;GT.M
S %D="%ZOSVKR^%ZOSVKSE^%ZOSVKSS^%ZOSVKSD"
D MOVE
Q
ZOSF(X) ;
X SCR I $T W ! D @(U_X) W !
Q
1 ;;VAX DSM(V6), VAX DSM(V7)
S %S="ZOSVVXD^ZTBKCVXD^ZIS4VXD^ZISFVXD^ZISHVXD^XUCIVXD"
D DES,MOVE
S %S="ZOSV2VXD^ZTMDCL",%D="%ZOSV2^%ZTMDCL"
D MOVE,RUM,ZOSF("ZOSFVXD")
Q
2 ;;MSM-PC/PLUS, MSM for NT or UNIX
W !,"- Use autostart to do ZTMB don't resave as STUSER."
S %S="ZOSVMSM^ZTBKCMSM^ZIS4MSM^ZISFMSM^ZISHMSM^XUCIMSM"
D DES,MOVE
S %S="ZOSV2MSM",%D="%ZOSV2"
D MOVE,RUM,ZOSF("ZOSFMSM")
I $$VERSION^%ZOSV(1)["UNIX" S %S="ZISHMSU",%D="%ZISH" D MOVE
Q
3 ;;Cache (VMS, NT, Linux), OpenM-NT
S %S="ZOSVONT^ZTBKCONT^ZIS4ONT^ZISFONT^ZISHONT^XUCIONT"
D DES,MOVE
S %S="ZISTCPS^ZTMDCL",%D="%ZISTCPS^%ZTMDCL"
D MOVE,RUM,ZOSF("ZOSFONT")
Q
4 ;;
5 ;;
6 ;;
7 ;;GT.M (VMS)
S %ZE=".M" D init^%RSEL
S %S="ZOSVGTM^^ZIS4GTM^ZISFGTM^ZISHGTM^XUCIGTM"
D DES,MOVE
S %S="ZOSV2GTM^ZISTCPS^ZTMDCL",%D="%ZOSV2^%ZISTCPS^ZTMDCL"
D MOVE,ZOSF("ZOSFGTM")
Q
8 ;;GT.M (Unix)
S %ZE=".m" D init^%RSEL
S %S="ZOSVGUX^^ZIS4GTM^ZISFGTM^ZISHGTM^XUCIGTM"
D DES,MOVE
S %S="ZOSV2GTM^ZISTCPS",%D="%ZOSV2^%ZISTCPS"
D MOVE,ZOSF("ZOSFGUX")
Q
10 ;;NOT SUPPORTED
Q
MOVE ; rename % routines
N %,X,Y,M
F %=1:1:$L(%D,"^") D D MES(M)
. S M="",X=$P(%S,U,%) ; from
. S Y=$P(%D,U,%) ; to
. Q:X=""
. S M="Routine: "_$J(X,8)
. Q:Y="" I $T(^@X)="" S M=M_" Missing" Q
. X SCR Q:'$T
. S M=M_" Loaded, "
. D COPY(X,Y)
. S M=M_"Saved as "_$J(Y,8)
Q
;
COPY(FROM,TO) ;
I ZTOS'=7,ZTOS'=8 X "ZL @FROM ZS @TO" Q
;For GT.M below
N PATH,COPY,CMD S PATH=$$R
S FROM=PATH_FROM_".m"
S TO=PATH_$TR(TO,"%","_")_".m"
S COPY=$S(ZTOS=7:"COPY",1:"cp")
S CMD=COPY_" "_FROM_" "_TO
X "ZSYSTEM CMD"
Q
;
R() ; routine directory for GT.M
N ZRO X "S ZRO=$ZRO"
I ZTOS=7 D Q $S(ZRO["(":$P($P(ZRO,"(",2),")"),1:ZRO)
. S ZRO=$P(ZRO,",")
. I ZRO["/SRC=" S ZRO=$P(ZRO,"=",2) Q ;Source dir
. S ZRO=$S(ZRO["/":$P(ZRO,"/"),1:ZRO) Q ;Source and Obj in same dir
I ZTOS=8 Q $P($S(ZRO["(":$P($P(ZRO,"(",2),")"),1:ZRO)," ")_"/" ;Use first source dir.
E Q ""
;
DES S %D="%ZOSV^%ZTBKC1^%ZIS4^%ZISF^%ZISH^%XUCI" Q
;
GLOBALS ;Set node zero of file #3.05 & #3.07
W !!,"Now, I will check your % globals."
W ".........."
F %="^%ZIS","^%ZISL","^%ZTER","^%ZUA" S:'$D(@%) @%=""
S:$D(^%ZTSK(0))[0 ^%ZTSK(-1)=100,^%ZTSCH=""
S Z1=$G(^%ZTSK(-1),-1),Z2=$G(^%ZTSK(0))
I Z1'=$P(Z2,"^",3) S:Z1'>0 ^%ZTSK(-1)=+Z2 S ^%ZTSK(0)="TASKS^14.4^"_^%ZTSK(-1)
S:$D(^%ZUA(3.05,0))[0 ^%ZUA(3.05,0)="FAILED ACCESS ATTEMPTS LOG^3.05^^"
S:$D(^%ZUA(3.07,0))[0 ^%ZUA(3.07,0)="PROGRAMMER MODE LOG^3.07^^"
Q
NAME ;Setup the static names for this system
MGR W !,"NAME OF MANAGER'S UCI,VOLUME SET: "_^%ZOSF("MGR")_"// " R X:$S($G(DTIME):DTIME,1:9999) I X]"" X ^("UCICHECK") G MGR:0[Y S ^%ZOSF("MGR")=X
PROD W !,"PRODUCTION (SIGN-ON) UCI,VOLUME SET: "_^%ZOSF("PROD")_"// " R X:$S($G(DTIME):DTIME,1:9999) I X]"" X ^("UCICHECK") G PROD:0[Y S ^%ZOSF("PROD")=X
VOL W !,"NAME OF VOLUME SET: "_^%ZOSF("VOL")_"//" R X:$S($G(DTIME):DTIME,1:9999) I X]"" S:X?3U ^%ZOSF("VOL")=X I X'?3U W "MUST BE 3 Upper case." G VOL
W ! Q
ZTMGRSET ;SF/RWF,PUG/TOAD - SET UP THE MGR ACCOUNT FOR THE SYSTEM ;02/13/2008
+1 ;;8.0;KERNEL;**34,36,69,94,121,127,136,191,275,355,446,584**;JUL 10, 1995;Build 7
+2 ;Per VHA Directive 2004-038, this routine should not be modified
+3 ;
+4 NEW %D,%S,I,OSMAX,U,X,X1,X2,Y,Z1,Z2,ZTOS,ZTMODE,SCR
+5 SET ZTMODE=0
A WRITE !!,"ZTMGRSET Version ",$PIECE($TEXT(+2),";",3)," Patch level ",$PIECE($TEXT(+2),";",5)
+1 WRITE !,"HELLO! I exist to assist you in correctly initializing the current account."
+2 IF $DATA(^%ZOSF("UCI"))
XECUTE ^%ZOSF("UCI")
Begin DoDot:1
+3 IF ZTMODE=2
SET X="Y"
QUIT
+4 WRITE $CHAR(7),!!,"This is namespace or uci ",Y,".",!
+5 READ "Should I continue? N//",X:120
+6 QUIT
End DoDot:1
IF "YNyn"'[$EXTRACT(X)
GOTO A
IF "Nn"[$EXTRACT(X)
QUIT
+7 SET ZTOS=$$OS()
IF ZTOS'>0
WRITE !,"OS type not selected. Exiting ZTMGRSET."
QUIT
+8 IF ZTMODE
Begin DoDot:1
+9 IF ZTMODE<2
READ !!,"Patch number to load: ",PCNM:120
IF (PCNM<1)!(PCNM>999)
QUIT
+10 SET SCR="I $P($T(+2^@X),"";"",5)?.E1P1"_$CHAR(34)_PCNM_$CHAR(34)_"1P.E"
End DoDot:1
IF (PCNM<1)!(PCNM>999)
WRITE !,"Need a Patch number to load."
QUIT
+11 ;
+12 ;Remove old nodes.
KILL ^%ZOSF("MASTER"),^("SIGNOFF")
+13 ;
DOIT DO MES("I will now rename a group of routines specific to your operating system.",1)
+1 DO @ZTOS
DO ALL
IF 'ZTMODE
DO GLOBALS
DO MES("ALL DONE",1)
+2 QUIT
+3 ;========================================
RELOAD ;Reload any patched routines
+1 NEW %D,%S,I,OSMAX,U,X,X1,X2,Y,Z1,Z2,ZTOS,ZTMODE,SCR
+2 SET ZTMODE=1
GOTO A
+3 QUIT
+4 ;
PATCH(PCNM) ;Post install Reload any patched routines
+1 NEW %D,%S,I,OSMAX,U,X,X1,X2,Y,Z1,Z2,ZTOS,ZTMODE,SCR
+2 IF (1>PCNM)!(PCNM>999)
DO MES("PATCH NUMBER OUT OF RANGE",1)
QUIT
+3 DO MES("Rename the routines in Patch "_PCNM,1)
+4 SET ZTMODE=2
GOTO A
+5 QUIT
+6 ;
MES(T,B) ;Write message.
+1 SET B=$GET(B)
+2 IF $LENGTH($TEXT(BMES^XPDUTL))
IF B
DO BMES^XPDUTL(T)
IF 'B
DO MES^XPDUTL(T)
QUIT
+3 IF B
WRITE !
WRITE !,T
+4 QUIT
+5 ;
OS() ;Select the OS
+1 NEW Y,X1,X,OSMAX
+2 SET U="^"
SET SCR="I 1"
FOR I=1:1:20
SET X=$TEXT(@I)
IF X=""
QUIT
SET OSMAX=I
B SET Y=0
SET ZTOS=0
IF $DATA(^%ZOSF("OS"))
Begin DoDot:1
+1 SET X1=$PIECE(^%ZOSF("OS"),U)
SET ZTOS=$$OSNUM
WRITE !,"I think you are using ",X1
End DoDot:1
+2 IF ZTMODE=2
IF ZTOS>0
QUIT ZTOS
+3 WRITE !,"Which MUMPS system should I install?",!
+4 FOR I=1:1:OSMAX
WRITE !,I," = ",$PIECE($TEXT(@I),";",3)
+5 WRITE !,"System: "
IF ZTOS
WRITE ZTOS,"//"
+6 READ X:300
IF X=""
SET X=ZTOS
+7 IF $SELECT(X<1!(X>OSMAX):1,1:$PIECE($TEXT(@X),";",3)="")
WRITE !,"NOT A VALID CHOICE"
IF X[U
QUIT 0
GOTO B
+8 QUIT X
+9 ;
OSNUM() ;Return the OS number
+1 NEW I,X1,X2,Y
SET Y=0
SET X1=$PIECE($GET(^%ZOSF("OS")),"^")
+2 FOR I=1:1
SET X2=$TEXT(@I)
IF X2=""
QUIT
IF X2[X1
SET Y=I
QUIT
+3 QUIT Y
+4 ;
ALL WRITE !!,"Now to load routines common to all systems."
+1 DO TM
DO ETRAP
DO DEV
DO OTHER
DO FM
+2 IF ZTOS=7!(ZTOS=8)
Begin DoDot:1
+3 SET ^%ZE="D ^ZE"
End DoDot:1
+4 ;With ZLoad, ZSave, ZInsert
IF '$TEST
Begin DoDot:1
+5 WRITE !,"Installing ^%Z editor"
+6 DO ^ZTEDIT
End DoDot:1
+7 IF 'ZTMODE
WRITE !,"Setting ^%ZIS('C')"
KILL ^%ZIS("C")
SET ^%ZIS("C")="G ^%ZISC"
+8 QUIT
+9 ;
TM ;Taskman
+1 SET %S="ZTLOAD^ZTLOAD1^ZTLOAD2^ZTLOAD3^ZTLOAD4^ZTLOAD5^ZTLOAD6^ZTLOAD7"
+2 SET %D="%ZTLOAD^%ZTLOAD1^%ZTLOAD2^%ZTLOAD3^%ZTLOAD4^%ZTLOAD5^%ZTLOAD6^%ZTLOAD7"
+3 DO MOVE
+4 SET %S="ZTM^ZTM0^ZTM1^ZTM2^ZTM3^ZTM4^ZTM5^ZTM6"
+5 SET %D="%ZTM^%ZTM0^%ZTM1^%ZTM2^%ZTM3^%ZTM4^%ZTM5^%ZTM6"
+6 DO MOVE
+7 SET %S="ZTMS^ZTMS0^ZTMS1^ZTMS2^ZTMS3^ZTMS4^ZTMS5^ZTMS7^ZTMSH"
+8 SET %D="%ZTMS^%ZTMS0^%ZTMS1^%ZTMS2^%ZTMS3^%ZTMS4^%ZTMS5^%ZTMS7^%ZTMSH"
+9 DO MOVE
+10 QUIT
FM ;Rename the FileMan routines
+1 ;Only ask on full install
IF ZTMODE>0
QUIT
+2 READ !,"Want to rename the FileMan routines: No//",X:600
IF "Yy"'[$EXTRACT(X_"N")
QUIT
+3 SET %S="DIDT^DIDTC^DIRCR"
SET %D="%DT^%DTC^%RCR"
+4 DO MOVE
+5 QUIT
+6 ;
ETRAP ;Error Trap
+1 SET %S="ZTER^ZTER1"
SET %D="%ZTER^%ZTER1"
+2 DO MOVE
+3 QUIT
OTHER SET %S="ZTPP^ZTP1^ZTPTCH^ZTRDEL^ZTMOVE^ZTBKC"
+1 SET %D="%ZTPP^%ZTP1^%ZTPTCH^%ZTRDEL^%ZTMOVE^%ZTBKC"
+2 DO MOVE
+3 QUIT
DEV SET %S="ZIS^ZIS1^ZIS2^ZIS3^ZIS5^ZIS6^ZIS7^ZISC^ZISP^ZISS^ZISS1^ZISS2^ZISTCP^ZISUTL"
+1 SET %D="%ZIS^%ZIS1^%ZIS2^%ZIS3^%ZIS5^%ZIS6^%ZIS7^%ZISC^%ZISP^%ZISS^%ZISS1^%ZISS2^%ZISTCP^%ZISUTL"
+2 DO MOVE
+3 QUIT
RUM ;Build the routines for Capacity Management (CM)
+1 SET %S=""
+2 ;DSM
IF ZTOS=1
SET %S="ZOSVKRV^ZOSVKSVE^ZOSVKSVS^ZOSVKSD"
+3 ;MSM
IF ZTOS=2
SET %S="ZOSVKRM^ZOSVKSME^ZOSVKSMS^ZOSVKSD"
+4 ;OpenM
IF ZTOS=3
SET %S="ZOSVKRO^ZOSVKSOE^ZOSVKSOS^ZOSVKSD"
+5 ;GT.M
IF ZTOS=7!(ZTOS=8)
SET %S="ZOSVKRG^ZOSVKSGE^ZOSVKSGS^ZOSVKSD"
+6 SET %D="%ZOSVKR^%ZOSVKSE^%ZOSVKSS^%ZOSVKSD"
+7 DO MOVE
+8 QUIT
ZOSF(X) ;
+1 XECUTE SCR
IF $TEST
WRITE !
DO @(U_X)
WRITE !
+2 QUIT
1 ;;VAX DSM(V6), VAX DSM(V7)
+1 SET %S="ZOSVVXD^ZTBKCVXD^ZIS4VXD^ZISFVXD^ZISHVXD^XUCIVXD"
+2 DO DES
DO MOVE
+3 SET %S="ZOSV2VXD^ZTMDCL"
SET %D="%ZOSV2^%ZTMDCL"
+4 DO MOVE
DO RUM
DO ZOSF("ZOSFVXD")
+5 QUIT
2 ;;MSM-PC/PLUS, MSM for NT or UNIX
+1 WRITE !,"- Use autostart to do ZTMB don't resave as STUSER."
+2 SET %S="ZOSVMSM^ZTBKCMSM^ZIS4MSM^ZISFMSM^ZISHMSM^XUCIMSM"
+3 DO DES
DO MOVE
+4 SET %S="ZOSV2MSM"
SET %D="%ZOSV2"
+5 DO MOVE
DO RUM
DO ZOSF("ZOSFMSM")
+6 IF $$VERSION^%ZOSV(1)["UNIX"
SET %S="ZISHMSU"
SET %D="%ZISH"
DO MOVE
+7 QUIT
3 ;;Cache (VMS, NT, Linux), OpenM-NT
+1 SET %S="ZOSVONT^ZTBKCONT^ZIS4ONT^ZISFONT^ZISHONT^XUCIONT"
+2 DO DES
DO MOVE
+3 SET %S="ZISTCPS^ZTMDCL"
SET %D="%ZISTCPS^%ZTMDCL"
+4 DO MOVE
DO RUM
DO ZOSF("ZOSFONT")
+5 QUIT
4 ;;
5 ;;
6 ;;
7 ;;GT.M (VMS)
+1 SET %ZE=".M"
DO init^%RSEL
+2 SET %S="ZOSVGTM^^ZIS4GTM^ZISFGTM^ZISHGTM^XUCIGTM"
+3 DO DES
DO MOVE
+4 SET %S="ZOSV2GTM^ZISTCPS^ZTMDCL"
SET %D="%ZOSV2^%ZISTCPS^ZTMDCL"
+5 DO MOVE
DO ZOSF("ZOSFGTM")
+6 QUIT
8 ;;GT.M (Unix)
+1 SET %ZE=".m"
DO init^%RSEL
+2 SET %S="ZOSVGUX^^ZIS4GTM^ZISFGTM^ZISHGTM^XUCIGTM"
+3 DO DES
DO MOVE
+4 SET %S="ZOSV2GTM^ZISTCPS"
SET %D="%ZOSV2^%ZISTCPS"
+5 DO MOVE
DO ZOSF("ZOSFGUX")
+6 QUIT
10 ;;NOT SUPPORTED
+1 QUIT
MOVE ; rename % routines
+1 NEW %,X,Y,M
+2 FOR %=1:1:$LENGTH(%D,"^")
Begin DoDot:1
+3 ; from
SET M=""
SET X=$PIECE(%S,U,%)
+4 ; to
SET Y=$PIECE(%D,U,%)
+5 IF X=""
QUIT
+6 SET M="Routine: "_$JUSTIFY(X,8)
+7 IF Y=""
QUIT
IF $TEXT(^@X)=""
SET M=M_" Missing"
QUIT
+8 XECUTE SCR
IF '$TEST
QUIT
+9 SET M=M_" Loaded, "
+10 DO COPY(X,Y)
+11 SET M=M_"Saved as "_$JUSTIFY(Y,8)
End DoDot:1
DO MES(M)
+12 QUIT
+13 ;
COPY(FROM,TO) ;
+1 IF ZTOS'=7
IF ZTOS'=8
XECUTE "ZL @FROM ZS @TO"
QUIT
+2 ;For GT.M below
+3 NEW PATH,COPY,CMD
SET PATH=$$R
+4 SET FROM=PATH_FROM_".m"
+5 SET TO=PATH_$TRANSLATE(TO,"%","_")_".m"
+6 SET COPY=$SELECT(ZTOS=7:"COPY",1:"cp")
+7 SET CMD=COPY_" "_FROM_" "_TO
+8 XECUTE "ZSYSTEM CMD"
+9 QUIT
+10 ;
R() ; routine directory for GT.M
+1 NEW ZRO
XECUTE "S ZRO=$ZRO"
+2 IF ZTOS=7
Begin DoDot:1
+3 SET ZRO=$PIECE(ZRO,",")
+4 ;Source dir
IF ZRO["/SRC="
SET ZRO=$PIECE(ZRO,"=",2)
QUIT
+5 ;Source and Obj in same dir
SET ZRO=$SELECT(ZRO["/":$PIECE(ZRO,"/"),1:ZRO)
QUIT
End DoDot:1
QUIT $SELECT(ZRO["(":$PIECE($PIECE(ZRO,"(",2),")"),1:ZRO)
+6 ;Use first source dir.
IF ZTOS=8
QUIT $PIECE($SELECT(ZRO["(":$PIECE($PIECE(ZRO,"(",2),")"),1:ZRO)," ")_"/"
+7 IF '$TEST
QUIT ""
+8 ;
DES SET %D="%ZOSV^%ZTBKC1^%ZIS4^%ZISF^%ZISH^%XUCI"
QUIT
+1 ;
GLOBALS ;Set node zero of file #3.05 & #3.07
+1 WRITE !!,"Now, I will check your % globals."
+2 WRITE ".........."
+3 FOR %="^%ZIS","^%ZISL","^%ZTER","^%ZUA"
IF '$DATA(@%)
SET @%=""
+4 IF $DATA(^%ZTSK(0))[0
SET ^%ZTSK(-1)=100
SET ^%ZTSCH=""
+5 SET Z1=$GET(^%ZTSK(-1),-1)
SET Z2=$GET(^%ZTSK(0))
+6 IF Z1'=$PIECE(Z2,"^",3)
IF Z1'>0
SET ^%ZTSK(-1)=+Z2
SET ^%ZTSK(0)="TASKS^14.4^"_^%ZTSK(-1)
+7 IF $DATA(^%ZUA(3.05,0))[0
SET ^%ZUA(3.05,0)="FAILED ACCESS ATTEMPTS LOG^3.05^^"
+8 IF $DATA(^%ZUA(3.07,0))[0
SET ^%ZUA(3.07,0)="PROGRAMMER MODE LOG^3.07^^"
+9 QUIT
NAME ;Setup the static names for this system
MGR WRITE !,"NAME OF MANAGER'S UCI,VOLUME SET: "_^%ZOSF("MGR")_"// "
READ X:$SELECT($GET(DTIME):DTIME,1:9999)
IF X]""
XECUTE ^("UCICHECK")
IF 0[Y
GOTO MGR
SET ^%ZOSF("MGR")=X
PROD WRITE !,"PRODUCTION (SIGN-ON) UCI,VOLUME SET: "_^%ZOSF("PROD")_"// "
READ X:$SELECT($GET(DTIME):DTIME,1:9999)
IF X]""
XECUTE ^("UCICHECK")
IF 0[Y
GOTO PROD
SET ^%ZOSF("PROD")=X
VOL WRITE !,"NAME OF VOLUME SET: "_^%ZOSF("VOL")_"//"
READ X:$SELECT($GET(DTIME):DTIME,1:9999)
IF X]""
IF X?3U
SET ^%ZOSF("VOL")=X
IF X'?3U
WRITE "MUST BE 3 Upper case."
GOTO VOL
+1 WRITE !
QUIT
