- 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
