- 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 Feb 18, 2025@23:31:28 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