BLRALBM2 ;DAOU/ALA-Build Micro results for STERILITY, PARASITES, VIRUS
;;5.2T9;LR;**1013,1015,1018**;Nov 17, 2004
;;5.2;LR;**1013,1015**;Nov 18, 2002
;
;
;
STER ;EP
I $L($P($G(^LR(LRDFN,"MI",LRIDT,1)),U,7)) D
. S BLRAZ="STERILITY CONTROL: "_$S($P(^(1),U,7)="N":"NEGATIVE",1:"POSITIVE")
. S BLRADSP=BLRADSP+1,^TMP($J,"BLRA",BLRADSP,0)=BLRAZ
;
;S DIC="^LR("_LRDFN_",""MI"",",DA=LRIDT,DR=31 D EN^DIQ S:$D(DTOUT)!($D(DUOUT)) LREND=1
Q
;
PARA ;EP
I '$L($P($G(^LR(LRDFN,"MI",LRIDT,5)),U)) Q:'$D(LRWRDVEW) Q:LRSB'=5
S LRTUS=$P($G(^LR(LRDFN,"MI",LRIDT,5)),U,2),DZ=$P($G(^(5)),U,3),Y=$P($G(^(5)),U) D D^LRU
S BLRAZ="* PARASITOLOGY "_$S(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")_" REPORT => "_Y_" TECH CODE: "_DZ
S BLRADSP=BLRADSP+1,^TMP($J,"BLRA",BLRADSP,0)=BLRAZ
S LRPRE=21 D PRE^BLRALBM1
I $D(^LR(LRDFN,"MI",LRIDT,24)) D
. S BLRAZ="PARASITOLOGY SMEAR/PREP:"
. S BLRADSP=BLRADSP+1,^TMP($J,"BLRA",BLRADSP,0)=BLRAZ
. S LRMYC=0 F S LRMYC=+$O(^LR(LRDFN,"MI",LRIDT,24,LRMYC)) Q:LRMYC<1 D
.. ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018 -- BLRBLKS should be BLRABLKS (MKK)
.. ; S BLRADSP=BLRADSP+1,^TMP($J,"BLRA",BLRADSP,0)=$E(BLRBLKS,1,5)_$G(^LR(LRDFN,"MI",LRIDT,24,LRMYC,0))
.. S BLRADSP=BLRADSP+1,^TMP($J,"BLRA",BLRADSP,0)=$E(BLRABLKS,1,5)_$G(^LR(LRDFN,"MI",LRIDT,24,LRMYC,0))
.. ;----- END IHS MODIFICATIONS LR*5.2*1018 -- BLRBLKS should be BLRABLKS (MKK)
S LRPAR=0 F S LRPAR=+$O(^LR(LRDFN,"MI",LRIDT,6,LRPAR)) Q:LRPAR<1 D
. S BLRAPAR=$G(^LR(LRDFN,"MI",LRIDT,6,LRPAR,0))
. S BLRAZ="Parasite: "_$E($P($G(^LAB(61.2,BLRAPAR,0)),U),1,25)
. S BLRADSP=BLRADSP+1,^TMP($J,"BLRA",BLRADSP,0)=BLRAZ
. S BLRAZ1=30 D Z1 D STG
I $D(^LR(LRDFN,"MI",LRIDT,7,0)),$P($G(^(0)),U,4)>0 D
. S BLRAZ="Parasitology Remark(s):"
. S BLRADSP=BLRADSP+1,^TMP($J,"BLRA",BLRADSP,0)=BLRAZ
. S LRPAR=0 F S LRPAR=+$O(^LR(LRDFN,"MI",LRIDT,7,LRPAR)) Q:LRPAR<1 D
.. S BLRADSP=BLRADSP+1,^TMP($J,"BLRA",BLRADSP,0)=$E(BLRABLKS,1,3)_$G(^LR(LRDFN,"MI",LRIDT,7,LRPAR,0))
Q
;
STG S LRBUG(LRPAR)=$G(^LR(LRDFN,"MI",LRIDT,6,LRPAR,0)),S1=6,LRTA=LRPAR
I $D(^LR(LRDFN,"MI",LRIDT,S1,LRTA,1,0)) D
. S B=0 F S B=+$O(^LR(LRDFN,"MI",LRIDT,S1,LRTA,1,B)) Q:B<1 D
.. S Y=$G(^LR(LRDFN,"MI",LRIDT,S1,LRTA,1,B,0)),Y1=$P(Y,U,2)
.. S BLRAZ=" Stage: " D SET
.. S BLRADSP=BLRADSP+1,^TMP($J,"BLRA",BLRADSP,0)=BLRAZ
.. I $L(Y1) S BLRAZ=" Quantity: "_Y1
.. S BLRADSP=BLRADSP+1,^TMP($J,"BLRA",BLRADSP,0)=BLRAZ
.. D LIST1
Q
;
SET S LRSET=$P($G(^DD(63.35,.01,0)),U,3)
S %=$P($P(";"_LRSET,";"_$P(Y,U)_":",2),";") I %]"" S BLRAZ=BLRAZ_%
Q
;
LIST1 S BLRAZ=" Comment: "
S BLRADSP=BLRADSP+1,^TMP($J,"BLRA",BLRADSP,0)=BLRAZ
S C=0 F S C=+$O(^LR(LRDFN,"MI",LRIDT,S1,LRTA,1,B,1,C)) Q:C<1 D
. S BLRAZ1=13 D Z1 S BLRAZ=BLRAZ_$G(^LR(LRDFN,"MI",LRIDT,S1,LRTA,1,B,1,C,0))
. S BLRADSP=BLRADSP+1,^TMP($J,"BLRA",BLRADSP,0)=BLRAZ,BLRAZ=$E(BLRABLKS,1,13)
Q
;
VIR ;EP
I '$L($P($G(^LR(LRDFN,"MI",LRIDT,16)),U)) Q:'$D(LRWRDVEW) Q:LRSB'=16
S LRTUS=$P($G(^LR(LRDFN,"MI",LRIDT,16)),U,2),DZ=$P($G(^(16)),U,3),Y=$P($G(^(16)),U) D D^LRU
S BLRAZ="* VIROLOGY "_$S(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")_" REPORT => "_Y_" TECH CODE: "_DZ
S LRPRE=20 D PRE^BLRALBM1
S LRPAR=0 F S LRPAR=+$O(^LR(LRDFN,"MI",LRIDT,17,LRPAR)) Q:LRPAR<1 D
.;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
.S BLRAZ="Virus: "_$P($G(^LAB(61.2,$P($G(^(LRPAR,0)),U),0)),U)
.S LRBUG(LRPAR)=$G(^LR(LRDFN,"MI",LRIDT,17,LRPAR,0))
.;----- END IHS MODIFICATIONS ERROR REPORTED AT AIH
.;----- ADDED "." TO PREVIOUS TWO LINES
I $D(^LR(LRDFN,"MI",LRIDT,18,0)),$P(^(0),U,4)>0 D
. S BLRAZ="Virology Remark(s):" S LRPAR=0
. F S LRPAR=+$O(^LR(LRDFN,"MI",LRIDT,18,LRPAR)) Q:LRPAR<1 D
.. S BLRADSP=BLRADSP+1,^TMP($J,"BLRA",BLRADSP,0)=$E(BLRABLKS,1,3)_$G(^LR(LRDFN,"MI",LRIDT,18,LRPAR,0))
Q
;
Z1 ; Pad with trailing spaces
F BLRAI=1:1:(BLRAZ1-$L(BLRAZ)) S BLRAZ=BLRAZ_" "
Q
BLRALBM2 ;DAOU/ALA-Build Micro results for STERILITY, PARASITES, VIRUS
+1 ;;5.2T9;LR;**1013,1015,1018**;Nov 17, 2004
+2 ;;5.2;LR;**1013,1015**;Nov 18, 2002
+3 ;
+4 ;
+5 ;
STER ;EP
+1 IF $LENGTH($PIECE($GET(^LR(LRDFN,"MI",LRIDT,1)),U,7))
Begin DoDot:1
+2 SET BLRAZ="STERILITY CONTROL: "_$SELECT($PIECE(^(1),U,7)="N":"NEGATIVE",1:"POSITIVE")
+3 SET BLRADSP=BLRADSP+1
SET ^TMP($JOB,"BLRA",BLRADSP,0)=BLRAZ
End DoDot:1
+4 ;
+5 ;S DIC="^LR("_LRDFN_",""MI"",",DA=LRIDT,DR=31 D EN^DIQ S:$D(DTOUT)!($D(DUOUT)) LREND=1
+6 QUIT
+7 ;
PARA ;EP
+1 IF '$LENGTH($PIECE($GET(^LR(LRDFN,"MI",LRIDT,5)),U))
IF '$DATA(LRWRDVEW)
QUIT
IF LRSB'=5
QUIT
+2 SET LRTUS=$PIECE($GET(^LR(LRDFN,"MI",LRIDT,5)),U,2)
SET DZ=$PIECE($GET(^(5)),U,3)
SET Y=$PIECE($GET(^(5)),U)
DO D^LRU
+3 SET BLRAZ="* PARASITOLOGY "_$SELECT(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")_" REPORT => "_Y_" TECH CODE: "_DZ
+4 SET BLRADSP=BLRADSP+1
SET ^TMP($JOB,"BLRA",BLRADSP,0)=BLRAZ
+5 SET LRPRE=21
DO PRE^BLRALBM1
+6 IF $DATA(^LR(LRDFN,"MI",LRIDT,24))
Begin DoDot:1
+7 SET BLRAZ="PARASITOLOGY SMEAR/PREP:"
+8 SET BLRADSP=BLRADSP+1
SET ^TMP($JOB,"BLRA",BLRADSP,0)=BLRAZ
+9 SET LRMYC=0
FOR
SET LRMYC=+$ORDER(^LR(LRDFN,"MI",LRIDT,24,LRMYC))
IF LRMYC<1
QUIT
Begin DoDot:2
+10 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018 -- BLRBLKS should be BLRABLKS (MKK)
+11 ; S BLRADSP=BLRADSP+1,^TMP($J,"BLRA",BLRADSP,0)=$E(BLRBLKS,1,5)_$G(^LR(LRDFN,"MI",LRIDT,24,LRMYC,0))
+12 SET BLRADSP=BLRADSP+1
SET ^TMP($JOB,"BLRA",BLRADSP,0)=$EXTRACT(BLRABLKS,1,5)_$GET(^LR(LRDFN,"MI",LRIDT,24,LRMYC,0))
+13 ;----- END IHS MODIFICATIONS LR*5.2*1018 -- BLRBLKS should be BLRABLKS (MKK)
End DoDot:2
End DoDot:1
+14 SET LRPAR=0
FOR
SET LRPAR=+$ORDER(^LR(LRDFN,"MI",LRIDT,6,LRPAR))
IF LRPAR<1
QUIT
Begin DoDot:1
+15 SET BLRAPAR=$GET(^LR(LRDFN,"MI",LRIDT,6,LRPAR,0))
+16 SET BLRAZ="Parasite: "_$EXTRACT($PIECE($GET(^LAB(61.2,BLRAPAR,0)),U),1,25)
+17 SET BLRADSP=BLRADSP+1
SET ^TMP($JOB,"BLRA",BLRADSP,0)=BLRAZ
+18 SET BLRAZ1=30
DO Z1
DO STG
End DoDot:1
+19 IF $DATA(^LR(LRDFN,"MI",LRIDT,7,0))
IF $PIECE($GET(^(0)),U,4)>0
Begin DoDot:1
+20 SET BLRAZ="Parasitology Remark(s):"
+21 SET BLRADSP=BLRADSP+1
SET ^TMP($JOB,"BLRA",BLRADSP,0)=BLRAZ
+22 SET LRPAR=0
FOR
SET LRPAR=+$ORDER(^LR(LRDFN,"MI",LRIDT,7,LRPAR))
IF LRPAR<1
QUIT
Begin DoDot:2
+23 SET BLRADSP=BLRADSP+1
SET ^TMP($JOB,"BLRA",BLRADSP,0)=$EXTRACT(BLRABLKS,1,3)_$GET(^LR(LRDFN,"MI",LRIDT,7,LRPAR,0))
End DoDot:2
End DoDot:1
+24 QUIT
+25 ;
STG SET LRBUG(LRPAR)=$GET(^LR(LRDFN,"MI",LRIDT,6,LRPAR,0))
SET S1=6
SET LRTA=LRPAR
+1 IF $DATA(^LR(LRDFN,"MI",LRIDT,S1,LRTA,1,0))
Begin DoDot:1
+2 SET B=0
FOR
SET B=+$ORDER(^LR(LRDFN,"MI",LRIDT,S1,LRTA,1,B))
IF B<1
QUIT
Begin DoDot:2
+3 SET Y=$GET(^LR(LRDFN,"MI",LRIDT,S1,LRTA,1,B,0))
SET Y1=$PIECE(Y,U,2)
+4 SET BLRAZ=" Stage: "
DO SET
+5 SET BLRADSP=BLRADSP+1
SET ^TMP($JOB,"BLRA",BLRADSP,0)=BLRAZ
+6 IF $LENGTH(Y1)
SET BLRAZ=" Quantity: "_Y1
+7 SET BLRADSP=BLRADSP+1
SET ^TMP($JOB,"BLRA",BLRADSP,0)=BLRAZ
+8 DO LIST1
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
SET SET LRSET=$PIECE($GET(^DD(63.35,.01,0)),U,3)
+1 SET %=$PIECE($PIECE(";"_LRSET,";"_$PIECE(Y,U)_":",2),";")
IF %]""
SET BLRAZ=BLRAZ_%
+2 QUIT
+3 ;
LIST1 SET BLRAZ=" Comment: "
+1 SET BLRADSP=BLRADSP+1
SET ^TMP($JOB,"BLRA",BLRADSP,0)=BLRAZ
+2 SET C=0
FOR
SET C=+$ORDER(^LR(LRDFN,"MI",LRIDT,S1,LRTA,1,B,1,C))
IF C<1
QUIT
Begin DoDot:1
+3 SET BLRAZ1=13
DO Z1
SET BLRAZ=BLRAZ_$GET(^LR(LRDFN,"MI",LRIDT,S1,LRTA,1,B,1,C,0))
+4 SET BLRADSP=BLRADSP+1
SET ^TMP($JOB,"BLRA",BLRADSP,0)=BLRAZ
SET BLRAZ=$EXTRACT(BLRABLKS,1,13)
End DoDot:1
+5 QUIT
+6 ;
VIR ;EP
+1 IF '$LENGTH($PIECE($GET(^LR(LRDFN,"MI",LRIDT,16)),U))
IF '$DATA(LRWRDVEW)
QUIT
IF LRSB'=16
QUIT
+2 SET LRTUS=$PIECE($GET(^LR(LRDFN,"MI",LRIDT,16)),U,2)
SET DZ=$PIECE($GET(^(16)),U,3)
SET Y=$PIECE($GET(^(16)),U)
DO D^LRU
+3 SET BLRAZ="* VIROLOGY "_$SELECT(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")_" REPORT => "_Y_" TECH CODE: "_DZ
+4 SET LRPRE=20
DO PRE^BLRALBM1
+5 SET LRPAR=0
FOR
SET LRPAR=+$ORDER(^LR(LRDFN,"MI",LRIDT,17,LRPAR))
IF LRPAR<1
QUIT
Begin DoDot:1
+6 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
+7 SET BLRAZ="Virus: "_$PIECE($GET(^LAB(61.2,$PIECE($GET(^(LRPAR,0)),U),0)),U)
+8 SET LRBUG(LRPAR)=$GET(^LR(LRDFN,"MI",LRIDT,17,LRPAR,0))
+9 ;----- END IHS MODIFICATIONS ERROR REPORTED AT AIH
+10 ;----- ADDED "." TO PREVIOUS TWO LINES
End DoDot:1
+11 IF $DATA(^LR(LRDFN,"MI",LRIDT,18,0))
IF $PIECE(^(0),U,4)>0
Begin DoDot:1
+12 SET BLRAZ="Virology Remark(s):"
SET LRPAR=0
+13 FOR
SET LRPAR=+$ORDER(^LR(LRDFN,"MI",LRIDT,18,LRPAR))
IF LRPAR<1
QUIT
Begin DoDot:2
+14 SET BLRADSP=BLRADSP+1
SET ^TMP($JOB,"BLRA",BLRADSP,0)=$EXTRACT(BLRABLKS,1,3)_$GET(^LR(LRDFN,"MI",LRIDT,18,LRPAR,0))
End DoDot:2
End DoDot:1
+15 QUIT
+16 ;
Z1 ; Pad with trailing spaces
+1 FOR BLRAI=1:1:(BLRAZ1-$LENGTH(BLRAZ))
SET BLRAZ=BLRAZ_" "
+2 QUIT
