Routine: LA7UTL1C

LA7UTL1C ;VA/HOIFO/BH - Microbiology Query Utility ;JUL 06, 2010 3:14 PM

 ;;5.2;AUTOMATED LAB INSTRUMENTS;**69,1027**;NOV 01, 1997

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

LA7UTL1C  ;VA/HOIFO/BH - Microbiology Query Utility ;JUL 06, 2010 3:14 PM

 +1       ;;5.2;AUTOMATED LAB INSTRUMENTS;**69,1027**;NOV 01, 1997

 +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     ;

LA7UTL1C.m