LR7OB3 ;DALOI/DCM/JAH - Build message, backdoor from Lab order #;Sep 27, 2018@10:00:00
;;5.2;LAB SERVICE;**121,187,272,291,462,512,541**;Sep 27, 1994;Build 7
69 K ^TMP("LRX",$J)
D 69^LR7OB69(ODT,SN) Q:'$D(^TMP("LRX",$J,69)) G OUT:'$D(DFN) D:LRFIRST FIRST^LR7OB0 S LRFIRST=0
SNEAK ;
N Y,Y9,Y10,Y11,GRP,L1,L2,L3,END,LROR100
S IFN=0 F S IFN=$O(^TMP("LRX",$J,69,IFN)) Q:IFN<1 S (COBR,COBX)=0 D
. I $O(^TMP("LRX",$J,69,IFN,68,0)) S Z=^TMP("LRX",$J,69,IFN,68) D Q
.. S IFN1=0 F S IFN1=$O(^TMP("LRX",$J,69,IFN,68,IFN1)) Q:IFN1<1 S Z1=^TMP("LRX",$J,69,IFN,68,IFN1) D
... S (Y9,Y10,Y11)="" I $P($G(^LAB(60,+Z1,64)),"^") S Y9=$P(^(64),"^"),Y10=$P(^LAM(Y9,0),"^"),Y9=$P(^(0),"^",2),Y11="99NLT"
... S X1=$$UVID^LR7OU0($P(Z1,"^"),$P(^TMP("LRX",$J,69),"^",10),Y9,Y11,Y10,.MSG,$G(SS))
... S X2=$$HL7DT^LR7OU0($P(Z,"^",4)) ;Obs Start date
... S X3=$$ACTCODE^LR7OU0($P(^TMP("LRX",$J,69),"^",4)) ;Specimen Act Code
... S X4=$$HL7DT^LR7OU0($P(Z,"^",5)) ;Specimen Received D/T
... S X5=$$SAMP^LR7OU0($P(^TMP("LRX",$J,69),"^",3),$P(^TMP("LRX",$J,69),"^",10)) ;Specimen Source
... S X6=$P(Z,"^",3) ;Filler Fld 1 (Accession)
... S X7=$$HL7DT^LR7OU0($P(Z,"^",6)) ;Results rpt/Sts Change D/T
... ;CPRS order number:
... S LROR100=$P($G(^TMP("LRX",$J,69,IFN)),"^",7)
... ;
... ;Check to see if the CPRS order number matches the ORC order number
... I $P($P(@MSG@(ORCMSG),"|",3),"^")'=LROR100 D
.... N LRORC
.... S LRORC=$P(@MSG@(ORCMSG),"|",3)
.... S $P(LRORC,"^")=LROR100
.... S $P(@MSG@(ORCMSG),"|",3)=LRORC
... S (GRP,END)=0
... I '$G(CORRECT),$P(Z,"^",6) S GRP=1
... ;LR*5.2*512 change on line below so that status of each panel and/or
... ;atomic test is evaluated: added $P(Z1,"^",4):"F"
... ;Variables:
... ; Z = (1) Lab order number ^ (2) LRDFN ^ (3) accession ^ (4) draw time ^
... ; (5) lab arrival time ^ (6) date/time results available (i.e. accession complete date)
... ; (7) inverse date (i.e. file 63 subscript corresponding to this accession)
... ;
... ; Z1 = (1) test number ^ (2) test urgency ^ (3) technologist ^ (4) complete date/time ^
... ;
... S X8=$S($G(CORRECT):"C",$P(Z,"^",6):$S(GRP:"F",1:"I"),$P(Z1,"^",4):"F",$P(Z,"^",5):"I",1:"O") ;Result Status
... D AX8
... S X10=$P(^TMP("LRX",$J,69),"^",7),$P(@MSG@(3),"|",4)=X10 ;Routing Location
... S X9="^^^^^"_$$URG^LR7OU0($P(^TMP("LRX",$J,69,IFN),"^",2))
... I $O(LINK(0)) S CTR=CTR+1 D NTE^LR7OU01(2,"L","LINK(",CTR) K LINK
... I $O(^TMP("LRX",$J,69,IFN,"NC",0)) S CTR=CTR+1 D NTE^LR7OU01("","L","^TMP(""LRX"",$J,69,"_IFN_",""NC"",",CTR)
... I CONTROL'="SN" S CTR=CTR+1 D NTE^LR7OU01("","P","^TMP(""LRX"",$J,69,"_IFN_",""N"",",CTR)
... I CONTROL'="SN" S CTR=CTR+1 D NTE^LR7OU01("","P","^TMP(""LRX"",$J,69,""N"",",CTR)
... S CTR=CTR+1,COBR=COBR+1,OBRMSG=CTR D OBR^LR7OU01(CTR)
... S CTR=CTR+1 D SDG1^LRBEBA2(IFN,.CTR,.MSG)
... I CONTROL="SN" S CTR=CTR+1 D NTE^LR7OU01("","P","^TMP(""LRX"",$J,69,"_IFN_",""N"",",CTR)
... I CONTROL="SN" S CTR=CTR+1 D NTE^LR7OU01("","P","^TMP(""LRX"",$J,69,""N"",",CTR)
.. S IFN1=0 F S IFN1=$O(^TMP("LRX",$J,69,IFN,63,IFN1)) Q:IFN1<1 S Z1=^TMP("LRX",$J,69,IFN,63,IFN1) D
... S X1=$S($L($P(Z1,"^",8)):$P(Z1,"^",8),1:"ST") ;Value type
... S X2=$$UVID^LR7OU0($P(Z1,"^"),$P(^TMP("LRX",$J,69),"^",10),$P(Z1,"^",9),$P(Z1,"^",11),$P(Z1,"^",10),.MSG,$G(SS))
... S X3=$P(Z1,"^",7) ;Obs SubID
... S X4=$P(Z1,"^",2) S:$L($P(Z1,"^",9))&(MSG["LRAP") X4=$P(Z1,"^",9)_"^"_$P(Z1,"^",2)_"^"_$P(Z1,"^",10) ;Value
... S X5=$P(Z1,"^",4) ;Units
... S X6=$P(Z1,"^",5) ;Ref Ranges
... S X7=$$FLAG^LR7OU0($P(Z1,"^",3)) ;Flag
... S (GRP,END)=0
... I '$G(CORRECT),$P(Z1,"^",6)="F"!($P(Z,"^",6)) S GRP=1
... S X8=$S($G(CORRECT):"C",$P(Z1,"^",6)="F"!($P(Z,"^",6)):$S(GRP:"F",1:"I"),$L($P(Z1,"^",6)):$S($P(Z1,"^",6)'="F":$P(Z1,"^",6),1:"R"),1:"R")
... S $P(@MSG@(OBRMSG),"|",26)=X8 ;Result Status
... I @MSG@(OBRMSG)'?.E1"|",$O(@MSG@(OBRMSG,0))]"" S @MSG@(OBRMSG)=@MSG@(OBRMSG)_"|" ;RLM
... ;LR*5.2*512 commenting out line below
... ;because a single result status should not update
... ;the overall order status in the ORC segment
... ;LR*5.2*541: invoking line below only if:
... ; (1) not in full edit mode logic (as in LEDI or if user elects not to do full edit)
... ; (2) and if status of a test is preliminary. Any preliminary test should cause an
... ; order to remain at "active" status.
... I $D(LREDITTYPE),LREDITTYPE<3 S:X8="P" X8="I" D AX8
... I $L($P(Z1,"^",18)) S X=$P(@MSG@(ORCMSG),"|",4),Y=$P(X,"^",2),X=$P(X,"^")_$P(Z1,"^",18) S $P(@MSG@(ORCMSG),"|",4)=X_"^"_Y ;Append 63 ptr to placer ID
... I "SPCYEM"[$P($G(X),";",4)&($L($P(X,";",5))) S $P(@MSG@(ORCMSG),"|",4)=X_"^LRAP" ;;* added to correct result update to CPRS where the package reference was not being updated properly for AP results
... ; X=ORD#;LRODT;LRSN;LRSS;LRIDT, indirect set of ^TMP("LRAP",$J
... S X10=$P(Z1,"^",14) ;Theraputic flag
... S X11=$P(Z1,"^",12) ;Verified by
... S CTR=CTR+1,COBX=COBX+1 D OBX^LR7OU01(CTR)
.. I $O(^TMP("LRX",$J,69,IFN,63,0)),$O(^("N",0)) S CTR=CTR+1 D NTE^LR7OU01("","L","^TMP(""LRX"",$J,69,"_IFN_",63,""N"",",CTR)
. ;
. ;Note to anyone researching this routine in the future:
. ;The lines below are not called because of the quit after the loop at SNEAK+3
. ;(not deleting them in case the lines are needed in the future.)
. ;
. S Z=$G(^TMP("LRX",$J,69,IFN))
. S (Y9,Y10,Y11)="" I $P($G(^LAB(60,+Z,64)),"^") S Y9=$P(^(64),"^"),Y10=$P(^LAM(Y9,0),"^"),Y9=$P(^(0),"^",2),Y11="99NLT"
. S X1=$$UVID^LR7OU0($P(Z,"^"),$P(^TMP("LRX",$J,69),"^",10),Y9,Y11,Y10,.MSG,$G(SS))
. S X2="" ;Obs Start date
. S X3=$$ACTCODE^LR7OU0($P(^TMP("LRX",$J,69),"^",4)) ;Specimen Action Code
. S X4="" ;Specimen Received D/T
. S X5=$$SAMP^LR7OU0($P(^TMP("LRX",$J,69),"^",3),$P(^TMP("LRX",$J,69),"^",10)) ;Specimen Source
. S X6="" ;Filler Fld 1 (Accession)
. S X7="" ;Results rpt/Sts change D/T
. S X8="O"
. I $G(CONTROL)="RE",$P(Z,"^",8) S X8=$S($G(CORRECT):"C",1:"F"),$P(@MSG@(ORCMSG),"|",6)="CM" ;Status
. S X10=$P(^TMP("LRX",$J,69),"^",7),$P(@MSG@(3),"|",4)=X10 ;Routing Location
. S X9="^^^^^"_$$URG^LR7OU0($P($G(^TMP("LRX",$J,69,IFN)),"^",2))
. I $O(LINK(0)) S CTR=CTR+1 D NTE^LR7OU01(2,"L","LINK(",CTR) K LINK
. I $O(^TMP("LRX",$J,69,IFN,"NC",0)) S CTR=CTR+1 D NTE^LR7OU01("","L","^TMP(""LRX"",$J,69,"_IFN_",""NC"",",CTR)
. I CONTROL'="SN" S CTR=CTR+1 D NTE^LR7OU01("","P","^TMP(""LRX"",$J,69,"_IFN_",""N"",",CTR)
. I CONTROL'="SN" S CTR=CTR+1 D NTE^LR7OU01("","P","^TMP(""LRX"",$J,69,""N"",",CTR)
. S CTR=CTR+1,COBR=COBR+1,OBRMSG=CTR D OBR^LR7OU01(CTR)
. S CTR=CTR+1 D SDG1^LRBEBA2(IFN,.CTR,.MSG)
. I CONTROL="SN" S CTR=CTR+1 D NTE^LR7OU01("","P","^TMP(""LRX"",$J,69,""N"",",CTR)
. I CONTROL="SN" S CTR=CTR+1 D NTE^LR7OU01("","P","^TMP(""LRX"",$J,69,"_IFN_",""N"",",CTR)
OUT ;Exit here
K ^TMP("LRX",$J)
Q
AX8 ;Modify order status based on result status
;LR*5.2*512 added three lines below for panels
;Routine LRVER3A sets ^TMP("LR",$J,"PANEL",order number)=status (final or active)
I $G(LROR100)]"",$D(^TMP("LR",$J,"PANEL",LROR100)) D Q
. Q:$P($P(@MSG@(ORCMSG),"|",3),"^")'=LROR100
. S $P(@MSG@(ORCMSG),"|",6)=$S($G(^TMP("LR",$J,"PANEL",LROR100)):"CM",1:"SC")
I X8="F"!(X8="C")!($G(LRSTATI)=2) S $P(@MSG@(ORCMSG),"|",6)="CM" Q ;Order Status
I X8="I" S $P(@MSG@(ORCMSG),"|",6)="SC"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR7OB3 7423 printed Apr 09, 2024@21:19:54 Page 2
LR7OB3 ;DALOI/DCM/JAH - Build message, backdoor from Lab order #;Sep 27, 2018@10:00:00
+1 ;;5.2;LAB SERVICE;**121,187,272,291,462,512,541**;Sep 27, 1994;Build 7
69 KILL ^TMP("LRX",$JOB)
+1 DO 69^LR7OB69(ODT,SN)
if '$DATA(^TMP("LRX",$JOB,69))
QUIT
if '$DATA(DFN)
GOTO OUT
if LRFIRST
DO FIRST^LR7OB0
SET LRFIRST=0
SNEAK ;
+1 NEW Y,Y9,Y10,Y11,GRP,L1,L2,L3,END,LROR100
+2 SET IFN=0
FOR
SET IFN=$ORDER(^TMP("LRX",$JOB,69,IFN))
if IFN<1
QUIT
SET (COBR,COBX)=0
Begin DoDot:1
+3 IF $ORDER(^TMP("LRX",$JOB,69,IFN,68,0))
SET Z=^TMP("LRX",$JOB,69,IFN,68)
Begin DoDot:2
+4 SET IFN1=0
FOR
SET IFN1=$ORDER(^TMP("LRX",$JOB,69,IFN,68,IFN1))
if IFN1<1
QUIT
SET Z1=^TMP("LRX",$JOB,69,IFN,68,IFN1)
Begin DoDot:3
+5 SET (Y9,Y10,Y11)=""
IF $PIECE($GET(^LAB(60,+Z1,64)),"^")
SET Y9=$PIECE(^(64),"^")
SET Y10=$PIECE(^LAM(Y9,0),"^")
SET Y9=$PIECE(^(0),"^",2)
SET Y11="99NLT"
+6 SET X1=$$UVID^LR7OU0($PIECE(Z1,"^"),$PIECE(^TMP("LRX",$JOB,69),"^",10),Y9,Y11,Y10,.MSG,$GET(SS))
+7 ;Obs Start date
SET X2=$$HL7DT^LR7OU0($PIECE(Z,"^",4))
+8 ;Specimen Act Code
SET X3=$$ACTCODE^LR7OU0($PIECE(^TMP("LRX",$JOB,69),"^",4))
+9 ;Specimen Received D/T
SET X4=$$HL7DT^LR7OU0($PIECE(Z,"^",5))
+10 ;Specimen Source
SET X5=$$SAMP^LR7OU0($PIECE(^TMP("LRX",$JOB,69),"^",3),$PIECE(^TMP("LRX",$JOB,69),"^",10))
+11 ;Filler Fld 1 (Accession)
SET X6=$PIECE(Z,"^",3)
+12 ;Results rpt/Sts Change D/T
SET X7=$$HL7DT^LR7OU0($PIECE(Z,"^",6))
+13 ;CPRS order number:
+14 SET LROR100=$PIECE($GET(^TMP("LRX",$JOB,69,IFN)),"^",7)
+15 ;
+16 ;Check to see if the CPRS order number matches the ORC order number
+17 IF $PIECE($PIECE(@MSG@(ORCMSG),"|",3),"^")'=LROR100
Begin DoDot:4
+18 NEW LRORC
+19 SET LRORC=$PIECE(@MSG@(ORCMSG),"|",3)
+20 SET $PIECE(LRORC,"^")=LROR100
+21 SET $PIECE(@MSG@(ORCMSG),"|",3)=LRORC
End DoDot:4
+22 SET (GRP,END)=0
+23 IF '$GET(CORRECT)
IF $PIECE(Z,"^",6)
SET GRP=1
+24 ;LR*5.2*512 change on line below so that status of each panel and/or
+25 ;atomic test is evaluated: added $P(Z1,"^",4):"F"
+26 ;Variables:
+27 ; Z = (1) Lab order number ^ (2) LRDFN ^ (3) accession ^ (4) draw time ^
+28 ; (5) lab arrival time ^ (6) date/time results available (i.e. accession complete date)
+29 ; (7) inverse date (i.e. file 63 subscript corresponding to this accession)
+30 ;
+31 ; Z1 = (1) test number ^ (2) test urgency ^ (3) technologist ^ (4) complete date/time ^
+32 ;
+33 ;Result Status
SET X8=$SELECT($GET(CORRECT):"C",$PIECE(Z,"^",6):$SELECT(GRP:"F",1:"I"),$PIECE(Z1,"^",4):"F",$PIECE(Z,"^",5):"I",1:"O")
+34 DO AX8
+35 ;Routing Location
SET X10=$PIECE(^TMP("LRX",$JOB,69),"^",7)
SET $PIECE(@MSG@(3),"|",4)=X10
+36 SET X9="^^^^^"_$$URG^LR7OU0($PIECE(^TMP("LRX",$JOB,69,IFN),"^",2))
+37 IF $ORDER(LINK(0))
SET CTR=CTR+1
DO NTE^LR7OU01(2,"L","LINK(",CTR)
KILL LINK
+38 IF $ORDER(^TMP("LRX",$JOB,69,IFN,"NC",0))
SET CTR=CTR+1
DO NTE^LR7OU01("","L","^TMP(""LRX"",$J,69,"_IFN_",""NC"",",CTR)
+39 IF CONTROL'="SN"
SET CTR=CTR+1
DO NTE^LR7OU01("","P","^TMP(""LRX"",$J,69,"_IFN_",""N"",",CTR)
+40 IF CONTROL'="SN"
SET CTR=CTR+1
DO NTE^LR7OU01("","P","^TMP(""LRX"",$J,69,""N"",",CTR)
+41 SET CTR=CTR+1
SET COBR=COBR+1
SET OBRMSG=CTR
DO OBR^LR7OU01(CTR)
+42 SET CTR=CTR+1
DO SDG1^LRBEBA2(IFN,.CTR,.MSG)
+43 IF CONTROL="SN"
SET CTR=CTR+1
DO NTE^LR7OU01("","P","^TMP(""LRX"",$J,69,"_IFN_",""N"",",CTR)
+44 IF CONTROL="SN"
SET CTR=CTR+1
DO NTE^LR7OU01("","P","^TMP(""LRX"",$J,69,""N"",",CTR)
End DoDot:3
+45 SET IFN1=0
FOR
SET IFN1=$ORDER(^TMP("LRX",$JOB,69,IFN,63,IFN1))
if IFN1<1
QUIT
SET Z1=^TMP("LRX",$JOB,69,IFN,63,IFN1)
Begin DoDot:3
+46 ;Value type
SET X1=$SELECT($LENGTH($PIECE(Z1,"^",8)):$PIECE(Z1,"^",8),1:"ST")
+47 SET X2=$$UVID^LR7OU0($PIECE(Z1,"^"),$PIECE(^TMP("LRX",$JOB,69),"^",10),$PIECE(Z1,"^",9),$PIECE(Z1,"^",11),$PIECE(Z1,"^",10),.MSG,$GET(SS))
+48 ;Obs SubID
SET X3=$PIECE(Z1,"^",7)
+49 ;Value
SET X4=$PIECE(Z1,"^",2)
if $LENGTH($PIECE(Z1,"^",9))&(MSG["LRAP")
SET X4=$PIECE(Z1,"^",9)_"^"_$PIECE(Z1,"^",2)_"^"_$PIECE(Z1,"^",10)
+50 ;Units
SET X5=$PIECE(Z1,"^",4)
+51 ;Ref Ranges
SET X6=$PIECE(Z1,"^",5)
+52 ;Flag
SET X7=$$FLAG^LR7OU0($PIECE(Z1,"^",3))
+53 SET (GRP,END)=0
+54 IF '$GET(CORRECT)
IF $PIECE(Z1,"^",6)="F"!($PIECE(Z,"^",6))
SET GRP=1
+55 SET X8=$SELECT($GET(CORRECT):"C",$PIECE(Z1,"^",6)="F"!($PIECE(Z,"^",6)):$SELECT(GRP:"F",1:"I"),$LENGTH($PIECE(Z1,"^",6)):$SELECT($PIECE(Z1,"^",6)'="F":$PIECE(Z1,"^",6),1:"R"),1:"R")
+56 ;Result Status
SET $PIECE(@MSG@(OBRMSG),"|",26)=X8
+57 ;RLM
IF @MSG@(OBRMSG)'?.E1"|"
IF $ORDER(@MSG@(OBRMSG,0))]""
SET @MSG@(OBRMSG)=@MSG@(OBRMSG)_"|"
+58 ;LR*5.2*512 commenting out line below
+59 ;because a single result status should not update
+60 ;the overall order status in the ORC segment
+61 ;LR*5.2*541: invoking line below only if:
+62 ; (1) not in full edit mode logic (as in LEDI or if user elects not to do full edit)
+63 ; (2) and if status of a test is preliminary. Any preliminary test should cause an
+64 ; order to remain at "active" status.
+65 IF $DATA(LREDITTYPE)
IF LREDITTYPE<3
if X8="P"
SET X8="I"
DO AX8
+66 ;Append 63 ptr to placer ID
IF $LENGTH($PIECE(Z1,"^",18))
SET X=$PIECE(@MSG@(ORCMSG),"|",4)
SET Y=$PIECE(X,"^",2)
SET X=$PIECE(X,"^")_$PIECE(Z1,"^",18)
SET $PIECE(@MSG@(ORCMSG),"|",4)=X_"^"_Y
+67 ;;* added to correct result update to CPRS where the package reference was not being updated properly for AP results
IF "SPCYEM"[$PIECE($GET(X),";",4)&($LENGTH($PIECE(X,";",5)))
SET $PIECE(@MSG@(ORCMSG),"|",4)=X_"^LRAP"
+68 ; X=ORD#;LRODT;LRSN;LRSS;LRIDT, indirect set of ^TMP("LRAP",$J
+69 ;Theraputic flag
SET X10=$PIECE(Z1,"^",14)
+70 ;Verified by
SET X11=$PIECE(Z1,"^",12)
+71 SET CTR=CTR+1
SET COBX=COBX+1
DO OBX^LR7OU01(CTR)
End DoDot:3
+72 IF $ORDER(^TMP("LRX",$JOB,69,IFN,63,0))
IF $ORDER(^("N",0))
SET CTR=CTR+1
DO NTE^LR7OU01("","L","^TMP(""LRX"",$J,69,"_IFN_",63,""N"",",CTR)
End DoDot:2
QUIT
+73 ;
+74 ;Note to anyone researching this routine in the future:
+75 ;The lines below are not called because of the quit after the loop at SNEAK+3
+76 ;(not deleting them in case the lines are needed in the future.)
+77 ;
+78 SET Z=$GET(^TMP("LRX",$JOB,69,IFN))
+79 SET (Y9,Y10,Y11)=""
IF $PIECE($GET(^LAB(60,+Z,64)),"^")
SET Y9=$PIECE(^(64),"^")
SET Y10=$PIECE(^LAM(Y9,0),"^")
SET Y9=$PIECE(^(0),"^",2)
SET Y11="99NLT"
+80 SET X1=$$UVID^LR7OU0($PIECE(Z,"^"),$PIECE(^TMP("LRX",$JOB,69),"^",10),Y9,Y11,Y10,.MSG,$GET(SS))
+81 ;Obs Start date
SET X2=""
+82 ;Specimen Action Code
SET X3=$$ACTCODE^LR7OU0($PIECE(^TMP("LRX",$JOB,69),"^",4))
+83 ;Specimen Received D/T
SET X4=""
+84 ;Specimen Source
SET X5=$$SAMP^LR7OU0($PIECE(^TMP("LRX",$JOB,69),"^",3),$PIECE(^TMP("LRX",$JOB,69),"^",10))
+85 ;Filler Fld 1 (Accession)
SET X6=""
+86 ;Results rpt/Sts change D/T
SET X7=""
+87 SET X8="O"
+88 ;Status
IF $GET(CONTROL)="RE"
IF $PIECE(Z,"^",8)
SET X8=$SELECT($GET(CORRECT):"C",1:"F")
SET $PIECE(@MSG@(ORCMSG),"|",6)="CM"
+89 ;Routing Location
SET X10=$PIECE(^TMP("LRX",$JOB,69),"^",7)
SET $PIECE(@MSG@(3),"|",4)=X10
+90 SET X9="^^^^^"_$$URG^LR7OU0($PIECE($GET(^TMP("LRX",$JOB,69,IFN)),"^",2))
+91 IF $ORDER(LINK(0))
SET CTR=CTR+1
DO NTE^LR7OU01(2,"L","LINK(",CTR)
KILL LINK
+92 IF $ORDER(^TMP("LRX",$JOB,69,IFN,"NC",0))
SET CTR=CTR+1
DO NTE^LR7OU01("","L","^TMP(""LRX"",$J,69,"_IFN_",""NC"",",CTR)
+93 IF CONTROL'="SN"
SET CTR=CTR+1
DO NTE^LR7OU01("","P","^TMP(""LRX"",$J,69,"_IFN_",""N"",",CTR)
+94 IF CONTROL'="SN"
SET CTR=CTR+1
DO NTE^LR7OU01("","P","^TMP(""LRX"",$J,69,""N"",",CTR)
+95 SET CTR=CTR+1
SET COBR=COBR+1
SET OBRMSG=CTR
DO OBR^LR7OU01(CTR)
+96 SET CTR=CTR+1
DO SDG1^LRBEBA2(IFN,.CTR,.MSG)
+97 IF CONTROL="SN"
SET CTR=CTR+1
DO NTE^LR7OU01("","P","^TMP(""LRX"",$J,69,""N"",",CTR)
+98 IF CONTROL="SN"
SET CTR=CTR+1
DO NTE^LR7OU01("","P","^TMP(""LRX"",$J,69,"_IFN_",""N"",",CTR)
End DoDot:1
OUT ;Exit here
+1 KILL ^TMP("LRX",$JOB)
+2 QUIT
AX8 ;Modify order status based on result status
+1 ;LR*5.2*512 added three lines below for panels
+2 ;Routine LRVER3A sets ^TMP("LR",$J,"PANEL",order number)=status (final or active)
+3 IF $GET(LROR100)]""
IF $DATA(^TMP("LR",$JOB,"PANEL",LROR100))
Begin DoDot:1
+4 if $PIECE($PIECE(@MSG@(ORCMSG),"|",3),"^")'=LROR100
QUIT
+5 SET $PIECE(@MSG@(ORCMSG),"|",6)=$SELECT($GET(^TMP("LR",$JOB,"PANEL",LROR100)):"CM",1:"SC")
End DoDot:1
QUIT
+6 ;Order Status
IF X8="F"!(X8="C")!($GET(LRSTATI)=2)
SET $PIECE(@MSG@(ORCMSG),"|",6)="CM"
QUIT
+7 IF X8="I"
SET $PIECE(@MSG@(ORCMSG),"|",6)="SC"
+8 QUIT
