LA7VHLU5 ;DALOI/JMC - HL7 segment builder utility ;10/09/09 10:25
;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,68,74,92**;Sep 27, 1994;Build 6
;
;
;5.2;AUTOMATED LAB INSTRUMENTS; CHANGE FOR PATCH LA*5.2*92; Feb 10 2016;
;
;
DEFCODE(LRSS,LRSB,LA7CODE,LA761) ; Determine default codes when data is not mapped
;
; Call with LRSS = file #63 subscript
; LRSB = file #63 dataname/location
; LA7CODE = current codes stored with data (order nlt!result nlt!loinc code!method suffix)
; LA761 = specimen, pointer to file #61
;
N I,LA760,LA7DFCDE,LA7MISS,LA7NLT,LA7X,LA7Y
;
I LA7CODE="" S LA7CODE="!!!"
;
; Replace any missing codes with defaults
; If no missing codes then return codes passed in.
S LA7MISS=""
F I=1:1:3 I $P(LA7CODE,"!",I)="" S $P(LA7MISS,"^",I)=I
;
I LA7MISS'="" D
. I LRSS="CH" D CHSUB Q
. I LRSS="MI" D MISUB Q
. I LRSS="SP" D SPSUB Q
. I LRSS="CY" D CYSUB Q
. I LRSS="EM" D EMSUB Q
;
Q LA7CODE
;
;
CHSUB ; Determine codes for CH subscript.
;
; Find a file #60 test which uses this dataname. Since there can be
; multiple tests check each until an order and result NLT code is found.
S LA760=0
F S LA760=$O(^LAB(60,"C",LRSS_";"_LRSB_";1",LA760)) Q:'LA760 D
. ; Default order NLT
. I $P(LA7MISS,"^") D
. . S LA7X=$$NLT^LRVER1(LA760)
. . I LA7X'="" S $P(LA7CODE,"!")=LA7X,$P(LA7MISS,"^")=""
. ; Default result NLT
. I $P(LA7MISS,"^",2) D
. . S LA7X=+$P($G(^LAB(60,LA760,64)),"^",2),LA7Y=""
. . I LA7X S LA7Y=$$GET1^DIQ(64,LA7X_",",1)
. . I LA7Y'="" S $P(LA7CODE,"!",2)=LA7Y,$P(LA7MISS,"^",2)=""
;
; If no result NLT code then use order NLT as default
I $P(LA7CODE,"!",2)="" S $P(LA7CODE,"!",2)=$P(LA7CODE,"!")
;
; If no order NLT code found on file #60 entries then use this default
I $P(LA7CODE,"!")="" S $P(LA7CODE,"!")="81323.0000"
;
; Default result LOINC code based on result NLT code
; If none on NLT result code then try order NLT code
;START OF CHANGE FOR LA*5.2*92
N LA760C1,LA7XC,LA7YC S LA760C1=0
I $P(LA7CODE,"!",2)'="" F S LA760C1=$O(^LAB(60,"C",LRSS_";"_LRSB_";1",LA760C1)) Q:'LA760C1 S LA7XC=+$P($G(^LAB(60,LA760C1,64)),"^",2) I LA7XC S LA7YC=$$GET1^DIQ(64,LA7XC_",",1) I LA7YC'=""&(LA7YC=$P(LA7CODE,"!",2)) Q
;END OF CHANGE FOR LA*5.2*92
I $P(LA7MISS,"^",3) D
. S LA7NLT=$P(LA7CODE,"!",2),LA7X=""
. ;START OF CHANGE FOR LA*5.2*92
. ;I LA7NLT'="" S LA7X=$$LNC^LRVER1(LA7NLT,$P(LA7CODE,"!",4),LA761)
. I LA7NLT'="" S LA7X=$$LNC^LRVER1(LA7NLT,$P(LA7CODE,"!",4),LA761,$G(LA760C1))
. ;END OF CHANGE FOR LA*5.2*92
. I LA7X S $P(LA7CODE,"!",3)=LA7X Q
. S LA7NLT=$P(LA7CODE,"!"),LA7X=""
. ;START OF CHANGE FOR LA*5.2*92
. ;I LA7NLT'="" S LA7X=$$LNC^LRVER1(LA7NLT,$P(LA7CODE,"!",4),LA761)
. I LA7NLT'="" S LA7X=$$LNC^LRVER1(LA7NLT,$P(LA7CODE,"!",4),LA761,$G(LA760C1))
. ;END OF CHANGE FOR LA*5.2*92
. I LA7X S $P(LA7CODE,"!",3)=LA7X
;START OF CHANGE FOR LA*5.2*92
K LA760C1,LA7XC,LA7YC
;END OF CHANGE FOR LA*5.2*92
;
Q
;
;
MISUB ; Determine codes for MI subscript
;
; Bacteriology report
I LRSB=11 S LA7DFCDE="87993.0000^93928.0000^" D DEFAULT Q
;
; Urine Screen
I LRSB=11.57 S LA7DFCDE="87993.0000^93948.0000^630" D DEFAULT Q
;
; Sputum screen
I LRSB=11.58 S LA7DFCDE="87993.0000^93949.0000^6460" D DEFAULT Q
;
; Gram stain
I LRSB=11.6 S LA7DFCDE="87993.0000^87754.0000^664" D DEFAULT Q
;
; Bacteriology organism
I LRSB=12 S LA7DFCDE="87993.0000^87570.0000^11475" D DEFAULT Q
;
; Bacteria colony count
I +LRSB=12,$P(LRSB,",",2)=1 S LA7DFCDE="^87719.0000^564" D DEFAULT Q
;
; Bacteriology smear/prep
I LRSB=11.7 S LA7DFCDE="87993.0000^93967.0000^" D DEFAULT Q
;
; Bacteriology test
I LRSB=1.5 S LA7DFCDE="87993.0000^93969.0000^" D DEFAULT Q
;
; Parasite report
I LRSB=14 S LA7DFCDE="87925.0000^93929.0000^" D DEFAULT Q
;
; Parasite organism
I LRSB=16 S LA7DFCDE="87925.0000^87576.0000^20932" D DEFAULT Q
;
; Parasite organism stage
I +LRSB=16,$P(LRSB,",",2)=.01 S LA7DFCDE="87925.0000^92930.0000^" D DEFAULT Q
;
; Parasite organism stage quantity
I +LRSB=16,$P(LRSB,",",2)=1 S LA7DFCDE="87925.0000^93997.0000^" D DEFAULT Q
;
; Parasitology smear/prep
I LRSB=15.51 S LA7DFCDE="87925.0000^93971.0000^" D DEFAULT Q
;
; Parasitology test
I LRSB=16.4 S LA7DFCDE="87925.0000^93972.0000^" D DEFAULT Q
;
; Mycology report
I LRSB=18 S LA7DFCDE="87994.0000^93930.0000^" D DEFAULT Q
;
; Mycology smear/prep
I LRSB=19.6 S LA7DFCDE="87994.0000^93984.0000^" D DEFAULT Q
;
; Mycology test
I LRSB=20.4 S LA7DFCDE="87994.0000^93974.0000^" D DEFAULT Q
;
; Fungal organism
I LRSB=20 S LA7DFCDE="87994.0000^87578.0000^580" D DEFAULT Q
;
; Fungal colony count
I +LRSB=20,$P(LRSB,",",2)=1 S LA7DFCDE="87994.0000^87723.0000^19101" D DEFAULT Q
;
; Mycobacterium report
I LRSB=22 S LA7DFCDE="87995.0000^93931.0000^" D DEFAULT Q
;
; Acid Fast stain
I LRSB=24 S LA7DFCDE="87995.0000^87756.0000^11545" D DEFAULT Q
;
; Acid Fast stain quantity
I LRSB=25 S LA7DFCDE="87995.0000^87583.0000^" D DEFAULT Q
;
; Mycobacterium organism
I +LRSB=26,'$P(LRSB,",",2) S LA7DFCDE="87995.0000^87589.0000^543" D DEFAULT Q
;
; Mycobacterium colony count
I +LRSB=26,$P(LRSB,",",2)=1 S LA7DFCDE="87995.0000^87719.0000^564" D DEFAULT Q
;
; Bact or TB organism's susceptibilities
I ($P(LRSB,",")=12!($P(LRSB,",")=26)),$P(LRSB,",",2)>2,$P(LRSB,",",2)<2.999 D Q
. S LA7X=""
. I $P(LRSB,",")=12 D
. . S LA7DFCDE="87565.0000^^"
. . S LA7X=$O(^LAB(62.06,"AD",$P(LRSB,",",2),0))
. I $P(LRSB,",")=26 D
. . S LA7DFCDE="87568.0000^^"
. . S LA7X=$O(^LAB(62.06,"AD1",$P(LRSB,",",2),0))
. I LA7X D
. . S X=$$GET1^DIQ(62.06,LA7X_",","64:1")
. . I X S $P(LA7DFCDE,"^",2)=X
. D DEFAULT
;
; TB test
I LRSB=26.4 S LA7DFCDE="87995.0000^93977.0000^" D DEFAULT Q
;
; Virology report
I LRSB=33 S LA7DFCDE="87996.0000^93932.0000^" D DEFAULT Q
;
; Viral agent
I $P(LRSB,",")=36 S LA7DFCDE="87996.0000^87590.0000^6584" D DEFAULT Q
;
; Virology test
I LRSB=36.4 S LA7DFCDE="87996.0000^93981.0000^" D DEFAULT Q
;
; Sterility results
I LRSB=11.52 S LA7DFCDE="93982.0000^93982.0000^" D DEFAULT Q
;
Q
;
;
SPSUB ; Determine codes for SP subscript
;
; specimens
I $P(LRSB,",")=.012 S LA7DFCDE="88515.0000^88539.0000^22633" D DEFAULT Q
I LRSB=10 S LA7DFCDE="88515.0000^88539.0000^22633" D DEFAULT Q
;
; brief clinical history
I LRSB=.013 S LA7DFCDE="88515.0000^88542.0000^22636" D DEFAULT Q
;
; preoperative diagnosis
I LRSB=.014 S LA7DFCDE="88515.0000^88544.0000^10219" D DEFAULT Q
;
; operative findings
I LRSB=.015 S LA7DFCDE="88515.0000^88546.0000^10215" D DEFAULT Q
;
; postoperative diagnosis
I LRSB=.016 S LA7DFCDE="88515.0000^88547.0000^10218" D DEFAULT Q
;
; gross description
I LRSB=1 S LA7DFCDE="88515.0000^88549.0000^22634" D DEFAULT Q
;
; microscopic description
I LRSB=1.1 S LA7DFCDE="88515.0000^88563.0000^22635" D DEFAULT Q
;
; frozen section
I LRSB=1.3 S LA7DFCDE="88515.0000^88569.0000^22635" D DEFAULT Q
;
; surgical path diagnosis
I LRSB=1.4 S LA7DFCDE="88515.0000^88571.0000^22637" D DEFAULT Q
;
; supplementary report
I LRSB=1.2!(LRSB="10,5") S LA7DFCDE="88589.0000^88589.0000^22639" D DEFAULT Q
;
; specimen weight
I LRSB="10,2" S LA7DFCDE="88515.0000^81233.0000^3154" D DEFAULT Q
;
Q
;
;
CYSUB ; Determine codes for CY subscript
;
; specimens
I $P(LRSB,",")=.012 S LA7DFCDE="88593.0000^88539.0000^22633" D DEFAULT Q
I LRSB=10 S LA7DFCDE="88593.0000^88539.0000^22633" D DEFAULT Q
;
; brief clinical history
I LRSB=.013 S LA7DFCDE="88593.0000^88542.0000^22636" D DEFAULT Q
;
; preoperative diagnosis
I LRSB=.014 S LA7DFCDE="88593.0000^88544.0000^10219" D DEFAULT Q
;
; operative findings
I LRSB=.015 S LA7DFCDE="88593.0000^88542.0000^10215" D DEFAULT Q
;
; postoperative diagnosis
I LRSB=.016 S LA7DFCDE="88593.0000^88547.0000^10218" D DEFAULT Q
;
; gross description
I LRSB=1!(LRSB=20) S LA7DFCDE="88593.0000^88549.0000^22634" D DEFAULT Q
;
; microscopic examination
I LRSB=1.1 S LA7DFCDE="88593.0000^88563.0000^22635" D DEFAULT Q
;
; supplementary report
I LRSB=1.2 S LA7DFCDE="88589.0000^88589.0000^22639" D DEFAULT Q
;
; cytopathology diagnosis
I LRSB=1.4 S LA7DFCDE="88593.0000^88571.0000^22637" D DEFAULT Q
;
Q
;
;
EMSUB ; Determine codes for EM subscript
;
; specimens
I $P(LRSB,",")=.012 S LA7DFCDE="88597.0000^88057.0000^22633" D DEFAULT Q
I LRSB=10 S LA7DFCDE="88597.0000^88057.0000^22633" D DEFAULT Q
;
; brief clinical history
I LRSB=.013 S LA7DFCDE="88597.0000^88542.0000^22636" D DEFAULT Q
;
; preoperative diagnosis
I LRSB=.014 S LA7DFCDE="88597.0000^88544.0000^10219" D DEFAULT Q
;
; operative findings
I LRSB=.015 S LA7DFCDE="88597.0000^88542.0000^10215" D DEFAULT Q
;
; postoperative diagnosis
I LRSB=.016 S LA7DFCDE="88597.0000^88547.0000^10218" D DEFAULT Q
;
; gross description
I LRSB=1!(LRSB=20) S LA7DFCDE="88597.0000^88549.0000^22634" D DEFAULT Q
;
; microscopic examination
I LRSB=1.1 S LA7DFCDE="88597.0000^88563.0000^22635" D DEFAULT Q
;
; supplementary report
I LRSB=1.2 S LA7DFCDE="88589.0000^88589.0000^22639" D DEFAULT Q
;
; em diagnosis
I LRSB=1.4 S LA7DFCDE="88597.0000^88571.0000^22637" D DEFAULT Q
;
Q
;
;
DEFAULT ; Resolve codes and set defaults as needed
;
; Expects LA7DFCDE=default order NLT^default result NLT^default LOINC code
;
I $P(LA7MISS,"^") S $P(LA7CODE,"!")=$P(LA7DFCDE,"^")
I $P(LA7MISS,"^",2) S $P(LA7CODE,"!",2)=$P(LA7DFCDE,"^",2)
I $P(LA7MISS,"^",3) D
. ;START OF CHANGE FOR LA*5.2*92
. ;S $P(LA7CODE,"!",3)=$$LNC^LRVER1($P(LA7CODE,"!",2),$P(LA7CODE,"!",4),LA761)
. S $P(LA7CODE,"!",3)=$$LNC^LRVER1($P(LA7CODE,"!",2),$P(LA7CODE,"!",4),LA761,0)
. ;END OF CHANGE FOR LA*5.2*92
. I '$P(LA7CODE,"!",3) S $P(LA7CODE,"!",3)=$P(LA7DFCDE,"^",3)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7VHLU5 9982 printed Jan 18, 2025@02:41:25 Page 2
LA7VHLU5 ;DALOI/JMC - HL7 segment builder utility ;10/09/09 10:25
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**46,64,68,74,92**;Sep 27, 1994;Build 6
+2 ;
+3 ;
+4 ;5.2;AUTOMATED LAB INSTRUMENTS; CHANGE FOR PATCH LA*5.2*92; Feb 10 2016;
+5 ;
+6 ;
DEFCODE(LRSS,LRSB,LA7CODE,LA761) ; Determine default codes when data is not mapped
+1 ;
+2 ; Call with LRSS = file #63 subscript
+3 ; LRSB = file #63 dataname/location
+4 ; LA7CODE = current codes stored with data (order nlt!result nlt!loinc code!method suffix)
+5 ; LA761 = specimen, pointer to file #61
+6 ;
+7 NEW I,LA760,LA7DFCDE,LA7MISS,LA7NLT,LA7X,LA7Y
+8 ;
+9 IF LA7CODE=""
SET LA7CODE="!!!"
+10 ;
+11 ; Replace any missing codes with defaults
+12 ; If no missing codes then return codes passed in.
+13 SET LA7MISS=""
+14 FOR I=1:1:3
IF $PIECE(LA7CODE,"!",I)=""
SET $PIECE(LA7MISS,"^",I)=I
+15 ;
+16 IF LA7MISS'=""
Begin DoDot:1
+17 IF LRSS="CH"
DO CHSUB
QUIT
+18 IF LRSS="MI"
DO MISUB
QUIT
+19 IF LRSS="SP"
DO SPSUB
QUIT
+20 IF LRSS="CY"
DO CYSUB
QUIT
+21 IF LRSS="EM"
DO EMSUB
QUIT
End DoDot:1
+22 ;
+23 QUIT LA7CODE
+24 ;
+25 ;
CHSUB ; Determine codes for CH subscript.
+1 ;
+2 ; Find a file #60 test which uses this dataname. Since there can be
+3 ; multiple tests check each until an order and result NLT code is found.
+4 SET LA760=0
+5 FOR
SET LA760=$ORDER(^LAB(60,"C",LRSS_";"_LRSB_";1",LA760))
if 'LA760
QUIT
Begin DoDot:1
+6 ; Default order NLT
+7 IF $PIECE(LA7MISS,"^")
Begin DoDot:2
+8 SET LA7X=$$NLT^LRVER1(LA760)
+9 IF LA7X'=""
SET $PIECE(LA7CODE,"!")=LA7X
SET $PIECE(LA7MISS,"^")=""
End DoDot:2
+10 ; Default result NLT
+11 IF $PIECE(LA7MISS,"^",2)
Begin DoDot:2
+12 SET LA7X=+$PIECE($GET(^LAB(60,LA760,64)),"^",2)
SET LA7Y=""
+13 IF LA7X
SET LA7Y=$$GET1^DIQ(64,LA7X_",",1)
+14 IF LA7Y'=""
SET $PIECE(LA7CODE,"!",2)=LA7Y
SET $PIECE(LA7MISS,"^",2)=""
End DoDot:2
End DoDot:1
+15 ;
+16 ; If no result NLT code then use order NLT as default
+17 IF $PIECE(LA7CODE,"!",2)=""
SET $PIECE(LA7CODE,"!",2)=$PIECE(LA7CODE,"!")
+18 ;
+19 ; If no order NLT code found on file #60 entries then use this default
+20 IF $PIECE(LA7CODE,"!")=""
SET $PIECE(LA7CODE,"!")="81323.0000"
+21 ;
+22 ; Default result LOINC code based on result NLT code
+23 ; If none on NLT result code then try order NLT code
+24 ;START OF CHANGE FOR LA*5.2*92
+25 NEW LA760C1,LA7XC,LA7YC
SET LA760C1=0
+26 IF $PIECE(LA7CODE,"!",2)'=""
FOR
SET LA760C1=$ORDER(^LAB(60,"C",LRSS_";"_LRSB_";1",LA760C1))
if 'LA760C1
QUIT
SET LA7XC=+$PIECE($GET(^LAB(60,LA760C1,64)),"^",2)
IF LA7XC
SET LA7YC=$$GET1^DIQ(64,LA7XC_",",1)
IF LA7YC'=""&(LA7YC=$PIECE(LA7CODE,"!",2))
QUIT
+27 ;END OF CHANGE FOR LA*5.2*92
+28 IF $PIECE(LA7MISS,"^",3)
Begin DoDot:1
+29 SET LA7NLT=$PIECE(LA7CODE,"!",2)
SET LA7X=""
+30 ;START OF CHANGE FOR LA*5.2*92
+31 ;I LA7NLT'="" S LA7X=$$LNC^LRVER1(LA7NLT,$P(LA7CODE,"!",4),LA761)
+32 IF LA7NLT'=""
SET LA7X=$$LNC^LRVER1(LA7NLT,$PIECE(LA7CODE,"!",4),LA761,$GET(LA760C1))
+33 ;END OF CHANGE FOR LA*5.2*92
+34 IF LA7X
SET $PIECE(LA7CODE,"!",3)=LA7X
QUIT
+35 SET LA7NLT=$PIECE(LA7CODE,"!")
SET LA7X=""
+36 ;START OF CHANGE FOR LA*5.2*92
+37 ;I LA7NLT'="" S LA7X=$$LNC^LRVER1(LA7NLT,$P(LA7CODE,"!",4),LA761)
+38 IF LA7NLT'=""
SET LA7X=$$LNC^LRVER1(LA7NLT,$PIECE(LA7CODE,"!",4),LA761,$GET(LA760C1))
+39 ;END OF CHANGE FOR LA*5.2*92
+40 IF LA7X
SET $PIECE(LA7CODE,"!",3)=LA7X
End DoDot:1
+41 ;START OF CHANGE FOR LA*5.2*92
+42 KILL LA760C1,LA7XC,LA7YC
+43 ;END OF CHANGE FOR LA*5.2*92
+44 ;
+45 QUIT
+46 ;
+47 ;
MISUB ; Determine codes for MI subscript
+1 ;
+2 ; Bacteriology report
+3 IF LRSB=11
SET LA7DFCDE="87993.0000^93928.0000^"
DO DEFAULT
QUIT
+4 ;
+5 ; Urine Screen
+6 IF LRSB=11.57
SET LA7DFCDE="87993.0000^93948.0000^630"
DO DEFAULT
QUIT
+7 ;
+8 ; Sputum screen
+9 IF LRSB=11.58
SET LA7DFCDE="87993.0000^93949.0000^6460"
DO DEFAULT
QUIT
+10 ;
+11 ; Gram stain
+12 IF LRSB=11.6
SET LA7DFCDE="87993.0000^87754.0000^664"
DO DEFAULT
QUIT
+13 ;
+14 ; Bacteriology organism
+15 IF LRSB=12
SET LA7DFCDE="87993.0000^87570.0000^11475"
DO DEFAULT
QUIT
+16 ;
+17 ; Bacteria colony count
+18 IF +LRSB=12
IF $PIECE(LRSB,",",2)=1
SET LA7DFCDE="^87719.0000^564"
DO DEFAULT
QUIT
+19 ;
+20 ; Bacteriology smear/prep
+21 IF LRSB=11.7
SET LA7DFCDE="87993.0000^93967.0000^"
DO DEFAULT
QUIT
+22 ;
+23 ; Bacteriology test
+24 IF LRSB=1.5
SET LA7DFCDE="87993.0000^93969.0000^"
DO DEFAULT
QUIT
+25 ;
+26 ; Parasite report
+27 IF LRSB=14
SET LA7DFCDE="87925.0000^93929.0000^"
DO DEFAULT
QUIT
+28 ;
+29 ; Parasite organism
+30 IF LRSB=16
SET LA7DFCDE="87925.0000^87576.0000^20932"
DO DEFAULT
QUIT
+31 ;
+32 ; Parasite organism stage
+33 IF +LRSB=16
IF $PIECE(LRSB,",",2)=.01
SET LA7DFCDE="87925.0000^92930.0000^"
DO DEFAULT
QUIT
+34 ;
+35 ; Parasite organism stage quantity
+36 IF +LRSB=16
IF $PIECE(LRSB,",",2)=1
SET LA7DFCDE="87925.0000^93997.0000^"
DO DEFAULT
QUIT
+37 ;
+38 ; Parasitology smear/prep
+39 IF LRSB=15.51
SET LA7DFCDE="87925.0000^93971.0000^"
DO DEFAULT
QUIT
+40 ;
+41 ; Parasitology test
+42 IF LRSB=16.4
SET LA7DFCDE="87925.0000^93972.0000^"
DO DEFAULT
QUIT
+43 ;
+44 ; Mycology report
+45 IF LRSB=18
SET LA7DFCDE="87994.0000^93930.0000^"
DO DEFAULT
QUIT
+46 ;
+47 ; Mycology smear/prep
+48 IF LRSB=19.6
SET LA7DFCDE="87994.0000^93984.0000^"
DO DEFAULT
QUIT
+49 ;
+50 ; Mycology test
+51 IF LRSB=20.4
SET LA7DFCDE="87994.0000^93974.0000^"
DO DEFAULT
QUIT
+52 ;
+53 ; Fungal organism
+54 IF LRSB=20
SET LA7DFCDE="87994.0000^87578.0000^580"
DO DEFAULT
QUIT
+55 ;
+56 ; Fungal colony count
+57 IF +LRSB=20
IF $PIECE(LRSB,",",2)=1
SET LA7DFCDE="87994.0000^87723.0000^19101"
DO DEFAULT
QUIT
+58 ;
+59 ; Mycobacterium report
+60 IF LRSB=22
SET LA7DFCDE="87995.0000^93931.0000^"
DO DEFAULT
QUIT
+61 ;
+62 ; Acid Fast stain
+63 IF LRSB=24
SET LA7DFCDE="87995.0000^87756.0000^11545"
DO DEFAULT
QUIT
+64 ;
+65 ; Acid Fast stain quantity
+66 IF LRSB=25
SET LA7DFCDE="87995.0000^87583.0000^"
DO DEFAULT
QUIT
+67 ;
+68 ; Mycobacterium organism
+69 IF +LRSB=26
IF '$PIECE(LRSB,",",2)
SET LA7DFCDE="87995.0000^87589.0000^543"
DO DEFAULT
QUIT
+70 ;
+71 ; Mycobacterium colony count
+72 IF +LRSB=26
IF $PIECE(LRSB,",",2)=1
SET LA7DFCDE="87995.0000^87719.0000^564"
DO DEFAULT
QUIT
+73 ;
+74 ; Bact or TB organism's susceptibilities
+75 IF ($PIECE(LRSB,",")=12!($PIECE(LRSB,",")=26))
IF $PIECE(LRSB,",",2)>2
IF $PIECE(LRSB,",",2)<2.999
Begin DoDot:1
+76 SET LA7X=""
+77 IF $PIECE(LRSB,",")=12
Begin DoDot:2
+78 SET LA7DFCDE="87565.0000^^"
+79 SET LA7X=$ORDER(^LAB(62.06,"AD",$PIECE(LRSB,",",2),0))
End DoDot:2
+80 IF $PIECE(LRSB,",")=26
Begin DoDot:2
+81 SET LA7DFCDE="87568.0000^^"
+82 SET LA7X=$ORDER(^LAB(62.06,"AD1",$PIECE(LRSB,",",2),0))
End DoDot:2
+83 IF LA7X
Begin DoDot:2
+84 SET X=$$GET1^DIQ(62.06,LA7X_",","64:1")
+85 IF X
SET $PIECE(LA7DFCDE,"^",2)=X
End DoDot:2
+86 DO DEFAULT
End DoDot:1
QUIT
+87 ;
+88 ; TB test
+89 IF LRSB=26.4
SET LA7DFCDE="87995.0000^93977.0000^"
DO DEFAULT
QUIT
+90 ;
+91 ; Virology report
+92 IF LRSB=33
SET LA7DFCDE="87996.0000^93932.0000^"
DO DEFAULT
QUIT
+93 ;
+94 ; Viral agent
+95 IF $PIECE(LRSB,",")=36
SET LA7DFCDE="87996.0000^87590.0000^6584"
DO DEFAULT
QUIT
+96 ;
+97 ; Virology test
+98 IF LRSB=36.4
SET LA7DFCDE="87996.0000^93981.0000^"
DO DEFAULT
QUIT
+99 ;
+100 ; Sterility results
+101 IF LRSB=11.52
SET LA7DFCDE="93982.0000^93982.0000^"
DO DEFAULT
QUIT
+102 ;
+103 QUIT
+104 ;
+105 ;
SPSUB ; Determine codes for SP subscript
+1 ;
+2 ; specimens
+3 IF $PIECE(LRSB,",")=.012
SET LA7DFCDE="88515.0000^88539.0000^22633"
DO DEFAULT
QUIT
+4 IF LRSB=10
SET LA7DFCDE="88515.0000^88539.0000^22633"
DO DEFAULT
QUIT
+5 ;
+6 ; brief clinical history
+7 IF LRSB=.013
SET LA7DFCDE="88515.0000^88542.0000^22636"
DO DEFAULT
QUIT
+8 ;
+9 ; preoperative diagnosis
+10 IF LRSB=.014
SET LA7DFCDE="88515.0000^88544.0000^10219"
DO DEFAULT
QUIT
+11 ;
+12 ; operative findings
+13 IF LRSB=.015
SET LA7DFCDE="88515.0000^88546.0000^10215"
DO DEFAULT
QUIT
+14 ;
+15 ; postoperative diagnosis
+16 IF LRSB=.016
SET LA7DFCDE="88515.0000^88547.0000^10218"
DO DEFAULT
QUIT
+17 ;
+18 ; gross description
+19 IF LRSB=1
SET LA7DFCDE="88515.0000^88549.0000^22634"
DO DEFAULT
QUIT
+20 ;
+21 ; microscopic description
+22 IF LRSB=1.1
SET LA7DFCDE="88515.0000^88563.0000^22635"
DO DEFAULT
QUIT
+23 ;
+24 ; frozen section
+25 IF LRSB=1.3
SET LA7DFCDE="88515.0000^88569.0000^22635"
DO DEFAULT
QUIT
+26 ;
+27 ; surgical path diagnosis
+28 IF LRSB=1.4
SET LA7DFCDE="88515.0000^88571.0000^22637"
DO DEFAULT
QUIT
+29 ;
+30 ; supplementary report
+31 IF LRSB=1.2!(LRSB="10,5")
SET LA7DFCDE="88589.0000^88589.0000^22639"
DO DEFAULT
QUIT
+32 ;
+33 ; specimen weight
+34 IF LRSB="10,2"
SET LA7DFCDE="88515.0000^81233.0000^3154"
DO DEFAULT
QUIT
+35 ;
+36 QUIT
+37 ;
+38 ;
CYSUB ; Determine codes for CY subscript
+1 ;
+2 ; specimens
+3 IF $PIECE(LRSB,",")=.012
SET LA7DFCDE="88593.0000^88539.0000^22633"
DO DEFAULT
QUIT
+4 IF LRSB=10
SET LA7DFCDE="88593.0000^88539.0000^22633"
DO DEFAULT
QUIT
+5 ;
+6 ; brief clinical history
+7 IF LRSB=.013
SET LA7DFCDE="88593.0000^88542.0000^22636"
DO DEFAULT
QUIT
+8 ;
+9 ; preoperative diagnosis
+10 IF LRSB=.014
SET LA7DFCDE="88593.0000^88544.0000^10219"
DO DEFAULT
QUIT
+11 ;
+12 ; operative findings
+13 IF LRSB=.015
SET LA7DFCDE="88593.0000^88542.0000^10215"
DO DEFAULT
QUIT
+14 ;
+15 ; postoperative diagnosis
+16 IF LRSB=.016
SET LA7DFCDE="88593.0000^88547.0000^10218"
DO DEFAULT
QUIT
+17 ;
+18 ; gross description
+19 IF LRSB=1!(LRSB=20)
SET LA7DFCDE="88593.0000^88549.0000^22634"
DO DEFAULT
QUIT
+20 ;
+21 ; microscopic examination
+22 IF LRSB=1.1
SET LA7DFCDE="88593.0000^88563.0000^22635"
DO DEFAULT
QUIT
+23 ;
+24 ; supplementary report
+25 IF LRSB=1.2
SET LA7DFCDE="88589.0000^88589.0000^22639"
DO DEFAULT
QUIT
+26 ;
+27 ; cytopathology diagnosis
+28 IF LRSB=1.4
SET LA7DFCDE="88593.0000^88571.0000^22637"
DO DEFAULT
QUIT
+29 ;
+30 QUIT
+31 ;
+32 ;
EMSUB ; Determine codes for EM subscript
+1 ;
+2 ; specimens
+3 IF $PIECE(LRSB,",")=.012
SET LA7DFCDE="88597.0000^88057.0000^22633"
DO DEFAULT
QUIT
+4 IF LRSB=10
SET LA7DFCDE="88597.0000^88057.0000^22633"
DO DEFAULT
QUIT
+5 ;
+6 ; brief clinical history
+7 IF LRSB=.013
SET LA7DFCDE="88597.0000^88542.0000^22636"
DO DEFAULT
QUIT
+8 ;
+9 ; preoperative diagnosis
+10 IF LRSB=.014
SET LA7DFCDE="88597.0000^88544.0000^10219"
DO DEFAULT
QUIT
+11 ;
+12 ; operative findings
+13 IF LRSB=.015
SET LA7DFCDE="88597.0000^88542.0000^10215"
DO DEFAULT
QUIT
+14 ;
+15 ; postoperative diagnosis
+16 IF LRSB=.016
SET LA7DFCDE="88597.0000^88547.0000^10218"
DO DEFAULT
QUIT
+17 ;
+18 ; gross description
+19 IF LRSB=1!(LRSB=20)
SET LA7DFCDE="88597.0000^88549.0000^22634"
DO DEFAULT
QUIT
+20 ;
+21 ; microscopic examination
+22 IF LRSB=1.1
SET LA7DFCDE="88597.0000^88563.0000^22635"
DO DEFAULT
QUIT
+23 ;
+24 ; supplementary report
+25 IF LRSB=1.2
SET LA7DFCDE="88589.0000^88589.0000^22639"
DO DEFAULT
QUIT
+26 ;
+27 ; em diagnosis
+28 IF LRSB=1.4
SET LA7DFCDE="88597.0000^88571.0000^22637"
DO DEFAULT
QUIT
+29 ;
+30 QUIT
+31 ;
+32 ;
DEFAULT ; Resolve codes and set defaults as needed
+1 ;
+2 ; Expects LA7DFCDE=default order NLT^default result NLT^default LOINC code
+3 ;
+4 IF $PIECE(LA7MISS,"^")
SET $PIECE(LA7CODE,"!")=$PIECE(LA7DFCDE,"^")
+5 IF $PIECE(LA7MISS,"^",2)
SET $PIECE(LA7CODE,"!",2)=$PIECE(LA7DFCDE,"^",2)
+6 IF $PIECE(LA7MISS,"^",3)
Begin DoDot:1
+7 ;START OF CHANGE FOR LA*5.2*92
+8 ;S $P(LA7CODE,"!",3)=$$LNC^LRVER1($P(LA7CODE,"!",2),$P(LA7CODE,"!",4),LA761)
+9 SET $PIECE(LA7CODE,"!",3)=$$LNC^LRVER1($PIECE(LA7CODE,"!",2),$PIECE(LA7CODE,"!",4),LA761,0)
+10 ;END OF CHANGE FOR LA*5.2*92
+11 IF '$PIECE(LA7CODE,"!",3)
SET $PIECE(LA7CODE,"!",3)=$PIECE(LA7DFCDE,"^",3)
End DoDot:1
+12 QUIT
