LA7COBX1.m

LA7COBX1 ;VA/DALOI/JMC - LAB OBX Segment message builder (CH subscript) cont'd ; 22-Oct-2013 09:22 ; MAW

 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,61,63,1018,64,71,1027,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,LA7VAL

 ;

 ; "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^LA7CHLU5(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)="SN"

 E  S LA7OBX(2)=$$OBX2^LA7COBX(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")_"^L"

 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),"^")_"^L"

 S LA7OBX(3)=$$OBX3^LA7COBX($P(LA7X,"!",2),$P(LA7X,"!",3),LA7ALT,LA7FS,LA7ECH,$G(LA7INTYP))

 S $P(LA7OBX(3),$E(LA7ECH),7)=2.40  ;MU2

 S $P(LA7OBX(3),$E(LA7ECH),8)=5.2  ;MU2

 I $G(LA7INPT) S $P(LA7OBX(3),$E(LA7ECH),9)=$P(LA7OBX(3),$E(LA7ECH),2)  ;mu2 inpatient

 I $G(LA7INPT) S LA7STOR($P($P(LA7OBX(3),$E(LA7ECH)),"-"))=$G(LA7OBX(3))

 ;

 ; Build sub-id to aid in linking updates to previous transmissions.

 S LA7OBX(4)=$$OBX4^LA7COBX("CH"_LRSB,LA7FS,LA7ECH)

 I $G(LA7INPT) S $P(LA7STOR($P($P(LA7OBX(3),$E(LA7ECH)),"-")),"*",2)=$G(LA7OBX(4))

 ;

 ; 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

 . N LA71,LA72,LA73,LA74,LA75,LA76,LA77,LA78,LA79,LA7XUP

 . S LA73="SCT"

 . S LA74=LA7X

 . S LA7X=$$EXTERNAL^DILFD(63.04,LRSB,"",LA7X)

 . S LA71=$P($$LOOKDSC^LA7CQRY1("","SCT",$$UPPER^HLFNC(LA7X),$E(LA7ECH)),$E(LA7ECH))  ;get snomed code here

 . S LA72=LA7X

 . S LA75=LA7X

 . S LA76="L"

 . S LA77="07/31/2012"

 . S LA78="5.2"

 . S LA79=LA7X

 . S $P(LA7X,$E(LA7ECH))=LA71

 . S $P(LA7X,$E(LA7ECH),2)=LA72

 . S $P(LA7X,$E(LA7ECH),3)=LA73

 . S $P(LA7X,$E(LA7ECH),4)=LA74

 . S $P(LA7X,$E(LA7ECH),5)=LA75

 . S $P(LA7X,$E(LA7ECH),6)=LA76

 . S $P(LA7X,$E(LA7ECH),7)=LA77

 . S $P(LA7X,$E(LA7ECH),8)=LA78

 . S $P(LA7X,$E(LA7ECH),9)=LA79

 . I LA7X="" S LA7X=$P(LA7VAL,"^")

 I $G(LA7NVAF)=1,LA7X="canc" S LA7X="PL Cancelled"

 S LA7OBX(5)=$$OBX5^LA7COBX(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)

 I $P(LA7X,"!",7)]"" S LA7OBX(6)=$$OBX6^LA7COBX($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^LA7COBX(LA7Y("LOW"),LA7Y("HIGH"),LA7FS,LA7ECH)

 K LA7Y

 ;

 ; Abnormal flags

 N ABTXT

 S ABTXT=""

 ;S LA7OBX(8)=$$OBX8^LA7COBX($P(LA7VAL,"^",2))

 N LA7AB

 S LA7AB=$G(^LAB(60,LA760,1,LRSPEC,"IHS"))

 I LA7AB]"" S $P(LA7VAL,"^",2)="A"

 I $P(LA7VAL,"^",2)="" S $P(LA7VAL,"^",2)="N"

 S LA7OBX(8)=$$LOOKTAB^LA7CQRY1("HL7","0078",$E($P(LA7VAL,"^",2)),$E(LA7ECH))

 ;I $E(LA7OBX(8))="H" S ABTXT="Above High Normal"  

 ;I $E(LA7OBX(8))="L" S ABTXT="Below Low Normal"

 I $G(LA7INPT) S LA7OBX(8)=$E(LA7OBX(8))

 I '$G(LA7INPT) D

 .S $P(LA7OBX(8),$E(LA7ECH),4)=$P(LA7OBX(8),$E(LA7ECH))

 .S $P(LA7OBX(8),$E(LA7ECH),5)=$P(LA7OBX(8),$E(LA7ECH),2)

 .S $P(LA7OBX(8),$E(LA7ECH),6)="L"

 .S $P(LA7OBX(8),$E(LA7ECH),7)="2.7"

 .S $P(LA7OBX(8),$E(LA7ECH),8)="1.0"

 ;

 ; "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^LA7COBX(LA7X)

 I LA7INTYP=30,$P(LA7VAL,"^")="canc",LA7OBX(11)="X" S LA7OBX(2)="",LA7OBX(5)=""

 I $G(LA7INPT),$G(LA7OBX(11))="" S LA7OBX(11)="F"  ;mu2 inpatient

 ;

 ; 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^LA7COBX(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^LA7COBX(LA7DIV,LA7FS,LA7ECH)

 ;

 ; Person that verified the test

 S LA7OBX(16)=$$OBX16^LA7COBX($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^LA7COBX(LA7X,LA7Y,LA7FS,LA7ECH)

 I $G(LA7Y)]"" D

 . N WKI

 . S WKI=$O(^LAM("E",LA7Y,0))

 . Q:'WKI

 . S OBSI=$P($G(^LAM(WKI,0)),U,6)

 . Q:'OBSI

 . S OBSE=$$LOOKTAB^LA7CQRY1("","OBSMETHOD",+OBSI,$E(LA7ECH))

 . I $G(OBSE)]"" D

 .. S LA7OBX(17)=OBSI_$E(LA7ECH)_$P(OBSE,$E(LA7ECH),2)_$E(LA7ECH)_"OBSMETHOD"_$E(LA7ECH)_+OBSI_$E(LA7ECH)_$P(OBSE,$E(LA7ECH),2)_$E(LA7ECH)_"L"_$E(LA7ECH)_"20090501"_$E(LA7ECH)_LA7VER

 ; Equipment entity identifier

 I $P(LA7VAL,"^",11)'="" S LA7OBX(18)=$$OBX18^LA7COBX($P(LA7VAL,"^",11),LA7FS,LA7ECH)

 ;

 ; Date/time of the analysis

 I $P(LA7VAL,"^",6)'="" S LA7OBX(19)=$$OBX19^LA7COBX($P(LA7VAL,"^",6))

 I $G(LA7OBX(19))="" S LA7OBX(19)=$G(LA7OBX(14))

 ;

 ; Performing organization name/address

 I LA7DIV="" S LA7DIV=DUZ(2)  ;MU2

 I LA7DIV'="" D

 . N LA7DT

 . S LA7OBX(23)=$$OBX23^LA7COBX(4,LA7DIV,LA7FS,LA7ECH)

 . S $P(LA7OBX(23),$E(LA7ECH,1),6)="CLIA"_$E(LA7ECH,4)_"2.16.840.1.113883.4.7"_$E(LA7ECH,4)_"ISO"

 . S $P(LA7OBX(23),$E(LA7ECH,1),7)="XX"

 . S $P(LA7OBX(23),$E(LA7ECH,1),10)=$P($G(^DIC(4,LA7DIV,99)),U)

 . S LA7DT=$S($P(LA7VAL,"^",6):$P(LA7VAL,"^",6),$P(LA76304(0),"^",3):$P(LA76304(0),"^",3),1:$$NOW^XLFDT)

 . S LA7OBX(24)=$$OBX24^LA7COBX(4,LA7DIV,LA7DT,LA7FS,LA7ECH)

 . S $P(LA7OBX(24),$E(LA7ECH),6)="USA"

 . S $P(LA7OBX(24),$E(LA7ECH),7)="L"

 . S $P(LA7OBX(24),$E(LA7ECH),9)=$P(LA7OBX(24),$E(LA7ECH),5)  ;MU2 county code same as zip for now

 ;

 S LA7OBX(25)=$$OBX25^LA7COBX($$GET1^DIQ(9009029,DUZ(2),3027,"I"),DUZ(2),LA7FS,LA7ECH)

 S $P(LA7OBX(25),$E(LA7ECH),9)="NPI"_$E(LA7ECH,4)_"2.16.840.1.113883.4.6"_$E(LA7ECH,4)_"ISO"

 S $P(LA7OBX(25),$E(LA7ECH),10)="L"

 S $P(LA7OBX(25),$E(LA7ECH),13)="NPI"

 S $P(LA7OBX(25),$E(LA7ECH),14)="NPI_Facility"_$E(LA7ECH,4)_"2.16.840.1.113883.3.72.5.26"_$E(LA7ECH,4)_"ISO"

 S $P(LA7OBX(25),$E(LA7ECH),21)=$P(LA7OBX(25),$E(LA7ECH),6)

 I $G(LA7INPT) S $P(LA7OBX(25),$E(LA7ECH),7)=""  ;mu2 inpatient

 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

