source: FOIAVistA/tag/r/LAB_SERVICE-LR-LS/LROR.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: 4.9 KB
Line 
1LROR ;SLC/CJS - LAB MODULE FOR OR ;3/29/90 16:39 ;
2 ;;5.2;LAB SERVICE;**5,18,100,121**;Sep 27, 1994
3 I $D(ORACTION),ORACTION G EN^LROR6:ORACTION=1,EN^LROR7:ORACTION=2,EN^LROR8:ORACTION=3,EN1^LROR8:ORACTION=4,C^LROR3:ORACTION=6,P^LROR3:ORACTION=7,STAT^LROR1:ORACTION=8,EN2^LROR8:ORGY=10 Q
4 G EN^LROR5
5V ;;from LRVER3A
6 S LRY=Y,ORIFN="" I '$D(LRNOW),$D(LX1) Q:LX1<1 S %DT="T",X="N" D ^%DT S LRNOWM=+Y
7 N DA,DH,DIER,DU,DV,I1,LRIFN
8 I $D(^LRO(69,LRODT,1,LRSN,2,"B",I)) S A=$O(^(I,0)) Q:'A I $D(^LRO(69,LRODT,1,LRSN,2,A,0)) S X=^(0) I $P(X,"^",4)=LRAA,$P(X,"^",5)=LRAN S LRTNUM=$P(X,"^",1) S LRIFN=$P(X,"^",7) I LRIFN D
9 . I $L($P(X,"^",14)) S X=$P(X,"^",14) I $P($G(^LRO(69,+X,1,+$P(X,";",2),2,+$P(X,";",3),0)),"^",7) S ORIFN=$P(^(0),"^",7),ORSTS=2 D ST^ORX
10 . N I I $D(LRNOW)!$D(LRNOWM) S ORETURN("ORSTOP")=$S($D(LRNOW):LRNOW,1:LRNOWM)
11 . S ORIFN=LRIFN,ORETURN("ORSTS")=2 D RETURN^ORX S ORIFN=LRIFN
12 S Y=LRY K LRY,LRNOWM,A,B,C Q
13SET ;from LROW2,LRWLST
14 N X,ORPK,ORL,ORNP,ORVP,ORPCL,ORPURG,ORSTRT,ORSTS,ORTX,ORIT,LRURG,Y
15 S:'$D(DFN) DFN=$S($D(^LR(LRDFN,0)):$P(^(0),U,3),1:"") S:'$D(LRDPF) LRDPF=$S($D(^LR(LRDFN,0)):$P(^(0),U,2),1:"")
16 Q:+LRDPF'=2&(+LRDPF'=65.5)&(+LRDPF'=67)
17 I '$D(ORNATR) S ORNATR=$S($D(LRNATURE):LRNATURE,1:"") I '$D(LRNATURE) D:$P($G(^ORD(100.99,1,2)),"^",2) OT^LROR6 S LRNATURE=ORNATR
18 S ORPK=LRODT_"^"_LRSN_"^"_LRTN,ORIT=+LRTEST(LRI)_";LAB(60,",LRURG=$P(LRTEST(LRI),"^",2),X=$G(^LRO(69,+LRODT,1,+LRSN,0)),X1=$G(^(1))
19 I ORNATR="C" S:$P(X,"^",2) OREPDUZ=$P(X,"^",2) S:$P(X,"^",5) ORLOG=$P(X,"^",5) S ORNATR=""
20 S:'$L(LRLLOC)!(LRLLOC["^") LRLLOC="UNKNOWN" S ORL=$S(LROLLOC:LROLLOC_";SC(",1:""),ORNP=$S($G(LRPRAC):LRPRAC,1:$P(X,"^",6)),ORVP=DFN_";"_$P(^DIC(+LRDPF,0,"GL"),"^",2)
21SET1 S:'$D(ORPCL) ORPCL=$P(^LAB(69.9,1,1),U,6)_";ORD(101,"
22 S ORPURG=$P(LRPARAM,"^",9),ORSTRT=$S($P(X,"^",8):$P(X,"^",8),$P(X,"^",5):$P(X,"^",5),1:LRODT),ORSTS=$S(X1:6,1:5) D NOW^%DTC S NOW=%,LRODTSV=LRODT,LRSNSV=LRSN,LRTNSV=LRTN
23 D SET2(+LRTEST(LRI),LRSAMP,LRSPEC,LRURG,$G(LRLWC),LRORD)
24 D FILE^ORX S LRORIFN=$S($D(ORIFN):ORIFN,1:""),LRODT=LRODTSV,LRSN=LRSNSV,LRTN=LRTNSV
25 Q
26SET2(TST,SAMP,SPEC,URG,TYPE,ORD) ;
27 S X=$S($D(SAMP):$S($D(^LAB(62,+SAMP,0)):$P(^(0),"^"),1:""),1:""),Y=$S($D(SPEC):$S($D(^LAB(61,+SPEC,0)):$P(^(0),"^"),1:""),1:"")
28 S ORTX(1)=$P(^LAB(60,TST,0),"^")_$S(Y'[X!(X=Y):" "_X,1:"")_$S(X'[Y:" "_Y,1:"")
29 I $G(ORD)!($D(TYPE))!($D(URG)) S ORTX(1)=ORTX(1)_$S($G(ORD):" LB #"_ORD,1:"")_" "_$S($D(TYPE):TYPE,1:"")_$S(URG=9!('URG):"",1:" "_$P(^LAB(62.05,URG,0),"^"))
30 Q
31FLAG ;
32 Q:$G(LRORFLG)
33 S LRORFLG=1
34NOTIF1 ;
35 K XQAKILL S ORVP=$P(XQA1,",",2)_";DPT(",ORRACT("D")="Results Display",ORPRES="10^NOTIFICATIONS",DFN=$P(ORVP,";",1)
36 S NOTE=$P(XQA1,",",3) S ORNSCRN="I ORNOTE=" S ORNSCRN=$S(NOTE=24:ORNSCRN_24,NOTE=3:ORNSCRN_3,NOTE=14:ORNSCRN_14,NOTE=50:ORNSCRN_50,1:"")
37 D REVN^ORF4
38 K ORVP,ORPRES,DFN,ORNSCRN Q
39EN(AREA,DATE,ACC) ;
40 ;AREA=Accession area
41 ;ACC=#
42 Q:'$D(^LRO(68,+$G(AREA),1,+$G(DATE),1,+$G(ACC)))
43 N MSG,TST,LRN,TST1,II,ORBPMSG,ORNOTE,ORVP,LRNOTI,ORIFN,X,ORBATCH,FLAG
44 S TST=0
45 F S TST=$O(^LRO(68,AREA,1,DATE,1,ACC,4,TST)) Q:TST<1 D
46 . S LRN=$P($G(^LAB(60,TST,0)),"^",5)
47 . I $L(LRN) D CHK(LRN,TST)
48 . I $O(^LAB(60,TST,2,0)) S II=0 F S II=$O(^LAB(60,TST,2,II)) Q:II<1 S TST1=^(II,0) S LRN=$P($G(^LAB(60,TST1,0)),"^",5) I $L(LRN) D
49 .. D CHK(LRN,TST1)
50 . I $O(LRNOTI(0)),'$D(LRNOTI(TST)) S LRNOTI(TST)=""
51 I $O(FLAG(0)) D MSG S ORBPMSG=MSG,ORNOTE(50)=1,ORVP=$S(LRDPF=2:DFN,1:"") Q:'ORVP S ORVP=ORVP_";DPT(",II=0 D
52 . F S II=$O(LRNOTI(II)) Q:II<1 D
53 .. Q:'$D(^LRO(69,LRODT,1,LRSN,2,"B",II)) S A=$O(^(II,0)) Q:'A
54 .. I $D(^LRO(69,LRODT,1,LRSN,2,A,0)) S X=^(0) I $P(X,"^",4)=AREA,$P(X,"^",5)=ACC S TST=$P(X,"^"),ORIFN=$P(X,"^",7) I ORIFN S ORBATCH(ORIFN)="",ORBXDATA=LRODT_"^"_LRSN_"^"_A_"^"_ORIFN
55 . I $O(ORBATCH(0)) D NOTE^ORX3
56 Q
57CHK(TEST,TST) ;
58 ;TEST=Data Name
59 N LRNOTE Q:'$L(TEST) S TEST=$P(TEST,";",2) Q:'TEST Q:'$D(LRSB(TEST))
60 S A=$S($D(LRSA(TEST)):$S("<>"[$E(LRSA(TEST)):$E(LRSA(TEST),2,99),1:LRSA(TEST)),1:""),B=$S("<>"[$E(LRSB(TEST)):$E(LRSB(TEST),2,99),1:LRSB(TEST))
61 I +A'=+B D
62 . I $P(B,"^",2)["*" S FLAG(24,TST)="",LRNOTI(TST)="",ORFLAG(24)=""
63 . I '$D(LRNOTE),$D(^ORD(100.9,14,3)),$P(^(3),"^")'="D",$L($P(B,"^",2)) S:'$D(FLAG(24,TST)) FLAG(14,TST)="" S LRNOTI(TST)="",ORFLAG(14)=""
64 . I '$D(LRNOTE),$D(^ORD(100.9,3,3)),$P(^(3),"^")'="D" S:'$D(FLAG(24,TST))&'$D(FLAG(14,TST)) FLAG(3,TST)="" S LRNOTI(TST)="",ORFLAG(3)=""
65 Q
66MSG ;
67 N I,TS,STOP
68 S MSG="LAB",STOP=0
69 I $D(FLAG(24)) S MSG=MSG_" Critical ",TS=0 F S TS=$O(FLAG(24,TS)) Q:'TS S MSG=MSG_$$NAME(TS)_":" I $L(MSG)>40 S:$O(FLAG(24,TS)) STOP=1 Q
70 I STOP!($L(MSG)>33&($D(FLAG(14))!$D(FLAG(3)))) S MSG=MSG_"..." Q
71 I $D(FLAG(14)) S MSG=MSG_" Abnormal ",TS=0 F S TS=$O(FLAG(14,TS)) Q:'TS S MSG=MSG_$$NAME(TS)_":" I $L(MSG)>40 S:$O(FLAG(14,TS)) STOP=1 Q
72 I STOP!($L(MSG)>37&$D(FLAG(3))) S MSG=MSG_"..." Q
73 I $D(FLAG(3)) S MSG=MSG_" New ",TS=0 F S TS=$O(FLAG(3,TS)) Q:'TS S MSG=MSG_$$NAME(TS)_":" I $L(MSG)>40 S:$O(FLAG(3,TS)) STOP=1 Q
74 I STOP S MSG=MSG_"..." Q
75 Q
76NAME(TEST) ;
77 S NAME=$S($L($G(^LAB(60,TEST,.1))):$P(^(.1),"^"),1:$E($P(^(0),"^"),1,7))
78 Q NAME
Note: See TracBrowser for help on using the repository browser.