LR7OSMZ4 ;DALOI/STAFF - Silent Micro rpt - AFB, FUNGUS ;Jul 15, 2021@13:33
;;5.2;LAB SERVICE;**121,244,350,547**;Sep 27, 1994;Build 10
;
;
TB ; from LR7OSMZ1
;
N LRTA,LRX
;
S LRX=^LR(LRDFN,"MI",LRIDT,11)
I $P(LRX,U)="" D Q:'$D(LRWRDVEW) Q:LRSB'=11
. Q:'$D(^XTMP("LRMICRO EDIT",LRDFN,LRIDT,11))
. ;LR*5.2*547: Display informational message if accession/test is currently being edited
. ; and results had previously been verified.
. N LR7SB S LR7SB=11
. D MES^LR7OSMZ2
;
S LRTUS=$P(LRX,U,2),DZ=$P(LRX,U,5),LRAFS=$P(LRX,U,3),LRAMT=$P(LRX,U,4),Y=$P(LRX,U)
D D^LRU,LINE^LR7OSUM4
S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"* MYCOBACTERIOLOGY "_$S(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")_" REPORT => "_Y_" TECH CODE: "_DZ)
S LRPRE=23
D PRE^LR7OSMZU
;
S LRTA=""
I $O(^LR(LRDFN,"MI",LRIDT,12,0)) S LRTA=0
D:LRAFS'=""!(LRTA=0) AFS
;
I $O(^LR(LRDFN,"MI",LRIDT,13,0)) D
. D LINE^LR7OSUM4,LINE^LR7OSUM4
. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Mycobacteriology Remark(s):")
. S B=0
. F S B=+$O(^LR(LRDFN,"MI",LRIDT,13,B)) Q:B<1 S X=^(B,0) D LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(3,CCNT,X)
;
Q
;
;
AFS ; Acid Fast Stain results
;
N LRX,X
;
I LRAFS'="" D
. S LRX="Acid Fast Stain: "
. I LRAFS?1(1"DP",1"DN",1"CP",1"CN") D
. . S LRX=$S($E(LRAFS)="D":"Direct ",$E(LRAFS)="C":"Concentrate ",1:"")_LRX
. . S LRX=LRX_$S($E(LRAFS,2)="P":"Positive",$E(LRAFS,2)="N":"Negative",1:LRAFS)
. E D
. . S X=$$GET1^DIQ(63.05,LRIDT_","_LRDFN_",",24)
. . I X'="" S LRX=LRX_X Q
. . S LRX=LRX_LRAFS
. D LINE^LR7OSUM4
. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,LRX)
. I LRAMT'="" D
. . D LINE^LR7OSUM4
. . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(3,CCNT,"Quantity: "_LRAMT)
;
K ^TMP("LR",$J,"T"),LRTSTS
;
I $D(LRTA) D
. S LRTSTS=0
. F A=0:1 S LRTA=+$O(^LR(LRDFN,"MI",LRIDT,12,LRTA)) Q:LRTA<1 S (LRBUG(LRTA),LRTBC)=$P(^(LRTA,0),U),LRQU=$P(^(0),U,2),LRTBC=$P(^LAB(61.2,LRTBC,0),U) D LIST
Q
;
;
LIST ;
N CNT,LRTB,LRTBA,LRTBS
D LINE^LR7OSUM4,LINE^LR7OSUM4
S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Mycobacterium: "_LRTBC)
S:$D(^LR(LRDFN,"MI",LRIDT,12,LRTA,2)) LRTSTS=LRTSTS+1
I LRQU'="" D LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(3,CCNT,"Quantity: "_LRQU)
I $D(^LR(LRDFN,"MI",LRIDT,12,LRTA,1,0)) D
. D LINE^LR7OSUM4
. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT," Comment: ")
. S (CNT,B)=0
. F S B=+$O(^LR(LRDFN,"MI",LRIDT,12,LRTA,1,B)) Q:B<1 S X=^(B,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)
. D LINE^LR7OSUM4
;
SEN ;
S LRTB=2
F S LRTB=+$O(^LR(LRDFN,"MI",LRIDT,12,LRTA,LRTB)) Q:LRTB'["2."!(LRTB="") D
. S LRTBS=^LR(LRDFN,"MI",LRIDT,12,LRTA,LRTB)
. I LRTBS="" Q
. S LRTBA=""
. I $D(^LAB(62.06,"AD1",LRTB)) D
. . S LRX=$O(^LAB(62.06,"AD1",LRTB,0)),LRX(0)=""
. . I LRX S LRX(0)=$G(^LAB(62.06,LRX,0))
. . S LRTBA=$P(LRX(0),"^")
. I LRTBA="" D
. . S LRTBA=$O(^DD(63.39,"GL",LRTB,1,0))
. . S LRTBA=$P(^DD(63.39,LRTBA,0),U)
. S LRTBA=$$LJ^XLFSTR(LRTBA,30,".")
. D LINE^LR7OSUM4
. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(3,CCNT,LRTBA)_$$S^LR7OS(34,CCNT,LRTBS)
;
Q
;
;
FUNG ;from LR7OSMZ1
S X=^LR(LRDFN,"MI",LRIDT,8)
I '$L($P(X,U)) D Q:'$D(LRWRDVEW) Q:LRSB'=8
. Q:'$D(^XTMP("LRMICRO EDIT",LRDFN,LRIDT,8))
. ;LR*5.2*547: Display informational message if accession/test is currently being edited
. ; and results had previously been verified.
. N LR7SB S LR7SB=8
. D MES^LR7OSMZ2
S LRTUS=$P(X,U,2),DZ=$P(X,U,3),Y=$P(X,U)
D D^LRU,LINE^LR7OSUM4
S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"* MYCOLOGY "_$S(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")_" REPORT => "_Y_" TECH CODE: "_DZ)
S LRPRE=22
D PRE^LR7OSMZU
I $D(^LR(LRDFN,"MI",LRIDT,15)) D
. D LINE^LR7OSUM4
. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"MYCOLOGY SMEAR/PREP:")
. S LRMYC=0
. F S LRMYC=+$O(^LR(LRDFN,"MI",LRIDT,15,LRMYC)) Q:LRMYC<1 S X=^(LRMYC,0) D LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(5,CCNT,X)
;
I $O(^LR(LRDFN,"MI",LRIDT,9,0)) D
. D LINE^LR7OSUM4
. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Fungus/Yeast: ")
. D SHOW
;
I $O(^LR(LRDFN,"MI",LRIDT,10,0)) D
. D LINE^LR7OSUM4
. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Mycology Remark(s):")
. S LRMYC=0
. F S LRMYC=+$O(^LR(LRDFN,"MI",LRIDT,10,LRMYC)) Q:LRMYC<1 S X=^(LRMYC,0) D LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(3,CCNT,X)
Q
;
;
SHOW ;
S LRTA=0
F S LRTA=+$O(^LR(LRDFN,"MI",LRIDT,9,LRTA)) Q:LRTA<1 D
. S (LRBUG(LRTA),LRTBC)=$P(^(LRTA,0),U),LRQU=$P(^(0),U,2),LRTBC=$P(^LAB(61.2,LRTBC,0),U)
. D LIST1
Q
;
;
LIST1 ;
N B,C
D LINE^LR7OSUM4
S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,LRTBC)
I LRQU'="" D
. D LINE^LR7OSUM4
. S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(3,CCNT,"Quantity: "_LRQU)
;
I $D(^LR(LRDFN,"MI",LRIDT,9,LRTA,1,0)) D
. D LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(3,CCNT,"Comment:")
. S (B,C)=0
. F S B=+$O(^LR(LRDFN,"MI",LRIDT,9,LRTA,1,B)) Q:B<1 S X=^(B,0) D
. . I 'C S C=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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLR7OSMZ4 5252 printed Jan 18, 2025@03:06:19 Page 2
LR7OSMZ4 ;DALOI/STAFF - Silent Micro rpt - AFB, FUNGUS ;Jul 15, 2021@13:33
+1 ;;5.2;LAB SERVICE;**121,244,350,547**;Sep 27, 1994;Build 10
+2 ;
+3 ;
TB ; from LR7OSMZ1
+1 ;
+2 NEW LRTA,LRX
+3 ;
+4 SET LRX=^LR(LRDFN,"MI",LRIDT,11)
+5 IF $PIECE(LRX,U)=""
Begin DoDot:1
+6 if '$DATA(^XTMP("LRMICRO EDIT",LRDFN,LRIDT,11))
QUIT
+7 ;LR*5.2*547: Display informational message if accession/test is currently being edited
+8 ; and results had previously been verified.
+9 NEW LR7SB
SET LR7SB=11
+10 DO MES^LR7OSMZ2
End DoDot:1
if '$DATA(LRWRDVEW)
QUIT
if LRSB'=11
QUIT
+11 ;
+12 SET LRTUS=$PIECE(LRX,U,2)
SET DZ=$PIECE(LRX,U,5)
SET LRAFS=$PIECE(LRX,U,3)
SET LRAMT=$PIECE(LRX,U,4)
SET Y=$PIECE(LRX,U)
+13 DO D^LRU
DO LINE^LR7OSUM4
+14 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"* MYCOBACTERIOLOGY "_$SELECT(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")_" REPORT => "_Y_" TECH CODE: "_DZ)
+15 SET LRPRE=23
+16 DO PRE^LR7OSMZU
+17 ;
+18 SET LRTA=""
+19 IF $ORDER(^LR(LRDFN,"MI",LRIDT,12,0))
SET LRTA=0
+20 if LRAFS'=""!(LRTA=0)
DO AFS
+21 ;
+22 IF $ORDER(^LR(LRDFN,"MI",LRIDT,13,0))
Begin DoDot:1
+23 DO LINE^LR7OSUM4
DO LINE^LR7OSUM4
+24 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"Mycobacteriology Remark(s):")
+25 SET B=0
+26 FOR
SET B=+$ORDER(^LR(LRDFN,"MI",LRIDT,13,B))
if B<1
QUIT
SET X=^(B,0)
DO LINE^LR7OSUM4
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(3,CCNT,X)
End DoDot:1
+27 ;
+28 QUIT
+29 ;
+30 ;
AFS ; Acid Fast Stain results
+1 ;
+2 NEW LRX,X
+3 ;
+4 IF LRAFS'=""
Begin DoDot:1
+5 SET LRX="Acid Fast Stain: "
+6 IF LRAFS?1(1"DP",1"DN",1"CP",1"CN")
Begin DoDot:2
+7 SET LRX=$SELECT($EXTRACT(LRAFS)="D":"Direct ",$EXTRACT(LRAFS)="C":"Concentrate ",1:"")_LRX
+8 SET LRX=LRX_$SELECT($EXTRACT(LRAFS,2)="P":"Positive",$EXTRACT(LRAFS,2)="N":"Negative",1:LRAFS)
End DoDot:2
+9 IF '$TEST
Begin DoDot:2
+10 SET X=$$GET1^DIQ(63.05,LRIDT_","_LRDFN_",",24)
+11 IF X'=""
SET LRX=LRX_X
QUIT
+12 SET LRX=LRX_LRAFS
End DoDot:2
+13 DO LINE^LR7OSUM4
+14 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,LRX)
+15 IF LRAMT'=""
Begin DoDot:2
+16 DO LINE^LR7OSUM4
+17 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(3,CCNT,"Quantity: "_LRAMT)
End DoDot:2
End DoDot:1
+18 ;
+19 KILL ^TMP("LR",$JOB,"T"),LRTSTS
+20 ;
+21 IF $DATA(LRTA)
Begin DoDot:1
+22 SET LRTSTS=0
+23 FOR A=0:1
SET LRTA=+$ORDER(^LR(LRDFN,"MI",LRIDT,12,LRTA))
if LRTA<1
QUIT
SET (LRBUG(LRTA),LRTBC)=$PIECE(^(LRTA,0),U)
SET LRQU=$PIECE(^(0),U,2)
SET LRTBC=$PIECE(^LAB(61.2,LRTBC,0),U)
DO LIST
End DoDot:1
+24 QUIT
+25 ;
+26 ;
LIST ;
+1 NEW CNT,LRTB,LRTBA,LRTBS
+2 DO LINE^LR7OSUM4
DO LINE^LR7OSUM4
+3 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"Mycobacterium: "_LRTBC)
+4 if $DATA(^LR(LRDFN,"MI",LRIDT,12,LRTA,2))
SET LRTSTS=LRTSTS+1
+5 IF LRQU'=""
DO LINE^LR7OSUM4
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(3,CCNT,"Quantity: "_LRQU)
+6 IF $DATA(^LR(LRDFN,"MI",LRIDT,12,LRTA,1,0))
Begin DoDot:1
+7 DO LINE^LR7OSUM4
+8 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT," Comment: ")
+9 SET (CNT,B)=0
+10 FOR
SET B=+$ORDER(^LR(LRDFN,"MI",LRIDT,12,LRTA,1,B))
if B<1
QUIT
SET X=^(B,0)
Begin DoDot:2
+11 IF 'CNT
SET CNT=1
SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(13,CCNT,X)
QUIT
+12 DO LINE^LR7OSUM4
+13 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(13,CCNT,X)
End DoDot:2
+14 DO LINE^LR7OSUM4
End DoDot:1
+15 ;
SEN ;
+1 SET LRTB=2
+2 FOR
SET LRTB=+$ORDER(^LR(LRDFN,"MI",LRIDT,12,LRTA,LRTB))
if LRTB'["2."!(LRTB="")
QUIT
Begin DoDot:1
+3 SET LRTBS=^LR(LRDFN,"MI",LRIDT,12,LRTA,LRTB)
+4 IF LRTBS=""
QUIT
+5 SET LRTBA=""
+6 IF $DATA(^LAB(62.06,"AD1",LRTB))
Begin DoDot:2
+7 SET LRX=$ORDER(^LAB(62.06,"AD1",LRTB,0))
SET LRX(0)=""
+8 IF LRX
SET LRX(0)=$GET(^LAB(62.06,LRX,0))
+9 SET LRTBA=$PIECE(LRX(0),"^")
End DoDot:2
+10 IF LRTBA=""
Begin DoDot:2
+11 SET LRTBA=$ORDER(^DD(63.39,"GL",LRTB,1,0))
+12 SET LRTBA=$PIECE(^DD(63.39,LRTBA,0),U)
End DoDot:2
+13 SET LRTBA=$$LJ^XLFSTR(LRTBA,30,".")
+14 DO LINE^LR7OSUM4
+15 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(3,CCNT,LRTBA)_$$S^LR7OS(34,CCNT,LRTBS)
End DoDot:1
+16 ;
+17 QUIT
+18 ;
+19 ;
FUNG ;from LR7OSMZ1
+1 SET X=^LR(LRDFN,"MI",LRIDT,8)
+2 IF '$LENGTH($PIECE(X,U))
Begin DoDot:1
+3 if '$DATA(^XTMP("LRMICRO EDIT",LRDFN,LRIDT,8))
QUIT
+4 ;LR*5.2*547: Display informational message if accession/test is currently being edited
+5 ; and results had previously been verified.
+6 NEW LR7SB
SET LR7SB=8
+7 DO MES^LR7OSMZ2
End DoDot:1
if '$DATA(LRWRDVEW)
QUIT
if LRSB'=8
QUIT
+8 SET LRTUS=$PIECE(X,U,2)
SET DZ=$PIECE(X,U,3)
SET Y=$PIECE(X,U)
+9 DO D^LRU
DO LINE^LR7OSUM4
+10 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"* MYCOLOGY "_$SELECT(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")_" REPORT => "_Y_" TECH CODE: "_DZ)
+11 SET LRPRE=22
+12 DO PRE^LR7OSMZU
+13 IF $DATA(^LR(LRDFN,"MI",LRIDT,15))
Begin DoDot:1
+14 DO LINE^LR7OSUM4
+15 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"MYCOLOGY SMEAR/PREP:")
+16 SET LRMYC=0
+17 FOR
SET LRMYC=+$ORDER(^LR(LRDFN,"MI",LRIDT,15,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
+18 ;
+19 IF $ORDER(^LR(LRDFN,"MI",LRIDT,9,0))
Begin DoDot:1
+20 DO LINE^LR7OSUM4
+21 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"Fungus/Yeast: ")
+22 DO SHOW
End DoDot:1
+23 ;
+24 IF $ORDER(^LR(LRDFN,"MI",LRIDT,10,0))
Begin DoDot:1
+25 DO LINE^LR7OSUM4
+26 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"Mycology Remark(s):")
+27 SET LRMYC=0
+28 FOR
SET LRMYC=+$ORDER(^LR(LRDFN,"MI",LRIDT,10,LRMYC))
if LRMYC<1
QUIT
SET X=^(LRMYC,0)
DO LINE^LR7OSUM4
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(3,CCNT,X)
End DoDot:1
+29 QUIT
+30 ;
+31 ;
SHOW ;
+1 SET LRTA=0
+2 FOR
SET LRTA=+$ORDER(^LR(LRDFN,"MI",LRIDT,9,LRTA))
if LRTA<1
QUIT
Begin DoDot:1
+3 SET (LRBUG(LRTA),LRTBC)=$PIECE(^(LRTA,0),U)
SET LRQU=$PIECE(^(0),U,2)
SET LRTBC=$PIECE(^LAB(61.2,LRTBC,0),U)
+4 DO LIST1
End DoDot:1
+5 QUIT
+6 ;
+7 ;
LIST1 ;
+1 NEW B,C
+2 DO LINE^LR7OSUM4
+3 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,LRTBC)
+4 IF LRQU'=""
Begin DoDot:1
+5 DO LINE^LR7OSUM4
+6 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(3,CCNT,"Quantity: "_LRQU)
End DoDot:1
+7 ;
+8 IF $DATA(^LR(LRDFN,"MI",LRIDT,9,LRTA,1,0))
Begin DoDot:1
+9 DO LINE^LR7OSUM4
SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(3,CCNT,"Comment:")
+10 SET (B,C)=0
+11 FOR
SET B=+$ORDER(^LR(LRDFN,"MI",LRIDT,9,LRTA,1,B))
if B<1
QUIT
SET X=^(B,0)
Begin DoDot:2
+12 IF 'C
SET C=1
SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(13,CCNT,X)
QUIT
+13 DO LINE^LR7OSUM4
+14 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(13,CCNT,X)
End DoDot:2
End DoDot:1
+15 QUIT
