DINZDTM.m

DINZDTM ;SFISC/HGL,AL-SETS %ZOSF FOR DATATREE ;2:32 PM  1 Oct 1998

 ;;22.0;VA FileMan;;Mar 30, 1999

 ;Per VHA Directive 10-93-142, this routine should not be modified.

 K ^%ZOSF("MASTER"),^%ZOSF("SIGNOFF")

 F I=1:2 S Z=$P($T(Z+I),";;",2) Q:Z=""  S X=$P($T(Z+1+I),";;",2,99) S ^%ZOSF(Z)=X

 K I,X,Z

 Q

V3 ;

 S ^%ZOSF("TRAP")="$ZE=X"

 S ^%ZOSF("PROGMODE")="S Y=0"

 Q

Z ;;

 ;;OS;; Operating System Name

 ;;DTM-PC^9

 ;;ACTJ;; Active Jobs

 ;;S Y=$$ACTJ^%ZOSV

 ;;AVJ;; Available Jobs

 ;;S Y=$$AVJ^%ZOSV

 ;;MAXJ;; Maximum # of Jobs

 ;;G MAXJ^%ZOSV

 ;;BRK;; Enable Break

 ;;B 1

 ;;DEL;; Delete Routine in X

 ;;X "ZR  ZS @X"

 ;;EOFF;; Turn echo off

 ;;U $I:(echom=0)

 ;;EON;; Turn echo on

 ;;U $I:(echom=1)

 ;;EOT;; End of tape

 ;;S Y=($ZIOS=3)

 ;;ERRTN;; Error trap routine

 ;;^%ZTER

 ;;ETRP;; Set error trap to X

 ;;Q

 ;;GD;; Global Directory

 ;;G ^%gd

 ;;JOBPARAM

 ;;G JOBPAR^%ZOSV

 ;;LABOFF

 ;;U IO:(echom=0)

 ;;LOAD

 ;;S %N=0 X "ZL @X F XCNP=XCNP+1:1 S %N=%N+1,%=$T(+%N) Q:$L(%)=0  S @(DIF_XCNP_"",0)"")=%"

 ;;LPC;;

 ;;S Y=$ZCRC(X,1)

 ;;MAXSIZ;; Reset partition size

 ;;Q

 ;;NBRK;; Disable Break

 ;;B 0

 ;;NO-PASSALL

 ;;G NOPASS^%ZOSV

 ;;NO-TYPE-AHEAD;; Turn off type-ahead

 ;;U $I:(ta=0)

 ;;PARSIZ

 ;;S X=3

 ;;PASSALL

 ;;G PASSALL^%ZOSV

 ;;PRIINQ;; Find job's priority

 ;;S Y=$$PRIINQ^%ZOSV()

 ;;PRIORITY;; Set a job's priority

 ;;G PRIORITY^%ZOSV

 ;;PROGMODE;; Check if user is in programmer mode

 ;;S Y=$ZMODE

 ;;RD;; Routine Directory

 ;;G ^%rd

 ;;RESJOB

 ;;Q:'$D(DUZ)  Q:'$D(^XUSEC("XUMGR",+DUZ))  N XQZ S XQZ="^%mjob[MGR]" D DO^%XUCI

 ;;RM;; Set right margin to X ;***EDITED BY AC/SFISC***

 ;;U $I:(lmar=0:width=$S(X:X,1:$zdevfwid):wrap=(X&($I>99)))

 ;;RSEL;; Routine Select - returns number of routines in NRO

 ;;K ^UTILITY($J) S NRO=$$^%rselect W !,NRO," routines selected" S %X="^%RSET("_$J_",",%Y="^UTILITY("_$J_"," D %XY^%RCR S ^UTILITY($J)=^%RSET($J) K ^%RSET($J),%X,%Y

 ;;RSUM

 ;;ZL @X S Y=0 F %=1,3:1 S %1=$T(+%),%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

 ;;SAVE

 ;;S XCS="F XCM=1:1 S XCN=$O(@(DIE_XCN_"")"")) Q:+XCN'=XCN  S %=^(XCN,0) Q:$E(%,1)=""$""  S:%'[$C(9) %=$P(%,"" "",1)_$C(9)_$P(%,"" "",2,999) I $E(%,1)'="";"" ZI %" X "ZR  X XCS ZS @X" S ^UTILITY("ROU",X)="" K XCS

 ;;SIZE;; Return size of routine in partition

 ;;S Y=$L($zrsource($zn))

 ;;SS;; System Status

 ;;G ^%mjob

 ;;TEST;; Routine existence test

 ;;I $ZRSTATUS(X)'=""

 ;;TMK;; Tapemark

 ;;Q

 ;;TRMOFF

 ;;G:$P($ZVER,"/",2)<4.3 TRMOFF^%ZOSV U $I:TERM=$C(13,27)

 ;;TRMON

 ;;G:$P($ZVER,"/",2)<4.3 TRMON^%ZOSV U $I:TERM=$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)

 ;;TRMRD

 ;;S Y=$S('$ZIOS:$ZIOT,1:0)

 ;;TRAP;; DTM V4 only.  zetrap works for both versions

 ;;$ZT=X

 ;;TYPE-AHEAD;; Turn on type-ahead

 ;;U $I:(ta=1)

 ;;UCI;; Return current namespace in Y

 ;;S Y=$ZNSPACE

 ;;UCICHECK;;

 ;;S Y=$$UCICHECK^%ZOSV(X)

 ;;UPPERCASE

 ;;S Y=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")

 ;;XY;; Position cursor

 ;;S $X=DX,$Y=DY

 ;;ZD;; External date format in Y

 ;;S Y=$ZD($H,1)

DINZDTM   ;SFISC/HGL,AL-SETS %ZOSF FOR DATATREE ;2:32 PM  1 Oct 1998

 +1       ;;22.0;VA FileMan;;Mar 30, 1999

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

 +3        KILL ^%ZOSF("MASTER"),^%ZOSF("SIGNOFF")

 +4        FOR I=1:2

               SET Z=$PIECE($TEXT(Z+I),";;",2)

               IF Z=""

                   QUIT 

               SET X=$PIECE($TEXT(Z+1+I),";;",2,99)

               SET ^%ZOSF(Z)=X

 +5        KILL I,X,Z

 +6        QUIT 

V3        ;

 +1        SET ^%ZOSF("TRAP")="$ZE=X"

 +2        SET ^%ZOSF("PROGMODE")="S Y=0"

 +3        QUIT 

Z         ;;

 +1       ;;OS;; Operating System Name

 +2       ;;DTM-PC^9

 +3       ;;ACTJ;; Active Jobs

 +4       ;;S Y=$$ACTJ^%ZOSV

 +5       ;;AVJ;; Available Jobs

 +6       ;;S Y=$$AVJ^%ZOSV

 +7       ;;MAXJ;; Maximum # of Jobs

 +8       ;;G MAXJ^%ZOSV

 +9       ;;BRK;; Enable Break

 +10      ;;B 1

 +11      ;;DEL;; Delete Routine in X

 +12      ;;X "ZR  ZS @X"

 +13      ;;EOFF;; Turn echo off

 +14      ;;U $I:(echom=0)

 +15      ;;EON;; Turn echo on

 +16      ;;U $I:(echom=1)

 +17      ;;EOT;; End of tape

 +18      ;;S Y=($ZIOS=3)

 +19      ;;ERRTN;; Error trap routine

 +20      ;;^%ZTER

 +21      ;;ETRP;; Set error trap to X

 +22      ;;Q

 +23      ;;GD;; Global Directory

 +24      ;;G ^%gd

 +25      ;;JOBPARAM

 +26      ;;G JOBPAR^%ZOSV

 +27      ;;LABOFF

 +28      ;;U IO:(echom=0)

 +29      ;;LOAD

 +30      ;;S %N=0 X "ZL @X F XCNP=XCNP+1:1 S %N=%N+1,%=$T(+%N) Q:$L(%)=0  S @(DIF_XCNP_"",0)"")=%"

 +31      ;;LPC;;

 +32      ;;S Y=$ZCRC(X,1)

 +33      ;;MAXSIZ;; Reset partition size

 +34      ;;Q

 +35      ;;NBRK;; Disable Break

 +36      ;;B 0

 +37      ;;NO-PASSALL

 +38      ;;G NOPASS^%ZOSV

 +39      ;;NO-TYPE-AHEAD;; Turn off type-ahead

 +40      ;;U $I:(ta=0)

 +41      ;;PARSIZ

 +42      ;;S X=3

 +43      ;;PASSALL

 +44      ;;G PASSALL^%ZOSV

 +45      ;;PRIINQ;; Find job's priority

 +46      ;;S Y=$$PRIINQ^%ZOSV()

 +47      ;;PRIORITY;; Set a job's priority

 +48      ;;G PRIORITY^%ZOSV

 +49      ;;PROGMODE;; Check if user is in programmer mode

 +50      ;;S Y=$ZMODE

 +51      ;;RD;; Routine Directory

 +52      ;;G ^%rd

 +53      ;;RESJOB

 +54      ;;Q:'$D(DUZ)  Q:'$D(^XUSEC("XUMGR",+DUZ))  N XQZ S XQZ="^%mjob[MGR]" D DO^%XUCI

 +55      ;;RM;; Set right margin to X ;***EDITED BY AC/SFISC***

 +56      ;;U $I:(lmar=0:width=$S(X:X,1:$zdevfwid):wrap=(X&($I>99)))

 +57      ;;RSEL;; Routine Select - returns number of routines in NRO

 +58      ;;K ^UTILITY($J) S NRO=$$^%rselect W !,NRO," routines selected" S %X="^%RSET("_$J_",",%Y="^UTILITY("_$J_"," D %XY^%RCR S ^UTILITY($J)=^%RSET($J) K ^%RSET($J),%X,%Y

 +59      ;;RSUM

 +60      ;;ZL @X S Y=0 F %=1,3:1 S %1=$T(+%),%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

 +61      ;;SAVE

 +62      ;;S XCS="F XCM=1:1 S XCN=$O(@(DIE_XCN_"")"")) Q:+XCN'=XCN  S %=^(XCN,0) Q:$E(%,1)=""$""  S:%'[$C(9) %=$P(%,"" "",1)_$C(9)_$P(%,"" "",2,999) I $E(%,1)'="";"" ZI %" X "ZR  X XCS ZS @X" S ^UTILITY("ROU",X)="" K XCS

 +63      ;;SIZE;; Return size of routine in partition

 +64      ;;S Y=$L($zrsource($zn))

 +65      ;;SS;; System Status

 +66      ;;G ^%mjob

 +67      ;;TEST;; Routine existence test

 +68      ;;I $ZRSTATUS(X)'=""

 +69      ;;TMK;; Tapemark

 +70      ;;Q

 +71      ;;TRMOFF

 +72      ;;G:$P($ZVER,"/",2)<4.3 TRMOFF^%ZOSV U $I:TERM=$C(13,27)

 +73      ;;TRMON

 +74      ;;G:$P($ZVER,"/",2)<4.3 TRMON^%ZOSV U $I:TERM=$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)

 +75      ;;TRMRD

 +76      ;;S Y=$S('$ZIOS:$ZIOT,1:0)

 +77      ;;TRAP;; DTM V4 only.  zetrap works for both versions

 +78      ;;$ZT=X

 +79      ;;TYPE-AHEAD;; Turn on type-ahead

 +80      ;;U $I:(ta=1)

 +81      ;;UCI;; Return current namespace in Y

 +82      ;;S Y=$ZNSPACE

 +83      ;;UCICHECK;;

 +84      ;;S Y=$$UCICHECK^%ZOSV(X)

 +85      ;;UPPERCASE

 +86      ;;S Y=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")

 +87      ;;XY;; Position cursor

 +88      ;;S $X=DX,$Y=DY

 +89      ;;ZD;; External date format in Y

 +90      ;;S Y=$ZD($H,1)