- 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 Feb 19, 2025@00:18:26 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