LRVRMI2A ;DALOI/STAFF - LAH/TMP TO FILE #63 ;02/22/17 08:07
;;5.2;LAB SERVICE;**350,427,474,480**;Sep 27, 1994;Build 7
;
; Continuation of LRVRMI4 and is used for extracting results from the LAH global and storing it into LAB DATA FILE (#63).
;
Q
;
N9 ; Process Fungus/Yeast
N DATA,DIERR,IEN,IEN2,IEN3,ISOID,LRCMT,LRFDA,LRIEN,LRIENS,LRMSG,LRN9,LRX,R6337,STAT
;
;ZEXCEPT: LRDFN,LRDUZ,LRIDT,LRINTYPE,LRLL,LRNOW,LRPROF,LRRPTAPP,LRSTATUS
;
S (IEN,IEN2,IEN3)=0
F S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9,IEN)) Q:IEN<1 D N9A
;
K LRFDA,LRMSG,LRIENS,DIERR
S LRIEN=LRIDT_","_LRDFN_","
I LRINTYPE=10 S LRFDA(9,63.05,LRIEN,18)=LRNOW
S LRFDA(9,63.05,LRIEN,19.5)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
D FILE^DIE("","LRFDA(9)","LRMSG")
S LRRPTAPP=1
Q
;
;
N9A ; Process fungus yeast organism
;
N DIERR,IEN2,ISOID,LRCMT,LRFDA,LRFDAIEN,LRI,LRIEN,LRIENS,LRMSG,LRN9,LRX,R6337,STAT
;
;ZEXCEPT: IEN,LRDFN,LRIDT,LRINTYPE,LRLL,LRPROF,LRSTATUS
;
S LRN9=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9,IEN,0))
Q:LRN9=""
S ISOID=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9,IEN,.1))
Q:ISOID=""
;
; Delete ISOID entry if it exists on LEDI (LRINTYPE=10) interfaces
; On UI interfaces update fungus/yeast for this isolate id.
S R6337=$O(^LR(LRDFN,"MI",LRIDT,9,"C",ISOID,0))
I R6337 D
. K LRFDA,LRMSG,LRIENS,DIERR
. S LRIEN=R6337_","_LRIDT_","_LRDFN_","
. I LRINTYPE=10 D
. . S LRFDA(9,63.37,LRIEN,.01)="@"
. . S R6337=""
. E D
. . S LRFDA(9,63.37,LRIEN,.01)=$P(LRN9,U) ; fungus/yeast
. . I $P(LRN9,U,2)'="" S LRFDA(9,63.37,LRIEN,1)=$P(LRN9,U,2) ; quantity
. D FILE^DIE("","LRFDA(9)","LRMSG")
;
; On LEDI (LRINTYPE=10) interfaces existing ISOID was deleted above so always add record
I 'R6337 D
. K LRFDA,LRMSG,LRIENS,DIERR
. S LRIEN="+1,"_LRIDT_","_LRDFN_","
. S LRFDA(9,63.37,LRIEN,.01)=$P(LRN9,"^") ; fungus/yeast
. S LRFDA(9,63.37,LRIEN,.1)=ISOID
. S LRFDA(9,63.37,LRIEN,1)=$P(LRN9,"^",2) ; quantity
. D UPDATE^DIE("","LRFDA(9)","LRIENS","LRMSG")
. S R6337=$G(LRIENS(1))
;
Q:'R6337
;
; Store code system references for fungus
S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9,IEN,0,.01))
F LRI=1:1:3 I $P(LRX,"^",LRI) D
. N LRDATA
. S LRDATA(.01)=LRDFN_",MI,"_LRIDT_",9,"_R6337_",0;1"
. S LRDATA(.02)=$S(LRI<3:2,1:3),LRDATA(.03)=$P(LRX,"^",LRI),LRDATA(.04)=$P("LN^NLT^SCT","^",LRI)
. D SETREF^LRUCSR(LRDFN,LRDATA(.01),.LRDATA,1)
;
; Store code system references for yeast quantity
S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9,IEN,0,.02))
F LRI=1,2 I $P(LRX,"^",LRI) D
. N LRDATA
. S LRDATA(.01)=LRDFN_",MI,"_LRIDT_",9,"_R6337_"0;2"
. S LRDATA(.02)=2,LRDATA(.03)=$P(LRX,"^",LRI),LRDATA(.04)=$P("LN^NLT","^",LRI)
. D SETREF^LRUCSR(LRDFN,LRDATA(.01),.LRDATA,1)
;
; Store performing lab
S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9,IEN,0,.01,1))
I $P(LRX,"^") D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",9,"_R6337_",0",$P(LRX,"^"))
;
S STAT=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9,IEN,0,.01,0))
D BLDSTAT^LRVRMI4A(63.05,19,STAT,.LRSTATUS)
;
; fungus/yeast comments - comments don't have status
K LRFDA,LRFDAIEN,LRMSG,LRIENS,DIERR
M LRCMT=^LR(LRDFN,"MI",LRIDT,9,IEN,1)
S IEN2=0
F S IEN2=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9,IEN,1,IEN2)) Q:IEN2<1 D
. S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9,IEN,1,IEN2,0),LRX=$S(LRX'="":LRX,1:" ")
. I LRX'=" ",$$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX) Q
. S LRIEN="+"_IEN2_","_R6337_","_LRIDT_","_LRDFN_","
. S LRFDA(9,63.372,LRIEN,.01)=LRX
;
I $D(LRFDA) D UPDATE^DIE("","LRFDA(9)","","LRMSG")
;
Q
;
;
N11 ; Process Acid Fast
N AFS,DIERR,LRFDA,LRIEN,LRIENS,LRMSG,LRX,QTY
;
;ZEXCEPT: LRDFN,LRDUZ,LRI,LRIDT,LRINTYPE,LRNOW,LRRPTAPP
;
S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,11))
D BLDSTAT^LRVRMI4A(63.05,23,$P(LRX,"^",2),.LRSTATUS)
;
S LRIEN=LRIDT_","_LRDFN_","
I LRINTYPE=10 S LRFDA(11,63.05,LRIEN,22)=LRNOW
S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,11,0))
S AFS=$P(LRX,"^",3),QTY=$P(LRX,U,4)
S LRFDA(11,63.05,LRIEN,24)=AFS ; Acid Fast Stain
;I $L(QTY)>68 S QTY=$E(QTY,1,65)_"..."
S LRFDA(11,63.05,LRIEN,25)=QTY ; Quantity
S LRFDA(11,63.05,LRIEN,25.5)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
; derive status
I AFS'="" D
. S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,11,0,.01,0))
. D BLDSTAT^LRVRMI4A(63.05,23,$P(LRX,"^"),.LRSTATUS)
I QTY'="" D
. S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,11,0,.02,0))
. D BLDSTAT^LRVRMI4A(63.05,23,$P(LRX,"^"),.LRSTATUS)
;
D FILE^DIE("","LRFDA(11)","LRMSG")
S LRRPTAPP=1
;
; Store code system references for AFB Stain
S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,11,0,.01))
F LRI=1,2 I $P(LRX,"^",LRI) D
. N LRDATA
. S LRDATA(.01)=LRDFN_",MI,"_LRIDT_",11,0;3"
. S LRDATA(.02)=2,LRDATA(.03)=$P(LRX,"^",LRI),LRDATA(.04)=$P("LN^NLT","^",LRI)
. D SETREF^LRUCSR(LRDFN,LRDATA(.01),.LRDATA,1)
;
; Store code system references for AFB quantity
S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,11,0,.02))
F LRI=1,2 I $P(LRX,"^",LRI) D
. N LRDATA
. S LRDATA(.01)=LRDFN_",MI,"_LRIDT_",11,0;4"
. S LRDATA(.02)=2,LRDATA(.03)=$P(LRX,"^",LRI),LRDATA(.04)=$P("LN^NLT","^",LRI)
. D SETREF^LRUCSR(LRDFN,LRDATA(.01),.LRDATA,1)
;
Q
;
;
N12 ; Process Mycobacteria
;
N DATA,DIERR,DNFLDS,FLD,IEN,IEN2,ISOID,LRCMT,LRFDA,LRIEN,LRIENS,LRMSG,LRN12,LRX,R6339,STAT
;
;ZEXCEPT: LRDFN,LRIDT,LRLL,LRPROF,LRSTATUS
;
S IEN=0
F S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN)) Q:IEN<1 D N12A
;
Q
;
;
N12A ; Process mycobacteria organism
;
N DATA,DIERR,DNFLDS,FLD,I,IEN2,ISOID,LRCMT,LRCSR,LRFDA,LRI,LRIEN,LRIENS,LRMSG,LRN12,LRX,R6339,STAT
;
;ZEXCEPT: IEN,LRDFN,LRIDT,LRINTYPE,LRLL,LRPROF,LRSTATUS
;
S LRN12=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN,0))
Q:LRN12=""
S ISOID=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN,.1))
Q:ISOID=""
;
; Delete ISOID entry if it exists on LEDI (LRINTYPE=10) interfaces
; On UI interfaces update mycobacteria for this isolate id.
S R6339=$O(^LR(LRDFN,"MI",LRIDT,12,"C",ISOID,0))
I R6339 D
. K LRFDA,LRMSG,LRIENS,DIERR
. S LRIEN=R6339_","_LRIDT_","_LRDFN_","
. I LRINTYPE=10 D
. . S LRFDA(12,63.39,LRIEN,.01)="@"
. . S R6339=""
. E D
. . S LRFDA(12,63.39,LRIEN,.01)=$P(LRN12,U) ; mycobacteria
. . I $P(LRN12,U,2)'="" S LRFDA(12,63.39,LRIEN,1)=$P(LRN12,U,2) ; quantity
. D FILE^DIE("","LRFDA(12)","LRMSG")
;
; On LEDI (LRINTYPE=10) interfaces existing ISOID was deleted above so always add record
I 'R6339 D
. K LRFDA,LRMSG,LRIENS,DIERR
. S LRIEN="+1,"_LRIDT_","_LRDFN_","
. S LRFDA(12,63.39,LRIEN,.01)=$P(LRN12,"^") ; fungus/yeast
. S LRFDA(12,63.39,LRIEN,.1)=ISOID
. S LRFDA(12,63.39,LRIEN,1)=$P(LRN12,"^",2) ; quantity
. D UPDATE^DIE("","LRFDA(12)","LRIENS","LRMSG")
. S R6339=$G(LRIENS(1))
;
Q:'R6339
;
; Store code system references
S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN,0,.01))
F LRI=1:1:3 I $P(LRX,"^",LRI) D
. N LRDATA
. S LRDATA(.01)=LRDFN_",MI,"_LRIDT_",12,"_R6339_",0"
. S LRDATA(.02)=$S(LRI<3:2,1:3),LRDATA(.03)=$P(LRX,"^",LRI),LRDATA(.04)=$P("LN^NLT^SCT","^",LRI)
. D SETREF^LRUCSR(LRDFN,LRDATA(.01),.LRDATA,1)
;
; Store performing lab
S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN,0,.01,1))
I $P(LRX,"^") D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",12,"_R6339_",0",$P(LRX,"^"))
;
S STAT=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN,0,.01,0))
D BLDSTAT^LRVRMI4A(63.05,23,STAT,.LRSTATUS)
;
; Process comments
K LRFDA,LRIENS,LRMSG,DIERR
M LRCMT=^LR(LRDFN,"MI",LRIDT,12,IEN,1)
S IEN2=0
F S IEN2=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN,1,IEN2)) Q:'IEN2 D
. S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN,1,IEN2,0),LRX=$S(LRX'="":LRX,1:" ")
. I LRX'=" ",$$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX) Q
. S LRIEN="+"_IEN2_","_R6339_","_LRIDT_","_LRDFN_","
. S LRFDA(12,63.4,LRIEN,.01)=LRX
I $D(LRFDA) D UPDATE^DIE("","LRFDA(12)","","LRMSG")
;
; Add drug susceptibilities
S IEN2=1.999999999,IEN2=2
K LRFDA,LRIENS,LRMSG,DIERR
F S IEN2=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN,IEN2)) Q:'IEN2 D ;
. S STAT=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN,IEN2,.01,0))
. D BLDSTAT^LRVRMI4A(63.05,23,STAT,.LRSTATUS)
. S LRIEN=R6339_","_LRIDT_","_LRDFN_","
. S DATA=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN,IEN2)
. S DNFLDS=$$DN2FLDS^LRVRMI4A(IEN2,,12)
. S FLD=$P(DNFLDS,"^",1)
. I FLD S LRFDA(12,63.39,LRIEN,FLD)=DATA
. S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,IEN,IEN2,.01))
. 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)
;
; File susceptibilities
I $D(LRFDA) D FILE^DIE("","LRFDA(12)","LRMSG")
;
; Store code system references
I $D(LRCSR) D CSR^LRVRMI4A(.LRCSR,LRDFN_",MI,"_LRIDT_",12,"_IEN_",")
;
Q
;
;
N17 ; Process Virology
N DIERR,IEN,IEN2,IEN3,LRFDA,LRIEN,LRMSG
;
;ZEXCEPT: LRDFN,LRDUZ,LRIDT,LRINTYPE,LRNOW,LRRPTAPP
;
S (IEN,IEN2,IEN3)=0
F S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,17,IEN)) Q:IEN<1 D N17A
;
S LRIEN=LRIDT_","_LRDFN_","
I LRINTYPE=10 S LRFDA(17,63.05,LRIEN,33)=LRNOW
S LRFDA(17,63.05,LRIEN,35)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
D FILE^DIE("","LRFDA(17)","LRMSG")
S LRRPTAPP=1
Q
;
;
N17A ; Process virus
;
N DIERR,ISOID,LRFDA,LRI,LRIEN,LRMSG,LRN17,LRX,R6343
;
;ZEXCEPT: IEN,LRDFN,LRIDT,LRIENS,LRINTYPE
;
S LRN17=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,17,IEN,0)
Q:LRN17=""
S ISOID=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,17,IEN,.1))
Q:ISOID=""
;
; Delete ISOID entry if it exists on LEDI (LRINTYPE=10) interfaces
; On UI interfaces update virus for this isolate id.
S R6343=$O(^LR(LRDFN,"MI",LRIDT,17,"C",ISOID,0))
I R6343 D
. K LRFDA,LRMSG,LRIENS,DIERR
. S LRIEN=R6343_","_LRIDT_","_LRDFN_","
. I LRINTYPE=10 D
. . S LRFDA(17,63.43,LRIEN,.01)="@"
. . S R6343=""
. E S LRFDA(17,63.43,LRIEN,.01)=LRN17 ; virus
. D FILE^DIE("","LRFDA(17)","LRMSG")
;
; On LEDI (LRINTYPE=10) interfaces existing ISOID was deleted above so always add record
I 'R6343 D
. K LRFDA,LRMSG,LRIENS,DIERR
. S LRIEN="+1,"_LRIDT_","_LRDFN_","
. S LRFDA(17,63.43,LRIEN,.01)=LRN17 ; virus
. S LRFDA(17,63.43,LRIEN,.1)=ISOID
. D UPDATE^DIE("","LRFDA(17)","LRIENS","LRMSG")
. S R6343=$G(LRIENS(1))
;
; Store code system references
S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,17,IEN,0,.01))
F LRI=1:1:3 I $P(LRX,"^",LRI) D
. N LRDATA
. S LRDATA(.01)=LRDFN_",MI,"_LRIDT_",17,"_R6343_",0"
. S LRDATA(.02)=$S(LRI<3:2,1:3),LRDATA(.03)=$P(LRX,"^",LRI),LRDATA(.04)=$P("LN^NLT^SCT","^",LRI)
. D SETREF^LRUCSR(LRDFN,LRDATA(.01),.LRDATA,1)
;
; Store performing lab
S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,17,IEN,0,.01,1))
I $P(LRX,"^") D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",17,"_R6343_",0",$P(LRX,"^"))
;
S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,17,IEN,0,.01,0))
D BLDSTAT^LRVRMI4A(63.05,34,$P(LRX,"^"),.LRSTATUS)
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRVRMI2A 10794 printed Apr 09, 2024@21:21:09 Page 2
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
+2 ;
+3 ; Continuation of LRVRMI4 and is used for extracting results from the LAH global and storing it into LAB DATA FILE (#63).
+4 ;
+5 QUIT
+6 ;
N9 ; Process Fungus/Yeast
+1 NEW DATA,DIERR,IEN,IEN2,IEN3,ISOID,LRCMT,LRFDA,LRIEN,LRIENS,LRMSG,LRN9,LRX,R6337,STAT
+2 ;
+3 ;ZEXCEPT: LRDFN,LRDUZ,LRIDT,LRINTYPE,LRLL,LRNOW,LRPROF,LRRPTAPP,LRSTATUS
+4 ;
+5 SET (IEN,IEN2,IEN3)=0
+6 FOR
SET IEN=$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,9,IEN))
if IEN<1
QUIT
DO N9A
+7 ;
+8 KILL LRFDA,LRMSG,LRIENS,DIERR
+9 SET LRIEN=LRIDT_","_LRDFN_","
+10 IF LRINTYPE=10
SET LRFDA(9,63.05,LRIEN,18)=LRNOW
+11 SET LRFDA(9,63.05,LRIEN,19.5)=$SELECT($GET(LRDUZ):LRDUZ,1:$GET(DUZ))
+12 DO FILE^DIE("","LRFDA(9)","LRMSG")
+13 SET LRRPTAPP=1
+14 QUIT
+15 ;
+16 ;
N9A ; Process fungus yeast organism
+1 ;
+2 NEW DIERR,IEN2,ISOID,LRCMT,LRFDA,LRFDAIEN,LRI,LRIEN,LRIENS,LRMSG,LRN9,LRX,R6337,STAT
+3 ;
+4 ;ZEXCEPT: IEN,LRDFN,LRIDT,LRINTYPE,LRLL,LRPROF,LRSTATUS
+5 ;
+6 SET LRN9=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,9,IEN,0))
+7 if LRN9=""
QUIT
+8 SET ISOID=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,9,IEN,.1))
+9 if ISOID=""
QUIT
+10 ;
+11 ; Delete ISOID entry if it exists on LEDI (LRINTYPE=10) interfaces
+12 ; On UI interfaces update fungus/yeast for this isolate id.
+13 SET R6337=$ORDER(^LR(LRDFN,"MI",LRIDT,9,"C",ISOID,0))
+14 IF R6337
Begin DoDot:1
+15 KILL LRFDA,LRMSG,LRIENS,DIERR
+16 SET LRIEN=R6337_","_LRIDT_","_LRDFN_","
+17 IF LRINTYPE=10
Begin DoDot:2
+18 SET LRFDA(9,63.37,LRIEN,.01)="@"
+19 SET R6337=""
End DoDot:2
+20 IF '$TEST
Begin DoDot:2
+21 ; fungus/yeast
SET LRFDA(9,63.37,LRIEN,.01)=$PIECE(LRN9,U)
+22 ; quantity
IF $PIECE(LRN9,U,2)'=""
SET LRFDA(9,63.37,LRIEN,1)=$PIECE(LRN9,U,2)
End DoDot:2
+23 DO FILE^DIE("","LRFDA(9)","LRMSG")
End DoDot:1
+24 ;
+25 ; On LEDI (LRINTYPE=10) interfaces existing ISOID was deleted above so always add record
+26 IF 'R6337
Begin DoDot:1
+27 KILL LRFDA,LRMSG,LRIENS,DIERR
+28 SET LRIEN="+1,"_LRIDT_","_LRDFN_","
+29 ; fungus/yeast
SET LRFDA(9,63.37,LRIEN,.01)=$PIECE(LRN9,"^")
+30 SET LRFDA(9,63.37,LRIEN,.1)=ISOID
+31 ; quantity
SET LRFDA(9,63.37,LRIEN,1)=$PIECE(LRN9,"^",2)
+32 DO UPDATE^DIE("","LRFDA(9)","LRIENS","LRMSG")
+33 SET R6337=$GET(LRIENS(1))
End DoDot:1
+34 ;
+35 if 'R6337
QUIT
+36 ;
+37 ; Store code system references for fungus
+38 SET LRX=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,9,IEN,0,.01))
+39 FOR LRI=1:1:3
IF $PIECE(LRX,"^",LRI)
Begin DoDot:1
+40 NEW LRDATA
+41 SET LRDATA(.01)=LRDFN_",MI,"_LRIDT_",9,"_R6337_",0;1"
+42 SET LRDATA(.02)=$SELECT(LRI<3:2,1:3)
SET LRDATA(.03)=$PIECE(LRX,"^",LRI)
SET LRDATA(.04)=$PIECE("LN^NLT^SCT","^",LRI)
+43 DO SETREF^LRUCSR(LRDFN,LRDATA(.01),.LRDATA,1)
End DoDot:1
+44 ;
+45 ; Store code system references for yeast quantity
+46 SET LRX=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,9,IEN,0,.02))
+47 FOR LRI=1,2
IF $PIECE(LRX,"^",LRI)
Begin DoDot:1
+48 NEW LRDATA
+49 SET LRDATA(.01)=LRDFN_",MI,"_LRIDT_",9,"_R6337_"0;2"
+50 SET LRDATA(.02)=2
SET LRDATA(.03)=$PIECE(LRX,"^",LRI)
SET LRDATA(.04)=$PIECE("LN^NLT","^",LRI)
+51 DO SETREF^LRUCSR(LRDFN,LRDATA(.01),.LRDATA,1)
End DoDot:1
+52 ;
+53 ; Store performing lab
+54 SET LRX=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,9,IEN,0,.01,1))
+55 IF $PIECE(LRX,"^")
DO SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",9,"_R6337_",0",$PIECE(LRX,"^"))
+56 ;
+57 SET STAT=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,9,IEN,0,.01,0))
+58 DO BLDSTAT^LRVRMI4A(63.05,19,STAT,.LRSTATUS)
+59 ;
+60 ; fungus/yeast comments - comments don't have status
+61 KILL LRFDA,LRFDAIEN,LRMSG,LRIENS,DIERR
+62 MERGE LRCMT=^LR(LRDFN,"MI",LRIDT,9,IEN,1)
+63 SET IEN2=0
+64 FOR
SET IEN2=$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,9,IEN,1,IEN2))
if IEN2<1
QUIT
Begin DoDot:1
+65 SET LRX=^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,9,IEN,1,IEN2,0)
SET LRX=$SELECT(LRX'="":LRX,1:" ")
+66 IF LRX'=" "
IF $$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX)
QUIT
+67 SET LRIEN="+"_IEN2_","_R6337_","_LRIDT_","_LRDFN_","
+68 SET LRFDA(9,63.372,LRIEN,.01)=LRX
End DoDot:1
+69 ;
+70 IF $DATA(LRFDA)
DO UPDATE^DIE("","LRFDA(9)","","LRMSG")
+71 ;
+72 QUIT
+73 ;
+74 ;
N11 ; Process Acid Fast
+1 NEW AFS,DIERR,LRFDA,LRIEN,LRIENS,LRMSG,LRX,QTY
+2 ;
+3 ;ZEXCEPT: LRDFN,LRDUZ,LRI,LRIDT,LRINTYPE,LRNOW,LRRPTAPP
+4 ;
+5 SET LRX=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,11))
+6 DO BLDSTAT^LRVRMI4A(63.05,23,$PIECE(LRX,"^",2),.LRSTATUS)
+7 ;
+8 SET LRIEN=LRIDT_","_LRDFN_","
+9 IF LRINTYPE=10
SET LRFDA(11,63.05,LRIEN,22)=LRNOW
+10 SET LRX=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,11,0))
+11 SET AFS=$PIECE(LRX,"^",3)
SET QTY=$PIECE(LRX,U,4)
+12 ; Acid Fast Stain
SET LRFDA(11,63.05,LRIEN,24)=AFS
+13 ;I $L(QTY)>68 S QTY=$E(QTY,1,65)_"..."
+14 ; Quantity
SET LRFDA(11,63.05,LRIEN,25)=QTY
+15 SET LRFDA(11,63.05,LRIEN,25.5)=$SELECT($GET(LRDUZ):LRDUZ,1:$GET(DUZ))
+16 ; derive status
+17 IF AFS'=""
Begin DoDot:1
+18 SET LRX=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,11,0,.01,0))
+19 DO BLDSTAT^LRVRMI4A(63.05,23,$PIECE(LRX,"^"),.LRSTATUS)
End DoDot:1
+20 IF QTY'=""
Begin DoDot:1
+21 SET LRX=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,11,0,.02,0))
+22 DO BLDSTAT^LRVRMI4A(63.05,23,$PIECE(LRX,"^"),.LRSTATUS)
End DoDot:1
+23 ;
+24 DO FILE^DIE("","LRFDA(11)","LRMSG")
+25 SET LRRPTAPP=1
+26 ;
+27 ; Store code system references for AFB Stain
+28 SET LRX=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,11,0,.01))
+29 FOR LRI=1,2
IF $PIECE(LRX,"^",LRI)
Begin DoDot:1
+30 NEW LRDATA
+31 SET LRDATA(.01)=LRDFN_",MI,"_LRIDT_",11,0;3"
+32 SET LRDATA(.02)=2
SET LRDATA(.03)=$PIECE(LRX,"^",LRI)
SET LRDATA(.04)=$PIECE("LN^NLT","^",LRI)
+33 DO SETREF^LRUCSR(LRDFN,LRDATA(.01),.LRDATA,1)
End DoDot:1
+34 ;
+35 ; Store code system references for AFB quantity
+36 SET LRX=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,11,0,.02))
+37 FOR LRI=1,2
IF $PIECE(LRX,"^",LRI)
Begin DoDot:1
+38 NEW LRDATA
+39 SET LRDATA(.01)=LRDFN_",MI,"_LRIDT_",11,0;4"
+40 SET LRDATA(.02)=2
SET LRDATA(.03)=$PIECE(LRX,"^",LRI)
SET LRDATA(.04)=$PIECE("LN^NLT","^",LRI)
+41 DO SETREF^LRUCSR(LRDFN,LRDATA(.01),.LRDATA,1)
End DoDot:1
+42 ;
+43 QUIT
+44 ;
+45 ;
N12 ; Process Mycobacteria
+1 ;
+2 NEW DATA,DIERR,DNFLDS,FLD,IEN,IEN2,ISOID,LRCMT,LRFDA,LRIEN,LRIENS,LRMSG,LRN12,LRX,R6339,STAT
+3 ;
+4 ;ZEXCEPT: LRDFN,LRIDT,LRLL,LRPROF,LRSTATUS
+5 ;
+6 SET IEN=0
+7 FOR
SET IEN=$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,12,IEN))
if IEN<1
QUIT
DO N12A
+8 ;
+9 QUIT
+10 ;
+11 ;
N12A ; Process mycobacteria organism
+1 ;
+2 NEW DATA,DIERR,DNFLDS,FLD,I,IEN2,ISOID,LRCMT,LRCSR,LRFDA,LRI,LRIEN,LRIENS,LRMSG,LRN12,LRX,R6339,STAT
+3 ;
+4 ;ZEXCEPT: IEN,LRDFN,LRIDT,LRINTYPE,LRLL,LRPROF,LRSTATUS
+5 ;
+6 SET LRN12=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,12,IEN,0))
+7 if LRN12=""
QUIT
+8 SET ISOID=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,12,IEN,.1))
+9 if ISOID=""
QUIT
+10 ;
+11 ; Delete ISOID entry if it exists on LEDI (LRINTYPE=10) interfaces
+12 ; On UI interfaces update mycobacteria for this isolate id.
+13 SET R6339=$ORDER(^LR(LRDFN,"MI",LRIDT,12,"C",ISOID,0))
+14 IF R6339
Begin DoDot:1
+15 KILL LRFDA,LRMSG,LRIENS,DIERR
+16 SET LRIEN=R6339_","_LRIDT_","_LRDFN_","
+17 IF LRINTYPE=10
Begin DoDot:2
+18 SET LRFDA(12,63.39,LRIEN,.01)="@"
+19 SET R6339=""
End DoDot:2
+20 IF '$TEST
Begin DoDot:2
+21 ; mycobacteria
SET LRFDA(12,63.39,LRIEN,.01)=$PIECE(LRN12,U)
+22 ; quantity
IF $PIECE(LRN12,U,2)'=""
SET LRFDA(12,63.39,LRIEN,1)=$PIECE(LRN12,U,2)
End DoDot:2
+23 DO FILE^DIE("","LRFDA(12)","LRMSG")
End DoDot:1
+24 ;
+25 ; On LEDI (LRINTYPE=10) interfaces existing ISOID was deleted above so always add record
+26 IF 'R6339
Begin DoDot:1
+27 KILL LRFDA,LRMSG,LRIENS,DIERR
+28 SET LRIEN="+1,"_LRIDT_","_LRDFN_","
+29 ; fungus/yeast
SET LRFDA(12,63.39,LRIEN,.01)=$PIECE(LRN12,"^")
+30 SET LRFDA(12,63.39,LRIEN,.1)=ISOID
+31 ; quantity
SET LRFDA(12,63.39,LRIEN,1)=$PIECE(LRN12,"^",2)
+32 DO UPDATE^DIE("","LRFDA(12)","LRIENS","LRMSG")
+33 SET R6339=$GET(LRIENS(1))
End DoDot:1
+34 ;
+35 if 'R6339
QUIT
+36 ;
+37 ; Store code system references
+38 SET LRX=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,12,IEN,0,.01))
+39 FOR LRI=1:1:3
IF $PIECE(LRX,"^",LRI)
Begin DoDot:1
+40 NEW LRDATA
+41 SET LRDATA(.01)=LRDFN_",MI,"_LRIDT_",12,"_R6339_",0"
+42 SET LRDATA(.02)=$SELECT(LRI<3:2,1:3)
SET LRDATA(.03)=$PIECE(LRX,"^",LRI)
SET LRDATA(.04)=$PIECE("LN^NLT^SCT","^",LRI)
+43 DO SETREF^LRUCSR(LRDFN,LRDATA(.01),.LRDATA,1)
End DoDot:1
+44 ;
+45 ; Store performing lab
+46 SET LRX=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,12,IEN,0,.01,1))
+47 IF $PIECE(LRX,"^")
DO SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",12,"_R6339_",0",$PIECE(LRX,"^"))
+48 ;
+49 SET STAT=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,12,IEN,0,.01,0))
+50 DO BLDSTAT^LRVRMI4A(63.05,23,STAT,.LRSTATUS)
+51 ;
+52 ; Process comments
+53 KILL LRFDA,LRIENS,LRMSG,DIERR
+54 MERGE LRCMT=^LR(LRDFN,"MI",LRIDT,12,IEN,1)
+55 SET IEN2=0
+56 FOR
SET IEN2=$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,12,IEN,1,IEN2))
if 'IEN2
QUIT
Begin DoDot:1
+57 SET LRX=^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,12,IEN,1,IEN2,0)
SET LRX=$SELECT(LRX'="":LRX,1:" ")
+58 IF LRX'=" "
IF $$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX)
QUIT
+59 SET LRIEN="+"_IEN2_","_R6339_","_LRIDT_","_LRDFN_","
+60 SET LRFDA(12,63.4,LRIEN,.01)=LRX
End DoDot:1
+61 IF $DATA(LRFDA)
DO UPDATE^DIE("","LRFDA(12)","","LRMSG")
+62 ;
+63 ; Add drug susceptibilities
+64 SET IEN2=1.999999999
SET IEN2=2
+65 KILL LRFDA,LRIENS,LRMSG,DIERR
+66 ;
FOR
SET IEN2=$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,12,IEN,IEN2))
if 'IEN2
QUIT
Begin DoDot:1
+67 SET STAT=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,12,IEN,IEN2,.01,0))
+68 DO BLDSTAT^LRVRMI4A(63.05,23,STAT,.LRSTATUS)
+69 SET LRIEN=R6339_","_LRIDT_","_LRDFN_","
+70 SET DATA=^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,12,IEN,IEN2)
+71 SET DNFLDS=$$DN2FLDS^LRVRMI4A(IEN2,,12)
+72 SET FLD=$PIECE(DNFLDS,"^",1)
+73 IF FLD
SET LRFDA(12,63.39,LRIEN,FLD)=DATA
+74 SET LRX=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,12,IEN,IEN2,.01))
+75 FOR I=1:1:3
IF $PIECE(LRX,"^",I)
SET LRCSR(IEN2_";1",$SELECT(I<3:2,1:3),$PIECE("LN^NLT^SCT","^",I))=$PIECE(LRX,"^",I)
End DoDot:1
+76 ;
+77 ; File susceptibilities
+78 IF $DATA(LRFDA)
DO FILE^DIE("","LRFDA(12)","LRMSG")
+79 ;
+80 ; Store code system references
+81 IF $DATA(LRCSR)
DO CSR^LRVRMI4A(.LRCSR,LRDFN_",MI,"_LRIDT_",12,"_IEN_",")
+82 ;
+83 QUIT
+84 ;
+85 ;
N17 ; Process Virology
+1 NEW DIERR,IEN,IEN2,IEN3,LRFDA,LRIEN,LRMSG
+2 ;
+3 ;ZEXCEPT: LRDFN,LRDUZ,LRIDT,LRINTYPE,LRNOW,LRRPTAPP
+4 ;
+5 SET (IEN,IEN2,IEN3)=0
+6 FOR
SET IEN=$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,17,IEN))
if IEN<1
QUIT
DO N17A
+7 ;
+8 SET LRIEN=LRIDT_","_LRDFN_","
+9 IF LRINTYPE=10
SET LRFDA(17,63.05,LRIEN,33)=LRNOW
+10 SET LRFDA(17,63.05,LRIEN,35)=$SELECT($GET(LRDUZ):LRDUZ,1:$GET(DUZ))
+11 DO FILE^DIE("","LRFDA(17)","LRMSG")
+12 SET LRRPTAPP=1
+13 QUIT
+14 ;
+15 ;
N17A ; Process virus
+1 ;
+2 NEW DIERR,ISOID,LRFDA,LRI,LRIEN,LRMSG,LRN17,LRX,R6343
+3 ;
+4 ;ZEXCEPT: IEN,LRDFN,LRIDT,LRIENS,LRINTYPE
+5 ;
+6 SET LRN17=^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,17,IEN,0)
+7 if LRN17=""
QUIT
+8 SET ISOID=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,17,IEN,.1))
+9 if ISOID=""
QUIT
+10 ;
+11 ; Delete ISOID entry if it exists on LEDI (LRINTYPE=10) interfaces
+12 ; On UI interfaces update virus for this isolate id.
+13 SET R6343=$ORDER(^LR(LRDFN,"MI",LRIDT,17,"C",ISOID,0))
+14 IF R6343
Begin DoDot:1
+15 KILL LRFDA,LRMSG,LRIENS,DIERR
+16 SET LRIEN=R6343_","_LRIDT_","_LRDFN_","
+17 IF LRINTYPE=10
Begin DoDot:2
+18 SET LRFDA(17,63.43,LRIEN,.01)="@"
+19 SET R6343=""
End DoDot:2
+20 ; virus
IF '$TEST
SET LRFDA(17,63.43,LRIEN,.01)=LRN17
+21 DO FILE^DIE("","LRFDA(17)","LRMSG")
End DoDot:1
+22 ;
+23 ; On LEDI (LRINTYPE=10) interfaces existing ISOID was deleted above so always add record
+24 IF 'R6343
Begin DoDot:1
+25 KILL LRFDA,LRMSG,LRIENS,DIERR
+26 SET LRIEN="+1,"_LRIDT_","_LRDFN_","
+27 ; virus
SET LRFDA(17,63.43,LRIEN,.01)=LRN17
+28 SET LRFDA(17,63.43,LRIEN,.1)=ISOID
+29 DO UPDATE^DIE("","LRFDA(17)","LRIENS","LRMSG")
+30 SET R6343=$GET(LRIENS(1))
End DoDot:1
+31 ;
+32 ; Store code system references
+33 SET LRX=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,17,IEN,0,.01))
+34 FOR LRI=1:1:3
IF $PIECE(LRX,"^",LRI)
Begin DoDot:1
+35 NEW LRDATA
+36 SET LRDATA(.01)=LRDFN_",MI,"_LRIDT_",17,"_R6343_",0"
+37 SET LRDATA(.02)=$SELECT(LRI<3:2,1:3)
SET LRDATA(.03)=$PIECE(LRX,"^",LRI)
SET LRDATA(.04)=$PIECE("LN^NLT^SCT","^",LRI)
+38 DO SETREF^LRUCSR(LRDFN,LRDATA(.01),.LRDATA,1)
End DoDot:1
+39 ;
+40 ; Store performing lab
+41 SET LRX=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,17,IEN,0,.01,1))
+42 IF $PIECE(LRX,"^")
DO SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",17,"_R6343_",0",$PIECE(LRX,"^"))
+43 ;
+44 SET LRX=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,17,IEN,0,.01,0))
+45 DO BLDSTAT^LRVRMI4A(63.05,34,$PIECE(LRX,"^"),.LRSTATUS)
+46 ;
+47 QUIT
