| [613] | 1 | RORRP023 ;HCIOFO/SG - RPC: REGISTRY COORDINATORS ; 7/16/03 11:25am
|
|---|
| 2 | ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
|
|---|
| 3 | ;
|
|---|
| 4 | ; This routine uses the following IAs:
|
|---|
| 5 | ;
|
|---|
| 6 | ; #10060 Read access (FileMan) to the file #200 (supported)
|
|---|
| 7 | ;
|
|---|
| 8 | Q
|
|---|
| 9 | ;
|
|---|
| 10 | ;***** RETURNS THE LIST OF REGISTRY COORDINATORS
|
|---|
| 11 | ; RPC: [ROR LIST COORDINATORS]
|
|---|
| 12 | ;
|
|---|
| 13 | ; .RESULTS Reference to a local variable where the results
|
|---|
| 14 | ; are returned to.
|
|---|
| 15 | ;
|
|---|
| 16 | ; REGIEN Registry IEN
|
|---|
| 17 | ;
|
|---|
| 18 | ; The ^TMP("DILIST",$J) global node is used by the procedure.
|
|---|
| 19 | ;
|
|---|
| 20 | ; Return Values:
|
|---|
| 21 | ;
|
|---|
| 22 | ; A negative value of the first "^"-piece of the RESULTS(0)
|
|---|
| 23 | ; indicates an error (see the RPCSTK^RORERR procedure for more
|
|---|
| 24 | ; details).
|
|---|
| 25 | ;
|
|---|
| 26 | ; Otherwise, number of coordinators is returned in the
|
|---|
| 27 | ; @RESULTS@(0) and the subsequent nodes of the global array
|
|---|
| 28 | ; contain the coordinators.
|
|---|
| 29 | ;
|
|---|
| 30 | ; @RESULTS@(0) Number of Coordinators
|
|---|
| 31 | ;
|
|---|
| 32 | ; @RESULTS@(i) Coordinator's Descriptor
|
|---|
| 33 | ; ^01: IEN
|
|---|
| 34 | ; ^02: Name
|
|---|
| 35 | ;
|
|---|
| 36 | RCLIST(RESULTS,REGIEN) ;
|
|---|
| 37 | N IENS,RC,RORERRDL,RORMSG,TMP
|
|---|
| 38 | D CLEAR^RORERR("RCLIST^RORRP023",1)
|
|---|
| 39 | K RESULTS S RESULTS=$NA(^TMP("DILIST",$J)) K @RESULTS
|
|---|
| 40 | ;--- Check the parameters
|
|---|
| 41 | S RC=0 D I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
|
|---|
| 42 | . ;--- Registry IEN
|
|---|
| 43 | . I $G(REGIEN)'>0 D Q
|
|---|
| 44 | . . S RC=$$ERROR^RORERR(-88,,,,"REGIEN",$G(REGIEN))
|
|---|
| 45 | . S REGIEN=+REGIEN
|
|---|
| 46 | ;--- Get the list of coordinators
|
|---|
| 47 | S IENS=","_REGIEN_",",TMP="@;.01E"
|
|---|
| 48 | D LIST^DIC(798.114,IENS,TMP,"PU",,,,"B",,,,"RORMSG")
|
|---|
| 49 | I $G(DIERR) D D RPCSTK^RORERR(.RESULTS,RC) Q
|
|---|
| 50 | . S RC=$$DBS^RORERR("RORMSG",-9,,,798.114,IENS)
|
|---|
| 51 | ;--- Success
|
|---|
| 52 | S TMP=+$G(^TMP("DILIST",$J,0))
|
|---|
| 53 | K ^TMP("DILIST",$J,0) S @RESULTS@(0)=TMP
|
|---|
| 54 | Q
|
|---|
| 55 | ;
|
|---|
| 56 | ;***** UPDATES THE LIST OF REGISTRY COORDINATORS
|
|---|
| 57 | ; RPC: [ROR UPDATE COORDINATORS]
|
|---|
| 58 | ;
|
|---|
| 59 | ; .RESULTS Reference to a local variable where the results
|
|---|
| 60 | ; are returned to.
|
|---|
| 61 | ;
|
|---|
| 62 | ; REGIEN Registry IEN
|
|---|
| 63 | ;
|
|---|
| 64 | ; .RCLST( Reference to a local variable that contains
|
|---|
| 65 | ; a list of registry coordinators
|
|---|
| 66 | ; i) User IEN (DUZ)
|
|---|
| 67 | ;
|
|---|
| 68 | ; Return Values:
|
|---|
| 69 | ;
|
|---|
| 70 | ; A negative value of the first "^"-piece of the RESULTS(0)
|
|---|
| 71 | ; indicates an error (see the RPCSTK^RORERR procedure for more
|
|---|
| 72 | ; details).
|
|---|
| 73 | ;
|
|---|
| 74 | ; Otherwise, zero is returned in the RESULTS(0).
|
|---|
| 75 | ;
|
|---|
| 76 | RCLUPD(RESULTS,REGIEN,RCLST) ;
|
|---|
| 77 | N DA,DIK,ECNT,IEN,IENS,RC,RCL,ROOT,RORERRDL,RORFDA,RORIEN,RORMSG,TMP
|
|---|
| 78 | D CLEAR^RORERR("RCLUPD^RORRP023",1) K RESULTS
|
|---|
| 79 | ;--- Check the parameters
|
|---|
| 80 | S RC=0 D I RC<0 D RPCSTK^RORERR(.RESULTS,RC) Q
|
|---|
| 81 | . ;--- Registry IEN
|
|---|
| 82 | . I $G(REGIEN)'>0 D Q
|
|---|
| 83 | . . S RC=$$ERROR^RORERR(-88,,,,"REGIEN",$G(REGIEN))
|
|---|
| 84 | . S REGIEN=+REGIEN
|
|---|
| 85 | ;
|
|---|
| 86 | ;--- Lock the COORDINATOR multiple
|
|---|
| 87 | S IENS=","_REGIEN_","
|
|---|
| 88 | S RC=$$LOCK^RORLOCK(798.114,IENS)
|
|---|
| 89 | I RC D:RC>0 D RPCSTK^RORERR(.RESULTS,RC) Q
|
|---|
| 90 | . S RC=$$ERROR^RORERR(-11,,,,"the COORDINATOR multiple")
|
|---|
| 91 | ;---
|
|---|
| 92 | S ROOT=$$ROOT^DILFD(798.114,IENS,1)
|
|---|
| 93 | ;
|
|---|
| 94 | ;--- Create a list of coordinators' IENs
|
|---|
| 95 | S TMP=""
|
|---|
| 96 | F S TMP=$O(RCLST(TMP)) Q:TMP="" D
|
|---|
| 97 | . S IEN=+RCLST(TMP)
|
|---|
| 98 | . S:$$FIND1^DIC(200,,,"`"_IEN,,,"RORMSG")>0 RCL(IEN)=""
|
|---|
| 99 | ;
|
|---|
| 100 | ;--- Delete the coordinators
|
|---|
| 101 | S DIK=$$OREF^DILF(ROOT),DA(1)=REGIEN,DA=0
|
|---|
| 102 | F S DA=$O(@ROOT@(DA)) Q:DA'>0 D:'$D(RCL(DA)) ^DIK
|
|---|
| 103 | ;--- Update the coordinators
|
|---|
| 104 | S (ECNT,IEN)=0,IENS="?+1,"_REGIEN_","
|
|---|
| 105 | F S IEN=$O(RCL(IEN)) Q:IEN'>0 D
|
|---|
| 106 | . S RORFDA(798.114,IENS,.01)=IEN
|
|---|
| 107 | . S RORIEN(1)=IEN
|
|---|
| 108 | . D UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
|
|---|
| 109 | . I $G(DIERR) D S ECNT=ECNT+1 Q
|
|---|
| 110 | . . S RC=$$DBS^RORERR("RORMSG",-9,,,798.114,IENS)
|
|---|
| 111 | ;
|
|---|
| 112 | ;--- Unlock the multiple and check for errors
|
|---|
| 113 | D UNLOCK^RORLOCK(798.114,","_REGIEN_",")
|
|---|
| 114 | I ECNT>0 D RPCSTK^RORERR(.RESULTS,-9) Q
|
|---|
| 115 | ;--- Success
|
|---|
| 116 | S RESULTS(0)=0
|
|---|
| 117 | Q
|
|---|
