- 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
