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

LRVRMI4A.m

Go to the documentation of this file. 
  1. LRVRMI4A ;DALOI/STAFF - LAH/TMP TO FILE 63 ;02/22/17  08:09
  1.  ;;5.2;LAB SERVICE;**350,427,474,480**;Sep 27, 1994;Build 7
  1.  ;
  1.  ; Reference to global ^DD(filenumber,"GL") supported by ICR 999
  1.  ; Extracts the information in the ^TMP("LRMI",$J) global and stores it into the Lab Data micro subfile.
  1.  ;
  1.  Q
  1.  ;
  1. N3 ;Process Organism
  1.  ;
  1.  N DIERR,IEN,LRFDA,LRIEN,LRIENS,LRMSG
  1.  ;
  1.  ;ZEXCEPT: LRDFN,LRDUZ,LRIDT,LRINTYPE,LRNOW,LRRPTAPP
  1.  ;
  1.  S IEN=0
  1.  F  S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,IEN)) Q:IEN<1  D N3A
  1.  ;
  1.  K LRFDA,LRIENS,LRMSG,DIERR
  1.  S LRIEN=LRIDT_","_LRDFN_","
  1.  I LRINTYPE=10 S LRFDA(3,63.05,LRIEN,11)=LRNOW
  1.  S LRFDA(3,63.05,LRIEN,11.55)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
  1.  D FILE^DIE("","LRFDA(3)","LRMSG")
  1.  S LRRPTAPP=1
  1.  Q
  1.  ;
  1.  ;
  1. N3A ; Process each organism
  1.  ;
  1.  N DATA,DIERR,DNFLDS,FLD,I,IEN2,ISOID
  1.  N LRCSR,LRCMT,LRDATA,LRFDA,LRI,LRIEN,LRIENS,LRMSG,LRN3,LRX,R633,STAT
  1.  ;
  1.  ; ZEXCEPT: IEN,LRDFN,LRIDT,LRINTYPE,LRLL,LRPROF,LRSTATUS
  1.  ;
  1.  S LRN3=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,IEN,0))
  1.  Q:LRN3=""
  1.  S ISOID=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,IEN,.1))
  1.  Q:ISOID=""
  1.  ;
  1.  ; Delete ISOID entry if it exists on LEDI (LRINTYPE=10) interfaces
  1.  ; On UI interfaces update organism for this isolate id.
  1.  S R633=$O(^LR(LRDFN,"MI",LRIDT,3,"C",ISOID,0))
  1.  I R633 D
  1.  . K LRFDA,LRMSG,LRIENS,DIERR
  1.  . S LRIEN=R633_","_LRIDT_","_LRDFN_","
  1.  . I LRINTYPE=10 D
  1.  . . S LRFDA(3,63.3,LRIEN,.01)="@"
  1.  . . S R633=""
  1.  . E  D
  1.  . . S LRFDA(3,63.3,LRIEN,.01)=$P(LRN3,U) ; organism
  1.  . . I $P(LRN3,U,2)'="" S LRFDA(3,63.3,LRIEN,1)=$P(LRN3,U,2) ; qty
  1.  . D FILE^DIE("","LRFDA(3)","LRMSG")
  1.  ;
  1.  ; On LEDI (LRINTYPE=10) interfaces existing ISOID was deleted above so always add record
  1.  I 'R633 D
  1.  . K LRFDA,LRMSG,LRIENS,DIERR
  1.  . S LRIEN="+1,"_LRIDT_","_LRDFN_","
  1.  . S LRFDA(3,63.3,LRIEN,.01)=$P(LRN3,U) ; organism
  1.  . S LRFDA(3,63.3,LRIEN,.1)=ISOID
  1.  . S LRFDA(3,63.3,LRIEN,1)=$P(LRN3,U,2) ; qty
  1.  . D UPDATE^DIE("","LRFDA(3)","LRIENS","LRMSG")
  1.  . S R633=$G(LRIENS(1))
  1.  ;
  1.  Q:'R633
  1.  ;
  1.  ; Store code system references
  1.  S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,IEN,0,.01))
  1.  F LRI=1:1:3 I $P(LRX,"^",LRI) D
  1.  . N LRDATA
  1.  . S LRDATA(.01)=LRDFN_",MI,"_LRIDT_",3,"_R633_",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,3,IEN,0,.01,1))
  1.  I $P(LRX,"^") D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",3,"_R633_",0",$P(LRX,"^"))
  1.  ;
  1.  S STAT=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,IEN,0,.01,0))
  1.  S STAT=$P(STAT,U,1)
  1.  D BLDSTAT(63.05,11.5,STAT,.LRSTATUS)
  1.  ;
  1.  ; Process organism comments
  1.  K LRFDA,LRIENS,LRMSG,DIERR
  1.  M LRCMT=^LR(LRDFN,"MI",LRIDT,3,IEN,1)
  1.  S IEN2=0
  1.  F  S IEN2=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,IEN,1,IEN2)) Q:'IEN2  D
  1.  . S DATA=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,IEN,1,IEN2,0),DATA=$S(DATA'="":DATA,1:" ")
  1.  . I DATA'=" ",$$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,DATA) Q
  1.  . S LRIEN="+"_IEN2_","_R633_","_LRIDT_","_LRDFN_","
  1.  . S LRFDA(3,63.31,LRIEN,.01)=DATA
  1.  I $D(LRFDA) D UPDATE^DIE("","LRFDA(3)","","LRMSG")
  1.  ;
  1.  ; Add drug susceptibilities
  1.  S IEN2=2
  1.  K LRFDA,LRIENS,LRMSG,DIERR
  1.  F  S IEN2=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,IEN,IEN2)) Q:'IEN2  D
  1.  . S STAT=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,IEN,IEN2,.01,0))
  1.  . S STAT=$P(STAT,U,1)
  1.  . D BLDSTAT(63.05,11.5,STAT,.LRSTATUS)
  1.  . S LRIEN=R633_","_LRIDT_","_LRDFN_","
  1.  . S DATA=^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,IEN,IEN2)
  1.  . S DNFLDS=$$DN2FLDS(IEN2,,3)
  1.  . F I=1:1:3 D  ;
  1.  . . S FLD=$P(DNFLDS,"^",I)
  1.  . . Q:'FLD
  1.  . . S LRFDA(3,63.3,LRIEN,FLD)=$P(DATA,U,I)
  1.  . S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,3,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.  ; File susceptibilities
  1.  I $D(LRFDA) D FILE^DIE("","LRFDA(3)","LRMSG")
  1.  ;
  1.  ; Store code system references
  1.  I $D(LRCSR) D CSR(.LRCSR,LRDFN_",MI,"_LRIDT_",3,"_IEN_",")
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. N6 ; Process Parasite
  1.  ;
  1.  N DIERR,IEN,LRFDA,LRIEN,LRIENS,LRMSG
  1.  ;
  1.  ;ZEXCEPT: LRDFN,LRDUZ,LRIDT,LRINTYPE,LRLL,LRNOW,LRPROF,LRRPTAPP,LRSTATUS
  1.  ;
  1.  S IEN=0
  1.  F  S IEN=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,IEN)) Q:IEN<1  D N6A
  1.  ;
  1.  S LRIEN=LRIDT_","_LRDFN_","
  1.  I LRINTYPE=10 S LRFDA(6,63.05,LRIEN,14)=LRNOW
  1.  S LRFDA(6,63.05,LRIEN,15.5)=$S($G(LRDUZ):LRDUZ,1:$G(DUZ))
  1.  D FILE^DIE("","LRFDA(6)","LRMSG")
  1.  S LRRPTAPP=1
  1.  Q
  1.  ;
  1.  ;
  1. N6A ; Process individual parasite result
  1.  ;
  1.  N DIERR,IEN2,ISOID,LRFDA,LRI,LRIEN,LRIENS,LRINTYPE,LRMSG,LRN6,LRX,R6334,STAT
  1.  ;
  1.  ;ZEXCEPT: LRDFN,LRIDT,LRSTATUS,IEN
  1.  ;
  1.  S LRN6=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,IEN,0))
  1.  Q:LRN6=""
  1.  S ISOID=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,IEN,.1))
  1.  Q:ISOID=""
  1.  ;
  1.  ; Delete ISOID entry if it exists on LEDI (LRINTYPE=10) interfaces
  1.  ; On UI interfaces update parasite for this isolate id.
  1.  S R6334=$O(^LR(LRDFN,"MI",LRIDT,6,"C",ISOID,0))
  1.  I R6334 D
  1.  . K LRFDA,LRMSG,LRIENS,DIERR
  1.  . S LRIEN=R6334_","_LRIDT_","_LRDFN_","
  1.  . I LRINTYPE=10 D
  1.  . . S LRFDA(6,63.34,LRIEN,.01)="@"
  1.  . . S R6334=""
  1.  . E  S LRFDA(6,63.34,LRIEN,.01)=LRN6 ; parasite
  1.  . D FILE^DIE("","LRFDA(6)","LRMSG")
  1.  ;
  1.  ; On LEDI (LRINTYPE=10) interfaces existing ISOID was deleted above so always add record
  1.  I 'R6334 D
  1.  . K LRFDA,LRMSG,LRIENS,DIERR
  1.  . S LRIEN="+1,"_LRIDT_","_LRDFN_","
  1.  . S LRFDA(6,63.34,LRIEN,.01)=LRN6 ; parasite
  1.  . S LRFDA(6,63.34,LRIEN,.1)=ISOID
  1.  . D UPDATE^DIE("","LRFDA(6)","LRIENS","LRMSG")
  1.  . S R6334=$G(LRIENS(1))
  1.  ;
  1.  Q:'R6334
  1.  ;
  1.  ; Store code system references
  1.  S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,IEN,0,.01))
  1.  F LRI=1:1:3 I $P(LRX,"^",LRI) D
  1.  . N LRDATA
  1.  . S LRDATA(.01)=LRDFN_",MI,"_LRIDT_",6,"_IEN_",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,6,IEN,0,.01,1))
  1.  I $P(LRX,"^") D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",6,"_R6334_",0",$P(LRX,"^"))
  1.  ;
  1.  S STAT=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,IEN,0,.01,0))
  1.  S STAT=$P(STAT,U,1)
  1.  D BLDSTAT(63.05,15,STAT,.LRSTATUS)
  1.  ;
  1.  ; Stage results
  1.  K LRFDA,LRMSG,LRIENS,DIERR
  1.  S IEN2=0
  1.  F  S IEN2=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,IEN,1,IEN2)) Q:'IEN2  D N6B
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. N6B ; Process Parasite Stage results
  1.  ;
  1.  N DATA,DIERR,IEN3,LRCMT,LRCSR,LRFDA,LRI,LRIEN,LRIENS,LRMSG,LRPL,LRX,R6335,STAT
  1.  ;
  1.  ;ZEXCEPT: ISOID,LRDFN,LRIDT,LRINTYPE,LRLL,LRPROF,IEN,IEN2,LRSTATUS,R6334
  1.  ;
  1.  ; Delete STAGE entry if it exists on LEDI (LRINTYPE=10) interfaces
  1.  ; On UI interfaces update STAGE for this isolate id.
  1.  S DATA=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,IEN,1,IEN2,0))
  1.  S R6335=$O(^LR(LRDFN,"MI",LRIDT,6,IEN,1,"B",ISOID,0))
  1.  I R6335 D
  1.  . K LRFDA,LRMSG,LRIENS,DIERR
  1.  . S LRIEN=R6335_","_LRIDT_","_LRDFN_","
  1.  . I LRINTYPE=10 D
  1.  . . S LRFDA(6,63.35,LRIEN,.01)="@"
  1.  . . S R6335=""
  1.  . E  D
  1.  . . S LRFDA(6,63.35,LRIEN,.01)=$P(DATA,U,1) ;stage
  1.  . . S LRFDA(6,63.35,LRIEN,1)=$P(DATA,U,2) ;qty
  1.  . D FILE^DIE("","LRFDA(6)","LRMSG")
  1.  ;
  1.  ; On LEDI (LRINTYPE=10) interfaces existing STAGE was deleted above so always add record
  1.  I 'R6335 D
  1.  . K LRFDA,LRMSG,LRIENS,DIERR
  1.  . S LRIEN="+"_IEN2_","_R6334_","_LRIDT_","_LRDFN_","
  1.  . S DATA=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,IEN,1,IEN2,0))
  1.  . S LRFDA(6,63.35,LRIEN,.01)=$P(DATA,U,1) ;stage
  1.  . S LRFDA(6,63.35,LRIEN,1)=$P(DATA,U,2) ;qty
  1.  . D UPDATE^DIE("","LRFDA(6)","LRIENS","LRMSG")
  1.  . S R6335=$G(LRIENS(IEN2))
  1.  ;
  1.  Q:'R6335
  1.  ;
  1.  S STAT=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,IEN,1,IEN2,0,.01,0))
  1.  S STAT=$P(STAT,U,1)
  1.  ;
  1.  ; Store code system references for stage
  1.  S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,IEN,1,IEN2,.01))
  1.  F LRI=1:1:3 I $P(LRX,"^",LRI) D
  1.  . N LRDATA
  1.  . S LRDATA(.01)=LRDFN_",MI,"_LRIDT_",6,"_R6334_",1,"_R6335_",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 quantity
  1.  S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,IEN,1,IEN2,1))
  1.  F LRI=1:1:3 I $P(LRX,"^",LRI) D
  1.  . N LRDATA
  1.  . S LRDATA(.01)=LRDFN_",MI,"_LRIDT_",6,"_R6334_",1,"_R6335_",0;2"
  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",6,IEN,1,IEN2,0,.01,1))
  1.  I $P(LRX,"^") D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",6,"_R6334_",1,"_R6335_",0",$P(LRX,"^"))
  1.  ;
  1.  D BLDSTAT(63.05,15,STAT,.LRSTATUS)
  1.  ;
  1.  ; get stage comments
  1.  K LRFDA,LRMSG,LRIENS,DIERR
  1.  M LRCMT=^LR(LRDFN,"MI",LRIDT,6,IEN,1,IEN2,1)
  1.  S LRX=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,IEN,1,IEN2,1,0))
  1.  S STAT=$P(LRX,U,4)
  1.  D BLDSTAT(63.05,15,STAT,.LRSTATUS)
  1.  S IEN3=0
  1.  F  S IEN3=$O(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,IEN,1,IEN2,1,IEN3)) Q:IEN3<1  D
  1.  . S DATA=$G(^TMP("LRMI",$J,LRDFN,"MI",LRIDT,6,IEN,1,IEN2,1,IEN3,0)),DATA=$S(DATA'="":DATA,1:" ")
  1.  . I DATA'=" ",$$DUPCHK^LRVRMI3(LRLL,LRPROF,.LRCMT,DATA) Q
  1.  . S LRIEN="+"_IEN3_","_R6335_","_R6334_","_LRIDT_","_LRDFN_","
  1.  . S LRFDA(6,63.351,LRIEN,.01)=DATA
  1.  . I $P(LRX,"^") S LRPL(IEN3)=$P(LRX,"^")
  1.  . I $P(LRX,"^",3) S LRCSR(IEN3,2,"LN")=$P(LRX,"^",3)
  1.  ;
  1.  I '$D(LRFDA) Q
  1.  ;
  1.  D UPDATE^DIE("","LRFDA(6)","LRIENS","LRMSG")
  1.  ;
  1.  ; Store performing lab
  1.  S IEN3=0
  1.  F  S IEN3=$O(LRPL(IEN3)) Q:'IEN3  I $G(LRIENS(IEN3)) D SETPL^LRRPLUA(LRDFN_",MI,"_LRIDT_",6,"_LRIENS(IEN3),LRPL(IEN3))
  1.  ;
  1.  ; Store code system references
  1.  I $D(LRCSR) D CSR^LRVRMI4(.LRCSR,.LRIENS,LRDFN_",MI,"_LRIDT_",6,")
  1.  Q
  1.  ;
  1.  ;
  1. DN2FLDS(DN,FN,SUB) ;
  1.  ; Convert a drug node to a field number
  1.  ;File ^DD(filenumber,"GL")/999
  1.  ; Inputs
  1.  ;   DN : Drug Node (ie 2.0003)
  1.  ;   FN : <opt> File Number (ie 63.3)
  1.  ;  SUB : <opt> Subscript (ie 3)
  1.  ;       : Note: either FN or SUB must be supplied
  1.  ; Output
  1.  ;   The three associated field numbers for the drug node
  1.  ;     ie 15^15.1^15.2
  1.  N FLDS,I,X
  1.  S DN=$G(DN),FN=$G(FN),SUB=$G(SUB)
  1.  S FLDS=""
  1.  I FN="" D  ;
  1.  . I SUB=3 S FN=63.3
  1.  . I SUB=6 S FN=63.34
  1.  . I SUB=9 S FN=63.37
  1.  . I SUB=12 S FN=63.39
  1.  . I SUB=17 S FN=63.43
  1.  I $D(^DD(FN,"GL",DN)) D  ;
  1.  . F I=1:1:3 S X=$O(^DD(FN,"GL",DN,I,0)) I X S $P(FLDS,"^",I)=X
  1.  Q FLDS
  1.  ;
  1.  ;
  1. BLDSTAT(FN,FLD,STAT,DATA) ;
  1.  ; Builds the DATA array used for setting status(es)
  1.  ; Inputs
  1.  ;   FN : File Number  (ie 63.5)
  1.  ;  FLD : Field Number  (ie 19)
  1.  ; STAT : Status  (ie "F")
  1.  ; DATA <byref> : See Outputs
  1.  ;
  1.  ; Outputs
  1.  ; DATA <byref> : DATA(file#,field#)=status  DATA(63.05,19)="P"
  1.  ;
  1.  N CURR
  1.  I $G(STAT)="" Q
  1.  I STAT'?1(1"P",1"F",1"C") S STAT="P"
  1.  S CURR=$G(DATA(FN,FLD))
  1.  I CURR="" S DATA(FN,FLD)=STAT Q
  1.  I CURR=STAT Q
  1.  I CURR="P" Q
  1.  I CURR="F" D
  1.  . I STAT="P" S DATA(FN,FLD)="P" Q
  1.  . I STAT="C" S DATA(FN,FLD)="C" Q
  1.  Q
  1.  ;
  1.  ;
  1. SETSTAT(DATA) ;
  1.  ; Goes thru DATA array and files the status(es)
  1.  ; Inputs
  1.  ;   DATA <byref> : DATA(file#,field#)=status  ie DATA(63.05,19)="P"
  1.  ; Outputs
  1.  ;   DATA <byref> : Sets DATA(0)=overall status (P,F,C)
  1.  ;
  1.  N FLD,FN,LRFDA,LRIEN,LRMSG,NODE,STAT,STAT2
  1.  ;
  1.  ;ZEXCEPT: LRDFN,LRIDT
  1.  ;
  1.  S LRIEN=LRIDT_","_LRDFN_",",STAT2=""
  1.  S NODE="DATA(0)"
  1.  F  S NODE=$Q(@NODE) Q:NODE=""  D
  1.  . S FN=$QS(NODE,1),FLD=$QS(NODE,2)
  1.  . I 'FN!('FLD) Q
  1.  . S STAT=DATA(FN,FLD)
  1.  . ; derive "overall" status
  1.  . ; P > C > F
  1.  . I STAT2="" S STAT2=STAT
  1.  . I STAT="P" S STAT2="P"
  1.  . I STAT="C",STAT2'="P" S STAT2="C"
  1.  . I STAT="F",STAT2'="C",STAT2'="P" S STAT2="F"
  1.  . ;
  1.  . ;convert "C" to "F"
  1.  . I STAT="C" S STAT="F"
  1.  . S LRFDA(1,FN,LRIEN,FLD)=STAT
  1.  I $D(LRFDA) D FILE^DIE("","LRFDA(1)","LRMSG")
  1.  S DATA(0)=STAT2
  1.  Q
  1.  ;
  1.  ;
  1. CSR(LRCSR,LRREF) ; Store code system references
  1.  ; Call with LRCSR = array of ien/codes to store as references (pass by value)
  1.  ;           LRREF = root of reference to build full reference to data
  1.  ;
  1.  N IEN,LRDATA,LRDATAREF,LRDFN,LRROOT,ROLE,TYPE
  1.  ;
  1.  S LRROOT="LRCSR",LRDFN=$P(LRREF,",")
  1.  F  S LRROOT=$Q(@LRROOT) Q:LRROOT=""  D
  1.  . S IEN=$QS(LRROOT,1),ROLE=$QS(LRROOT,2),TYPE=$QS(LRROOT,3),LRDATAREF=LRREF_IEN
  1.  . S LRDATA(.01)=LRDATAREF,LRDATA(.02)=ROLE,LRDATA(.03)=LRCSR(IEN,ROLE,TYPE),LRDATA(.04)=TYPE
  1.  . D SETREF^LRUCSR(LRDFN,LRDATAREF,.LRDATA,1)
  1.  Q