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

LRVRMI2A.m

Go to the documentation of this file. 
  1. LRVRMI2A ;DALOI/STAFF - LAH/TMP TO FILE #63 ;02/22/17  08:07
  1.  ;;5.2;LAB SERVICE;**350,427,474,480**;Sep 27, 1994;Build 7
  1.  ;
  1.  ; Continuation of LRVRMI4 and is used for extracting results from the LAH global and storing it into LAB DATA FILE (#63).
  1.  ;
  1.  Q
  1.  ;
  1. N9 ; Process Fungus/Yeast
  1.  N DATA,DIERR,IEN,IEN2,IEN3,ISOID,LRCMT,LRFDA,LRIEN,LRIENS,LRMSG,LRN9,LRX,R6337,STAT
  1.  ;
  1.  ;ZEXCEPT: LRDFN,LRDUZ,LRIDT,LRINTYPE,LRLL,LRNOW,LRPROF,LRRPTAPP,LRSTATUS
  1.  ;
  1.  S (IEN,IEN2,IEN3)=0
  1.  F  S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9,IEN)) Q:IEN<1  D N9A
  1.  ;
  1.  K LRFDA,LRMSG,LRIENS,DIERR
  1.  S LRIEN=LRIDT_","_LRDFN_","
  1.  I LRINTYPE=10 S LRFDA(9,63.05,LRIEN,18)=LRNOW
  1.  S LRFDA(9,63.05,LRIEN,19.5)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
  1.  D FILE^DIE("","LRFDA(9)","LRMSG")
  1.  S LRRPTAPP=1
  1.  Q
  1.  ;
  1.  ;
  1. N9A ; Process fungus yeast organism
  1.  ;
  1.  N DIERR,IEN2,ISOID,LRCMT,LRFDA,LRFDAIEN,LRI,LRIEN,LRIENS,LRMSG,LRN9,LRX,R6337,STAT
  1.  ;
  1.  ;ZEXCEPT: IEN,LRDFN,LRIDT,LRINTYPE,LRLL,LRPROF,LRSTATUS
  1.  ;
  1.  S LRN9=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9,IEN,0))
  1.  Q:LRN9=""
  1.  S ISOID=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9,IEN,.1))
  1.  Q:ISOID=""
  1.  ;
  1.  ; Delete ISOID entry if it exists on LEDI (LRINTYPE=10) interfaces
  1.  ; On UI interfaces update fungus/yeast for this isolate id.
  1.  S R6337=$O(^LR(LRDFN,"MI",LRIDT,9,"C",ISOID,0))
  1.  I R6337 D
  1.  . K LRFDA,LRMSG,LRIENS,DIERR
  1.  . S LRIEN=R6337_","_LRIDT_","_LRDFN_","
  1.  . I LRINTYPE=10 D
  1.  . . S LRFDA(9,63.37,LRIEN,.01)="@"
  1.  . . S R6337=""
  1.  . E  D
  1.  . . S LRFDA(9,63.37,LRIEN,.01)=$P(LRN9,U) ; fungus/yeast
  1.  . . I $P(LRN9,U,2)'="" S LRFDA(9,63.37,LRIEN,1)=$P(LRN9,U,2) ; quantity
  1.  . D FILE^DIE("","LRFDA(9)","LRMSG")
  1.  ;
  1.  ; On LEDI (LRINTYPE=10) interfaces existing ISOID was deleted above so always add record
  1.  I 'R6337 D
  1.  . K LRFDA,LRMSG,LRIENS,DIERR
  1.  . S LRIEN="+1,"_LRIDT_","_LRDFN_","
  1.  . S LRFDA(9,63.37,LRIEN,.01)=$P(LRN9,"^") ; fungus/yeast
  1.  . S LRFDA(9,63.37,LRIEN,.1)=ISOID
  1.  . S LRFDA(9,63.37,LRIEN,1)=$P(LRN9,"^",2) ; quantity
  1.  . D UPDATE^DIE("","LRFDA(9)","LRIENS","LRMSG")
  1.  . S R6337=$G(LRIENS(1))
  1.  ;
  1.  Q:'R6337
  1.  ;
  1.  ; Store code system references for fungus
  1.  S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9,IEN,0,.01))
  1.  F LRI=1:1:3 I $P(LRX,"^",LRI) D
  1.  . N LRDATA
  1.  . S LRDATA(.01)=LRDFN_",MI,"_LRIDT_",9,"_R6337_",0;1"
  1.  . S LRDATA(.02)=$S(LRI<3:2,1:3),LRDATA(.03)=$P(LRX,"^",LRI),LRDATA(.04)=$P("LN^NLT^SCT","^",LRI)
  1.  . D SETREF^LRUCSR(LRDFN,LRDATA(.01),.LRDATA,1)
  1.  ;
  1.  ; Store code system references for yeast quantity
  1.  S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9,IEN,0,.02))
  1.  F LRI=1,2 I $P(LRX,"^",LRI) D
  1.  . N LRDATA
  1.  . S LRDATA(.01)=LRDFN_",MI,"_LRIDT_",9,"_R6337_"0;2"
  1.  . S LRDATA(.02)=2,LRDATA(.03)=$P(LRX,"^",LRI),LRDATA(.04)=$P("LN^NLT","^",LRI)
  1.  . D SETREF^LRUCSR(LRDFN,LRDATA(.01),.LRDATA,1)
  1.  ;
  1.  ; Store performing lab
  1.  S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9,IEN,0,.01,1))
  1.  I $P(LRX,"^") D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",9,"_R6337_",0",$P(LRX,"^"))
  1.  ;
  1.  S STAT=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9,IEN,0,.01,0))
  1.  D BLDSTAT^LRVRMI4A(63.05,19,STAT,.LRSTATUS)
  1.  ;
  1.  ; fungus/yeast comments - comments don't have status
  1.  K LRFDA,LRFDAIEN,LRMSG,LRIENS,DIERR
  1.  M LRCMT=^LR(LRDFN,"MI",LRIDT,9,IEN,1)
  1.  S IEN2=0
  1.  F  S IEN2=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9,IEN,1,IEN2)) Q:IEN2<1  D
  1.  . S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9,IEN,1,IEN2,0),LRX=$S(LRX'="":LRX,1:" ")
  1.  . I LRX'=" ",$$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX) Q
  1.  . S LRIEN="+"_IEN2_","_R6337_","_LRIDT_","_LRDFN_","
  1.  . S LRFDA(9,63.372,LRIEN,.01)=LRX
  1.  ;
  1.  I $D(LRFDA) D UPDATE^DIE("","LRFDA(9)","","LRMSG")
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. N11 ; Process Acid Fast
  1.  N AFS,DIERR,LRFDA,LRIEN,LRIENS,LRMSG,LRX,QTY
  1.  ;
  1.  ;ZEXCEPT: LRDFN,LRDUZ,LRI,LRIDT,LRINTYPE,LRNOW,LRRPTAPP
  1.  ;
  1.  S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,11))
  1.  D BLDSTAT^LRVRMI4A(63.05,23,$P(LRX,"^",2),.LRSTATUS)
  1.  ;
  1.  S LRIEN=LRIDT_","_LRDFN_","
  1.  I LRINTYPE=10 S LRFDA(11,63.05,LRIEN,22)=LRNOW
  1.  S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,11,0))
  1.  S AFS=$P(LRX,"^",3),QTY=$P(LRX,U,4)
  1.  S LRFDA(11,63.05,LRIEN,24)=AFS ; Acid Fast Stain
  1.  ;I $L(QTY)>68 S QTY=$E(QTY,1,65)_"..."
  1.  S LRFDA(11,63.05,LRIEN,25)=QTY ; Quantity
  1.  S LRFDA(11,63.05,LRIEN,25.5)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
  1.  ; derive status
  1.  I AFS'="" D
  1.  . S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,11,0,.01,0))
  1.  . D BLDSTAT^LRVRMI4A(63.05,23,$P(LRX,"^"),.LRSTATUS)
  1.  I QTY'="" D
  1.  . S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,11,0,.02,0))
  1.  . D BLDSTAT^LRVRMI4A(63.05,23,$P(LRX,"^"),.LRSTATUS)
  1.  ;
  1.  D FILE^DIE("","LRFDA(11)","LRMSG")
  1.  S LRRPTAPP=1
  1.  ;
  1.  ; Store code system references for AFB Stain
  1.  S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,11,0,.01))
  1.  F LRI=1,2 I $P(LRX,"^",LRI) D
  1.  . N LRDATA
  1.  . S LRDATA(.01)=LRDFN_",MI,"_LRIDT_",11,0;3"
  1.  . S LRDATA(.02)=2,LRDATA(.03)=$P(LRX,"^",LRI),LRDATA(.04)=$P("LN^NLT","^",LRI)
  1.  . D SETREF^LRUCSR(LRDFN,LRDATA(.01),.LRDATA,1)
  1.  ;
  1.  ; Store code system references for AFB quantity
  1.  S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,11,0,.02))
  1.  F LRI=1,2 I $P(LRX,"^",LRI) D
  1.  . N LRDATA
  1.  . S LRDATA(.01)=LRDFN_",MI,"_LRIDT_",11,0;4"
  1.  . S LRDATA(.02)=2,LRDATA(.03)=$P(LRX,"^",LRI),LRDATA(.04)=$P("LN^NLT","^",LRI)
  1.  . D SETREF^LRUCSR(LRDFN,LRDATA(.01),.LRDATA,1)
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. N12 ; Process Mycobacteria
  1.  ;
  1.  N DATA,DIERR,DNFLDS,FLD,IEN,IEN2,ISOID,LRCMT,LRFDA,LRIEN,LRIENS,LRMSG,LRN12,LRX,R6339,STAT
  1.  ;
  1.  ;ZEXCEPT: LRDFN,LRIDT,LRLL,LRPROF,LRSTATUS
  1.  ;
  1.  S IEN=0
  1.  F  S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN)) Q:IEN<1  D N12A
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. N12A ; Process mycobacteria organism
  1.  ;
  1.  N DATA,DIERR,DNFLDS,FLD,I,IEN2,ISOID,LRCMT,LRCSR,LRFDA,LRI,LRIEN,LRIENS,LRMSG,LRN12,LRX,R6339,STAT
  1.  ;
  1.  ;ZEXCEPT: IEN,LRDFN,LRIDT,LRINTYPE,LRLL,LRPROF,LRSTATUS
  1.  ;
  1.  S LRN12=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN,0))
  1.  Q:LRN12=""
  1.  S ISOID=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN,.1))
  1.  Q:ISOID=""
  1.  ;
  1.  ; Delete ISOID entry if it exists on LEDI (LRINTYPE=10) interfaces
  1.  ; On UI interfaces update mycobacteria for this isolate id.
  1.  S R6339=$O(^LR(LRDFN,"MI",LRIDT,12,"C",ISOID,0))
  1.  I R6339 D
  1.  . K LRFDA,LRMSG,LRIENS,DIERR
  1.  . S LRIEN=R6339_","_LRIDT_","_LRDFN_","
  1.  . I LRINTYPE=10 D
  1.  . . S LRFDA(12,63.39,LRIEN,.01)="@"
  1.  . . S R6339=""
  1.  . E  D
  1.  . . S LRFDA(12,63.39,LRIEN,.01)=$P(LRN12,U) ; mycobacteria
  1.  . . I $P(LRN12,U,2)'="" S LRFDA(12,63.39,LRIEN,1)=$P(LRN12,U,2) ; quantity
  1.  . D FILE^DIE("","LRFDA(12)","LRMSG")
  1.  ;
  1.  ; On LEDI (LRINTYPE=10) interfaces existing ISOID was deleted above so always add record
  1.  I 'R6339 D
  1.  . K LRFDA,LRMSG,LRIENS,DIERR
  1.  . S LRIEN="+1,"_LRIDT_","_LRDFN_","
  1.  . S LRFDA(12,63.39,LRIEN,.01)=$P(LRN12,"^") ; fungus/yeast
  1.  . S LRFDA(12,63.39,LRIEN,.1)=ISOID
  1.  . S LRFDA(12,63.39,LRIEN,1)=$P(LRN12,"^",2) ; quantity
  1.  . D UPDATE^DIE("","LRFDA(12)","LRIENS","LRMSG")
  1.  . S R6339=$G(LRIENS(1))
  1.  ;
  1.  Q:'R6339
  1.  ;
  1.  ; Store code system references
  1.  S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN,0,.01))
  1.  F LRI=1:1:3 I $P(LRX,"^",LRI) D
  1.  . N LRDATA
  1.  . S LRDATA(.01)=LRDFN_",MI,"_LRIDT_",12,"_R6339_",0"
  1.  . S LRDATA(.02)=$S(LRI<3:2,1:3),LRDATA(.03)=$P(LRX,"^",LRI),LRDATA(.04)=$P("LN^NLT^SCT","^",LRI)
  1.  . D SETREF^LRUCSR(LRDFN,LRDATA(.01),.LRDATA,1)
  1.  ;
  1.  ; Store performing lab
  1.  S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN,0,.01,1))
  1.  I $P(LRX,"^") D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",12,"_R6339_",0",$P(LRX,"^"))
  1.  ;
  1.  S STAT=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN,0,.01,0))
  1.  D BLDSTAT^LRVRMI4A(63.05,23,STAT,.LRSTATUS)
  1.  ;
  1.  ; Process comments
  1.  K LRFDA,LRIENS,LRMSG,DIERR
  1.  M LRCMT=^LR(LRDFN,"MI",LRIDT,12,IEN,1)
  1.  S IEN2=0
  1.  F  S IEN2=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN,1,IEN2)) Q:'IEN2  D
  1.  . S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN,1,IEN2,0),LRX=$S(LRX'="":LRX,1:" ")
  1.  . I LRX'=" ",$$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX) Q
  1.  . S LRIEN="+"_IEN2_","_R6339_","_LRIDT_","_LRDFN_","
  1.  . S LRFDA(12,63.4,LRIEN,.01)=LRX
  1.  I $D(LRFDA) D UPDATE^DIE("","LRFDA(12)","","LRMSG")
  1.  ;
  1.  ; Add drug susceptibilities
  1.  S IEN2=1.999999999,IEN2=2
  1.  K LRFDA,LRIENS,LRMSG,DIERR
  1.  F  S IEN2=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN,IEN2)) Q:'IEN2  D  ;
  1.  . S STAT=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN,IEN2,.01,0))
  1.  . D BLDSTAT^LRVRMI4A(63.05,23,STAT,.LRSTATUS)
  1.  . S LRIEN=R6339_","_LRIDT_","_LRDFN_","
  1.  . S DATA=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN,IEN2)
  1.  . S DNFLDS=$$DN2FLDS^LRVRMI4A(IEN2,,12)
  1.  . S FLD=$P(DNFLDS,"^",1)
  1.  . I FLD S LRFDA(12,63.39,LRIEN,FLD)=DATA
  1.  . S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN,IEN2,.01))
  1.  . F I=1:1:3 I $P(LRX,"^",I) S LRCSR(IEN2_";1",$S(I<3:2,1:3),$P("LN^NLT^SCT","^",I))=$P(LRX,"^",I)
  1.  ;
  1.  ; File susceptibilities
  1.  I $D(LRFDA) D FILE^DIE("","LRFDA(12)","LRMSG")
  1.  ;
  1.  ; Store code system references
  1.  I $D(LRCSR) D CSR^LRVRMI4A(.LRCSR,LRDFN_",MI,"_LRIDT_",12,"_IEN_",")
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. N17 ; Process Virology
  1.  N DIERR,IEN,IEN2,IEN3,LRFDA,LRIEN,LRMSG
  1.  ;
  1.  ;ZEXCEPT: LRDFN,LRDUZ,LRIDT,LRINTYPE,LRNOW,LRRPTAPP
  1.  ;
  1.  S (IEN,IEN2,IEN3)=0
  1.  F  S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,17,IEN)) Q:IEN<1  D N17A
  1.  ;
  1.  S LRIEN=LRIDT_","_LRDFN_","
  1.  I LRINTYPE=10 S LRFDA(17,63.05,LRIEN,33)=LRNOW
  1.  S LRFDA(17,63.05,LRIEN,35)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
  1.  D FILE^DIE("","LRFDA(17)","LRMSG")
  1.  S LRRPTAPP=1
  1.  Q
  1.  ;
  1.  ;
  1. N17A ; Process virus
  1.  ;
  1.  N DIERR,ISOID,LRFDA,LRI,LRIEN,LRMSG,LRN17,LRX,R6343
  1.  ;
  1.  ;ZEXCEPT: IEN,LRDFN,LRIDT,LRIENS,LRINTYPE
  1.  ;
  1.  S LRN17=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,17,IEN,0)
  1.  Q:LRN17=""
  1.  S ISOID=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,17,IEN,.1))
  1.  Q:ISOID=""
  1.  ;
  1.  ; Delete ISOID entry if it exists on LEDI (LRINTYPE=10) interfaces
  1.  ; On UI interfaces update virus for this isolate id.
  1.  S R6343=$O(^LR(LRDFN,"MI",LRIDT,17,"C",ISOID,0))
  1.  I R6343 D
  1.  . K LRFDA,LRMSG,LRIENS,DIERR
  1.  . S LRIEN=R6343_","_LRIDT_","_LRDFN_","
  1.  . I LRINTYPE=10 D
  1.  . . S LRFDA(17,63.43,LRIEN,.01)="@"
  1.  . . S R6343=""
  1.  . E  S LRFDA(17,63.43,LRIEN,.01)=LRN17 ; virus
  1.  . D FILE^DIE("","LRFDA(17)","LRMSG")
  1.  ;
  1.  ; On LEDI (LRINTYPE=10) interfaces existing ISOID was deleted above so always add record
  1.  I 'R6343 D
  1.  . K LRFDA,LRMSG,LRIENS,DIERR
  1.  . S LRIEN="+1,"_LRIDT_","_LRDFN_","
  1.  . S LRFDA(17,63.43,LRIEN,.01)=LRN17 ; virus
  1.  . S LRFDA(17,63.43,LRIEN,.1)=ISOID
  1.  . D UPDATE^DIE("","LRFDA(17)","LRIENS","LRMSG")
  1.  . S R6343=$G(LRIENS(1))
  1.  ;
  1.  ; Store code system references
  1.  S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,17,IEN,0,.01))
  1.  F LRI=1:1:3 I $P(LRX,"^",LRI) D
  1.  . N LRDATA
  1.  . S LRDATA(.01)=LRDFN_",MI,"_LRIDT_",17,"_R6343_",0"
  1.  . S LRDATA(.02)=$S(LRI<3:2,1:3),LRDATA(.03)=$P(LRX,"^",LRI),LRDATA(.04)=$P("LN^NLT^SCT","^",LRI)
  1.  . D SETREF^LRUCSR(LRDFN,LRDATA(.01),.LRDATA,1)
  1.  ;
  1.  ; Store performing lab
  1.  S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,17,IEN,0,.01,1))
  1.  I $P(LRX,"^") D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",17,"_R6343_",0",$P(LRX,"^"))
  1.  ;
  1.  S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,17,IEN,0,.01,0))
  1.  D BLDSTAT^LRVRMI4A(63.05,34,$P(LRX,"^"),.LRSTATUS)
  1.  ;
  1.  Q