LRPARAM ;SLC/CJS/DALISC/FHS - SET LAB PARAMETERS ;8/11/97
;;5.2;LAB SERVICE;**98,121,153,201**;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
EN ;Entry point for external package calls - [Will not reset IO definitions]
N X,X1,X2,Y
K LRPARAM,LRDATA
D
. N X,DIK,DIC,%I,DICS,%DT
. D DT^DICRW
. S LRDT0=$$FMTE^XLFDT(DT,"5DZ")
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"))
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)"
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"))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRPARAM 3550 printed Oct 16, 2024@18:20 Page 2
LRPARAM ;SLC/CJS/DALISC/FHS - SET LAB PARAMETERS ;8/11/97
+1 ;;5.2;LAB SERVICE;**98,121,153,201**;Sep 27, 1994
INIT ;
+1 SET U="^"
IF '$DATA(ZTQUEUED)
SET IOP="HOME"
DO ^%ZIS
+2 IF '$DATA(ZTQUEUED)
IF $SELECT('$DATA(DUZ(2)):1,'DUZ(2):1,1:0)
WRITE !,"SORRY ! You must have a site defined. (NO DUZ(2))"
SET LREND=1
QUIT
+3 IF '$DATA(DUZ(2))
if '$DATA(ZTQUEUED)
WRITE !,"SORRY ! You must have a site defined. (NO DUZ(2))"
SET LREND=1
QUIT
+4 IF 'DUZ(2)
if '$DATA(ZTQUEUED)
WRITE !,"SORRY ! You must have a site defined. (NO DUZ(2))"
SET LREND=1
QUIT
EN ;Entry point for external package calls - [Will not reset IO definitions]
+1 NEW X,X1,X2,Y
+2 KILL LRPARAM,LRDATA
+3 Begin DoDot:1
+4 NEW X,DIK,DIC,%I,DICS,%DT
+5 DO DT^DICRW
+6 SET LRDT0=$$FMTE^XLFDT(DT,"5DZ")
End DoDot:1
+7 SET U="^"
SET VA200=""
SET LRPARAM=1_"^"_$PIECE(^LAB(69.9,1,0),"^",2,255)
if '$DATA(DTIME)
SET DTIME=300
+8 ; LRPARAM("VR") is set to the version of lab installed at this site.
+9 ;This variable can be used by other packages when interfacing with
+10 ;laboratory routines (ie. OERR)
+11 SET LRPARAM("VR")=$GET(^DD(63,0,"VR"))_U_$GET(^DD(100,0,"VR"))_U_$GET(^DG(43,1,"VERSION"))
+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 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)
+3 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"))
