LRPARAM ;SLC/CJS/DALISC/MKK - SET LAB PARAMETERS ;8/11/97 [ 04/08/2003 10:18 AM ]
;;5.2;LR;**1011,1013,1015,1018,1019**;MAR 25, 2005
;;5.2;LAB SERVICE;**98,121,153**;Sep 27, 1994
INIT ;
;S U="^" I '$D(ZTQUEUED) S IOP="HOME" D ^%ZIS
;I '$D(ZTQUEUED),$S('$D(DUZ(2)):1,'DUZ(2):1,1:0) W !,"SORRY ! You must have a site defined. (NO DUZ(2))" S LREND=1 Q
;I '$D(DUZ(2)) W:'$D(ZTQUEUED) !,"SORRY ! You must have a site defined. (NO DUZ(2))" S LREND=1 Q
;I 'DUZ(2) W:'$D(ZTQUEUED) !,"SORRY ! You must have a site defined. (NO DUZ(2))" S LREND=1 Q
;----- BEGIN IHS MODIFICATION LR*5.2*1018
S U="^"
I '$G(BLRGUI) S LREND=0 D Q:$G(LREND)
.I '$D(ZTQUEUED) S IOP="HOME" D ^%ZIS
.I '$G(DUZ(2)) W:'$D(ZTQUEUED) !,"SORRY ! You must have a site defined. (NO DUZ(2))" S LREND=1 Q
S BLRQSITE=$P(^AUTTSITE(1,0),U,1),BLRLOG=$G(^BLRSITE(BLRQSITE,0)),BLRPCC=$P(BLRLOG,U,3),BLRSTOP=$P(BLRLOG,U,9),BLRLOG=$P(BLRLOG,U,2) ;IHS/DIR/MJL 11/9/99
I BLRLOG,'BLRSTOP D JOB^BLRPARAM
;----- END IHS MODIFICATION
EN ;Entry point for external package calls - [Will not reset IO definitions]
N X,X1,X2,Y
K LRPARAM,LRDATA
D DT^LRX S U="^",VA200="",LRPARAM=1_"^"_$P(^LAB(69.9,1,0),"^",2,255) S:'$D(DTIME) DTIME=300
; LRPARAM("VR") is set to the version of lab installed at this site.
;This variable can be used by other packages when interfacing with
;laboratory routines (ie. OERR)
S LRPARAM("VR")=$G(^DD(63,0,"VR"))_U_$G(^DD(100,0,"VR"))_U_$G(^DG(43,1,"VERSION"))
;----- BEGIN IHS MODIFICATION LR*5.2*1018
S LRDAHEAD=$P($G(^LAB(69.9,1,9999999)),U,2) ;IHS/ITSC/TPF 11/18/02 MOVE FIELD TO IHS NUMBERED FIELD **1015**
S:LRDAHEAD="" LRDAHEAD=366 ;IHS/ITSC/TPF 06/06/02 DEFAULT ORDER AHEAD **1013**
;----- END IHS MODIFICATION
D ; Each Institution can have several associated divisions
. ; The divisions are used to control editing of clinical results
. ; performed by another instituion.
. N N,SITE
. S LRPARAM("ASITE",DUZ(2))="",N=$O(^LAB(69.9,1,99,"B",DUZ(2),0)) I N D
. . S SITE=0 F S SITE=$O(^LAB(69.9,1,99,N,1,"B",SITE)) Q:SITE<1 S LRPARAM("ASITE",SITE)=""
S LRPCEVSO=$G(^LAB(69.9,1,"VSIT")) ;Indicates of PCE/VSIT is turned on
S X=^LAB(69.9,1,1),LRBLOOD=$P(X,"^",1),LRURINE=$P(X,"^",2),LRSERUM=$P(X,"^",3),LRPLASMA=$P(X,"^",4),LRUNKNOW=$P(X,"^",5)
I $D(^LRO(69,DT,0))[0 S ^(0)=DT,^LRO(69,"B",DT,DT)="",X=$P(^LRO(69,0),U,3,4),X1=($P(X,U)+1),X2=($P(X,U,2)+1),$P(^LRO(69,0),U,3)=X1,$P(^(0),U,4)=X2 K X1,X2
LABKEY ;If DUZ is a LRLAB or LRVERIFY Key holder then LRLABKY is defined. The 1st piece of LRLABKY IS 1 IF DUZ has the LRVERIFY key and the 2nd piece = LRSUPER key.
;If DUZ is holder of LRVERIFY and LRLIAISON then the third piece is 1
; The fourth 1 indicates if the user is allowed to edit Host results.
; LRLABKY=1^1^1^1 INDICATES THIS USER HOLD ALL FOUR SECURITY KEYS
K LRLABKY I $G(DUZ),$D(^XUSEC("LRLAB",DUZ))!($D(^XUSEC("LRVERIFY",DUZ))) S LRLABKY="" S:$D(^XUSEC("LRVERIFY",DUZ)) $P(LRLABKY,U)=1 S:$D(^XUSEC("LRSUPER",DUZ)) $P(LRLABKY,U,2)=1
I $P($G(LRLABKY),U,2),$D(^XUSEC("LRLIASON",DUZ)) S $P(LRLABKY,U,3)=1
I $P($G(LRLABKY),U) S $P(LRLABKY,U,4)=1 D
. N LRDATA
. S I=+$O(^LAB(69.9,1,99,"B",+$G(DUZ(2)),0)) Q:I<1
. S LRDATA=$P($G(^DIC(19.1,+$P($G(^LAB(69.9,1,99,I,0)),U,2),0)),U)
. I $L(LRDATA),'$D(^XUSEC(LRDATA,DUZ)) S $P(LRLABKY,U,4)=0
I $D(LRLABKY),$D(^LAB(69.9,1,"RO")),+$H'=+^("RO") W $C(7),!,"ROLLOVER ",$S($P(^("RO"),U,2):"IS RUNNING.",1:"HAS NOT RUN.")," ACCESSIONING SHOULDN'T BE DONE NOW.",$C(7) D
. I '$$TM^%ZTLOAD W !!?7,"Taskman is not running ",!!,$C(7) Q
. I $P($G(^LAB(69.9,1,"RO")),U,2) Q
. N ZTSK S ZTRTN="LROLOVER",ZTIO="",ZTDTH=$H,ZTDESC="LAB ROLLOVER TASKED FROM ^LRPARAM" D ^%ZTLOAD K ZTRTN,ZTDTH,ZTDESC
. W:$D(ZTSK) !!?10," ROLLOVER HAS BEEN TASKED -- TRY ACCESSIONING LATER ",!!,$C(7)
VIDEO ;Get Video settings for reverse and blinking features
S LRVIDO="$C(91)",LRVIDOF="$C(93),$C(7)"
;----- BEGIN IHS MODIFICATION LR*5.2*1019
; Snapshot accidently left "active"
; NEW SNAPSHOT
; S SNAPSHOT=1
; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER VIDEO^LRPARAM")
;----- END IHS MODIFICATION LR*5.2*1019
;
I $G(IOST(0)) S X=$G(^%ZIS(2,+IOST(0),5)) Q:'$L($P(X,U,4))!('$L($P(X,U,8)))!('$L($P(X,U,5)))!('$L($P(X,U,9))) S LRVIDO=$P(X,U,4)_","_$P(X,U,8),LRVIDOF=$P(X,U,5)_","_$P(X,U,9)
Q
VR() ;Return current version of Laboratory Package installed
;Other packages may call this line to determine version of lab loaded.
;No integration agreement required.
Q $G(^DD(60,0,"VR"))
LRPARAM ;SLC/CJS/DALISC/MKK - SET LAB PARAMETERS ;8/11/97 [ 04/08/2003 10:18 AM ]
+1 ;;5.2;LR;**1011,1013,1015,1018,1019**;MAR 25, 2005
+2 ;;5.2;LAB SERVICE;**98,121,153**;Sep 27, 1994
INIT ;
+1 ;S U="^" I '$D(ZTQUEUED) S IOP="HOME" D ^%ZIS
+2 ;I '$D(ZTQUEUED),$S('$D(DUZ(2)):1,'DUZ(2):1,1:0) W !,"SORRY ! You must have a site defined. (NO DUZ(2))" S LREND=1 Q
+3 ;I '$D(DUZ(2)) W:'$D(ZTQUEUED) !,"SORRY ! You must have a site defined. (NO DUZ(2))" S LREND=1 Q
+4 ;I 'DUZ(2) W:'$D(ZTQUEUED) !,"SORRY ! You must have a site defined. (NO DUZ(2))" S LREND=1 Q
+5 ;----- BEGIN IHS MODIFICATION LR*5.2*1018
+6 SET U="^"
+7 IF '$GET(BLRGUI)
SET LREND=0
Begin DoDot:1
+8 IF '$DATA(ZTQUEUED)
SET IOP="HOME"
DO ^%ZIS
+9 IF '$GET(DUZ(2))
IF '$DATA(ZTQUEUED)
WRITE !,"SORRY ! You must have a site defined. (NO DUZ(2))"
SET LREND=1
QUIT
End DoDot:1
IF $GET(LREND)
QUIT
+10 ;IHS/DIR/MJL 11/9/99
SET BLRQSITE=$PIECE(^AUTTSITE(1,0),U,1)
SET BLRLOG=$GET(^BLRSITE(BLRQSITE,0))
SET BLRPCC=$PIECE(BLRLOG,U,3)
SET BLRSTOP=$PIECE(BLRLOG,U,9)
SET BLRLOG=$PIECE(BLRLOG,U,2)
+11 IF BLRLOG
IF 'BLRSTOP
DO JOB^BLRPARAM
+12 ;----- END IHS MODIFICATION
EN ;Entry point for external package calls - [Will not reset IO definitions]
+1 NEW X,X1,X2,Y
+2 KILL LRPARAM,LRDATA
+3 DO DT^LRX
SET U="^"
SET VA200=""
SET LRPARAM=1_"^"_$PIECE(^LAB(69.9,1,0),"^",2,255)
IF '$DATA(DTIME)
SET DTIME=300
+4 ; LRPARAM("VR") is set to the version of lab installed at this site.
+5 ;This variable can be used by other packages when interfacing with
+6 ;laboratory routines (ie. OERR)
+7 SET LRPARAM("VR")=$GET(^DD(63,0,"VR"))_U_$GET(^DD(100,0,"VR"))_U_$GET(^DG(43,1,"VERSION"))
+8 ;----- BEGIN IHS MODIFICATION LR*5.2*1018
+9 ;IHS/ITSC/TPF 11/18/02 MOVE FIELD TO IHS NUMBERED FIELD **1015**
SET LRDAHEAD=$PIECE($GET(^LAB(69.9,1,9999999)),U,2)
+10 ;IHS/ITSC/TPF 06/06/02 DEFAULT ORDER AHEAD **1013**
IF LRDAHEAD=""
SET LRDAHEAD=366
+11 ;----- END IHS MODIFICATION
+12 ; Each Institution can have several associated divisions
Begin DoDot:1
+13 ; The divisions are used to control editing of clinical results
+14 ; performed by another instituion.
+15 NEW N,SITE
+16 SET LRPARAM("ASITE",DUZ(2))=""
SET N=$ORDER(^LAB(69.9,1,99,"B",DUZ(2),0))
IF N
Begin DoDot:2
+17 SET SITE=0
FOR
SET SITE=$ORDER(^LAB(69.9,1,99,N,1,"B",SITE))
IF SITE<1
QUIT
SET LRPARAM("ASITE",SITE)=""
End DoDot:2
End DoDot:1
+18 ;Indicates of PCE/VSIT is turned on
SET LRPCEVSO=$GET(^LAB(69.9,1,"VSIT"))
+19 SET X=^LAB(69.9,1,1)
SET LRBLOOD=$PIECE(X,"^",1)
SET LRURINE=$PIECE(X,"^",2)
SET LRSERUM=$PIECE(X,"^",3)
SET LRPLASMA=$PIECE(X,"^",4)
SET LRUNKNOW=$PIECE(X,"^",5)
+20 IF $DATA(^LRO(69,DT,0))[0
SET ^(0)=DT
SET ^LRO(69,"B",DT,DT)=""
SET X=$PIECE(^LRO(69,0),U,3,4)
SET X1=($PIECE(X,U)+1)
SET X2=($PIECE(X,U,2)+1)
SET $PIECE(^LRO(69,0),U,3)=X1
SET $PIECE(^(0),U,4)=X2
KILL X1,X2
LABKEY ;If DUZ is a LRLAB or LRVERIFY Key holder then LRLABKY is defined. The 1st piece of LRLABKY IS 1 IF DUZ has the LRVERIFY key and the 2nd piece = LRSUPER key.
+1 ;If DUZ is holder of LRVERIFY and LRLIAISON then the third piece is 1
+2 ; The fourth 1 indicates if the user is allowed to edit Host results.
+3 ; LRLABKY=1^1^1^1 INDICATES THIS USER HOLD ALL FOUR SECURITY KEYS
+4 KILL LRLABKY
IF $GET(DUZ)
IF $DATA(^XUSEC("LRLAB",DUZ))!($DATA(^XUSEC("LRVERIFY",DUZ)))
SET LRLABKY=""
IF $DATA(^XUSEC("LRVERIFY",DUZ))
SET $PIECE(LRLABKY,U)=1
IF $DATA(^XUSEC("LRSUPER",DUZ))
SET $PIECE(LRLABKY,U,2)=1
+5 IF $PIECE($GET(LRLABKY),U,2)
IF $DATA(^XUSEC("LRLIASON",DUZ))
SET $PIECE(LRLABKY,U,3)=1
+6 IF $PIECE($GET(LRLABKY),U)
SET $PIECE(LRLABKY,U,4)=1
Begin DoDot:1
+7 NEW LRDATA
+8 SET I=+$ORDER(^LAB(69.9,1,99,"B",+$GET(DUZ(2)),0))
IF I<1
QUIT
+9 SET LRDATA=$PIECE($GET(^DIC(19.1,+$PIECE($GET(^LAB(69.9,1,99,I,0)),U,2),0)),U)
+10 IF $LENGTH(LRDATA)
IF '$DATA(^XUSEC(LRDATA,DUZ))
SET $PIECE(LRLABKY,U,4)=0
End DoDot:1
+11 IF $DATA(LRLABKY)
IF $DATA(^LAB(69.9,1,"RO"))
IF +$HOROLOG'=+^("RO")
WRITE $CHAR(7),!,"ROLLOVER ",$SELECT($PIECE(^("RO"),U,2):"IS RUNNING.",1:"HAS NOT RUN.")," ACCESSIONING SHOULDN'T BE DONE NOW.",$CHAR(7)
Begin DoDot:1
+12 IF '$$TM^%ZTLOAD
WRITE !!?7,"Taskman is not running ",!!,$CHAR(7)
QUIT
+13 IF $PIECE($GET(^LAB(69.9,1,"RO")),U,2)
QUIT
+14 NEW ZTSK
SET ZTRTN="LROLOVER"
SET ZTIO=""
SET ZTDTH=$HOROLOG
SET ZTDESC="LAB ROLLOVER TASKED FROM ^LRPARAM"
DO ^%ZTLOAD
KILL ZTRTN,ZTDTH,ZTDESC
+15 IF $DATA(ZTSK)
WRITE !!?10," ROLLOVER HAS BEEN TASKED -- TRY ACCESSIONING LATER ",!!,$CHAR(7)
End DoDot:1
VIDEO ;Get Video settings for reverse and blinking features
+1 SET LRVIDO="$C(91)"
SET LRVIDOF="$C(93),$C(7)"
+2 ;----- BEGIN IHS MODIFICATION LR*5.2*1019
+3 ; Snapshot accidently left "active"
+4 ; NEW SNAPSHOT
+5 ; S SNAPSHOT=1
+6 ; D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTER VIDEO^LRPARAM")
+7 ;----- END IHS MODIFICATION LR*5.2*1019
+8 ;
+9 IF $GET(IOST(0))
SET X=$GET(^%ZIS(2,+IOST(0),5))
IF '$LENGTH($PIECE(X,U,4))!('$LENGTH($PIECE(X,U,8)))!('$LENGTH($PIECE(X,U,5)))!('$LENGTH($PIECE(X,U,9)))
QUIT
SET LRVIDO=$PIECE(X,U,4)_","_$PIECE(X,U,8)
SET LRVIDOF=$PIECE(X,U,5)_","_$PIECE(X,U,9)
+10 QUIT
VR() ;Return current version of Laboratory Package installed
+1 ;Other packages may call this line to determine version of lab loaded.
+2 ;No integration agreement required.
+3 QUIT $GET(^DD(60,0,"VR"))
