LA7COBXA ;VA/DALOI/JMC - LAB OBX Segment message builder (cont'd) ; 22-Oct-2013 09:22 ; MAW
;;5.2;AUTOMATED LAB INSTRUMENTS;**46,1018,70,64,1027,68,1033**;NOV 01, 1997
;
Q
;
OBX2 ; Build OBX-2 sequence - Value type
;
; default value - string data
N TST
S LA7VAL="SN"
S LA7TYP="",LA7FILE=$G(LA7FILE),LA7FIELD=$G(LA7FIELD)
;
I LA7FILE,LA7FIELD S LA7TYP=$$GET1^DID(LA7FILE,LA7FIELD,"","TYPE","","LA7ERR")
;
I LA7TYP="DATE/TIME" S LA7VAL="TS"
I LA7TYP="FREE TEXT" S LA7VAL="SN" ;MU2 from ST
I LA7TYP="FREE TEXT",$G(LA7INPT) S LA7VAL="TX" ;mu2 inpatient
I LA7VAL="TX",$G(LRSS)="MI" S LA7VAL="SN" ;mu2 inpatient micro
I LA7TYP="WORD-PROCESSING" S LA7VAL="FT"
I LA7TYP="WORD-PROCESSING",$G(LA7INPT) S LA7VAL="TX" ;mu2 inpatient
I LA7TYP="NUMERIC" S LA7VAL="SN" ;MU2
I LA7TYP="NUMERIC",$G(LA7INPT) S LA7VAL="NM" ;mu2 inpatient
I LA7TYP="SET" S LA7VAL="CWE" ;MU2
I LA7TYP="POINTER" S LA7VAL="ST"
I $G(LA7VAL)="" S LA7VAL="SN"
I LA7VAL="SN",$G(LA7INPT)="SN" S LA7VAL="NM" ;mu2 inpatient no SN's
;put in code here to look at a field in file 60 and use that value over anything else
I $G(LA7INPT) D
.S TST=$O(^LAB(60,"C",LRSS_";"_LA7FIELD_";"_1,0))
.Q:'$G(TST)
.I $P($G(^LAB(60,TST,.1)),U,2)]"" S LA7VAL=$P($G(^LAB(60,TST,.1)),U,2) ;override with MU2 value
;
Q
;
;
OBX3 ; Build OBX-3 sequence - Observation identifier field
;
; Initialize variables
S LA7J=1,LA7Y="",LA7INTYP=$G(LA7INTYP)
;
; Build sequence using LOINC codes. LOINC code/code name/"LN"
; VA VUID in 2nd triplet when sending to VA HDR. Use VA Display name (field #82) for VUID test name
I LA7953'="" D
. N LA7IENS,LA7Z
. S LA7953=$P(LA7953,"-"),LA7IENS=LA7953_","
. D GETS^DIQ(95.3,LA7IENS,".01;80;99.99","E","LA7X")
. ; Invalid code???
. I $G(LA7X(95.3,LA7IENS,.01,"E"))="" Q
. S LA7Z=LA7X(95.3,LA7IENS,.01,"E")
. S LA7Z=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
. S $P(LA7Y,$E(LA7ECH,1),LA7J)=LA7Z
. S LA7Z=$G(LA7X(95.3,LA7IENS,80,"E"))
. S LA7Z=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
. S $P(LA7Y,$E(LA7ECH,1),LA7J+1)=LA7Z
. S $P(LA7Y,$E(LA7ECH,1),LA7J+2)="LN"
. S LA7J=4
. I LA7INTYP=30,$G(LA7X(95.3,LA7IENS,99.99,"E"))'="" D
. . S $P(LA7Y,$E(LA7ECH,1),LA7J)=LA7X(95.3,LA7IENS,99.99,"E")
. . I $$VFIELD^DILFD(95.3,82) D
. . . S LA7Z=$$GET1^DIQ(95.3,LA7IENS,82)
. . . I LA7Z'="" S $P(LA7Y,$E(LA7ECH,1),LA7J+1)=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
. . S $P(LA7Y,$E(LA7ECH,1),LA7J+2)="L"
. . S LA7J=9
. I $G(LA7LNCVR)="" S LA7LNCVR=$$GET1^DID(95.3,"","","PACKAGE REVISION DATA")
. I LA7J>1 S $P(LA7Y,$E(LA7ECH,1),7)=LA7LNCVR
. I LA7J=9 S $P(LA7Y,$E(LA7ECH,1),8)=LA7LNCVR
;
; Build sequence using NLT codes - file #64 NLT code/NLT code name/"99VA64"
; If LOINC is primary make NLT alternate, otherwise NLT primary.
; Only on non-HDR type interfaces.
I LA7NLT'="",LA7INTYP'=30,LA7J<9 D
. N LA7642,LA7Z
. S LA764=$O(^LAM("E",LA7NLT,0)),LA7Z=""
. I LA764 S LA7Z=$$GET1^DIQ(64,LA764_",",.01,"I")
. I LA7Z="" D
. . S LA764=$O(^LAM("E",$P(LA7NLT,".")_".0000",0))
. . I LA764 S LA7Z=$$GET1^DIQ(64,LA764_",",.01,"I")
. . S LA7642=$O(^LAB(64.2,"C","."_$P(LA7NLT,".",2),0))
. . I LA764,LA7642 S LA7Z=LA7Z_"~"_$$GET1^DIQ(64.2,LA7642_",",.01,"I")
. S LA7Z=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
. S $P(LA7Y,$E(LA7ECH,1),LA7J)=LA7NLT
. S $P(LA7Y,$E(LA7ECH,1),LA7J+1)=LA7Z
. S $P(LA7Y,$E(LA7ECH,1),LA7J+2)="L"
. S LA7Z=$$GET1^DID(64,"","","PACKAGE REVISION DATA")
. S $P(LA7Y,$E(LA7ECH,1),$S(LA7J=1:7,1:8))=LA7Z
. S LA7J=LA7J+3
;
; Non-standard/non-VA code
; If alternate is a non-VA code then use as alternate code.
I LA7ALT="" Q
I LA7INTYP'=30,$P(LA7ALT,"^",3)'="99VA63",LA7J>4 S LA7J=4
I LA7J<7 D
. S $P(LA7Y,$E(LA7ECH,1),LA7J)=$$CHKDATA^LA7VHLU3($P(LA7ALT,"^"),LA7FS_LA7ECH)
. S $P(LA7Y,$E(LA7ECH,1),LA7J+1)=$$CHKDATA^LA7VHLU3($P(LA7ALT,"^",2),LA7FS_LA7ECH)
. S $P(LA7Y,$E(LA7ECH,1),LA7J+2)=$$CHKDATA^LA7VHLU3($P(LA7ALT,"^",3),LA7FS_LA7ECH)
. I $P(LA7ALT,"^",3)="99VA63" S $P(LA7Y,$E(LA7ECH,1),$S(LA7J=1:7,1:8))="5.2"
;
; Put local test name in local text (9th component)
I $E($P(LA7ALT,"^",6),1,5)="99VA6",$P(LA7ALT,"^",6)'="99VA64" D
. N I,LA7Z
. S LA7Z=$$TRIM^XLFSTR($P(LA7ALT,"^",5),"LR"," ")
. I LA7Z="" Q
. S LA7Z=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
. S $P(LA7Y,$E(LA7ECH,1),9)=LA7Z
;
Q
;
;
OBX5 ; Build OBX-5 sequence - Observation value
; Removes trailing spaces on string and text results.
; Removes leading & trailing spaces on numeric results.
;
S LA7Y=""
;
I $G(LA7OBX2)="" S LA7OBX2="ST" ; default value type
I LA7OBX2="ST"!(LA7OBX2="TX") D
. S LA7VAL=$$TRIM^XLFSTR(LA7VAL,"R"," ")
. S LA7Y=$$CHKDATA^LA7VHLU3(LA7VAL,LA7FS_LA7ECH)
;I LA7OBX2="SN" S LA7Y=$$TRIM^XLFSTR(LA7VAL,"RL"," ") ;MU2
I LA7OBX2="TS" D
. S LA7VAL=$$CHKDT^LA7VHLU1(LA7VAL)
. S LA7Y=$$FMTHL7^XLFDT(LA7VAL)
I LA7OBX2?1(1"CE",1"CNE",1"CWE") D
. N LA7I,LA7J,X
. S LA7J=$S(LA7OBX2="CE":6,1:9)
. F LA7I=1:1:LA7J I $P(LA7VAL,"^",LA7I)'="" S $P(LA7Y,$E(LA7ECH),LA7I)=$$CHKDATA^LA7VHLU3($P(LA7VAL,"^",LA7I),LA7FS_LA7ECH)
I LA7OBX2="SN" D ;mu2
. N LA7I
. S $P(LA7Y,$E(LA7ECH))="="
. S $P(LA7Y,$E(LA7ECH),2)=LA7VAL
. I $E(LA7VAL)="<" D
.. S $P(LA7Y,$E(LA7ECH))="<"
.. S $P(LA7Y,$E(LA7ECH),2)=$P(LA7VAL,"<",2)
. I $E(LA7VAL,1,2)="<=" D
.. S $P(LA7Y,$E(LA7ECH))="<="
.. S $P(LA7Y,$E(LA7ECH),2)=$P(LA7VAL,"<=",2)
. I $E(LA7VAL)=">" D
.. S $P(LA7Y,$E(LA7ECH))=">"
.. S $P(LA7Y,$E(LA7ECH),2)=$P(LA7VAL,">",2)
. ;S $P(LA7Y,$E(LA7ECH))=$S($E(LA7VAL)="<":"<=",$E(LA7VAL)=">":">=",1:"=")
. ;S $P(LA7Y,$E(LA7ECH),2)=$S($E(LA7VAL)="<":$P(LA7VAL,"<",2),$E(LA7VAL)=">":$P(LA7VAL,">",2),1:LA7VAL)
. I LA7Y[":" D
.. N LA7Z
.. S LA7Z=$P(LA7Y,$E(LA7ECH),2)
.. S $P(LA7Y,$E(LA7ECH))=""
.. S $P(LA7Y,$E(LA7ECH),2)=$P(LA7Z,":")
.. S $P(LA7Y,$E(LA7ECH),3)=":"
.. S $P(LA7Y,$E(LA7ECH),4)=$P(LA7Z,":",2)
. I $P(LA7Y," ")["/" D
.. N LA7Z
.. S LA7Z=$P(LA7Y,$E(LA7ECH),2)
.. S $P(LA7Y,$E(LA7ECH))="="
.. S $P(LA7Y,$E(LA7ECH),2)=$P(LA7Z,"/")
.. S $P(LA7Y,$E(LA7ECH),3)="/"
.. S $P(LA7Y,$E(LA7ECH),4)=$P($P(LA7Z,"/",2)," ")_" "_$P(LA7Z," ",2)
. ;F LA7I=1:1:9 I $P(LA7VAL,"^",LA7I)'="" S $P(LA7Y,$E(LA7ECH),LA7I)=$$CHKDATA^LA7VHLU3($P(LA7VAL,"^",LA7I),LA7FS_LA7ECH)
I LA7OBX2="NM" S LA7Y=LA7VAL
;
Q
;
;
OBX5M ; Build OBX-5 sequence - Observation value - multi-line textual result
;
K LA7WP
;
S LA7WP=""
S LA7TYPE=$$GET1^DID(LA7FN,LA7FLD,"","TYPE","LA7ERR(1)")
;
; Process word-processing type field.
; Check and encode data
I LA7TYPE="WORD-PROCESSING" D Q
. N DIWF,DIWL,DIWR,X
. S LA7WP=$$GET1^DIQ(LA7FN,LA7IENS,LA7FLD,"","LA7WP","LA7ERR(2)")
. K ^UTILITY($J,"W")
. S DIWL=1,DIWR=245,DIWF="",LA7I=0
. I $$GET1^DID(+$$GET1^DID(LA7FN,LA7FLD,"","SPECIFIER","LA7ERR(1)"),.01,"","SPECIFIER","LA7ERR(3)")["L" S DIWF="N"
. F S LA7I=$O(LA7WP(LA7I)) Q:'LA7I S X=LA7WP(LA7I) D ^DIWP
. K LA7WP
. S LA7I=0
. F S LA7I=$O(^UTILITY($J,"W",DIWL,LA7I)) Q:'LA7I D
. . S LA7WP(LA7I)=$$CHKDATA^LA7VHLU3(^UTILITY($J,"W",DIWL,LA7I,0),LA7FS_LA7ECH)
. . I LA7I>1 S LA7WP(LA7I)=$E(LA7ECH,3)_".br"_$E(LA7ECH,3)_LA7WP(LA7I)
. K ^UTILITY($J,"W")
;
; Free text, assumes multiple valued
I LA7TYPE="FREE TEXT" D
. D GETS^DIQ(LA7FN,LA7IENS,LA7FLD_"*","","LA7WP","LA7ERR")
;
Q
;
;
OBX5R ; Build OBX-5 sequence with repetition - Observation value
;
S (LA7I,LA7Y)=""
F S LA7I=$O(LA7VAL(LA7I)) Q:'LA7I D
. S LA7Y=LA7Y_$$OBX5^LA7VOBX(LA7VAL(LA7I),LA7OBX2,LA7FS,LA7ECH)_$E(LA7ECH,2)
;
Q
;
;
OBX6 ; Build OBX-6 sequence - Units
;
S LA7ECH=$G(LA7ECH),LA7Y=""
;
; Units - remove leading and trailing spaces
; If HDR interface (LA7INTYP=30) then add coding system (L) to units.
I $G(LA7VAL)'="" D
. S LA7Y=$$TRIM^XLFSTR(LA7VAL,"LR"," ")
. I $G(LA7INTYP)=30 D
. . S $P(LA7Y,$E(LA7ECH,1),2)=LA7Y
. . S $P(LA7Y,$E(LA7ECH,1),3)="L"
;
; Build sequence using LOINC codes only
; LOINC code/code name/"LN"
I $G(LA764061) D
. N LA7IENS,LA7X,LA7Z
. S LA7IENS=LA764061_","
. D GETS^DIQ(64.061,LA7IENS,"1;8","E","LA7X")
. ; LOINC code
. S LA7Z=$G(LA7X(64.061,LA7IENS,1,"E"))
. S LA7Z=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
. S $P(LA7Y,$E(LA7ECH,1),1)=LA7Z
. ; LOINC code name
. S LA7Z=$G(LA7X(64.061,LA7IENS,8,"E"))
. S LA7Z=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
. S $P(LA7Y,$E(LA7ECH,1),2)=LA7Z
. S $P(LA7Y,$E(LA7ECH,1),3)="LN"
;
S $P(LA7Y,$E(LA7ECH,1),2)=LA7VAL
S $P(LA7Y,$E(LA7ECH,1),3)="UCUM"
S $P(LA7Y,$E(LA7ECH,1),4)=LA7VAL
S $P(LA7Y,$E(LA7ECH,1),5)=LA7VAL
S $P(LA7Y,$E(LA7ECH,1),6)="L"
S $P(LA7Y,$E(LA7ECH,1),7)="1.1"
S $P(LA7Y,$E(LA7ECH,1),8)="1.0"
Q
;
;
OBX7 ; Build OBX-7 sequence - Reference range
; Removes leading and trailing quote marks ("").
;
S LA7Y=""
;
I $G(LA7LOW)'="" D
. S LA7LOW=$$TRIM^XLFSTR(LA7LOW,"RL","""")
. I LA7LOW?1A.E S LA7Y=LA7Y_LA7LOW Q ; alphabetic value
. I $G(LA7HIGH)="",$E(LA7LOW)'=">" S LA7Y=">"
. S LA7Y=LA7Y_LA7LOW
;
I $G(LA7HIGH)'="" D
. S LA7HIGH=$$TRIM^XLFSTR(LA7HIGH,"RL","""")
. I LA7HIGH?1A.E S LA7Y=LA7Y_LA7HIGH Q ; alphabetic value
. I $G(LA7LOW)="" D Q
. . I $E(LA7HIGH)'="<" S LA7Y="<"
. . S LA7Y=LA7Y_LA7HIGH
. S LA7Y=LA7Y_"-"_LA7HIGH
;
S LA7Y=$$CHKDATA^LA7VHLU3(LA7Y,LA7FS_LA7ECH)_" "_$P($P(LA7VAL,U,5),"!",7) ;mu2 added units to the end
I $G(LA7INPT) S LA7Y=$E(LA7Y,1,60) ;mu2 inpatient
;
Q
;
;
OBX17 ; Build OBX-17 sequence - Observation method field
;
; method suffix code maybe stored without leading decimal,
; add "." back for lookup, also add trailing space for lookup in x-ref.
I LA7VAL>1 S LA7VAL="."_LA7VAL
S LA7X=$O(^LAB(64.2,"C",LA7VAL_" ",0)),LA7Y=""
I LA7X D
. S LA7X(.01)=$P($G(^LAB(64.2,LA7X,0)),"^")
. S LA7X(.01)=$$CHKDATA^LA7VHLU3(LA7X(.01),LA7FS_LA7ECH)
. S LA7Y=LA7VAL_$E(LA7ECH)_LA7X(.01)_$E(LA7ECH)_"OBSMETHOD"
. ;S LA7X=$$GET1^DID(64.2,"","","PACKAGE REVISION DATA")
. ;S $P(LA7Y,$E(LA7ECH,1),7)=LA7X
;
; Send NLT result code
I LA7NLT'="" D
. S LA764=$O(^LAM("E",LA7NLT,0)),LA7Z=""
. I LA764 S LA7X=$P($G(^LAM(LA764,0)),"^")
. S LA7X=$$CHKDATA^LA7VHLU3(LA7X,LA7FS_LA7ECH)
. S $P(LA7Z,$E(LA7ECH,1),1)=LA7NLT
. S $P(LA7Z,$E(LA7ECH,1),2)=LA7X
. S $P(LA7Z,$E(LA7ECH,1),3)="L"
. ;S LA7X=$$GET1^DID(64,"","","PACKAGE REVISION DATA")
. ;S $P(LA7Z,$E(LA7ECH,1),7)=LA7X
. I LA7Y'="" S LA7Y=LA7Y_$E(LA7ECH)
. S LA7Y=LA7Y_LA7Z
. S $P(LA7Y,$E(LA7ECH),7)=20090501
. S $P(LA7Y,$E(LA7ECH),8)=LA7VER
;
Q
;
;
OBX18 ; Build OBX-18 sequence - Equipment entity identifier field
;
S LA7X="",LA7J=$L(LA7VAL,"!")
F LA7I=1:1:LA7J D
. S LA7Y=$P(LA7VAL,"!",LA7I)
. I LA7Y="" Q
. S $P(LA7X,$E(LA7ECH,1),LA7I)=$$CHKDATA^LA7VHLU3(LA7Y,LA7FS_LA7ECH)
;
Q
LA7COBXA ;VA/DALOI/JMC - LAB OBX Segment message builder (cont'd) ; 22-Oct-2013 09:22 ; MAW
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,1018,70,64,1027,68,1033**;NOV 01, 1997
+2 ;
+3 QUIT
+4 ;
OBX2 ; Build OBX-2 sequence - Value type
+1 ;
+2 ; default value - string data
+3 NEW TST
+4 SET LA7VAL="SN"
+5 SET LA7TYP=""
SET LA7FILE=$GET(LA7FILE)
SET LA7FIELD=$GET(LA7FIELD)
+6 ;
+7 IF LA7FILE
IF LA7FIELD
SET LA7TYP=$$GET1^DID(LA7FILE,LA7FIELD,"","TYPE","","LA7ERR")
+8 ;
+9 IF LA7TYP="DATE/TIME"
SET LA7VAL="TS"
+10 ;MU2 from ST
IF LA7TYP="FREE TEXT"
SET LA7VAL="SN"
+11 ;mu2 inpatient
IF LA7TYP="FREE TEXT"
IF $GET(LA7INPT)
SET LA7VAL="TX"
+12 ;mu2 inpatient micro
IF LA7VAL="TX"
IF $GET(LRSS)="MI"
SET LA7VAL="SN"
+13 IF LA7TYP="WORD-PROCESSING"
SET LA7VAL="FT"
+14 ;mu2 inpatient
IF LA7TYP="WORD-PROCESSING"
IF $GET(LA7INPT)
SET LA7VAL="TX"
+15 ;MU2
IF LA7TYP="NUMERIC"
SET LA7VAL="SN"
+16 ;mu2 inpatient
IF LA7TYP="NUMERIC"
IF $GET(LA7INPT)
SET LA7VAL="NM"
+17 ;MU2
IF LA7TYP="SET"
SET LA7VAL="CWE"
+18 IF LA7TYP="POINTER"
SET LA7VAL="ST"
+19 IF $GET(LA7VAL)=""
SET LA7VAL="SN"
+20 ;mu2 inpatient no SN's
IF LA7VAL="SN"
IF $GET(LA7INPT)="SN"
SET LA7VAL="NM"
+21 ;put in code here to look at a field in file 60 and use that value over anything else
+22 IF $GET(LA7INPT)
Begin DoDot:1
+23 SET TST=$ORDER(^LAB(60,"C",LRSS_";"_LA7FIELD_";"_1,0))
+24 IF '$GET(TST)
QUIT
+25 ;override with MU2 value
IF $PIECE($GET(^LAB(60,TST,.1)),U,2)]""
SET LA7VAL=$PIECE($GET(^LAB(60,TST,.1)),U,2)
End DoDot:1
+26 ;
+27 QUIT
+28 ;
+29 ;
OBX3 ; Build OBX-3 sequence - Observation identifier field
+1 ;
+2 ; Initialize variables
+3 SET LA7J=1
SET LA7Y=""
SET LA7INTYP=$GET(LA7INTYP)
+4 ;
+5 ; Build sequence using LOINC codes. LOINC code/code name/"LN"
+6 ; VA VUID in 2nd triplet when sending to VA HDR. Use VA Display name (field #82) for VUID test name
+7 IF LA7953'=""
Begin DoDot:1
+8 NEW LA7IENS,LA7Z
+9 SET LA7953=$PIECE(LA7953,"-")
SET LA7IENS=LA7953_","
+10 DO GETS^DIQ(95.3,LA7IENS,".01;80;99.99","E","LA7X")
+11 ; Invalid code???
+12 IF $GET(LA7X(95.3,LA7IENS,.01,"E"))=""
QUIT
+13 SET LA7Z=LA7X(95.3,LA7IENS,.01,"E")
+14 SET LA7Z=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
+15 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),LA7J)=LA7Z
+16 SET LA7Z=$GET(LA7X(95.3,LA7IENS,80,"E"))
+17 SET LA7Z=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
+18 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),LA7J+1)=LA7Z
+19 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),LA7J+2)="LN"
+20 SET LA7J=4
+21 IF LA7INTYP=30
IF $GET(LA7X(95.3,LA7IENS,99.99,"E"))'=""
Begin DoDot:2
+22 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),LA7J)=LA7X(95.3,LA7IENS,99.99,"E")
+23 IF $$VFIELD^DILFD(95.3,82)
Begin DoDot:3
+24 SET LA7Z=$$GET1^DIQ(95.3,LA7IENS,82)
+25 IF LA7Z'=""
SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),LA7J+1)=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
End DoDot:3
+26 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),LA7J+2)="L"
+27 SET LA7J=9
End DoDot:2
+28 IF $GET(LA7LNCVR)=""
SET LA7LNCVR=$$GET1^DID(95.3,"","","PACKAGE REVISION DATA")
+29 IF LA7J>1
SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),7)=LA7LNCVR
+30 IF LA7J=9
SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),8)=LA7LNCVR
End DoDot:1
+31 ;
+32 ; Build sequence using NLT codes - file #64 NLT code/NLT code name/"99VA64"
+33 ; If LOINC is primary make NLT alternate, otherwise NLT primary.
+34 ; Only on non-HDR type interfaces.
+35 IF LA7NLT'=""
IF LA7INTYP'=30
IF LA7J<9
Begin DoDot:1
+36 NEW LA7642,LA7Z
+37 SET LA764=$ORDER(^LAM("E",LA7NLT,0))
SET LA7Z=""
+38 IF LA764
SET LA7Z=$$GET1^DIQ(64,LA764_",",.01,"I")
+39 IF LA7Z=""
Begin DoDot:2
+40 SET LA764=$ORDER(^LAM("E",$PIECE(LA7NLT,".")_".0000",0))
+41 IF LA764
SET LA7Z=$$GET1^DIQ(64,LA764_",",.01,"I")
+42 SET LA7642=$ORDER(^LAB(64.2,"C","."_$PIECE(LA7NLT,".",2),0))
+43 IF LA764
IF LA7642
SET LA7Z=LA7Z_"~"_$$GET1^DIQ(64.2,LA7642_",",.01,"I")
End DoDot:2
+44 SET LA7Z=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
+45 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),LA7J)=LA7NLT
+46 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),LA7J+1)=LA7Z
+47 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),LA7J+2)="L"
+48 SET LA7Z=$$GET1^DID(64,"","","PACKAGE REVISION DATA")
+49 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),$SELECT(LA7J=1:7,1:8))=LA7Z
+50 SET LA7J=LA7J+3
End DoDot:1
+51 ;
+52 ; Non-standard/non-VA code
+53 ; If alternate is a non-VA code then use as alternate code.
+54 IF LA7ALT=""
QUIT
+55 IF LA7INTYP'=30
IF $PIECE(LA7ALT,"^",3)'="99VA63"
IF LA7J>4
SET LA7J=4
+56 IF LA7J<7
Begin DoDot:1
+57 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),LA7J)=$$CHKDATA^LA7VHLU3($PIECE(LA7ALT,"^"),LA7FS_LA7ECH)
+58 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),LA7J+1)=$$CHKDATA^LA7VHLU3($PIECE(LA7ALT,"^",2),LA7FS_LA7ECH)
+59 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),LA7J+2)=$$CHKDATA^LA7VHLU3($PIECE(LA7ALT,"^",3),LA7FS_LA7ECH)
+60 IF $PIECE(LA7ALT,"^",3)="99VA63"
SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),$SELECT(LA7J=1:7,1:8))="5.2"
End DoDot:1
+61 ;
+62 ; Put local test name in local text (9th component)
+63 IF $EXTRACT($PIECE(LA7ALT,"^",6),1,5)="99VA6"
IF $PIECE(LA7ALT,"^",6)'="99VA64"
Begin DoDot:1
+64 NEW I,LA7Z
+65 SET LA7Z=$$TRIM^XLFSTR($PIECE(LA7ALT,"^",5),"LR"," ")
+66 IF LA7Z=""
QUIT
+67 SET LA7Z=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
+68 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),9)=LA7Z
End DoDot:1
+69 ;
+70 QUIT
+71 ;
+72 ;
OBX5 ; Build OBX-5 sequence - Observation value
+1 ; Removes trailing spaces on string and text results.
+2 ; Removes leading & trailing spaces on numeric results.
+3 ;
+4 SET LA7Y=""
+5 ;
+6 ; default value type
IF $GET(LA7OBX2)=""
SET LA7OBX2="ST"
+7 IF LA7OBX2="ST"!(LA7OBX2="TX")
Begin DoDot:1
+8 SET LA7VAL=$$TRIM^XLFSTR(LA7VAL,"R"," ")
+9 SET LA7Y=$$CHKDATA^LA7VHLU3(LA7VAL,LA7FS_LA7ECH)
End DoDot:1
+10 ;I LA7OBX2="SN" S LA7Y=$$TRIM^XLFSTR(LA7VAL,"RL"," ") ;MU2
+11 IF LA7OBX2="TS"
Begin DoDot:1
+12 SET LA7VAL=$$CHKDT^LA7VHLU1(LA7VAL)
+13 SET LA7Y=$$FMTHL7^XLFDT(LA7VAL)
End DoDot:1
+14 IF LA7OBX2?1(1"CE",1"CNE",1"CWE")
Begin DoDot:1
+15 NEW LA7I,LA7J,X
+16 SET LA7J=$SELECT(LA7OBX2="CE":6,1:9)
+17 FOR LA7I=1:1:LA7J
IF $PIECE(LA7VAL,"^",LA7I)'=""
SET $PIECE(LA7Y,$EXTRACT(LA7ECH),LA7I)=$$CHKDATA^LA7VHLU3($PIECE(LA7VAL,"^",LA7I),LA7FS_LA7ECH)
End DoDot:1
+18 ;mu2
IF LA7OBX2="SN"
Begin DoDot:1
+19 NEW LA7I
+20 SET $PIECE(LA7Y,$EXTRACT(LA7ECH))="="
+21 SET $PIECE(LA7Y,$EXTRACT(LA7ECH),2)=LA7VAL
+22 IF $EXTRACT(LA7VAL)="<"
Begin DoDot:2
+23 SET $PIECE(LA7Y,$EXTRACT(LA7ECH))="<"
+24 SET $PIECE(LA7Y,$EXTRACT(LA7ECH),2)=$PIECE(LA7VAL,"<",2)
End DoDot:2
+25 IF $EXTRACT(LA7VAL,1,2)="<="
Begin DoDot:2
+26 SET $PIECE(LA7Y,$EXTRACT(LA7ECH))="<="
+27 SET $PIECE(LA7Y,$EXTRACT(LA7ECH),2)=$PIECE(LA7VAL,"<=",2)
End DoDot:2
+28 IF $EXTRACT(LA7VAL)=">"
Begin DoDot:2
+29 SET $PIECE(LA7Y,$EXTRACT(LA7ECH))=">"
+30 SET $PIECE(LA7Y,$EXTRACT(LA7ECH),2)=$PIECE(LA7VAL,">",2)
End DoDot:2
+31 ;S $P(LA7Y,$E(LA7ECH))=$S($E(LA7VAL)="<":"<=",$E(LA7VAL)=">":">=",1:"=")
+32 ;S $P(LA7Y,$E(LA7ECH),2)=$S($E(LA7VAL)="<":$P(LA7VAL,"<",2),$E(LA7VAL)=">":$P(LA7VAL,">",2),1:LA7VAL)
+33 IF LA7Y[":"
Begin DoDot:2
+34 NEW LA7Z
+35 SET LA7Z=$PIECE(LA7Y,$EXTRACT(LA7ECH),2)
+36 SET $PIECE(LA7Y,$EXTRACT(LA7ECH))=""
+37 SET $PIECE(LA7Y,$EXTRACT(LA7ECH),2)=$PIECE(LA7Z,":")
+38 SET $PIECE(LA7Y,$EXTRACT(LA7ECH),3)=":"
+39 SET $PIECE(LA7Y,$EXTRACT(LA7ECH),4)=$PIECE(LA7Z,":",2)
End DoDot:2
+40 IF $PIECE(LA7Y," ")["/"
Begin DoDot:2
+41 NEW LA7Z
+42 SET LA7Z=$PIECE(LA7Y,$EXTRACT(LA7ECH),2)
+43 SET $PIECE(LA7Y,$EXTRACT(LA7ECH))="="
+44 SET $PIECE(LA7Y,$EXTRACT(LA7ECH),2)=$PIECE(LA7Z,"/")
+45 SET $PIECE(LA7Y,$EXTRACT(LA7ECH),3)="/"
+46 SET $PIECE(LA7Y,$EXTRACT(LA7ECH),4)=$PIECE($PIECE(LA7Z,"/",2)," ")_" "_$PIECE(LA7Z," ",2)
End DoDot:2
+47 ;F LA7I=1:1:9 I $P(LA7VAL,"^",LA7I)'="" S $P(LA7Y,$E(LA7ECH),LA7I)=$$CHKDATA^LA7VHLU3($P(LA7VAL,"^",LA7I),LA7FS_LA7ECH)
End DoDot:1
+48 IF LA7OBX2="NM"
SET LA7Y=LA7VAL
+49 ;
+50 QUIT
+51 ;
+52 ;
OBX5M ; Build OBX-5 sequence - Observation value - multi-line textual result
+1 ;
+2 KILL LA7WP
+3 ;
+4 SET LA7WP=""
+5 SET LA7TYPE=$$GET1^DID(LA7FN,LA7FLD,"","TYPE","LA7ERR(1)")
+6 ;
+7 ; Process word-processing type field.
+8 ; Check and encode data
+9 IF LA7TYPE="WORD-PROCESSING"
Begin DoDot:1
+10 NEW DIWF,DIWL,DIWR,X
+11 SET LA7WP=$$GET1^DIQ(LA7FN,LA7IENS,LA7FLD,"","LA7WP","LA7ERR(2)")
+12 KILL ^UTILITY($JOB,"W")
+13 SET DIWL=1
SET DIWR=245
SET DIWF=""
SET LA7I=0
+14 IF $$GET1^DID(+$$GET1^DID(LA7FN,LA7FLD,"","SPECIFIER","LA7ERR(1)"),.01,"","SPECIFIER","LA7ERR(3)")["L"
SET DIWF="N"
+15 FOR
SET LA7I=$ORDER(LA7WP(LA7I))
IF 'LA7I
QUIT
SET X=LA7WP(LA7I)
DO ^DIWP
+16 KILL LA7WP
+17 SET LA7I=0
+18 FOR
SET LA7I=$ORDER(^UTILITY($JOB,"W",DIWL,LA7I))
IF 'LA7I
QUIT
Begin DoDot:2
+19 SET LA7WP(LA7I)=$$CHKDATA^LA7VHLU3(^UTILITY($JOB,"W",DIWL,LA7I,0),LA7FS_LA7ECH)
+20 IF LA7I>1
SET LA7WP(LA7I)=$EXTRACT(LA7ECH,3)_".br"_$EXTRACT(LA7ECH,3)_LA7WP(LA7I)
End DoDot:2
+21 KILL ^UTILITY($JOB,"W")
End DoDot:1
QUIT
+22 ;
+23 ; Free text, assumes multiple valued
+24 IF LA7TYPE="FREE TEXT"
Begin DoDot:1
+25 DO GETS^DIQ(LA7FN,LA7IENS,LA7FLD_"*","","LA7WP","LA7ERR")
End DoDot:1
+26 ;
+27 QUIT
+28 ;
+29 ;
OBX5R ; Build OBX-5 sequence with repetition - Observation value
+1 ;
+2 SET (LA7I,LA7Y)=""
+3 FOR
SET LA7I=$ORDER(LA7VAL(LA7I))
IF 'LA7I
QUIT
Begin DoDot:1
+4 SET LA7Y=LA7Y_$$OBX5^LA7VOBX(LA7VAL(LA7I),LA7OBX2,LA7FS,LA7ECH)_$EXTRACT(LA7ECH,2)
End DoDot:1
+5 ;
+6 QUIT
+7 ;
+8 ;
OBX6 ; Build OBX-6 sequence - Units
+1 ;
+2 SET LA7ECH=$GET(LA7ECH)
SET LA7Y=""
+3 ;
+4 ; Units - remove leading and trailing spaces
+5 ; If HDR interface (LA7INTYP=30) then add coding system (L) to units.
+6 IF $GET(LA7VAL)'=""
Begin DoDot:1
+7 SET LA7Y=$$TRIM^XLFSTR(LA7VAL,"LR"," ")
+8 IF $GET(LA7INTYP)=30
Begin DoDot:2
+9 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),2)=LA7Y
+10 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),3)="L"
End DoDot:2
End DoDot:1
+11 ;
+12 ; Build sequence using LOINC codes only
+13 ; LOINC code/code name/"LN"
+14 IF $GET(LA764061)
Begin DoDot:1
+15 NEW LA7IENS,LA7X,LA7Z
+16 SET LA7IENS=LA764061_","
+17 DO GETS^DIQ(64.061,LA7IENS,"1;8","E","LA7X")
+18 ; LOINC code
+19 SET LA7Z=$GET(LA7X(64.061,LA7IENS,1,"E"))
+20 SET LA7Z=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
+21 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),1)=LA7Z
+22 ; LOINC code name
+23 SET LA7Z=$GET(LA7X(64.061,LA7IENS,8,"E"))
+24 SET LA7Z=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
+25 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),2)=LA7Z
+26 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),3)="LN"
End DoDot:1
+27 ;
+28 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),2)=LA7VAL
+29 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),3)="UCUM"
+30 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),4)=LA7VAL
+31 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),5)=LA7VAL
+32 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),6)="L"
+33 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),7)="1.1"
+34 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),8)="1.0"
+35 QUIT
+36 ;
+37 ;
OBX7 ; Build OBX-7 sequence - Reference range
+1 ; Removes leading and trailing quote marks ("").
+2 ;
+3 SET LA7Y=""
+4 ;
+5 IF $GET(LA7LOW)'=""
Begin DoDot:1
+6 SET LA7LOW=$$TRIM^XLFSTR(LA7LOW,"RL","""")
+7 ; alphabetic value
IF LA7LOW?1A.E
SET LA7Y=LA7Y_LA7LOW
QUIT
+8 IF $GET(LA7HIGH)=""
IF $EXTRACT(LA7LOW)'=">"
SET LA7Y=">"
+9 SET LA7Y=LA7Y_LA7LOW
End DoDot:1
+10 ;
+11 IF $GET(LA7HIGH)'=""
Begin DoDot:1
+12 SET LA7HIGH=$$TRIM^XLFSTR(LA7HIGH,"RL","""")
+13 ; alphabetic value
IF LA7HIGH?1A.E
SET LA7Y=LA7Y_LA7HIGH
QUIT
+14 IF $GET(LA7LOW)=""
Begin DoDot:2
+15 IF $EXTRACT(LA7HIGH)'="<"
SET LA7Y="<"
+16 SET LA7Y=LA7Y_LA7HIGH
End DoDot:2
QUIT
+17 SET LA7Y=LA7Y_"-"_LA7HIGH
End DoDot:1
+18 ;
+19 ;mu2 added units to the end
SET LA7Y=$$CHKDATA^LA7VHLU3(LA7Y,LA7FS_LA7ECH)_" "_$PIECE($PIECE(LA7VAL,U,5),"!",7)
+20 ;mu2 inpatient
IF $GET(LA7INPT)
SET LA7Y=$EXTRACT(LA7Y,1,60)
+21 ;
+22 QUIT
+23 ;
+24 ;
OBX17 ; Build OBX-17 sequence - Observation method field
+1 ;
+2 ; method suffix code maybe stored without leading decimal,
+3 ; add "." back for lookup, also add trailing space for lookup in x-ref.
+4 IF LA7VAL>1
SET LA7VAL="."_LA7VAL
+5 SET LA7X=$ORDER(^LAB(64.2,"C",LA7VAL_" ",0))
SET LA7Y=""
+6 IF LA7X
Begin DoDot:1
+7 SET LA7X(.01)=$PIECE($GET(^LAB(64.2,LA7X,0)),"^")
+8 SET LA7X(.01)=$$CHKDATA^LA7VHLU3(LA7X(.01),LA7FS_LA7ECH)
+9 SET LA7Y=LA7VAL_$EXTRACT(LA7ECH)_LA7X(.01)_$EXTRACT(LA7ECH)_"OBSMETHOD"
+10 ;S LA7X=$$GET1^DID(64.2,"","","PACKAGE REVISION DATA")
+11 ;S $P(LA7Y,$E(LA7ECH,1),7)=LA7X
End DoDot:1
+12 ;
+13 ; Send NLT result code
+14 IF LA7NLT'=""
Begin DoDot:1
+15 SET LA764=$ORDER(^LAM("E",LA7NLT,0))
SET LA7Z=""
+16 IF LA764
SET LA7X=$PIECE($GET(^LAM(LA764,0)),"^")
+17 SET LA7X=$$CHKDATA^LA7VHLU3(LA7X,LA7FS_LA7ECH)
+18 SET $PIECE(LA7Z,$EXTRACT(LA7ECH,1),1)=LA7NLT
+19 SET $PIECE(LA7Z,$EXTRACT(LA7ECH,1),2)=LA7X
+20 SET $PIECE(LA7Z,$EXTRACT(LA7ECH,1),3)="L"
+21 ;S LA7X=$$GET1^DID(64,"","","PACKAGE REVISION DATA")
+22 ;S $P(LA7Z,$E(LA7ECH,1),7)=LA7X
+23 IF LA7Y'=""
SET LA7Y=LA7Y_$EXTRACT(LA7ECH)
+24 SET LA7Y=LA7Y_LA7Z
+25 SET $PIECE(LA7Y,$EXTRACT(LA7ECH),7)=20090501
+26 SET $PIECE(LA7Y,$EXTRACT(LA7ECH),8)=LA7VER
End DoDot:1
+27 ;
+28 QUIT
+29 ;
+30 ;
OBX18 ; Build OBX-18 sequence - Equipment entity identifier field
+1 ;
+2 SET LA7X=""
SET LA7J=$LENGTH(LA7VAL,"!")
+3 FOR LA7I=1:1:LA7J
Begin DoDot:1
+4 SET LA7Y=$PIECE(LA7VAL,"!",LA7I)
+5 IF LA7Y=""
QUIT
+6 SET $PIECE(LA7X,$EXTRACT(LA7ECH,1),LA7I)=$$CHKDATA^LA7VHLU3(LA7Y,LA7FS_LA7ECH)
End DoDot:1
+7 ;
+8 QUIT
