LR7OB63B ;slc/dcm - Get Micro (Parasite, Virology, TB, Mycology) ;8/11/97
;;5.2;LAB SERVICE;**121**;Sep 27, 1994
;
MI ;Microbiology
I $D(^LR(LRDFN,"MI",IVDT,5)) S X=^(5) D ;Parasite
. Q:'$L($P(X,"^"))
. S IFN=0 F S IFN=$O(^LR(LRDFN,"MI",IVDT,24,IFN)) Q:IFN<1 S X1=^(IFN,0),Y1="PARASITOLOGY SMEAR/PREP",Y2=X1,CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_$P(X,"^",2)_"^^^^^^^^^"_Y1_"^^^"_Y18
. S IFN=0 F S IFN=$O(^LR(LRDFN,"MI",IVDT,6,IFN)) Q:IFN<1 S X1=^(IFN,0),Y1="Parasite",X2=$P(^LAB(61.2,+X1,0),"^") D
.. S IFN1=0 F S IFN1=$O(^LR(LRDFN,"MI",IVDT,6,IFN,1,IFN1)) Q:IFN1<1 S X3=^(IFN1,0) D
... S Y2=X2_" Stage: "_$P($P(";"_$P(^DD(63.35,.01,0),"^",3),";"_$P(X3,"^")_":",2),";")_$S($L($P(X3,"^",2)):" Quantity: "_$P(X3,"^",2),1:""),CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_$P(X,"^",2)_"^^^^^^^^^"_Y1_"^^^"_Y18
... S IFN2=0 F S IFN2=$O(^LR(LRDFN,"MI",IVDT,6,IFN,1,IFN1,1,IFN2)) Q:IFN2<1 S X1=^(IFN2,0),Y1="Comment",Y2=X1,CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_$P(X,"^",2)_"^^^^^^^^^"_Y1_"^^^"_Y18
. S IFN=0 F S IFN=$O(^LR(LRDFN,"MI",IVDT,7,IFN)) Q:IFN<1 S X1=^(IFN,0),Y1="Parasitology Remark(s)",Y2=X1,CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_$P(X,"^",2)_"^^^^^^^^^"_Y1_"^^^"_Y18
;
I $D(^LR(LRDFN,"MI",IVDT,16)) S X=^(16) D ;Virology
. Q:'$L($P(X,"^"))
. S IFN=0 F S IFN=$O(^LR(LRDFN,"MI",IVDT,17,IFN)) Q:IFN<1 S X1=^(IFN,0),Y1="Virus",Y2=$P(^LAB(61.2,$P(X1,"^"),0),"^"),CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_$P(X,"^",2)_"^^^^^^^^^"_Y1_"^^^"_Y18
. S IFN=0 F S IFN=$O(^LR(LRDFN,"MI",IVDT,18,IFN)) Q:IFN<1 S X1=^(IFN,0),Y1="Virology Remark(s)",Y2=X1,CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_$P(X,"^",2)_"^^^^^^^^^"_Y1_"^^^"_Y18
;
I $D(^LR(LRDFN,"MI",IVDT,11)) S X=^(11) D ;TB
. Q:'$L($P(X,"^"))
. S X1=$P(X,"^",3),Y1="MYCOBACTERIOLOGY "_$S(X1["D":"Direct",X1["C":"Concentrate",1:"")_" Acid Fast Stain: "_$S(X1["P":"Positive",X1["N":"Negative",1:X1)_$S($P(X,"^",4):" Quantity: "_$P(X,"^",4),1:"")
. S IFN=0 F S IFN=$O(^LR(LRDFN,"MI",IVDT,12,IFN)) Q:IFN<1 S X1=^(IFN,0) D
.. S X2=$P(^LAB(61.2,+X1,0),"^"),Y1="Mycobacterium: "_X2_$S($P(X1,"^",2):" Quantity: "_$P(X1,"^",2),1:""),CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^^^^^"_$P(X,"^",2)_"^^^^^^^^^"_Y1_"^^^"_Y18
.. S IFN1=0 F S IFN1=$O(^LR(LRDFN,"MI",IVDT,12,IFN,1,IFN1)) Q:IFN1<1 S X1=^(IFN1,0),CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=X1_"^^^^^^^^^^^^^^"_X1_"^^^"_Y1_"^^^"_Y18
.. S IFN1=2
.. F S IFN1=$O(^LR(LRDFN,"MI",IVDT,12,IFN,IFN1)) Q:IFN1<1!(IFN1'["2.") S Y2=^(IFN1),Y1=$O(^DD(63.39,"GL",IFN1,1,0)),Y1=$P(^DD(63.39,Y1,0),"^"),CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_$P(X,"^",2)_"^^^^^^^^^"_Y1_"^^^"_Y18
. S IFN=0 F S IFN=$O(^LR(LRDFN,"MI",IVDT,13,IFN)) Q:IFN<1 S X1=^(IFN,0),Y1="Mycobacteriology Remark(s)",Y2=X1,CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_$P(X,"^",2)_"^^^^^^^^^"_Y1_"^^^"_Y18
;
I $D(^LR(LRDFN,"MI",IVDT,8)) S X=^(8) D ;Mycology
. Q:'$L($P(X,"^")) N IFN
. S IFN=0 F S IFN=$O(^LR(LRDFN,"MI",IVDT,15,IFN)) Q:IFN<1 S X1=^(IFN,0),Y1="MYCOLOGY SMEAR/PREP",Y2=X1,CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_$P(X,"^",2)_"^^^^^^^^^"_Y1_"^^^"_Y18
. S IFN=0 F S IFN=$O(^LR(LRDFN,"MI",IVDT,9,IFN)) Q:IFN<1 S X1=^(IFN,0) D
.. S X2=$P(^LAB(61.2,+X1,0),"^"),Y1="Fungus/Yeast",Y2=X2_$S($P(X1,"^",2):" Quantity: "_$P(X1,"^",2),1:""),CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_$P(X,"^",2)_"^^^^^^^^^"_Y1_"^^^"_Y18
.. S IFN1=0 F S IFN1=$O(^LR(LRDFN,"MI",IVDT,9,IFN,1,IFN1)) Q:IFN1<1 S X1=^(IFN1,0),CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^"_X1_"^^^^"_$P(X,"^",2)_"^^^^^^^^^"_Y1_"^^^"_Y18
. S IFN=0 F S IFN=$O(^LR(LRDFN,"MI",IVDT,10,IFN)) Q:IFN<1 S X1=^(IFN,0),Y1="Mycology Remark(s)",Y2=X1,CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_$P(X,"^",2)_"^^^^^^^^^"_Y1_"^^^"_Y18
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR7OB63B 3931 printed Dec 13, 2024@02:04:50 Page 2
LR7OB63B ;slc/dcm - Get Micro (Parasite, Virology, TB, Mycology) ;8/11/97
+1 ;;5.2;LAB SERVICE;**121**;Sep 27, 1994
+2 ;
MI ;Microbiology
+1 ;Parasite
IF $DATA(^LR(LRDFN,"MI",IVDT,5))
SET X=^(5)
Begin DoDot:1
+2 if '$LENGTH($PIECE(X,"^"))
QUIT
+3 SET IFN=0
FOR
SET IFN=$ORDER(^LR(LRDFN,"MI",IVDT,24,IFN))
if IFN<1
QUIT
SET X1=^(IFN,0)
SET Y1="PARASITOLOGY SMEAR/PREP"
SET Y2=X1
SET CTR1=CTR1+1
SET ^TMP("LRX",$JOB,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_$PIECE(X,"^",2)_"^^^^^^^^^"_Y1_"^^^"_Y18
+4 SET IFN=0
FOR
SET IFN=$ORDER(^LR(LRDFN,"MI",IVDT,6,IFN))
if IFN<1
QUIT
SET X1=^(IFN,0)
SET Y1="Parasite"
SET X2=$PIECE(^LAB(61.2,+X1,0),"^")
Begin DoDot:2
+5 SET IFN1=0
FOR
SET IFN1=$ORDER(^LR(LRDFN,"MI",IVDT,6,IFN,1,IFN1))
if IFN1<1
QUIT
SET X3=^(IFN1,0)
Begin DoDot:3
+6 SET Y2=X2_" Stage: "_$PIECE($PIECE(";"_$PIECE(^DD(63.35,.01,0),"^",3),";"_$PIECE(X3,"^")_":",2),";")_$SELECT($LENGTH($PIECE(X3,"^",2)):" Quantity: "_$PIECE(X3,"^",2),1:"")
SET CTR1=CTR1+1
SET ^TMP("LRX",$JOB,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_$PIECE(X,"^",2)_"^^^^^^^^^"_Y1_"^^^"_Y18
+7 SET IFN2=0
FOR
SET IFN2=$ORDER(^LR(LRDFN,"MI",IVDT,6,IFN,1,IFN1,1,IFN2))
if IFN2<1
QUIT
SET X1=^(IFN2,0)
SET Y1="Comment"
SET Y2=X1
SET CTR1=CTR1+1
SET ^TMP("LRX",$JOB,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_$PIECE(X,"^",2)_"^^^^^^^^^"_Y1_"^^^"_Y18
End DoDot:3
End DoDot:2
+8 SET IFN=0
FOR
SET IFN=$ORDER(^LR(LRDFN,"MI",IVDT,7,IFN))
if IFN<1
QUIT
SET X1=^(IFN,0)
SET Y1="Parasitology Remark(s)"
SET Y2=X1
SET CTR1=CTR1+1
SET ^TMP("LRX",$JOB,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_$PIECE(X,"^",2)_"^^^^^^^^^"_Y1_"^^^"_Y18
End DoDot:1
+9 ;
+10 ;Virology
IF $DATA(^LR(LRDFN,"MI",IVDT,16))
SET X=^(16)
Begin DoDot:1
+11 if '$LENGTH($PIECE(X,"^"))
QUIT
+12 SET IFN=0
FOR
SET IFN=$ORDER(^LR(LRDFN,"MI",IVDT,17,IFN))
if IFN<1
QUIT
SET X1=^(IFN,0)
SET Y1="Virus"
SET Y2=$PIECE(^LAB(61.2,$PIECE(X1,"^"),0),"^")
SET CTR1=CTR1+1
SET ^TMP("LRX",$JOB,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_$PIECE(X,"^",2)_"^^^^^^^^^"_Y1_"^^^"_Y18
+13 SET IFN=0
FOR
SET IFN=$ORDER(^LR(LRDFN,"MI",IVDT,18,IFN))
if IFN<1
QUIT
SET X1=^(IFN,0)
SET Y1="Virology Remark(s)"
SET Y2=X1
SET CTR1=CTR1+1
SET ^TMP("LRX",$JOB,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_$PIECE(X,"^",2)_"^^^^^^^^^"_Y1_"^^^"_Y18
End DoDot:1
+14 ;
+15 ;TB
IF $DATA(^LR(LRDFN,"MI",IVDT,11))
SET X=^(11)
Begin DoDot:1
+16 if '$LENGTH($PIECE(X,"^"))
QUIT
+17 SET X1=$PIECE(X,"^",3)
SET Y1="MYCOBACTERIOLOGY "_$SELECT(X1["D":"Direct",X1["C":"Concentrate",1:"")_" Acid Fast Stain: "_$SELECT(X1["P":"Positive",X1["N":"Negative",1:X1)_$SELECT($PIECE(X,"^",4):" Quantity: "_$PIECE(X,"^",4),1:"")
+18 SET IFN=0
FOR
SET IFN=$ORDER(^LR(LRDFN,"MI",IVDT,12,IFN))
if IFN<1
QUIT
SET X1=^(IFN,0)
Begin DoDot:2
+19 SET X2=$PIECE(^LAB(61.2,+X1,0),"^")
SET Y1="Mycobacterium: "_X2_$SELECT($PIECE(X1,"^",2):" Quantity: "_$PIECE(X1,"^",2),1:"")
SET CTR1=CTR1+1
SET ^TMP("LRX",$JOB,69,CTR,63,CTR1)=Y1_"^^^^^"_$PIECE(X,"^",2)_"^^^^^^^^^"_Y1_"^^^"_Y18
+20 SET IFN1=0
FOR
SET IFN1=$ORDER(^LR(LRDFN,"MI",IVDT,12,IFN,1,IFN1))
if IFN1<1
QUIT
SET X1=^(IFN1,0)
SET CTR1=CTR1+1
SET ^TMP("LRX",$JOB,69,CTR,63,CTR1)=X1_"^^^^^^^^^^^^^^"_X1_"^^^"_Y1_"^^^"_Y18
+21 SET IFN1=2
+22 FOR
SET IFN1=$ORDER(^LR(LRDFN,"MI",IVDT,12,IFN,IFN1))
if IFN1<1!(IFN1'["2.")
QUIT
SET Y2=^(IFN1)
SET Y1=$ORDER(^DD(63.39,"GL",IFN1,1,0))
SET Y1=$PIECE(^DD(63.39,Y1,0),"^")
SET CTR1=CTR1+1
SET ^TMP("LRX",$JOB,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_$PIECE(X,"^",2)_"^^^^^^^^^"_Y1_"^^^"_Y18
End DoDot:2
+23 SET IFN=0
FOR
SET IFN=$ORDER(^LR(LRDFN,"MI",IVDT,13,IFN))
if IFN<1
QUIT
SET X1=^(IFN,0)
SET Y1="Mycobacteriology Remark(s)"
SET Y2=X1
SET CTR1=CTR1+1
SET ^TMP("LRX",$JOB,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_$PIECE(X,"^",2)_"^^^^^^^^^"_Y1_"^^^"_Y18
End DoDot:1
+24 ;
+25 ;Mycology
IF $DATA(^LR(LRDFN,"MI",IVDT,8))
SET X=^(8)
Begin DoDot:1
+26 if '$LENGTH($PIECE(X,"^"))
QUIT
NEW IFN
+27 SET IFN=0
FOR
SET IFN=$ORDER(^LR(LRDFN,"MI",IVDT,15,IFN))
if IFN<1
QUIT
SET X1=^(IFN,0)
SET Y1="MYCOLOGY SMEAR/PREP"
SET Y2=X1
SET CTR1=CTR1+1
SET ^TMP("LRX",$JOB,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_$PIECE(X,"^",2)_"^^^^^^^^^"_Y1_"^^^"_Y18
+28 SET IFN=0
FOR
SET IFN=$ORDER(^LR(LRDFN,"MI",IVDT,9,IFN))
if IFN<1
QUIT
SET X1=^(IFN,0)
Begin DoDot:2
+29 SET X2=$PIECE(^LAB(61.2,+X1,0),"^")
SET Y1="Fungus/Yeast"
SET Y2=X2_$SELECT($PIECE(X1,"^",2):" Quantity: "_$PIECE(X1,"^",2),1:"")
SET CTR1=CTR1+1
SET ^TMP("LRX",$JOB,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_$PIECE(X,"^",2)_"^^^^^^^^^"_Y1_"^^^"_Y18
+30 SET IFN1=0
FOR
SET IFN1=$ORDER(^LR(LRDFN,"MI",IVDT,9,IFN,1,IFN1))
if IFN1<1
QUIT
SET X1=^(IFN1,0)
SET CTR1=CTR1+1
SET ^TMP("LRX",$JOB,69,CTR,63,CTR1)=Y1_"^"_X1_"^^^^"_$PIECE(X,"^",2)_"^^^^^^^^^"_Y1_"^^^"_Y18
End DoDot:2
+31 SET IFN=0
FOR
SET IFN=$ORDER(^LR(LRDFN,"MI",IVDT,10,IFN))
if IFN<1
QUIT
SET X1=^(IFN,0)
SET Y1="Mycology Remark(s)"
SET Y2=X1
SET CTR1=CTR1+1
SET ^TMP("LRX",$JOB,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_$PIECE(X,"^",2)_"^^^^^^^^^"_Y1_"^^^"_Y18
End DoDot:1
+32 QUIT
