source: FOIAVistA/tag/r/CLINICAL_CASE_REGISTRIES-ROR/RORRP013.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 6.4 KB
Line 
1RORRP013 ;HCIOFO/SG - RPC: ACCESS & SECURITY ; 11/9/05 8:56am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6 ;***** RETURNS A LIST OF REGISTRIES ACCESSIBLE TO THE GUI USER
7 ; RPC: [ROR GUI ACCESS]
8 ;
9 ; .RESULTS Reference to a local variable where the results
10 ; are returned to.
11 ;
12 ; [USER] User IEN in the NEW PERSON file. By default
13 ; (if $G(USER)'>0), the DUZ is used).
14 ;
15 ; Return Values:
16 ;
17 ; A negative value of the first "^"-piece of the RESULTS(0) indicates
18 ; an error (see the RPCSTK^RORERR procedure for more details).
19 ;
20 ; RESULTS(0) Number of accessible registries
21 ;
22 ; RESULTS(i) Registry descriptor
23 ; ^01: Registry IEN
24 ; ^02: Registry name
25 ; ^03: Administrator? (0 or 1)
26 ; ^04: Short description
27 ;
28ACREGLST(RESULTS,USER) ;
29 N ADMIN,CNT,IENS,KEY,RC,REGIEN,RORBUF,RORERRDL,RORMSG,TMP
30 K RESULTS S RESULTS(0)=0
31 D CLEAR^RORERR("ACREGLST^RORRP013",1)
32 ;--- Check the version of the GUI
33 I $G(XWBAPVER)<1.5 D D RPCSTK^RORERR(.RESULTS,RC) Q
34 . N DIERR,DIHELP,DIMSG
35 . S TMP("CV")=$S($G(XWBAPVER)>0:XWBAPVER,1:"1.0")
36 . S TMP("RV")="1.5"
37 . D BLD^DIALOG(7980000.006,.TMP,,"RORBUF")
38 . S RC=$$ERROR^RORERR(-107,,.RORBUF)
39 . K RORBUF,TMP
40 ;--- User must be defined
41 I $G(USER)'>0 S USER=+$G(DUZ) Q:USER'>0
42 ;
43 S (CNT,RC,REGIEN)=0
44 F S REGIEN=$O(^ROR(798.1,"ACL",USER,REGIEN)) Q:REGIEN="" D Q:RC<0
45 . Q:REGIEN'>0 S IENS=REGIEN_"," K RORBUF
46 . D GETS^DIQ(798.1,IENS,".01;4",,"RORBUF","RORMSG")
47 . I $G(DIERR) S RC=$$DBS^RORERR("RORMSG",-9,,,798.1,IENS) Q
48 . ;--- Add the registry descriptor to the list
49 . S CNT=CNT+1,RESULTS(CNT)=REGIEN_"^"_$G(RORBUF(798.1,IENS,.01))
50 . S $P(RESULTS(CNT),"^",4)=$G(RORBUF(798.1,IENS,4))
51 . ;--- Check if the user has the administrator security key
52 . S KEY="",ADMIN=0
53 . F S KEY=$O(^ROR(798.1,"ACL",USER,REGIEN,KEY)) Q:KEY="" D Q:RC<0
54 . . I KEY?1"ROR"1.E S:KEY["ADMIN" ADMIN=1
55 . S $P(RESULTS(CNT),"^",3)=ADMIN
56 ;
57 I RC'<0 D:CNT'>0 S RESULTS(0)=CNT
58 . D ACVIOLTN^RORLOG(-91) ; Record the access violation
59 E D RPCSTK^RORERR(.RESULTS,RC)
60 Q
61 ;
62 ;***** RETURNS THE LIST OF ACCESS VIOLATIONS
63 ; RPC: [ROR LOG GET ACCESS VIOLATIONS]
64 ;
65 ; .RESULTS Reference to a local variable where the results
66 ; are returned to.
67 ;
68 ; [STDT] Start date (by default, from the earliest violation)
69 ; [ENDT] End date (by default, to the latest violation)
70 ;
71 ; Return Values:
72 ;
73 ; A negative value of the first "^"-piece of the RESULTS(0) indicates
74 ; an error (see the RPCSTK^RORERR procedure for more details).
75 ;
76 ; Otherwise, number of logs is returned in the RESULTS(0) and the
77 ; subsequent nodes of the RESULTS array contain the violations.
78 ;
79 ; @RESULTS@(0) Number of access violations
80 ;
81 ; @RESULTS@(i) Access violation descriptor
82 ; ^01: Date/Time (int)
83 ; ^02: User Name
84 ; ^03: User IEN
85 ; ^04: Message
86 ;
87AVLIST(RESULTS,STDT,ENDT) ;
88 N BUF,CNT,DATE,IEN,IENS,RC,ROOT,RORBUF,RORERRDL,RORMSG
89 D CLEAR^RORERR("AVLIST^RORRP013",1)
90 ;--- Check the parameters
91 S STDT=$G(STDT)\1,ENDT=$G(ENDT)\1
92 S ENDT=$S(ENDT>0:$$FMADD^XLFDT(ENDT,1),1:9999999)
93 ;--- Initialize the variables
94 S ROOT=$$ROOT^DILFD(798.7,,1),CNT=0
95 K RESULTS S RESULTS=$$ALLOC^RORTMP()
96 ;--- Browse through the logs
97 S DATE=STDT
98 F S DATE=$O(@ROOT@("B",DATE)) Q:DATE="" Q:DATE'<ENDT D
99 . S IEN=0
100 . F S IEN=$O(@ROOT@("B",DATE,IEN)) Q:IEN'>0 D
101 . . S IENS=IEN_"," K RORBUF
102 . . D GETS^DIQ(798.7,IENS,".01;1;7","EI","RORBUF","RORMSG")
103 . . Q:$G(DIERR)
104 . . ;--- Check for the 'Access Violation' Activity
105 . . Q:$G(RORBUF(798.7,IENS,1,"I"))'=6
106 . . ;--- Date/Time of the event
107 . . S BUF=$G(RORBUF(798.7,IENS,.01,"I"))
108 . . ;--- User Name (ext)
109 . . S $P(BUF,"^",2)=$G(RORBUF(798.7,IENS,7,"E"))
110 . . ;--- User IEN (int)
111 . . S $P(BUF,"^",3)=$G(RORBUF(798.7,IENS,7,"I"))
112 . . ;--- Message
113 . . S $P(BUF,"^",4)=$$GET1^DIQ(798.74,"1,"_IENS,2,,,"RORMSG")
114 . . ;--- Add the record to the output
115 . . S CNT=CNT+1,@RESULTS@(CNT)=BUF
116 ;--- Number of violations
117 S @RESULTS@(0)=CNT
118 Q
119 ;
120 ;***** ADDS THE USERS WHO HAVE THE SECURITY KEY TO THE LIST
121 ;
122 ; KEYNAME Name of the security key
123 ; ACCESS Level of the user access to the registry
124 ; (1-User, 2-Administrator, 3-IRM)
125 ;
126 ; Return Values:
127 ;
128KLIST(KEYNAME,ACCESS) ;
129 N IEN S IEN=0
130 F S IEN=$O(^XUSEC(KEYNAME,IEN)) Q:IEN'>0 D
131 . S $P(@RORULST@(IEN,0),"^",ACCESS)=1
132 Q
133 ;
134 ;***** RETURNS THE LIST OF REGISTRY USERS
135 ; RPC: [ROR GET REGISTRY USERS]
136 ;
137 ; .RESULTS Reference to a local variable where the results
138 ; are returned to.
139 ;
140 ; REGIEN Registry IEN
141 ;
142 ; Return Values:
143 ;
144 ; A negative value of the first "^"-piece of the RESULTS(0) indicates
145 ; an error (see the RPCSTK^RORERR procedure for more details).
146 ;
147 ; Otherwise, number of users is returned in the RESULTS(0) and the
148 ; subsequent nodes of the RESULTS array contain the users.
149 ;
150 ; @RESULTS@(0) Number of users
151 ;
152 ; @RESULTS@(i) User descriptor
153 ; ^01: User IEN (DUZ)
154 ; ^02: User Name
155 ; ^03: User (0/1)
156 ; ^04: Administrator (0/1)
157 ; ^05: IRM (0/1)
158 ;
159USERLIST(RESULTS,REGIEN) ;
160 N ACCESS,ADMIN,CNT,IEN,NAME,RORERRDL,RORMSG,RORULST
161 D CLEAR^RORERR("USERLIST^RORRP013",1)
162 ;--- Check the parameters
163 I $G(REGIEN)'>0 D D RPCSTK^RORERR(.RESULTS,RC) Q
164 . S RC=$$ERROR^RORERR(-88,,,,"REGIEN",$G(REGIEN))
165 S REGIEN=+REGIEN
166 ;--- Initialize the variables
167 K RESULTS S RESULTS=$$ALLOC^RORTMP()
168 S RORULST=$$ALLOC^RORTMP()
169 ;--- Browse the security keys
170 S NAME=""
171 F S NAME=$O(^ROR(798.1,REGIEN,18,"B",NAME)) Q:NAME="" D
172 . S ADMIN=(NAME?1"ROR"1.E)&(NAME["ADMIN")
173 . D KLIST(NAME,$S(ADMIN:2,1:1))
174 ;--- Add the authorized IRM personnel
175 D KLIST("ROR VA IRM",3)
176 ;--- Sort the users by their names
177 S IEN=0
178 F S IEN=$O(@RORULST@(IEN)) Q:IEN'>0 D
179 . S NAME=$$GET1^DIQ(200,IEN_",",.01,,,"RORMSG")
180 . S:NAME'="" @RORULST@("B",NAME,IEN)=""
181 ;--- Generate the output
182 S NAME="",CNT=0
183 F S NAME=$O(@RORULST@("B",NAME)) Q:NAME="" D
184 . S IEN=0
185 . F S IEN=$O(@RORULST@("B",NAME,IEN)) Q:IEN'>0 D
186 . . S ACCESS=$G(@RORULST@(IEN,0))
187 . . S CNT=CNT+1,@RESULTS@(CNT)=IEN_"^"_NAME_"^"_ACCESS
188 S @RESULTS@(0)=CNT
189 ;--- Cleanup
190 D FREE^RORTMP(RORULST)
191 Q
Note: See TracBrowser for help on using the repository browser.