LA7VORUB ;VA/DALOI/JMC - Builder of HL7 Lab Results cont'd ; 13-Aug-2013 09:09 ; MKK
;;5.2;AUTOMATED LAB INSTRUMENTS;**68,1033**;NOV 01, 1997
;
Q
;
;
OBR ;Observation Request segment for Lab Order
;
N LA761,LA762,LA7DATA,LA7PLOBR,LA7RS,LA7RSDT,LA7SNM,LA7X,LA7Y,LADFINST,OBR
;
; Retrieve placer's OBR information stored in #69.6
D RETOBR^LA7VHLU(LA("SITE"),LA("RUID"),LA("NLT"),.LA7PLOBR)
;
; Retrieve "ORUT" node for this NLT from file #63
S LA7NLT(63)=""
I LA7NLT'="" D
. S LA7X=$O(^LR(LRDFN,LRSS,LRIDT,"ORUT","B",LA7NLT,0))
. I LA7X>0 S LA7NLT(63)=$G(^LR(LRDFN,LRSS,LRIDT,"ORUT",LA7X,0))
;
; Default institution from Kernel
S LADFINST=+$$KSP^XUPARAM("INST")
;
; Retreive accession info used below - accession area^accession date^accession number
S LA7Y=$$CHECKUID^LRWU4(LA("HUID"))
I LA7Y S LA("HUID",68)=$P(LA7Y,"^",2,4)
E S LA("HUID",68)=""
;
; Initialize OBR segment
S OBR(0)="OBR"
S OBR(1)=$$OBR1^LA7VOBR(.LA7OBRSN)
;
; Remote UID
M LA7X=LA("RUID")
S OBR(2)=$$OBR2^LA7VOBR(.LA7X,LA7FS,LA7ECH)
;
; Host UID
K LA7X
M LA7X=LA("HUID")
S OBR(3)=$$OBR3^LA7VOBR(.LA7X,LA7FS,LA7ECH)
;
; Universal service ID, build from info stored in #69.6
K LA7X
S LA7X=""
I $G(LA7PLOBR("OBR-4"))'="" S OBR(4)=$$CNVFLD^LA7VHLU3(LA7PLOBR("OBR-4"),LA7PLOBR("ECH"),LA7ECH)
E S OBR(4)=$$OBR4^LA7VOBR(LA7NLT,"",LA7X,LA7FS,LA7ECH)
;
; Collection D/T - only send date if d/t is inexact (2nd piece)
K LA7X
S LA7X=$P(LA763(0),"^") S:$P(LA763(0),"^",2) LA7X=$P(LA7X,".")
S OBR(7)=$$OBR7^LA7VOBR(LA7X)
;
; Specimen action code
; If no OBR from PENDING ORDER file (#69.6) then assume added test.
I $G(LA7INTYP)=10,$G(LA7PLOBR("OBR-4"))="" S OBR(11)=$$OBR11^LA7VOBR("A")
;
; Infection Warning
S OBR(12)=$$OBR12^LA7VOBR(LRDFN,LA7FS,LA7ECH)
;
; Lab Arrival Time
; "CH" subscript does not store lab arrival time - attempt to retrieve from file #68.
; Other subscripts do store lab arrival time (date/time received).
I LA("SUB")?1(1"MI",1"SP",1"CY",1"EM") S OBR(14)=$$OBR14^LA7VOBR($P(LA763(0),"^",10))
I LA("SUB")="CH",LA("HUID",68) D
. S LA7X=$G(^LRO(68,$P(LA("HUID",68),"^"),1,$P(LA("HUID",68),"^",2),1,$P(LA("HUID",68),"^",3),3))
. I $P(LA7X,"^",3) S OBR(14)=$$OBR14^LA7VOBR($P(LA7X,"^",3))
;
; Specimen source
S (LA761,LA762,LA7SNM)=""
I LA("SUB")?1(1"CH",1"MI") D
. S LA761=$P(LA763(0),U,5)
. I LA761="" D CREATE^LA7LOG(27)
. I LA("SUB")="MI" S LA762=$P(LA763(0),U,11)
I LA7NVAF=1,LA("SUB")'="CH" S LA7SNM=1
S OBR(15)=$$OBR15^LA7VOBR(LA761,LA762,"",LA7FS,LA7ECH,"",LA7SNM)
;
; Ordering provider
K LA7X
S (LA7X,LA7Y)=""
; "CH" subscript stores requesting provider and requesting div/location.
I LA("SUB")="CH" D
. N LA7J
. S LA7J=$P(LA763(0),"^",13)
. I $P(LA7J,";",2)="SC(" S LA7Y=$$GET1^DIQ(44,$P(LA7J,";")_",",3,"I")
. I $P(LA7J,";",2)="DIC(4," S LA7Y=$P(LA7J,";")
. S LA7X=$P(LA763(0),"^",10)
;
; Other subscripts only store requesting provider
I LA("SUB")?1(1"MI",1"SP",1"CY",1"EM") S LA7X=$P(LA763(0),"^",7)
;
I LA7Y="" S LA7Y=LADFINST
S OBR(16)=$$ORC12^LA7VORC(LA7X,LA7Y,LA7FS,LA7ECH,$S($G(LA7INTYP)=30:2,$G(LA7NVAF)=1:0,1:1))
;
; Placer Field #1 (remote auto-inst)
; Build from info stored in #69.6
I $G(LA7PLOBR("OBR-18"))'="" D
. S OBR(18)=$$CHKDATA^LA7VHLU3(LA7PLOBR("OBR-18"),LA7FS_LA7ECH)
; Else build "auto instrument" if sending to VA facility
I $G(LA7PLOBR("OBR-18"))="",'LA7NVAF D
. N LA7X
. S LA7X(1)=LA("AUTO-INST")
. S OBR(18)=$$OBR18^LA7VOBR(.LA7X,LA7FS,LA7ECH)
;
; Placer Field #2
I $G(LA7PLOBR("OBR-19"))'="" S OBR(19)=$$CHKDATA^LA7VHLU3(LA7PLOBR("OBR-19"),LA7FS_LA7ECH)
; Else build collecting UID if sending to VA facility
I $G(LA7PLOBR("OBR-19"))="",'LA7NVAF,LA("RUID")'="" D
. K LA7X
. S LA7X(7)=LA("RUID")
. S OBR(19)=$$OBR19^LA7VOBR(.LA7X,LA7FS,LA7ECH)
;
; Filler Field #1
; Send file #63 ien info - used by HDR to track patient/specimen
K LA7X
S LA7X(1)=LA("LRDFN"),LA7X(2)=LA("SUB"),LA7X(3)=LA("LRIDT")
S OBR(20)=$$OBR20^LA7VOBR(.LA7X,LA7FS,LA7ECH)
;
; Filler Field #2
; Send Accession/test info - used by DSS to track patient/specimen
; LRACC^LRAA^LRAD^LRAN^Accession Area^Area Abbreviation^NLT
K LA7X
S LA7X(1)=$P(LA763(0),"^",6),LA7X(7)=LA7NLT
S LA7Y=LA("HUID",68)
I LA7Y D
. N I
. F I=1,2,3 S LA7X(I+1)=$P(LA7Y,"^",I)
. S LA7X(5)=$P($G(^LRO(68,$P(LA7Y,"^"),0)),"^")
. S LA7X(6)=$P($G(^LRO(68,$P(LA7Y,"^"),0)),"^",11)
S OBR(21)=$$OBR20^LA7VOBR(.LA7X,LA7FS,LA7ECH)
K LA7X,LAY7
;
; Date Report Completed/Report status/Responsible person
; Determine report date and status from 0 node.
S LA7RSDT=$P(LA763(0),"^",3),(LA7PRI,LA7RS)=""
;
; If CYEMSP subscripts then check for corrected report
I LA("SUB")?1(1"SP",1"CY",1"EM") D
. S LA7RSDT=$P(LA763(0),"^",11),LA7PRI=$P(LA763(0),"^",2)
. I LA7RSDT S LA7RS="F"
. I $P(LA763(0),"^",15) S LA7RS="C"
. I $G(LRSB)=1.2,$G(LA7SR) S LA7RSDT=+$G(^LR(LRDFN,LA("SUB"),LRIDT,LRSB,LA7SR,0),"^")
;
; If MI subscript then also check various sections and audit subfile for corrected report
I LA("SUB")="MI" D
. S LA7PRI=$P(LA763(0),"^",4)
. S LA7X=$S(LRSB=11:1,LRSB=11.6:1,LRSB=12:1,LRSB=14:5,LRSB=16:5,LRSB=18:8,LRSB=20:8,LRSB=22:11,LRSB=26:11,LRSB=24:11,LRSB=33:16,LRSB=36:16,1:0)
. S LA7Y=$G(^LR(LRDFN,"MI",LRIDT,LA7X),"^")
. I $P(LA7Y,"^") S LA7RSDT=$P(LA7Y,"^"),LA7RS=$P(LA7Y,"^",2),LA7PRI=$P(LA7Y,"^",3)
. I $P(LA763(0),"^",9)=1 S LA7RS="C" Q
. I '$D(^LR(LRDFN,"MI",LRIDT,32)) Q
. S I=0
. F S I=$O(^LR(LRDFN,"MI",LRIDT,32,I)) Q:'I I $P(^(I,0),"^",4)>1,LA7RS="F" S LA7RS="C" Q
;
; Also check for individual test status on "ORUT" node in file #63
I $P(LA7NLT(63),"^",10) S LA7RS=$P(LA7NLT(63),"^",10)
;
; Date Report Completed
I LA7RSDT S OBR(22)=$$OBR22^LA7VOBR(LA7RSDT)
;
; Diagnostic service id
S OBR(24)=$$OBR24^LA7VOBR(LA("SUB")_"^"_$G(LRSB))
;
; Result status
I LA7RS'="" S OBR(25)=$$OBR25^LA7VOBR(LA7RS)
;
; Parent Result and Parent
I $D(LA7PARNT) D
. S OBR(26)=$$OBR26^LA7VOBR(LA7PARNT(1),LA7PARNT(2),LA7PARNT(3),LA7FS,LA7ECH)
. S OBR(29)=$$OBR29^LA7VOBR(LA("RUID"),LA("HUID"),LA7FS,LA7ECH)
;
; Principle result interpreter
I LA("SUB")?1(1"MI",1"SP",1"CY",1"EM") D
. I LA("SUB")="MI" S LA7X=$P(LA763(0),"^",4)
. E S LA7X=$P(LA763(0),"^",2)
. S OBR(32)=$$OBR32^LA7VOBR(LA7X,LADFINST,LA7FS,LA7ECH)
;
; Assistant result interpreter
I LA("SUB")?1(1"SP",1"EM"),$P(LA763(0),"^",4) S OBR(33)=$$OBR33^LA7VOBR($P(LA763(0),"^",4),LADFINST,LA7FS,LA7ECH)
;
; Technician
I LA("SUB")?1(1"CY",1"EM"),$P(LA763(0),"^",4) S OBR(34)=$$OBR34^LA7VOBR($P(LA763(0),"^",4),LADFINST,LA7FS,LA7ECH)
;
; Typist - VistA stores as free text
I LA("SUB")?1(1"SP",1"CY",1"EM"),$P(LA763(0),"^",9)'="" S OBR(35)=$$OBR35^LA7VOBR($P(LA763(0),"^",9),LADFINST,LA7FS,LA7ECH)
;
; Procedure code - use Order NLT code
S OBR(44)=$$OBR44^LA7VOBR(LA7NLT,LA7FS,LA7ECH)
;
D BUILDSEG^LA7VHLU(.OBR,.LA7DATA,LA7FS)
D FILESEG^LA7VHLU(GBL,.LA7DATA)
;
; Check for flag to only build message but do not file
I '$G(LA7NOMSG) D FILE6249^LA7VHLU(LA76249,.LA7DATA)
;
Q
LA7VORUB ;VA/DALOI/JMC - Builder of HL7 Lab Results cont'd ; 13-Aug-2013 09:09 ; MKK
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**68,1033**;NOV 01, 1997
+2 ;
+3 QUIT
+4 ;
+5 ;
OBR ;Observation Request segment for Lab Order
+1 ;
+2 NEW LA761,LA762,LA7DATA,LA7PLOBR,LA7RS,LA7RSDT,LA7SNM,LA7X,LA7Y,LADFINST,OBR
+3 ;
+4 ; Retrieve placer's OBR information stored in #69.6
+5 DO RETOBR^LA7VHLU(LA("SITE"),LA("RUID"),LA("NLT"),.LA7PLOBR)
+6 ;
+7 ; Retrieve "ORUT" node for this NLT from file #63
+8 SET LA7NLT(63)=""
+9 IF LA7NLT'=""
Begin DoDot:1
+10 SET LA7X=$ORDER(^LR(LRDFN,LRSS,LRIDT,"ORUT","B",LA7NLT,0))
+11 IF LA7X>0
SET LA7NLT(63)=$GET(^LR(LRDFN,LRSS,LRIDT,"ORUT",LA7X,0))
End DoDot:1
+12 ;
+13 ; Default institution from Kernel
+14 SET LADFINST=+$$KSP^XUPARAM("INST")
+15 ;
+16 ; Retreive accession info used below - accession area^accession date^accession number
+17 SET LA7Y=$$CHECKUID^LRWU4(LA("HUID"))
+18 IF LA7Y
SET LA("HUID",68)=$PIECE(LA7Y,"^",2,4)
+19 IF '$TEST
SET LA("HUID",68)=""
+20 ;
+21 ; Initialize OBR segment
+22 SET OBR(0)="OBR"
+23 SET OBR(1)=$$OBR1^LA7VOBR(.LA7OBRSN)
+24 ;
+25 ; Remote UID
+26 MERGE LA7X=LA("RUID")
+27 SET OBR(2)=$$OBR2^LA7VOBR(.LA7X,LA7FS,LA7ECH)
+28 ;
+29 ; Host UID
+30 KILL LA7X
+31 MERGE LA7X=LA("HUID")
+32 SET OBR(3)=$$OBR3^LA7VOBR(.LA7X,LA7FS,LA7ECH)
+33 ;
+34 ; Universal service ID, build from info stored in #69.6
+35 KILL LA7X
+36 SET LA7X=""
+37 IF $GET(LA7PLOBR("OBR-4"))'=""
SET OBR(4)=$$CNVFLD^LA7VHLU3(LA7PLOBR("OBR-4"),LA7PLOBR("ECH"),LA7ECH)
+38 IF '$TEST
SET OBR(4)=$$OBR4^LA7VOBR(LA7NLT,"",LA7X,LA7FS,LA7ECH)
+39 ;
+40 ; Collection D/T - only send date if d/t is inexact (2nd piece)
+41 KILL LA7X
+42 SET LA7X=$PIECE(LA763(0),"^")
IF $PIECE(LA763(0),"^",2)
SET LA7X=$PIECE(LA7X,".")
+43 SET OBR(7)=$$OBR7^LA7VOBR(LA7X)
+44 ;
+45 ; Specimen action code
+46 ; If no OBR from PENDING ORDER file (#69.6) then assume added test.
+47 IF $GET(LA7INTYP)=10
IF $GET(LA7PLOBR("OBR-4"))=""
SET OBR(11)=$$OBR11^LA7VOBR("A")
+48 ;
+49 ; Infection Warning
+50 SET OBR(12)=$$OBR12^LA7VOBR(LRDFN,LA7FS,LA7ECH)
+51 ;
+52 ; Lab Arrival Time
+53 ; "CH" subscript does not store lab arrival time - attempt to retrieve from file #68.
+54 ; Other subscripts do store lab arrival time (date/time received).
+55 IF LA("SUB")?1(1"MI",1"SP",1"CY",1"EM")
SET OBR(14)=$$OBR14^LA7VOBR($PIECE(LA763(0),"^",10))
+56 IF LA("SUB")="CH"
IF LA("HUID",68)
Begin DoDot:1
+57 SET LA7X=$GET(^LRO(68,$PIECE(LA("HUID",68),"^"),1,$PIECE(LA("HUID",68),"^",2),1,$PIECE(LA("HUID",68),"^",3),3))
+58 IF $PIECE(LA7X,"^",3)
SET OBR(14)=$$OBR14^LA7VOBR($PIECE(LA7X,"^",3))
End DoDot:1
+59 ;
+60 ; Specimen source
+61 SET (LA761,LA762,LA7SNM)=""
+62 IF LA("SUB")?1(1"CH",1"MI")
Begin DoDot:1
+63 SET LA761=$PIECE(LA763(0),U,5)
+64 IF LA761=""
DO CREATE^LA7LOG(27)
+65 IF LA("SUB")="MI"
SET LA762=$PIECE(LA763(0),U,11)
End DoDot:1
+66 IF LA7NVAF=1
IF LA("SUB")'="CH"
SET LA7SNM=1
+67 SET OBR(15)=$$OBR15^LA7VOBR(LA761,LA762,"",LA7FS,LA7ECH,"",LA7SNM)
+68 ;
+69 ; Ordering provider
+70 KILL LA7X
+71 SET (LA7X,LA7Y)=""
+72 ; "CH" subscript stores requesting provider and requesting div/location.
+73 IF LA("SUB")="CH"
Begin DoDot:1
+74 NEW LA7J
+75 SET LA7J=$PIECE(LA763(0),"^",13)
+76 IF $PIECE(LA7J,";",2)="SC("
SET LA7Y=$$GET1^DIQ(44,$PIECE(LA7J,";")_",",3,"I")
+77 IF $PIECE(LA7J,";",2)="DIC(4,"
SET LA7Y=$PIECE(LA7J,";")
+78 SET LA7X=$PIECE(LA763(0),"^",10)
End DoDot:1
+79 ;
+80 ; Other subscripts only store requesting provider
+81 IF LA("SUB")?1(1"MI",1"SP",1"CY",1"EM")
SET LA7X=$PIECE(LA763(0),"^",7)
+82 ;
+83 IF LA7Y=""
SET LA7Y=LADFINST
+84 SET OBR(16)=$$ORC12^LA7VORC(LA7X,LA7Y,LA7FS,LA7ECH,$SELECT($GET(LA7INTYP)=30:2,$GET(LA7NVAF)=1:0,1:1))
+85 ;
+86 ; Placer Field #1 (remote auto-inst)
+87 ; Build from info stored in #69.6
+88 IF $GET(LA7PLOBR("OBR-18"))'=""
Begin DoDot:1
+89 SET OBR(18)=$$CHKDATA^LA7VHLU3(LA7PLOBR("OBR-18"),LA7FS_LA7ECH)
End DoDot:1
+90 ; Else build "auto instrument" if sending to VA facility
+91 IF $GET(LA7PLOBR("OBR-18"))=""
IF 'LA7NVAF
Begin DoDot:1
+92 NEW LA7X
+93 SET LA7X(1)=LA("AUTO-INST")
+94 SET OBR(18)=$$OBR18^LA7VOBR(.LA7X,LA7FS,LA7ECH)
End DoDot:1
+95 ;
+96 ; Placer Field #2
+97 IF $GET(LA7PLOBR("OBR-19"))'=""
SET OBR(19)=$$CHKDATA^LA7VHLU3(LA7PLOBR("OBR-19"),LA7FS_LA7ECH)
+98 ; Else build collecting UID if sending to VA facility
+99 IF $GET(LA7PLOBR("OBR-19"))=""
IF 'LA7NVAF
IF LA("RUID")'=""
Begin DoDot:1
+100 KILL LA7X
+101 SET LA7X(7)=LA("RUID")
+102 SET OBR(19)=$$OBR19^LA7VOBR(.LA7X,LA7FS,LA7ECH)
End DoDot:1
+103 ;
+104 ; Filler Field #1
+105 ; Send file #63 ien info - used by HDR to track patient/specimen
+106 KILL LA7X
+107 SET LA7X(1)=LA("LRDFN")
SET LA7X(2)=LA("SUB")
SET LA7X(3)=LA("LRIDT")
+108 SET OBR(20)=$$OBR20^LA7VOBR(.LA7X,LA7FS,LA7ECH)
+109 ;
+110 ; Filler Field #2
+111 ; Send Accession/test info - used by DSS to track patient/specimen
+112 ; LRACC^LRAA^LRAD^LRAN^Accession Area^Area Abbreviation^NLT
+113 KILL LA7X
+114 SET LA7X(1)=$PIECE(LA763(0),"^",6)
SET LA7X(7)=LA7NLT
+115 SET LA7Y=LA("HUID",68)
+116 IF LA7Y
Begin DoDot:1
+117 NEW I
+118 FOR I=1,2,3
SET LA7X(I+1)=$PIECE(LA7Y,"^",I)
+119 SET LA7X(5)=$PIECE($GET(^LRO(68,$PIECE(LA7Y,"^"),0)),"^")
+120 SET LA7X(6)=$PIECE($GET(^LRO(68,$PIECE(LA7Y,"^"),0)),"^",11)
End DoDot:1
+121 SET OBR(21)=$$OBR20^LA7VOBR(.LA7X,LA7FS,LA7ECH)
+122 KILL LA7X,LAY7
+123 ;
+124 ; Date Report Completed/Report status/Responsible person
+125 ; Determine report date and status from 0 node.
+126 SET LA7RSDT=$PIECE(LA763(0),"^",3)
SET (LA7PRI,LA7RS)=""
+127 ;
+128 ; If CYEMSP subscripts then check for corrected report
+129 IF LA("SUB")?1(1"SP",1"CY",1"EM")
Begin DoDot:1
+130 SET LA7RSDT=$PIECE(LA763(0),"^",11)
SET LA7PRI=$PIECE(LA763(0),"^",2)
+131 IF LA7RSDT
SET LA7RS="F"
+132 IF $PIECE(LA763(0),"^",15)
SET LA7RS="C"
+133 IF $GET(LRSB)=1.2
IF $GET(LA7SR)
SET LA7RSDT=+$GET(^LR(LRDFN,LA("SUB"),LRIDT,LRSB,LA7SR,0),"^")
End DoDot:1
+134 ;
+135 ; If MI subscript then also check various sections and audit subfile for corrected report
+136 IF LA("SUB")="MI"
Begin DoDot:1
+137 SET LA7PRI=$PIECE(LA763(0),"^",4)
+138 SET LA7X=$SELECT(LRSB=11:1,LRSB=11.6:1,LRSB=12:1,LRSB=14:5,LRSB=16:5,LRSB=18:8,LRSB=20:8,LRSB=22:11,LRSB=26:11,LRSB=24:11,LRSB=33:16,LRSB=36:16,1:0)
+139 SET LA7Y=$GET(^LR(LRDFN,"MI",LRIDT,LA7X),"^")
+140 IF $PIECE(LA7Y,"^")
SET LA7RSDT=$PIECE(LA7Y,"^")
SET LA7RS=$PIECE(LA7Y,"^",2)
SET LA7PRI=$PIECE(LA7Y,"^",3)
+141 IF $PIECE(LA763(0),"^",9)=1
SET LA7RS="C"
QUIT
+142 IF '$DATA(^LR(LRDFN,"MI",LRIDT,32))
QUIT
+143 SET I=0
+144 FOR
SET I=$ORDER(^LR(LRDFN,"MI",LRIDT,32,I))
IF 'I
QUIT
IF $PIECE(^(I,0),"^",4)>1
IF LA7RS="F"
SET LA7RS="C"
QUIT
End DoDot:1
+145 ;
+146 ; Also check for individual test status on "ORUT" node in file #63
+147 IF $PIECE(LA7NLT(63),"^",10)
SET LA7RS=$PIECE(LA7NLT(63),"^",10)
+148 ;
+149 ; Date Report Completed
+150 IF LA7RSDT
SET OBR(22)=$$OBR22^LA7VOBR(LA7RSDT)
+151 ;
+152 ; Diagnostic service id
+153 SET OBR(24)=$$OBR24^LA7VOBR(LA("SUB")_"^"_$GET(LRSB))
+154 ;
+155 ; Result status
+156 IF LA7RS'=""
SET OBR(25)=$$OBR25^LA7VOBR(LA7RS)
+157 ;
+158 ; Parent Result and Parent
+159 IF $DATA(LA7PARNT)
Begin DoDot:1
+160 SET OBR(26)=$$OBR26^LA7VOBR(LA7PARNT(1),LA7PARNT(2),LA7PARNT(3),LA7FS,LA7ECH)
+161 SET OBR(29)=$$OBR29^LA7VOBR(LA("RUID"),LA("HUID"),LA7FS,LA7ECH)
End DoDot:1
+162 ;
+163 ; Principle result interpreter
+164 IF LA("SUB")?1(1"MI",1"SP",1"CY",1"EM")
Begin DoDot:1
+165 IF LA("SUB")="MI"
SET LA7X=$PIECE(LA763(0),"^",4)
+166 IF '$TEST
SET LA7X=$PIECE(LA763(0),"^",2)
+167 SET OBR(32)=$$OBR32^LA7VOBR(LA7X,LADFINST,LA7FS,LA7ECH)
End DoDot:1
+168 ;
+169 ; Assistant result interpreter
+170 IF LA("SUB")?1(1"SP",1"EM")
IF $PIECE(LA763(0),"^",4)
SET OBR(33)=$$OBR33^LA7VOBR($PIECE(LA763(0),"^",4),LADFINST,LA7FS,LA7ECH)
+171 ;
+172 ; Technician
+173 IF LA("SUB")?1(1"CY",1"EM")
IF $PIECE(LA763(0),"^",4)
SET OBR(34)=$$OBR34^LA7VOBR($PIECE(LA763(0),"^",4),LADFINST,LA7FS,LA7ECH)
+174 ;
+175 ; Typist - VistA stores as free text
+176 IF LA("SUB")?1(1"SP",1"CY",1"EM")
IF $PIECE(LA763(0),"^",9)'=""
SET OBR(35)=$$OBR35^LA7VOBR($PIECE(LA763(0),"^",9),LADFINST,LA7FS,LA7ECH)
+177 ;
+178 ; Procedure code - use Order NLT code
+179 SET OBR(44)=$$OBR44^LA7VOBR(LA7NLT,LA7FS,LA7ECH)
+180 ;
+181 DO BUILDSEG^LA7VHLU(.OBR,.LA7DATA,LA7FS)
+182 DO FILESEG^LA7VHLU(GBL,.LA7DATA)
+183 ;
+184 ; Check for flag to only build message but do not file
+185 IF '$GET(LA7NOMSG)
DO FILE6249^LA7VHLU(LA76249,.LA7DATA)
+186 ;
+187 QUIT
