GMTSLRMX ;SLC/JER,KER - Extended Microbiology Extract; Aug 02, 2022@08:31:08
;;2.7;Health Summary;**49,138**;Oct 20, 1995;Build 4
;
; External References
; Reference to %XY^%RCR in ICR #10022
; Reference to ^LAB(61.2 in ICR #526
; Reference to ^LR( in ICR #63
; Reference to $$GET1^DID in ICR #2056
; Reference to EN^DIQ1 in ICR #10015
;
PARA ; Get Parasitology Work-up
;Do not display if results not verified (GMTS*2.7*138)
I $P($G(^LR(LRDFN,"MI",IX,5)),U)="" D Q
. ;Were results previously verified and are now in the process
. ;of being amended?
. Q:'$D(^XTMP("LRMICRO EDIT",LRDFN,IX,5))
. S ^TMP("LRM",$J,"PARA",0)="Results currently being edited by tech code "_$G(^XTMP("LRMICRO EDIT",LRDFN,IX,5))
N DA,DIC,DIQ,DR,STATUS,PN,SN,RMK,SMEAR,COM
I $D(^LR(LRDFN,"MI",IX,5)) D
. S DIC=63,DA=LRDFN,DA(63.05)=IX,DR=5,DR(63.05)=15,DIQ="STATUS"
. S DIQ(0)="E" D EN^DIQ1
. S ^TMP("LRM",$J,"PARA",0)=$E($P(STATUS(63.05,IX,15,"E")," ",1),1,6)
S PN=0
F S PN=$O(^LR(LRDFN,"MI",IX,6,PN)) Q:+PN'>0 D
. S SN=0
. D IDPARA
. F S SN=$O(^LR(LRDFN,"MI",IX,6,PN,1,SN)) Q:+SN'>0 D IDPARA
; Parasitology smear/prep
S SMEAR=0
F S SMEAR=$O(^LR(LRDFN,"MI",IX,24,SMEAR)) Q:SMEAR'>0 S ^TMP("LRM",$J,"PARA","SMEAR",SMEAR)=^(SMEAR,0)
; Remark
S RMK=0
F S RMK=$O(^LR(LRDFN,"MI",IX,7,RMK)) Q:+RMK'>0 S ^TMP("LRM",$J,"PARA","R",RMK)=^(RMK,0)
Q
IDPARA ; Get parasite stage, quantity, and comment
N DA,DIC,DIQ,DR,PARA,STAGE
I 'SN S PARA=+^LR(LRDFN,"MI",IX,6,PN,0),PARA=$S($D(EXPAND):PN_";"_$P(^LAB(61.2,PARA,0),U),1:$P(^LAB(61.2,PARA,0),U)),^TMP("LRM",$J,"PARA",PN)=PARA Q
S DA=LRDFN,DA(63.05)=IX,DA(63.34)=PN,DA(63.35)=SN,DIC=63,DIQ="STAGE",DIQ(0)="E",DR=5,DR(63.05)=16,DR(63.34)=1,DR(63.35)=".01;1" D EN^DIQ1
S ^TMP("LRM",$J,"PARA",PN,SN)=STAGE(63.35,SN,.01,"E")_U_STAGE(63.35,SN,1,"E")
; Comment
S COM=0
F S COM=$O(^LR(LRDFN,"MI",IX,6,PN,1,SN,1,COM)) Q:COM'>0 S ^TMP("LRM",$J,"PARA",PN,SN,"COM",COM)=^(COM,0)
Q
MYCO ; Get Mycology Work-up
;Do not display if results not verified (GMTS*2.7*138)
I $P($G(^LR(LRDFN,"MI",IX,8)),U)="" D Q
. ;Were results previously verified and are now in the process
. ;of being amended?
. Q:'$D(^XTMP("LRMICRO EDIT",LRDFN,IX,8))
. S ^TMP("LRM",$J,"MYCO",0)="Results currently being edited by tech code "_$G(^XTMP("LRMICRO EDIT",LRDFN,IX,8))
N DA,DIC,DIQ,DR,DA,STATUS,GMW,ISO,FUN,RMK,COM,SMEAR
; Work-up
I $D(^LR(LRDFN,"MI",IX,8)) D
. S DIC=63,DA=LRDFN,DA(63.05)=IX,DR=5,DR(63.05)=19,DIQ="STATUS"
. S DIQ(0)="E" D EN^DIQ1
. S ^TMP("LRM",$J,"MYCO",0)=$E($P(STATUS(63.05,IX,19,"E")," ",1),1,6)
S ISO=0
F S ISO=$O(^LR(LRDFN,"MI",IX,9,ISO)) Q:+ISO'>0 D
. D FNGS S ^TMP("LRM",$J,"MYCO",ISO)=$S($D(EXPAND):ISO_";"_FUN,1:FUN)
. ; Comment
. S COM=0
. F S COM=$O(^LR(LRDFN,"MI",IX,9,ISO,1,COM)) Q:COM'>0 S ^TMP("LRM",$J,"MYCO",ISO,"COM",COM)=^(COM,0)
; Mycology smear/prep
S SMEAR=0
F S SMEAR=$O(^LR(LRDFN,"MI",IX,15,SMEAR)) Q:SMEAR'>0 S ^TMP("LRM",$J,"MYCO","SMEAR",SMEAR)=^(SMEAR,0)
; Remark
S RMK=0
F S RMK=$O(^LR(LRDFN,"MI",IX,10,RMK)) Q:+RMK'>0 S ^TMP("LRM",$J,"MYCO","R",RMK)=^(RMK,0)
Q
FNGS ; Fungus/Yeast
N QTY S FUN=+^LR(LRDFN,"MI",IX,9,ISO,0),QTY=$P(^(0),U,2)
S FUN=$P(^LAB(61.2,FUN,0),U),FUN=FUN_U_QTY
Q
TB ; Gets Mycobacteriology Work-up
;Do not display if results not verified (GMTS*2.7*138)
I $P($G(^LR(LRDFN,"MI",IX,11)),U)="" D Q
. ;Were results previously verified and are now in the process
. ;of being amended?
. Q:'$D(^XTMP("LRMICRO EDIT",LRDFN,IX,11))
. S ^TMP("LRM",$J,"TB",0)="Results currently being edited by tech code "_$G(^XTMP("LRMICRO EDIT",LRDFN,IX,11))
N DA,DIC,DIQ,DR,STATUS,GMW,ISO,MB,RMK,X,%X,Y,%Y,COM,MY,GMTB,GMTBA,GMTBF,GMTBL
I $D(^LR(LRDFN,"MI",IX,11)) D
. S DIC=63,DA=LRDFN,DA(63.05)=IX,DR=5,DR(63.05)="23;24;25",DIQ="STATUS"
. S DIQ(0)="E" D EN^DIQ1
. ; Status, Acid Fast Stain, Quantity
. S ^TMP("LRM",$J,"TB",0)=$E($P(STATUS(63.05,IX,23,"E")," ",1),1,6)_U_STATUS(63.05,IX,24,"E")_U_STATUS(63.05,IX,25,"E")
S ISO=0
F S ISO=$O(^LR(LRDFN,"MI",IX,12,ISO)) Q:+ISO'>0 D
. D MYCB S ^TMP("LRM",$J,"TB",ISO)=$S($D(EXPAND):ISO_";"_MB,1:MB)
. ; Comment
. S COM=0
. F S COM=$O(^LR(LRDFN,"MI",IX,12,ISO,1,COM)) Q:COM'>0 S ^TMP("LRM",$J,"TB",ISO,"COM",COM)=^(COM,0)
. ; Susceptiblities
. S GMTB=2
. F S GMTB=$O(^LR(LRDFN,"MI",IX,12,ISO,GMTB)) Q:GMTB'["2."!(GMTB="") D
. . K GMTBL S %X="^DD(63.39,""GL"","_+($G(GMTB))_",1",%Y="GMTBL(" D %XY^%RCR
. . S GMTBF=+($O(GMTBL(1,0))),GMTBA=$$GET1^DID(63.39,GMTBF,"","LABEL")
. . S ^TMP("LRM",$J,"TB",ISO,"SUSC",GMTB)=GMTBA_U_$P(^LR(LRDFN,"MI",IX,12,ISO,GMTB),U)
; Remark
S RMK=0
F S RMK=$O(^LR(LRDFN,"MI",IX,13,RMK)) Q:RMK="" S ^TMP("LRM",$J,"TB","R",RMK)=^(RMK,0)
Q
MYCB ; Mycobacterium
N QTY S MB=+^LR(LRDFN,"MI",IX,12,ISO,0),QTY=$P(^(0),U,2)
S MB=$P(^LAB(61.2,MB,0),U),MB=MB_U_QTY
Q
VIRO ; Gets Virology Work-up
;Do not display if results not verified (GMTS*2.7*138)
I $P($G(^LR(LRDFN,"MI",IX,16)),U)="" D Q
. ;Were results previously verified and are now in the process
. ;of being amended?
. Q:'$D(^XTMP("LRMICRO EDIT",LRDFN,IX,16))
. S ^TMP("LRM",$J,"VIRO",0)="Results currently being edited by tech code "_$G(^XTMP("LRMICRO EDIT",LRDFN,IX,16))
N BUG,DA,DIC,DIQ,DR,GMW,ISO,RMK,STATUS
I $D(^LR(LRDFN,"MI",IX,16)) D
. S DIC=63,DA=LRDFN,DA(63.05)=IX,DR=5,DR(63.05)=34,DIQ="STATUS"
. S DIQ(0)="E" D EN^DIQ1
. S ^TMP("LRM",$J,"VIRO",0)=$E($P(STATUS(63.05,IX,34,"E")," ",1),1,6)
S ISO=0
F S ISO=$O(^LR(LRDFN,"MI",IX,17,ISO)) Q:+ISO'>0 D
. D PHAGE S ^TMP("LRM",$J,"VIRO",ISO)=$S($D(EXPAND):ISO_";"_BUG,1:BUG)
S RMK=0
F S RMK=$O(^LR(LRDFN,"MI",IX,18,RMK)) Q:RMK="" S ^TMP("LRM",$J,"VIRO","R",RMK)=^(RMK,0)
Q
PHAGE ; Virus
S BUG=+^LR(LRDFN,"MI",IX,17,ISO,0),BUG=$P(^LAB(61.2,BUG,0),U)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSLRMX 5885 printed Dec 13, 2024@01:57:51 Page 2
GMTSLRMX ;SLC/JER,KER - Extended Microbiology Extract; Aug 02, 2022@08:31:08
+1 ;;2.7;Health Summary;**49,138**;Oct 20, 1995;Build 4
+2 ;
+3 ; External References
+4 ; Reference to %XY^%RCR in ICR #10022
+5 ; Reference to ^LAB(61.2 in ICR #526
+6 ; Reference to ^LR( in ICR #63
+7 ; Reference to $$GET1^DID in ICR #2056
+8 ; Reference to EN^DIQ1 in ICR #10015
+9 ;
PARA ; Get Parasitology Work-up
+1 ;Do not display if results not verified (GMTS*2.7*138)
+2 IF $PIECE($GET(^LR(LRDFN,"MI",IX,5)),U)=""
Begin DoDot:1
+3 ;Were results previously verified and are now in the process
+4 ;of being amended?
+5 if '$DATA(^XTMP("LRMICRO EDIT",LRDFN,IX,5))
QUIT
+6 SET ^TMP("LRM",$JOB,"PARA",0)="Results currently being edited by tech code "_$GET(^XTMP("LRMICRO EDIT",LRDFN,IX,5))
End DoDot:1
QUIT
+7 NEW DA,DIC,DIQ,DR,STATUS,PN,SN,RMK,SMEAR,COM
+8 IF $DATA(^LR(LRDFN,"MI",IX,5))
Begin DoDot:1
+9 SET DIC=63
SET DA=LRDFN
SET DA(63.05)=IX
SET DR=5
SET DR(63.05)=15
SET DIQ="STATUS"
+10 SET DIQ(0)="E"
DO EN^DIQ1
+11 SET ^TMP("LRM",$JOB,"PARA",0)=$EXTRACT($PIECE(STATUS(63.05,IX,15,"E")," ",1),1,6)
End DoDot:1
+12 SET PN=0
+13 FOR
SET PN=$ORDER(^LR(LRDFN,"MI",IX,6,PN))
if +PN'>0
QUIT
Begin DoDot:1
+14 SET SN=0
+15 DO IDPARA
+16 FOR
SET SN=$ORDER(^LR(LRDFN,"MI",IX,6,PN,1,SN))
if +SN'>0
QUIT
DO IDPARA
End DoDot:1
+17 ; Parasitology smear/prep
+18 SET SMEAR=0
+19 FOR
SET SMEAR=$ORDER(^LR(LRDFN,"MI",IX,24,SMEAR))
if SMEAR'>0
QUIT
SET ^TMP("LRM",$JOB,"PARA","SMEAR",SMEAR)=^(SMEAR,0)
+20 ; Remark
+21 SET RMK=0
+22 FOR
SET RMK=$ORDER(^LR(LRDFN,"MI",IX,7,RMK))
if +RMK'>0
QUIT
SET ^TMP("LRM",$JOB,"PARA","R",RMK)=^(RMK,0)
+23 QUIT
IDPARA ; Get parasite stage, quantity, and comment
+1 NEW DA,DIC,DIQ,DR,PARA,STAGE
+2 IF 'SN
SET PARA=+^LR(LRDFN,"MI",IX,6,PN,0)
SET PARA=$SELECT($DATA(EXPAND):PN_";"_$PIECE(^LAB(61.2,PARA,0),U),1:$PIECE(^LAB(61.2,PARA,0),U))
SET ^TMP("LRM",$JOB,"PARA",PN)=PARA
QUIT
+3 SET DA=LRDFN
SET DA(63.05)=IX
SET DA(63.34)=PN
SET DA(63.35)=SN
SET DIC=63
SET DIQ="STAGE"
SET DIQ(0)="E"
SET DR=5
SET DR(63.05)=16
SET DR(63.34)=1
SET DR(63.35)=".01;1"
DO EN^DIQ1
+4 SET ^TMP("LRM",$JOB,"PARA",PN,SN)=STAGE(63.35,SN,.01,"E")_U_STAGE(63.35,SN,1,"E")
+5 ; Comment
+6 SET COM=0
+7 FOR
SET COM=$ORDER(^LR(LRDFN,"MI",IX,6,PN,1,SN,1,COM))
if COM'>0
QUIT
SET ^TMP("LRM",$JOB,"PARA",PN,SN,"COM",COM)=^(COM,0)
+8 QUIT
MYCO ; Get Mycology Work-up
+1 ;Do not display if results not verified (GMTS*2.7*138)
+2 IF $PIECE($GET(^LR(LRDFN,"MI",IX,8)),U)=""
Begin DoDot:1
+3 ;Were results previously verified and are now in the process
+4 ;of being amended?
+5 if '$DATA(^XTMP("LRMICRO EDIT",LRDFN,IX,8))
QUIT
+6 SET ^TMP("LRM",$JOB,"MYCO",0)="Results currently being edited by tech code "_$GET(^XTMP("LRMICRO EDIT",LRDFN,IX,8))
End DoDot:1
QUIT
+7 NEW DA,DIC,DIQ,DR,DA,STATUS,GMW,ISO,FUN,RMK,COM,SMEAR
+8 ; Work-up
+9 IF $DATA(^LR(LRDFN,"MI",IX,8))
Begin DoDot:1
+10 SET DIC=63
SET DA=LRDFN
SET DA(63.05)=IX
SET DR=5
SET DR(63.05)=19
SET DIQ="STATUS"
+11 SET DIQ(0)="E"
DO EN^DIQ1
+12 SET ^TMP("LRM",$JOB,"MYCO",0)=$EXTRACT($PIECE(STATUS(63.05,IX,19,"E")," ",1),1,6)
End DoDot:1
+13 SET ISO=0
+14 FOR
SET ISO=$ORDER(^LR(LRDFN,"MI",IX,9,ISO))
if +ISO'>0
QUIT
Begin DoDot:1
+15 DO FNGS
SET ^TMP("LRM",$JOB,"MYCO",ISO)=$SELECT($DATA(EXPAND):ISO_";"_FUN,1:FUN)
+16 ; Comment
+17 SET COM=0
+18 FOR
SET COM=$ORDER(^LR(LRDFN,"MI",IX,9,ISO,1,COM))
if COM'>0
QUIT
SET ^TMP("LRM",$JOB,"MYCO",ISO,"COM",COM)=^(COM,0)
End DoDot:1
+19 ; Mycology smear/prep
+20 SET SMEAR=0
+21 FOR
SET SMEAR=$ORDER(^LR(LRDFN,"MI",IX,15,SMEAR))
if SMEAR'>0
QUIT
SET ^TMP("LRM",$JOB,"MYCO","SMEAR",SMEAR)=^(SMEAR,0)
+22 ; Remark
+23 SET RMK=0
+24 FOR
SET RMK=$ORDER(^LR(LRDFN,"MI",IX,10,RMK))
if +RMK'>0
QUIT
SET ^TMP("LRM",$JOB,"MYCO","R",RMK)=^(RMK,0)
+25 QUIT
FNGS ; Fungus/Yeast
+1 NEW QTY
SET FUN=+^LR(LRDFN,"MI",IX,9,ISO,0)
SET QTY=$PIECE(^(0),U,2)
+2 SET FUN=$PIECE(^LAB(61.2,FUN,0),U)
SET FUN=FUN_U_QTY
+3 QUIT
TB ; Gets Mycobacteriology Work-up
+1 ;Do not display if results not verified (GMTS*2.7*138)
+2 IF $PIECE($GET(^LR(LRDFN,"MI",IX,11)),U)=""
Begin DoDot:1
+3 ;Were results previously verified and are now in the process
+4 ;of being amended?
+5 if '$DATA(^XTMP("LRMICRO EDIT",LRDFN,IX,11))
QUIT
+6 SET ^TMP("LRM",$JOB,"TB",0)="Results currently being edited by tech code "_$GET(^XTMP("LRMICRO EDIT",LRDFN,IX,11))
End DoDot:1
QUIT
+7 NEW DA,DIC,DIQ,DR,STATUS,GMW,ISO,MB,RMK,X,%X,Y,%Y,COM,MY,GMTB,GMTBA,GMTBF,GMTBL
+8 IF $DATA(^LR(LRDFN,"MI",IX,11))
Begin DoDot:1
+9 SET DIC=63
SET DA=LRDFN
SET DA(63.05)=IX
SET DR=5
SET DR(63.05)="23;24;25"
SET DIQ="STATUS"
+10 SET DIQ(0)="E"
DO EN^DIQ1
+11 ; Status, Acid Fast Stain, Quantity
+12 SET ^TMP("LRM",$JOB,"TB",0)=$EXTRACT($PIECE(STATUS(63.05,IX,23,"E")," ",1),1,6)_U_STATUS(63.05,IX,24,"E")_U_STATUS(63.05,IX,25,"E")
End DoDot:1
+13 SET ISO=0
+14 FOR
SET ISO=$ORDER(^LR(LRDFN,"MI",IX,12,ISO))
if +ISO'>0
QUIT
Begin DoDot:1
+15 DO MYCB
SET ^TMP("LRM",$JOB,"TB",ISO)=$SELECT($DATA(EXPAND):ISO_";"_MB,1:MB)
+16 ; Comment
+17 SET COM=0
+18 FOR
SET COM=$ORDER(^LR(LRDFN,"MI",IX,12,ISO,1,COM))
if COM'>0
QUIT
SET ^TMP("LRM",$JOB,"TB",ISO,"COM",COM)=^(COM,0)
+19 ; Susceptiblities
+20 SET GMTB=2
+21 FOR
SET GMTB=$ORDER(^LR(LRDFN,"MI",IX,12,ISO,GMTB))
if GMTB'["2."!(GMTB="")
QUIT
Begin DoDot:2
+22 KILL GMTBL
SET %X="^DD(63.39,""GL"","_+($GET(GMTB))_",1"
SET %Y="GMTBL("
DO %XY^%RCR
+23 SET GMTBF=+($ORDER(GMTBL(1,0)))
SET GMTBA=$$GET1^DID(63.39,GMTBF,"","LABEL")
+24 SET ^TMP("LRM",$JOB,"TB",ISO,"SUSC",GMTB)=GMTBA_U_$PIECE(^LR(LRDFN,"MI",IX,12,ISO,GMTB),U)
End DoDot:2
End DoDot:1
+25 ; Remark
+26 SET RMK=0
+27 FOR
SET RMK=$ORDER(^LR(LRDFN,"MI",IX,13,RMK))
if RMK=""
QUIT
SET ^TMP("LRM",$JOB,"TB","R",RMK)=^(RMK,0)
+28 QUIT
MYCB ; Mycobacterium
+1 NEW QTY
SET MB=+^LR(LRDFN,"MI",IX,12,ISO,0)
SET QTY=$PIECE(^(0),U,2)
+2 SET MB=$PIECE(^LAB(61.2,MB,0),U)
SET MB=MB_U_QTY
+3 QUIT
VIRO ; Gets Virology Work-up
+1 ;Do not display if results not verified (GMTS*2.7*138)
+2 IF $PIECE($GET(^LR(LRDFN,"MI",IX,16)),U)=""
Begin DoDot:1
+3 ;Were results previously verified and are now in the process
+4 ;of being amended?
+5 if '$DATA(^XTMP("LRMICRO EDIT",LRDFN,IX,16))
QUIT
+6 SET ^TMP("LRM",$JOB,"VIRO",0)="Results currently being edited by tech code "_$GET(^XTMP("LRMICRO EDIT",LRDFN,IX,16))
End DoDot:1
QUIT
+7 NEW BUG,DA,DIC,DIQ,DR,GMW,ISO,RMK,STATUS
+8 IF $DATA(^LR(LRDFN,"MI",IX,16))
Begin DoDot:1
+9 SET DIC=63
SET DA=LRDFN
SET DA(63.05)=IX
SET DR=5
SET DR(63.05)=34
SET DIQ="STATUS"
+10 SET DIQ(0)="E"
DO EN^DIQ1
+11 SET ^TMP("LRM",$JOB,"VIRO",0)=$EXTRACT($PIECE(STATUS(63.05,IX,34,"E")," ",1),1,6)
End DoDot:1
+12 SET ISO=0
+13 FOR
SET ISO=$ORDER(^LR(LRDFN,"MI",IX,17,ISO))
if +ISO'>0
QUIT
Begin DoDot:1
+14 DO PHAGE
SET ^TMP("LRM",$JOB,"VIRO",ISO)=$SELECT($DATA(EXPAND):ISO_";"_BUG,1:BUG)
End DoDot:1
+15 SET RMK=0
+16 FOR
SET RMK=$ORDER(^LR(LRDFN,"MI",IX,18,RMK))
if RMK=""
QUIT
SET ^TMP("LRM",$JOB,"VIRO","R",RMK)=^(RMK,0)
+17 QUIT
PHAGE ; Virus
+1 SET BUG=+^LR(LRDFN,"MI",IX,17,ISO,0)
SET BUG=$PIECE(^LAB(61.2,BUG,0),U)
+2 QUIT
