LRUCSR ;DALOI/JMC - Code System Reference Utility ;11/24/09 15:21
;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
;
; ZEXCEPT is used to identify variables which are external to a specific TAG
; used in conjunction with Eclipse M-editor.
;
Q
;
;
SETREF(LRDFN,LRREF,LRDATA,LRACTION) ; Set reference to code system in file #63
; Call with LRDFN = File #63 IEN
; LRREF = value of #.01 field in format LRDFN,LRSS,LRIDT,0 or other ending reference
; e.g. "123,SP,6919594.8946,0"
; e.g. "123,SP,6919594.8946,1;5" - 5th piece of 1 node
; if reference to other file then use format LRDFN,file #,other ending reference.
; e.g. "123,69,LRODT,LRSN,0"
; e.g. "123,68,LRAA,LRAD,LRAN,0"
; LRDATA = array with data to store i.e LRDATA(field #)=value
; LRACTION = 1-update if exists otherwise add
; 2-always add
;
N LRROLE,LRCODEID,LRCODESYSTEM
;
I $G(LRREF)="" Q
;
; Determine role for this code.
S LRROLE=$G(LRDATA(.02))
I LRROLE<1 Q
;
; Determine what code system this code id is from.
S LRCODESYSTEM=$G(LRDATA(.04))
I LRCODESYSTEM="" Q
;
S LRACTION=$G(LRACTION)
I LRACTION<1 S LRACTION=1
;
S LRCODEID=$G(LRDATA(.03))
I LRCODEID="" Q
;
; Update existing entry for this role and code system
I LRACTION=1,$D(^LR(LRDFN,"CSR","AE",LRREF,LRROLE,LRCODESYSTEM)) D UEE Q
;
; Create new entry
D CNE
;
Q
;
;
UEE ; Update existing entry
;
N LRDIE,LRFDA,LRIEN
;
;ZEXCEPT: LRCODEID,LRCODESYSTEM,LRDATA,LRDFN,LRREF,LRROLE
;
S LRIEN=$O(^LR(LRDFN,"CSR","AE",LRREF,LRROLE,LRCODESYSTEM,LRCODEID,0))
;
I LRDATA(.01)'="",LRDATA(.01)'=LRREF S LRFDA(1,63.00014,LRIEN_","_LRDFN_",",.01)=LRDATA(.01)
;
S LRFDA(1,63.00014,LRIEN_","_LRDFN_",",.02)=LRDATA(.02)
S LRFDA(1,63.00014,LRIEN_","_LRDFN_",",.03)=LRDATA(.03)
S LRFDA(1,63.00014,LRIEN_","_LRDFN_",",.035)=$G(LRDATA(.035))
S LRFDA(1,63.00014,LRIEN_","_LRDFN_",",.04)=LRDATA(.04)
S LRFDA(1,63.00014,LRIEN_","_LRDFN_",",.05)=$G(LRDATA(.05))
S LRFDA(1,63.00014,LRIEN_","_LRDFN_",",.06)=$G(LRDATA(.06))
;
D FILE^DIE("","LRFDA(1)","LRDIE(1)")
Q
;
;
CNE ; Create new entry
;
N LRDIE,LRFDA,LRIEN
;
;ZEXCEPT: LRDATA,LRDFN
;
S LRFDA(1,63.00014,"+1,"_LRDFN_",",.01)=LRDATA(.01)
S LRFDA(1,63.00014,"+1,"_LRDFN_",",.02)=LRDATA(.02)
S LRFDA(1,63.00014,"+1,"_LRDFN_",",.03)=LRDATA(.03)
I $G(LRDATA(.035))'="" S LRFDA(1,63.00014,"+1,"_LRDFN_",",.035)=LRDATA(.035)
S LRFDA(1,63.00014,"+1,"_LRDFN_",",.04)=LRDATA(.04)
I $G(LRDATA(.05))'="" S LRFDA(1,63.00014,"+1,"_LRDFN_",",.05)=LRDATA(.05)
I $G(LRDATA(.06))'="" S LRFDA(1,63.00014,"+1,"_LRDFN_",",.06)=LRDATA(.06)
;
D UPDATE^DIE("","LRFDA(1)","LRIEN","LRDIE(1)")
Q
;
;
DEE(LRIENS) ; Delete existing entry
; Call with LRIENS = File #63 code system reference IENS
;
N LRDIE,LRFDA
;
S LRFDA(1,63.00014,LRIENS,.01)="@"
D FILE^DIE("","LRFDA(1)","LRDIE(1)")
Q
;
;
GETDATA(LRDATA,LRIENS) ; Retrieve information for a specific entry
; Call with LRDATA = array to return data, pass by reference
; LRRIENS = File #63 code system reference IENS
;
; Returns data in standard FileMan DBS structure - See FileMan DBS documentation
;
D GETS^DIQ(63.00014,LRIENS,"**","I","LRDATA")
Q
;
;
GETALL(LRDATA,LRDFN,LRREF,LRROLE) ; Retrieve information for all entries related to a specific reference/role
; Call with LRDATA = array to return data, pass by reference
; LRDFN = File #63 IEN
; LRREF = value of #.01 field in format LRDFN,LRSS,LRIDT,0 or other ending reference
; e.g. "123,SP,6919594.8946,0"
; if reference to other file then use format LRDFN,file #,other ending reference.
; e.g. "123,69,LRODT,LRSN,0"
; e.g. "123,68,LRAA,LRAD,LRAN,0"
; LRROLE = code system role
;
; Returns data in standard FileMan DBS structure - See FileMan DBS documentation
;
N LRIEN,LRIENS
;
S LRIEN=0
F S LRIEN=$O(^LR(LRDFN,"CSR","AD",LRREF,LRROLE,LRIEN)) Q:'LRIEN D
. S LRIENS=LRIEN_","_LRDFN_","
. D GETS^DIQ(63.00014,LRIENS,"**","I","LRDATA")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRUCSR 4271 printed Dec 13, 2024@02:21:23 Page 2
LRUCSR ;DALOI/JMC - Code System Reference Utility ;11/24/09 15:21
+1 ;;5.2;LAB SERVICE;**350**;Sep 27, 1994;Build 230
+2 ;
+3 ; ZEXCEPT is used to identify variables which are external to a specific TAG
+4 ; used in conjunction with Eclipse M-editor.
+5 ;
+6 QUIT
+7 ;
+8 ;
SETREF(LRDFN,LRREF,LRDATA,LRACTION) ; Set reference to code system in file #63
+1 ; Call with LRDFN = File #63 IEN
+2 ; LRREF = value of #.01 field in format LRDFN,LRSS,LRIDT,0 or other ending reference
+3 ; e.g. "123,SP,6919594.8946,0"
+4 ; e.g. "123,SP,6919594.8946,1;5" - 5th piece of 1 node
+5 ; if reference to other file then use format LRDFN,file #,other ending reference.
+6 ; e.g. "123,69,LRODT,LRSN,0"
+7 ; e.g. "123,68,LRAA,LRAD,LRAN,0"
+8 ; LRDATA = array with data to store i.e LRDATA(field #)=value
+9 ; LRACTION = 1-update if exists otherwise add
+10 ; 2-always add
+11 ;
+12 NEW LRROLE,LRCODEID,LRCODESYSTEM
+13 ;
+14 IF $GET(LRREF)=""
QUIT
+15 ;
+16 ; Determine role for this code.
+17 SET LRROLE=$GET(LRDATA(.02))
+18 IF LRROLE<1
QUIT
+19 ;
+20 ; Determine what code system this code id is from.
+21 SET LRCODESYSTEM=$GET(LRDATA(.04))
+22 IF LRCODESYSTEM=""
QUIT
+23 ;
+24 SET LRACTION=$GET(LRACTION)
+25 IF LRACTION<1
SET LRACTION=1
+26 ;
+27 SET LRCODEID=$GET(LRDATA(.03))
+28 IF LRCODEID=""
QUIT
+29 ;
+30 ; Update existing entry for this role and code system
+31 IF LRACTION=1
IF $DATA(^LR(LRDFN,"CSR","AE",LRREF,LRROLE,LRCODESYSTEM))
DO UEE
QUIT
+32 ;
+33 ; Create new entry
+34 DO CNE
+35 ;
+36 QUIT
+37 ;
+38 ;
UEE ; Update existing entry
+1 ;
+2 NEW LRDIE,LRFDA,LRIEN
+3 ;
+4 ;ZEXCEPT: LRCODEID,LRCODESYSTEM,LRDATA,LRDFN,LRREF,LRROLE
+5 ;
+6 SET LRIEN=$ORDER(^LR(LRDFN,"CSR","AE",LRREF,LRROLE,LRCODESYSTEM,LRCODEID,0))
+7 ;
+8 IF LRDATA(.01)'=""
IF LRDATA(.01)'=LRREF
SET LRFDA(1,63.00014,LRIEN_","_LRDFN_",",.01)=LRDATA(.01)
+9 ;
+10 SET LRFDA(1,63.00014,LRIEN_","_LRDFN_",",.02)=LRDATA(.02)
+11 SET LRFDA(1,63.00014,LRIEN_","_LRDFN_",",.03)=LRDATA(.03)
+12 SET LRFDA(1,63.00014,LRIEN_","_LRDFN_",",.035)=$GET(LRDATA(.035))
+13 SET LRFDA(1,63.00014,LRIEN_","_LRDFN_",",.04)=LRDATA(.04)
+14 SET LRFDA(1,63.00014,LRIEN_","_LRDFN_",",.05)=$GET(LRDATA(.05))
+15 SET LRFDA(1,63.00014,LRIEN_","_LRDFN_",",.06)=$GET(LRDATA(.06))
+16 ;
+17 DO FILE^DIE("","LRFDA(1)","LRDIE(1)")
+18 QUIT
+19 ;
+20 ;
CNE ; Create new entry
+1 ;
+2 NEW LRDIE,LRFDA,LRIEN
+3 ;
+4 ;ZEXCEPT: LRDATA,LRDFN
+5 ;
+6 SET LRFDA(1,63.00014,"+1,"_LRDFN_",",.01)=LRDATA(.01)
+7 SET LRFDA(1,63.00014,"+1,"_LRDFN_",",.02)=LRDATA(.02)
+8 SET LRFDA(1,63.00014,"+1,"_LRDFN_",",.03)=LRDATA(.03)
+9 IF $GET(LRDATA(.035))'=""
SET LRFDA(1,63.00014,"+1,"_LRDFN_",",.035)=LRDATA(.035)
+10 SET LRFDA(1,63.00014,"+1,"_LRDFN_",",.04)=LRDATA(.04)
+11 IF $GET(LRDATA(.05))'=""
SET LRFDA(1,63.00014,"+1,"_LRDFN_",",.05)=LRDATA(.05)
+12 IF $GET(LRDATA(.06))'=""
SET LRFDA(1,63.00014,"+1,"_LRDFN_",",.06)=LRDATA(.06)
+13 ;
+14 DO UPDATE^DIE("","LRFDA(1)","LRIEN","LRDIE(1)")
+15 QUIT
+16 ;
+17 ;
DEE(LRIENS) ; Delete existing entry
+1 ; Call with LRIENS = File #63 code system reference IENS
+2 ;
+3 NEW LRDIE,LRFDA
+4 ;
+5 SET LRFDA(1,63.00014,LRIENS,.01)="@"
+6 DO FILE^DIE("","LRFDA(1)","LRDIE(1)")
+7 QUIT
+8 ;
+9 ;
GETDATA(LRDATA,LRIENS) ; Retrieve information for a specific entry
+1 ; Call with LRDATA = array to return data, pass by reference
+2 ; LRRIENS = File #63 code system reference IENS
+3 ;
+4 ; Returns data in standard FileMan DBS structure - See FileMan DBS documentation
+5 ;
+6 DO GETS^DIQ(63.00014,LRIENS,"**","I","LRDATA")
+7 QUIT
+8 ;
+9 ;
GETALL(LRDATA,LRDFN,LRREF,LRROLE) ; Retrieve information for all entries related to a specific reference/role
+1 ; Call with LRDATA = array to return data, pass by reference
+2 ; LRDFN = File #63 IEN
+3 ; LRREF = value of #.01 field in format LRDFN,LRSS,LRIDT,0 or other ending reference
+4 ; e.g. "123,SP,6919594.8946,0"
+5 ; if reference to other file then use format LRDFN,file #,other ending reference.
+6 ; e.g. "123,69,LRODT,LRSN,0"
+7 ; e.g. "123,68,LRAA,LRAD,LRAN,0"
+8 ; LRROLE = code system role
+9 ;
+10 ; Returns data in standard FileMan DBS structure - See FileMan DBS documentation
+11 ;
+12 NEW LRIEN,LRIENS
+13 ;
+14 SET LRIEN=0
+15 FOR
SET LRIEN=$ORDER(^LR(LRDFN,"CSR","AD",LRREF,LRROLE,LRIEN))
if 'LRIEN
QUIT
Begin DoDot:1
+16 SET LRIENS=LRIEN_","_LRDFN_","
+17 DO GETS^DIQ(63.00014,LRIENS,"**","I","LRDATA")
End DoDot:1
+18 QUIT
