SDES2GETDEVICES ;ALB/JHC - VISTA SCHEDULING RPCS - DEVICE RETRIEVAL ; MAY 05,2025
;;5.3;Scheduling;**907**;Aug 13, 1993;Build 5
;;Per VHA Directive 6402, this routine should not be modified
;
; External References
; -------------------
; Reference to ^%ZIS(1 supported by IA #2963
; Reference to ^%ZIS(2 supported by IA #2964
;
; RPC: SDES2 GET VISTA DEVICES
;
; SDINPUT("LOOKUPSTRING") = Search string to match device name (* not allowed)
; length must be 15 characters or less
;
; This will return up to 80 devices.
;
Q
DEVICES(JSON,SDCONTEXT,SDINPUT) ;
N ERRORS,DEVICES,DEVLIST,DEV,DEVDAT,LOOKUP,LOOKUPSHORT
; Validation
D VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
I $D(ERRORS) S RETURN("Device",1)="" M RETURN=ERRORS D BUILDJSON^SDES2JSON(.JSON,.RETURN) Q
S LOOKUP=$G(SDINPUT("LOOKUPSTRING"))
D VALLOOKUP(.ERRORS,LOOKUP)
S LOOKUPSHORT=$E(LOOKUP,1,$L(LOOKUP)-1)
I $D(ERRORS) S ERRORS("Device",1)="" D BUILDJSON^SDESBUILDJSON(.JSON,.ERRORS) Q
; Loop through device info
D DEVICE(.DEVICES,LOOKUPSHORT,1)
I '$D(DEVICES) S DEVLIST("Device",1)="" D BUILDJSON^SDESBUILDJSON(.JSON,.DEVLIST) Q
; Build output
D BLDOUTPUT(.DEVICES,.DEVLIST)
I '$D(DEVLIST) S DEVLIST("Device",1)="" D BUILDJSON^SDESBUILDJSON(.JSON,.DEVLIST) Q
; Build JSON output
D BUILDJSON^SDESBUILDJSON(.JSON,.DEVLIST)
Q
VALLOOKUP(ERRORS,LOOKUP) ;
I LOOKUP["*" D ERRLOG^SDESJSON(.ERRORS,52,"Search string cannot contain an *") Q
I LOOKUP="" D ERRLOG^SDESJSON(.ERRORS,277) Q
I $L(LOOKUP)>15 D ERRLOG^SDESJSON(.ERRORS,278)
Q
DEVICE(RETURN,SEARCHSTRING,DIRECTION,RIGHTMARGIN) ; Return a subset of entries from the Device file
; Return up to 80 entries.
; RETURN(n)=Device IEN^Device Name^Display Name^Location^Right Margin^Page Length
; SEARCHSTRING=text to $O from. Allow the Display Name to be used.
; Allow "NAME*" to get count limit from that starting point.
; DIRECTION=$O direction
; [RIGHTMARGIN]=min RM value or min-max value (Default to 80).
N FOUNDCNT,DEVICEIEN,MAXCOUNT,SEARCH,DTYP,RML,RMH
S FOUNDCNT=0,MAXCOUNT=$G(MAXCOUNT,80),RIGHTMARGIN=$G(RIGHTMARGIN,80)
I '$G(DIRECTION) S DIRECTION=1
S RML=+RIGHTMARGIN,RMH=$S(RIGHTMARGIN["-":$P(RIGHTMARGIN,"-",2),1:99999)
;Allow the DisplayName to be used.
I SEARCHSTRING[" <" S SEARCHSTRING=$RE($P($RE(SEARCHSTRING),"< ",2))
S SEARCH=SEARCHSTRING I SEARCHSTRING["*" S SEARCHSTRING=$P(SEARCHSTRING,"*",1),SEARCH=""
F Q:FOUNDCNT'<MAXCOUNT S SEARCHSTRING=$O(^%ZIS(1,"B",SEARCHSTRING),DIRECTION) Q:(SEARCHSTRING="") D
. I $L(SEARCH),($E(SEARCHSTRING,1,$L(SEARCH))'=SEARCH) Q
. S DEVICEIEN=0
. F S DEVICEIEN=$O(^%ZIS(1,"B",SEARCHSTRING,DEVICEIEN)) Q:'DEVICEIEN D
. . Q:'$D(^%ZIS(1,DEVICEIEN,0))
. . N OUTOFSERVDT,MARGINWIDTH,SECURITY,XTYPE,XSTYPE,XTIME
. . N DEVICENAME,DISPLAYNAME
. . N LOCKTIME,CURRTIME,ULIM,LLIM,SECSTRNG,EXT,SCODE
. . ; Device Info (filter)
. . S OUTOFSERVDT=$P($G(^%ZIS(1,DEVICEIEN,90)),U)
. . S MARGINWIDTH=$P($G(^%ZIS(1,DEVICEIEN,91)),U)
. . S SECURITY=$G(^%ZIS(1,DEVICEIEN,95))
. . S XSTYPE=$G(^%ZIS(1,DEVICEIEN,"SUBTYPE"))
. . S XTIME=$G(^%ZIS(1,DEVICEIEN,"TIME"))
. . S XTYPE=$G(^%ZIS(1,DEVICEIEN,"TYPE"))
. . ; Device Filters
. . I $E($G(^%ZIS(2,+XSTYPE,0)))'="P" Q ;Printers only
. . S DTYP=$P(XTYPE,"^") I DTYP'="TRM",DTYP'="HG",DTYP'="HFS",DTYP'="CHAN" Q ;Device Types
. . Q:($P($G(^%ZIS(1,DEVICEIEN,0)),U,2)="0")!($P($G(^%ZIS(1,DEVICEIEN,0)),U,12)=2) ;Queuing allowed
. . I OUTOFSERVDT,(OUTOFSERVDT'>DT) Q ;Out of Service
. . ;Prohibited Times -CURRTIME is current time, LLIM is lower limit, ULIM is upper limit
. . S LOCKTIME=$P(XTIME,"^")
. . I $L(LOCKTIME) S CURRTIME=$P($H,",",2),CURRTIME=CURRTIME\60#60+(CURRTIME\3600*100),ULIM=$P(LOCKTIME,"-",2),LLIM=+LOCKTIME I $S(ULIM'<LLIM:(CURRTIME'>ULIM&(CURRTIME'<LLIM)),1:(CURRTIME'<LLIM!(CURRTIME'>ULIM))) Q
. . S EXT=0
. . I SECURITY]"" S SECSTRNG=$G(DUZ(0)) I SECSTRNG'="@" S EXT=1 F SCODE=1:1:$L(SECSTRNG) I SECURITY[$E(SECSTRNG,SCODE) S EXT=0 Q
. . Q:EXT ;User Security check
. . ; Device data to return
. . I '+MARGINWIDTH S MARGINWIDTH=$G(^%ZIS(2,+XSTYPE,1),"80^#^60^") ;Get default width & page length p542
. . I RML>0,(+MARGINWIDTH<RML)!(+MARGINWIDTH>RMH) Q
. . S DEVICENAME=$P($G(^%ZIS(1,DEVICEIEN,0)),U),DISPLAYNAME=DEVICENAME
. . S:DEVICENAME'=SEARCHSTRING DISPLAYNAME=SEARCHSTRING_" <"_DEVICENAME_">"
. . S FOUNDCNT=FOUNDCNT+1,RETURN(FOUNDCNT)=DEVICEIEN_U_DEVICENAME_U_DISPLAYNAME_U_$P($G(^%ZIS(1,DEVICEIEN,1)),U)_U_$P(MARGINWIDTH,U)_U_$P(MARGINWIDTH,U,3)
Q
BLDOUTPUT(DEVICES,DEVLIST) ;
S DEV=0 F S DEV=$O(DEVICES(DEV)) Q:'DEV D
.S DEVDAT=$G(DEVICES(DEV))
.I ($P(DEVDAT,U,2)'[LOOKUP),($P(DEVDAT,U,3)'[LOOKUP) Q
.S DEVLIST("Device",DEV,"ID")=$P(DEVDAT,U)
.S DEVLIST("Device",DEV,"Name")=$P(DEVDAT,U,2)
.S DEVLIST("Device",DEV,"DisplayName")=$P(DEVDAT,U,3)
.S DEVLIST("Device",DEV,"Location")=$P(DEVDAT,U,4)
.S DEVLIST("Device",DEV,"RightMargin")=$P(DEVDAT,U,5)
.S DEVLIST("Device",DEV,"PageLength")=$P(DEVDAT,U,6)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2GETDEVICES 5023 printed Sep 23, 2025@20:30:33 Page 2
SDES2GETDEVICES ;ALB/JHC - VISTA SCHEDULING RPCS - DEVICE RETRIEVAL ; MAY 05,2025
+1 ;;5.3;Scheduling;**907**;Aug 13, 1993;Build 5
+2 ;;Per VHA Directive 6402, this routine should not be modified
+3 ;
+4 ; External References
+5 ; -------------------
+6 ; Reference to ^%ZIS(1 supported by IA #2963
+7 ; Reference to ^%ZIS(2 supported by IA #2964
+8 ;
+9 ; RPC: SDES2 GET VISTA DEVICES
+10 ;
+11 ; SDINPUT("LOOKUPSTRING") = Search string to match device name (* not allowed)
+12 ; length must be 15 characters or less
+13 ;
+14 ; This will return up to 80 devices.
+15 ;
+16 QUIT
DEVICES(JSON,SDCONTEXT,SDINPUT) ;
+1 NEW ERRORS,DEVICES,DEVLIST,DEV,DEVDAT,LOOKUP,LOOKUPSHORT
+2 ; Validation
+3 DO VALCONTEXT^SDES2VALCONTEXT(.ERRORS,.SDCONTEXT)
+4 IF $DATA(ERRORS)
SET RETURN("Device",1)=""
MERGE RETURN=ERRORS
DO BUILDJSON^SDES2JSON(.JSON,.RETURN)
QUIT
+5 SET LOOKUP=$GET(SDINPUT("LOOKUPSTRING"))
+6 DO VALLOOKUP(.ERRORS,LOOKUP)
+7 SET LOOKUPSHORT=$EXTRACT(LOOKUP,1,$LENGTH(LOOKUP)-1)
+8 IF $DATA(ERRORS)
SET ERRORS("Device",1)=""
DO BUILDJSON^SDESBUILDJSON(.JSON,.ERRORS)
QUIT
+9 ; Loop through device info
+10 DO DEVICE(.DEVICES,LOOKUPSHORT,1)
+11 IF '$DATA(DEVICES)
SET DEVLIST("Device",1)=""
DO BUILDJSON^SDESBUILDJSON(.JSON,.DEVLIST)
QUIT
+12 ; Build output
+13 DO BLDOUTPUT(.DEVICES,.DEVLIST)
+14 IF '$DATA(DEVLIST)
SET DEVLIST("Device",1)=""
DO BUILDJSON^SDESBUILDJSON(.JSON,.DEVLIST)
QUIT
+15 ; Build JSON output
+16 DO BUILDJSON^SDESBUILDJSON(.JSON,.DEVLIST)
+17 QUIT
VALLOOKUP(ERRORS,LOOKUP) ;
+1 IF LOOKUP["*"
DO ERRLOG^SDESJSON(.ERRORS,52,"Search string cannot contain an *")
QUIT
+2 IF LOOKUP=""
DO ERRLOG^SDESJSON(.ERRORS,277)
QUIT
+3 IF $LENGTH(LOOKUP)>15
DO ERRLOG^SDESJSON(.ERRORS,278)
+4 QUIT
DEVICE(RETURN,SEARCHSTRING,DIRECTION,RIGHTMARGIN) ; Return a subset of entries from the Device file
+1 ; Return up to 80 entries.
+2 ; RETURN(n)=Device IEN^Device Name^Display Name^Location^Right Margin^Page Length
+3 ; SEARCHSTRING=text to $O from. Allow the Display Name to be used.
+4 ; Allow "NAME*" to get count limit from that starting point.
+5 ; DIRECTION=$O direction
+6 ; [RIGHTMARGIN]=min RM value or min-max value (Default to 80).
+7 NEW FOUNDCNT,DEVICEIEN,MAXCOUNT,SEARCH,DTYP,RML,RMH
+8 SET FOUNDCNT=0
SET MAXCOUNT=$GET(MAXCOUNT,80)
SET RIGHTMARGIN=$GET(RIGHTMARGIN,80)
+9 IF '$GET(DIRECTION)
SET DIRECTION=1
+10 SET RML=+RIGHTMARGIN
SET RMH=$SELECT(RIGHTMARGIN["-":$PIECE(RIGHTMARGIN,"-",2),1:99999)
+11 ;Allow the DisplayName to be used.
+12 IF SEARCHSTRING[" <"
SET SEARCHSTRING=$REVERSE($PIECE($REVERSE(SEARCHSTRING),"< ",2))
+13 SET SEARCH=SEARCHSTRING
IF SEARCHSTRING["*"
SET SEARCHSTRING=$PIECE(SEARCHSTRING,"*",1)
SET SEARCH=""
+14 FOR
if FOUNDCNT'<MAXCOUNT
QUIT
SET SEARCHSTRING=$ORDER(^%ZIS(1,"B",SEARCHSTRING),DIRECTION)
if (SEARCHSTRING="")
QUIT
Begin DoDot:1
+15 IF $LENGTH(SEARCH)
IF ($EXTRACT(SEARCHSTRING,1,$LENGTH(SEARCH))'=SEARCH)
QUIT
+16 SET DEVICEIEN=0
+17 FOR
SET DEVICEIEN=$ORDER(^%ZIS(1,"B",SEARCHSTRING,DEVICEIEN))
if 'DEVICEIEN
QUIT
Begin DoDot:2
+18 if '$DATA(^%ZIS(1,DEVICEIEN,0))
QUIT
+19 NEW OUTOFSERVDT,MARGINWIDTH,SECURITY,XTYPE,XSTYPE,XTIME
+20 NEW DEVICENAME,DISPLAYNAME
+21 NEW LOCKTIME,CURRTIME,ULIM,LLIM,SECSTRNG,EXT,SCODE
+22 ; Device Info (filter)
+23 SET OUTOFSERVDT=$PIECE($GET(^%ZIS(1,DEVICEIEN,90)),U)
+24 SET MARGINWIDTH=$PIECE($GET(^%ZIS(1,DEVICEIEN,91)),U)
+25 SET SECURITY=$GET(^%ZIS(1,DEVICEIEN,95))
+26 SET XSTYPE=$GET(^%ZIS(1,DEVICEIEN,"SUBTYPE"))
+27 SET XTIME=$GET(^%ZIS(1,DEVICEIEN,"TIME"))
+28 SET XTYPE=$GET(^%ZIS(1,DEVICEIEN,"TYPE"))
+29 ; Device Filters
+30 ;Printers only
IF $EXTRACT($GET(^%ZIS(2,+XSTYPE,0)))'="P"
QUIT
+31 ;Device Types
SET DTYP=$PIECE(XTYPE,"^")
IF DTYP'="TRM"
IF DTYP'="HG"
IF DTYP'="HFS"
IF DTYP'="CHAN"
QUIT
+32 ;Queuing allowed
if ($PIECE($GET(^%ZIS(1,DEVICEIEN,0)),U,2)="0")!($PIECE($GET(^%ZIS(1,DEVICEIEN,0)),U,12)=2)
QUIT
+33 ;Out of Service
IF OUTOFSERVDT
IF (OUTOFSERVDT'>DT)
QUIT
+34 ;Prohibited Times -CURRTIME is current time, LLIM is lower limit, ULIM is upper limit
+35 SET LOCKTIME=$PIECE(XTIME,"^")
+36 IF $LENGTH(LOCKTIME)
SET CURRTIME=$PIECE($HOROLOG,",",2)
SET CURRTIME=CURRTIME\60#60+(CURRTIME\3600*100)
SET ULIM=$PIECE(LOCKTIME,"-",2)
SET LLIM=+LOCKTIME
IF $SELECT(ULIM'<LLIM:(CURRTIME'>ULIM&(CURRTIME'<LLIM)),1:(CURRTIME'<LLIM!(CURRTIME'>ULIM)))
QUIT
+37 SET EXT=0
+38 IF SECURITY]""
SET SECSTRNG=$GET(DUZ(0))
IF SECSTRNG'="@"
SET EXT=1
FOR SCODE=1:1:$LENGTH(SECSTRNG)
IF SECURITY[$EXTRACT(SECSTRNG,SCODE)
SET EXT=0
QUIT
+39 ;User Security check
if EXT
QUIT
+40 ; Device data to return
+41 ;Get default width & page length p542
IF '+MARGINWIDTH
SET MARGINWIDTH=$GET(^%ZIS(2,+XSTYPE,1),"80^#^60^")
+42 IF RML>0
IF (+MARGINWIDTH<RML)!(+MARGINWIDTH>RMH)
QUIT
+43 SET DEVICENAME=$PIECE($GET(^%ZIS(1,DEVICEIEN,0)),U)
SET DISPLAYNAME=DEVICENAME
+44 if DEVICENAME'=SEARCHSTRING
SET DISPLAYNAME=SEARCHSTRING_" <"_DEVICENAME_">"
+45 SET FOUNDCNT=FOUNDCNT+1
SET RETURN(FOUNDCNT)=DEVICEIEN_U_DEVICENAME_U_DISPLAYNAME_U_$PIECE($GET(^%ZIS(1,DEVICEIEN,1)),U)_U_$PIECE(MARGINWIDTH,U)_U_$PIECE(MARGINWIDTH,U,3)
End DoDot:2
End DoDot:1
+46 QUIT
BLDOUTPUT(DEVICES,DEVLIST) ;
+1 SET DEV=0
FOR
SET DEV=$ORDER(DEVICES(DEV))
if 'DEV
QUIT
Begin DoDot:1
+2 SET DEVDAT=$GET(DEVICES(DEV))
+3 IF ($PIECE(DEVDAT,U,2)'[LOOKUP)
IF ($PIECE(DEVDAT,U,3)'[LOOKUP)
QUIT
+4 SET DEVLIST("Device",DEV,"ID")=$PIECE(DEVDAT,U)
+5 SET DEVLIST("Device",DEV,"Name")=$PIECE(DEVDAT,U,2)
+6 SET DEVLIST("Device",DEV,"DisplayName")=$PIECE(DEVDAT,U,3)
+7 SET DEVLIST("Device",DEV,"Location")=$PIECE(DEVDAT,U,4)
+8 SET DEVLIST("Device",DEV,"RightMargin")=$PIECE(DEVDAT,U,5)
+9 SET DEVLIST("Device",DEV,"PageLength")=$PIECE(DEVDAT,U,6)
End DoDot:1
+10 QUIT
