source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LR7OB3.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.0 KB
Line 
1LR7OB3 ;DALOI/DCM/JAH - Build message, backdoor from Lab order # ;8/10/04
2 ;;5.2;LAB SERVICE;**121,187,272,291**;Sep 27, 1994
369 K ^TMP("LRX",$J)
4 D 69^LR7OB69(ODT,SN) Q:'$D(^TMP("LRX",$J,69)) G OUT:'$D(DFN) D:LRFIRST FIRST^LR7OB0 S LRFIRST=0
5SNEAK ;
6 N Y,Y9,Y10,Y11,GRP,L1,L2,L3,END
7 S IFN=0 F S IFN=$O(^TMP("LRX",$J,69,IFN)) Q:IFN<1 S (COBR,COBX)=0 D
8 . I $O(^TMP("LRX",$J,69,IFN,68,0)) S Z=^TMP("LRX",$J,69,IFN,68) D Q
9 .. 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
10 ... 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"
11 ... S X1=$$UVID^LR7OU0($P(Z1,"^"),$P(^TMP("LRX",$J,69),"^",10),Y9,Y11,Y10,.MSG,$G(SS))
12 ... S X2=$$HL7DT^LR7OU0($P(Z,"^",4)) ;Obs Start date
13 ... S X3=$$ACTCODE^LR7OU0($P(^TMP("LRX",$J,69),"^",4)) ;Specimen Act Code
14 ... S X4=$$HL7DT^LR7OU0($P(Z,"^",5)) ;Specimen Received D/T
15 ... S X5=$$SAMP^LR7OU0($P(^TMP("LRX",$J,69),"^",3),$P(^TMP("LRX",$J,69),"^",10)) ;Specimen Source
16 ... S X6=$P(Z,"^",3) ;Filler Fld 1 (Accession)
17 ... S X7=$$HL7DT^LR7OU0($P(Z,"^",6)) ;Results rpt/Sts Change D/T
18 ... S (GRP,END)=0
19 ... I '$G(CORRECT),$P(Z,"^",6) S GRP=1
20 ... S X8=$S($G(CORRECT):"C",$P(Z,"^",6):$S(GRP:"F",1:"I"),$P(Z,"^",5):"I",1:"O") ;Result Status
21 ... D AX8
22 ... S X10=$P(^TMP("LRX",$J,69),"^",7),$P(@MSG@(3),"|",4)=X10 ;Routing Location
23 ... S X9="^^^^^"_$$URG^LR7OU0($P(^TMP("LRX",$J,69,IFN),"^",2))
24 ... I $O(LINK(0)) S CTR=CTR+1 D NTE^LR7OU01(2,"L","LINK(",CTR) K LINK
25 ... I $O(^TMP("LRX",$J,69,IFN,"NC",0)) S CTR=CTR+1 D NTE^LR7OU01("","L","^TMP(""LRX"",$J,69,"_IFN_",""NC"",",CTR)
26 ... I CONTROL'="SN" S CTR=CTR+1 D NTE^LR7OU01("","P","^TMP(""LRX"",$J,69,"_IFN_",""N"",",CTR)
27 ... I CONTROL'="SN" S CTR=CTR+1 D NTE^LR7OU01("","P","^TMP(""LRX"",$J,69,""N"",",CTR)
28 ... S CTR=CTR+1,COBR=COBR+1,OBRMSG=CTR D OBR^LR7OU01(CTR)
29 ... S CTR=CTR+1 D SDG1^LRBEBA2(IFN,.CTR,.MSG)
30 ... I CONTROL="SN" S CTR=CTR+1 D NTE^LR7OU01("","P","^TMP(""LRX"",$J,69,"_IFN_",""N"",",CTR)
31 ... I CONTROL="SN" S CTR=CTR+1 D NTE^LR7OU01("","P","^TMP(""LRX"",$J,69,""N"",",CTR)
32 .. 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
33 ... S X1=$S($L($P(Z1,"^",8)):$P(Z1,"^",8),1:"ST") ;Value type
34 ... S X2=$$UVID^LR7OU0($P(Z1,"^"),$P(^TMP("LRX",$J,69),"^",10),$P(Z1,"^",9),$P(Z1,"^",11),$P(Z1,"^",10),.MSG,$G(SS))
35 ... S X3=$P(Z1,"^",7) ;Obs SubID
36 ... S X4=$P(Z1,"^",2) S:$L($P(Z1,"^",9))&(MSG["LRAP") X4=$P(Z1,"^",9)_"^"_$P(Z1,"^",2)_"^"_$P(Z1,"^",10) ;Value
37 ... S X5=$P(Z1,"^",4) ;Units
38 ... S X6=$P(Z1,"^",5) ;Ref Ranges
39 ... S X7=$$FLAG^LR7OU0($P(Z1,"^",3)) ;Flag
40 ... S (GRP,END)=0
41 ... I '$G(CORRECT),$P(Z1,"^",6)="F"!($P(Z,"^",6)) S GRP=1
42 ... 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")
43 ... S $P(@MSG@(OBRMSG),"|",26)=X8 ;Result Status
44 ... I @MSG@(OBRMSG)'?.E1"|",$O(@MSG@(OBRMSG,0))]"" S @MSG@(OBRMSG)=@MSG@(OBRMSG)_"|" ;RLM
45 ... D AX8
46 ... 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
47 ... S X10=$P(Z1,"^",14) ;Theraputic flag
48 ... S X11=$P(Z1,"^",12) ;Verified by
49 ... S CTR=CTR+1,COBX=COBX+1 D OBX^LR7OU01(CTR)
50 .. 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)
51 . S Z=$G(^TMP("LRX",$J,69,IFN))
52 . 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"
53 . S X1=$$UVID^LR7OU0($P(Z,"^"),$P(^TMP("LRX",$J,69),"^",10),Y9,Y11,Y10,.MSG,$G(SS))
54 . S X2="" ;Obs Start date
55 . S X3=$$ACTCODE^LR7OU0($P(^TMP("LRX",$J,69),"^",4)) ;Specimen Action Code
56 . S X4="" ;Specimen Received D/T
57 . S X5=$$SAMP^LR7OU0($P(^TMP("LRX",$J,69),"^",3),$P(^TMP("LRX",$J,69),"^",10)) ;Specimen Source
58 . S X6="" ;Filler Fld 1 (Accession)
59 . S X7="" ;Results rpt/Sts change D/T
60 . S X8="O"
61 . I $G(CONTROL)="RE",$P(Z,"^",8) S X8=$S($G(CORRECT):"C",1:"F"),$P(@MSG@(ORCMSG),"|",6)="CM" ;Status
62 . S X10=$P(^TMP("LRX",$J,69),"^",7),$P(@MSG@(3),"|",4)=X10 ;Routing Location
63 . S X9="^^^^^"_$$URG^LR7OU0($P($G(^TMP("LRX",$J,69,IFN)),"^",2))
64 . I $O(LINK(0)) S CTR=CTR+1 D NTE^LR7OU01(2,"L","LINK(",CTR) K LINK
65 . I $O(^TMP("LRX",$J,69,IFN,"NC",0)) S CTR=CTR+1 D NTE^LR7OU01("","L","^TMP(""LRX"",$J,69,"_IFN_",""NC"",",CTR)
66 . I CONTROL'="SN" S CTR=CTR+1 D NTE^LR7OU01("","P","^TMP(""LRX"",$J,69,"_IFN_",""N"",",CTR)
67 . I CONTROL'="SN" S CTR=CTR+1 D NTE^LR7OU01("","P","^TMP(""LRX"",$J,69,""N"",",CTR)
68 . S CTR=CTR+1,COBR=COBR+1,OBRMSG=CTR D OBR^LR7OU01(CTR)
69 . S CTR=CTR+1 D SDG1^LRBEBA2(IFN,.CTR,.MSG)
70 . I CONTROL="SN" S CTR=CTR+1 D NTE^LR7OU01("","P","^TMP(""LRX"",$J,69,""N"",",CTR)
71 . I CONTROL="SN" S CTR=CTR+1 D NTE^LR7OU01("","P","^TMP(""LRX"",$J,69,"_IFN_",""N"",",CTR)
72OUT ;Exit here
73 K ^TMP("LRX",$J)
74 Q
75AX8 ;Modify order status based on result status
76 I X8="F"!(X8="C")!($G(LRSTATI)=2) S $P(@MSG@(ORCMSG),"|",6)="CM" Q ;Order Status
77 I X8="I" S $P(@MSG@(ORCMSG),"|",6)="SC"
78 Q
Note: See TracBrowser for help on using the repository browser.