LRVRMI4 ;DALOI/STAFF - LAH/TMP TO FILE 63 ;09/07/16 08:09
;;5.2;LAB SERVICE;**350,427,474**;Sep 27, 1994;Build 14
;
; Extracts the information in the ^TMP("LRMI",$J) global and stores it into the Lab Data micro subfile.
;
Q
;
EN ;
N LRNODE,LRNOW,LRRPTAPP,LRSTATUS,LR63539,X,I
Q:'$D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT))
S LRNOW=$$NOW^XLFDT
; Get IEN of last Micro Audit on file
S LR63539=0
S X=$O(^LR(LRDFN,"MI",LRIDT,32,"B","A"),-1)
I X S LR63539=$O(^LR(LRDFN,"MI",LRIDT,32,"B",X,0))
;
; If any of these nodes are defined then trigger the audit
F I=1,2,3,4,5,6,7,8,9,10,11,12,13,15,16,17,18,99 I $D(^LR(LRDFN,"MI",LRIDT,I)) D Q
. I $G(LRSB)'>0 N LRSB S LRSB=$S(I<5:1,I<8:5,I<11:8,I<14:11,I<19:16,I=99:.99,1:0)
. I LRSB>0 D AUDTRG
;
I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,2,0)) D N2
I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,0)) D N3^LRVRMI4A
I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,4,0)) D N4
I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,0)) D N6^LRVRMI4A
I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,7,0)) D N7^LRVRMI2
I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,9,0)) D N9^LRVRMI2A
I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,10,0)) D N10^LRVRMI2
I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,11)) D N11^LRVRMI2A
I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,12,0)) D N12^LRVRMI2A
I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,13,0)) D N13^LRVRMI2
;I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,15,0)) D N15^LRVRMI2
I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,17,0)) D N17^LRVRMI2A
I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,18,0)) D N18^LRVRMI2
;
F LRNODE=15,19:1:31 I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,LRNODE,0)) D NODE^LRVRMI3(LRNODE)
;
I $D(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,99)) D N99
;
; Only release report when receving verified report from external lab (LEDI interface)
I LRINTYPE=10 D
. D SETSTAT^LRVRMI4A(.LRSTATUS)
. I (LRSTATUS(0)="C")!(LRSTATUS(0)="F") D FIN ; ccr_5439n - Added IF statement to only Do FIN if overall status is final or corrected. LMT 9/6/11
;
I $G(LRRPTAPP) D VT1^LRMIUT1
;
; Update MICRO AUDIT to reflect corrected status on verified reference lab reports (interface type 10 in file #62.48)
; If audit doesn't exist then create instead of updating.
I LRINTYPE=10,LRSTATUS(0)="C" D
. I LR63539<1 D AUDTRG Q
. N LRFDA,LRIEN,LRMSG,DIERR
. S LRIEN=LR63539_","_LRIDT_","_LRDFN_","
. S LRFDA(1,63.539,LRIEN,3)=3 ; Edit Type
. D FILE^DIE("","LRFDA(1)","LRMSG")
;
Q
;
;
FIN ; Release report
N LRFDA,LRIEN,LRMSG,DIERR
S LRIEN=LRIDT_","_LRDFN_","
S LRFDA(1,63.05,LRIEN,.04)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
S LRFDA(1,63.05,LRIEN,.03)=LRNOW
;S LRFDA(1,63.05,LRIEN,.2)=LRNOW ; ccr_5439n - Commented this line out as there is no field .2 in subfile #63.05. LMT 9/6/11
D FILE^DIE("","LRFDA(1)","LRMSG")
Q
;
;
N2 ; Process gram stain comments
N DIERR,IEN,LRCMT,LRCSR,LRDATA,LRFDA,LRFDAIEN,LRIEN,LRIENS,LRMSG,LRPL,LRX,STAT
;
M LRCMT=^LR(LRDFN,"MI",LRIDT,2)
;
S IEN=0,STAT=""
F S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,2,IEN)) Q:IEN<1 D
. S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,2,IEN,0),LRX=$S(LRX'="":LRX,1:" ")
. I LRX'=" ",$$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX) Q
. S LRIEN="+"_IEN_","_LRIDT_","_LRDFN_","
. S LRFDA(2,63.29,LRIEN,.01)=LRX
. S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,2,IEN,0,0)
. I $P(LRX,"^") S LRPL(IEN)=$P(LRX,"^")
. I $P(LRX,"^",3) S LRCSR(IEN,2,"LN")=$P(LRX,"^",3)
. I $P(LRX,"^",4) S LRCSR(IEN,2,"NLT")=$P(LRX,"^",4)
. I $P(LRX,"^",5)'="" D BLDSTAT^LRVRMI4A(63.05,11.5,$P(LRX,"^",5),.LRSTATUS)
I '$D(LRFDA) Q
;
D UPDATE^DIE("","LRFDA(2)","LRFDAIEN","LRMSG")
; Store performing lab
S IEN=0
F S IEN=$O(LRPL(IEN)) Q:'IEN D
. I $G(LRPL(IEN)),$G(LRFDAIEN(IEN)) D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",2,"_LRFDAIEN(IEN),LRPL(IEN))
;
; Store code system references
I $D(LRCSR) D CSR(.LRCSR,.LRFDAIEN,LRDFN_",MI,"_LRIDT_",2,")
;
K LRFDA,LRIENS,LRMSG,DIERR
S LRIEN=LRIDT_","_LRDFN_","
I LRINTYPE=10 S LRFDA(2,63.05,LRIEN,11)=LRNOW
S LRFDA(2,63.05,LRIEN,11.55)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
D FILE^DIE("","LRFDA(2)","LRMSG")
S LRRPTAPP=1
Q
;
;
N4 ; Bact report remarks
N DIERR,IEN,LRCMT,LRCSR,LRFDA,LRFDAIEN,LRIEN,LRIENS,LRMSG,LRPL,LRX
S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,4,0))
D BLDSTAT^LRVRMI4A(63.05,11.5,$P(LRX,"^",4),.LRSTATUS)
S LRPL=$P(LRX,"^")
M LRCMT=^LR(LRDFN,"MI",LRIDT,4)
;
S IEN=0
F S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,4,IEN)) Q:IEN<1 D ;
. S LRX=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,4,IEN,0),LRX=$S(LRX'="":LRX,1:" ")
. I LRX'=" ",$$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX) Q
. S LRIEN="+"_IEN_","_LRIDT_","_LRDFN_","
. S LRFDA(4,63.33,LRIEN,.01)=LRX
. I $P(LRX,"^",3) S LRCSR(IEN,2,"LN")=$P(LRX,"^",3)
. I $P(LRX,"^",4) S LRCSR(IEN,2,"NLT")=$P(LRX,"^",4)
I '$D(LRFDA) Q
;
D UPDATE^DIE("","LRFDA(4)","LRFDAIEN","LRMSG")
;
; Store performing lab
S IEN=0
F S IEN=$O(LRFDAIEN(IEN)) Q:'IEN I LRPL D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",4,"_LRFDAIEN(IEN),LRPL)
;
; Store code system references
I $D(LRCSR) D CSR(.LRCSR,.LRFDAIEN,LRDFN_",MI,"_LRIDT_",4,")
;
K LRFDA,LRIENS,LRMSG,DIERR
S LRIEN=LRIDT_","_LRDFN_","
I LRINTYPE=10 D
. S LRFDA(4,63.05,LRIEN,11)=LRNOW
. S LRFDA(4,63.05,LRIEN,11.5)=$P($G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,4,0)),U,4)
S LRFDA(4,63.05,LRIEN,11.55)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
D FILE^DIE("","LRFDA(4)","LRMSG")
S LRRPTAPP=1
Q
;
;
N99 ; Comment on specimen
N LRDATA,LRFDA,LRMSG,LRX
S LRDATA=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,99))
Q:$TR(LRDATA," ","")="" ; don't file empty comments
; Don't file same comment
I LRDATA=$G(^LR(LRDFN,"MI",LRIDT,99)) Q
S LRIEN=LRIDT_","_LRDFN_","
S LRFDA(99,63.05,LRIEN,.99)=LRDATA
D FILE^DIE("","LRFDA(99)","LRMSG")
S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,99,0))
I $P(LRX,"^") D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",99",$P(LRX,"^"))
Q
;
;
AUDTRG ; Trigger the audit trail
N LRDATA,LRMODE,LRBATCH
S LRMODE="LDSI",LRBATCH=1
S LRDATA(63.539,1)=LRNOW
S LRDATA(63.539,3)=$S($G(LRSTATUS(0))'="C":1,1:3)
I LRINTYPE=1 S LRDATA(63.539,4)="Update from lab automated instrument via HL7"
I LRINTYPE=10 S LRDATA(63.539,4)="Update from performing lab via HL7"
D LEDI^LRMIAUD(.LRDATA)
Q
;
;
CSR(LRCSR,LRFDAIEN,LRREF) ; Store code system references
; Call with LRCSR = array of ien/codes to store as references (pass by value)
; LRFDAIEN = FileMan array of entries added by DBA call (pass by value)
; LRREF = root of reference to build full reference to data
;
N IEN,LRDATA,LRDATAREF,LRDFN,LRROOT,ROLE,TYPE
;
S LRROOT="LRCSR",LRDFN=$P(LRREF,",")
F S LRROOT=$Q(@LRROOT) Q:LRROOT="" D
. S IEN=$QS(LRROOT,1),ROLE=$QS(LRROOT,2),TYPE=$QS(LRROOT,3)
. I '$G(LRFDAIEN(IEN)) Q
. S LRDATAREF=LRREF_LRFDAIEN(IEN)
. S LRDATA(.01)=LRDATAREF,LRDATA(.02)=ROLE,LRDATA(.03)=LRCSR(IEN,ROLE,TYPE),LRDATA(.04)=TYPE
. D SETREF^LRUCSR(LRDFN,LRDATAREF,.LRDATA,1)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRVRMI4 6910 printed Sep 23, 2025@19:58:33 Page 2
LRVRMI4 ;DALOI/STAFF - LAH/TMP TO FILE 63 ;09/07/16 08:09
+1 ;;5.2;LAB SERVICE;**350,427,474**;Sep 27, 1994;Build 14
+2 ;
+3 ; Extracts the information in the ^TMP("LRMI",$J) global and stores it into the Lab Data micro subfile.
+4 ;
+5 QUIT
+6 ;
EN ;
+1 NEW LRNODE,LRNOW,LRRPTAPP,LRSTATUS,LR63539,X,I
+2 if '$DATA(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT))
QUIT
+3 SET LRNOW=$$NOW^XLFDT
+4 ; Get IEN of last Micro Audit on file
+5 SET LR63539=0
+6 SET X=$ORDER(^LR(LRDFN,"MI",LRIDT,32,"B","A"),-1)
+7 IF X
SET LR63539=$ORDER(^LR(LRDFN,"MI",LRIDT,32,"B",X,0))
+8 ;
+9 ; If any of these nodes are defined then trigger the audit
+10 FOR I=1,2,3,4,5,6,7,8,9,10,11,12,13,15,16,17,18,99
IF $DATA(^LR(LRDFN,"MI",LRIDT,I))
Begin DoDot:1
+11 IF $GET(LRSB)'>0
NEW LRSB
SET LRSB=$SELECT(I<5:1,I<8:5,I<11:8,I<14:11,I<19:16,I=99:.99,1:0)
+12 IF LRSB>0
DO AUDTRG
End DoDot:1
QUIT
+13 ;
+14 IF $ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,2,0))
DO N2
+15 IF $ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,3,0))
DO N3^LRVRMI4A
+16 IF $ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,4,0))
DO N4
+17 IF $ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,6,0))
DO N6^LRVRMI4A
+18 IF $ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,7,0))
DO N7^LRVRMI2
+19 IF $ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,9,0))
DO N9^LRVRMI2A
+20 IF $ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,10,0))
DO N10^LRVRMI2
+21 IF $DATA(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,11))
DO N11^LRVRMI2A
+22 IF $ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,12,0))
DO N12^LRVRMI2A
+23 IF $ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,13,0))
DO N13^LRVRMI2
+24 ;I $O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,15,0)) D N15^LRVRMI2
+25 IF $ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,17,0))
DO N17^LRVRMI2A
+26 IF $ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,18,0))
DO N18^LRVRMI2
+27 ;
+28 FOR LRNODE=15,19:1:31
IF $ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,LRNODE,0))
DO NODE^LRVRMI3(LRNODE)
+29 ;
+30 IF $DATA(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,99))
DO N99
+31 ;
+32 ; Only release report when receving verified report from external lab (LEDI interface)
+33 IF LRINTYPE=10
Begin DoDot:1
+34 DO SETSTAT^LRVRMI4A(.LRSTATUS)
+35 ; ccr_5439n - Added IF statement to only Do FIN if overall status is final or corrected. LMT 9/6/11
IF (LRSTATUS(0)="C")!(LRSTATUS(0)="F")
DO FIN
End DoDot:1
+36 ;
+37 IF $GET(LRRPTAPP)
DO VT1^LRMIUT1
+38 ;
+39 ; Update MICRO AUDIT to reflect corrected status on verified reference lab reports (interface type 10 in file #62.48)
+40 ; If audit doesn't exist then create instead of updating.
+41 IF LRINTYPE=10
IF LRSTATUS(0)="C"
Begin DoDot:1
+42 IF LR63539<1
DO AUDTRG
QUIT
+43 NEW LRFDA,LRIEN,LRMSG,DIERR
+44 SET LRIEN=LR63539_","_LRIDT_","_LRDFN_","
+45 ; Edit Type
SET LRFDA(1,63.539,LRIEN,3)=3
+46 DO FILE^DIE("","LRFDA(1)","LRMSG")
End DoDot:1
+47 ;
+48 QUIT
+49 ;
+50 ;
FIN ; Release report
+1 NEW LRFDA,LRIEN,LRMSG,DIERR
+2 SET LRIEN=LRIDT_","_LRDFN_","
+3 SET LRFDA(1,63.05,LRIEN,.04)=$SELECT($GET(LRDUZ):LRDUZ,1:$GET(DUZ))
+4 SET LRFDA(1,63.05,LRIEN,.03)=LRNOW
+5 ;S LRFDA(1,63.05,LRIEN,.2)=LRNOW ; ccr_5439n - Commented this line out as there is no field .2 in subfile #63.05. LMT 9/6/11
+6 DO FILE^DIE("","LRFDA(1)","LRMSG")
+7 QUIT
+8 ;
+9 ;
N2 ; Process gram stain comments
+1 NEW DIERR,IEN,LRCMT,LRCSR,LRDATA,LRFDA,LRFDAIEN,LRIEN,LRIENS,LRMSG,LRPL,LRX,STAT
+2 ;
+3 MERGE LRCMT=^LR(LRDFN,"MI",LRIDT,2)
+4 ;
+5 SET IEN=0
SET STAT=""
+6 FOR
SET IEN=$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,2,IEN))
if IEN<1
QUIT
Begin DoDot:1
+7 SET LRX=^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,2,IEN,0)
SET LRX=$SELECT(LRX'="":LRX,1:" ")
+8 IF LRX'=" "
IF $$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX)
QUIT
+9 SET LRIEN="+"_IEN_","_LRIDT_","_LRDFN_","
+10 SET LRFDA(2,63.29,LRIEN,.01)=LRX
+11 SET LRX=^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,2,IEN,0,0)
+12 IF $PIECE(LRX,"^")
SET LRPL(IEN)=$PIECE(LRX,"^")
+13 IF $PIECE(LRX,"^",3)
SET LRCSR(IEN,2,"LN")=$PIECE(LRX,"^",3)
+14 IF $PIECE(LRX,"^",4)
SET LRCSR(IEN,2,"NLT")=$PIECE(LRX,"^",4)
+15 IF $PIECE(LRX,"^",5)'=""
DO BLDSTAT^LRVRMI4A(63.05,11.5,$PIECE(LRX,"^",5),.LRSTATUS)
End DoDot:1
+16 IF '$DATA(LRFDA)
QUIT
+17 ;
+18 DO UPDATE^DIE("","LRFDA(2)","LRFDAIEN","LRMSG")
+19 ; Store performing lab
+20 SET IEN=0
+21 FOR
SET IEN=$ORDER(LRPL(IEN))
if 'IEN
QUIT
Begin DoDot:1
+22 IF $GET(LRPL(IEN))
IF $GET(LRFDAIEN(IEN))
DO SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",2,"_LRFDAIEN(IEN),LRPL(IEN))
End DoDot:1
+23 ;
+24 ; Store code system references
+25 IF $DATA(LRCSR)
DO CSR(.LRCSR,.LRFDAIEN,LRDFN_",MI,"_LRIDT_",2,")
+26 ;
+27 KILL LRFDA,LRIENS,LRMSG,DIERR
+28 SET LRIEN=LRIDT_","_LRDFN_","
+29 IF LRINTYPE=10
SET LRFDA(2,63.05,LRIEN,11)=LRNOW
+30 SET LRFDA(2,63.05,LRIEN,11.55)=$SELECT($GET(LRDUZ):LRDUZ,1:$GET(DUZ))
+31 DO FILE^DIE("","LRFDA(2)","LRMSG")
+32 SET LRRPTAPP=1
+33 QUIT
+34 ;
+35 ;
N4 ; Bact report remarks
+1 NEW DIERR,IEN,LRCMT,LRCSR,LRFDA,LRFDAIEN,LRIEN,LRIENS,LRMSG,LRPL,LRX
+2 SET LRX=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,4,0))
+3 DO BLDSTAT^LRVRMI4A(63.05,11.5,$PIECE(LRX,"^",4),.LRSTATUS)
+4 SET LRPL=$PIECE(LRX,"^")
+5 MERGE LRCMT=^LR(LRDFN,"MI",LRIDT,4)
+6 ;
+7 SET IEN=0
+8 ;
FOR
SET IEN=$ORDER(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,4,IEN))
if IEN<1
QUIT
Begin DoDot:1
+9 SET LRX=^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,4,IEN,0)
SET LRX=$SELECT(LRX'="":LRX,1:" ")
+10 IF LRX'=" "
IF $$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,LRX)
QUIT
+11 SET LRIEN="+"_IEN_","_LRIDT_","_LRDFN_","
+12 SET LRFDA(4,63.33,LRIEN,.01)=LRX
+13 IF $PIECE(LRX,"^",3)
SET LRCSR(IEN,2,"LN")=$PIECE(LRX,"^",3)
+14 IF $PIECE(LRX,"^",4)
SET LRCSR(IEN,2,"NLT")=$PIECE(LRX,"^",4)
End DoDot:1
+15 IF '$DATA(LRFDA)
QUIT
+16 ;
+17 DO UPDATE^DIE("","LRFDA(4)","LRFDAIEN","LRMSG")
+18 ;
+19 ; Store performing lab
+20 SET IEN=0
+21 FOR
SET IEN=$ORDER(LRFDAIEN(IEN))
if 'IEN
QUIT
IF LRPL
DO SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",4,"_LRFDAIEN(IEN),LRPL)
+22 ;
+23 ; Store code system references
+24 IF $DATA(LRCSR)
DO CSR(.LRCSR,.LRFDAIEN,LRDFN_",MI,"_LRIDT_",4,")
+25 ;
+26 KILL LRFDA,LRIENS,LRMSG,DIERR
+27 SET LRIEN=LRIDT_","_LRDFN_","
+28 IF LRINTYPE=10
Begin DoDot:1
+29 SET LRFDA(4,63.05,LRIEN,11)=LRNOW
+30 SET LRFDA(4,63.05,LRIEN,11.5)=$PIECE($GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,4,0)),U,4)
End DoDot:1
+31 SET LRFDA(4,63.05,LRIEN,11.55)=$SELECT($GET(LRDUZ):LRDUZ,1:$GET(DUZ))
+32 DO FILE^DIE("","LRFDA(4)","LRMSG")
+33 SET LRRPTAPP=1
+34 QUIT
+35 ;
+36 ;
N99 ; Comment on specimen
+1 NEW LRDATA,LRFDA,LRMSG,LRX
+2 SET LRDATA=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,99))
+3 ; don't file empty comments
if $TRANSLATE(LRDATA," ","")=""
QUIT
+4 ; Don't file same comment
+5 IF LRDATA=$GET(^LR(LRDFN,"MI",LRIDT,99))
QUIT
+6 SET LRIEN=LRIDT_","_LRDFN_","
+7 SET LRFDA(99,63.05,LRIEN,.99)=LRDATA
+8 DO FILE^DIE("","LRFDA(99)","LRMSG")
+9 SET LRX=$GET(^TMP("LRMI",$JOB,LRDFN,"MI",LRIDT,99,0))
+10 IF $PIECE(LRX,"^")
DO SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",99",$PIECE(LRX,"^"))
+11 QUIT
+12 ;
+13 ;
AUDTRG ; Trigger the audit trail
+1 NEW LRDATA,LRMODE,LRBATCH
+2 SET LRMODE="LDSI"
SET LRBATCH=1
+3 SET LRDATA(63.539,1)=LRNOW
+4 SET LRDATA(63.539,3)=$SELECT($GET(LRSTATUS(0))'="C":1,1:3)
+5 IF LRINTYPE=1
SET LRDATA(63.539,4)="Update from lab automated instrument via HL7"
+6 IF LRINTYPE=10
SET LRDATA(63.539,4)="Update from performing lab via HL7"
+7 DO LEDI^LRMIAUD(.LRDATA)
+8 QUIT
+9 ;
+10 ;
CSR(LRCSR,LRFDAIEN,LRREF) ; Store code system references
+1 ; Call with LRCSR = array of ien/codes to store as references (pass by value)
+2 ; LRFDAIEN = FileMan array of entries added by DBA call (pass by value)
+3 ; LRREF = root of reference to build full reference to data
+4 ;
+5 NEW IEN,LRDATA,LRDATAREF,LRDFN,LRROOT,ROLE,TYPE
+6 ;
+7 SET LRROOT="LRCSR"
SET LRDFN=$PIECE(LRREF,",")
+8 FOR
SET LRROOT=$QUERY(@LRROOT)
if LRROOT=""
QUIT
Begin DoDot:1
+9 SET IEN=$QSUBSCRIPT(LRROOT,1)
SET ROLE=$QSUBSCRIPT(LRROOT,2)
SET TYPE=$QSUBSCRIPT(LRROOT,3)
+10 IF '$GET(LRFDAIEN(IEN))
QUIT
+11 SET LRDATAREF=LRREF_LRFDAIEN(IEN)
+12 SET LRDATA(.01)=LRDATAREF
SET LRDATA(.02)=ROLE
SET LRDATA(.03)=LRCSR(IEN,ROLE,TYPE)
SET LRDATA(.04)=TYPE
+13 DO SETREF^LRUCSR(LRDFN,LRDATAREF,.LRDATA,1)
End DoDot:1
+14 QUIT
