source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7SMU2.m@ 1336

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

initial load of FOIAVistA 6/30/08 version
File size: 6.3 KB
Line 
1LA7SMU2 ;DALOI/JMC - Shipping Manifest Utility (Cont'd);5/5/97 14:44
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64**;Sep 27, 1994
3 Q
4 ;
5DTTO(LA7SCFG,LA7VNLT,LA7HLSC,LA764NCS,LA761NCS,LA7HLPRI,LA7CSC) ; Determine test to order
6 ; Call with LA7SCFG = ien of Shipping Configuration file #62.9
7 ; LA7VNLT = NLT code or non-VA test code
8 ; LA7HLSC = HL7 Specimen Code
9 ; LA764NCS = HL7 Name of Test Coding System
10 ; LA761NCS = HL7 Name of Specimen Coding System
11 ; LA7HLPRI = HL7 Priority Code
12 ; LA7CSC = collection sample code^name^coding system
13 ;
14 ; Returns LA7X = 0^0^0^0^^^ (if unsuccessful)
15 ; LABORATORY TEST (ien file #60)^TOPOGRAPHY (ien file #61)^COLLECTION SAMPLE (ien file #62)^URGENCY (ien file #62.05)^NLT TEST CODE^NLT TEST NAME
16 ;
17 N LA760,LA7V64,LA7X,X,Y,Z
18 ;
19 ; Make sure variables initialized.
20 S LA7X="0^0^0^0^^^"
21 I LA7VNLT="" Q LA7X
22 S LA7SCFG=+$G(LA7SCFG)
23 I LA7HLPRI="" S LA7HLPRI="R"
24 I LA7HLSC="" S LA7HLSC="XXX"
25 ;
26 ; If coding systems not defined then assume
27 ; HL7 Table 0070 and VA NLT file
28 I LA761NCS="0070" S LA761NCS="HL70070"
29 I LA761NCS="" S LA761NCS="HL70070"
30 I LA764NCS="" S LA764NCS="99VA64"
31 I LA764NCS="L",$P(^LAHM(62.9,LA7SCFG,0),"^",15)=0 S LA764NCS="99VA64"
32 ;
33 ; Build index of tests if not previously done for this session.
34 I '$D(^TMP("LA7TC",$J,LA7SCFG)) D BINDX
35 ;
36 ; Found test info with priority
37 I LA7HLPRI]"" D
38 . I $P(LA7CSC,"^")'="" D Q:LA7X
39 . . S X=$G(^TMP("LA7TC",$J,LA7SCFG,LA7VNLT,LA7HLSC,LA7HLPRI,$P(LA7CSC,"^")))
40 . . I X S LA7X=X
41 . S X=$G(^TMP("LA7TC",$J,LA7SCFG,LA7VNLT,LA7HLSC,LA7HLPRI))
42 . I X S LA7X=X Q
43 . S X=$G(^TMP("LA7TC",$J,LA7SCFG,LA7VNLT,"XXX",LA7HLPRI))
44 . I X,"MISPCYEM"[$P(^LAB(60,+X,0),"^",4) S LA7X=X
45 ;
46 ; Found test info with no priority specified
47 I 'LA7X D
48 . I $P(LA7CSC,"^")'="" D Q:LA7X
49 . . S X=$G(^TMP("LA7TC",$J,LA7SCFG,LA7VNLT,LA7HLSC,0,$P(LA7CSC,"^")))
50 . . I X S LA7X=X
51 . S X=$G(^TMP("LA7TC",$J,LA7SCFG,LA7VNLT,LA7HLSC))
52 . I X S LA7X=X Q
53 . S X=$G(^TMP("LA7TC",$J,LA7SCFG,LA7VNLT,"XXX"))
54 . I X,"MISPCYEM"[$P(^LAB(60,+X,0),"^",4) S LA7X=X
55 ;
56 ; Otherwise get values from files #60 LABORATORY TEST and #61, TOPOGRAPHY
57 ; Lookup test using NLT code and get first lab test in "AC" for this
58 ; NLT code that's type (I)nput or (B)oth.
59 I 'LA7X,LA764NCS="99VA64" D
60 . S LA7V64=$O(^LAM("E",LA7VNLT,0)),Y=0 Q:'LA7V64
61 . F S Y=$O(^LAB(60,"AC",LA7V64,Y)) Q:'Y Q:"BI"[$P(^LAB(60,Y,0),"^",3)
62 . I Y S $P(LA7X,"^")=Y
63 ;
64 ; Get default topography and collection sample for HL7 specimen type.
65 ; Check file #60 collection samples first, then check first entry in file #61 for match
66 ; If non-table 0070 then look for "XXX" in table 0070
67 I $P(LA7X,"^"),'$P(LA7X,"^",2),LA761NCS="HL70070" D
68 . S (X,Y)=0,LA760=$P(LA7X,"^")
69 . F S X=$O(^LAB(60,LA760,3,"B",X)) Q:'X D Q:Y
70 . . S Z=$P(^LAB(62,X,0),"^",2)
71 . . I Z,$D(^LAB(61,"HL7",LA7HLSC,Z)) S Y=Z_"^"_X
72 . I Y S $P(LA7X,"^",2,3)=Y
73 I '$P(LA7X,"^",2),LA761NCS="HL70070" D
74 . S X=$O(^LAB(61,"HL7",LA7HLSC,0)) Q:'X
75 . S $P(LA7X,"^",2)=X
76 . I '$P(LA7X,"^",3) S $P(LA7X,"^",3)=$P(^LAB(61,X,0),"^",6)
77 I $P(LA7X,"^"),'$P(LA7X,"^",2),LA761NCS'="HL70070","MISPCYEM"[$P(^LAB(60,$P(LA7X,"^"),0),"^",4) D
78 . S X=$O(^LAB(61,"HL7","XXX",0))
79 . I X S $P(LA7X,"^",2)=X
80 ;
81 ; No urgency mapping, get last using this HL7 code or site's default urgency from #69.9
82 ; Find highest non-workload urgency using this priority code else use site's default
83 I '$P(LA7X,"^",4) D
84 . S X=$O(^LAB(62.05,"HL7",LA7HLPRI,50),-1)
85 . I X S $P(LA7X,"^",4)=X
86 . E S $P(LA7X,"^",4)=+$P($G(^LAB(69.9,1,3)),"^",2)
87 ;
88 ; Check file #60 forced and highest urgency.
89 I $P(LA7X,"^"),$P(LA7X,"^",4) D
90 . S X=$G(^LAB(60,$P(LA7X,"^"),0))
91 . I $P(X,"^",18) S $P(LA7X,"^",4)=$P(X,"^",18)
92 . I $P(X,"^",16),$P(LA7X,"^",4)<$P(X,"^",16) S $P(LA7X,"^",4)=$P(X,"^",16)
93 ;
94 Q LA7X
95 ;
96 ;
97BINDX ; Build index of tests for a shipping configuration.
98 ; Called from above.
99 ;
100 I '$D(^LAHM(62.9,LA7SCFG,0)) Q
101 N LA760,LA761,LA762,LA76205,LA764,LA7HL,LA7NLT,LA7NLTN,LA7TC,LA7X
102 S LA7X=0
103 F S LA7X=$O(^LAHM(62.9,LA7SCFG,60,LA7X)) Q:'LA7X D BLD
104 Q
105 ;
106 ;
107BLD ; Build TMP global for a test
108 ; Called from above
109 ;
110 S LA7X(0)=$G(^LAHM(62.9,LA7SCFG,60,LA7X,0))
111 S LA7X(5)=$G(^LAHM(62.9,LA7SCFG,60,LA7X,5))
112 ;
113 ; Laboratory test/collection sample.
114 S LA760=$P(LA7X(0),"^"),LA762=$P(LA7X(0),"^",9)
115 ; Incomplete entry.
116 I 'LA760!('LA762) Q
117 ;
118 ; Test urgency/HL7 priority code.
119 S LA76205=$P(LA7X(0),"^",4),LA76205("HL")=""
120 I LA76205 S LA76205("HL")=$$GET1^DIQ(62.05,LA76205_",","LEDI HL7:HL7 ABBR")
121 ;
122 ; Topography
123 S LA761=$$GET1^DIQ(62,LA762_",",2,"I")
124 I 'LA761,"BBCH"[$P(^LAB(60,LA760,0),"^",4) Q ; Incomplete entry.
125 ; Handle MI with no topography associated with collection sample.
126 I 'LA761,$P(^LAB(60,LA760,0),"^",4)="MI" S LA761=+$P(LA7X(0),"^",3)
127 ;
128 ; Use HL7 specimen code if using table 0070 else use mapping in 62.9
129 S LA7HL=""
130 I LA761NCS="HL70070" S LA7HL=$$GET1^DIQ(61,LA761_",","LEDI HL7:HL7 ABBR")
131 I LA7HL="" S LA7HL=$P(LA7X(5),"^",3)
132 ;
133 ; File #64 ien/NLT code/NLT code test name.
134 ; Use NLT code if using VA coding else use non-VA test order code.
135 S LA764=+$$GET1^DIQ(60,LA760_",",64,"I")
136 S LA7NLT=$$GET1^DIQ(64,LA764_",",1)
137 S LA7NLTN=$$GET1^DIQ(64,LA764_",",.01)
138 I LA764NCS="99VA64" S LA7TC=LA7NLT
139 E S LA7TC=$P(LA7X(5),"^")
140 ;
141 ; Set TMP global with information
142 I LA7HL'="",LA7TC'="" D
143 . I "MISPCYEM"[$P(^LAB(60,LA760,0),"^",4),$P(LA7X(5),"^",7)'="" D
144 . . S ^TMP("LA7TC",$J,LA7SCFG,LA7TC,LA7HL,0,$P(LA7X(5),"^",7))=LA760_"^"_LA761_"^"_LA762_"^^"_LA7NLT_"^"_LA7NLTN
145 . E S ^TMP("LA7TC",$J,LA7SCFG,LA7TC,LA7HL)=LA760_"^"_LA761_"^"_LA762_"^^"_LA7NLT_"^"_LA7NLTN
146 . I LA76205("HL")'="" D
147 . . I "MISPCYEM"[$P(^LAB(60,LA760,0),"^",4),$P(LA7X(5),"^",7)'="" D
148 . . . S ^TMP("LA7TC",$J,LA7SCFG,LA7TC,LA7HL,LA76205("HL"),$P(LA7X(5),"^",7))=LA760_"^"_LA761_"^"_LA762_"^"_LA76205_"^"_LA7NLT_"^"_LA7NLTN
149 . . E S ^TMP("LA7TC",$J,LA7SCFG,LA7TC,LA7HL,LA76205("HL"))=LA760_"^"_LA761_"^"_LA762_"^"_LA76205_"^"_LA7NLT_"^"_LA7NLTN
150 ;
151 ; Set TMP global when collection sample does not have a topography.
152 ; Used for "MISPCYEM" subscripts which can have collection sample with no tpopgraphy.
153 I LA7TC'="",'LA761,"MISPCYEM"[$P(^LAB(60,LA760,0),"^",4) D
154 . S ^TMP("LA7TC",$J,LA7SCFG,LA7TC,"XXX")=LA760_"^"_LA761_"^"_LA762_"^^"_LA7NLT_"^"_LA7NLTN
155 . I LA76205("HL")'="" S ^TMP("LA7TC",$J,LA7SCFG,LA7TC,"XXX",LA76205("HL"))=LA760_"^"_LA761_"^"_LA762_"^"_LA76205_"^"_LA7NLT_"^"_LA7NLTN
156 ;
157 Q
Note: See TracBrowser for help on using the repository browser.