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