Changeset 623 for WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/ZOSFONT.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/ZOSFONT.m
r613 r623 1 ZOSFONT ;SFISC/AC - SETS UP ^%ZOSF for Cache for NT/VMS ;10/19/06 14:01 2 ;;8.0;KERNEL;**34,104,365**;JUL 10, 1995;Build 5 3 ;For Cache versions 3.2, 4 and 5 4 S %Y=1 K ^%ZOSF("MASTER"),^%ZOSF("SIGNOFF") 5 N ZO F I="MGR","PROD","VOL" S:$D(^%ZOSF(I)) ZO(I)=^%ZOSF(I) 6 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)=$S($D(ZO(Z)):ZO(Z),1:X) 7 ; 8 MGR W !,"NAME OF MANAGER'S NAMESPACE: "_^%ZOSF("MGR")_"// " R X:$S($G(DTIME):DTIME,1:9999) I X]"" X ^("UCICHECK") G MGR:0[Y S ^%ZOSF("MGR")=X 9 PROD W !,"PRODUCTION (SIGN-ON) NAMESPACE: "_^%ZOSF("PROD")_"// " R X:$S($G(DTIME):DTIME,1:9999) I X]"" X ^("UCICHECK") G PROD:0[Y S ^%ZOSF("PROD")=Y 10 VOL W !,"NAME OF THIS CONFIGURATION: "_^%ZOSF("VOL")_"//" R X:$S($G(DTIME):DTIME,1:9999) I X]"" S:X?1.22U ^%ZOSF("VOL")=X I X'?1.22U W "MUST BE 1-22 uppercase characters." G VOL 11 ; 12 OS S $P(^%ZOSF("OS"),"^",1)="OpenM-NT" S:'$P(^%ZOSF("OS"),"^",2) $P(^%ZOSF("OS"),"^",2)=18 13 ;For Cache 5.1 and above 14 I $$VERSION^ZOSVONT>5 S ^%ZOSF("GSEL")="K ^CacheTempJ($J),^UTILITY($J) D ^%SYS.GSET M ^UTILITY($J)=CacheTempJ($J)" 15 W !!,"ALL SET UP",!! Q 16 Z ;; 17 ;;ACTJ 18 ;;S Y=$$ACTJ^%ZOSV() 19 ;;AVJ 20 ;;S Y=$$AVJ^%ZOSV() 21 ;;BRK 22 ;;U $I:("":"+B") 23 ;;DEL 24 ;;X "ZR ZS @X" 25 ;;EOFF 26 ;;U $I:("":"+S") 27 ;;EON 28 ;;U $I:("":"-S") 29 ;;EOT 30 ;;S Y=$ZA\1024#2 31 ;;ERRTN 32 ;;^%ZTER 33 ;;ETRP 34 ;;Q 35 ;;GD 36 ;;D ^%GD 37 ;;GSEL;Select Globals 38 ;;K ^UTILITY($J) D ^%GSET 39 ;;JOBPARAM 40 ;;D JOBPAR^%ZOSV 41 ;;LABOFF 42 ;;U IO:("":"+S+I-T":$C(13,27)) 43 ;;LOAD 44 ;;N %,%N S %N=0 X "ZL @X F XCNP=XCNP+1:1 S %N=%N+1,%=$T(+%N) Q:$L(%)=0 S @(DIF_XCNP_"",0)"")=%" 45 ;;LPC 46 ;;S Y=$ZC(X) 47 ;;MAXSIZ 48 ;;S $ZS=X+X 49 ;;MGR 50 ;;%SYS 51 ;;MAGTAPE 52 ;;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" 53 ;;MTBOT 54 ;;S Y=$ZA\32#2 55 ;;MTONLINE 56 ;;S Y=$ZA\64#2 57 ;;MTWPROT 58 ;;S Y=$ZA\4#2 59 ;;MTERR;;MAGTAPE ERROR 60 ;;S Y=$ZA\32768#2 61 ;;NBRK 62 ;;U $I:("":"-B") 63 ;;NO-PASSALL 64 ;;U $I:("":"-I+T") 65 ;;NO-TYPE-AHEAD 66 ;;U $I:("":"+F":$C(13,27)) 67 ;;PASSALL 68 ;;U $I:("":"+I-T") 69 ;;PRIINQ;; Priority in current queue 70 ;;N %PRIO D ^%PRIO S Y=$S('%PRIO:5,%PRIO>0:8,1:3) 71 ;;PRIORITY;;set priority to X (1=low, 10=high) 72 ;;D @($S(X>7:"NORMAL",X>3:"NORMAL",1:"LOW")_"^%PRIO") ;Don't do HIGH 73 ;;PROGMODE 74 ;;S Y=$ZJOB#2 75 ;;PROD 76 ;;VAH 77 ;;RD 78 ;;D ^%RD 79 ;;RESJOB 80 ;;N OLD S OLD=$ZNSPACE ZNSPACE "%SYS" D ^RESJOB ZNSPACE OLD Q 81 ;;RM 82 ;;I $G(IOT)["TRM" U $I:X 83 ;;RSEL;;ROUTINE SELECT 84 ;;K ^UTILITY($J) D KERNEL^%RSET K %ST ;Special entry point for VA 85 ;;RSUM 86 ;;N %,%1,%3 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 87 ;;RSUM1 88 ;;N %,%1,%3 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 89 ;;SS 90 ;;D ^%SS 91 ;;SAVE 92 ;;N XCS S XCS="F XCM=1:1 S XCN=$O(@(DIE_XCN_"")"")) Q:+XCN'=XCN S %=^(XCN,0) Q:$E(%,1)=""$"" I $E(%,1)'="";"" ZI %" X "ZR X XCS ZS @X" 93 ;;SIZE 94 ;;S Y=0 F I=1:1 S %=$T(+I) Q:%="" S Y=Y+$L(%)+2 95 ;;TEST 96 ;;I X?1(1"%",1A).7AN,$D(^$ROUTINE(X)) 97 ;;TMK;;MAGTAPE MARK 98 ;;S Y=$ZA\4#2 99 ;;TRAP;;S X="^%ET",@^%ZOSF("TRAP"); User $ETRAP 100 ;;$ZT=X 101 ;;TRMOFF 102 ;;U $I:("":"-I-T":$C(13,27)) 103 ;;TRMON 104 ;;U $I:("":"+I+T") 105 ;;TRMRD;;old Y=$A($ZB),Y=$S(Y<32:Y,Y=127:Y,1:0) 106 ;;S Y=$A($ZB),Y=$S(Y<32:Y,Y=127:Y,1:0) 107 ;;TYPE-AHEAD 108 ;;U $I:("":"-F":$C(13,27)) 109 ;;UCI 110 ;;D UCI^%ZOSV 111 ;;UCICHECK 112 ;;S Y=$$UCICHECK^%ZOSV(X) 113 ;;UPPERCASE 114 ;;S Y=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") 115 ;;XY 116 ;;S $X=DX,$Y=DY 117 ;;VOL;;VOLUME SET NAME 118 ;;ROU 119 ;;ZD;;$H to external 120 ;;S Y=$ZD(X) 1 ZOSFONT ;SFISC/AC - SETS UP ^%ZOSF FOR Open M for NT ;09/29/98 08:26 2 ;;8.0;KERNEL;**34,104**;JUL 03, 1995 3 S %Y=1 K ^%ZOSF("MASTER"),^%ZOSF("SIGNOFF") 4 K ZO F I="MGR","PROD","VOL" S:$D(^%ZOSF(I)) ZO(I)=^%ZOSF(I) 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)=$S($D(ZO(Z)):ZO(Z),1:X) 6 MGR W !,"NAME OF MANAGER'S NAMESPACE: "_^%ZOSF("MGR")_"// " R X:$S($G(DTIME):DTIME,1:9999) I X]"" X ^("UCICHECK") G MGR:Y="" S ^%ZOSF("MGR")=X 7 PROD W !,"PRODUCTION (SIGN-ON) NAMESPACE: "_^%ZOSF("PROD")_"// " R X:$S($G(DTIME):DTIME,1:9999) I X]"" X ^("UCICHECK") G PROD:Y="" S ^%ZOSF("PROD")=Y 8 VOL W !,"NAME OF THIS CONFIGURATION: "_^%ZOSF("VOL")_"//" R X:$S($G(DTIME):DTIME,1:9999) I X]"" S:X?1.5U ^%ZOSF("VOL")=X I X'?1.5U W "MUST BE 1-5 uppercase characters." G VOL 9 OS S $P(^%ZOSF("OS"),"^",1)="OpenM-NT" S:'$P(^%ZOSF("OS"),"^",2) $P(^%ZOSF("OS"),"^",2)=18 10 W !!,"ALL SET UP",!! Q 11 Z ;; 12 ;;ACTJ 13 ;;S Y=$$ACTJ^%ZOSV() 14 ;;AVJ 15 ;;S Y=$$AVJ^%ZOSV() 16 ;;BRK 17 ;;U $I:("":"+B") 18 ;;DEL 19 ;;X "ZR ZS @X" K ^UTILITY("ROU",X) 20 ;;EOFF 21 ;;U $I:("":"+S") 22 ;;EON 23 ;;U $I:("":"-S") 24 ;;EOT 25 ;;S Y=$ZA\1024#2 26 ;;ERRTN 27 ;;^%ZTER 28 ;;ETRP 29 ;;Q 30 ;;GD 31 ;;D ^%GD 32 ;;JOBPARAM 33 ;;D JOBPAR^%ZOSV 34 ;;LABOFF 35 ;;U IO:("":"+S+I-T":$C(13,27)) 36 ;;LOAD 37 ;;S %N=0 X "ZL @X F XCNP=XCNP+1:1 S %N=%N+1,%=$T(+%N) Q:$L(%)=0 S @(DIF_XCNP_"",0)"")=%" 38 ;;LPC 39 ;;S Y=$ZC(X) 40 ;;MAXSIZ 41 ;;S $ZS=X+X 42 ;;MGR 43 ;;%SYS 44 ;;MAGTAPE 45 ;;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" 46 ;;MTBOT 47 ;;S Y=$ZA\32#2 48 ;;MTONLINE 49 ;;S Y=$ZA\64#2 50 ;;MTWPROT 51 ;;S Y=$ZA\4#2 52 ;;MTERR;;MAGTAPE ERROR 53 ;;S Y=$ZA\32768#2 54 ;;NBRK 55 ;;U $I:("":"-B") 56 ;;NO-PASSALL 57 ;;U $I:("":"-I+T") 58 ;;NO-TYPE-AHEAD 59 ;;U $I:("":"+F":$C(13,27)) 60 ;;PASSALL 61 ;;U $I:("":"+I-T") 62 ;;PRIINQ;; Priority in current queue 63 ;;N %PRIO D ^%PRIO S Y=$S('%PRIO:5,%PRIO>0:8,1:3) 64 ;;PRIORITY;;set priority to X (1=low, 10=high) 65 ;;D @($S(X>7:"NORMAL",X>3:"NORMAL",1:"LOW")_"^%PRIO") ;Don't do HIGH 66 ;;PROGMODE 67 ;;S Y=$ZJ#2 68 ;;PROD 69 ;;VAH 70 ;;RD 71 ;;D ^%RD 72 ;;RESJOB 73 ;;Q:'$D(DUZ) Q:'$D(^XUSEC("XUMGR",+DUZ)) N XQZ S XQZ="^RESJOB[MGR]" D DO^%XUCI 74 ;;RM 75 ;;U $I:X 76 ;;RSEL;;ROUTINE SELECT 77 ;;K ^UTILITY($J) D KERNEL^%RSET K %ST ;Special entry point for VA 78 ;;RSUM 79 ;;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 80 ;;SS 81 ;;D ^%SS 82 ;;SAVE 83 ;;S XCS="F XCM=1:1 S XCN=$O(@(DIE_XCN_"")"")) Q:+XCN'=XCN S %=^(XCN,0) Q:$E(%,1)=""$"" I $E(%,1)'="";"" ZI %" X "ZR X XCS ZS @X" S ^UTILITY("ROU",X)="" K XCS 84 ;;SIZE 85 ;;S Y=0 F I=1:1 S %=$T(+I) Q:%="" S Y=Y+$L(%)+2 86 ;;TEST 87 ;;I X?1(1"%",1A).7AN,$D(^$ROUTINE(X)) 88 ;;TMK;;MAGTAPE MARK 89 ;;S Y=$ZA\4#2 90 ;;TRAP;;S X="^%ET",@^%ZOSF("TRAP") TO SET ERROR TRAP 91 ;;$ZT=X 92 ;;TRMOFF 93 ;;U $I:("":"-I-T":$C(13,27)) 94 ;;TRMON 95 ;;U $I:("":"+I+T") 96 ;;TRMRD 97 ;;S Y=$A($ZB),Y=$S(Y<32:Y,Y=127:Y,1:0) 98 ;;TYPE-AHEAD 99 ;;U $I:("":"-F":$C(13,27)) 100 ;;UCI 101 ;;D UCI^%ZOSV 102 ;;UCICHECK 103 ;;S Y=$$UCICHECK^%ZOSV(X) 104 ;;UPPERCASE 105 ;;S Y=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ") 106 ;;XY 107 ;;S $X=DX,$Y=DY 108 ;;VOL;;VOLUME SET NAME 109 ;;ROU 110 ;;ZD 111 ;;S Y=$ZD(X)
Note:
See TracChangeset
for help on using the changeset viewer.
