- LROR1 ;SLC/DCM - LAB MODULE FOR OR (CONT.) ;8/11/97
- ;;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
- . N X,Y S X=I,Y=N,CHK=1 N N,D,I D NOTIF^ORX8(X,Y)
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLROR1 3095 printed Feb 18, 2025@23:44:29 Page 2
- LROR1 ;SLC/DCM - LAB MODULE FOR OR (CONT.) ;8/11/97
- +1 ;;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 NEW X,Y
- SET X=I
- SET Y=N
- SET CHK=1
- NEW N,D,I
- DO NOTIF^ORX8(X,Y)
- End DoDot:1
- +5 KILL ORTIT
- +6 if CHK
- QUIT
- +7 IF $DATA(XQAID)
- DO DELETE^XQALERT
- QUIT
- +8 IF '$DATA(XQAID)
- SET XQAID=$PIECE(^ORD(100.9,N,0),"^",2)_","_$PIECE(ORVP,";")_","_N
- DO DELETEA^XQALERT
- QUIT
- +9 QUIT