LR7OF2 ;slc/dcm - Process messages from OE/RR ;8/11/97
;;5.2T9;LR;**1018**;Nov 17, 2004
;;5.2;LAB SERVICE;**121,187**;Sep 27, 1994
;
NEW ;Process New orders from OE/RR
;LRXMSG=Message with linking identifiers
;LRXORC=Current ORC message value - for communicating back to OE/RR
D GET(.LRXMSG,LRXORC) Q:LREND
I '$L(STARTDT) D ACK^LR7OF0("DE",LRXORC,"Start date not passed in message") S LREND=1 Q
I '$L(LRDUZ) D ACK^LR7OF0("DE",LRXORC,"Entered By person not passed in message") S LREND=1 Q
I '$L(PROV) D ACK^LR7OF0("DE",LRXORC,"Provider not passed in message") S LREND=1 Q
Q
CANC ;Process Canceled orders from OE/RR
N TST,X,LRODT,LRSN,LRORD,LRORIFN,STARTDT,LRDUZ,PROV,REASON,QUANT
D GET(.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 DOIT(LRODT,LRSN,TST,LRXORC,LRDUZ,REASON) 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 DOIT(LRODT,LRSN,TST,LRXORC,LRDUZ,REASON) Q:LREND
D ACK^LR7OF0("CR",LRXORC)
Q
XO ;Process order changes from OE/RR
D GET(.LRXMSG,LRXORC) Q:LREND
D ACK^LR7OF0("XR",LRXORC)
Q
DOIT(LRODT,LRSN,TST,LRXORC,LRDUZ,REASON) ;Clean it out
N LRAA,LRAD,LRAN,X,LRTSN,LRUSNM
;I $D(^LRO(69,LRODT,1,LRSN,3)),$P(^(3),"^",2) S LREND=1 D ACK^LR7OF0("UC",LRXORC,"Tests already verified") Q ;Tests already verified
S X=+^LRO(69,LRODT,1,LRSN,2,TST,0),LRTSN=+X,LRAD=+$P(X,"^",3),LRAA=+$P(X,"^",4),LRAN=+$P(X,"^",5)
I LRAD,LRAA,LRAN,$D(^LRO(68,LRAA,1,LRAD,1,LRAN,0)) S LREND=1 D ACK^LR7OF0("UC",LRXORC,"Tests already accessioned, contact lab to cancel") Q
S $P(^LRO(69,LRODT,1,LRSN,2,TST,0),"^",3,6)="^^^",$P(^(0),"^",9,11)="CA^W^"_LRDUZ
I $L($P(REASON,"^",5)) S:'$D(^LRO(69,LRODT,1,LRSN,2,TST,1.1,0)) ^(0)="^^^^"_DT S X=1+$O(^(9999),-1),$P(^LRO(69,LRODT,1,LRSN,2,TST,1.1,0),"^",3,4)=X_"^"_X,^(X,0)=$P(REASON,"^",5)
Q
NUM ;Process Return of OE/RR Order number
N LRODT,LRSN,LRORD,ORIFN,STARTDT,LRDUZ,PROV,REASON,QUANT
D GET(.LRXMSG,LRXORC) Q:LREND
I 'LRVERZ,LRORD 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 I $D(^LRO(69,LRODT,1,LRSN,0)) S $P(^(0),"^",11)=ORIFN
I LRVERZ,$D(^LRO(69,LRODT,1,LRSN,0)) S $P(^(0),"^",11)=ORIFN
Q
NA ;Set ORIFN at test level
N I,X,LRODT,LRSN,LRORD,ORIFN,STARTDT,LRDUZ,PROV,REASON,QUANT
D GET(.LRXORC,LRXORC) Q:LREND
S I=0
S X=$P($P(LRXMSG,"|",5),"^",4) I X S I=$O(^LRO(69,LRODT,1,LRSN,2,"B",X,0)) I I S $P(^LRO(69,LRODT,1,LRSN,2,I,0),"^",7)=ORIFN
Q
GET(XMSG,XORC) ;Get identification data from message
;ORIFN= OE/RR order number
;STARTDT= Start D/T of order
;LRDUZ= Entered by Person (ptr to file 200)
;PROV= Ordering Provider
;REASON= Order control reason (e.g. inadequate specimen)
;QUANT= Quantity ordered
;LRORD=Lab Order #
;LRODT=Order date
;LRSN=Specimen Number
;LRVERZ=0 if only LRORD, 1 if LRODT,LRSN exists. Used to maintain backward compatibility at Tuscaloosa when only LRORD was used.
N X,X1,I,J,CTR
S X=$P(XMSG,"|",4),LRORD=+X,LRODT=+$P(X,";",2),LRSN=+$P(X,";",3),LRVERZ=$S(LRODT&LRSN:1,1:0)
S LRPLACR=$P(XMSG,"|",3),ORIFN=+LRPLACR
I 'ORIFN D ACK^LR7OF0("DE",XORC,"OE/RR order number not passed") S LREND=1 Q
I '$O(XMSG(0)) S STARTDT=$$FMDATE^LR7OU0($P($P(XMSG,"|",8),"^",4)),LRDUZ=$P(XMSG,"|",11),PROV=$P(XMSG,"|",13),REASON=$P(XMSG,"|",17),QUANT=$P($P(XMSG,"|",8),"^") Q
F CTR=1:1:$L(XMSG,"|") S X1(CTR)=$P(XMSG,"|",CTR)
S J=0 F S J=$O(XMSG(J)) Q:J<1 D
. S I=1 I $E(XMSG(J))'="|" S X1(CTR)=X1(CTR)_$P(XMSG(J),"|"),I=I+1
. F I=I:1:$L(XMSG(J),"|") S CTR=CTR+1,X1(CTR)=$P(XMSG(J),"|",I)
S STARTDT=$$FMDATE^LR7OU0($P(X1(8),"^",4))
S QUANT=$P(X1(8),"^")
S LRDUZ=X1(11),PROV=X1(13),REASON=X1(17)
Q
NTE ;Process Order comments from OE/RR
;MSG(i)="NTE|1|P|comment..."
;MSG(i,c)="...more comments..."
N X,I,LINES
S X=$D(STARTDT)&($D(TYPE))&($D(SAMP))&($D(SPEC))&($D(LRSX))
I 'X Q ;Trying to add comments to undefined test array in ^TMP
I '$D(^TMP("OR",$J,"LROT",STARTDT,TYPE,SAMP,SPEC,LRSX)) Q ;Trying to add comments to undefined test array in ^TMP
S:'$D(^TMP("OR",$J,"COM",STARTDT,TYPE,SAMP,SPEC,LRSX)) ^(LRSX)=0 S LINES=^(LRSX)
I $L($P(LRXMSG,"|",4)) D N1($P(LRXMSG,"|",4))
S I=0 F S I=$O(MSG(LINE,I)) Q:I<1 I $L(MSG(LINE,I)) D N1(MSG(LINE,I))
Q
N1(X) ;
S LINES=LINES+1,^TMP("OR",$J,"COM",STARTDT,TYPE,SAMP,SPEC,LRSX,LINES)=X,^TMP("OR",$J,"COM",STARTDT,TYPE,SAMP,SPEC,LRSX)=LINES
Q
LR7OF2 ;slc/dcm - Process messages from OE/RR ;8/11/97
+1 ;;5.2T9;LR;**1018**;Nov 17, 2004
+2 ;;5.2;LAB SERVICE;**121,187**;Sep 27, 1994
+3 ;
NEW ;Process New orders from OE/RR
+1 ;LRXMSG=Message with linking identifiers
+2 ;LRXORC=Current ORC message value - for communicating back to OE/RR
+3 DO GET(.LRXMSG,LRXORC)
IF LREND
QUIT
+4 IF '$LENGTH(STARTDT)
DO ACK^LR7OF0("DE",LRXORC,"Start date not passed in message")
SET LREND=1
QUIT
+5 IF '$LENGTH(LRDUZ)
DO ACK^LR7OF0("DE",LRXORC,"Entered By person not passed in message")
SET LREND=1
QUIT
+6 IF '$LENGTH(PROV)
DO ACK^LR7OF0("DE",LRXORC,"Provider not passed in message")
SET LREND=1
QUIT
+7 QUIT
CANC ;Process Canceled orders from OE/RR
+1 NEW TST,X,LRODT,LRSN,LRORD,LRORIFN,STARTDT,LRDUZ,PROV,REASON,QUANT
+2 DO GET(.LRXORC,LRXORC)
IF LREND
QUIT
+3 IF 'LRVERZ
SET LRODT=0
FOR
SET LRODT=$ORDER(^LRO(69,"C",LRORD,LRODT))
IF LRODT<1
QUIT
SET LRSN=0
FOR
SET LRSN=$ORDER(^LRO(69,"C",LRORD,LRODT,LRSN))
IF LRSN<1
QUIT
Begin DoDot:1
+4 SET X=$PIECE($PIECE(LRXMSG,"|",5),"^",4)
IF X
SET TST=$ORDER(^LRO(69,LRODT,1,LRSN,2,"B",X,0))
IF TST
DO DOIT(LRODT,LRSN,TST,LRXORC,LRDUZ,REASON)
IF LREND
QUIT
End DoDot:1
QUIT
+5 IF LRVERZ
IF $DATA(^LRO(69,LRODT,1,LRSN,0))
SET X=$PIECE($PIECE(LRXMSG,"|",5),"^",4)
IF X
SET TST=$ORDER(^LRO(69,LRODT,1,LRSN,2,"B",X,0))
IF TST
DO DOIT(LRODT,LRSN,TST,LRXORC,LRDUZ,REASON)
IF LREND
QUIT
+6 DO ACK^LR7OF0("CR",LRXORC)
+7 QUIT
XO ;Process order changes from OE/RR
+1 DO GET(.LRXMSG,LRXORC)
IF LREND
QUIT
+2 DO ACK^LR7OF0("XR",LRXORC)
+3 QUIT
DOIT(LRODT,LRSN,TST,LRXORC,LRDUZ,REASON) ;Clean it out
+1 NEW LRAA,LRAD,LRAN,X,LRTSN,LRUSNM
+2 ;I $D(^LRO(69,LRODT,1,LRSN,3)),$P(^(3),"^",2) S LREND=1 D ACK^LR7OF0("UC",LRXORC,"Tests already verified") Q ;Tests already verified
+3 SET X=+^LRO(69,LRODT,1,LRSN,2,TST,0)
SET LRTSN=+X
SET LRAD=+$PIECE(X,"^",3)
SET LRAA=+$PIECE(X,"^",4)
SET LRAN=+$PIECE(X,"^",5)
+4 IF LRAD
IF LRAA
IF LRAN
IF $DATA(^LRO(68,LRAA,1,LRAD,1,LRAN,0))
SET LREND=1
DO ACK^LR7OF0("UC",LRXORC,"Tests already accessioned, contact lab to cancel")
QUIT
+5 SET $PIECE(^LRO(69,LRODT,1,LRSN,2,TST,0),"^",3,6)="^^^"
SET $PIECE(^(0),"^",9,11)="CA^W^"_LRDUZ
+6 IF $LENGTH($PIECE(REASON,"^",5))
IF '$DATA(^LRO(69,LRODT,1,LRSN,2,TST,1.1,0))
SET ^(0)="^^^^"_DT
SET X=1+$ORDER(^(9999),-1)
SET $PIECE(^LRO(69,LRODT,1,LRSN,2,TST,1.1,0),"^",3,4)=X_"^"_X
SET ^(X,0)=$PIECE(REASON,"^",5)
+7 QUIT
NUM ;Process Return of OE/RR Order number
+1 NEW LRODT,LRSN,LRORD,ORIFN,STARTDT,LRDUZ,PROV,REASON,QUANT
+2 DO GET(.LRXMSG,LRXORC)
IF LREND
QUIT
+3 IF 'LRVERZ
IF LRORD
SET LRODT=0
FOR
SET LRODT=$ORDER(^LRO(69,"C",LRORD,LRODT))
IF LRODT<1
QUIT
SET LRSN=0
FOR
SET LRSN=$ORDER(^LRO(69,"C",LRORD,LRODT,LRSN))
IF LRSN<1
QUIT
IF $DATA(^LRO(69,LRODT,1,LRSN,0))
SET $PIECE(^(0),"^",11)=ORIFN
+4 IF LRVERZ
IF $DATA(^LRO(69,LRODT,1,LRSN,0))
SET $PIECE(^(0),"^",11)=ORIFN
+5 QUIT
NA ;Set ORIFN at test level
+1 NEW I,X,LRODT,LRSN,LRORD,ORIFN,STARTDT,LRDUZ,PROV,REASON,QUANT
+2 DO GET(.LRXORC,LRXORC)
IF LREND
QUIT
+3 SET I=0
+4 SET X=$PIECE($PIECE(LRXMSG,"|",5),"^",4)
IF X
SET I=$ORDER(^LRO(69,LRODT,1,LRSN,2,"B",X,0))
IF I
SET $PIECE(^LRO(69,LRODT,1,LRSN,2,I,0),"^",7)=ORIFN
+5 QUIT
GET(XMSG,XORC) ;Get identification data from message
+1 ;ORIFN= OE/RR order number
+2 ;STARTDT= Start D/T of order
+3 ;LRDUZ= Entered by Person (ptr to file 200)
+4 ;PROV= Ordering Provider
+5 ;REASON= Order control reason (e.g. inadequate specimen)
+6 ;QUANT= Quantity ordered
+7 ;LRORD=Lab Order #
+8 ;LRODT=Order date
+9 ;LRSN=Specimen Number
+10 ;LRVERZ=0 if only LRORD, 1 if LRODT,LRSN exists. Used to maintain backward compatibility at Tuscaloosa when only LRORD was used.
+11 NEW X,X1,I,J,CTR
+12 SET X=$PIECE(XMSG,"|",4)
SET LRORD=+X
SET LRODT=+$PIECE(X,";",2)
SET LRSN=+$PIECE(X,";",3)
SET LRVERZ=$SELECT(LRODT&LRSN:1,1:0)
+13 SET LRPLACR=$PIECE(XMSG,"|",3)
SET ORIFN=+LRPLACR
+14 IF 'ORIFN
DO ACK^LR7OF0("DE",XORC,"OE/RR order number not passed")
SET LREND=1
QUIT
+15 IF '$ORDER(XMSG(0))
SET STARTDT=$$FMDATE^LR7OU0($PIECE($PIECE(XMSG,"|",8),"^",4))
SET LRDUZ=$PIECE(XMSG,"|",11)
SET PROV=$PIECE(XMSG,"|",13)
SET REASON=$PIECE(XMSG,"|",17)
SET QUANT=$PIECE($PIECE(XMSG,"|",8),"^")
QUIT
+16 FOR CTR=1:1:$LENGTH(XMSG,"|")
SET X1(CTR)=$PIECE(XMSG,"|",CTR)
+17 SET J=0
FOR
SET J=$ORDER(XMSG(J))
IF J<1
QUIT
Begin DoDot:1
+18 SET I=1
IF $EXTRACT(XMSG(J))'="|"
SET X1(CTR)=X1(CTR)_$PIECE(XMSG(J),"|")
SET I=I+1
+19 FOR I=I:1:$LENGTH(XMSG(J),"|")
SET CTR=CTR+1
SET X1(CTR)=$PIECE(XMSG(J),"|",I)
End DoDot:1
+20 SET STARTDT=$$FMDATE^LR7OU0($PIECE(X1(8),"^",4))
+21 SET QUANT=$PIECE(X1(8),"^")
+22 SET LRDUZ=X1(11)
SET PROV=X1(13)
SET REASON=X1(17)
+23 QUIT
NTE ;Process Order comments from OE/RR
+1 ;MSG(i)="NTE|1|P|comment..."
+2 ;MSG(i,c)="...more comments..."
+3 NEW X,I,LINES
+4 SET X=$DATA(STARTDT)&($DATA(TYPE))&($DATA(SAMP))&($DATA(SPEC))&($DATA(LRSX))
+5 ;Trying to add comments to undefined test array in ^TMP
IF 'X
QUIT
+6 ;Trying to add comments to undefined test array in ^TMP
IF '$DATA(^TMP("OR",$JOB,"LROT",STARTDT,TYPE,SAMP,SPEC,LRSX))
QUIT
+7 IF '$DATA(^TMP("OR",$JOB,"COM",STARTDT,TYPE,SAMP,SPEC,LRSX))
SET ^(LRSX)=0
SET LINES=^(LRSX)
+8 IF $LENGTH($PIECE(LRXMSG,"|",4))
DO N1($PIECE(LRXMSG,"|",4))
+9 SET I=0
FOR
SET I=$ORDER(MSG(LINE,I))
IF I<1
QUIT
IF $LENGTH(MSG(LINE,I))
DO N1(MSG(LINE,I))
+10 QUIT
N1(X) ;
+1 SET LINES=LINES+1
SET ^TMP("OR",$JOB,"COM",STARTDT,TYPE,SAMP,SPEC,LRSX,LINES)=X
SET ^TMP("OR",$JOB,"COM",STARTDT,TYPE,SAMP,SPEC,LRSX)=LINES
+2 QUIT
