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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLA7UTL1C 9640 printed Sep 23, 2025@19:16:04 Page 2
LA7UTL1C ;HOIFO/BH - Microbiology Query Utility ; 3/11/03 10:45am
+1 ;;5.2;AUTOMATED LAB INSTRUMENTS;**69**;Sep 27, 1994
+2 ;
+3 ;
MI(LRDFN,LRIDT,LAARRAY) ; Get Microbiology data
+1 ; Get top node data
+2 ;
+3 NEW LACOMIEN,LAGETIEN,LAGSIEN,LAIEN,LAORGIEN,LAPARIEN,LAPRIEN,LAREMIEN,LASCCOM,LASCIEN,LAFIXANT,LAFCOM,LAFUNIEN,LAMBIEN,LAMBCOM,LAFIXMB,LAMBFLD,LAMBFLD1,LACNT1,LAMBRES,LAVIEN
+4 NEW LAGETS,LAGETIEN,LAMFLD,LAANTIEN,LACMANTI,LABSPIEN,LAPSPIEN,LAMSPIEN,LAVRRIEN
+5 ;
+6 SET LAIEN=LRIDT_","_LRDFN
+7 KILL LARET,LAERR
+8 DO GETS^DIQ(63.05,LAIEN,".01;.05;.055;.06;11.51;11.57;11.58;22:23;24;25;.99","IE","LARET","LAERR")
+9 IF $DATA(LAERR("DIERR"))
KILL LAERR
QUIT
+10 MERGE @LAARRAY=LARET
+11 KILL LARET,LAERR
+12 ;
+13 ; Get Bact RPT Remark
+14 SET LAREMIEN=0
+15 FOR
SET LAREMIEN=$ORDER(^LR(LRDFN,"MI",LRIDT,4,LAREMIEN))
if 'LAREMIEN
QUIT
Begin DoDot:1
+16 SET LAGETIEN=LAREMIEN_","_LRIDT_","_LRDFN
+17 KILL LARET,LAERR
+18 DO GETS^DIQ(63.33,LAGETIEN,".01","IE","LARET","LAERR")
+19 IF $DATA(LAERR("DIERR"))
KILL LAERR
QUIT
+20 MERGE @LAARRAY=LARET
+21 KILL LARET,LAERR
End DoDot:1
+22 ;
+23 ; Get Gram Stain
+24 SET LAGSIEN=0
+25 FOR
SET LAGSIEN=$ORDER(^LR(LRDFN,"MI",LRIDT,2,LAGSIEN))
if 'LAGSIEN
QUIT
Begin DoDot:1
+26 SET LAGETIEN=LAGSIEN_","_LRIDT_","_LRDFN
+27 KILL LARET,LAERR
+28 DO GETS^DIQ(63.29,LAGETIEN,".01","IE","LARET","LAERR")
+29 IF $DATA(LAERR("DIERR"))
KILL LAERR
QUIT
+30 MERGE @LAARRAY=LARET
+31 KILL LARET,LAERR
End DoDot:1
+32 ;
+33 ; Get Organism data
+34 SET LAORGIEN=0
+35 FOR
SET LAORGIEN=$ORDER(^LR(LRDFN,"MI",LRIDT,3,LAORGIEN))
if 'LAORGIEN
QUIT
Begin DoDot:1
+36 SET LAGETIEN=LAORGIEN_","_LRIDT_","_LRDFN
+37 KILL LARET,LAERR
+38 DO GETS^DIQ(63.3,LAGETIEN,".01;1","IE","LARET","LAERR")
+39 IF $DATA(LAERR("DIERR"))
KILL LAERR
QUIT
+40 MERGE @LAARRAY=LARET
+41 KILL LARET,LAERR
+42 SET LACOMIEN=0
+43 FOR
SET LACOMIEN=$ORDER(^LR(LRDFN,"MI",LRIDT,3,LAORGIEN,1,LACOMIEN))
if 'LACOMIEN
QUIT
Begin DoDot:2
+44 SET LAGETIEN=LACOMIEN_","_LAORGIEN_","_LRIDT_","_LRDFN
+45 KILL LARET,LAERR
+46 DO GETS^DIQ(63.31,LAGETIEN,".01","IE","LARET","LAERR")
+47 IF $DATA(LAERR("DIERR"))
KILL LAERR
QUIT
+48 MERGE @LAARRAY=LARET
+49 KILL LARET,LAERR
End DoDot:2
+50 ;
+51 ;
+52 SET LAFIXANT=2
+53 FOR
SET LAFIXANT=$ORDER(^LR(LRDFN,"MI",LRIDT,3,LAORGIEN,LAFIXANT))
if 'LAFIXANT!(LAFIXANT'<3)
QUIT
Begin DoDot:2
+54 if $EXTRACT(LAFIXANT,1,4)'="2.00"
QUIT
+55 SET LAGETIEN=LAORGIEN_","_LRIDT_","_LRDFN
+56 IF $LENGTH(LAFIXANT)<7
Begin DoDot:3
+57 SET LAMFLD=$$DECODE^LA7UTL1B(LAFIXANT)
+58 IF LAMFLD=""
QUIT
+59 NEW LACNT1,LACNT,LAVAL,LA7ARR1,LAMFLD2,LAIN,LAMFLD3,LAMFLD4
+60 FOR LACNT=2,3,4
Begin DoDot:4
+61 SET LAVAL=$PIECE(LAMFLD,U,LACNT)
+62 SET LAIN="LAMFLD"_LACNT
+63 SET @LAIN=$PIECE(LAVAL,"~")
+64 SET LA7ARR1(@LAIN)=$PIECE(LAVAL,"~",2)
+65 ;
End DoDot:4
+66 KILL LARET,LAERR
+67 DO GETS^DIQ(63.3,LAGETIEN,LAMFLD2_";"_LAMFLD3_";"_LAMFLD4,"IE","LARET","LAERR")
+68 IF $DATA(LAERR("DIERR"))
KILL LAERR
QUIT
+69 SET LACNT1=0
+70 SET LAGETIEN=LAGETIEN_","
+71 FOR
SET LACNT1=$ORDER(LA7ARR1(LACNT1))
if 'LACNT1
QUIT
Begin DoDot:4
+72 NEW LARES
+73 SET LARES=$GET(LARET(63.3,LAGETIEN,LACNT1,"I"))
+74 IF LARES=""
KILL LARET(63.3,LAGETIEN,LACNT1)
QUIT
+75 SET LARET(63.3,LAGETIEN,LACNT1,"I")=LA7ARR1(LACNT1)_U_LARES
End DoDot:4
+76 MERGE @LAARRAY=LARET
+77 ;
+78 ;
End DoDot:3
+79 IF $LENGTH(LAFIXANT)>6
Begin DoDot:3
+80 NEW LACNT2,LANAME,LATEST,LARET,LAERR,LARES
+81 DO FIELD^DID(63.3,LAFIXANT,"","LABEL","LATEST")
+82 IF '$DATA(LATEST("LABEL"))
QUIT
+83 SET LANAME=LATEST("LABEL")
+84 ;
+85 DO GETS^DIQ(63.3,LAGETIEN,LAFIXANT_";"_LAFIXANT_"1;"_LAFIXANT_"2","IE","LARET","LAERR")
+86 IF $DATA(LAERR("DIERR"))
KILL LAERR
QUIT
+87 SET LAGETIEN=LAGETIEN_","
+88 SET LARES=$GET(LARET(63.3,LAGETIEN,LAFIXANT,"I"))
+89 if LARES'=""
SET LARET(63.3,LAGETIEN,LAFIXANT,"I")=LANAME_U_LARES
+90 IF LARES=""
KILL LARET(63.3,LAGETIEN,LAFIXANT)
+91 FOR LACNT2=1,2
Begin DoDot:4
+92 KILL LATEST
+93 DO FIELD^DID(63.3,LAFIXANT_LACNT2,"","LABEL","LATEST")
+94 IF '$DATA(LATEST("LABEL"))
QUIT
+95 SET LANAME=LATEST("LABEL")
+96 SET LARES=$GET(LARET(63.3,LAGETIEN,LAFIXANT_LACNT2,"I"))
+97 IF LARES=""
KILL LARET(63.3,LAGETIEN,LAFIXANT_LACNT2)
QUIT
+98 SET LARET(63.3,LAGETIEN,LAFIXANT_LACNT2,"I")=LANAME_U_LARES
End DoDot:4
+99 MERGE @LAARRAY=LARET
End DoDot:3
End DoDot:2
+100 ;
+101 SET LACMANTI=0
+102 FOR
SET LACMANTI=$ORDER(^LR(LRDFN,"MI",LRIDT,3,LAORGIEN,3,LACMANTI))
if 'LACMANTI
QUIT
Begin DoDot:2
+103 SET LAANTIEN=LACMANTI_","_LAORGIEN_","_LRIDT_","_LRDFN
+104 KILL LARET,LAERR
+105 DO GETS^DIQ(63.32,LAANTIEN,".01;1;2","IE","LARET","LAERR")
+106 IF $DATA(LAERR("DIERR"))
KILL LAERR
QUIT
+107 MERGE @LAARRAY=LARET
+108 KILL LARET,LAERR
End DoDot:2
End DoDot:1
+109 ;
+110 ;
+111 ; Get Parasite data
+112 SET LAPARIEN=0
+113 FOR
SET LAPARIEN=$ORDER(^LR(LRDFN,"MI",LRIDT,6,LAPARIEN))
if 'LAPARIEN
QUIT
Begin DoDot:1
+114 SET LAGETIEN=LAPARIEN_","_LRIDT_","_LRDFN
+115 KILL LARET,LAERR
+116 DO GETS^DIQ(63.34,LAGETIEN,".01","IE","LARET","LAERR")
+117 IF $DATA(LAERR("DIERR"))
KILL LAERR
QUIT
+118 MERGE @LAARRAY=LARET
+119 KILL LARET,LAERR
+120 ; - Get stage code data
+121 SET LASCIEN=0
+122 FOR
SET LASCIEN=$ORDER(^LR(LRDFN,"MI",LRIDT,6,LAPARIEN,1,LASCIEN))
if 'LASCIEN
QUIT
Begin DoDot:2
+123 SET LAGETIEN=LASCIEN_","_LAPARIEN_","_LRIDT_","_LRDFN
+124 KILL LARET,LAERR
+125 DO GETS^DIQ(63.35,LAGETIEN,".01;1","IE","LARET","LAERR")
+126 IF $DATA(LAERR("DIERR"))
KILL LAERR
QUIT
+127 MERGE @LAARRAY=LARET
+128 KILL LARET,LAERR
+129 ; - Get stage code comments
+130 SET LASCCOM=0
+131 FOR
SET LASCCOM=$ORDER(^LR(LRDFN,"MI",LRIDT,6,LAPARIEN,1,LASCIEN,1,LASCCOM))
if 'LASCCOM
QUIT
Begin DoDot:3
+132 SET LAGETIEN=LASCCOM_","_LASCIEN_","_LAPARIEN_","_LRIDT_","_LRDFN
+133 KILL LARET,LAERR
+134 DO GETS^DIQ(63.351,LAGETIEN,".01","IE","LARET","LAERR")
+135 IF $DATA(LAERR("DIERR"))
KILL LAERR
QUIT
+136 MERGE @LAARRAY=LARET
+137 KILL LARET,LAERR
End DoDot:3
End DoDot:2
End DoDot:1
+138 ;
+139 ; - Get Parasite Remarks
+140 SET LAPRIEN=0
+141 FOR
SET LAPRIEN=$ORDER(^LR(LRDFN,"MI",LRIDT,7,LAPRIEN))
if 'LAPRIEN
QUIT
Begin DoDot:1
+142 SET LAGETIEN=LAPRIEN_","_LRIDT_","_LRDFN
+143 KILL LARET,LAERR
+144 DO GETS^DIQ(63.36,LAGETIEN,".01","IE","LARET","LAERR")
+145 IF $DATA(LAERR("DIERR"))
KILL LAERR
QUIT
+146 MERGE @LAARRAY=LARET
+147 KILL LARET,LAERR
End DoDot:1
+148 ;
+149 ; ---Fungus Yeast
+150 SET LAFUNIEN=0
+151 FOR
SET LAFUNIEN=$ORDER(^LR(LRDFN,"MI",LRIDT,9,LAFUNIEN))
if 'LAFUNIEN
QUIT
Begin DoDot:1
+152 SET LAGETIEN=LAFUNIEN_","_LRIDT_","_LRDFN
+153 KILL LARET,LAERR
+154 DO GETS^DIQ(63.37,LAGETIEN,".01;1","IE","LARET","LAERR")
+155 IF $DATA(LAERR("DIERR"))
KILL LAERR
QUIT
+156 MERGE @LAARRAY=LARET
+157 KILL LARET,LAERR
+158 SET LAFCOM=0
+159 FOR
SET LAFCOM=$ORDER(^LR(LRDFN,"MI",LRIDT,9,LAFUNIEN,1,LAFCOM))
if 'LAFCOM
QUIT
Begin DoDot:2
+160 SET LAGETIEN=LAFCOM_","_LAFUNIEN_","_LRIDT_","_LRDFN
+161 KILL LARET,LAERR
+162 DO GETS^DIQ(63.372,LAGETIEN,".01","IE","LARET","LAERR")
+163 IF $DATA(LAERR("DIERR"))
KILL LAERR
QUIT
+164 MERGE @LAARRAY=LARET
+165 KILL LARET,LAERR
End DoDot:2
End DoDot:1
+166 ;
+167 ; ---Mycobacteruim
+168 ;
+169 SET LAMBIEN=0
+170 FOR
SET LAMBIEN=$ORDER(^LR(LRDFN,"MI",LRIDT,12,LAMBIEN))
if 'LAMBIEN
QUIT
Begin DoDot:1
+171 SET LAGETIEN=LAMBIEN_","_LRIDT_","_LRDFN
+172 KILL LARET,LAERR
+173 DO GETS^DIQ(63.39,LAGETIEN,".01;1","IE","LARET","LAERR")
+174 IF $DATA(LAERR("DIERR"))
KILL LAERR
QUIT
+175 MERGE @LAARRAY=LARET
+176 KILL LARET,LAERR
+177 SET LAMBCOM=0
+178 FOR
SET LAMBCOM=$ORDER(^LR(LRDFN,"MI",LRIDT,12,LAMBIEN,1,LAMBCOM))
if 'LAMBCOM
QUIT
Begin DoDot:2
+179 SET LAGETIEN=LAMBCOM_","_LAMBIEN_","_LRIDT_","_LRDFN
+180 KILL LARET,LAERR
+181 DO GETS^DIQ(63.4,LAGETIEN,".01","IE","LARET","LAERR")
+182 IF $DATA(LAERR("DIERR"))
KILL LAERR
QUIT
+183 MERGE @LAARRAY=LARET
End DoDot:2
+184 KILL LARET,LAERR
+185 SET LAFIXMB=2
+186 SET LAGETIEN=LAMBIEN_","_LRIDT_","_LRDFN
+187 FOR
SET LAFIXMB=$ORDER(^LR(LRDFN,"MI",LRIDT,12,LAMBIEN,LAFIXMB))
if 'LAFIXMB!(LAFIXMB'<3)
QUIT
Begin DoDot:2
+188 if $EXTRACT(LAFIXMB,1,4)'="2.00"
QUIT
+189 IF $LENGTH(LAFIXMB)<7
Begin DoDot:3
+190 SET LAMBFLD=$PIECE($$DECODEMB^LA7UTL1B(LAFIXMB),U,2)
+191 IF LAMBFLD=""
QUIT
+192 SET LAMBFLD1=$PIECE(LAMBFLD,"~",2)
+193 SET LAMBFLD=$PIECE(LAMBFLD,"~",1)
+194 KILL LARET,LAERR
+195 DO GETS^DIQ(63.39,LAGETIEN,LAMBFLD,"IE","LARET","LAERR")
+196 ;
+197 IF $DATA(LAERR("DIERR"))!('$DATA(LARET))
KILL LARET,LAERR
QUIT
+198 ;
+199 SET LAGETS=LAGETIEN_","
+200 SET LAMBRES=$GET(LARET(63.39,LAGETS,LAMBFLD,"I"))
+201 IF LAMBRES=""
KILL LARET(63.39,LAGETS,LAMBFLD)
QUIT
+202 SET LARET(63.39,LAGETS,LAMBFLD,"I")=LAMBFLD1_U_LAMBRES
+203 MERGE @LAARRAY=LARET
+204 ;
+205 ;
End DoDot:3
+206 IF $LENGTH(LAFIXMB)>6
Begin DoDot:3
+207 NEW LANAME,LATEST,LARET,LAERR,LAMBRES
+208 DO FIELD^DID(63.39,LAFIXMB,"","LABEL","LATEST")
+209 IF '$DATA(LATEST("LABEL"))
QUIT
+210 SET LANAME=LATEST("LABEL")
+211 KILL LARET,LAERR
+212 DO GETS^DIQ(63.39,LAGETIEN,LAFIXMB,"IE","LARET","LAERR")
+213 ;
+214 IF $DATA(LAERR("DIERR"))!('$DATA(LARET))
KILL LAERR
QUIT
+215 SET LAGETS=LAGETIEN_","
+216 SET LAMBRES=$GET(LARET(63.39,LAGETS,LAFIXMB,"I"))
+217 IF LAMBRES=""
KILL LARET(63.39,LAGETS,LAFIXMB)
QUIT
+218 if LAMBRES'=""
SET LARET(63.39,LAGETS,LAFIXMB,"I")=LANAME_U_LAMBRES
+219 MERGE @LAARRAY=LARET
End DoDot:3
End DoDot:2
End DoDot:1
+220 ;
+221 ; ---Virus
+222 ;
+223 SET LAVIEN=0
+224 FOR
SET LAVIEN=$ORDER(^LR(LRDFN,"MI",LRIDT,17,LAVIEN))
if 'LAVIEN
QUIT
Begin DoDot:1
+225 SET LAGETIEN=LAVIEN_","_LRIDT_","_LRDFN
+226 KILL LARET,LAERR
+227 DO GETS^DIQ(63.43,LAGETIEN,".01","IE","LARET","LAERR")
+228 IF $DATA(LAERR("DIERR"))
KILL LAERR
QUIT
+229 MERGE @LAARRAY=LARET
+230 KILL LARET,LAERR
End DoDot:1
+231 ;
+232 ; ---Parasitology Smear/Prep
+233 ;
+234 SET LAPSPIEN=0
+235 FOR
SET LAPSPIEN=$ORDER(^LR(LRDFN,"MI",LRIDT,24,LAPSPIEN))
if 'LAPSPIEN
QUIT
Begin DoDot:1
+236 SET LAGETIEN=LAPSPIEN_","_LRIDT_","_LRDFN
+237 KILL LARET,LAERR
+238 DO GETS^DIQ(63.341,LAGETIEN,".01","IE","LARET","LAERR")
+239 IF $DATA(LAERR("DIERR"))
KILL LAERR
QUIT
+240 MERGE @LAARRAY=LARET
+241 KILL LARET,LAERR
End DoDot:1
+242 ;
+243 ; ---Bacteriology Smear/Prep
+244 ;
+245 SET LABSPIEN=0
+246 FOR
SET LABSPIEN=$ORDER(^LR(LRDFN,"MI",LRIDT,25,LABSPIEN))
if 'LABSPIEN
QUIT
Begin DoDot:1
+247 SET LAGETIEN=LABSPIEN_","_LRIDT_","_LRDFN
+248 KILL LARET,LAERR
+249 DO GETS^DIQ(63.291,LAGETIEN,".01","IE","LARET","LAERR")
+250 IF $DATA(LAERR("DIERR"))
KILL LAERR
QUIT
+251 MERGE @LAARRAY=LARET
+252 KILL LARET,LAERR
End DoDot:1
+253 ;
+254 ; ---Mycology Smear/Prep
+255 ;
+256 SET LAMSPIEN=0
+257 FOR
SET LAMSPIEN=$ORDER(^LR(LRDFN,"MI",LRIDT,15,LAMSPIEN))
if 'LAMSPIEN
QUIT
Begin DoDot:1
+258 SET LAGETIEN=LAMSPIEN_","_LRIDT_","_LRDFN
+259 KILL LARET,LAERR
+260 DO GETS^DIQ(63.371,LAGETIEN,".01","IE","LARET","LAERR")
+261 IF $DATA(LAERR("DIERR"))
KILL LAERR
QUIT
+262 MERGE @LAARRAY=LARET
+263 KILL LARET,LAERR
End DoDot:1
+264 ;
+265 ; ---Virology RPT
+266 ;
+267 SET LAVRRIEN=0
+268 FOR
SET LAVRRIEN=$ORDER(^LR(LRDFN,"MI",LRIDT,18,LAVRRIEN))
if 'LAVRRIEN
QUIT
Begin DoDot:1
+269 SET LAGETIEN=LAVRRIEN_","_LRIDT_","_LRDFN
+270 KILL LARET,LAERR
+271 DO GETS^DIQ(63.44,LAGETIEN,".01","IE","LARET","LAERR")
+272 IF $DATA(LAERR("DIERR"))
KILL LAERR
QUIT
+273 MERGE @LAARRAY=LARET
+274 KILL LARET,LAERR
End DoDot:1
+275 ;
+276 QUIT
+277 ;
