LA7UTL1C ;HOIFO/BH - Microbiology Query Utility ; 3/11/03 10:45am
 ;;5.2;AUTOMATED LAB INSTRUMENTS;**69**;Sep 27, 1994
 ;
 ;
MI(LRDFN,LRIDT,LAARRAY) ; Get Microbiology data
 ; Get top node data
 ;
 N LACOMIEN,LAGETIEN,LAGSIEN,LAIEN,LAORGIEN,LAPARIEN,LAPRIEN,LAREMIEN,LASCCOM,LASCIEN,LAFIXANT,LAFCOM,LAFUNIEN,LAMBIEN,LAMBCOM,LAFIXMB,LAMBFLD,LAMBFLD1,LACNT1,LAMBRES,LAVIEN
 N LAGETS,LAGETIEN,LAMFLD,LAANTIEN,LACMANTI,LABSPIEN,LAPSPIEN,LAMSPIEN,LAVRRIEN
 ;
 S LAIEN=LRIDT_","_LRDFN
 K LARET,LAERR
 D GETS^DIQ(63.05,LAIEN,".01;.05;.055;.06;11.51;11.57;11.58;22:23;24;25;.99","IE","LARET","LAERR")
 I $D(LAERR("DIERR")) K LAERR Q
 M @LAARRAY=LARET
 K LARET,LAERR
 ;
 ; Get Bact RPT Remark
 S LAREMIEN=0
 F  S LAREMIEN=$O(^LR(LRDFN,"MI",LRIDT,4,LAREMIEN)) Q:'LAREMIEN  D
 . S LAGETIEN=LAREMIEN_","_LRIDT_","_LRDFN
 . K LARET,LAERR
 . D GETS^DIQ(63.33,LAGETIEN,".01","IE","LARET","LAERR")
 . I $D(LAERR("DIERR")) K LAERR Q
 . M @LAARRAY=LARET
 . K LARET,LAERR
 ;
 ; Get Gram Stain
 S LAGSIEN=0
 F  S LAGSIEN=$O(^LR(LRDFN,"MI",LRIDT,2,LAGSIEN)) Q:'LAGSIEN  D
 . S LAGETIEN=LAGSIEN_","_LRIDT_","_LRDFN
 . K LARET,LAERR
 . D GETS^DIQ(63.29,LAGETIEN,".01","IE","LARET","LAERR")
 . I $D(LAERR("DIERR")) K LAERR Q
 . M @LAARRAY=LARET
 . K LARET,LAERR
 ;
 ; Get Organism data
 S LAORGIEN=0
 F  S LAORGIEN=$O(^LR(LRDFN,"MI",LRIDT,3,LAORGIEN)) Q:'LAORGIEN  D
 . S LAGETIEN=LAORGIEN_","_LRIDT_","_LRDFN
 . K LARET,LAERR
 . D GETS^DIQ(63.3,LAGETIEN,".01;1","IE","LARET","LAERR")
 . I $D(LAERR("DIERR")) K LAERR Q
 . M @LAARRAY=LARET
 . K LARET,LAERR
 . S LACOMIEN=0
 . F  S LACOMIEN=$O(^LR(LRDFN,"MI",LRIDT,3,LAORGIEN,1,LACOMIEN)) Q:'LACOMIEN  D
 . . S LAGETIEN=LACOMIEN_","_LAORGIEN_","_LRIDT_","_LRDFN
 . . K LARET,LAERR
 . . D GETS^DIQ(63.31,LAGETIEN,".01","IE","LARET","LAERR")
 . . I $D(LAERR("DIERR")) K LAERR Q
 . . M @LAARRAY=LARET
 . . K LARET,LAERR
 . ;
 . ;
 . S LAFIXANT=2
 . F  S LAFIXANT=$O(^LR(LRDFN,"MI",LRIDT,3,LAORGIEN,LAFIXANT)) Q:'LAFIXANT!(LAFIXANT'<3)  D
 . . Q:$E(LAFIXANT,1,4)'="2.00"
 . . S LAGETIEN=LAORGIEN_","_LRIDT_","_LRDFN
 . . I $L(LAFIXANT)<7 D
 . . . S LAMFLD=$$DECODE^LA7UTL1B(LAFIXANT)
 . . . I LAMFLD="" Q
 . . . N LACNT1,LACNT,LAVAL,LA7ARR1,LAMFLD2,LAIN,LAMFLD3,LAMFLD4
 . . . F LACNT=2,3,4 D
 . . . . S LAVAL=$P(LAMFLD,U,LACNT)
 . . . . S LAIN="LAMFLD"_LACNT
 . . . . S @LAIN=$P(LAVAL,"~")
 . . . . S LA7ARR1(@LAIN)=$P(LAVAL,"~",2)
 . . . . ;
 . . . K LARET,LAERR
 . . . D GETS^DIQ(63.3,LAGETIEN,LAMFLD2_";"_LAMFLD3_";"_LAMFLD4,"IE","LARET","LAERR")
 . . . I $D(LAERR("DIERR")) K LAERR Q
 . . . S LACNT1=0
 . . . S LAGETIEN=LAGETIEN_","
 . . . F  S LACNT1=$O(LA7ARR1(LACNT1)) Q:'LACNT1  D
 . . . . N LARES
 . . . . S LARES=$G(LARET(63.3,LAGETIEN,LACNT1,"I"))
 . . . . I LARES="" K LARET(63.3,LAGETIEN,LACNT1) Q
 . . . . S LARET(63.3,LAGETIEN,LACNT1,"I")=LA7ARR1(LACNT1)_U_LARES
 . . . M @LAARRAY=LARET
 . . . ;
 . . . ;
 . . I $L(LAFIXANT)>6 D
 . . . N LACNT2,LANAME,LATEST,LARET,LAERR,LARES
 . . . D FIELD^DID(63.3,LAFIXANT,"","LABEL","LATEST")
 . . . I '$D(LATEST("LABEL")) Q
 . . . S LANAME=LATEST("LABEL")
 . . . ;
 . . . D GETS^DIQ(63.3,LAGETIEN,LAFIXANT_";"_LAFIXANT_"1;"_LAFIXANT_"2","IE","LARET","LAERR")
 . . . I $D(LAERR("DIERR")) K LAERR Q
 . . . S LAGETIEN=LAGETIEN_","
 . . . S LARES=$G(LARET(63.3,LAGETIEN,LAFIXANT,"I"))
 . . . S:LARES'="" LARET(63.3,LAGETIEN,LAFIXANT,"I")=LANAME_U_LARES
 . . . I LARES="" K LARET(63.3,LAGETIEN,LAFIXANT)
 . . . F LACNT2=1,2 D
 . . . . K LATEST
 . . . . D FIELD^DID(63.3,LAFIXANT_LACNT2,"","LABEL","LATEST")
 . . . . I '$D(LATEST("LABEL")) Q
 . . . . S LANAME=LATEST("LABEL")
 . . . . S LARES=$G(LARET(63.3,LAGETIEN,LAFIXANT_LACNT2,"I"))
 . . . . I LARES="" K LARET(63.3,LAGETIEN,LAFIXANT_LACNT2) Q
 . . . . S LARET(63.3,LAGETIEN,LAFIXANT_LACNT2,"I")=LANAME_U_LARES
 . . . M @LAARRAY=LARET
 . ;
 . S LACMANTI=0
 . F  S LACMANTI=$O(^LR(LRDFN,"MI",LRIDT,3,LAORGIEN,3,LACMANTI)) Q:'LACMANTI  D
 . . S LAANTIEN=LACMANTI_","_LAORGIEN_","_LRIDT_","_LRDFN
 . . K LARET,LAERR
 . . D GETS^DIQ(63.32,LAANTIEN,".01;1;2","IE","LARET","LAERR")
 . . I $D(LAERR("DIERR")) K LAERR Q
 . . M @LAARRAY=LARET
 . . K LARET,LAERR
 ;
 ;
 ; Get Parasite data
 S LAPARIEN=0
 F  S LAPARIEN=$O(^LR(LRDFN,"MI",LRIDT,6,LAPARIEN)) Q:'LAPARIEN  D
 . S LAGETIEN=LAPARIEN_","_LRIDT_","_LRDFN
 . K LARET,LAERR
 . D GETS^DIQ(63.34,LAGETIEN,".01","IE","LARET","LAERR")
 . I $D(LAERR("DIERR")) K LAERR Q
 . M @LAARRAY=LARET
 . K LARET,LAERR
 . ; - Get stage code data
 . S LASCIEN=0
 . F  S LASCIEN=$O(^LR(LRDFN,"MI",LRIDT,6,LAPARIEN,1,LASCIEN)) Q:'LASCIEN  D
 . . S LAGETIEN=LASCIEN_","_LAPARIEN_","_LRIDT_","_LRDFN
 . . K LARET,LAERR
 . . D GETS^DIQ(63.35,LAGETIEN,".01;1","IE","LARET","LAERR")
 . . I $D(LAERR("DIERR")) K LAERR Q
 . . M @LAARRAY=LARET
 . . K LARET,LAERR
 . . ; - Get stage code comments 
 . . S LASCCOM=0
 . . F  S LASCCOM=$O(^LR(LRDFN,"MI",LRIDT,6,LAPARIEN,1,LASCIEN,1,LASCCOM)) Q:'LASCCOM  D
 . . . S LAGETIEN=LASCCOM_","_LASCIEN_","_LAPARIEN_","_LRIDT_","_LRDFN
 . . . K LARET,LAERR
 . . . D GETS^DIQ(63.351,LAGETIEN,".01","IE","LARET","LAERR")
 . . . I $D(LAERR("DIERR")) K LAERR Q
 . . . M @LAARRAY=LARET
 . . . K LARET,LAERR
 ;
 ; - Get Parasite Remarks
 S LAPRIEN=0
 F  S LAPRIEN=$O(^LR(LRDFN,"MI",LRIDT,7,LAPRIEN)) Q:'LAPRIEN  D
 . S LAGETIEN=LAPRIEN_","_LRIDT_","_LRDFN
 . K LARET,LAERR
 . D GETS^DIQ(63.36,LAGETIEN,".01","IE","LARET","LAERR")
 . I $D(LAERR("DIERR")) K LAERR Q
 . M @LAARRAY=LARET
 . K LARET,LAERR
 ;
 ; ---Fungus Yeast
 S LAFUNIEN=0
 F  S LAFUNIEN=$O(^LR(LRDFN,"MI",LRIDT,9,LAFUNIEN)) Q:'LAFUNIEN  D
 . S LAGETIEN=LAFUNIEN_","_LRIDT_","_LRDFN
 . K LARET,LAERR
 . D GETS^DIQ(63.37,LAGETIEN,".01;1","IE","LARET","LAERR")
 . I $D(LAERR("DIERR")) K LAERR Q
 . M @LAARRAY=LARET
 . K LARET,LAERR
 . S LAFCOM=0
 . F  S LAFCOM=$O(^LR(LRDFN,"MI",LRIDT,9,LAFUNIEN,1,LAFCOM)) Q:'LAFCOM  D
 . . S LAGETIEN=LAFCOM_","_LAFUNIEN_","_LRIDT_","_LRDFN
 . . K LARET,LAERR
 . . D GETS^DIQ(63.372,LAGETIEN,".01","IE","LARET","LAERR")
 . . I $D(LAERR("DIERR")) K LAERR Q
 . . M @LAARRAY=LARET
 . . K LARET,LAERR
 ;
 ; ---Mycobacteruim
 ;
 S LAMBIEN=0
 F  S LAMBIEN=$O(^LR(LRDFN,"MI",LRIDT,12,LAMBIEN)) Q:'LAMBIEN  D
 . S LAGETIEN=LAMBIEN_","_LRIDT_","_LRDFN
 . K LARET,LAERR
 . D GETS^DIQ(63.39,LAGETIEN,".01;1","IE","LARET","LAERR")
 . I $D(LAERR("DIERR")) K LAERR Q
 . M @LAARRAY=LARET
 . K LARET,LAERR
 . S LAMBCOM=0
 . F  S LAMBCOM=$O(^LR(LRDFN,"MI",LRIDT,12,LAMBIEN,1,LAMBCOM)) Q:'LAMBCOM  D
 . . S LAGETIEN=LAMBCOM_","_LAMBIEN_","_LRIDT_","_LRDFN
 . . K LARET,LAERR
 . . D GETS^DIQ(63.4,LAGETIEN,".01","IE","LARET","LAERR")
 . . I $D(LAERR("DIERR")) K LAERR Q
 . . M @LAARRAY=LARET
 . K LARET,LAERR
 . S LAFIXMB=2
 . S LAGETIEN=LAMBIEN_","_LRIDT_","_LRDFN
 . F  S LAFIXMB=$O(^LR(LRDFN,"MI",LRIDT,12,LAMBIEN,LAFIXMB)) Q:'LAFIXMB!(LAFIXMB'<3)  D
 . . Q:$E(LAFIXMB,1,4)'="2.00"
 . . I $L(LAFIXMB)<7 D
 . . . S LAMBFLD=$P($$DECODEMB^LA7UTL1B(LAFIXMB),U,2)
 . . . I LAMBFLD="" Q
 . . . S LAMBFLD1=$P(LAMBFLD,"~",2)
 . . . S LAMBFLD=$P(LAMBFLD,"~",1)
 . . . K LARET,LAERR
 . . . D GETS^DIQ(63.39,LAGETIEN,LAMBFLD,"IE","LARET","LAERR")
 . . . ;
 . . . I $D(LAERR("DIERR"))!('$D(LARET)) K LARET,LAERR Q
 . . . ;
 . . . S LAGETS=LAGETIEN_","
 . . . S LAMBRES=$G(LARET(63.39,LAGETS,LAMBFLD,"I"))
 . . . I LAMBRES="" K LARET(63.39,LAGETS,LAMBFLD) Q
 . . . S LARET(63.39,LAGETS,LAMBFLD,"I")=LAMBFLD1_U_LAMBRES
 . . . M @LAARRAY=LARET
 . . . ;
 . . . ;
 . . I $L(LAFIXMB)>6 D
 . . . N LANAME,LATEST,LARET,LAERR,LAMBRES
 . . . D FIELD^DID(63.39,LAFIXMB,"","LABEL","LATEST")
 . . . I '$D(LATEST("LABEL")) Q
 . . . S LANAME=LATEST("LABEL")
 . . . K LARET,LAERR
 . . . D GETS^DIQ(63.39,LAGETIEN,LAFIXMB,"IE","LARET","LAERR")
 . . . ;
 . . . I $D(LAERR("DIERR"))!('$D(LARET)) K LAERR Q
 . . . S LAGETS=LAGETIEN_","
 . . . S LAMBRES=$G(LARET(63.39,LAGETS,LAFIXMB,"I"))
 . . . I LAMBRES="" K LARET(63.39,LAGETS,LAFIXMB) Q
 . . . S:LAMBRES'="" LARET(63.39,LAGETS,LAFIXMB,"I")=LANAME_U_LAMBRES
 . . . M @LAARRAY=LARET
 ;
 ; ---Virus
 ;
 S LAVIEN=0
 F  S LAVIEN=$O(^LR(LRDFN,"MI",LRIDT,17,LAVIEN)) Q:'LAVIEN  D
 . S LAGETIEN=LAVIEN_","_LRIDT_","_LRDFN
 . K LARET,LAERR
 . D GETS^DIQ(63.43,LAGETIEN,".01","IE","LARET","LAERR")
 . I $D(LAERR("DIERR")) K LAERR Q
 . M @LAARRAY=LARET
 . K LARET,LAERR
 ;
 ; ---Parasitology Smear/Prep
 ;
 S LAPSPIEN=0
 F  S LAPSPIEN=$O(^LR(LRDFN,"MI",LRIDT,24,LAPSPIEN)) Q:'LAPSPIEN  D
 . S LAGETIEN=LAPSPIEN_","_LRIDT_","_LRDFN
 . K LARET,LAERR
 . D GETS^DIQ(63.341,LAGETIEN,".01","IE","LARET","LAERR")
 . I $D(LAERR("DIERR")) K LAERR Q
 . M @LAARRAY=LARET
 . K LARET,LAERR
 ;
 ; ---Bacteriology Smear/Prep
 ;
 S LABSPIEN=0
 F  S LABSPIEN=$O(^LR(LRDFN,"MI",LRIDT,25,LABSPIEN)) Q:'LABSPIEN  D
 . S LAGETIEN=LABSPIEN_","_LRIDT_","_LRDFN
 . K LARET,LAERR
 . D GETS^DIQ(63.291,LAGETIEN,".01","IE","LARET","LAERR")
 . I $D(LAERR("DIERR")) K LAERR Q
 . M @LAARRAY=LARET
 . K LARET,LAERR
 ;
 ; ---Mycology Smear/Prep
 ;
 S LAMSPIEN=0
 F  S LAMSPIEN=$O(^LR(LRDFN,"MI",LRIDT,15,LAMSPIEN)) Q:'LAMSPIEN  D
 . S LAGETIEN=LAMSPIEN_","_LRIDT_","_LRDFN
 . K LARET,LAERR
 . D GETS^DIQ(63.371,LAGETIEN,".01","IE","LARET","LAERR")
 . I $D(LAERR("DIERR")) K LAERR Q
 . M @LAARRAY=LARET
 . K LARET,LAERR
 ;
 ; ---Virology RPT
 ;
 S LAVRRIEN=0
 F  S LAVRRIEN=$O(^LR(LRDFN,"MI",LRIDT,18,LAVRRIEN)) Q:'LAVRRIEN  D
 . S LAGETIEN=LAVRRIEN_","_LRIDT_","_LRDFN
 . K LARET,LAERR
 . D GETS^DIQ(63.44,LAGETIEN,".01","IE","LARET","LAERR")
 . I $D(LAERR("DIERR")) K LAERR Q
 . M @LAARRAY=LARET
 . K LARET,LAERR
 ;
 Q
 ;