LA7COBX1  ;VA/DALOI/JMC - LAB OBX Segment message builder (CH subscript) cont'd ; 22-Oct-2013 09:22 ; MAW

 +1       ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,61,63,1018,64,71,1027,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,LA7VAL

 +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^LA7CHLU5(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)="SN"

 +43      IF '$TEST

               SET LA7OBX(2)=$$OBX2^LA7COBX(63.04,LRSB)

 +44      ;I LA7OBX(2)'="NM",$P(LA7VAL,"^")?1(1.N,.N1"."1.N) S 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")_"^L"

 +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),"^")_"^L"

 +53       SET LA7OBX(3)=$$OBX3^LA7COBX($PIECE(LA7X,"!",2),$PIECE(LA7X,"!",3),LA7ALT,LA7FS,LA7ECH,$GET(LA7INTYP))

 +54      ;MU2

           SET $PIECE(LA7OBX(3),$EXTRACT(LA7ECH),7)=2.40

 +55      ;MU2

           SET $PIECE(LA7OBX(3),$EXTRACT(LA7ECH),8)=5.2

 +56      ;mu2 inpatient

           IF $GET(LA7INPT)

               SET $PIECE(LA7OBX(3),$EXTRACT(LA7ECH),9)=$PIECE(LA7OBX(3),$EXTRACT(LA7ECH),2)

 +57       IF $GET(LA7INPT)

               SET LA7STOR($PIECE($PIECE(LA7OBX(3),$EXTRACT(LA7ECH)),"-"))=$GET(LA7OBX(3))

 +58      ;

 +59      ; Build sub-id to aid in linking updates to previous transmissions.

 +60       SET LA7OBX(4)=$$OBX4^LA7COBX("CH"_LRSB,LA7FS,LA7ECH)

 +61       IF $GET(LA7INPT)

               SET $PIECE(LA7STOR($PIECE($PIECE(LA7OBX(3),$EXTRACT(LA7ECH)),"-")),"*",2)=$GET(LA7OBX(4))

 +62      ;

 +63      ; Test value

 +64      ; If DoD and "canc" then report "PL Cancelled" per Lab Interop ICD.

 +65       SET LA7X=$PIECE(LA7VAL,"^")

           KILL LA7DDERR

 +66       IF LA7X'="canc"

               IF $$GET1^DID(63.04,LRSB,"","TYPE","","LA7DDERR")="SET"

                   Begin DoDot:1

 +67                   NEW LA71,LA72,LA73,LA74,LA75,LA76,LA77,LA78,LA79,LA7XUP

 +68                   SET LA73="SCT"

 +69                   SET LA74=LA7X

 +70                   SET LA7X=$$EXTERNAL^DILFD(63.04,LRSB,"",LA7X)

 +71      ;get snomed code here

                       SET LA71=$PIECE($$LOOKDSC^LA7CQRY1("","SCT",$$UPPER^HLFNC(LA7X),$EXTRACT(LA7ECH)),$EXTRACT(LA7ECH))

 +72                   SET LA72=LA7X

 +73                   SET LA75=LA7X

 +74                   SET LA76="L"

 +75                   SET LA77="07/31/2012"

 +76                   SET LA78="5.2"

 +77                   SET LA79=LA7X

 +78                   SET $PIECE(LA7X,$EXTRACT(LA7ECH))=LA71

 +79                   SET $PIECE(LA7X,$EXTRACT(LA7ECH),2)=LA72

 +80                   SET $PIECE(LA7X,$EXTRACT(LA7ECH),3)=LA73

 +81                   SET $PIECE(LA7X,$EXTRACT(LA7ECH),4)=LA74

 +82                   SET $PIECE(LA7X,$EXTRACT(LA7ECH),5)=LA75

 +83                   SET $PIECE(LA7X,$EXTRACT(LA7ECH),6)=LA76

 +84                   SET $PIECE(LA7X,$EXTRACT(LA7ECH),7)=LA77

 +85                   SET $PIECE(LA7X,$EXTRACT(LA7ECH),8)=LA78

 +86                   SET $PIECE(LA7X,$EXTRACT(LA7ECH),9)=LA79

 +87                   IF LA7X=""

                           SET LA7X=$PIECE(LA7VAL,"^")

                   End DoDot:1

 +88       IF $GET(LA7NVAF)=1

               IF LA7X="canc"

                   SET LA7X="PL Cancelled"

 +89       SET LA7OBX(5)=$$OBX5^LA7COBX(LA7X,LA7OBX(2),LA7FS,LA7ECH)

 +90      ; Log exception when data dictionary appears corrupt.

 +91       IF $DATA(LA7DDERR)

               DO CREATE^LA7LOG(121)

               KILL LA7DDERR

 +92      ;

 +93      ; Suppress "pending" results when sending to HDR

 +94       IF LA7INTYP=30

               IF $PIECE(LA7VAL,"^")="pending"

                   SET LA7OBX(2)=""

                   SET LA7OBX(5)=""

 +95      ;

 +96      ; Units

 +97       SET LA7X=$PIECE(LA7VAL,"^",5)

 +98       IF $PIECE(LA7X,"!",7)]""

               SET LA7OBX(6)=$$OBX6^LA7COBX($PIECE(LA7X,"!",7),"",LA7FS,LA7ECH,$GET(LA7INTYP))

 +99      ;

 +100     ; Reference range - use therapeutic low/high if present.

 +101      KILL LA7Y

 +102      IF $PIECE(LA7X,"!",11)=""

               IF $PIECE(LA7X,"!",12)=""

                   Begin DoDot:1

 +103                  SET LA7Y("LOW")=$PIECE(LA7X,"!",2)

 +104                  SET LA7Y("HIGH")=$PIECE(LA7X,"!",3)

                   End DoDot:1

 +105     IF '$TEST

               Begin DoDot:1

 +106              SET LA7Y("LOW")=$PIECE(LA7X,"!",11)

 +107              SET LA7Y("HIGH")=$PIECE(LA7X,"!",12)

               End DoDot:1

 +108     ;

 +109      SET LA7OBX(7)=$$OBX7^LA7COBX(LA7Y("LOW"),LA7Y("HIGH"),LA7FS,LA7ECH)

 +110      KILL LA7Y

 +111     ;

 +112     ; Abnormal flags

 +113      NEW ABTXT

 +114      SET ABTXT=""

 +115     ;S LA7OBX(8)=$$OBX8^LA7COBX($P(LA7VAL,"^",2))

 +116      NEW LA7AB

 +117      SET LA7AB=$GET(^LAB(60,LA760,1,LRSPEC,"IHS"))

 +118      IF LA7AB]""

               SET $PIECE(LA7VAL,"^",2)="A"

 +119      IF $PIECE(LA7VAL,"^",2)=""

               SET $PIECE(LA7VAL,"^",2)="N"

 +120      SET LA7OBX(8)=$$LOOKTAB^LA7CQRY1("HL7","0078",$EXTRACT($PIECE(LA7VAL,"^",2)),$EXTRACT(LA7ECH))

 +121     ;I $E(LA7OBX(8))="H" S ABTXT="Above High Normal"  

 +122     ;I $E(LA7OBX(8))="L" S ABTXT="Below Low Normal"

 +123      IF $GET(LA7INPT)

               SET LA7OBX(8)=$EXTRACT(LA7OBX(8))

 +124      IF '$GET(LA7INPT)

               Begin DoDot:1

 +125              SET $PIECE(LA7OBX(8),$EXTRACT(LA7ECH),4)=$PIECE(LA7OBX(8),$EXTRACT(LA7ECH))

 +126              SET $PIECE(LA7OBX(8),$EXTRACT(LA7ECH),5)=$PIECE(LA7OBX(8),$EXTRACT(LA7ECH),2)

 +127              SET $PIECE(LA7OBX(8),$EXTRACT(LA7ECH),6)="L"

 +128              SET $PIECE(LA7OBX(8),$EXTRACT(LA7ECH),7)="2.7"

 +129              SET $PIECE(LA7OBX(8),$EXTRACT(LA7ECH),8)="1.0"

               End DoDot:1

 +130     ;

 +131     ; "P"artial or "F"inal results

 +132      SET LA7X=$SELECT("canccommentpending"[$PIECE(LA7VAL,"^"):$PIECE(LA7VAL,"^"),1:"F")

 +133      IF LA7RS="C"

               Begin DoDot:1

 +134              SET LA7X=LA7RS

 +135              IF LA7INTYP=30

                       IF $PIECE(LA7VAL,"^")="pending"

                           SET LA7X="W"

                           SET LA7OBX(5)=""""""

               End DoDot:1

 +136      SET LA7OBX(11)=$$OBX11^LA7COBX(LA7X)

 +137      IF LA7INTYP=30

               IF $PIECE(LA7VAL,"^")="canc"

                   IF LA7OBX(11)="X"

                       SET LA7OBX(2)=""

                       SET LA7OBX(5)=""

 +138     ;mu2 inpatient

           IF $GET(LA7INPT)

               IF $GET(LA7OBX(11))=""

                   SET LA7OBX(11)="F"

 +139     ;

 +140     ; Observation date/time - collection date/time per HL7 standard

 +141      SET LA7X=$PIECE(LA76304(0),"^")

           IF $PIECE(LA76304(0),"^",2)

               SET LA7X=$PIECE(LA7X,".")

 +142      IF LA7X

               SET LA7OBX(14)=$$OBX14^LA7COBX(LA7X)

 +143     ;

 +144      SET LA7DIV=$PIECE(LA7VAL,"^",9)

 +145      IF LA7DIV=""

               SET LA7DIV=$PIECE($GET(^LR(LRDFN,LRSS,LRIDT,"RF")),"^")

 +146      IF LA7DIV=""

               IF $$DIV4^XUSER(.LA7DIV,$PIECE(LA7VAL,"^",4))

                   SET LA7DIV=$ORDER(LA7DIV(0))

 +147     ;

 +148     ; Facility that performed the testing

 +149      SET LA7OBX(15)=$$OBX15^LA7COBX(LA7DIV,LA7FS,LA7ECH)

 +150     ;

 +151     ; Person that verified the test

 +152      SET LA7OBX(16)=$$OBX16^LA7COBX($PIECE(LA7VAL,"^",4),LA7DIV,LA7FS,LA7ECH)

 +153     ;

 +154     ; Observation method - workkload suffix (LA7X) and result NLT code (LA7Y)

 +155      SET LA7X=$PIECE($PIECE(LA7VAL,"^",3),"!",4)

           SET LA7Y=$PIECE($PIECE(LA7VAL,"^",3),"!",2)

 +156      IF LA7X'=""!(LA7Y="")

               SET LA7OBX(17)=$$OBX17^LA7COBX(LA7X,LA7Y,LA7FS,LA7ECH)

 +157      IF $GET(LA7Y)]""

               Begin DoDot:1

 +158              NEW WKI

 +159              SET WKI=$ORDER(^LAM("E",LA7Y,0))

 +160              IF 'WKI

                       QUIT 

 +161              SET OBSI=$PIECE($GET(^LAM(WKI,0)),U,6)

 +162              IF 'OBSI

                       QUIT 

 +163              SET OBSE=$$LOOKTAB^LA7CQRY1("","OBSMETHOD",+OBSI,$EXTRACT(LA7ECH))

 +164              IF $GET(OBSE)]""

                       Begin DoDot:2

 +165                      SET LA7OBX(17)=OBSI_$EXTRACT(LA7ECH)_$PIECE(OBSE,$EXTRACT(LA7ECH),2)_$EXTRACT(LA7ECH)_"OBSMETHOD"_$EXTRACT(LA7ECH)_+OBSI_$EXTRACT(LA7ECH)_$PIECE(OBSE,$EXTRACT(LA7ECH),2)_$EXTRACT(LA7ECH)_"L"_$EXTRACT(LA7ECH)_"20090501"_$EXTRACT(

LA7ECH)_LA7VER

                       End DoDot:2

               End DoDot:1

 +166     ; Equipment entity identifier

 +167      IF $PIECE(LA7VAL,"^",11)'=""

               SET LA7OBX(18)=$$OBX18^LA7COBX($PIECE(LA7VAL,"^",11),LA7FS,LA7ECH)

 +168     ;

 +169     ; Date/time of the analysis

 +170      IF $PIECE(LA7VAL,"^",6)'=""

               SET LA7OBX(19)=$$OBX19^LA7COBX($PIECE(LA7VAL,"^",6))

 +171      IF $GET(LA7OBX(19))=""

               SET LA7OBX(19)=$GET(LA7OBX(14))

 +172     ;

 +173     ; Performing organization name/address

 +174     ;MU2

           IF LA7DIV=""

               SET LA7DIV=DUZ(2)

 +175      IF LA7DIV'=""

               Begin DoDot:1

 +176              NEW LA7DT

 +177              SET LA7OBX(23)=$$OBX23^LA7COBX(4,LA7DIV,LA7FS,LA7ECH)

 +178              SET $PIECE(LA7OBX(23),$EXTRACT(LA7ECH,1),6)="CLIA"_$EXTRACT(LA7ECH,4)_"2.16.840.1.113883.4.7"_$EXTRACT(LA7ECH,4)_"ISO"

 +179              SET $PIECE(LA7OBX(23),$EXTRACT(LA7ECH,1),7)="XX"

 +180              SET $PIECE(LA7OBX(23),$EXTRACT(LA7ECH,1),10)=$PIECE($GET(^DIC(4,LA7DIV,99)),U)

 +181              SET LA7DT=$SELECT($PIECE(LA7VAL,"^",6):$PIECE(LA7VAL,"^",6),$PIECE(LA76304(0),"^",3):$PIECE(LA76304(0),"^",3),1:$$NOW^XLFDT)

 +182              SET LA7OBX(24)=$$OBX24^LA7COBX(4,LA7DIV,LA7DT,LA7FS,LA7ECH)

 +183              SET $PIECE(LA7OBX(24),$EXTRACT(LA7ECH),6)="USA"

 +184              SET $PIECE(LA7OBX(24),$EXTRACT(LA7ECH),7)="L"

 +185     ;MU2 county code same as zip for now

                   SET $PIECE(LA7OBX(24),$EXTRACT(LA7ECH),9)=$PIECE(LA7OBX(24),$EXTRACT(LA7ECH),5)

               End DoDot:1

 +186     ;

 +187      SET LA7OBX(25)=$$OBX25^LA7COBX($$GET1^DIQ(9009029,DUZ(2),3027,"I"),DUZ(2),LA7FS,LA7ECH)

 +188      SET $PIECE(LA7OBX(25),$EXTRACT(LA7ECH),9)="NPI"_$EXTRACT(LA7ECH,4)_"2.16.840.1.113883.4.6"_$EXTRACT(LA7ECH,4)_"ISO"

 +189      SET $PIECE(LA7OBX(25),$EXTRACT(LA7ECH),10)="L"

 +190      SET $PIECE(LA7OBX(25),$EXTRACT(LA7ECH),13)="NPI"

 +191      SET $PIECE(LA7OBX(25),$EXTRACT(LA7ECH),14)="NPI_Facility"_$EXTRACT(LA7ECH,4)_"2.16.840.1.113883.3.72.5.26"_$EXTRACT(LA7ECH,4)_"ISO"

 +192      SET $PIECE(LA7OBX(25),$EXTRACT(LA7ECH),21)=$PIECE(LA7OBX(25),$EXTRACT(LA7ECH),6)

 +193     ;mu2 inpatient

           IF $GET(LA7INPT)

               SET $PIECE(LA7OBX(25),$EXTRACT(LA7ECH),7)=""

 +194      DO BUILDSEG^LA7VHLU(.LA7OBX,.LA7ARRAY,LA7FS)

 +195     ;

 +196      QUIT 

 +197     ;

 +198     ;

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      ;