source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7VHLU2.m@ 1542

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

initial load of FOIAVistA 6/30/08 version
File size: 5.6 KB
Line 
1LA7VHLU2 ;DALOI/JMC - HL7 Segment Utility ;01/19/99 13:48
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,61,64**;Sep 27, 1994
3 ;
4 Q
5 ;
6GETSEG(LA76249,LA7NODE,LA7ARR) ; Returns the next segment from file 62.49
7 ; during processing of an inbound message. The following variables
8 ; are used for the processing.
9 ;
10 ; Call with LA76249 - Entry in 62.49 where message is
11 ; LA7NODE - Curent ien of "150" wp field
12 ;
13 ; Returns LA7ARR - Data is returned in LA7ARR(0) and
14 ; LA7ARR(n) if segmemt is greater than 245 chars.
15 ; LA7END - flag that end of message has been reached
16 ;
17 N LA7I,LA7END,LA7QUIT
18 K LA7ARR
19 S LA76249=+$G(LA76249),LA7NODE=$G(LA7NODE,0),(LA7END,LA7QUIT)=0
20 ;
21 S LA7NODE=$O(^LAHM(62.49,LA76249,150,LA7NODE))
22 I 'LA7NODE S LA7END=1
23 E D
24 . S LA7ARR(0)=$G(^LAHM(62.49,LA76249,150,LA7NODE,0)),LA7I=0
25 . F S LA7NODE=$O(^LAHM(62.49,LA76249,150,LA7NODE)) Q:'LA7NODE D Q:LA7QUIT
26 . . I $G(^LAHM(62.49,LA76249,150,LA7NODE,0))="" S LA7QUIT=1 Q
27 . . S LA7I=LA7I+1,LA7ARR(LA7I)=$G(^LAHM(62.49,LA76249,150,LA7NODE,0))
28 ;
29 Q LA7END
30 ;
31 ;
32FINDSITE(LA7Z,LA7TYPE,LA7SEM) ; Look up an institution in file #4
33 ;
34 ; Call with LA7Z = value to lookup
35 ; VA: "VA"(optional) followed by 3-5 character VA site number
36 ; Non-VA uses 3-5 character site assigned identifier
37 ; LA7TYPE = 1 (host facility)
38 ; 2 (collection facility)
39 ;
40 ; LA7SEM = 0 (log error message)
41 ; 1 (suppress error message)
42 ;
43 ; Returns LA7Y = ien of entry in INSTITUTION file (#4).
44 ;
45 N LA7X,LA7Y
46 ;
47 S LA7TYPE=$G(LA7TYPE),LA7Z=$G(LA7Z),LA7Y="",LA7SEM=$G(LA7SEM,1)
48 ;
49 ; If VA facility then strip off "VA" before lookup
50 I $E(LA7Z,1,2)="VA" S LA7X=$E(LA7Z,3,$L(LA7Z))
51 E S LA7X=LA7Z
52 ;
53 ; Lookup in INSTITUTION file (#4)
54 ; If appears to be a VA station number
55 I LA7Z?1(3N,3.4N2U,3N1U1N) S LA7Y=$$IDX^XUAF4("VASTANUM",LA7Z)
56 ; If appears to be a DoD DMIS number
57 I LA7Z?4N S LA7Y=$$IDX^XUAF4("DMIS",LA7Z)
58 ; Else try anything
59 I 'LA7Y S LA7Y=$$FIND1^DIC(4,"","OMX",LA7X)
60 ;
61 ; If unable to find in INSTITUTION file (#4) then try looking in
62 ; SHIPPING CONFIGURATION file (#62.9) using non-VA identifier.
63 ; Check that entry is not a VA facility
64 I LA7Y'>0,LA7X]"" D
65 . N LA7J,LA7K
66 . S LA7J=0
67 . F S LA7J=$O(^LAHM(62.9,LA7J)) Q:'LA7J D Q:LA7Y
68 . . S LA7J(0)=$G(^LAHM(62.9,LA7J,0))
69 . . I $P(LA7J(0),"^",4)'=1 Q ; Not active
70 . . I $P(LA7J(0),"^",12)'=LA7X Q
71 . . S LA7K=$S(LA7TYPE=1:$P(LA7J(0),"^",3),LA7TYPE=2:$P(LA7J(0),"^",2),1:"")
72 . . I LA7K,$$NVAF(LA7K) S LA7Y=LA7K
73 ;
74 ; No entry found
75 I 'LA7SEM,LA7Y'>0 D
76 . N LA7SITE
77 . S LA7SITE=$S(LA7TYPE=1:"Host",LA7TYPE=2:"Collection",1:"type")_" site: "_$S(LA7Z]"":LA7Z,1:"Blank-no value")
78 . N LA7X,LA7Y,LA7Z
79 . D CREATE^LA7LOG(25)
80 ;
81 Q LA7Y
82 ;
83 ;
84RETFACID(LA7Z,LA7TYPE,LA7SEM) ; (RET)urn (FAC)ility (ID)entifier
85 ;
86 ; Call with LA7Z = ien of entry in INSTITUTION file (#4).
87 ;
88 ; LA7TYPE = 1 (host facility)
89 ; 2 (collecting facility)
90 ;
91 ; LA7SEM = 0 (log error message)
92 ; 1 (suppress error message)
93 ;
94 ; Returns LA7Y = VA site number
95 ; non-VA site identifier
96 ;
97 N I,LA7NVAF,LA7X,LA7Y
98 S LA7Y="",LA7SEM=$G(LA7SEM,1)
99 ;
100 ; Check identifiers on file.
101 ; If DoD use DMIS code since some DoD also have VA station number.
102 S LA7NVAF=$$NVAF(LA7Z)
103 I LA7NVAF=0 S LA7Y=$$ID^XUAF4("VASTANUM",LA7Z)
104 I LA7NVAF=1 S LA7Y=$$ID^XUAF4("DMIS",LA7Z)
105 ;
106 ; If unable to find in INSTITUTION file (#4) then try looking in
107 ; SHIPPING CONFIGURATION file (#62.9) using non-VA identifier.
108 I LA7Y="" D
109 . N LA7J
110 . S LA7J=0
111 . F S LA7J=$O(^LAHM(62.9,LA7J)) Q:'LA7J D
112 . . S LA7J(0)=$G(^LAHM(62.9,LA7J,0))
113 . . I $P(LA7J(0),"^",4)'=1 Q ; Not active
114 . . I LA7TYPE=1,LA7Z=$P(LA7J(0),"^",3) S LA7Y=$P(LA7J(0),"^",12)
115 . . I LA7TYPE=2,LA7Z=$P(LA7J(0),"^",2) S LA7Y=$P(LA7J(0),"^",12)
116 . I LA7Y'="" S LA7Y=$$UP^XLFSTR(LA7Y)
117 ;
118 ; No entry found
119 I 'LA7SEM,LA7Y="" D
120 . N LA7SITE
121 . S LA7SITE=$S(LA7TYPE=1:"Host",LA7TYPE=2:"Collection",1:"type")_" site: "_$$GET1^DIQ(4,LA7Z_",",.01)
122 . N LA7X,LA7Y
123 . D CREATE^LA7LOG(25)
124 ;
125 Q LA7Y
126 ;
127 ;
128FNDOLOC(LRUID) ; Find ordering location
129 ; Call with LRUID = Accession's UID
130 ; Returns LA7Y = ordering location^ordering institution
131 ;
132 N LRAA,LRAD,LRAN,LA7X,LA7Y,X,Y
133 ;
134 S LA7Y=""
135 S X=$Q(^LRO(68,"C",LRUID))
136 I $QS(X,3)'=LRUID Q LA7Y
137 S LA7X=$P($G(^LRO(68,$QS(X,4),1,$QS(X,5),1,$QS(X,6),0)),"^",13)
138 I 'LA7X Q LA7Y
139 D GETS^DIQ(44,LA7X_",",".01;3","EI","LA7Y")
140 S LA7Y=LA7X_"^"_LA7Y(44,LA7X_",",.01,"E")_"^"_LA7Y(44,LA7X_",",3,"I")_"^"_LA7Y(44,LA7X_",",3,"E")
141 Q LA7Y
142 ;
143 ;
144CHKICN(LA7X) ; Lookup patient using ICN
145 ; Call with LA7X = patient's ICN
146 ; Returns LA7Y = patient's DFN^full ICN
147 ; -1^error message
148 ;
149 ; Note - until MPI can handle full ICN (number,"V" and checksum) as lookup value
150 ; then confirm if full ICN passed in with full ICN from MPI.
151 ;
152 N LA7Y,LA7Z
153 ;
154 S (LA7Y,LA7Z)=""
155 S LA7X(1)=$P(LA7X,"V")
156 S LA7X(2)=$P(LA7X,"V",2)
157 I LA7X(2)="" S LA7Y=$$GETDFN^MPIF001(LA7X(1))
158 E D
159 . S LA7Y=$$GETDFN^MPIF001(LA7X(1))
160 . S LA7Z=$$GETICN^MPIF001(LA7Y)
161 . I LA7X'=LA7Z S LA7Y="-1^Not a valid ICN"
162 ;
163 Q LA7Y_"^"_LA7Z
164 ;
165 ;
166NVAF(LA7X) ; Set flag sending to non-VA facility.
167 ; Used to code certain segments for other systems, i.e. CHCS-DOD.
168 ; Call with LA7X = ien of institution in file #4
169 ; Returns LA7Y = 0 (VA facility)
170 ; 1 (DoD facility - Army, Navy, Air Force)
171 ; 2 (Indian Health Service)
172 ; 3 (Other - non US Government)
173 ;
174 N LA7Y
175 S LA7Y=""
176 I LA7X S LA7Y=$$GET1^DIQ(4,LA7X_",",95,"I")
177 S LA7Y=$S(LA7Y="N":1,LA7Y="AF":1,LA7Y="ARMY":1,LA7Y="I":2,LA7Y="O":3,1:0)
178 Q LA7Y
Note: See TracBrowser for help on using the repository browser.