- 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"))
