LR7OSMZ3 ;slc/dcm - Silent Micro rpt - STERILITY, PARASITES, VIRUS ;Jul 15, 2021@13:33
;;5.2;LAB SERVICE;**121,244,547**;Sep 27, 1994;Build 10
;
STER ;from LR7OSMZ1
S X=^LR(LRDFN,"MI",LRIDT,1)
I $L($P(X,U,7)) D LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"STERILITY CONTROL: "_$S($P(X,U,7)="N":"NEGATIVE",$P(X,U,7)="P":"POSITIVE",1:$P(X,U,7)))
I $O(^LR(LRDFN,"MI",LRIDT,31,0)) D LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"STERILITY RESULT: "),I=0 F S I=$O(^LR(LRDFN,"MI",LRIDT,31,I)) Q:I<1 S X=^(I,0) D
. D LINE^LR7OSUM4
. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(3,CCNT,"#"_I_": "_$S($P(X,"^")="N":"NEGATIVE",$P(X,"^")="P":"POSITIVE",1:""))
Q
PARA ;from LR7OSMZ1
I '$L($P(^LR(LRDFN,"MI",LRIDT,5),U)) D Q:'$D(LRWRDVEW) Q:LRSB'=5
. Q:'$D(^XTMP("LRMICRO EDIT",LRDFN,LRIDT,5))
. ;LR*5.2*547: Display informational message if accession/test is currently being edited
. ; and results had previously been verified.
. N LR7SB S LR7SB=5
. D MES^LR7OSMZ2
S LRTUS=$P(^LR(LRDFN,"MI",LRIDT,5),U,2),DZ=$P(^(5),U,3),Y=$P(^(5),U)
D D^LRU,LINE^LR7OSUM4
S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"* PARASITOLOGY "_$S(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")_" REPORT => "_Y_" TECH CODE: "_DZ)
S LRPRE=21
D PRE^LR7OSMZU
I $D(^LR(LRDFN,"MI",LRIDT,24)) D LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"PARASITOLOGY SMEAR/PREP:") S LRMYC=0 D
. F S LRMYC=+$O(^LR(LRDFN,"MI",LRIDT,24,LRMYC)) Q:LRMYC<1 S X=^(LRMYC,0) D LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(5,CCNT,X)
S LRPAR=0
F S LRPAR=+$O(^LR(LRDFN,"MI",LRIDT,6,LRPAR)) Q:LRPAR<1 S X=^(LRPAR,0),X1=$E($P(^LAB(61.2,X,0),U),1,25) D LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Parasite: "_X1)_$$S^LR7OS(30,CCNT," ") D STG
I $D(^LR(LRDFN,"MI",LRIDT,7,0)),$P(^(0),U,4)>0 D LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Parasitology Remark(s):") S LRPAR=0 D
. F S LRPAR=+$O(^LR(LRDFN,"MI",LRIDT,7,LRPAR)) Q:LRPAR<1 S X=^(LRPAR,0) D LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(3,CCNT,X)
Q
STG ;
S LRBUG(LRPAR)=^LR(LRDFN,"MI",LRIDT,6,LRPAR,0),LRTA=LRPAR
I $D(^LR(LRDFN,"MI",LRIDT,6,LRTA,1,0)) S B=0 F I=0:0 S B=+$O(^LR(LRDFN,"MI",LRIDT,6,LRTA,1,B)) Q:B<1 S Y=^(B,0),Y1=$P(Y,U,2) D
. D LINE^LR7OSUM4
. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT," Stage: ")
. D SET
. I $L(Y1) D LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT," Quantity: "_Y1)
. D LIST1
Q
SET ;
S LRSET=$P(^DD(63.35,.01,0),U,3),%=$P($P(";"_LRSET,";"_$P(Y,U)_":",2),";") I %]""
S ^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(CCNT,CCNT,%)
Q
LIST1 ;
N CNT,C
D LINE^LR7OSUM4
S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT," Comment: "),(C,CNT)=0
F S C=+$O(^LR(LRDFN,"MI",LRIDT,6,LRTA,1,B,1,C)) Q:C<1 S X=^(C,0) D
. I 'CNT S CNT=1,^(0)=^TMP("LRC",$J,GCNT,0)_$$S^LR7OS(13,CCNT,X) Q
. D LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(13,CCNT,X)
Q
VIR ;from LR7OSMZ1
I '$L($P(^LR(LRDFN,"MI",LRIDT,16),U)) D Q:'$D(LRWRDVEW) Q:LRSB'=16
. Q:'$D(^XTMP("LRMICRO EDIT",LRDFN,LRIDT,16))
. ;LR*5.2*547: Display informational message if accession/test is currently being edited
. ; and results had previously been verified.
. N LR7SB S LR7SB=16
. D MES^LR7OSMZ2
S LRTUS=$P(^LR(LRDFN,"MI",LRIDT,16),U,2),DZ=$P(^(16),U,3),Y=$P(^(16),U)
D D^LRU,LINE^LR7OSUM4
S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"* VIROLOGY "_$S(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")_" REPORT => "_Y_" TECH CODE: "_DZ)
S LRPRE=20
D PRE^LR7OSMZU
S LRPAR=0
F S LRPAR=+$O(^LR(LRDFN,"MI",LRIDT,17,LRPAR)) Q:LRPAR<1 S X=^(LRPAR,0),X1=$P(^LAB(61.2,+X,0),U) D LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Virus: "_X1) S LRBUG(LRPAR)=^LR(LRDFN,"MI",LRIDT,17,LRPAR,0)
I $D(^LR(LRDFN,"MI",LRIDT,18,0)),$P(^(0),U,4)>0 D LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Virology Remark(s):") S LRPAR=0 D
. F S LRPAR=+$O(^LR(LRDFN,"MI",LRIDT,18,LRPAR)) Q:LRPAR<1 S X=^(LRPAR,0) D LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(3,CCNT,X)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR7OSMZ3 4031 printed Nov 22, 2024@17:15:40 Page 2
LR7OSMZ3 ;slc/dcm - Silent Micro rpt - STERILITY, PARASITES, VIRUS ;Jul 15, 2021@13:33
+1 ;;5.2;LAB SERVICE;**121,244,547**;Sep 27, 1994;Build 10
+2 ;
STER ;from LR7OSMZ1
+1 SET X=^LR(LRDFN,"MI",LRIDT,1)
+2 IF $LENGTH($PIECE(X,U,7))
DO LINE^LR7OSUM4
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"STERILITY CONTROL: "_$SELECT($PIECE(X,U,7)="N":"NEGATIVE",$PIECE(X,U,7)="P":"POSITIVE",1:$PIECE(X,U,7)))
+3 IF $ORDER(^LR(LRDFN,"MI",LRIDT,31,0))
DO LINE^LR7OSUM4
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"STERILITY RESULT: ")
SET I=0
FOR
SET I=$ORDER(^LR(LRDFN,"MI",LRIDT,31,I))
if I<1
QUIT
SET X=^(I,0)
Begin DoDot:1
+4 DO LINE^LR7OSUM4
+5 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(3,CCNT,"#"_I_": "_$SELECT($PIECE(X,"^")="N":"NEGATIVE",$PIECE(X,"^")="P":"POSITIVE",1:""))
End DoDot:1
+6 QUIT
PARA ;from LR7OSMZ1
+1 IF '$LENGTH($PIECE(^LR(LRDFN,"MI",LRIDT,5),U))
Begin DoDot:1
+2 if '$DATA(^XTMP("LRMICRO EDIT",LRDFN,LRIDT,5))
QUIT
+3 ;LR*5.2*547: Display informational message if accession/test is currently being edited
+4 ; and results had previously been verified.
+5 NEW LR7SB
SET LR7SB=5
+6 DO MES^LR7OSMZ2
End DoDot:1
if '$DATA(LRWRDVEW)
QUIT
if LRSB'=5
QUIT
+7 SET LRTUS=$PIECE(^LR(LRDFN,"MI",LRIDT,5),U,2)
SET DZ=$PIECE(^(5),U,3)
SET Y=$PIECE(^(5),U)
+8 DO D^LRU
DO LINE^LR7OSUM4
+9 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"* PARASITOLOGY "_$SELECT(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")_" REPORT => "_Y_" TECH CODE: "_DZ)
+10 SET LRPRE=21
+11 DO PRE^LR7OSMZU
+12 IF $DATA(^LR(LRDFN,"MI",LRIDT,24))
DO LINE^LR7OSUM4
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"PARASITOLOGY SMEAR/PREP:")
SET LRMYC=0
Begin DoDot:1
+13 FOR
SET LRMYC=+$ORDER(^LR(LRDFN,"MI",LRIDT,24,LRMYC))
if LRMYC<1
QUIT
SET X=^(LRMYC,0)
DO LINE^LR7OSUM4
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(5,CCNT,X)
End DoDot:1
+14 SET LRPAR=0
+15 FOR
SET LRPAR=+$ORDER(^LR(LRDFN,"MI",LRIDT,6,LRPAR))
if LRPAR<1
QUIT
SET X=^(LRPAR,0)
SET X1=$EXTRACT($PIECE(^LAB(61.2,X,0),U),1,25)
DO LINE^LR7OSUM4
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"Parasite: "_X1)_$$S^LR7OS(30,CCNT," ")
DO STG
+16 IF $DATA(^LR(LRDFN,"MI",LRIDT,7,0))
IF $PIECE(^(0),U,4)>0
DO LINE^LR7OSUM4
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"Parasitology Remark(s):")
SET LRPAR=0
Begin DoDot:1
+17 FOR
SET LRPAR=+$ORDER(^LR(LRDFN,"MI",LRIDT,7,LRPAR))
if LRPAR<1
QUIT
SET X=^(LRPAR,0)
DO LINE^LR7OSUM4
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(3,CCNT,X)
End DoDot:1
+18 QUIT
STG ;
+1 SET LRBUG(LRPAR)=^LR(LRDFN,"MI",LRIDT,6,LRPAR,0)
SET LRTA=LRPAR
+2 IF $DATA(^LR(LRDFN,"MI",LRIDT,6,LRTA,1,0))
SET B=0
FOR I=0:0
SET B=+$ORDER(^LR(LRDFN,"MI",LRIDT,6,LRTA,1,B))
if B<1
QUIT
SET Y=^(B,0)
SET Y1=$PIECE(Y,U,2)
Begin DoDot:1
+3 DO LINE^LR7OSUM4
+4 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT," Stage: ")
+5 DO SET
+6 IF $LENGTH(Y1)
DO LINE^LR7OSUM4
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT," Quantity: "_Y1)
+7 DO LIST1
End DoDot:1
+8 QUIT
SET ;
+1 SET LRSET=$PIECE(^DD(63.35,.01,0),U,3)
SET %=$PIECE($PIECE(";"_LRSET,";"_$PIECE(Y,U)_":",2),";")
IF %]""
+2 SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(CCNT,CCNT,%)
+3 QUIT
LIST1 ;
+1 NEW CNT,C
+2 DO LINE^LR7OSUM4
+3 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT," Comment: ")
SET (C,CNT)=0
+4 FOR
SET C=+$ORDER(^LR(LRDFN,"MI",LRIDT,6,LRTA,1,B,1,C))
if C<1
QUIT
SET X=^(C,0)
Begin DoDot:1
+5 IF 'CNT
SET CNT=1
SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(13,CCNT,X)
QUIT
+6 DO LINE^LR7OSUM4
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(13,CCNT,X)
End DoDot:1
+7 QUIT
VIR ;from LR7OSMZ1
+1 IF '$LENGTH($PIECE(^LR(LRDFN,"MI",LRIDT,16),U))
Begin DoDot:1
+2 if '$DATA(^XTMP("LRMICRO EDIT",LRDFN,LRIDT,16))
QUIT
+3 ;LR*5.2*547: Display informational message if accession/test is currently being edited
+4 ; and results had previously been verified.
+5 NEW LR7SB
SET LR7SB=16
+6 DO MES^LR7OSMZ2
End DoDot:1
if '$DATA(LRWRDVEW)
QUIT
if LRSB'=16
QUIT
+7 SET LRTUS=$PIECE(^LR(LRDFN,"MI",LRIDT,16),U,2)
SET DZ=$PIECE(^(16),U,3)
SET Y=$PIECE(^(16),U)
+8 DO D^LRU
DO LINE^LR7OSUM4
+9 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"* VIROLOGY "_$SELECT(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")_" REPORT => "_Y_" TECH CODE: "_DZ)
+10 SET LRPRE=20
+11 DO PRE^LR7OSMZU
+12 SET LRPAR=0
+13 FOR
SET LRPAR=+$ORDER(^LR(LRDFN,"MI",LRIDT,17,LRPAR))
if LRPAR<1
QUIT
SET X=^(LRPAR,0)
SET X1=$PIECE(^LAB(61.2,+X,0),U)
DO LINE^LR7OSUM4
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"Virus: "_X1)
SET LRBUG(LRPAR)=^LR(LRDFN,"MI",LRIDT,17,LRPAR,0)
+14 IF $DATA(^LR(LRDFN,"MI",LRIDT,18,0))
IF $PIECE(^(0),U,4)>0
DO LINE^LR7OSUM4
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"Virology Remark(s):")
SET LRPAR=0
Begin DoDot:1
+15 FOR
SET LRPAR=+$ORDER(^LR(LRDFN,"MI",LRIDT,18,LRPAR))
if LRPAR<1
QUIT
SET X=^(LRPAR,0)
DO LINE^LR7OSUM4
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(3,CCNT,X)
End DoDot:1
+16 QUIT
