283 lines
9.1 KiB
Mathematica
283 lines
9.1 KiB
Mathematica
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
|
|
;
|