- 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 6
- ;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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZTMGRSET 7042 printed Jan 18, 2025@03:17:27 Page 2
- 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 6
- +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