File:  [Coherent Logic Development] / freem_fileman / USER / DINZDTM.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:21 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    1: DINZDTM	;SFISC/HGL,AL-SETS %ZOSF FOR DATATREE ;03:23 PM  21 Dec 1994
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	K ^%ZOSF("MASTER"),^%ZOSF("SIGNOFF")
    5: 	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
    6: 	K I,X,Z
    7: 	Q
    8: V3	;
    9: 	S ^%ZOSF("TRAP")="$ZE=X"
   10: 	S ^%ZOSF("PROGMODE")="S Y=0"
   11: 	Q
   12: Z	;;
   13: 	;;OS;; Operating System Name
   14: 	;;DTM-PC^9
   15: 	;;ACTJ;; Active Jobs
   16: 	;;S Y=$$ACTJ^%ZOSV
   17: 	;;AVJ;; Available Jobs
   18: 	;;S Y=$$AVJ^%ZOSV
   19: 	;;MAXJ;; Maximum # of Jobs
   20: 	;;G MAXJ^%ZOSV
   21: 	;;BRK;; Enable Break
   22: 	;;B 1
   23: 	;;DEL;; Delete Routine in X
   24: 	;;zdelete @X:1
   25: 	;;EOFF;; Turn echo off
   26: 	;;U $I:(echom=0)
   27: 	;;EON;; Turn echo on
   28: 	;;U $I:(echom=1)
   29: 	;;EOT;; End of tape
   30: 	;;S Y=($ZIOS=3)
   31: 	;;ERRTN;; Error trap routine
   32: 	;;^%ZTER
   33: 	;;ETRP;; Set error trap to X
   34: 	;;Q
   35: 	;;GD;; Global Directory
   36: 	;;G ^%gd
   37: 	;;JOBPARAM
   38: 	;;G JOBPAR^%ZOSV
   39: 	;;LABOFF
   40: 	;;U IO:(echom=0)
   41: 	;;LOAD
   42: 	;;S %N=0 X "ZL @X F XCNP=XCNP+1:1 S %N=%N+1,%=$T(+%N) Q:$L(%)=0  S @(DIF_XCNP_"",0)"")=%"
   43: 	;;LPC;;
   44: 	;;S Y=$ZCRC(X,1)
   45: 	;;MAXSIZ;; Reset partition size
   46: 	;;Q
   47: 	;;NBRK;; Disable Break
   48: 	;;B 0
   49: 	;;NO-PASSALL
   50: 	;;G NOPASS^%ZOSV
   51: 	;;NO-TYPE-AHEAD;; Turn off type-ahead
   52: 	;;U $I:(ta=0)
   53: 	;;PARSIZ
   54: 	;;S X=3
   55: 	;;PASSALL
   56: 	;;G PASSALL^%ZOSV
   57: 	;;PRIINQ;; Find job's priority
   58: 	;;S Y=$$PRIINQ^%ZOSV()
   59: 	;;PRIORITY;; Set a job's priority
   60: 	;;G PRIORITY^%ZOSV
   61: 	;;PROGMODE;; Check if user is in programmer mode
   62: 	;;S Y=$ZMODE
   63: 	;;RD;; Routine Directory
   64: 	;;G ^%rd
   65: 	;;RESJOB
   66: 	;;Q:'$D(DUZ)  Q:'$D(^XUSEC("XUMGR",+DUZ))  N XQZ S XQZ="^%mjob[MGR]" D DO^%XUCI
   67: 	;;RM;; Set right margin to X ;***EDITED BY AC/SFISC***
   68: 	;;U $I:(lmar=0:width=$S(X:X,1:$zdevfwid):wrap=(X&($I>99)))
   69: 	;;RSEL;; Routine Select - returns number of routines in NRO
   70: 	;;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
   71: 	;;RSUM
   72: 	;;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
   73: 	;;SAVE
   74: 	;;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
   75: 	;;SIZE;; Return size of routine in partition
   76: 	;;S Y=$L($zrsource($zn))
   77: 	;;SS;; System Status
   78: 	;;G ^%mjob
   79: 	;;TEST;; Routine existence test
   80: 	;;I $ZRSTATUS(X)'=""
   81: 	;;TMK;; Tapemark
   82: 	;;Q
   83: 	;;TRMOFF
   84: 	;;G:$P($ZVER,"/",2)<4.3 TRMOFF^%ZOSV U $I:TERM=$C(13,27)
   85: 	;;TRMON
   86: 	;;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)
   87: 	;;TRMRD
   88: 	;;S Y=$S('$ZIOS:$ZIOT,1:0)
   89: 	;;TRAP;; DTM V4 only.  zetrap works for both versions
   90: 	;;$ZT=X
   91: 	;;TYPE-AHEAD;; Turn on type-ahead
   92: 	;;U $I:(ta=1)
   93: 	;;UCI;; Return current namespace in Y
   94: 	;;S Y=$ZNSPACE
   95: 	;;UCICHECK;;
   96: 	;;S Y=$$UCICHECK^%ZOSV(X)
   97: 	;;UPPERCASE
   98: 	;;S Y=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
   99: 	;;XY;; Position cursor
  100: 	;;S $X=DX,$Y=DY
  101: 	;;ZD;; External date format in Y
  102: 	;;S Y=$ZD($H,1)

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>