XUDHGUI ;ISF/STAFF,SLC/KCM - Device Utilites for Windows Calls ;03/24/10 10:34
;;8.0;KERNEL;**220,542**;Jul 10, 1995;Build 5
;
DEVICE(LST,FROM,DIR,RMAR) ; Return a subset of entries from the Device file
; Return up to 20 entries.
; .LST(n)=IEN^Name^DisplayName^Location^RMar^PLen
; FROM=text to $O from. Allow the DisplayName to be used.
; Allow "NAME*" to get count limit from that starting point.
; DIR=$O direction
; [RMAR]=min RM value or min-max value (Default to 80).
N I,IEN,CNT,FR,SHOW,X,RML,RMH
S I=0,CNT=$G(CNT,20),RMAR=$G(RMAR,80)
I '$G(DIR) S DIR=1
S RML=+RMAR,RMH=$S(RMAR["-":$P(RMAR,"-",2),1:99999)
;Allow the DisplayName to be used.
I FROM[" <" S FROM=$RE($P($RE(FROM),"< ",2))
S FR=FROM I FROM["*" S FROM=$P(FROM,"*",1),FR=""
F Q:I'<CNT S FROM=$O(^%ZIS(1,"B",FROM),DIR) Q:(FROM="") D
. I $L(FR),($E(FROM,1,$L(FR))'=FR) Q
. S IEN=0 F S IEN=$O(^%ZIS(1,"B",FROM,IEN)) Q:'IEN D
.. N X0,X1,X90,X91,X95,XTYPE,XSTYPE,XTIME,%A,%C,%H,%L,%X,EXT
.. Q:'$D(^%ZIS(1,IEN,0)) S X0=^(0),X1=$G(^(1)),X90=$G(^(90)),X91=$G(^(91)),X95=$G(^(95)),XSTYPE=$G(^("SUBTYPE")),XTIME=$G(^("TIME")),XTYPE=$G(^("TYPE"))
.. I $E($G(^%ZIS(2,+XSTYPE,0)))'="P" Q ;Printers only
.. S X=$P(XTYPE,"^") I X'="TRM",X'="HG",X'="HFS",X'="CHAN" Q ;Device Types
.. I ($P(X0,U,2)="0")!($P(X0,U,12)=2) Q ;Queuing allowed
.. S X=+X90 I X,(X'>DT) Q ;Out of Service
.. ;%C is current time, %L is lower limit, %H is upper limit
.. S %A=$P(XTIME,"^") I $L(%A) S %C=$P($H,",",2),%C=%C\60#60+(%C\3600*100),%H=$P(%A,"-",2),%L=+%A I $S(%H'<%L:(%C'>%H&(%C'<%L)),1:(%C'<%L!(%C'>%H))) Q ;Prohibited Times
.. S EXT=0
.. I X95]"" S %X=$G(DUZ(0)) I %X'="@" S EXT=1 F %A=1:1:$L(%X) I X95[$E(%X,%A) S EXT=0 Q
.. Q:EXT ;Security check
.. I '+X91 S X91=$G(^%ZIS(2,+XSTYPE,1),"80^#^60^") ;Get default width & page length p542
.. I RML>0,(+X91<RML)!(+X91>RMH) Q
.. S SHOW=$P(X0,U) I SHOW'=FROM S SHOW=FROM_" <"_SHOW_">"
.. S I=I+1,LST(I)=IEN_U_$P(X0,U)_U_SHOW_U_$P(X1,U)_U_$P(X91,U)_U_$P(X91,U,3)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUDHGUI 2033 printed Apr 09, 2024@21:05:22 Page 2
XUDHGUI ;ISF/STAFF,SLC/KCM - Device Utilites for Windows Calls ;03/24/10 10:34
+1 ;;8.0;KERNEL;**220,542**;Jul 10, 1995;Build 5
+2 ;
DEVICE(LST,FROM,DIR,RMAR) ; Return a subset of entries from the Device file
+1 ; Return up to 20 entries.
+2 ; .LST(n)=IEN^Name^DisplayName^Location^RMar^PLen
+3 ; FROM=text to $O from. Allow the DisplayName to be used.
+4 ; Allow "NAME*" to get count limit from that starting point.
+5 ; DIR=$O direction
+6 ; [RMAR]=min RM value or min-max value (Default to 80).
+7 NEW I,IEN,CNT,FR,SHOW,X,RML,RMH
+8 SET I=0
SET CNT=$GET(CNT,20)
SET RMAR=$GET(RMAR,80)
+9 IF '$GET(DIR)
SET DIR=1
+10 SET RML=+RMAR
SET RMH=$SELECT(RMAR["-":$PIECE(RMAR,"-",2),1:99999)
+11 ;Allow the DisplayName to be used.
+12 IF FROM[" <"
SET FROM=$REVERSE($PIECE($REVERSE(FROM),"< ",2))
+13 SET FR=FROM
IF FROM["*"
SET FROM=$PIECE(FROM,"*",1)
SET FR=""
+14 FOR
if I'<CNT
QUIT
SET FROM=$ORDER(^%ZIS(1,"B",FROM),DIR)
if (FROM="")
QUIT
Begin DoDot:1
+15 IF $LENGTH(FR)
IF ($EXTRACT(FROM,1,$LENGTH(FR))'=FR)
QUIT
+16 SET IEN=0
FOR
SET IEN=$ORDER(^%ZIS(1,"B",FROM,IEN))
if 'IEN
QUIT
Begin DoDot:2
+17 NEW X0,X1,X90,X91,X95,XTYPE,XSTYPE,XTIME,%A,%C,%H,%L,%X,EXT
+18 if '$DATA(^%ZIS(1,IEN,0))
QUIT
SET X0=^(0)
SET X1=$GET(^(1))
SET X90=$GET(^(90))
SET X91=$GET(^(91))
SET X95=$GET(^(95))
SET XSTYPE=$GET(^("SUBTYPE"))
SET XTIME=$GET(^("TIME"))
SET XTYPE=$GET(^("TYPE"))
+19 ;Printers only
IF $EXTRACT($GET(^%ZIS(2,+XSTYPE,0)))'="P"
QUIT
+20 ;Device Types
SET X=$PIECE(XTYPE,"^")
IF X'="TRM"
IF X'="HG"
IF X'="HFS"
IF X'="CHAN"
QUIT
+21 ;Queuing allowed
IF ($PIECE(X0,U,2)="0")!($PIECE(X0,U,12)=2)
QUIT
+22 ;Out of Service
SET X=+X90
IF X
IF (X'>DT)
QUIT
+23 ;%C is current time, %L is lower limit, %H is upper limit
+24 ;Prohibited Times
SET %A=$PIECE(XTIME,"^")
IF $LENGTH(%A)
SET %C=$PIECE($HOROLOG,",",2)
SET %C=%C\60#60+(%C\3600*100)
SET %H=$PIECE(%A,"-",2)
SET %L=+%A
IF $SELECT(%H'<%L:(%C'>%H&(%C'<%L)),1:(%C'<%L!(%C'>%H)))
QUIT
+25 SET EXT=0
+26 IF X95]""
SET %X=$GET(DUZ(0))
IF %X'="@"
SET EXT=1
FOR %A=1:1:$LENGTH(%X)
IF X95[$EXTRACT(%X,%A)
SET EXT=0
QUIT
+27 ;Security check
if EXT
QUIT
+28 ;Get default width & page length p542
IF '+X91
SET X91=$GET(^%ZIS(2,+XSTYPE,1),"80^#^60^")
+29 IF RML>0
IF (+X91<RML)!(+X91>RMH)
QUIT
+30 SET SHOW=$PIECE(X0,U)
IF SHOW'=FROM
SET SHOW=FROM_" <"_SHOW_">"
+31 SET I=I+1
SET LST(I)=IEN_U_$PIECE(X0,U)_U_SHOW_U_$PIECE(X1,U)_U_$PIECE(X91,U)_U_$PIECE(X91,U,3)
End DoDot:2
End DoDot:1
+32 QUIT
