- ZOSFONT ;SFISC/AC - SETS UP ^%ZOSF for Cache for NT/VMS ;09/29/09 15:35
- ;;8.0;KERNEL;**34,104,365,661,718**;JUL 10, 1995;Build 5
- ;Per VHA Directive 2004-038, this routine should not be modified.
- ;For Cache versions 2011 and above
- S %Y=1
- INIT ;
- N 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="" S X=$P($T(Z+1+I),";;",2,99) S ^%ZOSF(Z)=$S($D(ZO(Z)):ZO(Z),1:X)
- ;
- G:'$G(%Y) OS
- 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
- 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
- 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
- ;
- OS S $P(^%ZOSF("OS"),"^",1)="OpenM-NT" S:'$P(^%ZOSF("OS"),"^",2) $P(^%ZOSF("OS"),"^",2)=18
- W !!,"ALL SET UP",!!
- Q
- ;
- NOASK ;Setup %ZOSF without terminal interaction
- S %Y=0
- G INIT
- ;
- ONE(X) ;update a single global node
- Q:X=""
- F I=1:2 S Z=$P($T(Z+I),";;",2) Q:Z="" I Z=X S Y=$P($T(Z+1+I),";;",2,99),^%ZOSF(X)=Y Q
- Q
- Z ;;
- ;;ACTJ;;Active Jobs
- ;;S Y=$$ACTJ^%ZOSV()
- ;;AVJ;;Available Jobs
- ;;S Y=$$AVJ^%ZOSV()
- ;;BRK;;Enable Break
- ;;U $I:("":"+B")
- ;;DEL;;Delete Routine
- ;;X "ZR ZS @X"
- ;;EOFF;;Echo off
- ;;U $I:("":"+S")
- ;;EON;;Echo On
- ;;U $I:("":"-S")
- ;;EOT;;End of Tape
- ;;S Y=$ZA\1024#2
- ;;ERRTN;;Error Routine
- ;;^%ZTER
- ;;ETRP;;obsolete
- ;;Q
- ;;GD;;Global Directory
- ;;D ^%GD
- ;;GSEL;;Select Globals
- ;;K ^CacheTempJ($J),^UTILITY($J) D ^%SYS.GSET M ^UTILITY($J)=^CacheTempJ($J) K ^CacheTempJ($J)
- ;;JOBPARAM;;Local Job
- ;;D JOBPAR^%ZOSV
- ;;LABOFF;;Special Lab Echo off
- ;;U IO:("":"+S+I-T":$C(13,27))
- ;;LOAD;;Load Routine
- ;;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)"")=%"
- ;;LPC;;Longitudinal Parity Check
- ;;S Y=$ZC(X)
- ;;MAXSIZ;;Set Partition Size
- ;;S $ZS=X+X
- ;;MGR
- ;;%SYS
- ;;MAGTAPE;;Sets magtape functions into %MT
- ;;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"
- ;;MTBOT;;Begining of Tape
- ;;S Y=$ZA\32#2
- ;;MTONLINE;;Magtape Online
- ;;S Y=$ZA\64#2
- ;;MTWPROT;;Magtape Write Protected
- ;;S Y=$ZA\4#2
- ;;MTERR;;Magtape Error
- ;;S Y=$ZA\32768#2
- ;;NBRK;;No break
- ;;U $I:("":"-B")
- ;;NO-PASSALL;;Set terminal to normal text mode
- ;;U $I:("":"-I+T")
- ;;NO-TYPE-AHEAD;;Turn off Type Ahead
- ;;U $I:("":"+F":$C(13,27))
- ;;PASSALL;;Set terminal to pass all codes
- ;;U $I:("":"+I-T")
- ;;PRIINQ;;Priority in current queue
- ;;N %PRIO D ^%PRIO S Y=$S('%PRIO:5,%PRIO>0:8,1:3)
- ;;PRIORITY;;set priority to X (1=low, 10=high)
- ;;D @($S(X>7:"NORMAL",X>3:"NORMAL",1:"LOW")_"^%PRIO") ;Don't do HIGH
- ;;PROGMODE;;Checks Programmer Mode
- ;;S Y=$ZJOB#2
- ;;PROD
- ;;VAH
- ;;RD;;Routine Directory
- ;;D ^%RD
- ;;RESJOB;;Kill job on local node
- ;;N OLD S OLD=$ZNSPACE ZNSPACE "%SYS" D ^RESJOB ZNSPACE OLD Q
- ;;RM;;Set Right Margin for terminal
- ;;I $G(IOT)["TRM" U $I:X
- ;;RSEL;;Routine Select
- ;;K ^UTILITY($J) D KERNEL^%RSET K %ST ;Special entry point for VA
- ;;RSUM;;Returns Checksum of Routine
- ;;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
- ;;RSUM1;;Returns new Checksum of Routine
- ;;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
- ;;SS;;System Status
- ;;D ^%SS
- ;;SAVE;;Save Routine
- ;;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"
- ;;SIZE;;Routine size in Bytes
- ;;S Y=0 F I=1:1 S %=$T(+I) Q:%="" S Y=Y+$L(%)+2
- ;;TEST;;Routine exist
- ;;I X?1(1"%",1A).15AN,$D(^$ROUTINE(X))
- ;;TMK;;Magtape Mark
- ;;S Y=$ZA\4#2
- ;;TRAP;;Sets Error Trap;S X="^%ET",@^%ZOSF("TRAP"); User $ETRAP
- ;;$ZT=X
- ;;TRMOFF;;Terminators off
- ;;U $I:("":"-I-T":$C(13,27))
- ;;TRMON;;Terminators on
- ;;U $I:("":"+I+T")
- ;;TRMRD;;Read Terminator
- ;;S Y=$A($ZB),Y=$S(Y<32:Y,Y=127:Y,1:0)
- ;;TYPE-AHEAD;;Allows Type-ahead
- ;;U $I:("":"-F":$C(13,27))
- ;;UCI;;Current UCI
- ;;D UCI^%ZOSV
- ;;UCICHECK;;UCI Valid
- ;;S Y=$$UCICHECK^%ZOSV(X)
- ;;UPPERCASE;;Convert Lower case to Upper case
- ;;S Y=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- ;;XY;;Set $X & $Y
- ;;S $X=DX,$Y=DY
- ;;VOL;;VOLUME SET NAME
- ;;ROU
- ;;ZD;;$H to external
- ;;S Y=$ZD(X)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZOSFONT 4731 printed Feb 18, 2025@23:41:51 Page 2
- ZOSFONT ;SFISC/AC - SETS UP ^%ZOSF for Cache for NT/VMS ;09/29/09 15:35
- +1 ;;8.0;KERNEL;**34,104,365,661,718**;JUL 10, 1995;Build 5
- +2 ;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;For Cache versions 2011 and above
- +4 SET %Y=1
- INIT ;
- +1 NEW ZO
- FOR I="MGR","PROD","VOL"
- if $DATA(^%ZOSF(I))
- SET ZO(I)=^%ZOSF(I)
- +2 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)=$SELECT($DATA(ZO(Z)):ZO(Z),1:X)
- +3 ;
- +4 if '$GET(%Y)
- GOTO OS
- MGR WRITE !,"NAME OF MANAGER'S NAMESPACE: "_^%ZOSF("MGR")_"// "
- READ X:$SELECT($GET(DTIME):DTIME,1:9999)
- IF X]""
- XECUTE ^("UCICHECK")
- if 0[Y
- GOTO MGR
- SET ^%ZOSF("MGR")=X
- PROD WRITE !,"PRODUCTION (SIGN-ON) NAMESPACE: "_^%ZOSF("PROD")_"// "
- READ X:$SELECT($GET(DTIME):DTIME,1:9999)
- IF X]""
- XECUTE ^("UCICHECK")
- if 0[Y
- GOTO PROD
- SET ^%ZOSF("PROD")=Y
- VOL WRITE !,"NAME OF THIS CONFIGURATION: "_^%ZOSF("VOL")_"//"
- READ X:$SELECT($GET(DTIME):DTIME,1:9999)
- IF X]""
- if X?1.22U
- SET ^%ZOSF("VOL")=X
- IF X'?1.22U
- WRITE "MUST BE 1-22 uppercase characters."
- GOTO VOL
- +1 ;
- OS SET $PIECE(^%ZOSF("OS"),"^",1)="OpenM-NT"
- if '$PIECE(^%ZOSF("OS"),"^",2)
- SET $PIECE(^%ZOSF("OS"),"^",2)=18
- +1 WRITE !!,"ALL SET UP",!!
- +2 QUIT
- +3 ;
- NOASK ;Setup %ZOSF without terminal interaction
- +1 SET %Y=0
- +2 GOTO INIT
- +3 ;
- ONE(X) ;update a single global node
- +1 if X=""
- QUIT
- +2 FOR I=1:2
- SET Z=$PIECE($TEXT(Z+I),";;",2)
- if Z=""
- QUIT
- IF Z=X
- SET Y=$PIECE($TEXT(Z+1+I),";;",2,99)
- SET ^%ZOSF(X)=Y
- QUIT
- +3 QUIT
- Z ;;
- +1 ;;ACTJ;;Active Jobs
- +2 ;;S Y=$$ACTJ^%ZOSV()
- +3 ;;AVJ;;Available Jobs
- +4 ;;S Y=$$AVJ^%ZOSV()
- +5 ;;BRK;;Enable Break
- +6 ;;U $I:("":"+B")
- +7 ;;DEL;;Delete Routine
- +8 ;;X "ZR ZS @X"
- +9 ;;EOFF;;Echo off
- +10 ;;U $I:("":"+S")
- +11 ;;EON;;Echo On
- +12 ;;U $I:("":"-S")
- +13 ;;EOT;;End of Tape
- +14 ;;S Y=$ZA\1024#2
- +15 ;;ERRTN;;Error Routine
- +16 ;;^%ZTER
- +17 ;;ETRP;;obsolete
- +18 ;;Q
- +19 ;;GD;;Global Directory
- +20 ;;D ^%GD
- +21 ;;GSEL;;Select Globals
- +22 ;;K ^CacheTempJ($J),^UTILITY($J) D ^%SYS.GSET M ^UTILITY($J)=^CacheTempJ($J) K ^CacheTempJ($J)
- +23 ;;JOBPARAM;;Local Job
- +24 ;;D JOBPAR^%ZOSV
- +25 ;;LABOFF;;Special Lab Echo off
- +26 ;;U IO:("":"+S+I-T":$C(13,27))
- +27 ;;LOAD;;Load Routine
- +28 ;;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)"")=%"
- +29 ;;LPC;;Longitudinal Parity Check
- +30 ;;S Y=$ZC(X)
- +31 ;;MAXSIZ;;Set Partition Size
- +32 ;;S $ZS=X+X
- +33 ;;MGR
- +34 ;;%SYS
- +35 ;;MAGTAPE;;Sets magtape functions into %MT
- +36 ;;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"
- +37 ;;MTBOT;;Begining of Tape
- +38 ;;S Y=$ZA\32#2
- +39 ;;MTONLINE;;Magtape Online
- +40 ;;S Y=$ZA\64#2
- +41 ;;MTWPROT;;Magtape Write Protected
- +42 ;;S Y=$ZA\4#2
- +43 ;;MTERR;;Magtape Error
- +44 ;;S Y=$ZA\32768#2
- +45 ;;NBRK;;No break
- +46 ;;U $I:("":"-B")
- +47 ;;NO-PASSALL;;Set terminal to normal text mode
- +48 ;;U $I:("":"-I+T")
- +49 ;;NO-TYPE-AHEAD;;Turn off Type Ahead
- +50 ;;U $I:("":"+F":$C(13,27))
- +51 ;;PASSALL;;Set terminal to pass all codes
- +52 ;;U $I:("":"+I-T")
- +53 ;;PRIINQ;;Priority in current queue
- +54 ;;N %PRIO D ^%PRIO S Y=$S('%PRIO:5,%PRIO>0:8,1:3)
- +55 ;;PRIORITY;;set priority to X (1=low, 10=high)
- +56 ;;D @($S(X>7:"NORMAL",X>3:"NORMAL",1:"LOW")_"^%PRIO") ;Don't do HIGH
- +57 ;;PROGMODE;;Checks Programmer Mode
- +58 ;;S Y=$ZJOB#2
- +59 ;;PROD
- +60 ;;VAH
- +61 ;;RD;;Routine Directory
- +62 ;;D ^%RD
- +63 ;;RESJOB;;Kill job on local node
- +64 ;;N OLD S OLD=$ZNSPACE ZNSPACE "%SYS" D ^RESJOB ZNSPACE OLD Q
- +65 ;;RM;;Set Right Margin for terminal
- +66 ;;I $G(IOT)["TRM" U $I:X
- +67 ;;RSEL;;Routine Select
- +68 ;;K ^UTILITY($J) D KERNEL^%RSET K %ST ;Special entry point for VA
- +69 ;;RSUM;;Returns Checksum of Routine
- +70 ;;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
- +71 ;;RSUM1;;Returns new Checksum of Routine
- +72 ;;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
- +73 ;;SS;;System Status
- +74 ;;D ^%SS
- +75 ;;SAVE;;Save Routine
- +76 ;;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"
- +77 ;;SIZE;;Routine size in Bytes
- +78 ;;S Y=0 F I=1:1 S %=$T(+I) Q:%="" S Y=Y+$L(%)+2
- +79 ;;TEST;;Routine exist
- +80 ;;I X?1(1"%",1A).15AN,$D(^$ROUTINE(X))
- +81 ;;TMK;;Magtape Mark
- +82 ;;S Y=$ZA\4#2
- +83 ;;TRAP;;Sets Error Trap;S X="^%ET",@^%ZOSF("TRAP"); User $ETRAP
- +84 ;;$ZT=X
- +85 ;;TRMOFF;;Terminators off
- +86 ;;U $I:("":"-I-T":$C(13,27))
- +87 ;;TRMON;;Terminators on
- +88 ;;U $I:("":"+I+T")
- +89 ;;TRMRD;;Read Terminator
- +90 ;;S Y=$A($ZB),Y=$S(Y<32:Y,Y=127:Y,1:0)
- +91 ;;TYPE-AHEAD;;Allows Type-ahead
- +92 ;;U $I:("":"-F":$C(13,27))
- +93 ;;UCI;;Current UCI
- +94 ;;D UCI^%ZOSV
- +95 ;;UCICHECK;;UCI Valid
- +96 ;;S Y=$$UCICHECK^%ZOSV(X)
- +97 ;;UPPERCASE;;Convert Lower case to Upper case
- +98 ;;S Y=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- +99 ;;XY;;Set $X & $Y
- +100 ;;S $X=DX,$Y=DY
- +101 ;;VOL;;VOLUME SET NAME
- +102 ;;ROU
- +103 ;;ZD;;$H to external
- +104 ;;S Y=$ZD(X)