[536] | 1 | C0C7VORU ;WV/JMC - Builder of HL7 Lab Results OBR/OBX/NTE based on RPMS V LAB file ;Jun 16, 2009
|
---|
| 2 | ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994
|
---|
| 3 | ;
|
---|
| 4 | EN(LA) ; called from C0CVLAB
|
---|
| 5 | ; variables
|
---|
| 6 | ; LA("HUID") - Host Unique ID from the local ACCESSION file (#68)
|
---|
| 7 | ; LA("SITE") - Ordering site IEN in the INSTITUTION file (#4)
|
---|
| 8 | ; LA("RUID") - Remote sites Unique ID from ACCESSION file (#68)
|
---|
| 9 | ; LA("ORD") - Free text ordered test name from WKLD CODE file (#64)
|
---|
| 10 | ; LA("NLT") - National Laboratory test code from WKLD CODE file (#64)
|
---|
| 11 | ; LA("LRIDT") - Inverse date/time the lab arrival time (accession date/time)
|
---|
| 12 | ; LA("SUB") - test subscript defined in LABORATORY TEST file (#60)
|
---|
| 13 | ; LA("LRDFN") - IEN in LAB DATA file (#63)
|
---|
| 14 | ; LA("ORD"), LA("NLT"), and LA("SUB") are sent for specific lab results.
|
---|
| 15 | ; LA("AUTO-INST") - Auto-Instrument
|
---|
| 16 | ;
|
---|
| 17 | N LA763,LA7NLT,LA7NVAF,LA7X,PRIMARY
|
---|
| 18 | ;
|
---|
| 19 | S PRIMARY=$$PRIM^VASITE(DT),LA("AUTO-INST")=""
|
---|
| 20 | I $G(PRIMARY)'="" D
|
---|
| 21 | . S PRIMARY=$$SITE^VASITE(DT,PRIMARY)
|
---|
| 22 | . S PRIMARY=$P(PRIMARY,U,3)
|
---|
| 23 | . S LA("AUTO-INST")="LA7V HOST "_PRIMARY
|
---|
| 24 | ;
|
---|
| 25 | I '$O(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),0)) D Q
|
---|
| 26 | . ; need to add error logging when no entry in 63.
|
---|
| 27 | ;
|
---|
| 28 | ; Get zeroth node of entry in #63.
|
---|
| 29 | S LA763(0)=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),0))
|
---|
| 30 | S LA7NLT=$G(LA("NLT"))
|
---|
| 31 | ;
|
---|
| 32 | S LA7NVAF=$$NVAF^LA7VHLU2(+LA("SITE"))
|
---|
| 33 | S LA7NTESN=0
|
---|
| 34 | D ORC
|
---|
| 35 | ;
|
---|
| 36 | I $G(LA("SUB"))="CH" D CH
|
---|
| 37 | ;I $G(LA("SUB"))="MI" D MI^LA7VORU1
|
---|
| 38 | ;I "SPCYEM"[$G(LA("SUB")) D AP^LA7VORU2
|
---|
| 39 | Q
|
---|
| 40 | ;
|
---|
| 41 | ;
|
---|
| 42 | CH ; Build segments for "CH" subscript
|
---|
| 43 | ;
|
---|
| 44 | D OBR
|
---|
| 45 | D NTE
|
---|
| 46 | S LA7OBXSN=0
|
---|
| 47 | D OBX
|
---|
| 48 | ;
|
---|
| 49 | Q
|
---|
| 50 | ;
|
---|
| 51 | ;
|
---|
| 52 | ORC ; Build ORC segment
|
---|
| 53 | ;
|
---|
| 54 | N LA763,LA7696,LA7DATA,LA7SM,LA7X,LA7Y,ORC
|
---|
| 55 | ;
|
---|
| 56 | S LA763(0)=$G(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),0))
|
---|
| 57 | ;
|
---|
| 58 | S ORC(0)="ORC"
|
---|
| 59 | ;
|
---|
| 60 | ; Order control
|
---|
| 61 | S ORC(1)=$$ORC1^LA7VORC("RE")
|
---|
| 62 | ;
|
---|
| 63 | ; Remote UID
|
---|
| 64 | S ORC(2)=$$ORC2^LA7VORC(LA("RUID"),LA7FS,LA7ECH)
|
---|
| 65 | ;
|
---|
| 66 | ; Host UID
|
---|
| 67 | S ORC(3)=$$ORC3^LA7VORC(LA("HUID"),LA7FS,LA7ECH)
|
---|
| 68 | ;
|
---|
| 69 | ; Return shipping manifest if found
|
---|
| 70 | S LA7SM="",LA7696=0
|
---|
| 71 | I LA("SITE")'="",LA("RUID")'="" S LA7696=$O(^LRO(69.6,"RST",LA("SITE"),LA("RUID"),0))
|
---|
| 72 | I LA7696 S LA7SM=$P($G(^LRO(69.6,LA7696,0)),U,14)
|
---|
| 73 | I LA7SM'="" S ORC(4)=$$ORC4^LA7VORC(LA7SM,LA7FS,LA7ECH)
|
---|
| 74 | ;
|
---|
| 75 | ; Order status
|
---|
| 76 | ; DoD/CHCS requires ORC-5 valued otherwise will not process message
|
---|
| 77 | I LA7NVAF=1 S ORC(5)=$$ORC5^LA7VORC("CM",LA7FS,LA7ECH)
|
---|
| 78 | ;
|
---|
| 79 | ; Ordering provider
|
---|
| 80 | S (LA7X,LA7Y)=""
|
---|
| 81 | ; "CH" subscript stores requesting provider and requesting div/location.
|
---|
| 82 | I LA("SUB")="CH" D
|
---|
| 83 | . N LA7J
|
---|
| 84 | . S LA7J=$P(LA763(0),"^",13)
|
---|
| 85 | . I $P(LA7J,";",2)="SC(" S LA7Y=$$GET1^DIQ(44,$P(LA7J,";")_",",3,"I")
|
---|
| 86 | . I $P(LA7J,";",2)="DIC(4," S LA7Y=$P(LA7J,";")
|
---|
| 87 | . S LA7X=$P(LA763(0),"^",10)
|
---|
| 88 | ;
|
---|
| 89 | ; Other subscripts only store requesting provider
|
---|
| 90 | I "CYEMMISP"[LA("SUB") S LA7X=$P(LA763(0),"^",7)
|
---|
| 91 | ; Get default institution from MailMan Site Parameters file
|
---|
| 92 | I LA7Y="" S LA7Y=$$GET1^DIQ(4.3,"1,",217,"I")
|
---|
| 93 | S ORC(12)=$$ORC12^LA7VORC(LA7X,LA7Y,LA7FS,LA7ECH)
|
---|
| 94 | ;
|
---|
| 95 | ; Entering organization
|
---|
| 96 | S ORC(17)=$$ORC17^LA7VORC(LA7Y,LA7FS,LA7ECH)
|
---|
| 97 | ;
|
---|
| 98 | D BUILDSEG^LA7VHLU(.ORC,.LA7DATA,LA7FS)
|
---|
| 99 | D FILESEG^LA7VHLU(GBL,.LA7DATA)
|
---|
| 100 | ;
|
---|
| 101 | ; Check for flag to only build message but do not file
|
---|
| 102 | I '$G(LA7NOMSG) D FILE6249^LA7VHLU(LA76249P,.LA7DATA)
|
---|
| 103 | ;
|
---|
| 104 | Q
|
---|
| 105 | ;
|
---|
| 106 | ;
|
---|
| 107 | OBR ;Observation Request segment for Lab Order
|
---|
| 108 | ;
|
---|
| 109 | N LA761,LA762,LA7DATA,LA7PLOBR,LA7X,LA7Y,OBR
|
---|
| 110 | ;
|
---|
| 111 | ; Retrieve placer's OBR information stored in #69.6
|
---|
| 112 | D RETOBR^LA7VHLU(LA("SITE"),LA("RUID"),LA("NLT"),.LA7PLOBR)
|
---|
| 113 | ;
|
---|
| 114 | ; Initialize OBR segment
|
---|
| 115 | S OBR(0)="OBR"
|
---|
| 116 | S OBR(1)=$$OBR1^LA7VOBR(.LA7OBRSN)
|
---|
| 117 | ;
|
---|
| 118 | ; Remote UID
|
---|
| 119 | S OBR(2)=$$OBR2^LA7VOBR(LA("RUID"),LA7FS,LA7ECH)
|
---|
| 120 | ;
|
---|
| 121 | ; Host UID
|
---|
| 122 | S OBR(3)=$$OBR3^LA7VOBR(LA("HUID"),LA7FS,LA7ECH)
|
---|
| 123 | ;
|
---|
| 124 | ; Universal service ID, build from info stored in #69.6
|
---|
| 125 | S LA7X=""
|
---|
| 126 | I $G(LA7PLOBR("OBR-4"))'="" S OBR(4)=$$CNVFLD^LA7VHLU3(LA7PLOBR("OBR-4"),LA7PLOBR("ECH"),LA7ECH)
|
---|
| 127 | E S OBR(4)=$$OBR4^LA7VOBR(LA7NLT,"",LA7X,LA7FS,LA7ECH)
|
---|
| 128 | ;
|
---|
| 129 | ; Collection D/T
|
---|
| 130 | S OBR(7)=$$OBR7^LA7VOBR($P(LA763(0),U))
|
---|
| 131 | ;
|
---|
| 132 | ; Specimen action code
|
---|
| 133 | ; If no OBR from PENDING ORDER file (#69.6) then assume added test.
|
---|
| 134 | I $G(LA7INTYP)=10,$G(LA7PLOBR("OBR-4"))="" S OBR(11)=$$OBR11^LA7VOBR("A")
|
---|
| 135 | ;
|
---|
| 136 | ; Infection Warning
|
---|
| 137 | S OBR(12)=$$OBR12^LA7VOBR(LRDFN,LA7FS,LA7ECH)
|
---|
| 138 | ;
|
---|
| 139 | ; Lab Arrival Time
|
---|
| 140 | ; "CH" subscript does not store lab arrival time, use collection time.
|
---|
| 141 | ; Other subscripts do store lab arrival time (date/time received).
|
---|
| 142 | I "CYEMMISP"[LA("SUB") S OBR(14)=$$OBR14^LA7VOBR($P(LA763(0),"^",10))
|
---|
| 143 | I LA("SUB")="CH" S OBR(14)=$$OBR14^LA7VOBR($P(LA763(0),"^"))
|
---|
| 144 | ;
|
---|
| 145 | ; Specimen source
|
---|
| 146 | S (LA761,LA762)=""
|
---|
| 147 | I "CHMI"[LA("SUB") D
|
---|
| 148 | . S LA761=$P(LA763(0),U,5)
|
---|
| 149 | . I LA761="" D CREATE^LA7LOG(27)
|
---|
| 150 | . I LA("SUB")="MI" S LA762=$P(LA763(0),U,11)
|
---|
| 151 | S OBR(15)=$$OBR15^LA7VOBR(LA761,LA762,"",LA7FS,LA7ECH)
|
---|
| 152 | ;
|
---|
| 153 | ; Ordering provider
|
---|
| 154 | S (LA7X,LA7Y)=""
|
---|
| 155 | ; "CH" subscript stores requesting provider and requesting div/location.
|
---|
| 156 | I LA("SUB")="CH" D
|
---|
| 157 | . N LA7J
|
---|
| 158 | . S LA7J=$P(LA763(0),"^",13)
|
---|
| 159 | . I $P(LA7J,";",2)="SC(" S LA7Y=$$GET1^DIQ(44,$P(LA7J,";")_",",3,"I")
|
---|
| 160 | . I $P(LA7J,";",2)="DIC(4," S LA7Y=$P(LA7J,";")
|
---|
| 161 | . S LA7X=$P(LA763(0),"^",10)
|
---|
| 162 | ;
|
---|
| 163 | ; Other subscripts only store requesting provider
|
---|
| 164 | I "CYEMMISP"[LA("SUB") S LA7X=$P(LA763(0),"^",7)
|
---|
| 165 | ; Get default institution from MailMan Site Parameters file
|
---|
| 166 | I LA7Y="" S LA7Y=$$GET1^DIQ(4.3,"1,",217,"I")
|
---|
| 167 | S OBR(16)=$$ORC12^LA7VORC(LA7X,LA7Y,LA7FS,LA7ECH)
|
---|
| 168 | ;
|
---|
| 169 | ; Placer Field #1 (remote auto-inst)
|
---|
| 170 | ; Build from info stored in #69.6
|
---|
| 171 | I $G(LA7PLOBR("OBR-18"))'="" D
|
---|
| 172 | . S OBR(18)=$$CHKDATA^LA7VHLU3(LA7PLOBR("OBR-18"),LA7FS_LA7ECH)
|
---|
| 173 | ; Else build "auto instrument" if sending to VA facility
|
---|
| 174 | I $G(LA7PLOBR("OBR-18"))="",'LA7NVAF D
|
---|
| 175 | . N LA7X
|
---|
| 176 | . S LA7X(1)=LA("AUTO-INST")
|
---|
| 177 | . S OBR(18)=$$OBR18^LA7VOBR(.LA7X,LA7FS,LA7ECH)
|
---|
| 178 | ;
|
---|
| 179 | ; Placer Field #2
|
---|
| 180 | I $G(LA7PLOBR("OBR-19"))'="" D
|
---|
| 181 | . S OBR(19)=$$CHKDATA^LA7VHLU3(LA7PLOBR("OBR-19"),LA7FS_LA7ECH)
|
---|
| 182 | ; Else build collecting UID if sending to VA facility
|
---|
| 183 | I $G(LA7PLOBR("OBR-19"))="",'LA7NVAF,LA("RUID")'="" D
|
---|
| 184 | . K LA7X
|
---|
| 185 | . S LA7X(7)=LA("RUID")
|
---|
| 186 | . S OBR(19)=$$OBR19^LA7VOBR(.LA7X,LA7FS,LA7ECH)
|
---|
| 187 | ;
|
---|
| 188 | ; Filler Field #1
|
---|
| 189 | ; Send file #63 ien info - used by HDR to track patient/specimen
|
---|
| 190 | K LA7X
|
---|
| 191 | S LA7X(1)=LA("LRDFN")
|
---|
| 192 | S LA7X(2)=LA("SUB")
|
---|
| 193 | S LA7X(3)=LA("LRIDT")
|
---|
| 194 | S OBR(20)=$$OBR20^LA7VOBR(.LA7X,LA7FS,LA7ECH)
|
---|
| 195 | ;
|
---|
| 196 | ; Date Report Completed
|
---|
| 197 | I $P(LA763(0),"^",3) S OBR(22)=$$OBR22^LA7VOBR($P(LA763(0),"^",3))
|
---|
| 198 | ;
|
---|
| 199 | ; Diagnostic service id
|
---|
| 200 | S OBR(24)=$$OBR24^LA7VOBR(LA("SUB")_"^"_$G(LRSB))
|
---|
| 201 | ;
|
---|
| 202 | ; Parent Result and Parent
|
---|
| 203 | I $D(LA7PARNT) D
|
---|
| 204 | . S OBR(26)=$$OBR26^LA7VOBR(LA7PARNT(1),LA7PARNT(2),LA7PARNT(3),LA7FS,LA7ECH)
|
---|
| 205 | . S OBR(29)=$$OBR29^LA7VOBR(LA("RUID"),LA("HUID"),LA7FS,LA7ECH)
|
---|
| 206 | ;
|
---|
| 207 | ; Principle result interpreter
|
---|
| 208 | ; Get default institution from MailMan Site Parameters file
|
---|
| 209 | I "CYEMMISP"[LA("SUB") D
|
---|
| 210 | . I LA("SUB")="MI" S LA7X=$P(LA763(0),"^",4)
|
---|
| 211 | . E S LA7X=$P(LA763(0),"^",2)
|
---|
| 212 | . S LA7Y=$$GET1^DIQ(4.3,"1,",217,"I")
|
---|
| 213 | . S OBR(32)=$$OBR32^LA7VOBR(LA7X,LA7Y,LA7FS,LA7ECH)
|
---|
| 214 | ;
|
---|
| 215 | ; Assistant result interpreter
|
---|
| 216 | ; Get default institution from MailMan Site Parameters file
|
---|
| 217 | I "EMSP"[LA("SUB") D
|
---|
| 218 | . S LA7X=$P(LA763(0),"^",4),LA7Y=$$GET1^DIQ(4.3,"1,",217,"I")
|
---|
| 219 | . S OBR(33)=$$OBR33^LA7VOBR(LA7X,LA7Y,LA7FS,LA7ECH)
|
---|
| 220 | ;
|
---|
| 221 | ; Technician
|
---|
| 222 | ; Get default institution from MailMan Site Parameters file
|
---|
| 223 | I "CYEM"[LA("SUB") D
|
---|
| 224 | . S LA7X=$P(LA763(0),"^",4),LA7Y=$$GET1^DIQ(4.3,"1,",217,"I")
|
---|
| 225 | . S OBR(34)=$$OBR34^LA7VOBR(LA7X,LA7Y,LA7FS,LA7ECH)
|
---|
| 226 | ;
|
---|
| 227 | ; Typist - VistA stores as free text
|
---|
| 228 | ; Get default institution from MailMan Site Parameters file
|
---|
| 229 | I "CYEMSP"[LA("SUB") D
|
---|
| 230 | . S LA7X=$P(LA763(0),"^",9),LA7Y=$$GET1^DIQ(4.3,"1,",217,"I")
|
---|
| 231 | . S OBR(35)=$$OBR35^LA7VOBR(LA7X,LA7Y,LA7FS,LA7ECH)
|
---|
| 232 | ;
|
---|
| 233 | D BUILDSEG^LA7VHLU(.OBR,.LA7DATA,LA7FS)
|
---|
| 234 | D FILESEG^LA7VHLU(GBL,.LA7DATA)
|
---|
| 235 | ;
|
---|
| 236 | ; Check for flag to only build message but do not file
|
---|
| 237 | I '$G(LA7NOMSG) D FILE6249^LA7VHLU(LA76249,.LA7DATA)
|
---|
| 238 | ;
|
---|
| 239 | Q
|
---|
| 240 | ;
|
---|
| 241 | ;
|
---|
| 242 | OBX ;Observation/Result segment for Lab Results
|
---|
| 243 | ;
|
---|
| 244 | N LA7953,LA7DATA,LA7VT,LA7VTIEN,LA7X
|
---|
| 245 | ;
|
---|
| 246 | S LA7VTIEN=0
|
---|
| 247 | F S LA7VTIEN=$O(^LAHM(62.49,LA(62.49),1,LA7VTIEN)) Q:'LA7VTIEN D
|
---|
| 248 | . S LA7VT=$P(^LAHM(62.49,LA(62.49),1,LA7VTIEN,0),"^",1,2)
|
---|
| 249 | . ; Build OBX segment
|
---|
| 250 | . K LA7DATA
|
---|
| 251 | . D OBX^LA7VOBX(LA("LRDFN"),LA("SUB"),LA("LRIDT"),$P(LA7VT,"^",1,2),.LA7DATA,.LA7OBXSN,LA7FS,LA7ECH,$G(LA7NVAF))
|
---|
| 252 | . ; If OBX failed to build then don't store
|
---|
| 253 | . I '$D(LA7DATA) Q
|
---|
| 254 | . ;
|
---|
| 255 | . D FILESEG^LA7VHLU(GBL,.LA7DATA)
|
---|
| 256 | . I '$G(LA7NOMSG) D FILE6249^LA7VHLU(LA76249,.LA7DATA)
|
---|
| 257 | . ;
|
---|
| 258 | . ; Send performing lab comment and interpretation from file #60
|
---|
| 259 | . S LA7NTESN=0
|
---|
| 260 | . I LA7NVAF=1 D PLC^LA7VORUA
|
---|
| 261 | . D INTRP^LA7VORUA
|
---|
| 262 | . ;
|
---|
| 263 | . ; Mark result as sent - set to 1, if corrected results set to 2
|
---|
| 264 | . I LA("SUB")="CH" D
|
---|
| 265 | . . I $P(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),$P(LA7VT,"^")),"^",10)>1 Q
|
---|
| 266 | . . S $P(^LR(LA("LRDFN"),LA("SUB"),LA("LRIDT"),$P(LA7VT,"^")),"^",10)=$S($P(LA7VT,"^",2)="C":2,1:1)
|
---|
| 267 | ;
|
---|
| 268 | Q
|
---|
| 269 | ;
|
---|
| 270 | ;
|
---|
| 271 | NTE ; Build NTE segment
|
---|
| 272 | ;
|
---|
| 273 | D NTE^LA7VORUA
|
---|
| 274 | Q
|
---|