BLRAG10 ; IHS/MSC/SAT - LABORATORY ACCESSION GUI RPCs ;
;;5.2;IHS LABORATORY;**1031**;NOV 01, 1997;Build 185
;
; See the BLRAG00 routine for a listing of LABORATORY ACCESSION GUI RPCs
;
DEVICE(BLRXY) ;EP List of printers
;BLR PRINTERS AVAILABLE
; OUTPUT:
; DEVICE_IEN ^ DEVICE_NAME
;
N BLRII,FROM,DIR
S BLRII=0
S BLRXY=$$TMPGLB^BLRAGUT()
S @BLRXY@(BLRII)="I00030PRINTER_IEN^T00040PRINTER_NAME"
N CNT,IEN,X,Y,X0,XLOC,XSEC,XTYPE,XSTYPE,XTIME,XOSD,MW,PL,DEV
S FROM="",DIR=1
F S FROM=$O(^%ZIS(1,"B",FROM),DIR),IEN=0 Q:FROM="" D
.F S IEN=$O(^%ZIS(1,"B",FROM,IEN)) Q:'IEN D
..S DEV="",X0=$G(^%ZIS(1,IEN,0)),XLOC=$P($G(^(1)),U),XOSD=+$G(^(90)),MW=$G(^(91)),XSEC=$G(^(95)),XSTYPE=+$G(^("SUBTYPE")),XTIME=$P($G(^("TIME")),U),XTYPE=$P($G(^("TYPE")),U)
..Q:$E($G(^%ZIS(2,XSTYPE,0)))'="P" ; Printers only
..Q:"^TRM^HG^CHAN^OTH^"'[(U_XTYPE_U)
..Q:$P(X0,U,2)="0"!($P(X0,U,12)=2) ; Queuing allowed
..I XOSD,XOSD'>DT Q ; Out of Service
..I $L(XTIME) D Q:'$L(XTIME) ; Prohibited Times
...S Y=$P($H,",",2),Y=Y\60#60+(Y\3600*100),X=$P(XTIME,"-",2)
...S:X'<XTIME&(Y'>X&(Y'<XTIME))!(X<XTIME&(Y'<XTIME!(Y'>X))) XTIME=""
..I $L(XSEC),$G(DUZ(0))'="@",$TR(XSEC,$G(DUZ(0)))=XSEC Q
..S PL=$P(MW,U,3),MW=$P(MW,U),X=$G(^%ZIS(2,XSTYPE,1))
..S:'MW MW=$P(X,U)
..S:'PL PL=$P(X,U,3)
..S X=$P(X0,U)
..Q:$E(X,1,4)["NULL"
..S:X'=FROM X=FROM_" <"_X_">"
..S BLRII=BLRII+1,@BLRXY@(BLRII)=IEN_U_$P(X0,U)
Q
;
RETDTA(RESULT) ; EP - Return Days To Accession XPAR Parameter
; RPC: BLR XPAR DAYS TO ACCESSION
;INPUT:
; None.
;
;RETURNS:
; Value of the BLR DAYS TO ACCESSION parameter, if it exists
; 0 if the parameter does not exist
;
NEW BLRDOM,BLRENT,BLRI,BLRPAR
;
S BLRDOM=$$GET1^DIQ(8989.3,"1,",.01,"I")
S BLRENT=BLRDOM_";"_"DIC(4.2,"
S BLRPAR=+$O(^XTV(8989.51,"B","BLR DAYS TO ACCESSION",0))
S RESULT=+$$GET^XPAR(BLRENT,BLRPAR,1,"Q")
Q
BLRAG10 ; IHS/MSC/SAT - LABORATORY ACCESSION GUI RPCs ;
+1 ;;5.2;IHS LABORATORY;**1031**;NOV 01, 1997;Build 185
+2 ;
+3 ; See the BLRAG00 routine for a listing of LABORATORY ACCESSION GUI RPCs
+4 ;
DEVICE(BLRXY) ;EP List of printers
+1 ;BLR PRINTERS AVAILABLE
+2 ; OUTPUT:
+3 ; DEVICE_IEN ^ DEVICE_NAME
+4 ;
+5 NEW BLRII,FROM,DIR
+6 SET BLRII=0
+7 SET BLRXY=$$TMPGLB^BLRAGUT()
+8 SET @BLRXY@(BLRII)="I00030PRINTER_IEN^T00040PRINTER_NAME"
+9 NEW CNT,IEN,X,Y,X0,XLOC,XSEC,XTYPE,XSTYPE,XTIME,XOSD,MW,PL,DEV
+10 SET FROM=""
SET DIR=1
+11 FOR
SET FROM=$ORDER(^%ZIS(1,"B",FROM),DIR)
SET IEN=0
IF FROM=""
QUIT
Begin DoDot:1
+12 FOR
SET IEN=$ORDER(^%ZIS(1,"B",FROM,IEN))
IF 'IEN
QUIT
Begin DoDot:2
+13 SET DEV=""
SET X0=$GET(^%ZIS(1,IEN,0))
SET XLOC=$PIECE($GET(^(1)),U)
SET XOSD=+$GET(^(90))
SET MW=$GET(^(91))
SET XSEC=$GET(^(95))
SET XSTYPE=+$GET(^("SUBTYPE"))
SET XTIME=$PIECE($GET(^("TIME")),U)
SET XTYPE=$PIECE($GET(^("TYPE")),U)
+14 ; Printers only
IF $EXTRACT($GET(^%ZIS(2,XSTYPE,0)))'="P"
QUIT
+15 IF "^TRM^HG^CHAN^OTH^"'[(U_XTYPE_U)
QUIT
+16 ; Queuing allowed
IF $PIECE(X0,U,2)="0"!($PIECE(X0,U,12)=2)
QUIT
+17 ; Out of Service
IF XOSD
IF XOSD'>DT
QUIT
+18 ; Prohibited Times
IF $LENGTH(XTIME)
Begin DoDot:3
+19 SET Y=$PIECE($HOROLOG,",",2)
SET Y=Y\60#60+(Y\3600*100)
SET X=$PIECE(XTIME,"-",2)
+20 IF X'<XTIME&(Y'>X&(Y'<XTIME))!(X<XTIME&(Y'<XTIME!(Y'>X)))
SET XTIME=""
End DoDot:3
IF '$LENGTH(XTIME)
QUIT
+21 IF $LENGTH(XSEC)
IF $GET(DUZ(0))'="@"
IF $TRANSLATE(XSEC,$GET(DUZ(0)))=XSEC
QUIT
+22 SET PL=$PIECE(MW,U,3)
SET MW=$PIECE(MW,U)
SET X=$GET(^%ZIS(2,XSTYPE,1))
+23 IF 'MW
SET MW=$PIECE(X,U)
+24 IF 'PL
SET PL=$PIECE(X,U,3)
+25 SET X=$PIECE(X0,U)
+26 IF $EXTRACT(X,1,4)["NULL"
QUIT
+27 IF X'=FROM
SET X=FROM_" <"_X_">"
+28 SET BLRII=BLRII+1
SET @BLRXY@(BLRII)=IEN_U_$PIECE(X0,U)
End DoDot:2
End DoDot:1
+29 QUIT
+30 ;
RETDTA(RESULT) ; EP - Return Days To Accession XPAR Parameter
+1 ; RPC: BLR XPAR DAYS TO ACCESSION
+2 ;INPUT:
+3 ; None.
+4 ;
+5 ;RETURNS:
+6 ; Value of the BLR DAYS TO ACCESSION parameter, if it exists
+7 ; 0 if the parameter does not exist
+8 ;
+9 NEW BLRDOM,BLRENT,BLRI,BLRPAR
+10 ;
+11 SET BLRDOM=$$GET1^DIQ(8989.3,"1,",.01,"I")
+12 SET BLRENT=BLRDOM_";"_"DIC(4.2,"
+13 SET BLRPAR=+$ORDER(^XTV(8989.51,"B","BLR DAYS TO ACCESSION",0))
+14 SET RESULT=+$$GET^XPAR(BLRENT,BLRPAR,1,"Q")
+15 QUIT
