LR7OB3 ;DALOI/DCM/JAH - Build message, backdoor from Lab order # ;8/10/04
;;5.2;AUTOMATED LAB INSTRUMENTS;**1003,1031**;NOV 01, 1997
;
;;VA LR Patche(s): 121,187,272,291
;
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
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
... S (GRP,END)=0
... I '$G(CORRECT),$P(Z,"^",6) S GRP=1
... S X8=$S($G(CORRECT):"C",$P(Z,"^",6):$S(GRP:"F",1:"I"),$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
... 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
... 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)
. 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
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
LR7OB3 ;DALOI/DCM/JAH - Build message, backdoor from Lab order # ;8/10/04
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**1003,1031**;NOV 01, 1997
+2 ;
+3 ;;VA LR Patche(s): 121,187,272,291
+4 ;
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
+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 SET (GRP,END)=0
+14 IF '$GET(CORRECT)
IF $PIECE(Z,"^",6)
SET GRP=1
+15 ;Result Status
SET X8=$SELECT($GET(CORRECT):"C",$PIECE(Z,"^",6):$SELECT(GRP:"F",1:"I"),$PIECE(Z,"^",5):"I",1:"O")
+16 DO AX8
+17 ;Routing Location
SET X10=$PIECE(^TMP("LRX",$JOB,69),"^",7)
SET $PIECE(@MSG@(3),"|",4)=X10
+18 SET X9="^^^^^"_$$URG^LR7OU0($PIECE(^TMP("LRX",$JOB,69,IFN),"^",2))
+19 IF $ORDER(LINK(0))
SET CTR=CTR+1
DO NTE^LR7OU01(2,"L","LINK(",CTR)
KILL LINK
+20 IF $ORDER(^TMP("LRX",$JOB,69,IFN,"NC",0))
SET CTR=CTR+1
DO NTE^LR7OU01("","L","^TMP(""LRX"",$J,69,"_IFN_",""NC"",",CTR)
+21 IF CONTROL'="SN"
SET CTR=CTR+1
DO NTE^LR7OU01("","P","^TMP(""LRX"",$J,69,"_IFN_",""N"",",CTR)
+22 IF CONTROL'="SN"
SET CTR=CTR+1
DO NTE^LR7OU01("","P","^TMP(""LRX"",$J,69,""N"",",CTR)
+23 SET CTR=CTR+1
SET COBR=COBR+1
SET OBRMSG=CTR
DO OBR^LR7OU01(CTR)
+24 SET CTR=CTR+1
DO SDG1^LRBEBA2(IFN,.CTR,.MSG)
+25 IF CONTROL="SN"
SET CTR=CTR+1
DO NTE^LR7OU01("","P","^TMP(""LRX"",$J,69,"_IFN_",""N"",",CTR)
+26 IF CONTROL="SN"
SET CTR=CTR+1
DO NTE^LR7OU01("","P","^TMP(""LRX"",$J,69,""N"",",CTR)
End DoDot:3
+27 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
+28 ;Value type
SET X1=$SELECT($LENGTH($PIECE(Z1,"^",8)):$PIECE(Z1,"^",8),1:"ST")
+29 SET X2=$$UVID^LR7OU0($PIECE(Z1,"^"),$PIECE(^TMP("LRX",$JOB,69),"^",10),$PIECE(Z1,"^",9),$PIECE(Z1,"^",11),$PIECE(Z1,"^",10),.MSG,$GET(SS))
+30 ;Obs SubID
SET X3=$PIECE(Z1,"^",7)
+31 ;Value
SET X4=$PIECE(Z1,"^",2)
IF $LENGTH($PIECE(Z1,"^",9))&(MSG["LRAP")
SET X4=$PIECE(Z1,"^",9)_"^"_$PIECE(Z1,"^",2)_"^"_$PIECE(Z1,"^",10)
+32 ;Units
SET X5=$PIECE(Z1,"^",4)
+33 ;Ref Ranges
SET X6=$PIECE(Z1,"^",5)
+34 ;Flag
SET X7=$$FLAG^LR7OU0($PIECE(Z1,"^",3))
+35 SET (GRP,END)=0
+36 IF '$GET(CORRECT)
IF $PIECE(Z1,"^",6)="F"!($PIECE(Z,"^",6))
SET GRP=1
+37 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")
+38 ;Result Status
SET $PIECE(@MSG@(OBRMSG),"|",26)=X8
+39 ;RLM
IF @MSG@(OBRMSG)'?.E1"|"
IF $ORDER(@MSG@(OBRMSG,0))]""
SET @MSG@(OBRMSG)=@MSG@(OBRMSG)_"|"
+40 DO AX8
+41 ;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
+42 ;Theraputic flag
SET X10=$PIECE(Z1,"^",14)
+43 ;Verified by
SET X11=$PIECE(Z1,"^",12)
+44 SET CTR=CTR+1
SET COBX=COBX+1
DO OBX^LR7OU01(CTR)
End DoDot:3
+45 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
+46 SET Z=$GET(^TMP("LRX",$JOB,69,IFN))
+47 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"
+48 SET X1=$$UVID^LR7OU0($PIECE(Z,"^"),$PIECE(^TMP("LRX",$JOB,69),"^",10),Y9,Y11,Y10,.MSG,$GET(SS))
+49 ;Obs Start date
SET X2=""
+50 ;Specimen Action Code
SET X3=$$ACTCODE^LR7OU0($PIECE(^TMP("LRX",$JOB,69),"^",4))
+51 ;Specimen Received D/T
SET X4=""
+52 ;Specimen Source
SET X5=$$SAMP^LR7OU0($PIECE(^TMP("LRX",$JOB,69),"^",3),$PIECE(^TMP("LRX",$JOB,69),"^",10))
+53 ;Filler Fld 1 (Accession)
SET X6=""
+54 ;Results rpt/Sts change D/T
SET X7=""
+55 SET X8="O"
+56 ;Status
IF $GET(CONTROL)="RE"
IF $PIECE(Z,"^",8)
SET X8=$SELECT($GET(CORRECT):"C",1:"F")
SET $PIECE(@MSG@(ORCMSG),"|",6)="CM"
+57 ;Routing Location
SET X10=$PIECE(^TMP("LRX",$JOB,69),"^",7)
SET $PIECE(@MSG@(3),"|",4)=X10
+58 SET X9="^^^^^"_$$URG^LR7OU0($PIECE($GET(^TMP("LRX",$JOB,69,IFN)),"^",2))
+59 IF $ORDER(LINK(0))
SET CTR=CTR+1
DO NTE^LR7OU01(2,"L","LINK(",CTR)
KILL LINK
+60 IF $ORDER(^TMP("LRX",$JOB,69,IFN,"NC",0))
SET CTR=CTR+1
DO NTE^LR7OU01("","L","^TMP(""LRX"",$J,69,"_IFN_",""NC"",",CTR)
+61 IF CONTROL'="SN"
SET CTR=CTR+1
DO NTE^LR7OU01("","P","^TMP(""LRX"",$J,69,"_IFN_",""N"",",CTR)
+62 IF CONTROL'="SN"
SET CTR=CTR+1
DO NTE^LR7OU01("","P","^TMP(""LRX"",$J,69,""N"",",CTR)
+63 SET CTR=CTR+1
SET COBR=COBR+1
SET OBRMSG=CTR
DO OBR^LR7OU01(CTR)
+64 SET CTR=CTR+1
DO SDG1^LRBEBA2(IFN,.CTR,.MSG)
+65 IF CONTROL="SN"
SET CTR=CTR+1
DO NTE^LR7OU01("","P","^TMP(""LRX"",$J,69,""N"",",CTR)
+66 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 ;Order Status
IF X8="F"!(X8="C")!($GET(LRSTATI)=2)
SET $PIECE(@MSG@(ORCMSG),"|",6)="CM"
QUIT
+2 IF X8="I"
SET $PIECE(@MSG@(ORCMSG),"|",6)="SC"
+3 QUIT
