LR7OB63A ;slc/dcm - Get Micro (Antibiotic level, Bact, Sterility) ;8/11/97
;;5.2;LAB SERVICE;**121,153,187**;Sep 27, 1994
;
MI(SPECMEN) ;Microbiology
;SPECMEN=ptr to 61, to specify specimen
N X,Y1,Y2,Y3,Y4,Y5,Y6,Y18,Y19,CTR1,IF,IFN,IFN1,ORG,QU,SSD,SIC1,SBC1,TM1,SIC2,SBC2,TM2,X1,X2,X3
Q:'$D(^LR(LRDFN,"MI",+$G(IVDT),0)) S X0=^(0),Y6=$S(+$G(CORRECT):"C",$P(X0,"^",3):"F",1:""),Y19=$P(X0,"^",5),CTR1=0
I $G(SPECMEN),Y19'=SPECMEN Q
S Y18=";MI;"_IVDT
I $D(^LR(LRDFN,"MI",IVDT,14)) S IFN=0 D ;Antibiotic level
. F S IFN=$O(^LR(LRDFN,"MI",IVDT,14,IFN)) Q:IFN<1 S X=^(IFN,0) D
.. S Y1=$P(X,"^")_" ("_$S($P(X,"^",2)="P":"PEAK",$P(X,"^",2)="T":"TROUGH",1:"")_")",Y2=$P(X,"^",3),CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^"_"ug/ml"_"^^"_Y6_"^^^^^^^^^"_Y1_"^^^"_Y18_"^"_Y19
;
I $D(^LR(LRDFN,"MI",IVDT,1))#2 S X=^(1) D ;Bact
. S Y6=$S(+$G(CORRECT):"C",1:$P(X,"^",2))
. I $L($P(X,"^",5)) S Y1="SPUTUM SCREEN",Y2=$P(X,"^",5),CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_Y6_"^^^^^^^^^"_Y1_"^^^"_Y18_"^"_Y19
. I $L($P(X,"^",6)) S Y1="URINE SCREEN",Y2=$S($P(X,"^",6)="N":"Negative",$P(X,"^",6)="P":"Positive",1:$P(X,"^",6)),CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_Y6_"^^^^^^^^^"_Y1_"^^^"_Y18_"^"_Y19
. I $D(^LR(LRDFN,"MI",IVDT,2,0)) S Y1="GRAM STAIN",IFN=0 F S IFN=$O(^LR(LRDFN,"MI",IVDT,2,IFN)) Q:IFN<1 S Y2=^(IFN,0),CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_Y6_"^^^^^^^^^"_Y1_"^^^"_Y18_"^"_Y19
. I $D(^LR(LRDFN,"MI",IVDT,25,0)) S Y1="BACTERIOLOGY SMEAR/PREP",IFN=0 F S IFN=$O(^LR(LRDFN,"MI",IVDT,25,IFN)) Q:IFN<1 S Y2=^(IFN,0),CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_Y6_"^^^^^^^^^"_Y1_"^^^"_Y18_"^"_Y19
. I $D(^LR(LRDFN,"MI",IVDT,3,0)) S Y1="ORGANISM",IFN=0 D
.. F S IFN=$O(^LR(LRDFN,"MI",IVDT,3,IFN)) Q:IFN<1 S X=^(IFN,0),ORG=$P(X,"^"),ORG=$P($G(^LAB(61.2,+ORG,0)),"^"),QU=$P(X,"^",2),SSD=$P(X,"^",3,8) D
... I SSD'?."^" S SIC1=$P(SSD,"^"),SBC1=$P(SSD,"^",2),TM1=$P(SSD,"^",3),SIC2=$P(SSD,"^",4),SBC2=$P(SSD,"^",5),TM2=$P(SSD,"^",6),SSD=1
... I SSD S X1="" D S Y1=Y1_" "_X1
.... I $L(SIC1) S X1="SIT "_$S($L(TM1):"("_TM1_")",1:"")_": "_SIC1
.... I $L(SBC1) S X1=$S($L(X1):", ",1:"")_"SBT "_$S($L(TM1):"("_TM1_")",1:"")_": "_SBC1
.... I $L(SIC2) S X1=$S($L(X1):", ",1:"")_"SIT "_$S($L(TM2):"("_TM2_")",1:"")_": "_SIC2
.... I $L(SBC2) S X1=$S($L(X1):", ",1:"")_"SBT "_$S($L(TM2):"("_TM2_")",1:"")_": "_SBC2
... S Y2=ORG_";"_QU,CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_Y6_"^^^^^^^^^"_Y1_"^^^"_Y18_"^"_Y19
... S IF=0 F S IF=$O(^LR(LRDFN,"MI",IVDT,3,IFN,3,IF)) Q:IF<1 S X1=^(IF,0),Y1=$P(X1,"^"),Y2=$P(X1,"^",2)_";MIC^"_$P(X1,"^",3)_";MBC",CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^ug/ml^^"_Y6_"^^^^^^^^^"_Y1_"^^^"_Y18_"^"_Y19
... S IF=0 F S IF=$O(^LR(LRDFN,"MI",IVDT,3,IFN,1,IF)) Q:IF<1 S X=^(IF,0),^TMP("LRX",$J,69,CTR,63,"N",IF)=X
... S IF=2 F S IF=$O(^LR(LRDFN,"MI",IVDT,3,IFN,IF)) Q:IF<1!(IF'["2.") S X=^(IF),Y1=$P(X,"^",1),Y2=$P(X,"^",2),CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_Y6_"^^^^^^^^^"_Y1_"^^^"_Y18_"^"_Y19
. I $D(^LR(LRDFN,"MI",IVDT,4,0)) S Y1="Bacteriology Remark(s)",IFN=0 F S IFN=$O(^LR(LRDFN,"MI",IVDT,4,IFN)) Q:IFN<1 S Y2=^(IFN,0),CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_Y6_"^^^^^^^^^"_Y1_"^^^"_Y18_"^"_Y19
;
I $D(^LR(LRDFN,"MI",IVDT,31)) D ;Sterility
. S Y1="STERILITY CONTROL",Y2=$S($L($P(^LR(LRDFN,"MI",IVDT,1),"^",7)):$S($P(^(1),"^",7)="N":"Negative",1:"Positive"),1:""),CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_Y6_"^^^^^^^^^"_Y1_"^^^"_Y18_"^"_Y19
. S IFN=0 F S IFN=$O(^LR(LRDFN,"MI",IVDT,31,IFN)) Q:IFN<1 S X=^(IFN,0),Y2=X,CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_Y6_"^^^^^^^^^"_Y1_"^^^"_Y18_"^"_Y19
;
D MI^LR7OB63B
I $D(^LR(LRDFN,"MI",IVDT,99)) S Y1="Comments on Specimen",Y2=^(99),CTR1=CTR1+1,^TMP("LRX",$J,69,CTR,63,"N",CTR1)=Y1_": "_Y2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR7OB63A 3933 printed Dec 13, 2024@02:04:49 Page 2
LR7OB63A ;slc/dcm - Get Micro (Antibiotic level, Bact, Sterility) ;8/11/97
+1 ;;5.2;LAB SERVICE;**121,153,187**;Sep 27, 1994
+2 ;
MI(SPECMEN) ;Microbiology
+1 ;SPECMEN=ptr to 61, to specify specimen
+2 NEW X,Y1,Y2,Y3,Y4,Y5,Y6,Y18,Y19,CTR1,IF,IFN,IFN1,ORG,QU,SSD,SIC1,SBC1,TM1,SIC2,SBC2,TM2,X1,X2,X3
+3 if '$DATA(^LR(LRDFN,"MI",+$GET(IVDT),0))
QUIT
SET X0=^(0)
SET Y6=$SELECT(+$GET(CORRECT):"C",$PIECE(X0,"^",3):"F",1:"")
SET Y19=$PIECE(X0,"^",5)
SET CTR1=0
+4 IF $GET(SPECMEN)
IF Y19'=SPECMEN
QUIT
+5 SET Y18=";MI;"_IVDT
+6 ;Antibiotic level
IF $DATA(^LR(LRDFN,"MI",IVDT,14))
SET IFN=0
Begin DoDot:1
+7 FOR
SET IFN=$ORDER(^LR(LRDFN,"MI",IVDT,14,IFN))
if IFN<1
QUIT
SET X=^(IFN,0)
Begin DoDot:2
+8 SET Y1=$PIECE(X,"^")_" ("_$SELECT($PIECE(X,"^",2)="P":"PEAK",$PIECE(X,"^",2)="T":"TROUGH",1:"")_")"
SET Y2=$PIECE(X,"^",3)
SET CTR1=CTR1+1
SET ^TMP("LRX",$JOB,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^"_"ug/ml"_"^^"_Y6_"^^^^^^^^^"_Y1_"^^^"_Y18_"^"_Y19
End DoDot:2
End DoDot:1
+9 ;
+10 ;Bact
IF $DATA(^LR(LRDFN,"MI",IVDT,1))#2
SET X=^(1)
Begin DoDot:1
+11 SET Y6=$SELECT(+$GET(CORRECT):"C",1:$PIECE(X,"^",2))
+12 IF $LENGTH($PIECE(X,"^",5))
SET Y1="SPUTUM SCREEN"
SET Y2=$PIECE(X,"^",5)
SET CTR1=CTR1+1
SET ^TMP("LRX",$JOB,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_Y6_"^^^^^^^^^"_Y1_"^^^"_Y18_"^"_Y19
+13 IF $LENGTH($PIECE(X,"^",6))
SET Y1="URINE SCREEN"
SET Y2=$SELECT($PIECE(X,"^",6)="N":"Negative",$PIECE(X,"^",6)="P":"Positive",1:$PIECE(X,"^",6))
SET CTR1=CTR1+1
SET ^TMP("LRX",$JOB,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_Y6_"^^^^^^^^^"_Y1_"^^^"_Y18_"^"_Y19
+14 IF $DATA(^LR(LRDFN,"MI",IVDT,2,0))
SET Y1="GRAM STAIN"
SET IFN=0
FOR
SET IFN=$ORDER(^LR(LRDFN,"MI",IVDT,2,IFN))
if IFN<1
QUIT
SET Y2=^(IFN,0)
SET CTR1=CTR1+1
SET ^TMP("LRX",$JOB,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_Y6_"^^^^^^^^^"_Y1_"^^^"_Y18_"^"_Y19
+15 IF $DATA(^LR(LRDFN,"MI",IVDT,25,0))
SET Y1="BACTERIOLOGY SMEAR/PREP"
SET IFN=0
FOR
SET IFN=$ORDER(^LR(LRDFN,"MI",IVDT,25,IFN))
if IFN<1
QUIT
SET Y2=^(IFN,0)
SET CTR1=CTR1+1
SET ^TMP("LRX",$JOB,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_Y6_"^^^^^^^^^"_Y1_"^^^"_Y18_"^"_Y19
+16 IF $DATA(^LR(LRDFN,"MI",IVDT,3,0))
SET Y1="ORGANISM"
SET IFN=0
Begin DoDot:2
+17 FOR
SET IFN=$ORDER(^LR(LRDFN,"MI",IVDT,3,IFN))
if IFN<1
QUIT
SET X=^(IFN,0)
SET ORG=$PIECE(X,"^")
SET ORG=$PIECE($GET(^LAB(61.2,+ORG,0)),"^")
SET QU=$PIECE(X,"^",2)
SET SSD=$PIECE(X,"^",3,8)
Begin DoDot:3
+18 IF SSD'?."^"
SET SIC1=$PIECE(SSD,"^")
SET SBC1=$PIECE(SSD,"^",2)
SET TM1=$PIECE(SSD,"^",3)
SET SIC2=$PIECE(SSD,"^",4)
SET SBC2=$PIECE(SSD,"^",5)
SET TM2=$PIECE(SSD,"^",6)
SET SSD=1
+19 IF SSD
SET X1=""
Begin DoDot:4
+20 IF $LENGTH(SIC1)
SET X1="SIT "_$SELECT($LENGTH(TM1):"("_TM1_")",1:"")_": "_SIC1
+21 IF $LENGTH(SBC1)
SET X1=$SELECT($LENGTH(X1):", ",1:"")_"SBT "_$SELECT($LENGTH(TM1):"("_TM1_")",1:"")_": "_SBC1
+22 IF $LENGTH(SIC2)
SET X1=$SELECT($LENGTH(X1):", ",1:"")_"SIT "_$SELECT($LENGTH(TM2):"("_TM2_")",1:"")_": "_SIC2
+23 IF $LENGTH(SBC2)
SET X1=$SELECT($LENGTH(X1):", ",1:"")_"SBT "_$SELECT($LENGTH(TM2):"("_TM2_")",1:"")_": "_SBC2
End DoDot:4
SET Y1=Y1_" "_X1
+24 SET Y2=ORG_";"_QU
SET CTR1=CTR1+1
SET ^TMP("LRX",$JOB,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_Y6_"^^^^^^^^^"_Y1_"^^^"_Y18_"^"_Y19
+25 SET IF=0
FOR
SET IF=$ORDER(^LR(LRDFN,"MI",IVDT,3,IFN,3,IF))
if IF<1
QUIT
SET X1=^(IF,0)
SET Y1=$PIECE(X1,"^")
SET Y2=$PIECE(X1,"^",2)_";MIC^"_$PIECE(X1,"^",3)_";MBC"
SET CTR1=CTR1+1
SET ^TMP("LRX",$JOB,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^ug/ml^^"_Y6_"^^^^^^^^^"_Y1_"^^^"_Y18_"^"_Y19
+26 SET IF=0
FOR
SET IF=$ORDER(^LR(LRDFN,"MI",IVDT,3,IFN,1,IF))
if IF<1
QUIT
SET X=^(IF,0)
SET ^TMP("LRX",$JOB,69,CTR,63,"N",IF)=X
+27 SET IF=2
FOR
SET IF=$ORDER(^LR(LRDFN,"MI",IVDT,3,IFN,IF))
if IF<1!(IF'["2.")
QUIT
SET X=^(IF)
SET Y1=$PIECE(X,"^",1)
SET Y2=$PIECE(X,"^",2)
SET CTR1=CTR1+1
SET ^TMP("LRX",$JOB,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_Y6_"^^^^^^^^^"_Y1_"^^^"_Y18_"^"_Y19
End DoDot:3
End DoDot:2
+28 IF $DATA(^LR(LRDFN,"MI",IVDT,4,0))
SET Y1="Bacteriology Remark(s)"
SET IFN=0
FOR
SET IFN=$ORDER(^LR(LRDFN,"MI",IVDT,4,IFN))
if IFN<1
QUIT
SET Y2=^(IFN,0)
SET CTR1=CTR1+1
SET ^TMP("LRX",$JOB,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_Y6_"^^^^^^^^^"_Y1_"^^^"_Y18_"^"_Y19
End DoDot:1
+29 ;
+30 ;Sterility
IF $DATA(^LR(LRDFN,"MI",IVDT,31))
Begin DoDot:1
+31 SET Y1="STERILITY CONTROL"
SET Y2=$SELECT($LENGTH($PIECE(^LR(LRDFN,"MI",IVDT,1),"^",7)):$SELECT($PIECE(^(1),"^",7)="N":"Negative",1:"Positive"),1:"")
SET CTR1=CTR1+1
SET ^TMP("LRX",$JOB,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_Y6_"^^^^^^^^^"_Y1_"^^^"_Y18_"^"_Y19
+32 SET IFN=0
FOR
SET IFN=$ORDER(^LR(LRDFN,"MI",IVDT,31,IFN))
if IFN<1
QUIT
SET X=^(IFN,0)
SET Y2=X
SET CTR1=CTR1+1
SET ^TMP("LRX",$JOB,69,CTR,63,CTR1)=Y1_"^"_Y2_"^^^^"_Y6_"^^^^^^^^^"_Y1_"^^^"_Y18_"^"_Y19
End DoDot:1
+33 ;
+34 DO MI^LR7OB63B
+35 IF $DATA(^LR(LRDFN,"MI",IVDT,99))
SET Y1="Comments on Specimen"
SET Y2=^(99)
SET CTR1=CTR1+1
SET ^TMP("LRX",$JOB,69,CTR,63,"N",CTR1)=Y1_": "_Y2
+36 QUIT
