source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORRP023.m@ 1471

Last change on this file since 1471 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.5 KB
Line 
1RORRP023 ;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 ;
36RCLIST(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 ;
76RCLUPD(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
Note: See TracBrowser for help on using the repository browser.