32 lines
1.6 KiB
Mathematica
32 lines
1.6 KiB
Mathematica
LR7OF4 ;slc/dcm - Process messages from OE/RR ;8/11/97
|
|
;;5.2;LAB SERVICE;**121,187**;Sep 27, 1994
|
|
PURG ;Process Purge request for OBR Segment
|
|
N TST,X,LRODT,LRSN,LRORD,LRORIFN,STARTDT,LRDUZ,PROV,REASON,QUANT,LREND
|
|
S LREND=0
|
|
D GET^LR7OF2(.LRXORC,LRXORC) Q:LREND
|
|
I 'LRVERZ S LRODT=0 F S LRODT=$O(^LRO(69,"C",LRORD,LRODT)) Q:LRODT<1 S LRSN=0 F S LRSN=$O(^LRO(69,"C",LRORD,LRODT,LRSN)) Q:LRSN<1 D Q
|
|
. S X=$P($P(LRXMSG,"|",5),"^",4) I X S TST=$O(^LRO(69,LRODT,1,LRSN,2,"B",X,0)) I TST D P1(LRODT,LRSN,TST) Q:LREND
|
|
I LRVERZ,$D(^LRO(69,LRODT,1,LRSN,0)) S X=$P($P(LRXMSG,"|",5),"^",4) I X S TST=$O(^LRO(69,LRODT,1,LRSN,2,"B",X,0)) I TST D P1(LRODT,LRSN,TST) Q:LREND
|
|
I LREND D ACK^LR7OF0("ZU",LRXORC) Q
|
|
D ACK^LR7OF0("ZR",LRXORC)
|
|
Q
|
|
P1(LRODT,LRSN,TST) ;Check to purge
|
|
N X
|
|
I '$D(^LRO(69,LRODT,1,LRSN,0)) Q
|
|
S X=+^LRO(69,LRODT,1,LRSN,0) I $D(^LR(X,0)),$P(X,"^",2)'=2 G P2
|
|
I '$D(^LRO(69,LRODT,1,LRSN,1)) S LREND=1 Q
|
|
I $D(^LRO(69,LRODT,1,LRSN,3)),'$L($P(^(3),"^",2)) S LREND=1 Q
|
|
P2 S:$D(^LRO(69,LRODT,1,LRSN,2,TST,0)) $P(^(0),"^",7)="P" ;P=flag for purged
|
|
Q
|
|
PURG1 ;Process Purge request for ORC Segment
|
|
N X,I,STOP S X=$P(LRXORC,"|",4),STOP=0
|
|
S I=LINE F S I=$O(MSG(I)) Q:I<1 I $P(MSG(I),"|")="OBR" S STOP=1 Q
|
|
Q:STOP
|
|
I $L(X,"^")>5 D ACK^LR7OF0("ZR",LRXORC) Q ;Old unreleased 2.5 order
|
|
I +X#1 D ACK^LR7OF0("ZR",LRXORC) Q ;Old ORGY 2.5
|
|
I +X,$P(X,"^",2),$P(X,"^",3) D ACK^LR7OF0("ZR",LRXORC) Q ;Old unconverted 2.5
|
|
I +X,$P(X,"^",2)="LRCH" D PURG Q ;3.0 order with no tests (early tuscaloosa days)
|
|
I 'X D ACK^LR7OF0("ZR",LRXORC) Q ;Order with no lab pointers
|
|
D ACK^LR7OF0("DE",LRXORC,"Unrecognized ID's :"_$P(LRXORC,"|",4))
|
|
Q
|