- LR7OSMZ4 ;slc/dcm - Silent Micro rpt - AFB, FUNGUS ;8/11/97
- ;;5.2T9;LR;**1018**;Nov 17, 2004
- ;;5.2;LAB SERVICE;**121,244**;Sep 27, 1994
- TB ;from LR7OSMZ1
- S X=^LR(LRDFN,"MI",LRIDT,11)
- I '$L($P(X,U)) Q:'$D(LRWRDVEW) Q:LRSB'=11
- S LRTUS=$P(X,U,2),DZ=$P(X,U,5),LRAFS=$P(X,U,3),LRAMT=$P(X,U,4),Y=$P(X,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
- K LRTA
- I $D(^LR(LRDFN,"MI",LRIDT,12,0)),$P(^(0),U,4)>0 S LRTA=0
- D:LRAFS'=""!($D(LRTA)) AFS
- I $D(^LR(LRDFN,"MI",LRIDT,13,0)),$P(^(0),U,4)>0 D LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Mycobacteriology Remark(s):") S B=0 D
- . 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 ;
- I LRAFS'="" D LINE^LR7OSUM4 D
- . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,$S(LRAFS["D":"Direct",LRAFS["C":"Concentrate",1:"")_" Acid Fast Stain: "_$S(LRAFS["P":"Positive",LRAFS["N":"Negative",1:LRAFS)_" ")
- . I $L(LRAMT) D LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(3,CCNT,"Quantity: "_LRAMT)
- K ^TMP("LR",$J,"T"),LRTSTS
- I $D(LRTA) 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
- D 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 $L(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 LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT," Comment: ") S (CNT,B)=0 D
- . 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)
- SEN ;
- S LRTB=2
- F S LRTB=+$O(^LR(LRDFN,"MI",LRIDT,12,LRTA,LRTB)) Q:LRTB'["2."!(LRTB="") S LRTBA=$O(^DD(63.39,"GL",LRTB,1,0)),LRTBA=$P(^DD(63.39,LRTBA,0),U),LRTBS=^LR(LRDFN,"MI",LRIDT,12,LRTA,LRTB) D
- . D LINE^LR7OSUM4
- . S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(3,CCNT,LRTBA)_$$S^LR7OS(20,CCNT,LRTBS)
- K LRTB,LRTBA,LRTBS
- Q
- FUNG ;from LR7OSMZ1
- S X=^LR(LRDFN,"MI",LRIDT,8)
- I '$L($P(X,U)) Q:'$D(LRWRDVEW) Q:LRSB'=8
- 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 LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"MYCOLOGY SMEAR/PREP:") S LRMYC=0 D
- . 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 $D(^LR(LRDFN,"MI",LRIDT,9,0)),$P(^(0),U,4)>0 D LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Fungus/Yeast: ") D SHOW
- I $D(^LR(LRDFN,"MI",LRIDT,10,0)),$P(^(0),U,4)>0 D LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(1,CCNT,"Mycology Remark(s):") S LRMYC=0 D
- . 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 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 $L(LRQU) 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 LINE^LR7OSUM4 S ^TMP("LRC",$J,GCNT,0)=$$S^LR7OS(3,CCNT,"Comment:") S (B,C)=0 D
- . 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
- LR7OSMZ4 ;slc/dcm - Silent Micro rpt - AFB, FUNGUS ;8/11/97
- +1 ;;5.2T9;LR;**1018**;Nov 17, 2004
- +2 ;;5.2;LAB SERVICE;**121,244**;Sep 27, 1994
- TB ;from LR7OSMZ1
- +1 SET X=^LR(LRDFN,"MI",LRIDT,11)
- +2 IF '$LENGTH($PIECE(X,U))
- IF '$DATA(LRWRDVEW)
- QUIT
- IF LRSB'=11
- QUIT
- +3 SET LRTUS=$PIECE(X,U,2)
- SET DZ=$PIECE(X,U,5)
- SET LRAFS=$PIECE(X,U,3)
- SET LRAMT=$PIECE(X,U,4)
- SET Y=$PIECE(X,U)
- +4 DO D^LRU
- DO LINE^LR7OSUM4
- +5 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"* MYCOBACTERIOLOGY "_$SELECT(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")_" REPORT => "_Y_" TECH CODE: "_DZ)
- +6 SET LRPRE=23
- +7 DO PRE^LR7OSMZU
- +8 KILL LRTA
- +9 IF $DATA(^LR(LRDFN,"MI",LRIDT,12,0))
- IF $PIECE(^(0),U,4)>0
- SET LRTA=0
- +10 IF LRAFS'=""!($DATA(LRTA))
- DO AFS
- +11 IF $DATA(^LR(LRDFN,"MI",LRIDT,13,0))
- IF $PIECE(^(0),U,4)>0
- DO LINE^LR7OSUM4
- SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"Mycobacteriology Remark(s):")
- SET B=0
- Begin DoDot:1
- +12 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
- +13 QUIT
- AFS ;
- +1 IF LRAFS'=""
- DO LINE^LR7OSUM4
- Begin DoDot:1
- +2 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,$SELECT(LRAFS["D":"Direct",LRAFS["C":"Concentrate",1:"")_" Acid Fast Stain: "_$SELECT(LRAFS["P":"Positive",LRAFS["N":"Negative",1:LRAFS)_" ")
- +3 IF $LENGTH(LRAMT)
- DO LINE^LR7OSUM4
- SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(3,CCNT,"Quantity: "_LRAMT)
- End DoDot:1
- +4 KILL ^TMP("LR",$JOB,"T"),LRTSTS
- +5 IF $DATA(LRTA)
- SET LRTSTS=0
- 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
- +6 QUIT
- LIST ;
- +1 NEW CNT
- +2 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 $LENGTH(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))
- DO LINE^LR7OSUM4
- SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT," Comment: ")
- SET (CNT,B)=0
- Begin DoDot:1
- +7 FOR
- SET B=+$ORDER(^LR(LRDFN,"MI",LRIDT,12,LRTA,1,B))
- IF B<1
- QUIT
- SET X=^(B,0)
- Begin DoDot:2
- +8 IF 'CNT
- SET CNT=1
- SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(13,CCNT,X)
- QUIT
- +9 DO LINE^LR7OSUM4
- SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(13,CCNT,X)
- End DoDot:2
- End DoDot:1
- SEN ;
- +1 SET LRTB=2
- +2 FOR
- SET LRTB=+$ORDER(^LR(LRDFN,"MI",LRIDT,12,LRTA,LRTB))
- IF LRTB'["2."!(LRTB="")
- QUIT
- SET LRTBA=$ORDER(^DD(63.39,"GL",LRTB,1,0))
- SET LRTBA=$PIECE(^DD(63.39,LRTBA,0),U)
- SET LRTBS=^LR(LRDFN,"MI",LRIDT,12,LRTA,LRTB)
- Begin DoDot:1
- +3 DO LINE^LR7OSUM4
- +4 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(3,CCNT,LRTBA)_$$S^LR7OS(20,CCNT,LRTBS)
- End DoDot:1
- +5 KILL LRTB,LRTBA,LRTBS
- +6 QUIT
- FUNG ;from LR7OSMZ1
- +1 SET X=^LR(LRDFN,"MI",LRIDT,8)
- +2 IF '$LENGTH($PIECE(X,U))
- IF '$DATA(LRWRDVEW)
- QUIT
- IF LRSB'=8
- QUIT
- +3 SET LRTUS=$PIECE(X,U,2)
- SET DZ=$PIECE(X,U,3)
- SET Y=$PIECE(X,U)
- +4 DO D^LRU
- DO LINE^LR7OSUM4
- +5 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"* MYCOLOGY "_$SELECT(LRTUS="F":"FINAL",LRTUS="P":"PRELIMINARY",1:"")_" REPORT => "_Y_" TECH CODE: "_DZ)
- +6 SET LRPRE=22
- +7 DO PRE^LR7OSMZU
- +8 IF $DATA(^LR(LRDFN,"MI",LRIDT,15))
- DO LINE^LR7OSUM4
- SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"MYCOLOGY SMEAR/PREP:")
- SET LRMYC=0
- Begin DoDot:1
- +9 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
- +10 IF $DATA(^LR(LRDFN,"MI",LRIDT,9,0))
- IF $PIECE(^(0),U,4)>0
- DO LINE^LR7OSUM4
- SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"Fungus/Yeast: ")
- DO SHOW
- +11 IF $DATA(^LR(LRDFN,"MI",LRIDT,10,0))
- IF $PIECE(^(0),U,4)>0
- DO LINE^LR7OSUM4
- SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,"Mycology Remark(s):")
- SET LRMYC=0
- Begin DoDot:1
- +12 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
- +13 QUIT
- SHOW ;
- +1 SET LRTA=0
- +2 FOR
- SET LRTA=+$ORDER(^LR(LRDFN,"MI",LRIDT,9,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 LIST1
- +3 QUIT
- LIST1 ;
- +1 NEW B,C
- +2 DO LINE^LR7OSUM4
- +3 SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(1,CCNT,LRTBC)
- +4 IF $LENGTH(LRQU)
- DO LINE^LR7OSUM4
- SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(3,CCNT,"Quantity: "_LRQU)
- +5 IF $DATA(^LR(LRDFN,"MI",LRIDT,9,LRTA,1,0))
- DO LINE^LR7OSUM4
- SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(3,CCNT,"Comment:")
- SET (B,C)=0
- Begin DoDot:1
- +6 FOR
- SET B=+$ORDER(^LR(LRDFN,"MI",LRIDT,9,LRTA,1,B))
- IF B<1
- QUIT
- SET X=^(B,0)
- Begin DoDot:2
- +7 IF 'C
- SET C=1
- SET ^(0)=^TMP("LRC",$JOB,GCNT,0)_$$S^LR7OS(13,CCNT,X)
- QUIT
- +8 DO LINE^LR7OSUM4
- SET ^TMP("LRC",$JOB,GCNT,0)=$$S^LR7OS(13,CCNT,X)
- End DoDot:2
- End DoDot:1
- +9 QUIT
