XUDHSET.m

XUDHSET ;ISC-SF/RWF - Setup devices ;5/5/97  15:41 [ 04/02/2003   8:29 AM ]

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

 ;;8.0;KERNEL;**49**;Jul 10, 1995

 Q

 ;N1 device name, N2 resource name, CNT # of slots

RES(N1,N2,CNT,LOC,SUB) ;Build a RESOURCE device entry

 N X,Y,%,XUFD,XUDA,DIC

 S:'$D(N2) N2=N1 S:'$D(CNT) CNT=1 S:'$D(LOC) LOC="Resource Device" S:'$D(SUB) SUB="P-OTHER"

 S DIC="^%ZIS(1,",DIC(0)="M",X=N1 D ^DIC I Y>0 Q "-1^Device name in use"

 S DIC="^%ZISL(3.54,",DIC(0)="M",X=N2 D ^DIC I Y>0 Q "-1^Resource name in use"

 S %=$O(^%ZIS(2,"B",SUB,0)) S:%'>0 %=$O(^%ZIS(2,"B",SUB)),%=$S(%[SUB:$O(^%ZIS(2,"B",%,0)))

 S XUDA="+1,",XUDA2="+2,"

 S XUFD(3.5,XUDA,.01)=N1,XUFD(3.5,XUDA,2)="RES",XUFD(3.5,XUDA,1)=N2,XUFD(3.5,XUDA,35)=CNT,XUFD(3.5,XUDA,.02)=LOC

 S:%>0 XUFD(3.5,XUDA,3)=%

 D UPDATE^DIE("","XUFD","XUDA")

 S %=$O(^TMP("DIERR",$J,0)) I % Q "-1^"_^(%,"TEXT",1)

 Q XUDA(1)_"^"_$P(^%ZIS(1,XUDA(1),0),"^")

XUDHSET   ;ISC-SF/RWF - Setup devices ;5/5/97  15:41 [ 04/02/2003   8:29 AM ]

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

 +2       ;;8.0;KERNEL;**49**;Jul 10, 1995

 +3        QUIT 

 +4       ;N1 device name, N2 resource name, CNT # of slots

RES(N1,N2,CNT,LOC,SUB) ;Build a RESOURCE device entry

 +1        NEW X,Y,%,XUFD,XUDA,DIC

 +2        IF '$DATA(N2)

               SET N2=N1

           IF '$DATA(CNT)

               SET CNT=1

           IF '$DATA(LOC)

               SET LOC="Resource Device"

           IF '$DATA(SUB)

               SET SUB="P-OTHER"

 +3        SET DIC="^%ZIS(1,"

           SET DIC(0)="M"

           SET X=N1

           DO ^DIC

           IF Y>0

               QUIT "-1^Device name in use"

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

           SET DIC(0)="M"

           SET X=N2

           DO ^DIC

           IF Y>0

               QUIT "-1^Resource name in use"

 +5        SET %=$ORDER(^%ZIS(2,"B",SUB,0))

           IF %'>0

               SET %=$ORDER(^%ZIS(2,"B",SUB))

               SET %=$SELECT(%[SUB:$ORDER(^%ZIS(2,"B",%,0)))

 +6        SET XUDA="+1,"

           SET XUDA2="+2,"

 +7        SET XUFD(3.5,XUDA,.01)=N1

           SET XUFD(3.5,XUDA,2)="RES"

           SET XUFD(3.5,XUDA,1)=N2

           SET XUFD(3.5,XUDA,35)=CNT

           SET XUFD(3.5,XUDA,.02)=LOC

 +8        IF %>0

               SET XUFD(3.5,XUDA,3)=%

 +9        DO UPDATE^DIE("","XUFD","XUDA")

 +10       SET %=$ORDER(^TMP("DIERR",$JOB,0))

           IF %

               QUIT "-1^"_^(%,"TEXT",1)

 +11       QUIT XUDA(1)_"^"_$PIECE(^%ZIS(1,XUDA(1),0),"^")