DINZONT ;SFISC/AC - SETS UP ^%ZOSF FOR Open M for NT ;2:45 PM 1 Oct 1998
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
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
S ^%ZOSF("OS")="CACHE/OpenM^18"
K I,X,Z
Q
Z ;;
;;ACTJ
;;S Y=$$ACTJ^%ZOSV()
;;AVJ
;;S Y=$$AVJ^%ZOSV()
;;BRK
;;U $I:("":"+B")
;;DEL
;;X "ZR ZS @X" K ^UTILITY("ROU",X)
;;EOFF
;;U $I:("":"+S")
;;EON
;;U $I:("":"-S")
;;EOT
;;S Y=$ZA\1024#2
;;ERRTN
;;^%ZTER
;;ETRP
;;Q
;;GD
;;D ^%GD
;;JOBPARAM
;;D JOBPAR^%ZOSV
;;LABOFF
;;U IO:("":"+S+I-T":$C(13,27))
;;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=$ZC(X)
;;MAXSIZ
;;S $ZS=X+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"
;;MTBOT
;;S Y=$ZA\32#2
;;MTONLINE
;;S Y=$ZA\64#2
;;MTWPROT
;;S Y=$ZA\4#2
;;MTERR;;MAGTAPE ERROR
;;S Y=$ZA\32768#2
;;NBRK
;;U $I:("":"-B")
;;NO-PASSALL
;;U $I:("":"-I+T")
;;NO-TYPE-AHEAD
;;U $I:("":"+F":$C(13,27))
;;PASSALL
;;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
;;S Y=$ZJ#2
;;RD
;;D ^%RD
;;RESJOB
;;Q:'$D(DUZ) Q:'$D(^XUSEC("XUMGR",+DUZ)) N XQZ S XQZ="^RESJOB[MGR]" D DO^%XUCI
;;RM
;;U $I:X
;;RSEL;;ROUTINE SELECT
;;K ^UTILITY($J) D KERNEL^%RSET K %ST ;Special entry point for VA
;;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
;;SS
;;D ^%SS
;;SAVE
;;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
;;SIZE
;;S Y=0 F I=1:1 S %=$T(+I) Q:%="" S Y=Y+$L(%)+2
;;TEST
;;I X?1(1"%",1A).7AN,$D(^$ROUTINE(X))
;;TMK;;MAGTAPE MARK
;;S Y=$ZA\4#2
;;TRAP;;S X="^%ET",@^%ZOSF("TRAP") TO SET ERROR TRAP
;;$ZT=X
;;TRMOFF
;;U $I:("":"-I-T":$C(13,27))
;;TRMON
;;U $I:("":"+I+T")
;;TRMRD
;;S Y=$A($ZB),Y=$S(Y<32:Y,Y=127:Y,1:0)
;;TYPE-AHEAD
;;U $I:("":"-F":$C(13,27))
;;UCI
;;D UCI^%ZOSV
;;UCICHECK
;;S Y=$$UCICHECK^%ZOSV(X)
;;UPPERCASE
;;S Y=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
;;XY
;;S $X=DX,$Y=DY
;;ZD
;;S Y=$ZD(X)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDINZONT 2888 printed Dec 13, 2024@02:52:22 Page 2
DINZONT ;SFISC/AC - SETS UP ^%ZOSF FOR Open M for NT ;2:45 PM 1 Oct 1998
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
+7 KILL ^%ZOSF("MASTER"),^%ZOSF("SIGNOFF")
+8 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
+9 SET ^%ZOSF("OS")="CACHE/OpenM^18"
+10 KILL I,X,Z
+11 QUIT
Z ;;
+1 ;;ACTJ
+2 ;;S Y=$$ACTJ^%ZOSV()
+3 ;;AVJ
+4 ;;S Y=$$AVJ^%ZOSV()
+5 ;;BRK
+6 ;;U $I:("":"+B")
+7 ;;DEL
+8 ;;X "ZR ZS @X" K ^UTILITY("ROU",X)
+9 ;;EOFF
+10 ;;U $I:("":"+S")
+11 ;;EON
+12 ;;U $I:("":"-S")
+13 ;;EOT
+14 ;;S Y=$ZA\1024#2
+15 ;;ERRTN
+16 ;;^%ZTER
+17 ;;ETRP
+18 ;;Q
+19 ;;GD
+20 ;;D ^%GD
+21 ;;JOBPARAM
+22 ;;D JOBPAR^%ZOSV
+23 ;;LABOFF
+24 ;;U IO:("":"+S+I-T":$C(13,27))
+25 ;;LOAD
+26 ;;S %N=0 X "ZL @X F XCNP=XCNP+1:1 S %N=%N+1,%=$T(+%N) Q:$L(%)=0 S @(DIF_XCNP_"",0)"")=%"
+27 ;;LPC
+28 ;;S Y=$ZC(X)
+29 ;;MAXSIZ
+30 ;;S $ZS=X+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 ;;MTBOT
+34 ;;S Y=$ZA\32#2
+35 ;;MTONLINE
+36 ;;S Y=$ZA\64#2
+37 ;;MTWPROT
+38 ;;S Y=$ZA\4#2
+39 ;;MTERR;;MAGTAPE ERROR
+40 ;;S Y=$ZA\32768#2
+41 ;;NBRK
+42 ;;U $I:("":"-B")
+43 ;;NO-PASSALL
+44 ;;U $I:("":"-I+T")
+45 ;;NO-TYPE-AHEAD
+46 ;;U $I:("":"+F":$C(13,27))
+47 ;;PASSALL
+48 ;;U $I:("":"+I-T")
+49 ;;PRIINQ;; Priority in current queue
+50 ;;N %PRIO D ^%PRIO S Y=$S('%PRIO:5,%PRIO>0:8,1:3)
+51 ;;PRIORITY;;set priority to X (1=low, 10=high)
+52 ;;D @($S(X>7:"NORMAL",X>3:"NORMAL",1:"LOW")_"^%PRIO") ;Don't do HIGH
+53 ;;PROGMODE
+54 ;;S Y=$ZJ#2
+55 ;;RD
+56 ;;D ^%RD
+57 ;;RESJOB
+58 ;;Q:'$D(DUZ) Q:'$D(^XUSEC("XUMGR",+DUZ)) N XQZ S XQZ="^RESJOB[MGR]" D DO^%XUCI
+59 ;;RM
+60 ;;U $I:X
+61 ;;RSEL;;ROUTINE SELECT
+62 ;;K ^UTILITY($J) D KERNEL^%RSET K %ST ;Special entry point for VA
+63 ;;RSUM
+64 ;;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
+65 ;;SS
+66 ;;D ^%SS
+67 ;;SAVE
+68 ;;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
+69 ;;SIZE
+70 ;;S Y=0 F I=1:1 S %=$T(+I) Q:%="" S Y=Y+$L(%)+2
+71 ;;TEST
+72 ;;I X?1(1"%",1A).7AN,$D(^$ROUTINE(X))
+73 ;;TMK;;MAGTAPE MARK
+74 ;;S Y=$ZA\4#2
+75 ;;TRAP;;S X="^%ET",@^%ZOSF("TRAP") TO SET ERROR TRAP
+76 ;;$ZT=X
+77 ;;TRMOFF
+78 ;;U $I:("":"-I-T":$C(13,27))
+79 ;;TRMON
+80 ;;U $I:("":"+I+T")
+81 ;;TRMRD
+82 ;;S Y=$A($ZB),Y=$S(Y<32:Y,Y=127:Y,1:0)
+83 ;;TYPE-AHEAD
+84 ;;U $I:("":"-F":$C(13,27))
+85 ;;UCI
+86 ;;D UCI^%ZOSV
+87 ;;UCICHECK
+88 ;;S Y=$$UCICHECK^%ZOSV(X)
+89 ;;UPPERCASE
+90 ;;S Y=$TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+91 ;;XY
+92 ;;S $X=DX,$Y=DY
+93 ;;ZD
+94 ;;S Y=$ZD(X)
