LA7VOBX1 ;VA/DALOI/JMC - LAB OBX Segment message builder (CH subscript) cont'd ; 13-Aug-2013 09:09 ; MKK
;;5.2;AUTOMATED LAB INSTRUMENTS;**46,61,63,1018,64,1027,72,1031,68,1033**;NOV 1, 1997
;
CH ; Observation/Result segment for "CH" subscript results.
; Called by LA7VOBX
;
N LA760,LA76304,LA7ALT,LA7DDERR,LA7DIV,LA7I,LA7RS,LA7X,LA7Y,X
;
; "CH" subscript requires a dataname
I '$G(LRSB) Q
;
; get result node from LR global.
S LA76304(0)=$G(^LR(LRDFN,LRSS,LRIDT,0))
S LA7RS=$P(LRSB,"^",2),LRSB=$P(LRSB,"^")
S LA7VAL=$G(^LR(LRDFN,LRSS,LRIDT,LRSB))
; If previous results have been corrected then send corrected status
I LA7RS="",$P(LA7VAL,"^",10)=2 S LA7RS="C"
;
; Check if test is OK to send - (O)utput or (B)oth
S LA7X=$P(LA7VAL,"^",12)
I LA7X]"","BO"'[LA7X Q
I LA7X="",'$$OKTOSND^LA7VHLU1(LRSS,LRSB,+$P($P(LA7VAL,"^",3),"!",7)) Q
;
; If no result NLT or LOINC try to determine from file #60
S LA7X=$P(LA7VAL,"^",3)
I $P(LA7X,"!",2)=""!($P(LA7X,"!",3)="") S $P(LA7VAL,"^",3)=$$DEFCODE^LA7VHLU5(LRSS,LRSB,LA7X,$P(LA76304(0),"^",5))
; No result NLT code - log error
I $P($P(LA7VAL,"^",3),"!",2)="" D
. N LA7X
. S LA7X="["_LRSB_"]"_$$GET1^DID(63.04,LRSB,"","LABEL")
. D CREATE^LA7LOG(36)
;
; something missing - No result.
I $P(LA7VAL,"^")="" Q
;
; Check for missing units/reference ranges
D CHECK
;
; Initialize OBX segment
S LA7OBX(0)="OBX"
S LA7OBX(1)=$$OBX1^LA7VOBX(.LA7OBXSN)
;
; Value type
; If result is "cancel", "comment" or "pending" then data type is ST - string data
S LA7X=$S("canccommentpending"[$P(LA7VAL,"^"):1,1:0)
I LA7X,LA7INTYP'=30 S LA7OBX(2)="ST"
E S LA7OBX(2)=$$OBX2^LA7VOBX(63.04,LRSB)
I LA7OBX(2)'="NM",$P(LA7VAL,"^")?1(1.N,.N1"."1.N) S LA7OBX(2)="NM"
;
; Observation identifer
; build alternate code based on dataname from file #63 in case it's needed
S LA7X=$P(LA7VAL,"^",3)
S LA7ALT="CH"_LRSB_"^"_$$GET1^DID(63.04,LRSB,"","LABEL")_"^99VA63"
I $P(LA7X,"!",7) S LA760=$P(LA7X,"!",7)
E S LA760=+$O(^LAB(60,"C","CH;"_LRSB_";1",0))
I LA760 S $P(LA7ALT,"^",4,6)=LA760_"^"_$P(^LAB(60,LA760,0),"^")_"^99VA60"
S LA7OBX(3)=$$OBX3^LA7VOBX($P(LA7X,"!",2),$P(LA7X,"!",3),LA7ALT,LA7FS,LA7ECH,$G(LA7INTYP))
;
; Build sub-id to aid in linking updates to previous transmissions.
S LA7OBX(4)=$$OBX4^LA7VOBX("CH"_LRSB,LA7FS,LA7ECH)
;
; Test value
; If DoD and "canc" then report "PL Cancelled" per Lab Interop ICD.
S LA7X=$P(LA7VAL,"^") K LA7DDERR
I LA7X'="canc",$$GET1^DID(63.04,LRSB,"","TYPE","","LA7DDERR")="SET" D
. S LA7X=$$EXTERNAL^DILFD(63.04,LRSB,"",LA7X)
. I LA7X="" S LA7X=$P(LA7VAL,"^")
I $G(LA7NVAF)=1,LA7X="canc" S LA7X="PL Cancelled"
S LA7OBX(5)=$$OBX5^LA7VOBX(LA7X,LA7OBX(2),LA7FS,LA7ECH)
; Log exception when data dictionary appears corrupt.
I $D(LA7DDERR) D CREATE^LA7LOG(121) K LA7DDERR
;
; Suppress "pending" results when sending to HDR
I LA7INTYP=30,$P(LA7VAL,"^")="pending" S LA7OBX(2)="",LA7OBX(5)=""
;
; Units
S LA7X=$P(LA7VAL,"^",5)
S LA7OBX(6)=$$OBX6^LA7VOBX($P(LA7X,"!",7),"",LA7FS,LA7ECH,$G(LA7INTYP))
;
; Reference range - use therapeutic low/high if present.
K LA7Y
I $P(LA7X,"!",11)="",$P(LA7X,"!",12)="" D
. S LA7Y("LOW")=$P(LA7X,"!",2)
. S LA7Y("HIGH")=$P(LA7X,"!",3)
E D
. S LA7Y("LOW")=$P(LA7X,"!",11)
. S LA7Y("HIGH")=$P(LA7X,"!",12)
;
S LA7OBX(7)=$$OBX7^LA7VOBX(LA7Y("LOW"),LA7Y("HIGH"),LA7FS,LA7ECH)
K LA7Y
;
; Abnormal flags
S LA7OBX(8)=$$OBX8^LA7VOBX($P(LA7VAL,"^",2))
;
; "P"artial or "F"inal results
S LA7X=$S("canccommentpending"[$P(LA7VAL,"^"):$P(LA7VAL,"^"),1:"F")
I LA7RS="C" D
. S LA7X=LA7RS
. I LA7INTYP=30,$P(LA7VAL,"^")="pending" S LA7X="W",LA7OBX(5)=""""""
S LA7OBX(11)=$$OBX11^LA7VOBX(LA7X)
I LA7INTYP=30,$P(LA7VAL,"^")="canc",LA7OBX(11)="X" S LA7OBX(2)="",LA7OBX(5)=""
;
; Observation date/time - collection date/time per HL7 standard
S LA7X=$P(LA76304(0),"^") S:$P(LA76304(0),"^",2) LA7X=$P(LA7X,".")
I LA7X S LA7OBX(14)=$$OBX14^LA7VOBX(LA7X)
;
S LA7DIV=$P(LA7VAL,"^",9)
I LA7DIV="" S LA7DIV=$P($G(^LR(LRDFN,LRSS,LRIDT,"RF")),"^")
I LA7DIV="",$$DIV4^XUSER(.LA7DIV,$P(LA7VAL,"^",4)) S LA7DIV=$O(LA7DIV(0))
;
; Facility that performed the testing
S LA7OBX(15)=$$OBX15^LA7VOBX(LA7DIV,LA7FS,LA7ECH)
;
; Person that verified the test
S LA7OBX(16)=$$OBX16^LA7VOBX($P(LA7VAL,"^",4),LA7DIV,LA7FS,LA7ECH)
;
; Observation method - workkload suffix (LA7X) and result NLT code (LA7Y)
S LA7X=$P($P(LA7VAL,"^",3),"!",4),LA7Y=$P($P(LA7VAL,"^",3),"!",2)
I LA7X'=""!(LA7Y="") S LA7OBX(17)=$$OBX17^LA7VOBX(LA7X,LA7Y,LA7FS,LA7ECH)
;
; Equipment entity identifier
I $P(LA7VAL,"^",11)'="" S LA7OBX(18)=$$OBX18^LA7VOBX($P(LA7VAL,"^",11),LA7FS,LA7ECH)
;
; Date/time of the analysis
I $P(LA7VAL,"^",6)'="" S LA7OBX(19)=$$OBX19^LA7VOBX($P(LA7VAL,"^",6))
;
; Performing organization name/address
I LA7DIV'="" D
. N LA7DT
. S LA7OBX(23)=$$OBX23^LA7VOBX(4,LA7DIV,LA7FS,LA7ECH)
. S LA7DT=$S($P(LA7VAL,"^",6):$P(LA7VAL,"^",6),$P(LA76304(0),"^",3):$P(LA76304(0),"^",3),1:$$NOW^XLFDT)
. S LA7OBX(24)=$$OBX24^LA7VOBX(4,LA7DIV,LA7DT,LA7FS,LA7ECH)
;
D BUILDSEG^LA7VHLU(.LA7OBX,.LA7ARRAY,LA7FS)
;
Q
;
;
CHECK ; Check for missing units/reference ranges
;
N LA7I,LA7X,LA7FLAG
S LA7X=$P(LA7VAL,"^",5)
;
; If flag (NPC>1) indicates units/ranges are stored but pieces 5-9 are null then use values from file #60
; - some class III software still does not store this info in file #63 when NPC>1
S LA7FLAG=0
I $G(^LR(LRDFN,LRSS,LRIDT,"NPC"))>1 D
. F LA7I=5:1:9 I $P(LA7VAL,"^",LA7I)'="" S LA7FLAG=1 Q
I 'LA7FLAG D BUNR
;
; Evaluate low/high reference ranges in case M code in these fields.
S:$G(SEX)="" SEX="M" S:$G(AGE)="" AGE=99
F LA7I=2,3,11,12 I $E($P(LA7X,"!",LA7I),1,3)="$S(" D
. S @("X="_$P(LA7X,"!",LA7I))
. S $P(LA7X,"!",LA7I)=X
;
; Put units/reference ranges back in variable LA7VAL
S $P(LA7VAL,"^",5)=LA7X
;
Q
;
;
BUNR ; Build units/normal ranges from file #60
;
N LA7Y
S LA7Y=$$REFUNIT^LA7VHLU1(LRSB,$P(LA76304(0),"^",5))
;
; Results missing units, use value from file #60
I $P(LA7X,"!",7)="" S $P(LA7X,"!",7)=$P(LA7Y,"^",3)
;
; If results missing reference ranges, use values from file #60.
I $P(LA7X,"!",2)="",$P(LA7X,"!",3)="",$P(LA7X,"!",11)="",$P(LA7X,"!",12)="" D
. I $P(LA7X,"!",2)="",$P(LA7X,"!",3)="" D
. . S $P(LA7X,"!",2)=$P(LA7Y,"^")
. . S $P(LA7X,"!",3)=$P(LA7Y,"^",2)
. I $P(LA7X,"!",11)="",$P(LA7X,"!",12)="" D
. . S $P(LA7X,"!",11)=$P(LA7Y,"^",6)
. . S $P(LA7X,"!",12)=$P(LA7Y,"^",7)
Q
LA7VOBX1 ;VA/DALOI/JMC - LAB OBX Segment message builder (CH subscript) cont'd ; 13-Aug-2013 09:09 ; MKK
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,61,63,1018,64,1027,72,1031,68,1033**;NOV 1, 1997
+2 ;
CH ; Observation/Result segment for "CH" subscript results.
+1 ; Called by LA7VOBX
+2 ;
+3 NEW LA760,LA76304,LA7ALT,LA7DDERR,LA7DIV,LA7I,LA7RS,LA7X,LA7Y,X
+4 ;
+5 ; "CH" subscript requires a dataname
+6 IF '$GET(LRSB)
QUIT
+7 ;
+8 ; get result node from LR global.
+9 SET LA76304(0)=$GET(^LR(LRDFN,LRSS,LRIDT,0))
+10 SET LA7RS=$PIECE(LRSB,"^",2)
SET LRSB=$PIECE(LRSB,"^")
+11 SET LA7VAL=$GET(^LR(LRDFN,LRSS,LRIDT,LRSB))
+12 ; If previous results have been corrected then send corrected status
+13 IF LA7RS=""
IF $PIECE(LA7VAL,"^",10)=2
SET LA7RS="C"
+14 ;
+15 ; Check if test is OK to send - (O)utput or (B)oth
+16 SET LA7X=$PIECE(LA7VAL,"^",12)
+17 IF LA7X]""
IF "BO"'[LA7X
QUIT
+18 IF LA7X=""
IF '$$OKTOSND^LA7VHLU1(LRSS,LRSB,+$PIECE($PIECE(LA7VAL,"^",3),"!",7))
QUIT
+19 ;
+20 ; If no result NLT or LOINC try to determine from file #60
+21 SET LA7X=$PIECE(LA7VAL,"^",3)
+22 IF $PIECE(LA7X,"!",2)=""!($PIECE(LA7X,"!",3)="")
SET $PIECE(LA7VAL,"^",3)=$$DEFCODE^LA7VHLU5(LRSS,LRSB,LA7X,$PIECE(LA76304(0),"^",5))
+23 ; No result NLT code - log error
+24 IF $PIECE($PIECE(LA7VAL,"^",3),"!",2)=""
Begin DoDot:1
+25 NEW LA7X
+26 SET LA7X="["_LRSB_"]"_$$GET1^DID(63.04,LRSB,"","LABEL")
+27 DO CREATE^LA7LOG(36)
End DoDot:1
+28 ;
+29 ; something missing - No result.
+30 IF $PIECE(LA7VAL,"^")=""
QUIT
+31 ;
+32 ; Check for missing units/reference ranges
+33 DO CHECK
+34 ;
+35 ; Initialize OBX segment
+36 SET LA7OBX(0)="OBX"
+37 SET LA7OBX(1)=$$OBX1^LA7VOBX(.LA7OBXSN)
+38 ;
+39 ; Value type
+40 ; If result is "cancel", "comment" or "pending" then data type is ST - string data
+41 SET LA7X=$SELECT("canccommentpending"[$PIECE(LA7VAL,"^"):1,1:0)
+42 IF LA7X
IF LA7INTYP'=30
SET LA7OBX(2)="ST"
+43 IF '$TEST
SET LA7OBX(2)=$$OBX2^LA7VOBX(63.04,LRSB)
+44 IF LA7OBX(2)'="NM"
IF $PIECE(LA7VAL,"^")?1(1.N,.N1"."1.N)
SET LA7OBX(2)="NM"
+45 ;
+46 ; Observation identifer
+47 ; build alternate code based on dataname from file #63 in case it's needed
+48 SET LA7X=$PIECE(LA7VAL,"^",3)
+49 SET LA7ALT="CH"_LRSB_"^"_$$GET1^DID(63.04,LRSB,"","LABEL")_"^99VA63"
+50 IF $PIECE(LA7X,"!",7)
SET LA760=$PIECE(LA7X,"!",7)
+51 IF '$TEST
SET LA760=+$ORDER(^LAB(60,"C","CH;"_LRSB_";1",0))
+52 IF LA760
SET $PIECE(LA7ALT,"^",4,6)=LA760_"^"_$PIECE(^LAB(60,LA760,0),"^")_"^99VA60"
+53 SET LA7OBX(3)=$$OBX3^LA7VOBX($PIECE(LA7X,"!",2),$PIECE(LA7X,"!",3),LA7ALT,LA7FS,LA7ECH,$GET(LA7INTYP))
+54 ;
+55 ; Build sub-id to aid in linking updates to previous transmissions.
+56 SET LA7OBX(4)=$$OBX4^LA7VOBX("CH"_LRSB,LA7FS,LA7ECH)
+57 ;
+58 ; Test value
+59 ; If DoD and "canc" then report "PL Cancelled" per Lab Interop ICD.
+60 SET LA7X=$PIECE(LA7VAL,"^")
KILL LA7DDERR
+61 IF LA7X'="canc"
IF $$GET1^DID(63.04,LRSB,"","TYPE","","LA7DDERR")="SET"
Begin DoDot:1
+62 SET LA7X=$$EXTERNAL^DILFD(63.04,LRSB,"",LA7X)
+63 IF LA7X=""
SET LA7X=$PIECE(LA7VAL,"^")
End DoDot:1
+64 IF $GET(LA7NVAF)=1
IF LA7X="canc"
SET LA7X="PL Cancelled"
+65 SET LA7OBX(5)=$$OBX5^LA7VOBX(LA7X,LA7OBX(2),LA7FS,LA7ECH)
+66 ; Log exception when data dictionary appears corrupt.
+67 IF $DATA(LA7DDERR)
DO CREATE^LA7LOG(121)
KILL LA7DDERR
+68 ;
+69 ; Suppress "pending" results when sending to HDR
+70 IF LA7INTYP=30
IF $PIECE(LA7VAL,"^")="pending"
SET LA7OBX(2)=""
SET LA7OBX(5)=""
+71 ;
+72 ; Units
+73 SET LA7X=$PIECE(LA7VAL,"^",5)
+74 SET LA7OBX(6)=$$OBX6^LA7VOBX($PIECE(LA7X,"!",7),"",LA7FS,LA7ECH,$GET(LA7INTYP))
+75 ;
+76 ; Reference range - use therapeutic low/high if present.
+77 KILL LA7Y
+78 IF $PIECE(LA7X,"!",11)=""
IF $PIECE(LA7X,"!",12)=""
Begin DoDot:1
+79 SET LA7Y("LOW")=$PIECE(LA7X,"!",2)
+80 SET LA7Y("HIGH")=$PIECE(LA7X,"!",3)
End DoDot:1
+81 IF '$TEST
Begin DoDot:1
+82 SET LA7Y("LOW")=$PIECE(LA7X,"!",11)
+83 SET LA7Y("HIGH")=$PIECE(LA7X,"!",12)
End DoDot:1
+84 ;
+85 SET LA7OBX(7)=$$OBX7^LA7VOBX(LA7Y("LOW"),LA7Y("HIGH"),LA7FS,LA7ECH)
+86 KILL LA7Y
+87 ;
+88 ; Abnormal flags
+89 SET LA7OBX(8)=$$OBX8^LA7VOBX($PIECE(LA7VAL,"^",2))
+90 ;
+91 ; "P"artial or "F"inal results
+92 SET LA7X=$SELECT("canccommentpending"[$PIECE(LA7VAL,"^"):$PIECE(LA7VAL,"^"),1:"F")
+93 IF LA7RS="C"
Begin DoDot:1
+94 SET LA7X=LA7RS
+95 IF LA7INTYP=30
IF $PIECE(LA7VAL,"^")="pending"
SET LA7X="W"
SET LA7OBX(5)=""""""
End DoDot:1
+96 SET LA7OBX(11)=$$OBX11^LA7VOBX(LA7X)
+97 IF LA7INTYP=30
IF $PIECE(LA7VAL,"^")="canc"
IF LA7OBX(11)="X"
SET LA7OBX(2)=""
SET LA7OBX(5)=""
+98 ;
+99 ; Observation date/time - collection date/time per HL7 standard
+100 SET LA7X=$PIECE(LA76304(0),"^")
IF $PIECE(LA76304(0),"^",2)
SET LA7X=$PIECE(LA7X,".")
+101 IF LA7X
SET LA7OBX(14)=$$OBX14^LA7VOBX(LA7X)
+102 ;
+103 SET LA7DIV=$PIECE(LA7VAL,"^",9)
+104 IF LA7DIV=""
SET LA7DIV=$PIECE($GET(^LR(LRDFN,LRSS,LRIDT,"RF")),"^")
+105 IF LA7DIV=""
IF $$DIV4^XUSER(.LA7DIV,$PIECE(LA7VAL,"^",4))
SET LA7DIV=$ORDER(LA7DIV(0))
+106 ;
+107 ; Facility that performed the testing
+108 SET LA7OBX(15)=$$OBX15^LA7VOBX(LA7DIV,LA7FS,LA7ECH)
+109 ;
+110 ; Person that verified the test
+111 SET LA7OBX(16)=$$OBX16^LA7VOBX($PIECE(LA7VAL,"^",4),LA7DIV,LA7FS,LA7ECH)
+112 ;
+113 ; Observation method - workkload suffix (LA7X) and result NLT code (LA7Y)
+114 SET LA7X=$PIECE($PIECE(LA7VAL,"^",3),"!",4)
SET LA7Y=$PIECE($PIECE(LA7VAL,"^",3),"!",2)
+115 IF LA7X'=""!(LA7Y="")
SET LA7OBX(17)=$$OBX17^LA7VOBX(LA7X,LA7Y,LA7FS,LA7ECH)
+116 ;
+117 ; Equipment entity identifier
+118 IF $PIECE(LA7VAL,"^",11)'=""
SET LA7OBX(18)=$$OBX18^LA7VOBX($PIECE(LA7VAL,"^",11),LA7FS,LA7ECH)
+119 ;
+120 ; Date/time of the analysis
+121 IF $PIECE(LA7VAL,"^",6)'=""
SET LA7OBX(19)=$$OBX19^LA7VOBX($PIECE(LA7VAL,"^",6))
+122 ;
+123 ; Performing organization name/address
+124 IF LA7DIV'=""
Begin DoDot:1
+125 NEW LA7DT
+126 SET LA7OBX(23)=$$OBX23^LA7VOBX(4,LA7DIV,LA7FS,LA7ECH)
+127 SET LA7DT=$SELECT($PIECE(LA7VAL,"^",6):$PIECE(LA7VAL,"^",6),$PIECE(LA76304(0),"^",3):$PIECE(LA76304(0),"^",3),1:$$NOW^XLFDT)
+128 SET LA7OBX(24)=$$OBX24^LA7VOBX(4,LA7DIV,LA7DT,LA7FS,LA7ECH)
End DoDot:1
+129 ;
+130 DO BUILDSEG^LA7VHLU(.LA7OBX,.LA7ARRAY,LA7FS)
+131 ;
+132 QUIT
+133 ;
+134 ;
CHECK ; Check for missing units/reference ranges
+1 ;
+2 NEW LA7I,LA7X,LA7FLAG
+3 SET LA7X=$PIECE(LA7VAL,"^",5)
+4 ;
+5 ; If flag (NPC>1) indicates units/ranges are stored but pieces 5-9 are null then use values from file #60
+6 ; - some class III software still does not store this info in file #63 when NPC>1
+7 SET LA7FLAG=0
+8 IF $GET(^LR(LRDFN,LRSS,LRIDT,"NPC"))>1
Begin DoDot:1
+9 FOR LA7I=5:1:9
IF $PIECE(LA7VAL,"^",LA7I)'=""
SET LA7FLAG=1
QUIT
End DoDot:1
+10 IF 'LA7FLAG
DO BUNR
+11 ;
+12 ; Evaluate low/high reference ranges in case M code in these fields.
+13 IF $GET(SEX)=""
SET SEX="M"
IF $GET(AGE)=""
SET AGE=99
+14 FOR LA7I=2,3,11,12
IF $EXTRACT($PIECE(LA7X,"!",LA7I),1,3)="$S("
Begin DoDot:1
+15 SET @("X="_$PIECE(LA7X,"!",LA7I))
+16 SET $PIECE(LA7X,"!",LA7I)=X
End DoDot:1
+17 ;
+18 ; Put units/reference ranges back in variable LA7VAL
+19 SET $PIECE(LA7VAL,"^",5)=LA7X
+20 ;
+21 QUIT
+22 ;
+23 ;
BUNR ; Build units/normal ranges from file #60
+1 ;
+2 NEW LA7Y
+3 SET LA7Y=$$REFUNIT^LA7VHLU1(LRSB,$PIECE(LA76304(0),"^",5))
+4 ;
+5 ; Results missing units, use value from file #60
+6 IF $PIECE(LA7X,"!",7)=""
SET $PIECE(LA7X,"!",7)=$PIECE(LA7Y,"^",3)
+7 ;
+8 ; If results missing reference ranges, use values from file #60.
+9 IF $PIECE(LA7X,"!",2)=""
IF $PIECE(LA7X,"!",3)=""
IF $PIECE(LA7X,"!",11)=""
IF $PIECE(LA7X,"!",12)=""
Begin DoDot:1
+10 IF $PIECE(LA7X,"!",2)=""
IF $PIECE(LA7X,"!",3)=""
Begin DoDot:2
+11 SET $PIECE(LA7X,"!",2)=$PIECE(LA7Y,"^")
+12 SET $PIECE(LA7X,"!",3)=$PIECE(LA7Y,"^",2)
End DoDot:2
+13 IF $PIECE(LA7X,"!",11)=""
IF $PIECE(LA7X,"!",12)=""
Begin DoDot:2
+14 SET $PIECE(LA7X,"!",11)=$PIECE(LA7Y,"^",6)
+15 SET $PIECE(LA7X,"!",12)=$PIECE(LA7Y,"^",7)
End DoDot:2
End DoDot:1
+16 QUIT
