ZOSV1VXD ;SFISC/AC - View commands & special functions(continued). ;1:05 PM 30 Sep 1998
;;22.0;VA FileMan;;Mar 30, 1999;Build 1
;Per VHA Directive 10-93-142, this routine should not be modified.
DEVOPN ;List devices opened.
N %,%B,%I,%L,%X,%X1,%X2,%Y
S %X1=$V($V(0)+8),%X2=$V(%X1),Y=""
F %I=1:1 D D1 S %X2=$V(%X2) Q:%X2=%X1
Q
D1 S %X=$V(%X2+8)
S %L=$V(%X+4,-1,1),%B=$V(%X+8)
S %Y=""
F %=1:1:%L S %Y=%Y_$C($V(%B,-1,1)) S %B=%B+1
S Y=Y_%Y_"," Q
;
DEVOK ;Check Device Availability. (not complete)
;INPUT: X=Device $I, X1=IOT -- X1 needed for resources
;OUTPUT: Y=0 if available, Y=job # if owned, Y=-1 if device does not exists.
S Y=0 Q:X["::" I $G(X1)="RES" G RES
S Y=$ZC(%GETDVI,X,"EXISTS")
G DV1:Y D DV2 Q:Y=-1 I Y="TERM" S Y=-1 Q
S Y=-2 Q
DV1 S Y=$ZC(%GETDVI,X,"PID") I Y=$J!($ZC(%GETDVI,X,"SPL")) S Y=0 Q
I Y,$ZC(%GETJPI,X,"MASTER_PID")=Y G DVOPN
Q:Y>0 D DV2 G DVOPN:Y="TERM" S Y=$S(Y="DISK":0,Y="MAILBOX":0,Y="TAPE":0,1:-1) Q
DV2 S Y=$ZC(%PARSE,X) I Y="" S Y=-1 Q
I X]"" S Y=$ZC(%GETDVI,$S(Y]"":Y,1:X),"DEVCLASS") Q
Q
DVOPN S $ZT="DVERR",Y=0 Q:$D(%ZTIO)
L:$D(%ZISLOCK) +@%ZISLOCK:60
O X::$S($D(%ZISTO):%ZISTO,1:0) E S Y=999 L:$D(%ZISLOCK) -@%ZISLOCK:60 Q
L:$D(%ZISLOCK) -@%ZISLOCK
S Y=0 I '$D(%ZISCHK)!$S($D(%ZIS)#2:(%ZIS["T"),1:0) C X Q
S:X]"" IO(1,X)="" Q
DVERR I $ZE["OPENERR" S Y=-1 Q
ZQ
RES S Y=0,%ZISD0=$O(^%ZISL(3.54,"B",X,0))
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
S X1=$S($D(^%ZISL(3.54,+%ZISD0,0)):^(0),1:"")
I $P(X1,"^",2)&(X=$P(X1,"^")) S Y=0 Q
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
K %ZISD0,%ZISD1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDINV1VXD 1782 printed Apr 09, 2024@21:55:54 Page 2
ZOSV1VXD ;SFISC/AC - View commands & special functions(continued). ;1:05 PM 30 Sep 1998
+1 ;;22.0;VA FileMan;;Mar 30, 1999;Build 1
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
DEVOPN ;List devices opened.
+1 NEW %,%B,%I,%L,%X,%X1,%X2,%Y
+2 SET %X1=$VIEW($VIEW(0)+8)
SET %X2=$VIEW(%X1)
SET Y=""
+3 FOR %I=1:1
DO D1
SET %X2=$VIEW(%X2)
if %X2=%X1
QUIT
+4 QUIT
D1 SET %X=$VIEW(%X2+8)
+1 SET %L=$VIEW(%X+4,-1,1)
SET %B=$VIEW(%X+8)
+2 SET %Y=""
+3 FOR %=1:1:%L
SET %Y=%Y_$CHAR($VIEW(%B,-1,1))
SET %B=%B+1
+4 SET Y=Y_%Y_","
QUIT
+5 ;
DEVOK ;Check Device Availability. (not complete)
+1 ;INPUT: X=Device $I, X1=IOT -- X1 needed for resources
+2 ;OUTPUT: Y=0 if available, Y=job # if owned, Y=-1 if device does not exists.
+3 SET Y=0
if X["
QUIT
IF $GET(X1)="RES"
GOTO RES
+4 SET Y=$ZC(%GETDVI,X,"EXISTS")
+5 if Y
GOTO DV1
DO DV2
if Y=-1
QUIT
IF Y="TERM"
SET Y=-1
QUIT
+6 SET Y=-2
QUIT
DV1 SET Y=$ZC(%GETDVI,X,"PID")
IF Y=$JOB!($ZC(%GETDVI,X,"SPL"))
SET Y=0
QUIT
+1 IF Y
IF $ZC(%GETJPI,X,"MASTER_PID")=Y
GOTO DVOPN
+2 if Y>0
QUIT
DO DV2
if Y="TERM"
GOTO DVOPN
SET Y=$SELECT(Y="DISK":0,Y="MAILBOX":0,Y="TAPE":0,1:-1)
QUIT
DV2 SET Y=$ZC(%PARSE,X)
IF Y=""
SET Y=-1
QUIT
+1 IF X]""
SET Y=$ZC(%GETDVI,$SELECT(Y]"":Y,1:X),"DEVCLASS")
QUIT
+2 QUIT
DVOPN SET $ZT="DVERR"
SET Y=0
if $DATA(%ZTIO)
QUIT
+1 if $DATA(%ZISLOCK)
LOCK +@%ZISLOCK:60
+2 OPEN X::$SELECT($DATA(%ZISTO):%ZISTO,1:0)
IF '$TEST
SET Y=999
if $DATA(%ZISLOCK)
LOCK -@%ZISLOCK:60
QUIT
+3 if $DATA(%ZISLOCK)
LOCK -@%ZISLOCK
+4 SET Y=0
IF '$DATA(%ZISCHK)!$SELECT($DATA(%ZIS)#2:(%ZIS["T"),1:0)
CLOSE X
QUIT
+5 if X]""
SET IO(1,X)=""
QUIT
DVERR IF $ZE["OPENERR"
SET Y=-1
QUIT
+1
*** ERROR ***
RES SET Y=0
SET %ZISD0=$ORDER(^%ZISL(3.54,"B",X,0))
+1 IF '%ZISD0
SET Y=-1
SET %ZISD0=$ORDER(^%ZIS(1,"C",X))
if '%ZISD0
QUIT
if '$DATA(^%ZIS(1,+%ZISD0,0))
QUIT
if $PIECE(^(0),"^")'=X
QUIT
if '$DATA(^("TYPE"))
QUIT
if ^("TYPE")'="RES"
QUIT
SET Y=0
QUIT
+2 SET X1=$SELECT($DATA(^%ZISL(3.54,+%ZISD0,0)):^(0),1:"")
+3 IF $PIECE(X1,"^",2)&(X=$PIECE(X1,"^"))
SET Y=0
QUIT
+4 SET Y=999
FOR %ZISD1=0:0
SET %ZISD1=$ORDER(^%ZISL(3.54,%ZISD0,1,%ZISD1))
if %ZISD1'>0
QUIT
IF $DATA(^(%ZISD1,0))
SET Y=$PIECE(^(0),"^",3)
QUIT
+5 KILL %ZISD0,%ZISD1
+6 QUIT
