LROR1 ;SLC/DCM - LAB MODULE FOR OR (CONT.) ;8/11/97 [ 04/14/2003 10:59 AM ]
;;5.2T9;LR;**1002,1003,1018**;Nov 17, 2004
;;5.2;LAB SERVICE;**100,121,128,230**;Sep 27, 1994
STAT ;;Entry point for OR lab status
I $$VER^LR7OU1>2.5 Q ;Not valid with OE/RR 3.0
Q:'ORPK
S LREND=0,LRODT=+ORPK,LRSN=$P(ORPK,"^",2),LRTN=$P(ORPK,"^",3)
I 'LRODT!('LRSN)!('LRTN) G END
S LRDFN=$$LRDFN^LR7OR1(+ORVP,$P(ORVP,";",2))
G:'LRDFN END
S LRLAB=$S($D(^XUSEC("LRLAB",DUZ)):1,1:0)
K D,LRTT
G:'$D(^LRO(69,LRODT,1,LRSN,0)) END
S LROD0=^LRO(69,LRODT,1,LRSN,0),LROD1=$S($D(^(1)):^(1),1:""),LROD3=$S($D(^(3)):^(3),1:""),LRORD=^(.1)
S I=0 F S I=$O(^LRO(69,LRODT,1,LRSN,6,I)) Q:I<1 W !?5,": "_^(I,0)
I $D(^LRO(69,LRODT,1,LRSN,2,LRTN,0))#2 S LRZ=0 F S LRZ=$O(^LRO(69,LRODT,1,LRSN,2,LRZ)) Q:LRZ<1 S X=^(LRZ,0) I $P(X,"^",7)=ORIFN D COMB
G:'$D(LRAAO) END G:LRAAO<.1 END
S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3)
D PT^LRX,^LROR2
END K LRO,LRAA,LRAAO,LRACC,LRACN,LRACN0,LRAD,LRAN,LRBLOOD,LRC,LRCDT,LRCMNT,LRCW,LRDATA,LRDFN,LRDN,LRDOC,LRDPF,LRDTO,LREND,LRFFLG,LRFOOT,LRHF,LRHI,LRIDT,LRJJ,LRLL,LRLLT,LRLLO,LROC,LROD0,LROD1,LROD3,LROOS,LROP,LRORDER,LRORD,LRODT,LRSN
K LRECUR,LRINTP,LRLO,LROS,LRSAV,LRSX,LROSD,LROT,LRPANEL,LRPARAM,LRPC,LRPLASMA,LRPO,LRROD,LRSERUM,LRSORD,LRSPEC,LRSS,LRSTOP,LRSUB,LRTC,LRTEST,LRTHER,LRTM60,LRTSCRN,LRTSTS,LRTT,LRUNKNOW,LRWRD,LR0,LRACD,LRDT0,LRLAB,LRPG,LRSB,LRTN,LRURG,LRZ
K LRCAPLOC,LRCOM,LRJ,LRMX,LRNOW,LRODTSV,LRORN,LRSNSV,LRTNSV,LRURINE,LRXST,LRMA,KK,N,X1,X2,X3,Z1,X2,Z
Q
RES K ^TMP("LR",$J,"TP") S LRHF=1,LRFOOT=0,LRCW=8,LRORD(1)=LRSN,LRSORD=LRORD
Q:+LROD0'=LRDFN
K S,LRAAO
S X=LRACN0
D DATA^LRRP
K S
S LRORD=LRSORD
Q
COMB ;
N LRACN
S LRSAV=LRODT_"^"_LRSN_"^"_LRZ
I $P(X,"^",6) S J=0 F Q:LREND S J=$O(^LRO(69,"C",$P(X,"^",6),J)) Q:'J S K=0 F S K=$O(^LRO(69,"C",$P(X,"^",6),J,K)) Q:'K D C1 Q:LREND
S LREND=0,LRSS=$P(^LAB(60,+X,0),"^",4),LRACN0=X,LRACN=LRTN
D TEST^LROS:LRSS'="MI",RES
S LRODT=+LRSAV,LRSN=$P(LRSAV,"^",2),LRZ=$P(LRSAV,"^",3)
Q
C1 Q:'$D(^LRO(69,J,1,K,2))
S L=0 F S L=$O(^LRO(69,J,1,K,2,L)) Q:L<1 I +^(L,0)=+X,$P(^(0),"^",7)=$P(X,"^",7) S X=^(0),LRODT=J,LRSN=K,LRZ=L,LREND=1 Q
Q
FAST ;Go directly to results
I $$VER^LR7OU1>2.5 Q ;Not valid with OE/RR 3.0
Q:'$G(XQADATA)
S ORVP=$P(XQA1,",",2)_";DPT(",DFN=$P(ORVP,";",1),LRDFN=$$LRDFN^LR7OR1(DFN)
Q:'LRDFN
D PT^LRX,READ^ORUTL
W @IOF,PNM_" "_SSN
S ORPK=$P(XQADATA,"^",1,3),ORIFN=$P(XQADATA,"^",4)
Q:'ORIFN
D STAT,READ^ORUTL
I $D(^OR(100,"AN",ORVP,+$P(XQAID,",",3))) S ORNOTIF=+$P(XQAID,",",3) D CLEAN K XQAKILL
Q
ORN(ON) ;Check if OE/RR-Lab is on
N ON,X
S ON=0,X=$O(^DIC(9.4,"C","LR",0))
S:'X X=$O(^DIC(9.4,"C","LRX",0))
I X,$P($G(^ORD(100.99,1,20,X,0)),"^",2)!($P($G(^ORD(100.99,1,5,X,0)),"^",3)) S ON=1
Q ON
CLEAN ;
N CHK
S CHK=0
I $D(ORNOTIF) S N=+ORNOTIF Q:N<1 S D=0 F S D=$O(^OR(100,"AN",ORVP,N,D)) Q:D<1 S I=0 F S I=$O(^OR(100,"AN",ORVP,N,D,I)) Q:I<1 I I=ORIFN D
. ;BEGIN IHS MODIFICATIONS LR*5.2*1018
. N X,Y S X=I,Y=N,CHK=1 N N,D,I D NOTIF^ORX8(X,Y)
. ;END IHS MODIFICATIONS
.;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
.;REMOVE OLD IHS LINE
. ;N X,Y S X=I,Y=N,CHK=1 N N,D,I ;IHS/DIR TUC/AAB 06/15/98
.;----- END IHS MODIFICATIONS
K ORTIT
Q:CHK
I $D(XQAID) D DELETE^XQALERT Q
I '$D(XQAID) S XQAID=$P(^ORD(100.9,N,0),"^",2)_","_$P(ORVP,";")_","_N D DELETEA^XQALERT Q
Q
LROR1 ;SLC/DCM - LAB MODULE FOR OR (CONT.) ;8/11/97 [ 04/14/2003 10:59 AM ]
+1 ;;5.2T9;LR;**1002,1003,1018**;Nov 17, 2004
+2 ;;5.2;LAB SERVICE;**100,121,128,230**;Sep 27, 1994
STAT ;;Entry point for OR lab status
+1 ;Not valid with OE/RR 3.0
IF $$VER^LR7OU1>2.5
QUIT
+2 IF 'ORPK
QUIT
+3 SET LREND=0
SET LRODT=+ORPK
SET LRSN=$PIECE(ORPK,"^",2)
SET LRTN=$PIECE(ORPK,"^",3)
+4 IF 'LRODT!('LRSN)!('LRTN)
GOTO END
+5 SET LRDFN=$$LRDFN^LR7OR1(+ORVP,$PIECE(ORVP,";",2))
+6 IF 'LRDFN
GOTO END
+7 SET LRLAB=$SELECT($DATA(^XUSEC("LRLAB",DUZ)):1,1:0)
+8 KILL D,LRTT
+9 IF '$DATA(^LRO(69,LRODT,1,LRSN,0))
GOTO END
+10 SET LROD0=^LRO(69,LRODT,1,LRSN,0)
SET LROD1=$SELECT($DATA(^(1)):^(1),1:"")
SET LROD3=$SELECT($DATA(^(3)):^(3),1:"")
SET LRORD=^(.1)
+11 SET I=0
FOR
SET I=$ORDER(^LRO(69,LRODT,1,LRSN,6,I))
IF I<1
QUIT
WRITE !?5,": "_^(I,0)
+12 IF $DATA(^LRO(69,LRODT,1,LRSN,2,LRTN,0))#2
SET LRZ=0
FOR
SET LRZ=$ORDER(^LRO(69,LRODT,1,LRSN,2,LRZ))
IF LRZ<1
QUIT
SET X=^(LRZ,0)
IF $PIECE(X,"^",7)=ORIFN
DO COMB
+13 IF '$DATA(LRAAO)
GOTO END
IF LRAAO<.1
GOTO END
+14 SET LRDPF=$PIECE(^LR(LRDFN,0),U,2)
SET DFN=$PIECE(^(0),U,3)
+15 DO PT^LRX
DO ^LROR2
END KILL LRO,LRAA,LRAAO,LRACC,LRACN,LRACN0,LRAD,LRAN,LRBLOOD,LRC,LRCDT,LRCMNT,LRCW,LRDATA,LRDFN,LRDN,LRDOC,LRDPF,LRDTO,LREND,LRFFLG,LRFOOT,LRHF,LRHI,LRIDT,LRJJ,LRLL,LRLLT,LRLLO,LROC,LROD0,LROD1,LROD3,LROOS,LROP,LRORDER,LRORD,LRODT,LRSN
+1 KILL LRECUR,LRINTP,LRLO,LROS,LRSAV,LRSX,LROSD,LROT,LRPANEL,LRPARAM,LRPC,LRPLASMA,LRPO,LRROD,LRSERUM,LRSORD,LRSPEC,LRSS,LRSTOP,LRSUB,LRTC,LRTEST,LRTHER,LRTM60,LRTSCRN,LRTSTS,LRTT,LRUNKNOW,LRWRD,LR0,LRACD,LRDT0,LRLAB,LRPG,LRSB,LRTN,LRURG,LRZ
+2 KILL LRCAPLOC,LRCOM,LRJ,LRMX,LRNOW,LRODTSV,LRORN,LRSNSV,LRTNSV,LRURINE,LRXST,LRMA,KK,N,X1,X2,X3,Z1,X2,Z
+3 QUIT
RES KILL ^TMP("LR",$JOB,"TP")
SET LRHF=1
SET LRFOOT=0
SET LRCW=8
SET LRORD(1)=LRSN
SET LRSORD=LRORD
+1 IF +LROD0'=LRDFN
QUIT
+2 KILL S,LRAAO
+3 SET X=LRACN0
+4 DO DATA^LRRP
+5 KILL S
+6 SET LRORD=LRSORD
+7 QUIT
COMB ;
+1 NEW LRACN
+2 SET LRSAV=LRODT_"^"_LRSN_"^"_LRZ
+3 IF $PIECE(X,"^",6)
SET J=0
FOR
IF LREND
QUIT
SET J=$ORDER(^LRO(69,"C",$PIECE(X,"^",6),J))
IF 'J
QUIT
SET K=0
FOR
SET K=$ORDER(^LRO(69,"C",$PIECE(X,"^",6),J,K))
IF 'K
QUIT
DO C1
IF LREND
QUIT
+4 SET LREND=0
SET LRSS=$PIECE(^LAB(60,+X,0),"^",4)
SET LRACN0=X
SET LRACN=LRTN
+5 IF LRSS'="MI"
DO TEST^LROS
DO RES
+6 SET LRODT=+LRSAV
SET LRSN=$PIECE(LRSAV,"^",2)
SET LRZ=$PIECE(LRSAV,"^",3)
+7 QUIT
C1 IF '$DATA(^LRO(69,J,1,K,2))
QUIT
+1 SET L=0
FOR
SET L=$ORDER(^LRO(69,J,1,K,2,L))
IF L<1
QUIT
IF +^(L,0)=+X
IF $PIECE(^(0),"^",7)=$PIECE(X,"^",7)
SET X=^(0)
SET LRODT=J
SET LRSN=K
SET LRZ=L
SET LREND=1
QUIT
+2 QUIT
FAST ;Go directly to results
+1 ;Not valid with OE/RR 3.0
IF $$VER^LR7OU1>2.5
QUIT
+2 IF '$GET(XQADATA)
QUIT
+3 SET ORVP=$PIECE(XQA1,",",2)_";DPT("
SET DFN=$PIECE(ORVP,";",1)
SET LRDFN=$$LRDFN^LR7OR1(DFN)
+4 IF 'LRDFN
QUIT
+5 DO PT^LRX
DO READ^ORUTL
+6 WRITE @IOF,PNM_" "_SSN
+7 SET ORPK=$PIECE(XQADATA,"^",1,3)
SET ORIFN=$PIECE(XQADATA,"^",4)
+8 IF 'ORIFN
QUIT
+9 DO STAT
DO READ^ORUTL
+10 IF $DATA(^OR(100,"AN",ORVP,+$PIECE(XQAID,",",3)))
SET ORNOTIF=+$PIECE(XQAID,",",3)
DO CLEAN
KILL XQAKILL
+11 QUIT
ORN(ON) ;Check if OE/RR-Lab is on
+1 NEW ON,X
+2 SET ON=0
SET X=$ORDER(^DIC(9.4,"C","LR",0))
+3 IF 'X
SET X=$ORDER(^DIC(9.4,"C","LRX",0))
+4 IF X
IF $PIECE($GET(^ORD(100.99,1,20,X,0)),"^",2)!($PIECE($GET(^ORD(100.99,1,5,X,0)),"^",3))
SET ON=1
+5 QUIT ON
CLEAN ;
+1 NEW CHK
+2 SET CHK=0
+3 IF $DATA(ORNOTIF)
SET N=+ORNOTIF
IF N<1
QUIT
SET D=0
FOR
SET D=$ORDER(^OR(100,"AN",ORVP,N,D))
IF D<1
QUIT
SET I=0
FOR
SET I=$ORDER(^OR(100,"AN",ORVP,N,D,I))
IF I<1
QUIT
IF I=ORIFN
Begin DoDot:1
+4 ;BEGIN IHS MODIFICATIONS LR*5.2*1018
+5 NEW X,Y
SET X=I
SET Y=N
SET CHK=1
NEW N,D,I
DO NOTIF^ORX8(X,Y)
+6 ;END IHS MODIFICATIONS
+7 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
+8 ;REMOVE OLD IHS LINE
+9 ;N X,Y S X=I,Y=N,CHK=1 N N,D,I ;IHS/DIR TUC/AAB 06/15/98
+10 ;----- END IHS MODIFICATIONS
End DoDot:1
+11 KILL ORTIT
+12 IF CHK
QUIT
+13 IF $DATA(XQAID)
DO DELETE^XQALERT
QUIT
+14 IF '$DATA(XQAID)
SET XQAID=$PIECE(^ORD(100.9,N,0),"^",2)_","_$PIECE(ORVP,";")_","_N
DO DELETEA^XQALERT
QUIT
+15 QUIT
