Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMTSLRMX

GMTSLRMX.m

Go to the documentation of this file. 
  1. 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
  1.  ;                    
  1.  ; External References
  1.  ; Reference to %XY^%RCR in ICR #10022
  1.  ; Reference to ^LAB(61.2 in ICR #526
  1.  ; Reference to ^LR( in ICR #63
  1.  ; Reference to $$GET1^DID in ICR #2056
  1.  ; Reference to EN^DIQ1 in ICR #10015
  1.  ;                    
  1. PARA ; Get Parasitology Work-up
  1.  ;Do not display if results not verified (GMTS*2.7*138)
  1.  I $P($G(^LR(LRDFN,"MI",IX,5)),U)="" D  Q
  1.  . ;Were results previously verified and are now in the process
  1.  . ;of being amended?
  1.  . Q:'$D(^XTMP("LRMICRO EDIT",LRDFN,IX,5))
  1.  . S ^TMP("LRM",$J,"PARA",0)="Results currently being edited by tech code "_$G(^XTMP("LRMICRO EDIT",LRDFN,IX,5))
  1.  N DA,DIC,DIQ,DR,STATUS,PN,SN,RMK,SMEAR,COM
  1.  I $D(^LR(LRDFN,"MI",IX,5)) D
  1.  . S DIC=63,DA=LRDFN,DA(63.05)=IX,DR=5,DR(63.05)=15,DIQ="STATUS"
  1.  . S DIQ(0)="E" D EN^DIQ1
  1.  . S ^TMP("LRM",$J,"PARA",0)=$E($P(STATUS(63.05,IX,15,"E")," ",1),1,6)
  1.  S PN=0
  1.  F  S PN=$O(^LR(LRDFN,"MI",IX,6,PN)) Q:+PN'>0  D
  1.  . S SN=0
  1.  . D IDPARA
  1.  . F  S SN=$O(^LR(LRDFN,"MI",IX,6,PN,1,SN)) Q:+SN'>0  D IDPARA
  1.  ;   Parasitology smear/prep
  1.  S SMEAR=0
  1.  F  S SMEAR=$O(^LR(LRDFN,"MI",IX,24,SMEAR)) Q:SMEAR'>0  S ^TMP("LRM",$J,"PARA","SMEAR",SMEAR)=^(SMEAR,0)
  1.  ;   Remark
  1.  S RMK=0
  1.  F  S RMK=$O(^LR(LRDFN,"MI",IX,7,RMK)) Q:+RMK'>0  S ^TMP("LRM",$J,"PARA","R",RMK)=^(RMK,0)
  1.  Q
  1. IDPARA ; Get parasite stage, quantity, and comment
  1.  N DA,DIC,DIQ,DR,PARA,STAGE
  1.  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
  1.  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
  1.  S ^TMP("LRM",$J,"PARA",PN,SN)=STAGE(63.35,SN,.01,"E")_U_STAGE(63.35,SN,1,"E")
  1.  ;   Comment
  1.  S COM=0
  1.  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)
  1.  Q
  1. MYCO ; Get Mycology Work-up
  1.  ;Do not display if results not verified (GMTS*2.7*138)
  1.  I $P($G(^LR(LRDFN,"MI",IX,8)),U)="" D  Q
  1.   . ;Were results previously verified and are now in the process
  1.  . ;of being amended?
  1.  . Q:'$D(^XTMP("LRMICRO EDIT",LRDFN,IX,8))
  1.  . S ^TMP("LRM",$J,"MYCO",0)="Results currently being edited by tech code "_$G(^XTMP("LRMICRO EDIT",LRDFN,IX,8))
  1.  N DA,DIC,DIQ,DR,DA,STATUS,GMW,ISO,FUN,RMK,COM,SMEAR
  1.  ;   Work-up
  1.  I $D(^LR(LRDFN,"MI",IX,8)) D
  1.  . S DIC=63,DA=LRDFN,DA(63.05)=IX,DR=5,DR(63.05)=19,DIQ="STATUS"
  1.  . S DIQ(0)="E" D EN^DIQ1
  1.  . S ^TMP("LRM",$J,"MYCO",0)=$E($P(STATUS(63.05,IX,19,"E")," ",1),1,6)
  1.  S ISO=0
  1.  F  S ISO=$O(^LR(LRDFN,"MI",IX,9,ISO)) Q:+ISO'>0  D
  1.  . D FNGS S ^TMP("LRM",$J,"MYCO",ISO)=$S($D(EXPAND):ISO_";"_FUN,1:FUN)
  1.  . ;   Comment
  1.  . S COM=0
  1.  . 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)
  1.  ;   Mycology smear/prep
  1.  S SMEAR=0
  1.  F  S SMEAR=$O(^LR(LRDFN,"MI",IX,15,SMEAR)) Q:SMEAR'>0  S ^TMP("LRM",$J,"MYCO","SMEAR",SMEAR)=^(SMEAR,0)
  1.  ;   Remark
  1.  S RMK=0
  1.  F  S RMK=$O(^LR(LRDFN,"MI",IX,10,RMK)) Q:+RMK'>0  S ^TMP("LRM",$J,"MYCO","R",RMK)=^(RMK,0)
  1.  Q
  1. FNGS ; Fungus/Yeast
  1.  N QTY S FUN=+^LR(LRDFN,"MI",IX,9,ISO,0),QTY=$P(^(0),U,2)
  1.  S FUN=$P(^LAB(61.2,FUN,0),U),FUN=FUN_U_QTY
  1.  Q
  1. TB ; Gets Mycobacteriology Work-up
  1.  ;Do not display if results not verified (GMTS*2.7*138)
  1.  I $P($G(^LR(LRDFN,"MI",IX,11)),U)="" D  Q
  1.  . ;Were results previously verified and are now in the process
  1.  . ;of being amended?
  1.  . Q:'$D(^XTMP("LRMICRO EDIT",LRDFN,IX,11))
  1.  . S ^TMP("LRM",$J,"TB",0)="Results currently being edited by tech code "_$G(^XTMP("LRMICRO EDIT",LRDFN,IX,11))
  1.  N DA,DIC,DIQ,DR,STATUS,GMW,ISO,MB,RMK,X,%X,Y,%Y,COM,MY,GMTB,GMTBA,GMTBF,GMTBL
  1.  I $D(^LR(LRDFN,"MI",IX,11)) D
  1.  . S DIC=63,DA=LRDFN,DA(63.05)=IX,DR=5,DR(63.05)="23;24;25",DIQ="STATUS"
  1.  . S DIQ(0)="E" D EN^DIQ1
  1.  . ;   Status, Acid Fast Stain, Quantity
  1.  . 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")
  1.  S ISO=0
  1.  F  S ISO=$O(^LR(LRDFN,"MI",IX,12,ISO)) Q:+ISO'>0  D
  1.  . D MYCB S ^TMP("LRM",$J,"TB",ISO)=$S($D(EXPAND):ISO_";"_MB,1:MB)
  1.  . ;   Comment
  1.  . S COM=0
  1.  . 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)
  1.  . ;   Susceptiblities
  1.  . S GMTB=2
  1.  . F  S GMTB=$O(^LR(LRDFN,"MI",IX,12,ISO,GMTB)) Q:GMTB'["2."!(GMTB="")  D
  1.  . . K GMTBL S %X="^DD(63.39,""GL"","_+($G(GMTB))_",1",%Y="GMTBL(" D %XY^%RCR
  1.  . . S GMTBF=+($O(GMTBL(1,0))),GMTBA=$$GET1^DID(63.39,GMTBF,"","LABEL")
  1.  . . S ^TMP("LRM",$J,"TB",ISO,"SUSC",GMTB)=GMTBA_U_$P(^LR(LRDFN,"MI",IX,12,ISO,GMTB),U)
  1.  ;   Remark
  1.  S RMK=0
  1.  F  S RMK=$O(^LR(LRDFN,"MI",IX,13,RMK)) Q:RMK=""  S ^TMP("LRM",$J,"TB","R",RMK)=^(RMK,0)
  1.  Q
  1. MYCB ; Mycobacterium
  1.  N QTY S MB=+^LR(LRDFN,"MI",IX,12,ISO,0),QTY=$P(^(0),U,2)
  1.  S MB=$P(^LAB(61.2,MB,0),U),MB=MB_U_QTY
  1.  Q
  1. VIRO ; Gets Virology Work-up
  1.  ;Do not display if results not verified (GMTS*2.7*138)
  1.  I $P($G(^LR(LRDFN,"MI",IX,16)),U)="" D  Q
  1.   . ;Were results previously verified and are now in the process
  1.  . ;of being amended?
  1.  . Q:'$D(^XTMP("LRMICRO EDIT",LRDFN,IX,16))
  1.  . S ^TMP("LRM",$J,"VIRO",0)="Results currently being edited by tech code "_$G(^XTMP("LRMICRO EDIT",LRDFN,IX,16))
  1.  N BUG,DA,DIC,DIQ,DR,GMW,ISO,RMK,STATUS
  1.  I $D(^LR(LRDFN,"MI",IX,16)) D
  1.  . S DIC=63,DA=LRDFN,DA(63.05)=IX,DR=5,DR(63.05)=34,DIQ="STATUS"
  1.  . S DIQ(0)="E" D EN^DIQ1
  1.  . S ^TMP("LRM",$J,"VIRO",0)=$E($P(STATUS(63.05,IX,34,"E")," ",1),1,6)
  1.  S ISO=0
  1.  F  S ISO=$O(^LR(LRDFN,"MI",IX,17,ISO)) Q:+ISO'>0  D
  1.  . D PHAGE S ^TMP("LRM",$J,"VIRO",ISO)=$S($D(EXPAND):ISO_";"_BUG,1:BUG)
  1.  S RMK=0
  1.  F  S RMK=$O(^LR(LRDFN,"MI",IX,18,RMK)) Q:RMK=""  S ^TMP("LRM",$J,"VIRO","R",RMK)=^(RMK,0)
  1.  Q
  1. PHAGE ; Virus
  1.  S BUG=+^LR(LRDFN,"MI",IX,17,ISO,0),BUG=$P(^LAB(61.2,BUG,0),U)
  1.  Q