%ZIS31 ;SFISC/AC - DEVICE HANDLER -- RESOURCES ;10/13/89 13:51
;
L ^%ZISL(3.54):1
I '$T S POP=1 W:'$D(IOP) *7," [NOT AVAILABLE]" Q
S X=$O(^%ZISL(3.54,"B",IO,0))
I 'X D FLST S ^%ZISL(3.54,"B",IO,L)="",X=L
I '($D(^%ZISL(3.54,+X,0))#2) S ^(0)=IO_"^"_%ZISRL,A=^%ZISL(3.54,0),$P(A,"^",3)=+X,$P(A,"^",4)=$P(A,"^",4)+1,^(0)=A,IO(1,IO)="RES",%ZISD0=+X G R1
S %ZISD0=+X
S X=$P(^(0),"^",2) I 'X S POP=1 W:'$D(IOP) *7," [NOT AVAILABLE]" L Q
S X=X-1,$P(^(0),"^",2)=X,IO(1,IO)="RES"
;
R1 ;
;S %ZISROOT="^%ZISL(3.54,"_%ZISD0_",1," S:'$D(^%ZISL(3.54,%ZISD0,1,0)) ^(0)="^3.542^^" D FLST S ^%ZISL(3.54,%ZISD0,1,"B",L,L)="",X=L
S:'$D(^%ZISL(3.54,%ZISD0,1,0)) ^(0)="^3.542^^"
;D FLST
F L=1:1:(%ZISRL+1) I '$D(^%ZISL(3.54,%ZISD0,1,L,0)) Q
I '$T,L=(%ZISRL+1) S POP=1 K IO(1,IO) Q
S ^%ZISL(3.54,%ZISD0,1,"B",L,L)="",X=L
S ^%ZISL(3.54,%ZISD0,1,+X,0)=+X_"^"_%ZISV_"^"_$J,A=^%ZISL(3.54,%ZISD0,1,0),$P(A,"^",3)=+X,$P(A,"^",4)=$P(A,"^",4)+1,^(0)=A
L Q
;
FLST S:'$D(^%ZISL(3.54,0)) ^(0)="RESOURCE^3.54^^" S X=$P(^(0),"^",3),A=X
F I=+X:0 S I=+$O(^%ZISL(3.54,I)) Q:I'>0 S A=I
S L=A+1 Q
NTRMS ;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HZIS31 1118 printed Dec 13, 2024@02:14:24 Page 2
%ZIS31 ;SFISC/AC - DEVICE HANDLER -- RESOURCES ;10/13/89 13:51
+1 ;
+2 LOCK ^%ZISL(3.54):1
+3 IF '$TEST
SET POP=1
if '$DATA(IOP)
WRITE *7," [NOT AVAILABLE]"
QUIT
+4 SET X=$ORDER(^%ZISL(3.54,"B",IO,0))
+5 IF 'X
DO FLST
SET ^%ZISL(3.54,"B",IO,L)=""
SET X=L
+6 IF '($DATA(^%ZISL(3.54,+X,0))#2)
SET ^(0)=IO_"^"_%ZISRL
SET A=^%ZISL(3.54,0)
SET $PIECE(A,"^",3)=+X
SET $PIECE(A,"^",4)=$PIECE(A,"^",4)+1
SET ^(0)=A
SET IO(1,IO)="RES"
SET %ZISD0=+X
GOTO R1
+7 SET %ZISD0=+X
+8 SET X=$PIECE(^(0),"^",2)
IF 'X
SET POP=1
if '$DATA(IOP)
WRITE *7," [NOT AVAILABLE]"
LOCK
QUIT
+9 SET X=X-1
SET $PIECE(^(0),"^",2)=X
SET IO(1,IO)="RES"
+10 ;
R1 ;
+1 ;S %ZISROOT="^%ZISL(3.54,"_%ZISD0_",1," S:'$D(^%ZISL(3.54,%ZISD0,1,0)) ^(0)="^3.542^^" D FLST S ^%ZISL(3.54,%ZISD0,1,"B",L,L)="",X=L
+2 if '$DATA(^%ZISL(3.54,%ZISD0,1,0))
SET ^(0)="^3.542^^"
+3 ;D FLST
+4 FOR L=1:1:(%ZISRL+1)
IF '$DATA(^%ZISL(3.54,%ZISD0,1,L,0))
QUIT
+5 IF '$TEST
IF L=(%ZISRL+1)
SET POP=1
KILL IO(1,IO)
QUIT
+6 SET ^%ZISL(3.54,%ZISD0,1,"B",L,L)=""
SET X=L
+7 SET ^%ZISL(3.54,%ZISD0,1,+X,0)=+X_"^"_%ZISV_"^"_$JOB
SET A=^%ZISL(3.54,%ZISD0,1,0)
SET $PIECE(A,"^",3)=+X
SET $PIECE(A,"^",4)=$PIECE(A,"^",4)+1
SET ^(0)=A
+8 LOCK
QUIT
+9 ;
FLST if '$DATA(^%ZISL(3.54,0))
SET ^(0)="RESOURCE^3.54^^"
SET X=$PIECE(^(0),"^",3)
SET A=X
+1 FOR I=+X:0
SET I=+$ORDER(^%ZISL(3.54,I))
if I'>0
QUIT
SET A=I
+2 SET L=A+1
QUIT
NTRMS ;
