source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7VORUA.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 2.6 KB
Line 
1LA7VORUA ;DALOI/JMC - Builder of HL7 Lab Results NTE ; 4/10/2002
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**61,64**;Sep 27, 1994
3 ;
4 ;
5NTE ; Build NTE segment
6 ;
7 N LA7NTE,LA7SOC,LA7TXT,LA7X,X
8 ;
9 ; Initialize segment set id
10 S LA7NTESN=0
11 ; Source of comment - handle other system's special codes, i.e. DOD-CHCS
12 S LA7SOC=$S($G(LA7NVAF)=1:"AC",1:"L")
13 ;
14 ; Send "MI" specimen's comments
15 I LA("SUB")="MI" D
16 . K LA7NTE
17 . S LA7TXT=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),99))
18 . S LA7TXT=$$TRIM^XLFSTR(LA7TXT,"R"," ")
19 . I LA7TXT="" Q
20 . D NTE^LA7VORU1
21 ;
22 ; Send "CH" specimen's comments
23 I LA("SUB")="CH" D
24 . S LA7X=0
25 . F S LA7X=$O(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),1,LA7X)) Q:'LA7X D
26 . . K LA7NTE
27 . . S LA7TXT=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),1,LA7X,0))
28 . . D BNTE
29 Q
30 ;
31 ;
32PLC ; Performing lab comment
33 N LA74,LA7DIV,LA7NTE,LA7RNLT,LA7SOC,LA7TSTN,LA7TXT,LA7X,X
34 S (LA74,LA7DIV,LA7RNLT,LA7TSTN)=""
35 ;
36 ; Source of comment - handle other system's special codes, i.e. DOD-CHCS
37 S LA7SOC=$S($G(LA7NVAF)=1:"DS",1:"L")
38 ;
39 ; Find reporting facility (division).
40 I LA("SUB")="CH" D
41 . S LA7X=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),$P(LA7VT,"^")))
42 . S LA74=$P(LA7X,"^",9)
43 . S LA7RNLT=$P($P(LA7X,"^",3),"!",2)
44 I LA74="" S LA74=+$P($G(^XMB(1,1,"XUS")),"^",17)
45 I LA74 S LA7DIV=$$NAME^XUAF4(LA74)
46 ;
47 ; Build result test name
48 I LA7RNLT="" D
49 . I $G(LA("NLT"))'="" S LA7RNLT=LA("NLT") Q
50 . S LA7RNLT=$G(LA7NLT)
51 I LA7RNLT D
52 . S LA7X=$O(^LAM("E",LA7RNLT,0))
53 . I LA7X S LA7TSTN=$$GET1^DIQ(64,LA7X_",",.01,"I")
54 ;
55 S LA7TXT=LA7TSTN_" results from "_LA7DIV_"."
56 D NTE^LA7VORU1
57 S X=$$PADD^XUAF4(LA74)
58 S LA7TXT=$P(X,U)_" "_$P(X,U,2)_", "_$P(X,U,3)_" "_$P(X,U,4)
59 D NTE^LA7VORU1
60 Q
61 ;
62 ;
63INTRP ; Send test interpretation
64 ; Send "CH" subscript file #60 site/specimen's interpretation field (#5.5)
65 ;
66 N LA760,LA761,LA7NTE,LA7SOC,LA7TXT,LA7X,LA7Y,LRSB
67 ;
68 S LRSB=$P(LA7VT,"^"),LA7Y=0
69 S LA761=+$P(LA763(0),"^",5)
70 S LA7X=^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),LRSB)
71 S LA760=+$P($P(LA7X,"^",3),"!",5)
72 I LA760,$D(^LAB(60,LA760,1,LA761,1)) S LA7Y=1
73 I 'LA760 D
74 . S LA760=0
75 . F S LA760=$O(^LAB(60,"C","CH;"_LRSB_";1",LA760)) Q:'LA760 D Q:LA7Y
76 . . I $D(^LAB(60,LA760,1,LA761,1)) S LA7Y=1
77 ;
78 I 'LA7Y Q
79 ;
80 ; Source of comment - handle other system's special codes, i.e. DOD-CHCS
81 S LA7SOC=$S($G(LA7NVAF)=1:"RI",1:"L")
82 ;
83 ; Build each line of interpretation as a NTE segment.
84 S LA7X=0
85 F S LA7X=$O(^LAB(60,LA760,1,LA761,1,LA7X)) Q:'LA7X D
86 . S LA7TXT=$G(^LAB(60,LA760,1,LA761,1,LA7X,0))
87 . D BNTE
88 ;
89 Q
90 ;
91 ;
92BNTE ; Build NTE segment
93 ;
94 I $E(LA7TXT,1)="~" S LA7TXT=$$TRIM^XLFSTR(LA7TXT,"L","~")
95 S LA7TXT=$$TRIM^XLFSTR(LA7TXT,"R"," ")
96 I LA7TXT="" S LA7TXT=" "
97 D NTE^LA7VORU1
98 Q
Note: See TracBrowser for help on using the repository browser.