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

RORRP023.m

Go to the documentation of this file. 
  1. RORRP023 ;HCIOFO/SG - RPC: REGISTRY COORDINATORS ; 7/16/03 11:25am
  1.  ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
  1.  ;
  1.  ; This routine uses the following IAs:
  1.  ;
  1.  ; #10060        Read access (FileMan) to the file #200 (supported)
  1.  ;
  1.  Q
  1.  ;
  1.  ;***** RETURNS THE LIST OF REGISTRY COORDINATORS
  1.  ; RPC: [ROR LIST COORDINATORS]
  1.  ;
  1.  ; .RESULTS      Reference to a local variable where the results
  1.  ;               are returned to.
  1.  ;
  1.  ; REGIEN        Registry IEN
  1.  ;
  1.  ; The ^TMP("DILIST",$J) global node is used by the procedure.
  1.  ;
  1.  ; Return Values:
  1.  ;
  1.  ; A negative value of the first "^"-piece of the RESULTS(0)
  1.  ; indicates an error (see the RPCSTK^RORERR procedure for more
  1.  ; details).
  1.  ;
  1.  ; Otherwise, number of coordinators is returned in the
  1.  ; @RESULTS@(0) and the subsequent nodes of the global array
  1.  ; contain the coordinators.
  1.  ; 
  1.  ; @RESULTS@(0)          Number of Coordinators
  1.  ;
  1.  ; @RESULTS@(i)          Coordinator's Descriptor
  1.  ;                         ^01: IEN
  1.  ;                         ^02: Name
  1.  ;
  1. RCLIST(RESULTS,REGIEN) ;
  1.  N IENS,RC,RORERRDL,RORMSG,TMP
  1.  D CLEAR^RORERR("RCLIST^RORRP023",1)
  1.  K RESULTS  S RESULTS=$NA(^TMP("DILIST",$J))  K @RESULTS
  1.  ;--- Check the parameters
  1.  S RC=0  D  I RC<0  D RPCSTK^RORERR(.RESULTS,RC)  Q
  1.  . ;--- Registry IEN
  1.  . I $G(REGIEN)'>0  D  Q
  1.  . . S RC=$$ERROR^RORERR(-88,,,,"REGIEN",$G(REGIEN))
  1.  . S REGIEN=+REGIEN
  1.  ;--- Get the list of coordinators
  1.  S IENS=","_REGIEN_",",TMP="@;.01E"
  1.  D LIST^DIC(798.114,IENS,TMP,"PU",,,,"B",,,,"RORMSG")
  1.  I $G(DIERR)  D  D RPCSTK^RORERR(.RESULTS,RC)  Q
  1.  . S RC=$$DBS^RORERR("RORMSG",-9,,,798.114,IENS)
  1.  ;--- Success
  1.  S TMP=+$G(^TMP("DILIST",$J,0))
  1.  K ^TMP("DILIST",$J,0)  S @RESULTS@(0)=TMP
  1.  Q
  1.  ;
  1.  ;***** UPDATES THE LIST OF REGISTRY COORDINATORS
  1.  ; RPC: [ROR UPDATE COORDINATORS]
  1.  ;
  1.  ; .RESULTS      Reference to a local variable where the results
  1.  ;               are returned to.
  1.  ;
  1.  ; REGIEN        Registry IEN
  1.  ;
  1.  ; .RCLST(       Reference to a local variable that contains
  1.  ;               a list of registry coordinators
  1.  ;   i)            User IEN (DUZ)
  1.  ;
  1.  ; Return Values:
  1.  ;
  1.  ; A negative value of the first "^"-piece of the RESULTS(0)
  1.  ; indicates an error (see the RPCSTK^RORERR procedure for more
  1.  ; details).
  1.  ;
  1.  ; Otherwise, zero is returned in the RESULTS(0).
  1.  ;
  1. RCLUPD(RESULTS,REGIEN,RCLST) ;
  1.  N DA,DIK,ECNT,IEN,IENS,RC,RCL,ROOT,RORERRDL,RORFDA,RORIEN,RORMSG,TMP
  1.  D CLEAR^RORERR("RCLUPD^RORRP023",1)  K RESULTS
  1.  ;--- Check the parameters
  1.  S RC=0  D  I RC<0  D RPCSTK^RORERR(.RESULTS,RC)  Q
  1.  . ;--- Registry IEN
  1.  . I $G(REGIEN)'>0  D  Q
  1.  . . S RC=$$ERROR^RORERR(-88,,,,"REGIEN",$G(REGIEN))
  1.  . S REGIEN=+REGIEN
  1.  ;
  1.  ;--- Lock the COORDINATOR multiple
  1.  S IENS=","_REGIEN_","
  1.  S RC=$$LOCK^RORLOCK(798.114,IENS)
  1.  I RC  D:RC>0  D RPCSTK^RORERR(.RESULTS,RC)  Q
  1.  . S RC=$$ERROR^RORERR(-11,,,,"the COORDINATOR multiple")
  1.  ;---
  1.  S ROOT=$$ROOT^DILFD(798.114,IENS,1)
  1.  ;
  1.  ;--- Create a list of coordinators' IENs
  1.  S TMP=""
  1.  F  S TMP=$O(RCLST(TMP))  Q:TMP=""  D
  1.  . S IEN=+RCLST(TMP)
  1.  . S:$$FIND1^DIC(200,,,"`"_IEN,,,"RORMSG")>0 RCL(IEN)=""
  1.  ;
  1.  ;--- Delete the coordinators
  1.  S DIK=$$OREF^DILF(ROOT),DA(1)=REGIEN,DA=0
  1.  F  S DA=$O(@ROOT@(DA))  Q:DA'>0  D:'$D(RCL(DA)) ^DIK
  1.  ;--- Update the coordinators
  1.  S (ECNT,IEN)=0,IENS="?+1,"_REGIEN_","
  1.  F  S IEN=$O(RCL(IEN))  Q:IEN'>0  D
  1.  . S RORFDA(798.114,IENS,.01)=IEN
  1.  . S RORIEN(1)=IEN
  1.  . D UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
  1.  . I $G(DIERR)  D  S ECNT=ECNT+1  Q
  1.  . . S RC=$$DBS^RORERR("RORMSG",-9,,,798.114,IENS)
  1.  ;
  1.  ;--- Unlock the multiple and check for errors
  1.  D UNLOCK^RORLOCK(798.114,","_REGIEN_",")
  1.  I ECNT>0  D RPCSTK^RORERR(.RESULTS,-9)  Q
  1.  ;--- Success
  1.  S RESULTS(0)=0
  1.  Q