XUDHRES.m

XUDHRES ;ISCSF/RWF - Resource device utility. ;4/30/98  11:17 [ 04/02/2003   8:29 AM ]

 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 ;;8.0;KERNEL;**49,69**;Dec 30, 1996

 W !,"No entry from the top.",! Q

 ;

RELALL ;Release all resource devices.  Used at startup.

 N ZISJ,ZISD0,ZISD1

 F ZISD0=0:0 S ZISD0=$O(^%ZISL(3.54,ZISD0)) Q:ZISD0'>0  D

 . F ZISD1=0:0 S ZISD1=$O(^%ZISL(3.54,ZISD0,1,ZISD1)) Q:ZISD1'>0  D

 . . D KILLRES^%ZISC(ZISD0,ZISD1)

 . . S X1=$P(^%ZISL(3.54,ZISD0,0),U),X2=$O(^%ZIS(1,"C",X1,0))

 . . S X1=$P($G(^%ZIS(1,+X2,1)),U,10) S:X1 $P(^%ZISL(3.54,ZISD0,0),U,2)=X1

 . Q

 Q

RELONE ;Option to release one

 N ZISD0,ZISD1,DIC,X,Y

 S DIC="^%ZISL(3.54,",DIC(0)="AEMQ" D ^DIC Q:$D(DUOUT)!(Y'>0)  S ZISD0=+Y

 I $O(^%ZISL(3.54,ZISD0,1,0))'>0 W !!,"No slots in use to release." Q

 S DIC=DIC_ZISD0_",1," D ^DIC Q:$D(DUOUT)!(Y'>0)  S ZISD1=+Y

 D KILLRES^%ZISC(ZISD0,ZISD1)

 Q

XUDHRES   ;ISCSF/RWF - Resource device utility. ;4/30/98  11:17 [ 04/02/2003   8:29 AM ]

 +1       ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 +2       ;;8.0;KERNEL;**49,69**;Dec 30, 1996

 +3        WRITE !,"No entry from the top.",!

           QUIT 

 +4       ;

RELALL    ;Release all resource devices.  Used at startup.

 +1        NEW ZISJ,ZISD0,ZISD1

 +2        FOR ZISD0=0:0

               SET ZISD0=$ORDER(^%ZISL(3.54,ZISD0))

               IF ZISD0'>0

                   QUIT 

               Begin DoDot:1

 +3                FOR ZISD1=0:0

                       SET ZISD1=$ORDER(^%ZISL(3.54,ZISD0,1,ZISD1))

                       IF ZISD1'>0

                           QUIT 

                       Begin DoDot:2

 +4                        DO KILLRES^%ZISC(ZISD0,ZISD1)

 +5                        SET X1=$PIECE(^%ZISL(3.54,ZISD0,0),U)

                           SET X2=$ORDER(^%ZIS(1,"C",X1,0))

 +6                        SET X1=$PIECE($GET(^%ZIS(1,+X2,1)),U,10)

                           IF X1

                               SET $PIECE(^%ZISL(3.54,ZISD0,0),U,2)=X1

                       End DoDot:2

 +7                QUIT 

               End DoDot:1

 +8        QUIT 

RELONE    ;Option to release one

 +1        NEW ZISD0,ZISD1,DIC,X,Y

 +2        SET DIC="^%ZISL(3.54,"

           SET DIC(0)="AEMQ"

           DO ^DIC

           IF $DATA(DUOUT)!(Y'>0)

               QUIT 

           SET ZISD0=+Y

 +3        IF $ORDER(^%ZISL(3.54,ZISD0,1,0))'>0

               WRITE !!,"No slots in use to release."

               QUIT 

 +4        SET DIC=DIC_ZISD0_",1,"

           DO ^DIC

           IF $DATA(DUOUT)!(Y'>0)

               QUIT 

           SET ZISD1=+Y

 +5        DO KILLRES^%ZISC(ZISD0,ZISD1)

 +6        QUIT