- 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