- XUDHSET ;ISC-SF/RWF - Setup devices ;5/5/97 15:41
- ;;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),"^")
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUDHSET 860 printed Feb 18, 2025@23:35:43 Page 2
- XUDHSET ;ISC-SF/RWF - Setup devices ;5/5/97 15:41
- +1 ;;8.0;KERNEL;**49**;Jul 10, 1995
- +2 QUIT
- +3 ;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),"^")