source: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LROR1.m@ 636

Last change on this file since 636 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.0 KB
Line 
1LROR1 ;SLC/DCM - LAB MODULE FOR OR (CONT.) ;8/11/97
2 ;;5.2;LAB SERVICE;**100,121,128,230**;Sep 27, 1994
3STAT ;;Entry point for OR lab status
4 I $$VER^LR7OU1>2.5 Q ;Not valid with OE/RR 3.0
5 Q:'ORPK
6 S LREND=0,LRODT=+ORPK,LRSN=$P(ORPK,"^",2),LRTN=$P(ORPK,"^",3)
7 I 'LRODT!('LRSN)!('LRTN) G END
8 S LRDFN=$$LRDFN^LR7OR1(+ORVP,$P(ORVP,";",2))
9 G:'LRDFN END
10 S LRLAB=$S($D(^XUSEC("LRLAB",DUZ)):1,1:0)
11 K D,LRTT
12 G:'$D(^LRO(69,LRODT,1,LRSN,0)) END
13 S LROD0=^LRO(69,LRODT,1,LRSN,0),LROD1=$S($D(^(1)):^(1),1:""),LROD3=$S($D(^(3)):^(3),1:""),LRORD=^(.1)
14 S I=0 F S I=$O(^LRO(69,LRODT,1,LRSN,6,I)) Q:I<1 W !?5,": "_^(I,0)
15 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
16 G:'$D(LRAAO) END G:LRAAO<.1 END
17 S LRDPF=$P(^LR(LRDFN,0),U,2),DFN=$P(^(0),U,3)
18 D PT^LRX,^LROR2
19END 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
20 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
21 K LRCAPLOC,LRCOM,LRJ,LRMX,LRNOW,LRODTSV,LRORN,LRSNSV,LRTNSV,LRURINE,LRXST,LRMA,KK,N,X1,X2,X3,Z1,X2,Z
22 Q
23RES K ^TMP("LR",$J,"TP") S LRHF=1,LRFOOT=0,LRCW=8,LRORD(1)=LRSN,LRSORD=LRORD
24 Q:+LROD0'=LRDFN
25 K S,LRAAO
26 S X=LRACN0
27 D DATA^LRRP
28 K S
29 S LRORD=LRSORD
30 Q
31COMB ;
32 N LRACN
33 S LRSAV=LRODT_"^"_LRSN_"^"_LRZ
34 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
35 S LREND=0,LRSS=$P(^LAB(60,+X,0),"^",4),LRACN0=X,LRACN=LRTN
36 D TEST^LROS:LRSS'="MI",RES
37 S LRODT=+LRSAV,LRSN=$P(LRSAV,"^",2),LRZ=$P(LRSAV,"^",3)
38 Q
39C1 Q:'$D(^LRO(69,J,1,K,2))
40 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
41 Q
42FAST ;Go directly to results
43 I $$VER^LR7OU1>2.5 Q ;Not valid with OE/RR 3.0
44 Q:'$G(XQADATA)
45 S ORVP=$P(XQA1,",",2)_";DPT(",DFN=$P(ORVP,";",1),LRDFN=$$LRDFN^LR7OR1(DFN)
46 Q:'LRDFN
47 D PT^LRX,READ^ORUTL
48 W @IOF,PNM_" "_SSN
49 S ORPK=$P(XQADATA,"^",1,3),ORIFN=$P(XQADATA,"^",4)
50 Q:'ORIFN
51 D STAT,READ^ORUTL
52 I $D(^OR(100,"AN",ORVP,+$P(XQAID,",",3))) S ORNOTIF=+$P(XQAID,",",3) D CLEAN K XQAKILL
53 Q
54ORN(ON) ;Check if OE/RR-Lab is on
55 N ON,X
56 S ON=0,X=$O(^DIC(9.4,"C","LR",0))
57 S:'X X=$O(^DIC(9.4,"C","LRX",0))
58 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
59 Q ON
60CLEAN ;
61 N CHK
62 S CHK=0
63 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
64 . N X,Y S X=I,Y=N,CHK=1 N N,D,I D NOTIF^ORX8(X,Y)
65 K ORTIT
66 Q:CHK
67 I $D(XQAID) D DELETE^XQALERT Q
68 I '$D(XQAID) S XQAID=$P(^ORD(100.9,N,0),"^",2)_","_$P(ORVP,";")_","_N D DELETEA^XQALERT Q
69 Q
Note: See TracBrowser for help on using the repository browser.