LROR ;SLC/CJS - LAB MODULE FOR OR ;3/29/90 16:39 ;
;;5.2;LAB SERVICE;**5,18,100,121**;Sep 27, 1994
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
G EN^LROR5
V ;;from LRVER3A
S LRY=Y,ORIFN="" I '$D(LRNOW),$D(LX1) Q:LX1<1 S %DT="T",X="N" D ^%DT S LRNOWM=+Y
N DA,DH,DIER,DU,DV,I1,LRIFN
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
. 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
. N I I $D(LRNOW)!$D(LRNOWM) S ORETURN("ORSTOP")=$S($D(LRNOW):LRNOW,1:LRNOWM)
. S ORIFN=LRIFN,ORETURN("ORSTS")=2 D RETURN^ORX S ORIFN=LRIFN
S Y=LRY K LRY,LRNOWM,A,B,C Q
SET ;from LROW2,LRWLST
N X,ORPK,ORL,ORNP,ORVP,ORPCL,ORPURG,ORSTRT,ORSTS,ORTX,ORIT,LRURG,Y
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:"")
Q:+LRDPF'=2&(+LRDPF'=65.5)&(+LRDPF'=67)
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
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))
I ORNATR="C" S:$P(X,"^",2) OREPDUZ=$P(X,"^",2) S:$P(X,"^",5) ORLOG=$P(X,"^",5) S ORNATR=""
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)
SET1 S:'$D(ORPCL) ORPCL=$P(^LAB(69.9,1,1),U,6)_";ORD(101,"
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
D SET2(+LRTEST(LRI),LRSAMP,LRSPEC,LRURG,$G(LRLWC),LRORD)
D FILE^ORX S LRORIFN=$S($D(ORIFN):ORIFN,1:""),LRODT=LRODTSV,LRSN=LRSNSV,LRTN=LRTNSV
Q
SET2(TST,SAMP,SPEC,URG,TYPE,ORD) ;
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:"")
S ORTX(1)=$P(^LAB(60,TST,0),"^")_$S(Y'[X!(X=Y):" "_X,1:"")_$S(X'[Y:" "_Y,1:"")
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),"^"))
Q
FLAG ;
Q:$G(LRORFLG)
S LRORFLG=1
NOTIF1 ;
K XQAKILL S ORVP=$P(XQA1,",",2)_";DPT(",ORRACT("D")="Results Display",ORPRES="10^NOTIFICATIONS",DFN=$P(ORVP,";",1)
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:"")
D REVN^ORF4
K ORVP,ORPRES,DFN,ORNSCRN Q
EN(AREA,DATE,ACC) ;
;AREA=Accession area
;ACC=#
Q:'$D(^LRO(68,+$G(AREA),1,+$G(DATE),1,+$G(ACC)))
N MSG,TST,LRN,TST1,II,ORBPMSG,ORNOTE,ORVP,LRNOTI,ORIFN,X,ORBATCH,FLAG
S TST=0
F S TST=$O(^LRO(68,AREA,1,DATE,1,ACC,4,TST)) Q:TST<1 D
. S LRN=$P($G(^LAB(60,TST,0)),"^",5)
. I $L(LRN) D CHK(LRN,TST)
. 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
.. D CHK(LRN,TST1)
. I $O(LRNOTI(0)),'$D(LRNOTI(TST)) S LRNOTI(TST)=""
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
. F S II=$O(LRNOTI(II)) Q:II<1 D
.. Q:'$D(^LRO(69,LRODT,1,LRSN,2,"B",II)) S A=$O(^(II,0)) Q:'A
.. 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
. I $O(ORBATCH(0)) D NOTE^ORX3
Q
CHK(TEST,TST) ;
;TEST=Data Name
N LRNOTE Q:'$L(TEST) S TEST=$P(TEST,";",2) Q:'TEST Q:'$D(LRSB(TEST))
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))
I +A'=+B D
. I $P(B,"^",2)["*" S FLAG(24,TST)="",LRNOTI(TST)="",ORFLAG(24)=""
. 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)=""
. 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)=""
Q
MSG ;
N I,TS,STOP
S MSG="LAB",STOP=0
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
I STOP!($L(MSG)>33&($D(FLAG(14))!$D(FLAG(3)))) S MSG=MSG_"..." Q
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
I STOP!($L(MSG)>37&$D(FLAG(3))) S MSG=MSG_"..." Q
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
I STOP S MSG=MSG_"..." Q
Q
NAME(TEST) ;
S NAME=$S($L($G(^LAB(60,TEST,.1))):$P(^(.1),"^"),1:$E($P(^(0),"^"),1,7))
Q NAME
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLROR 5142 printed Oct 16, 2024@18:19:21 Page 2
LROR ;SLC/CJS - LAB MODULE FOR OR ;3/29/90 16:39 ;
+1 ;;5.2;LAB SERVICE;**5,18,100,121**;Sep 27, 1994
+2 IF $DATA(ORACTION)
IF ORACTION
if ORACTION=1
GOTO EN^LROR6
if ORACTION=2
GOTO EN^LROR7
if ORACTION=3
GOTO EN^LROR8
if ORACTION=4
GOTO EN1^LROR8
if ORACTION=6
GOTO C^LROR3
if ORACTION=7
GOTO P^LROR3
if ORACTION=8
GOTO STAT^LROR1
if ORGY=10
GOTO EN2^LROR8
QUIT
+3 GOTO EN^LROR5
V ;;from LRVER3A
+1 SET LRY=Y
SET ORIFN=""
IF '$DATA(LRNOW)
IF $DATA(LX1)
if LX1<1
QUIT
SET %DT="T"
SET X="N"
DO ^%DT
SET LRNOWM=+Y
+2 NEW DA,DH,DIER,DU,DV,I1,LRIFN
+3 IF $DATA(^LRO(69,LRODT,1,LRSN,2,"B",I))
SET A=$ORDER(^(I,0))
if 'A
QUIT
IF $DATA(^LRO(69,LRODT,1,LRSN,2,A,0))
SET X=^(0)
IF $PIECE(X,"^",4)=LRAA
IF $PIECE(X,"^",5)=LRAN
SET LRTNUM=$PIECE(X,"^",1)
SET LRIFN=$PIECE(X,"^",7)
IF LRIFN
Begin DoDot:1
+4 IF $LENGTH($PIECE(X,"^",14))
SET X=$PIECE(X,"^",14)
IF $PIECE($GET(^LRO(69,+X,1,+$PIECE(X,";",2),2,+$PIECE(X,";",3),0)),"^",7)
SET ORIFN=$PIECE(^(0),"^",7)
SET ORSTS=2
DO ST^ORX
+5 NEW I
IF $DATA(LRNOW)!$DATA(LRNOWM)
SET ORETURN("ORSTOP")=$SELECT($DATA(LRNOW):LRNOW,1:LRNOWM)
+6 SET ORIFN=LRIFN
SET ORETURN("ORSTS")=2
DO RETURN^ORX
SET ORIFN=LRIFN
End DoDot:1
+7 SET Y=LRY
KILL LRY,LRNOWM,A,B,C
QUIT
SET ;from LROW2,LRWLST
+1 NEW X,ORPK,ORL,ORNP,ORVP,ORPCL,ORPURG,ORSTRT,ORSTS,ORTX,ORIT,LRURG,Y
+2 if '$DATA(DFN)
SET DFN=$SELECT($DATA(^LR(LRDFN,0)):$PIECE(^(0),U,3),1:"")
if '$DATA(LRDPF)
SET LRDPF=$SELECT($DATA(^LR(LRDFN,0)):$PIECE(^(0),U,2),1:"")
+3 if +LRDPF'=2&(+LRDPF'=65.5)&(+LRDPF'=67)
QUIT
+4 IF '$DATA(ORNATR)
SET ORNATR=$SELECT($DATA(LRNATURE):LRNATURE,1:"")
IF '$DATA(LRNATURE)
if $PIECE($GET(^ORD(100.99,1,2)),"^",2)
DO OT^LROR6
SET LRNATURE=ORNATR
+5 SET ORPK=LRODT_"^"_LRSN_"^"_LRTN
SET ORIT=+LRTEST(LRI)_";LAB(60,"
SET LRURG=$PIECE(LRTEST(LRI),"^",2)
SET X=$GET(^LRO(69,+LRODT,1,+LRSN,0))
SET X1=$GET(^(1))
+6 IF ORNATR="C"
if $PIECE(X,"^",2)
SET OREPDUZ=$PIECE(X,"^",2)
if $PIECE(X,"^",5)
SET ORLOG=$PIECE(X,"^",5)
SET ORNATR=""
+7 if '$LENGTH(LRLLOC)!(LRLLOC["^")
SET LRLLOC="UNKNOWN"
SET ORL=$SELECT(LROLLOC:LROLLOC_";SC(",1:"")
SET ORNP=$SELECT($GET(LRPRAC):LRPRAC,1:$PIECE(X,"^",6))
SET ORVP=DFN_";"_$PIECE(^DIC(+LRDPF,0,"GL"),"^",2)
SET1 if '$DATA(ORPCL)
SET ORPCL=$PIECE(^LAB(69.9,1,1),U,6)_";ORD(101,"
+1 SET ORPURG=$PIECE(LRPARAM,"^",9)
SET ORSTRT=$SELECT($PIECE(X,"^",8):$PIECE(X,"^",8),$PIECE(X,"^",5):$PIECE(X,"^",5),1:LRODT)
SET ORSTS=$SELECT(X1:6,1:5)
DO NOW^%DTC
SET NOW=%
SET LRODTSV=LRODT
SET LRSNSV=LRSN
SET LRTNSV=LRTN
+2 DO SET2(+LRTEST(LRI),LRSAMP,LRSPEC,LRURG,$GET(LRLWC),LRORD)
+3 DO FILE^ORX
SET LRORIFN=$SELECT($DATA(ORIFN):ORIFN,1:"")
SET LRODT=LRODTSV
SET LRSN=LRSNSV
SET LRTN=LRTNSV
+4 QUIT
SET2(TST,SAMP,SPEC,URG,TYPE,ORD) ;
+1 SET X=$SELECT($DATA(SAMP):$SELECT($DATA(^LAB(62,+SAMP,0)):$PIECE(^(0),"^"),1:""),1:"")
SET Y=$SELECT($DATA(SPEC):$SELECT($DATA(^LAB(61,+SPEC,0)):$PIECE(^(0),"^"),1:""),1:"")
+2 SET ORTX(1)=$PIECE(^LAB(60,TST,0),"^")_$SELECT(Y'[X!(X=Y):" "_X,1:"")_$SELECT(X'[Y:" "_Y,1:"")
+3 IF $GET(ORD)!($DATA(TYPE))!($DATA(URG))
SET ORTX(1)=ORTX(1)_$SELECT($GET(ORD):" LB #"_ORD,1:"")_" "_$SELECT($DATA(TYPE):TYPE,1:"")_$SELECT(URG=9!('URG):"",1:" "_$PIECE(^LAB(62.05,URG,0),"^"))
+4 QUIT
FLAG ;
+1 if $GET(LRORFLG)
QUIT
+2 SET LRORFLG=1
NOTIF1 ;
+1 KILL XQAKILL
SET ORVP=$PIECE(XQA1,",",2)_";DPT("
SET ORRACT("D")="Results Display"
SET ORPRES="10^NOTIFICATIONS"
SET DFN=$PIECE(ORVP,";",1)
+2 SET NOTE=$PIECE(XQA1,",",3)
SET ORNSCRN="I ORNOTE="
SET ORNSCRN=$SELECT(NOTE=24:ORNSCRN_24,NOTE=3:ORNSCRN_3,NOTE=14:ORNSCRN_14,NOTE=50:ORNSCRN_50,1:"")
+3 DO REVN^ORF4
+4 KILL ORVP,ORPRES,DFN,ORNSCRN
QUIT
EN(AREA,DATE,ACC) ;
+1 ;AREA=Accession area
+2 ;ACC=#
+3 if '$DATA(^LRO(68,+$GET(AREA),1,+$GET(DATE),1,+$GET(ACC)))
QUIT
+4 NEW MSG,TST,LRN,TST1,II,ORBPMSG,ORNOTE,ORVP,LRNOTI,ORIFN,X,ORBATCH,FLAG
+5 SET TST=0
+6 FOR
SET TST=$ORDER(^LRO(68,AREA,1,DATE,1,ACC,4,TST))
if TST<1
QUIT
Begin DoDot:1
+7 SET LRN=$PIECE($GET(^LAB(60,TST,0)),"^",5)
+8 IF $LENGTH(LRN)
DO CHK(LRN,TST)
+9 IF $ORDER(^LAB(60,TST,2,0))
SET II=0
FOR
SET II=$ORDER(^LAB(60,TST,2,II))
if II<1
QUIT
SET TST1=^(II,0)
SET LRN=$PIECE($GET(^LAB(60,TST1,0)),"^",5)
IF $LENGTH(LRN)
Begin DoDot:2
+10 DO CHK(LRN,TST1)
End DoDot:2
+11 IF $ORDER(LRNOTI(0))
IF '$DATA(LRNOTI(TST))
SET LRNOTI(TST)=""
End DoDot:1
+12 IF $ORDER(FLAG(0))
DO MSG
SET ORBPMSG=MSG
SET ORNOTE(50)=1
SET ORVP=$SELECT(LRDPF=2:DFN,1:"")
if 'ORVP
QUIT
SET ORVP=ORVP_";DPT("
SET II=0
Begin DoDot:1
+13 FOR
SET II=$ORDER(LRNOTI(II))
if II<1
QUIT
Begin DoDot:2
+14 if '$DATA(^LRO(69,LRODT,1,LRSN,2,"B",II))
QUIT
SET A=$ORDER(^(II,0))
if 'A
QUIT
+15 IF $DATA(^LRO(69,LRODT,1,LRSN,2,A,0))
SET X=^(0)
IF $PIECE(X,"^",4)=AREA
IF $PIECE(X,"^",5)=ACC
SET TST=$PIECE(X,"^")
SET ORIFN=$PIECE(X,"^",7)
IF ORIFN
SET ORBATCH(ORIFN)=""
SET ORBXDATA=LRODT_"^"_LRSN_"^"_A_"^"_ORIFN
End DoDot:2
+16 IF $ORDER(ORBATCH(0))
DO NOTE^ORX3
End DoDot:1
+17 QUIT
CHK(TEST,TST) ;
+1 ;TEST=Data Name
+2 NEW LRNOTE
if '$LENGTH(TEST)
QUIT
SET TEST=$PIECE(TEST,";",2)
if 'TEST
QUIT
if '$DATA(LRSB(TEST))
QUIT
+3 SET A=$SELECT($DATA(LRSA(TEST)):$SELECT("<>"[$EXTRACT(LRSA(TEST)):$EXTRACT(LRSA(TEST),2,99),1:LRSA(TEST)),1:"")
SET B=$SELECT("<>"[$EXTRACT(LRSB(TEST)):$EXTRACT(LRSB(TEST),2,99),1:LRSB(TEST))
+4 IF +A'=+B
Begin DoDot:1
+5 IF $PIECE(B,"^",2)["*"
SET FLAG(24,TST)=""
SET LRNOTI(TST)=""
SET ORFLAG(24)=""
+6 IF '$DATA(LRNOTE)
IF $DATA(^ORD(100.9,14,3))
IF $PIECE(^(3),"^")'="D"
IF $LENGTH($PIECE(B,"^",2))
if '$DATA(FLAG(24,TST))
SET FLAG(14,TST)=""
SET LRNOTI(TST)=""
SET ORFLAG(14)=""
+7 IF '$DATA(LRNOTE)
IF $DATA(^ORD(100.9,3,3))
IF $PIECE(^(3),"^")'="D"
if '$DATA(FLAG(24,TST))&'$DATA(FLAG(14,TST))
SET FLAG(3,TST)=""
SET LRNOTI(TST)=""
SET ORFLAG(3)=""
End DoDot:1
+8 QUIT
MSG ;
+1 NEW I,TS,STOP
+2 SET MSG="LAB"
SET STOP=0
+3 IF $DATA(FLAG(24))
SET MSG=MSG_" Critical "
SET TS=0
FOR
SET TS=$ORDER(FLAG(24,TS))
if 'TS
QUIT
SET MSG=MSG_$$NAME(TS)_":"
IF $LENGTH(MSG)>40
if $ORDER(FLAG(24,TS))
SET STOP=1
QUIT
+4 IF STOP!($LENGTH(MSG)>33&($DATA(FLAG(14))!$DATA(FLAG(3))))
SET MSG=MSG_"..."
QUIT
+5 IF $DATA(FLAG(14))
SET MSG=MSG_" Abnormal "
SET TS=0
FOR
SET TS=$ORDER(FLAG(14,TS))
if 'TS
QUIT
SET MSG=MSG_$$NAME(TS)_":"
IF $LENGTH(MSG)>40
if $ORDER(FLAG(14,TS))
SET STOP=1
QUIT
+6 IF STOP!($LENGTH(MSG)>37&$DATA(FLAG(3)))
SET MSG=MSG_"..."
QUIT
+7 IF $DATA(FLAG(3))
SET MSG=MSG_" New "
SET TS=0
FOR
SET TS=$ORDER(FLAG(3,TS))
if 'TS
QUIT
SET MSG=MSG_$$NAME(TS)_":"
IF $LENGTH(MSG)>40
if $ORDER(FLAG(3,TS))
SET STOP=1
QUIT
+8 IF STOP
SET MSG=MSG_"..."
QUIT
+9 QUIT
NAME(TEST) ;
+1 SET NAME=$SELECT($LENGTH($GET(^LAB(60,TEST,.1))):$PIECE(^(.1),"^"),1:$EXTRACT($PIECE(^(0),"^"),1,7))
+2 QUIT NAME
