- LR7OB63B ; IHS/DIR/AAB - Get Micro (Parasite, Virology, TB, Mycology) ; [ 8/11/97 ]
- ;;5.2;LR;**1003**;JUN 01, 1998
- ;
- ;;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
- LR7OB63B ; IHS/DIR/AAB - Get Micro (Parasite, Virology, TB, Mycology) ; [ 8/11/97 ]
- +1 ;;5.2;LR;**1003**;JUN 01, 1998
- +2 ;
- +3 ;;5.2;LAB SERVICE;**121**;Sep 27, 1994
- +4 ;
- 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
