VistA-FOIAVistA/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7UTL1C.m

283 lines
9.1 KiB
Mathematica
Raw Normal View History

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
;