ZOSFGTM ;ISF/staff - ZOSF Table for GT.M for VMS ;10/18/06 14:28
;;8.0;KERNEL;**275,425**;Jul 10, 1995;Build 18
; for GT.M for VMS, version 4.3
;
S %Y=1,DTIME=$G(DTIME,600)
K ^%ZOSF("MASTER"),^%ZOSF("SIGNOFF")
I '$D(^%ZOSF("VOL")) S ^%ZOSF("VOL")="ROU"
K ZO F I="MGR","PROD","VOL" S:$D(^%ZOSF(I)) ZO(I)=^%ZOSF(I)
F I=1:2 S Z=$P($T(Z+I),";;",2) Q:Z="" D
. S X=$P($T(Z+1+I),";;",2,99)
. S ^%ZOSF(Z)=$S($D(ZO(Z)):ZO(Z),1:X)
. Q
;
OS S ^%ZOSF("OS")="GT.M (VMS)^17"
MGR W !,"NAME OF MANAGER'S UCI,VOLUME SET: "_^%ZOSF("MGR")_"// " R X:DTIME I X]"" X ^("UCICHECK") G MGR:0[Y S ^%ZOSF("MGR")=X
PROD ;
W !,"The value of PRODUCTION will be used in the GETENV api."
W !,"PRODUCTION (SIGN-ON) UCI,VOLUME SET: "_^%ZOSF("PROD")_"// " R X:DTIME I X]"" X ^("UCICHECK") G PROD:0[Y S ^%ZOSF("PROD")=X
;See that VOL and PROD agree.
I ^%ZOSF("PROD")'[^%ZOSF("VOL") S ^%ZOSF("VOL")=$P(^%ZOSF("PROD"),",",2)
VOL W !,"The VOLUME name must match the one in PRODUCTION."
W !,"NAME OF VOLUME SET: "_^%ZOSF("VOL")_"//" R X:DTIME
I X]"" D I X'?3U W "MUST BE 3 Upper case." G VOL
. I ^%ZOSF("PROD")'[X W !,"Must match PRODUCTION"
. S:X?3U ^%ZOSF("VOL")=X
W !,"^%ZOSF setup"
Q
;
Z ;
;;ACTJ
;;S Y=$$ACTJ^%ZOSV()
;;AVJ
;;S Y=$$AVJ^%ZOSV()
;;BRK
;;U $I:(CENABLE)
;;DEL
;;D DEL^%ZOSV2(X) ;N %DIR S %DIR=$P($ZRO,",") ZSYSTEM "DEL "_%DIR_X_".m;*" ZSYSTEM "DEL "_%DIR_X_".obj;*"
;;EOFF
;;U $I:(NOECHO)
;;EON
;;U $I:(ECHO)
;;EOT
;;S Y=$ZA\1024#2 ; <=====
;;ERRTN
;;^%ZTER
;;ETRP
;;Q
;;GD
;;G ^%GD
;;$INC
;;0
;;JOBPARAM
;;G JOBPAR^%ZOSV
;;LABOFF
;;U IO:(NOECHO)
;;LOAD
;;D LOAD^%ZOSV2(X) ;N % S %N=0 F XCNP=XCNP+1:1 S %N=%N+1,%=$T(+%N^@X) Q:$L(%)=0 S @(DIF_XCNP_",0)")=%
;;LPC;;Longitudinal Parity Check (Exclusive OR of the 8-bit bytes)
;;S Y=$$LPC^%ZOSV(X)
;;MAGTAPE
;;S %MT("BS")="*1",%MT("FS")="*2",%MT("WTM")="*3",%MT("WB")="*4",%MT("REW")="*5",%MT("RB")="*6",%MT("REL")="*7",%MT("WHL")="*8",%MT("WEL")="*9" ; <=====
;;MAXSIZ
;;Q
;;MGR
;;VAH,ROU
;;MTBOT
;;S Y=$ZA\32#2 ; <=====
;;MTERR
;;S Y=$ZA\32768#2 ; <=====
;;MTONLINE
;;S Y=$ZA\64#2 ; <=====
;;MTWPROT
;;S Y=$ZA\4#2 ; <=====
;;NBRK
;;U $I:(NOCENABLE)
;;NO-PASSALL
;;U $I:(ESCAPE:TERMINATOR="":NOPASTHRU)
;;NO-TYPE-AHEAD
;;U $I:(NOTYPEAHEAD)
;;PASSALL
;;U $I:(NOESCAPE:NOTERMINATOR:PASTHRU)
;;PRIINQ
;;S Y=$$PRIINQ^%ZOSV()
;;PRIORITY
;;Q ;G PRIORITY^%ZOSV
;;PROD
;;VAH,ROU
;;PROGMODE
;;S Y=$$PROGMODE^%ZOSV()
;;RD
;;G ^%RD
;;RESJOB
;;Q:'$D(DUZ) Q:'$D(^XUSEC("XUMGR",+DUZ)) W !!,"From VMS use: mupip stop /id=pid",!
;;RM
;;U $I:WIDTH=$S(X<256:X,1:0)
;;RSEL
;;N %ZR,X K ^UTILITY($J) D ^%RSEL S X="" X "F S X=$O(%ZR(X)) Q:X="""" S ^UTILITY($J,X)="""""
;;RSUM
;;N %,%1,%2,%3 S Y=0 F %=1,3:1 S %1=$T(+%^@X),%3=$F(%1," ") Q:'%3 S %3=$S($E(%1,%3)'=";":$L(%1),$E(%1,%3+1)=";":$L(%1),1:%3-2) F %2=1:1:%3 S Y=$A(%1,%2)*%2+Y
;;RSUM1
;;N %,%1,%2,%3 S Y=0 F %=1,3:1 S %1=$T(+%^@X),%3=$F(%1," ") Q:'%3 S %3=$S($E(%1,%3)'=";":$L(%1),$E(%1,%3+1)=";":$L(%1),1:%3-2) F %2=1:1:%3 S Y=$A(%1,%2)*(%2+%)+Y
;;SS
;;D ^ZSY
;;SAVE
;;D SAVE^%ZOSV2(X) ;N %I,%F,SP S %I=$I,SP=" ",%F=$P($ZRO,",")_X_".m" O %F:(NEWVERSION) U %F X "F S XCN=$O(@(DIE_XCN_"")"")) Q:XCN'>0 S %=@(DIE_XCN_"",0)"") Q:$E(%,1)=""$"" I $E(%)'="";"" W $P(%,SP)_$C(9)_$P(%,SP,2,99999),!" C %F U %I
;;SIZE
;;N %,I S Y=0 F I=1:1 S %=$T(+I^@X) Q:%="" S Y=Y+$L(%)+2
;;TEST
;;I X]"",$L($$TEST^%ZOSV2(X))
;;TMK
;;S Y=$ZA\16384#2
;;TRAP
;;$ZT="G "_X
;;TRMOFF
;;U $I:(TERMINATOR="":NOPASTHRU:ESCAPE)
;;TRMON
;;U $I:(TERMINATOR=$C(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,127):NOESCAPE:PASTHRU)
;;TRMRD
;;S Y=$A($ZB)
;;TYPE-AHEAD
;;U $I:(TYPEAHEAD)
;;UCI
;;S Y=^%ZOSF("PROD")
;;UCICHECK
;;S Y=1
;;UPPERCASE
;;S Y=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
;;XY
;;S $X=DX,$Y=DY
;;VOL
;;ROU
;;ZD;;Input X, output Y.
;;S Y=$ZDATE(X) ;$$HTE^XLFDT(X,2) I $L($P(Y,"/"))=1 S Y=0_Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZOSFGTM 4070 printed Dec 13, 2024@02:15:21 Page 2
ZOSFGTM ;ISF/staff - ZOSF Table for GT.M for VMS ;10/18/06 14:28
+1 ;;8.0;KERNEL;**275,425**;Jul 10, 1995;Build 18
+2 ; for GT.M for VMS, version 4.3
+3 ;
+4 SET %Y=1
SET DTIME=$GET(DTIME,600)
+5 KILL ^%ZOSF("MASTER"),^%ZOSF("SIGNOFF")
+6 IF '$DATA(^%ZOSF("VOL"))
SET ^%ZOSF("VOL")="ROU"
+7 KILL ZO
FOR I="MGR","PROD","VOL"
if $DATA(^%ZOSF(I))
SET ZO(I)=^%ZOSF(I)
+8 FOR I=1:2
SET Z=$PIECE($TEXT(Z+I),";;",2)
if Z=""
QUIT
Begin DoDot:1
+9 SET X=$PIECE($TEXT(Z+1+I),";;",2,99)
+10 SET ^%ZOSF(Z)=$SELECT($DATA(ZO(Z)):ZO(Z),1:X)
+11 QUIT
End DoDot:1
+12 ;
OS SET ^%ZOSF("OS")="GT.M (VMS)^17"
MGR WRITE !,"NAME OF MANAGER'S UCI,VOLUME SET: "_^%ZOSF("MGR")_"// "
READ X:DTIME
IF X]""
XECUTE ^("UCICHECK")
if 0[Y
GOTO MGR
SET ^%ZOSF("MGR")=X
PROD ;
+1 WRITE !,"The value of PRODUCTION will be used in the GETENV api."
+2 WRITE !,"PRODUCTION (SIGN-ON) UCI,VOLUME SET: "_^%ZOSF("PROD")_"// "
READ X:DTIME
IF X]""
XECUTE ^("UCICHECK")
if 0[Y
GOTO PROD
SET ^%ZOSF("PROD")=X
+3 ;See that VOL and PROD agree.
+4 IF ^%ZOSF("PROD")'[^%ZOSF("VOL")
SET ^%ZOSF("VOL")=$PIECE(^%ZOSF("PROD"),",",2)
VOL WRITE !,"The VOLUME name must match the one in PRODUCTION."
+1 WRITE !,"NAME OF VOLUME SET: "_^%ZOSF("VOL")_"//"
READ X:DTIME
+2 IF X]""
Begin DoDot:1
+3 IF ^%ZOSF("PROD")'[X
WRITE !,"Must match PRODUCTION"
+4 if X?3U
SET ^%ZOSF("VOL")=X
End DoDot:1
IF X'?3U
WRITE "MUST BE 3 Upper case."
GOTO VOL
+5 WRITE !,"^%ZOSF setup"
+6 QUIT
+7 ;
Z ;
+1 ;;ACTJ
+2 ;;S Y=$$ACTJ^%ZOSV()
+3 ;;AVJ
+4 ;;S Y=$$AVJ^%ZOSV()
+5 ;;BRK
+6 ;;U $I:(CENABLE)
+7 ;;DEL
+8 ;;D DEL^%ZOSV2(X) ;N %DIR S %DIR=$P($ZRO,",") ZSYSTEM "DEL "_%DIR_X_".m;*" ZSYSTEM "DEL "_%DIR_X_".obj;*"
+9 ;;EOFF
+10 ;;U $I:(NOECHO)
+11 ;;EON
+12 ;;U $I:(ECHO)
+13 ;;EOT
+14 ;;S Y=$ZA\1024#2 ; <=====
+15 ;;ERRTN
+16 ;;^%ZTER
+17 ;;ETRP
+18 ;;Q
+19 ;;GD
+20 ;;G ^%GD
+21 ;;$INC
+22 ;;0
+23 ;;JOBPARAM
+24 ;;G JOBPAR^%ZOSV
+25 ;;LABOFF
+26 ;;U IO:(NOECHO)
+27 ;;LOAD
+28 ;;D LOAD^%ZOSV2(X) ;N % S %N=0 F XCNP=XCNP+1:1 S %N=%N+1,%=$T(+%N^@X) Q:$L(%)=0 S @(DIF_XCNP_",0)")=%
+29 ;;LPC;;Longitudinal Parity Check (Exclusive OR of the 8-bit bytes)
+30 ;;S Y=$$LPC^%ZOSV(X)
+31 ;;MAGTAPE
+32 ;;S %MT("BS")="*1",%MT("FS")="*2",%MT("WTM")="*3",%MT("WB")="*4",%MT("REW")="*5",%MT("RB")="*6",%MT("REL")="*7",%MT("WHL")="*8",%MT("WEL")="*9" ; <=====
+33 ;;MAXSIZ
+34 ;;Q
+35 ;;MGR
+36 ;;VAH,ROU
+37 ;;MTBOT
+38 ;;S Y=$ZA\32#2 ; <=====
+39 ;;MTERR
+40 ;;S Y=$ZA\32768#2 ; <=====
+41 ;;MTONLINE
+42 ;;S Y=$ZA\64#2 ; <=====
+43 ;;MTWPROT
+44 ;;S Y=$ZA\4#2 ; <=====
+45 ;;NBRK
+46 ;;U $I:(NOCENABLE)
+47 ;;NO-PASSALL
+48 ;;U $I:(ESCAPE:TERMINATOR="":NOPASTHRU)
+49 ;;NO-TYPE-AHEAD
+50 ;;U $I:(NOTYPEAHEAD)
+51 ;;PASSALL
+52 ;;U $I:(NOESCAPE:NOTERMINATOR:PASTHRU)
+53 ;;PRIINQ
+54 ;;S Y=$$PRIINQ^%ZOSV()
+55 ;;PRIORITY
+56 ;;Q ;G PRIORITY^%ZOSV
+57 ;;PROD
+58 ;;VAH,ROU
+59 ;;PROGMODE
+60 ;;S Y=$$PROGMODE^%ZOSV()
+61 ;;RD
+62 ;;G ^%RD
+63 ;;RESJOB
+64 ;;Q:'$D(DUZ) Q:'$D(^XUSEC("XUMGR",+DUZ)) W !!,"From VMS use: mupip stop /id=pid",!
+65 ;;RM
+66 ;;U $I:WIDTH=$S(X<256:X,1:0)
+67 ;;RSEL
+68 ;;N %ZR,X K ^UTILITY($J) D ^%RSEL S X="" X "F S X=$O(%ZR(X)) Q:X="""" S ^UTILITY($J,X)="""""
+69 ;;RSUM
+70 ;;N %,%1,%2,%3 S Y=0 F %=1,3:1 S %1=$T(+%^@X),%3=$F(%1," ") Q:'%3 S %3=$S($E(%1,%3)'=";":$L(%1),$E(%1,%3+1)=";":$L(%1),1:%3-2) F %2=1:1:%3 S Y=$A(%1,%2)*%2+Y
+71 ;;RSUM1
+72 ;;N %,%1,%2,%3 S Y=0 F %=1,3:1 S %1=$T(+%^@X),%3=$F(%1," ") Q:'%3 S %3=$S($E(%1,%3)'=";":$L(%1),$E(%1,%3+1)=";":$L(%1),1:%3-2) F %2=1:1:%3 S Y=$A(%1,%2)*(%2+%)+Y
+73 ;;SS
+74 ;;D ^ZSY
+75 ;;SAVE
+76 ;;D SAVE^%ZOSV2(X) ;N %I,%F,SP S %I=$I,SP=" ",%F=$P($ZRO,",")_X_".m" O %F:(NEWVERSION) U %F X "F S XCN=$O(@(DIE_XCN_"")"")) Q:XCN'>0 S %=@(DIE_XCN_"",0)"") Q:$E(%,1)=""$"" I $E(%)'="";"" W $P(%,SP)_$C(9)_$P(%,SP,2,99999),!" C %F U %I
+77 ;;SIZE
+78 ;;N %,I S Y=0 F I=1:1 S %=$T(+I^@X) Q:%="" S Y=Y+$L(%)+2
+79 ;;TEST
+80 ;;I X]"",$L($$TEST^%ZOSV2(X))
+81 ;;TMK
+82 ;;S Y=$ZA\16384#2
+83 ;;TRAP
+84 ;;$ZT="G "_X
+85 ;;TRMOFF
+86 ;;U $I:(TERMINATOR="":NOPASTHRU:ESCAPE)
+87 ;;TRMON
+88 ;;U $I:(TERMINATOR=$C(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,127):NOESCAPE:PASTHRU)
+89 ;;TRMRD
+90 ;;S Y=$A($ZB)
+91 ;;TYPE-AHEAD
+92 ;;U $I:(TYPEAHEAD)
+93 ;;UCI
+94 ;;S Y=^%ZOSF("PROD")
+95 ;;UCICHECK
+96 ;;S Y=1
+97 ;;UPPERCASE
+98 ;;S Y=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+99 ;;XY
+100 ;;S $X=DX,$Y=DY
+101 ;;VOL
+102 ;;ROU
+103 ;;ZD;;Input X, output Y.
+104 ;;S Y=$ZDATE(X) ;$$HTE^XLFDT(X,2) I $L($P(Y,"/"))=1 S Y=0_Y
