LA7VOBXA ;DALOI/JMC - LAB OBX Segment message builder (cont'd) ;04/14/11 10:56
;;5.2;AUTOMATED LAB INSTRUMENTS;**46,70,64,68,74**;Sep 27, 1994;Build 229
;
Q
;
OBX2 ; Build OBX-2 sequence - Value type
;
; default value - string data
S LA7VAL="ST"
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="ST"
I LA7TYP="WORD-PROCESSING" S LA7VAL="FT"
I LA7TYP="NUMERIC" S LA7VAL="NM"
I LA7TYP="SET" S LA7VAL="ST"
I LA7TYP="POINTER" S LA7VAL="ST"
;
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
. I LA7953?1.N S LA7IENS=LA7953_","
. E S LA7IENS=$O(^LAB(95.3,"B",LA7953,0))_","
. 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)="99VA95.3"
. . 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)="99VA64"
. 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
; Local VA display name in 2nd triplet of LA7ALT
; If alternate is a non-VA code then use as alternate code.
I LA7ALT="" Q
I $P(LA7ALT,"^",1,3)'="^^" D
. 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?1(1"NM",1"SN") S LA7Y=$$TRIM^XLFSTR(LA7VAL,"RL"," ")
;
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)
;
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="N",LA7I=0
. 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"," ")
. S LA7Y=$$CHKDATA^LA7VHLU3(LA7Y,LA7FS_LA7ECH)
. 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"
;
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)
;
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)_"99VA64.2"
. ;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)="99VA64"
. ;S LA7X=$$GET1^DID(64,"","","PACKAGE REVISION DATA")
. ;S $P(LA7Z,$E(LA7ECH,1),7)=LA7X
. I LA7Y'="" S LA7Y=LA7Y_$E(LA7ECH,2)
. S LA7Y=LA7Y_LA7Z
;
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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7VOBXA 8536 printed Dec 13, 2024@01:40:54 Page 2
LA7VOBXA ;DALOI/JMC - LAB OBX Segment message builder (cont'd) ;04/14/11 10:56
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,70,64,68,74**;Sep 27, 1994;Build 229
+2 ;
+3 QUIT
+4 ;
OBX2 ; Build OBX-2 sequence - Value type
+1 ;
+2 ; default value - string data
+3 SET LA7VAL="ST"
+4 SET LA7TYP=""
SET LA7FILE=$GET(LA7FILE)
SET LA7FIELD=$GET(LA7FIELD)
+5 ;
+6 IF LA7FILE
IF LA7FIELD
SET LA7TYP=$$GET1^DID(LA7FILE,LA7FIELD,"","TYPE","","LA7ERR")
+7 ;
+8 IF LA7TYP="DATE/TIME"
SET LA7VAL="TS"
+9 IF LA7TYP="FREE TEXT"
SET LA7VAL="ST"
+10 IF LA7TYP="WORD-PROCESSING"
SET LA7VAL="FT"
+11 IF LA7TYP="NUMERIC"
SET LA7VAL="NM"
+12 IF LA7TYP="SET"
SET LA7VAL="ST"
+13 IF LA7TYP="POINTER"
SET LA7VAL="ST"
+14 ;
+15 QUIT
+16 ;
+17 ;
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 IF LA7953?1.N
SET LA7IENS=LA7953_","
+10 IF '$TEST
SET LA7IENS=$ORDER(^LAB(95.3,"B",LA7953,0))_","
+11 DO GETS^DIQ(95.3,LA7IENS,".01;80;99.99","E","LA7X")
+12 ; Invalid code???
+13 IF $GET(LA7X(95.3,LA7IENS,.01,"E"))=""
QUIT
+14 SET LA7Z=LA7X(95.3,LA7IENS,.01,"E")
+15 SET LA7Z=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
+16 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),LA7J)=LA7Z
+17 SET LA7Z=$GET(LA7X(95.3,LA7IENS,80,"E"))
+18 SET LA7Z=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
+19 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),LA7J+1)=LA7Z
+20 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),LA7J+2)="LN"
+21 SET LA7J=4
+22 IF LA7INTYP=30
IF $GET(LA7X(95.3,LA7IENS,99.99,"E"))'=""
Begin DoDot:2
+23 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),LA7J)=LA7X(95.3,LA7IENS,99.99,"E")
+24 IF $$VFIELD^DILFD(95.3,82)
Begin DoDot:3
+25 SET LA7Z=$$GET1^DIQ(95.3,LA7IENS,82)
+26 IF LA7Z'=""
SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),LA7J+1)=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
End DoDot:3
+27 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),LA7J+2)="99VA95.3"
+28 SET LA7J=9
End DoDot:2
+29 IF $GET(LA7LNCVR)=""
SET LA7LNCVR=$$GET1^DID(95.3,"","","PACKAGE REVISION DATA")
+30 IF LA7J>1
SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),7)=LA7LNCVR
+31 IF LA7J=9
SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),8)=LA7LNCVR
End DoDot:1
+32 ;
+33 ; Build sequence using NLT codes - file #64 NLT code/NLT code name/"99VA64"
+34 ; If LOINC is primary make NLT alternate, otherwise NLT primary.
+35 ; Only on non-HDR type interfaces.
+36 IF LA7NLT'=""
IF LA7INTYP'=30
IF LA7J<9
Begin DoDot:1
+37 NEW LA7642,LA7Z
+38 SET LA764=$ORDER(^LAM("E",LA7NLT,0))
SET LA7Z=""
+39 IF LA764
SET LA7Z=$$GET1^DIQ(64,LA764_",",.01,"I")
+40 IF LA7Z=""
Begin DoDot:2
+41 SET LA764=$ORDER(^LAM("E",$PIECE(LA7NLT,".")_".0000",0))
+42 IF LA764
SET LA7Z=$$GET1^DIQ(64,LA764_",",.01,"I")
+43 SET LA7642=$ORDER(^LAB(64.2,"C","."_$PIECE(LA7NLT,".",2),0))
+44 IF LA764
IF LA7642
SET LA7Z=LA7Z_"~"_$$GET1^DIQ(64.2,LA7642_",",.01,"I")
End DoDot:2
+45 SET LA7Z=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
+46 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),LA7J)=LA7NLT
+47 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),LA7J+1)=LA7Z
+48 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),LA7J+2)="99VA64"
+49 SET LA7Z=$$GET1^DID(64,"","","PACKAGE REVISION DATA")
+50 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),$SELECT(LA7J=1:7,1:8))=LA7Z
+51 SET LA7J=LA7J+3
End DoDot:1
+52 ;
+53 ; Non-standard/non-VA code
+54 ; Local VA display name in 2nd triplet of LA7ALT
+55 ; If alternate is a non-VA code then use as alternate code.
+56 IF LA7ALT=""
QUIT
+57 IF $PIECE(LA7ALT,"^",1,3)'="^^"
Begin DoDot:1
+58 IF LA7INTYP'=30
IF $PIECE(LA7ALT,"^",3)'="99VA63"
IF LA7J>4
SET LA7J=4
+59 IF LA7J<7
Begin DoDot:2
+60 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),LA7J)=$$CHKDATA^LA7VHLU3($PIECE(LA7ALT,"^"),LA7FS_LA7ECH)
+61 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),LA7J+1)=$$CHKDATA^LA7VHLU3($PIECE(LA7ALT,"^",2),LA7FS_LA7ECH)
+62 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),LA7J+2)=$$CHKDATA^LA7VHLU3($PIECE(LA7ALT,"^",3),LA7FS_LA7ECH)
+63 IF $PIECE(LA7ALT,"^",3)="99VA63"
SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),$SELECT(LA7J=1:7,1:8))="5.2"
End DoDot:2
End DoDot:1
+64 ;
+65 ; Put local test name in local text (9th component)
+66 IF $EXTRACT($PIECE(LA7ALT,"^",6),1,5)="99VA6"
IF $PIECE(LA7ALT,"^",6)'="99VA64"
Begin DoDot:1
+67 NEW I,LA7Z
+68 SET LA7Z=$$TRIM^XLFSTR($PIECE(LA7ALT,"^",5),"LR"," ")
+69 IF LA7Z=""
QUIT
+70 SET LA7Z=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
+71 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),9)=LA7Z
End DoDot:1
+72 ;
+73 QUIT
+74 ;
+75 ;
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 ;
+8 IF LA7OBX2="ST"!(LA7OBX2="TX")
Begin DoDot:1
+9 SET LA7VAL=$$TRIM^XLFSTR(LA7VAL,"R"," ")
+10 SET LA7Y=$$CHKDATA^LA7VHLU3(LA7VAL,LA7FS_LA7ECH)
End DoDot:1
+11 ;
+12 IF LA7OBX2?1(1"NM",1"SN")
SET LA7Y=$$TRIM^XLFSTR(LA7VAL,"RL"," ")
+13 ;
+14 IF LA7OBX2="TS"
Begin DoDot:1
+15 SET LA7VAL=$$CHKDT^LA7VHLU1(LA7VAL)
+16 SET LA7Y=$$FMTHL7^XLFDT(LA7VAL)
End DoDot:1
+17 ;
+18 IF LA7OBX2?1(1"CE",1"CNE",1"CWE")
Begin DoDot:1
+19 NEW LA7I,LA7J,X
+20 SET LA7J=$SELECT(LA7OBX2="CE":6,1:9)
+21 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
+22 ;
+23 QUIT
+24 ;
+25 ;
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="N"
SET LA7I=0
+14 FOR
SET LA7I=$ORDER(LA7WP(LA7I))
if 'LA7I
QUIT
SET X=LA7WP(LA7I)
DO ^DIWP
+15 KILL LA7WP
+16 SET LA7I=0
+17 FOR
SET LA7I=$ORDER(^UTILITY($JOB,"W",DIWL,LA7I))
if 'LA7I
QUIT
Begin DoDot:2
+18 SET LA7WP(LA7I)=$$CHKDATA^LA7VHLU3(^UTILITY($JOB,"W",DIWL,LA7I,0),LA7FS_LA7ECH)
+19 IF LA7I>1
SET LA7WP(LA7I)=$EXTRACT(LA7ECH,3)_".br"_$EXTRACT(LA7ECH,3)_LA7WP(LA7I)
End DoDot:2
+20 KILL ^UTILITY($JOB,"W")
End DoDot:1
QUIT
+21 ;
+22 ; Free text, assumes multiple valued
+23 IF LA7TYPE="FREE TEXT"
Begin DoDot:1
+24 DO GETS^DIQ(LA7FN,LA7IENS,LA7FLD_"*","","LA7WP","LA7ERR")
End DoDot:1
+25 ;
+26 QUIT
+27 ;
+28 ;
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 SET LA7Y=$$CHKDATA^LA7VHLU3(LA7Y,LA7FS_LA7ECH)
+9 IF $GET(LA7INTYP)=30
Begin DoDot:2
+10 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),2)=LA7Y
+11 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),3)="L"
End DoDot:2
End DoDot:1
+12 ;
+13 ; Build sequence using LOINC codes only
+14 ; LOINC code/code name/"LN"
+15 IF $GET(LA764061)
Begin DoDot:1
+16 NEW LA7IENS,LA7X,LA7Z
+17 SET LA7IENS=LA764061_","
+18 DO GETS^DIQ(64.061,LA7IENS,"1;8","E","LA7X")
+19 ; LOINC code
+20 SET LA7Z=$GET(LA7X(64.061,LA7IENS,1,"E"))
+21 SET LA7Z=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
+22 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),1)=LA7Z
+23 ; LOINC code name
+24 SET LA7Z=$GET(LA7X(64.061,LA7IENS,8,"E"))
+25 SET LA7Z=$$CHKDATA^LA7VHLU3(LA7Z,LA7FS_LA7ECH)
+26 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),2)=LA7Z
+27 SET $PIECE(LA7Y,$EXTRACT(LA7ECH,1),3)="LN"
End DoDot:1
+28 ;
+29 QUIT
+30 ;
+31 ;
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 SET LA7Y=$$CHKDATA^LA7VHLU3(LA7Y,LA7FS_LA7ECH)
+20 ;
+21 QUIT
+22 ;
+23 ;
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)_"99VA64.2"
+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)="99VA64"
+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,2)
+24 SET LA7Y=LA7Y_LA7Z
End DoDot:1
+25 ;
+26 QUIT
+27 ;
+28 ;
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
