DINZONT.m

DINZONT ;SFISC/AC - SETS UP ^%ZOSF FOR Open M for NT ;2:45 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

 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)

DINZONT   ;SFISC/AC - SETS UP ^%ZOSF FOR Open M for NT ;2:45 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        SET ^%ZOSF("OS")="CACHE/OpenM^18"

 +6        KILL I,X,Z

 +7        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)