RORRP023 ;HCIOFO/SG - RPC: REGISTRY COORDINATORS ; 7/16/03 11:25am
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
;
; This routine uses the following IAs:
;
; #10060 Read access (FileMan) to the file #200 (supported)
;
Q
;
;***** RETURNS THE LIST OF REGISTRY COORDINATORS
; RPC: [ROR LIST COORDINATORS]
;
; .RESULTS Reference to a local variable where the results
; are returned to.
;
; REGIEN Registry IEN
;
; The ^TMP("DILIST",$J) global node is used by the procedure.
;
; Return Values:
;
; A negative value of the first "^"-piece of the RESULTS(0)
; indicates an error (see the RPCSTK^RORERR procedure for more
; details).
;
; Otherwise, number of coordinators is returned in the
; @RESULTS@(0) and the subsequent nodes of the global array
; contain the coordinators.
;
; @RESULTS@(0) Number of Coordinators
;
; @RESULTS@(i) Coordinator's Descriptor
; ^01: IEN
; ^02: Name
;
RCLIST(RESULTS,REGIEN) ;
N IENS,RC,RORERRDL,RORMSG,TMP
D CLEAR^RORERR("RCLIST^RORRP023",1)
K RESULTS S RESULTS=$NA(^TMP("DILIST",$J)) K @RESULTS
;--- Check the parameters
S RC=0 D I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
. ;--- Registry IEN
. I $G(REGIEN)'>0 D Q
. . S RC=$$ERROR^RORERR(-88,,,,"REGIEN",$G(REGIEN))
. S REGIEN=+REGIEN
;--- Get the list of coordinators
S IENS=","_REGIEN_",",TMP="@;.01E"
D LIST^DIC(798.114,IENS,TMP,"PU",,,,"B",,,,"RORMSG")
I $G(DIERR) D D RPCSTK^RORERR(.RESULTS,RC) Q
. S RC=$$DBS^RORERR("RORMSG",-9,,,798.114,IENS)
;--- Success
S TMP=+$G(^TMP("DILIST",$J,0))
K ^TMP("DILIST",$J,0) S @RESULTS@(0)=TMP
Q
;
;***** UPDATES THE LIST OF REGISTRY COORDINATORS
; RPC: [ROR UPDATE COORDINATORS]
;
; .RESULTS Reference to a local variable where the results
; are returned to.
;
; REGIEN Registry IEN
;
; .RCLST( Reference to a local variable that contains
; a list of registry coordinators
; i) User IEN (DUZ)
;
; Return Values:
;
; A negative value of the first "^"-piece of the RESULTS(0)
; indicates an error (see the RPCSTK^RORERR procedure for more
; details).
;
; Otherwise, zero is returned in the RESULTS(0).
;
RCLUPD(RESULTS,REGIEN,RCLST) ;
N DA,DIK,ECNT,IEN,IENS,RC,RCL,ROOT,RORERRDL,RORFDA,RORIEN,RORMSG,TMP
D CLEAR^RORERR("RCLUPD^RORRP023",1) K RESULTS
;--- Check the parameters
S RC=0 D I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
. ;--- Registry IEN
. I $G(REGIEN)'>0 D Q
. . S RC=$$ERROR^RORERR(-88,,,,"REGIEN",$G(REGIEN))
. S REGIEN=+REGIEN
;
;--- Lock the COORDINATOR multiple
S IENS=","_REGIEN_","
S RC=$$LOCK^RORLOCK(798.114,IENS)
I RC D:RC>0 D RPCSTK^RORERR(.RESULTS,RC) Q
. S RC=$$ERROR^RORERR(-11,,,,"the COORDINATOR multiple")
;---
S ROOT=$$ROOT^DILFD(798.114,IENS,1)
;
;--- Create a list of coordinators' IENs
S TMP=""
F S TMP=$O(RCLST(TMP)) Q:TMP="" D
. S IEN=+RCLST(TMP)
. S:$$FIND1^DIC(200,,,"`"_IEN,,,"RORMSG")>0 RCL(IEN)=""
;
;--- Delete the coordinators
S DIK=$$OREF^DILF(ROOT),DA(1)=REGIEN,DA=0
F S DA=$O(@ROOT@(DA)) Q:DA'>0 D:'$D(RCL(DA)) ^DIK
;--- Update the coordinators
S (ECNT,IEN)=0,IENS="?+1,"_REGIEN_","
F S IEN=$O(RCL(IEN)) Q:IEN'>0 D
. S RORFDA(798.114,IENS,.01)=IEN
. S RORIEN(1)=IEN
. D UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
. I $G(DIERR) D S ECNT=ECNT+1 Q
. . S RC=$$DBS^RORERR("RORMSG",-9,,,798.114,IENS)
;
;--- Unlock the multiple and check for errors
D UNLOCK^RORLOCK(798.114,","_REGIEN_",")
I ECNT>0 D RPCSTK^RORERR(.RESULTS,-9) Q
;--- Success
S RESULTS(0)=0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORRP023 3729 printed Apr 09, 2024@20:48:47 Page 2
RORRP023 ;HCIOFO/SG - RPC: REGISTRY COORDINATORS ; 7/16/03 11:25am
+1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
+2 ;
+3 ; This routine uses the following IAs:
+4 ;
+5 ; #10060 Read access (FileMan) to the file #200 (supported)
+6 ;
+7 QUIT
+8 ;
+9 ;***** RETURNS THE LIST OF REGISTRY COORDINATORS
+10 ; RPC: [ROR LIST COORDINATORS]
+11 ;
+12 ; .RESULTS Reference to a local variable where the results
+13 ; are returned to.
+14 ;
+15 ; REGIEN Registry IEN
+16 ;
+17 ; The ^TMP("DILIST",$J) global node is used by the procedure.
+18 ;
+19 ; Return Values:
+20 ;
+21 ; A negative value of the first "^"-piece of the RESULTS(0)
+22 ; indicates an error (see the RPCSTK^RORERR procedure for more
+23 ; details).
+24 ;
+25 ; Otherwise, number of coordinators is returned in the
+26 ; @RESULTS@(0) and the subsequent nodes of the global array
+27 ; contain the coordinators.
+28 ;
+29 ; @RESULTS@(0) Number of Coordinators
+30 ;
+31 ; @RESULTS@(i) Coordinator's Descriptor
+32 ; ^01: IEN
+33 ; ^02: Name
+34 ;
RCLIST(RESULTS,REGIEN) ;
+1 NEW IENS,RC,RORERRDL,RORMSG,TMP
+2 DO CLEAR^RORERR("RCLIST^RORRP023",1)
+3 KILL RESULTS
SET RESULTS=$NAME(^TMP("DILIST",$JOB))
KILL @RESULTS
+4 ;--- Check the parameters
+5 SET RC=0
Begin DoDot:1
+6 ;--- Registry IEN
+7 IF $GET(REGIEN)'>0
Begin DoDot:2
+8 SET RC=$$ERROR^RORERR(-88,,,,"REGIEN",$GET(REGIEN))
End DoDot:2
QUIT
+9 SET REGIEN=+REGIEN
End DoDot:1
IF RC<0
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+10 ;--- Get the list of coordinators
+11 SET IENS=","_REGIEN_","
SET TMP="@;.01E"
+12 DO LIST^DIC(798.114,IENS,TMP,"PU",,,,"B",,,,"RORMSG")
+13 IF $GET(DIERR)
Begin DoDot:1
+14 SET RC=$$DBS^RORERR("RORMSG",-9,,,798.114,IENS)
End DoDot:1
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+15 ;--- Success
+16 SET TMP=+$GET(^TMP("DILIST",$JOB,0))
+17 KILL ^TMP("DILIST",$JOB,0)
SET @RESULTS@(0)=TMP
+18 QUIT
+19 ;
+20 ;***** UPDATES THE LIST OF REGISTRY COORDINATORS
+21 ; RPC: [ROR UPDATE COORDINATORS]
+22 ;
+23 ; .RESULTS Reference to a local variable where the results
+24 ; are returned to.
+25 ;
+26 ; REGIEN Registry IEN
+27 ;
+28 ; .RCLST( Reference to a local variable that contains
+29 ; a list of registry coordinators
+30 ; i) User IEN (DUZ)
+31 ;
+32 ; Return Values:
+33 ;
+34 ; A negative value of the first "^"-piece of the RESULTS(0)
+35 ; indicates an error (see the RPCSTK^RORERR procedure for more
+36 ; details).
+37 ;
+38 ; Otherwise, zero is returned in the RESULTS(0).
+39 ;
RCLUPD(RESULTS,REGIEN,RCLST) ;
+1 NEW DA,DIK,ECNT,IEN,IENS,RC,RCL,ROOT,RORERRDL,RORFDA,RORIEN,RORMSG,TMP
+2 DO CLEAR^RORERR("RCLUPD^RORRP023",1)
KILL RESULTS
+3 ;--- Check the parameters
+4 SET RC=0
Begin DoDot:1
+5 ;--- Registry IEN
+6 IF $GET(REGIEN)'>0
Begin DoDot:2
+7 SET RC=$$ERROR^RORERR(-88,,,,"REGIEN",$GET(REGIEN))
End DoDot:2
QUIT
+8 SET REGIEN=+REGIEN
End DoDot:1
IF RC<0
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+9 ;
+10 ;--- Lock the COORDINATOR multiple
+11 SET IENS=","_REGIEN_","
+12 SET RC=$$LOCK^RORLOCK(798.114,IENS)
+13 IF RC
if RC>0
Begin DoDot:1
+14 SET RC=$$ERROR^RORERR(-11,,,,"the COORDINATOR multiple")
End DoDot:1
DO RPCSTK^RORERR(.RESULTS,RC)
QUIT
+15 ;---
+16 SET ROOT=$$ROOT^DILFD(798.114,IENS,1)
+17 ;
+18 ;--- Create a list of coordinators' IENs
+19 SET TMP=""
+20 FOR
SET TMP=$ORDER(RCLST(TMP))
if TMP=""
QUIT
Begin DoDot:1
+21 SET IEN=+RCLST(TMP)
+22 if $$FIND1^DIC(200,,,"`"_IEN,,,"RORMSG")>0
SET RCL(IEN)=""
End DoDot:1
+23 ;
+24 ;--- Delete the coordinators
+25 SET DIK=$$OREF^DILF(ROOT)
SET DA(1)=REGIEN
SET DA=0
+26 FOR
SET DA=$ORDER(@ROOT@(DA))
if DA'>0
QUIT
if '$DATA(RCL(DA))
DO ^DIK
+27 ;--- Update the coordinators
+28 SET (ECNT,IEN)=0
SET IENS="?+1,"_REGIEN_","
+29 FOR
SET IEN=$ORDER(RCL(IEN))
if IEN'>0
QUIT
Begin DoDot:1
+30 SET RORFDA(798.114,IENS,.01)=IEN
+31 SET RORIEN(1)=IEN
+32 DO UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
+33 IF $GET(DIERR)
Begin DoDot:2
+34 SET RC=$$DBS^RORERR("RORMSG",-9,,,798.114,IENS)
End DoDot:2
SET ECNT=ECNT+1
QUIT
End DoDot:1
+35 ;
+36 ;--- Unlock the multiple and check for errors
+37 DO UNLOCK^RORLOCK(798.114,","_REGIEN_",")
+38 IF ECNT>0
DO RPCSTK^RORERR(.RESULTS,-9)
QUIT
+39 ;--- Success
+40 SET RESULTS(0)=0
+41 QUIT
