ZOSFGTM.m

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

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