Annotation of freem_fileman/DINVMSM.m, revision 1.1
1.1 ! snw 1: %ZOSV ;SFISC/AC-$View commands for MSM-UNIX ;03:16 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: ;
! 5: ACTJ() ;
! 6: Q $S($$V3:$V($V(44)+168,-3,2),1:$V(168,-4,2))
! 7: AVJ() ;
! 8: Q $S($$V3:$V($V(44)+94,-3,2)+1-$V($V(44)+168,-3,2),1:$V($V(3,-5),-3,0)-$V(168,-4,2))
! 9: T0 ; start RT clock
! 10: S XRT0=$H Q
! 11: T1 ; store RT datum
! 12: S ^%ZRTL(3,XRTL,+$H,XRTN,$P($H,",",2))=XRT0 K XRT0 Q
! 13: JOBPAR ;
! 14: S Y=$V(2,X,2) Q:'Y
! 15: S Y=$ZU(Y#32,Y\32) Q
! 16: PROGMODE() ;
! 17: Q $V(0,$J,2)#2
! 18: PRGMODE ;
! 19: W ! S ZTPAC=$S('$D(^VA(200,+DUZ,.1)):"",1:$P(^(.1),U,5)),XUVOL=^%ZOSF("VOL")
! 20: ;I ZTPAC="" W *7,"YOU HAVE NO PROGRAMMER ACCESS CODE!",! Q
! 21: I ZTPAC]"" X ^%ZOSF("EOFF") R !,"PAC: ",X:60 X ^%ZOSF("EON") I X'=ZTPAC W "??",*7 Q
! 22: S XMB="XUPROGMODE",XMB(1)=DUZ,XMB(2)=$I D ^XMB:$D(^XMB(3.7,0)) K ^XMB(3.7,+DUZ,100,$I),^XUSEC(0,"CUR",DUZ,+^XUTL("XQ",$J,0)),ZTPAC,X,XMB
! 23: S ZOSVER='$ZB($V(140,$J,2),512,1) ; 1 if V 2.1+ err trapping in effect
! 24: X ^%ZOSF("UCI") S XUCI=Y,XQZ="PRGM^ZUA[MGR]",XUSLNT=1 D DO^%XUCI B:ZOSVER 2 V 0:$J:$ZB($V(0,$J,2),1,7):2 S $ZE="PRGMODEX^%ZOSV" ABORT
! 25: PRGMODEX W !,"YOU ARE NOW IN PROGRAMMING MODE!",! S $ZE="" B:ZOSVER -2 K ZOSVER Q
! 26: ;
! 27: SIGNOFF ;
! 28: I 0
! 29: ;I $V($V(44)+4,-3,2)\32768#2 Q
! 30: UCI ;
! 31: S Y=$ZU(0) Q ;X ^%ZOSF("UCI") Q
! 32: ;
! 33: UCICHECK(X) ;
! 34: N Y,I S Y="",$ZT="BADUCI^%ZOSV"
! 35: I X["," S Y=$ZU($P(X,","),$P(X,",",2)),(X,Y)=$ZU($P(Y,","),$P(Y,",",2)) Q:Y]"" Y
! 36: F I=1:1:64 G:$ZU(I)="" BADUCI Q:$ZU(I)=X!($P($ZU(I),",")=X)!(I=X)
! 37: Q $ZU(I)
! 38: ;
! 39: BADUCI Q ""
! 40: ;
! 41: BAUD ;S Y=^%ZOSF("MGR"),X=$S($D(^%ZIS(1,D0,0)):$P(^(0),"^",2),1:"")
! 42: ;Q:X="" I '$D(^[Y]SYS(0,"DDB",+X)) S X="" Q
! 43: ;S X=$P(^(+X),",",3)#100 Q:'X
! 44: ;S X=$P("50,75,110,134.5,150,300,600,1200,1800,2400,3600,4800,9600",",",X) Q
! 45: Q
! 46: ;
! 47: LGR() Q $ZR ;Last global ref.
! 48: ;
! 49: EC() Q $ZE ;Error code
! 50: ;
! 51: DOLRO ;SAVE ENTIRE SYMBOL TABLE IN LOCATION SPECIFIED BY X
! 52: S Y="%" F %=0:0 S Y=$O(@Y) Q:Y="" S %=$D(@Y) S:%#2 @(X_"Y)="_Y) I %>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR
! 53: Q
! 54: ;
! 55: ORDER ;SAVE PART OF SYMBOL TABLE IN LOCATION SPECIFIED BY X
! 56: S (Y,Y1)=$P(Y,"*",1) I $D(@Y)=0 F %=0:0 S Y=$O(@Y) Q:Y=""!(Y[Y1)
! 57: Q:Y="" S %=$D(@Y) S:%#2 @(X_"Y)="_Y) I %>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR
! 58: F %=0:0 S Y=$O(@Y) Q:Y=""!(Y'[Y1) S %=$D(@Y) S:%#2 @(X_"Y)="_Y) I %>9 S %X=Y_"(",%Y=X_"Y," D %XY^%RCR
! 59: K %,X,Y,Y1 Q
! 60: ;
! 61: PRIORITY ;
! 62: N %D,%P S %P=(X>5) D INT^%HL Q
! 63: ;
! 64: PRIINQ() ;
! 65: Q $S($V(20,$J,2):10,1:1)
! 66: PARSIZ ;
! 67: S X=3 Q
! 68: ;
! 69: NOLOG ;
! 70: S Y=$S($$V3:"$V($V(44)+4,-3,2)",1:"$V(4,-4,2)")_"\64#2" Q
! 71: ;
! 72: DEVOPN ;
! 73: ;X=$J,Y=List of devices separated by a comma
! 74: N %,%1,%I,%X
! 75: S Y=""
! 76: I $$V3 S %=$V($V(44)+10,-3,2),%1=$V($V(44)+8,-3,2)+$V(44),%=$V(%*5+%1)
! 77: E S %=$V(5,-5,0)
! 78: F %I=1:1:255 S %X=$V(%+%I+%I,-3,2) I %X,%X#4=0,%X/4=X S Y=Y_%I_","
! 79: Q
! 80: DEVOK ;
! 81: ;X=Device $I, Y=0 if available, Y=Job # if owned,
! 82: ;Y=-1 if device is undefined.
! 83: G RES:$G(X1)="RES" I $E(X)="/"!($E(X)="\") S Y=0 Q
! 84: I X=2 S Y=0 Q
! 85: I X'?1.N!(X'>0!(X'<1024)) S Y=-1 Q
! 86: N %
! 87: I $$V3 S %=$V($V(44)+8,-3,2)+$V(44),%=$V($V($V(44)+10,-3,2)*5+%),Y=$V(%+X+X,-3,2),Y=$S(Y=0:0,Y#4=0:Y/4,1:-1)
! 88: E S %=$V(5,-5,0),Y=$V(%+X+X,-3,2),Y=$S(Y=0:0,Y#4=0:Y/4+$V(272,-4),1:-1)
! 89: I 'Y D DVOPN Q
! 90: S:Y=$J Y=0 Q
! 91: DVOPN S $ZT="DVERR",Y=0 Q:$D(%ZTIO)
! 92: L:$D(%ZISLOCK) +@%ZISLOCK:60
! 93: O X::$S($D(%ZISTO):%ZISTO,1:0) E S Y=999 L:$D(%ZISLOCK) -@%ZISLOCK Q
! 94: L:$D(%ZISLOCK) -@%ZISLOCK
! 95: S Y=0 I '$D(%ZISCHK)!$S($D(%ZIS)#2:(%ZIS["T"),1:0) C X Q
! 96: S:X]"" IO(1,X)="" Q
! 97: DVERR I $ZE["OPENERR" S Y=-1 Q
! 98: ZQ
! 99: RES S Y=0,%ZISD0=$O(^%ZISL(3.54,"B",X,0))
! 100: I '%ZISD0 S Y=-1,%ZISD0=%O(^%ZIS(1,"C",X)) Q:'%ZISD0 Q:'$D(^%ZIS(1,+%ZISD0,0)) Q:$P(^(0),"^")'=X Q:'$D(^("TYPE")) Q:^("TYPE")'="RES" S Y=0 Q
! 101: S X1=$S($D(^%ZISL(3.54,+%ZISD0,0)):^(0),1:"")
! 102: I $P(X1,"^",2)&(X=$P(X1,"^")) S Y=0 Q
! 103: S Y=999 F %ZISD1=0:0 S %ZISD1=$O(^%ZISL(3.54,%ZISD0,1,%ZISD1)) Q:%ZISD1'>0 I $D(^(%ZISD1,0)) S Y=$P(^(0),"^",3) Q
! 104: K %ZISD0,%ZISD1
! 105: Q
! 106: V2CL1 F %=0:0 Q:$ZA<0 R %X:5 Q:%X']"" F %1=0:0 S %1=$L(%Y),%Y=%Y_$E(%X,1,255-%1),%X=$E(%X,256-%1,$L(%X)),%1=$F(%Y,%ZCR) Q:%1'>0 S %2=$E(%Y,$A(%Y)=10+1,%1-2),%Y=$E(%Y,%1,$L(%Y)) D V2CL2
! 107: C 2:256 K IO(1,2) D CLOSE^ZISPL1 K %Y,%X,%1,ZOSFV
! 108: Q
! 109: V2CL2 S %1=$F(%2,$C(12)) I %1>0 S %=%+1 D LIMIT:%Z1<% Q:%Z1<% S ^XMBS(3.519,XS,2,%,0)="|TOP|",%2=$E(%2,1,%1-2)_$E(%2,%1,$L(%2))
! 110: S %=%+1,^XMBS(3.519,XS,2,%,0)=%2 Q
! 111: ;
! 112: LIMIT S ^XMBS(3.519,XS,2,%,0)="*** INCOMPLETE REPORT -- SPOOL DOCUMENT LINE LIMIT EXCEEDED ***",$P(^XMB(3.51,%ZDA,0),"^",11)=1 Q
! 113: ;
! 114: SET ;SET SPECIAL VARIABLES
! 115: S X=$H X ^%ZOSF("ZD") S DT=$E(Y,7,8)+200_$E(Y,1,2)_$E(Y,4,5)
! 116: Q
! 117: GETENV ;Get enviroment (UCI^VOL^NODE)
! 118: S Y=$P($ZU(0),",",1)_"^"_$P($ZU(0),",",2)_"^^"_$P($ZU(0),",",2) Q
! 119: SETENV ;Set enviroment
! 120: Q
! 121: LOGRSRC(OPT) ;record resource usage in ^XUCP
! 122: Q
! 123: V3() ;returns 1=version 3, 0=version 4
! 124: Q $P($ZV,"Version ",2)<4
! 125: SETTRM(X) ;Set specified terminators.
! 126: U $I:(::::::::X)
! 127: Q 1
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DINVMSM.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman