| 1 | LRPARAM ;SLC/CJS/DALISC/FHS - SET LAB PARAMETERS ;8/11/97
 | 
|---|
| 2 |  ;;5.2;LAB SERVICE;**98,121,153,201**;Sep 27, 1994
 | 
|---|
| 3 | INIT ;
 | 
|---|
| 4 |  S U="^" I '$D(ZTQUEUED) S IOP="HOME" D ^%ZIS
 | 
|---|
| 5 |  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
 | 
|---|
| 6 |  I '$D(DUZ(2)) W:'$D(ZTQUEUED) !,"SORRY ! You must have a site defined. (NO DUZ(2))" S LREND=1 Q
 | 
|---|
| 7 |  I 'DUZ(2) W:'$D(ZTQUEUED) !,"SORRY ! You must have a site defined. (NO DUZ(2))" S LREND=1 Q
 | 
|---|
| 8 | EN ;Entry point for external package calls - [Will not reset IO definitions]
 | 
|---|
| 9 |  N X,X1,X2,Y
 | 
|---|
| 10 |  K LRPARAM,LRDATA
 | 
|---|
| 11 |  D
 | 
|---|
| 12 |  . N X,DIK,DIC,%I,DICS,%DT
 | 
|---|
| 13 |  . D DT^DICRW
 | 
|---|
| 14 |  . S LRDT0=$$FMTE^XLFDT(DT,"5DZ")
 | 
|---|
| 15 |  S U="^",VA200="",LRPARAM=1_"^"_$P(^LAB(69.9,1,0),"^",2,255) S:'$D(DTIME) DTIME=300
 | 
|---|
| 16 |  ; LRPARAM("VR") is set to the version of lab installed at this site.
 | 
|---|
| 17 |  ;This variable can be used by other packages when interfacing with
 | 
|---|
| 18 |  ;laboratory routines (ie. OERR)
 | 
|---|
| 19 |  S LRPARAM("VR")=$G(^DD(63,0,"VR"))_U_$G(^DD(100,0,"VR"))_U_$G(^DG(43,1,"VERSION"))
 | 
|---|
| 20 |  D  ; Each Institution can have several associated divisions
 | 
|---|
| 21 |  . ; The divisions are used to control editing of clinical results
 | 
|---|
| 22 |  . ; performed by another instituion.
 | 
|---|
| 23 |  . N N,SITE
 | 
|---|
| 24 |  . S LRPARAM("ASITE",DUZ(2))="",N=$O(^LAB(69.9,1,99,"B",DUZ(2),0)) I N D
 | 
|---|
| 25 |  . . S SITE=0 F  S SITE=$O(^LAB(69.9,1,99,N,1,"B",SITE)) Q:SITE<1  S LRPARAM("ASITE",SITE)=""
 | 
|---|
| 26 |  S LRPCEVSO=$G(^LAB(69.9,1,"VSIT")) ;Indicates of PCE/VSIT is turned on
 | 
|---|
| 27 |  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)
 | 
|---|
| 28 |  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
 | 
|---|
| 29 | 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.
 | 
|---|
| 30 |  ;If DUZ is holder of LRVERIFY and LRLIAISON then the third piece is 1
 | 
|---|
| 31 |  ; The fourth 1 indicates if the user is allowed to edit Host results.
 | 
|---|
| 32 |  ; LRLABKY=1^1^1^1 INDICATES THIS USER HOLD ALL FOUR SECURITY KEYS
 | 
|---|
| 33 |  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
 | 
|---|
| 34 |  I $P($G(LRLABKY),U,2),$D(^XUSEC("LRLIASON",DUZ)) S $P(LRLABKY,U,3)=1
 | 
|---|
| 35 |  I $P($G(LRLABKY),U) S $P(LRLABKY,U,4)=1 D
 | 
|---|
| 36 |  . N LRDATA
 | 
|---|
| 37 |  . S I=+$O(^LAB(69.9,1,99,"B",+$G(DUZ(2)),0)) Q:I<1
 | 
|---|
| 38 |  . S LRDATA=$P($G(^DIC(19.1,+$P($G(^LAB(69.9,1,99,I,0)),U,2),0)),U)
 | 
|---|
| 39 |  . I $L(LRDATA),'$D(^XUSEC(LRDATA,DUZ)) S $P(LRLABKY,U,4)=0
 | 
|---|
| 40 |  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
 | 
|---|
| 41 |  . I '$$TM^%ZTLOAD W !!?7,"Taskman is not running ",!!,$C(7) Q
 | 
|---|
| 42 |  . I $P($G(^LAB(69.9,1,"RO")),U,2) Q
 | 
|---|
| 43 |  . N ZTSK S ZTRTN="LROLOVER",ZTIO="",ZTDTH=$H,ZTDESC="LAB ROLLOVER TASKED FROM ^LRPARAM" D ^%ZTLOAD K ZTRTN,ZTDTH,ZTDESC
 | 
|---|
| 44 |  . W:$D(ZTSK) !!?10," ROLLOVER HAS BEEN TASKED  --  TRY ACCESSIONING LATER ",!!,$C(7)
 | 
|---|
| 45 | VIDEO ;Get Video settings for reverse and blinking features
 | 
|---|
| 46 |  S LRVIDO="$C(91)",LRVIDOF="$C(93),$C(7)"
 | 
|---|
| 47 |  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)
 | 
|---|
| 48 |  Q
 | 
|---|
| 49 | VR() ;Return current version of Laboratory Package installed
 | 
|---|
| 50 |  ;Other packages may call this line to determine version of lab loaded.
 | 
|---|
| 51 |  ;No integration agreement required.
 | 
|---|
| 52 |  Q $G(^DD(60,0,"VR"))
 | 
|---|