- %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 Jan 18, 2025@03:15:35 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 ;