Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LROR1

LROR1.m

Go to the documentation of this file.
  1. LROR1 ;SLC/DCM - LAB MODULE FOR OR (CONT.) ;8/11/97
  1. ;;5.2;LAB SERVICE;**100,121,128,230**;Sep 27, 1994
  1. STAT ;;Entry point for OR lab status
  1. I $$VER^LR7OU1>2.5 Q ;Not valid with OE/RR 3.0
  1. Q:'ORPK
  1. S LREND=0,LRODT=+ORPK,LRSN=$P(ORPK,"^",2),LRTN=$P(ORPK,"^",3)
  1. I 'LRODT!('LRSN)!('LRTN) G END
  1. S LRDFN=$$LRDFN^LR7OR1(+ORVP,$P(ORVP,";",2))
  1. G:'LRDFN END
  1. S LRLAB=$S($D(^XUSEC("LRLAB",DUZ)):1,1:0)
  1. K D,LRTT
  1. G:'$D(^LRO(69,LRODT,1,LRSN,0)) END
  1. S LROD0=^LRO(69,LRODT,1,LRSN,0),LROD1=$S($D(^(1)):^(1),1:""),LROD3=$S($D(^(3)):^(3),1:""),LRORD=^(.1)
  1. S I=0 F S I=$O(^LRO(69,LRODT,1,LRSN,6,I)) Q:I<1 W !?5,": "_^(I,0)
  1. 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
  1. G:'$D(LRAAO) END G:LRAAO<.1 END
  1. S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3)
  1. D PT^LRX,^LROR2
  1. 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
  1. 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
  1. K LRCAPLOC,LRCOM,LRJ,LRMX,LRNOW,LRODTSV,LRORN,LRSNSV,LRTNSV,LRURINE,LRXST,LRMA,KK,N,X1,X2,X3,Z1,X2,Z
  1. Q
  1. RES K ^TMP("LR",$J,"TP") S LRHF=1,LRFOOT=0,LRCW=8,LRORD(1)=LRSN,LRSORD=LRORD
  1. Q:+LROD0'=LRDFN
  1. K S,LRAAO
  1. S X=LRACN0
  1. D DATA^LRRP
  1. K S
  1. S LRORD=LRSORD
  1. Q
  1. COMB ;
  1. N LRACN
  1. S LRSAV=LRODT_"^"_LRSN_"^"_LRZ
  1. 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
  1. S LREND=0,LRSS=$P(^LAB(60,+X,0),"^",4),LRACN0=X,LRACN=LRTN
  1. D TEST^LROS:LRSS'="MI",RES
  1. S LRODT=+LRSAV,LRSN=$P(LRSAV,"^",2),LRZ=$P(LRSAV,"^",3)
  1. Q
  1. C1 Q:'$D(^LRO(69,J,1,K,2))
  1. 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
  1. Q
  1. FAST ;Go directly to results
  1. I $$VER^LR7OU1>2.5 Q ;Not valid with OE/RR 3.0
  1. Q:'$G(XQADATA)
  1. S ORVP=$P(XQA1,",",2)_";DPT(",DFN=$P(ORVP,";",1),LRDFN=$$LRDFN^LR7OR1(DFN)
  1. Q:'LRDFN
  1. D PT^LRX,READ^ORUTL
  1. W @IOF,PNM_" "_SSN
  1. S ORPK=$P(XQADATA,"^",1,3),ORIFN=$P(XQADATA,"^",4)
  1. Q:'ORIFN
  1. D STAT,READ^ORUTL
  1. I $D(^OR(100,"AN",ORVP,+$P(XQAID,",",3))) S ORNOTIF=+$P(XQAID,",",3) D CLEAN K XQAKILL
  1. Q
  1. ORN(ON) ;Check if OE/RR-Lab is on
  1. N ON,X
  1. S ON=0,X=$O(^DIC(9.4,"C","LR",0))
  1. S:'X X=$O(^DIC(9.4,"C","LRX",0))
  1. 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
  1. Q ON
  1. CLEAN ;
  1. N CHK
  1. S CHK=0
  1. 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
  1. . N X,Y S X=I,Y=N,CHK=1 N N,D,I D NOTIF^ORX8(X,Y)
  1. K ORTIT
  1. Q:CHK
  1. I $D(XQAID) D DELETE^XQALERT Q
  1. I '$D(XQAID) S XQAID=$P(^ORD(100.9,N,0),"^",2)_","_$P(ORVP,";")_","_N D DELETEA^XQALERT Q
  1. Q