source: FOIAVistA/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORLOG.m@ 1688

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

initial load of FOIAVistA 6/30/08 version
File size: 9.0 KB
Line 
1RORLOG ;HCIOFO/SG - LOG FILE MANAGEMENT ; 1/17/06 10:10am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 ; RORLOG -------------- CONSTANT & VARIABLES OF THE LOG SUSBSYSTEM
5 ;
6 ; RORLOG("IEN") IEN of the main record in the ROR LOG file
7 ;
8 ; This routine uses the following IAs:
9 ;
10 ; #10060 Read-only (DBS API) access to the NEW PERSON file
11 ;
12 Q
13 ;
14 ;***** RECORDS THE ACCESS VIOLATION EVENT
15 ;
16 ; MSG Either a negative code of the message or a message
17 ; text that will be recorded in the log.
18 ;
19 ; [REGISTRY] Either a registry name or a registry IEN
20 ; (the log will be associated with this registry)
21 ;
22 ; [ARG2-ARG5] Optional parameters as for $$MSG^RORERR20
23 ;
24ACVIOLTN(MSG,REGISTRY,ARG2,ARG3,ARG4,ARG5) ;
25 N INFO,RORLOG,RORMSG,RORPARM
26 S REGISTRY=$G(REGISTRY)
27 ;--- Make sure that event recording is enabled
28 S RORPARM("LOG")=1
29 ;--- Get the registry name
30 I (+REGISTRY)=REGISTRY D:REGISTRY>0
31 . S REGISTRY=$P($G(^ROR(798.1,+REGISTRY,0)),U)
32 ;--- Get the text of the message (if a code is provided)
33 S:(+MSG)=MSG MSG=$$MSG^RORERR20(+MSG,,,.ARG2,.ARG3,.ARG4,.ARG5)
34 ;--- Send an alert to the registry coordinators
35 D:REGISTRY'=""
36 . S INFO=$G(DUZ)_U_$$NOW^XLFDT
37 . D ALERT^RORUTL01(REGISTRY,MSG,"ACLRTN^RORLOG01",INFO)
38 ;--- Create a new log and record the message
39 I $$OPEN(REGISTRY,6)'<0 D D CLOSE()
40 . D:$G(DUZ)>0
41 . . S INFO="Violator: "_$$GET1^DIQ(200,DUZ_",",.01,,,"RORMSG")
42 . . S INFO=INFO_" (DUZ="_DUZ_")"
43 . D LOG(6,MSG,,.INFO)
44 Q
45 ;
46 ;***** CLOSES THE CURRENT LOG
47 ;
48 ; [MESSAGE] Text of the final message
49 ; [COUNTERS] Statistic counters
50 ; ^1: Total number of processed patients
51 ; ^2: Number of patients processed with errors
52 ;
53CLOSE(MESSAGE,COUNTERS) ;
54 Q:$G(RORLOG("IEN"))'>0
55 N BDT,EDT,IENS,RATE,RORFDA,RORINFO,RORMSG,TMP
56 S EDT=$$NOW^XLFDT
57 S IENS=RORLOG("IEN")_","
58 ;--- Prepare statistic data
59 D:$G(COUNTERS)>0
60 . S RORINFO(1)="Patients: "_+$P(COUNTERS,U)
61 . S RORINFO(2)="Errors: "_+$P(COUNTERS,U,2)
62 . S BDT=$$GET1^DIQ(798.7,IENS,.01,"I",,"RORMSG")
63 . Q:$G(BDT)'>0
64 . S TMP=$$FMDIFF^XLFDT(EDT,BDT,2)
65 . S RATE=$S(TMP>0:$J(COUNTERS/TMP,0,3),1:"")
66 . S RORINFO(3)="Time (sec): "_TMP
67 . S:RATE RORINFO(4)="Patients/sec: "_RATE
68 . ;--- Data for the log header
69 . S RORFDA(798.7,IENS,6.01)=$P(COUNTERS,U,1)
70 . S RORFDA(798.7,IENS,6.02)=$P(COUNTERS,U,2)
71 . S:RATE RORFDA(798.7,IENS,6.03)=RATE
72 ;--- Store data in the header and log the final message
73 S RORFDA(798.7,IENS,5)=EDT
74 D FILE^DIE("K","RORFDA","RORMSG")
75 D:$G(MESSAGE)'="" LOG^RORLOG(,MESSAGE,,.RORINFO)
76 K RORLOG
77 Q
78 ;
79 ;***** PUTS MESSAGE IN THE LOG
80 ;
81 ; [TYPE] Type of the event:
82 ; 1 Debug
83 ; 2 Information
84 ; 3 Data quality
85 ; 4 Warning
86 ; 5 Database error
87 ; 6 Error
88 ;
89 ; If value of the parameter is omitted or equals 0, the message
90 ; is logged as "information" (if log is enabled). This mode is
91 ; intended for log headers and separators.
92 ;
93 ; MESSAGE Message text
94 ; [PATIEN] Patient IEN
95 ;
96 ; [[.]RORINFO] Optional additional information (either a string or
97 ; a reference to a local array that contains strings
98 ; prepared for storing in a word processing field)
99 ;
100LOG(TYPE,MESSAGE,PATIEN,RORINFO) ;
101 ;--- Do not do anything if log is disabled
102 Q:'$G(RORPARM("LOG"))
103 ;--- Check if collection of this kind of event is enabled.
104 ; Debug messages could be enabled only explicitly.
105 I '$G(TYPE) S TYPE=2
106 E I ($D(RORPARM("LOG"))>1)!(TYPE=1) Q:'$G(RORPARM("LOG",+TYPE))
107 ;---
108 N CURRIO,DATETIME,I,IENS,RC,RORFDA,RORMSG,TMP
109 I $D(RORINFO)=1 S TMP=RORINFO K RORINFO S RORINFO(1)=TMP K TMP
110 S DATETIME=$$NOW^XLFDT
111 ;--- Add a new record to the log (if it has been open)
112 D:$G(RORLOG("IEN"))>0
113 . S IENS="+1,"_RORLOG("IEN")_","
114 . S RORFDA(798.74,IENS,.01)=DATETIME
115 . S RORFDA(798.74,IENS,1)=+TYPE
116 . S RORFDA(798.74,IENS,2)=$E(MESSAGE,1,70)
117 . S:$G(PATIEN) RORFDA(798.74,IENS,3)=+PATIEN
118 . S:$D(RORINFO)>1 RORFDA(798.74,IENS,4)="RORINFO"
119 . D UPDATE^DIE(,"RORFDA",,"RORMSG")
120 ;--- Display message (if debug mode 2 is enabled)
121 I $G(RORPARM("DEBUG"))>1 U $G(IO(0)) D U IO
122 . W !,$P($$FMTE^XLFDT(DATETIME,"2FS"),"@",2)_" "_$E(MESSAGE,1,70),!
123 . S I=""
124 . F S I=$O(RORINFO(I)) Q:I="" D W ?9,TMP,!
125 . . S TMP=$G(RORINFO(I)) S:TMP="" TMP=$G(RORINFO(I,0))
126 . W:$G(PATIEN) ?9,"Patient IEN: "_PATIEN,!
127 Q
128 ;
129 ;***** RETURNS AN IEN OF THE CURRENT LOG
130LOGIEN() ;
131 Q +$G(RORLOG("IEN"))
132 ;
133 ;***** OPENS A NEW LOG
134 ;
135 ; [[.]REGLST] Either name of the registry or reference to a local
136 ; array containing registry names as subscripts and
137 ; optional registry IENs as values
138 ;
139 ; [ACTIVITY] Type of the activity:
140 ; 0 Other (default)
141 ; 1 Registry update
142 ; 2 Data Extract
143 ; 3 Acknowledgement
144 ; 4 Hist. Extraction
145 ; 5 Report
146 ; 6 Access Violation
147 ; 7 ROR TASK
148 ; 8 Registry Setup
149 ;
150 ; [MESSAGE] Text of the first message
151 ;
152 ; [[.]ADDINFO] Optional additional information (either a string or
153 ; a reference to a local array that contains strings
154 ; prepared for storing in a word processing field).
155 ; This text is appended after the list of registries
156 ; associated with the log.
157 ;
158 ; Return Values:
159 ; <0 Error code
160 ; 0 Ok
161 ;
162OPEN(REGLST,ACTIVITY,MESSAGE,ADDINFO) ;
163 Q:'$G(RORPARM("LOG")) 0
164 N I,IENS,IPTR,RC,REGIEN,REGNAME,RORFDA,RORIEN,RORINFO,RORMSG,TMP
165 K RORLOG
166 ;=== Prepare the list of registries
167 I $D(REGLST)=1 S:REGLST'="" REGLST(REGLST)=""
168 S REGNAME="",(IPTR,RC)=0
169 F S REGNAME=$O(REGLST(REGNAME)) Q:REGNAME="" D Q:RC<0
170 . S REGIEN=+$G(REGLST(REGNAME))
171 . I REGIEN'>0 D I REGIEN'>0 S RC=REGIEN Q
172 . . S REGIEN=$$REGIEN^RORUTL02(REGNAME)
173 . S IPTR=IPTR+1,RORINFO(IPTR)=REGNAME
174 . S RORFDA(798.73,"+"_(IPTR+10)_",+1,",.01)=REGIEN
175 . S RORIEN(IPTR+10)=REGIEN
176 Q:RC<0 RC
177 ;=== Create a log header (main record) in the ROR LOG file
178 S IENS="+1,"
179 S RORFDA(798.7,IENS,.01)=$$NOW^XLFDT
180 S:$G(ACTIVITY)>0 RORFDA(798.7,IENS,1)=ACTIVITY
181 S RORFDA(798.7,IENS,2)=$J
182 S RORFDA(798.7,IENS,7)=$S($G(DUZ)>0:+DUZ,1:"")
183 S TMP=$S($D(ZTQUEUED):+$G(ZTSK),1:0)
184 S RORFDA(798.7,IENS,8)=$S(TMP>0:TMP,1:"")
185 D UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
186 S RC=$$DBS^RORERR("RORMSG",-9) Q:RC<0 RC
187 S RORLOG("IEN")=RORIEN(1)
188 ;=== Add the header message (if any)
189 D:$G(MESSAGE)'=""
190 . ;--- Append the additional text to list of registries
191 . I $D(ADDINFO)=1 D
192 . . S IPTR=IPTR+1,RORINFO(IPTR)=ADDINFO
193 . E S I="" D
194 . . F S I=$O(ADDINFO(I)) Q:I="" D
195 . . . S TMP=$G(ADDINFO(I)),IPTR=IPTR+1
196 . . . S RORINFO(IPTR)=$S(TMP'="":TMP,1:$G(ADDINFO(I,0)))
197 . ;---
198 . D LOG(,MESSAGE,,.RORINFO)
199 ;=== Success
200 Q 0
201 ;
202 ;***** REPLACES LIST OF REGISTRIES ASSOCIATED WITH THE CURRENT LOG
203 ;
204 ; [.]REGLST Either name of the registry or a reference to a local
205 ; array containing registry names as subscripts and
206 ; optional registry IENs as values.
207 ;
208 ; [NOLP] If this parameter is defined and non-zero, the log
209 ; subsystem parameters will not be updated according
210 ; to the new list of associated registries.
211 ;
212 ; Return Values:
213 ; <0 Error code
214 ; 0 Ok
215 ;
216SETRGLST(REGLST,NOLP) ;
217 N I,IENS,RC,REGIEN,RILST,RORBUF,RORFDA,RORIEN,RORMSG
218 S IENS=$$LOGIEN()_","
219 Q:'$G(RORPARM("LOG"))!(IENS'>0) 0
220 ;--- Compile a list of registry IENs (as subscripts)
221 S:$D(REGLST)=1 REGLST(REGLST)=""
222 S I="",RC=0
223 F S I=$O(REGLST(I)) Q:I="" D Q:RC<0
224 . S REGIEN=+$G(REGLST(I))
225 . I REGIEN'>0 D I REGIEN'>0 S RC=REGIEN Q
226 . . S REGIEN=$$REGIEN^RORUTL02(I)
227 . S RILST(REGIEN)=""
228 Q:RC<0 RC
229 ;--- Delete old registries from the multiple of the log record
230 D LIST^DIC(798.73,","_IENS,"@;.01I","U",,,,"B",,,"RORBUF","RORMSG")
231 S RC=$$DBS^RORERR("RORMSG",-9) Q:RC<0 RC
232 S I=""
233 F S I=$O(RORBUF("DILIST",2,I)) Q:I="" D
234 . S REGIEN=RORBUF("DILIST","ID",I,.01)
235 . I $D(RILST(REGIEN)) K RILST(REGIEN) Q
236 . S RORFDA(798.73,RORBUF("DILIST",2,I)_","_IENS,.01)="@"
237 I $D(RORFDA)>1 D Q:RC<0 RC
238 . D FILE^DIE("K","RORFDA","RORMSG")
239 . S RC=$$DBS^RORERR("RORMSG",-9)
240 ;--- Add new registries to the multiple
241 S REGIEN=""
242 F I=1:1 S REGIEN=$O(RILST(REGIEN)) Q:REGIEN="" D
243 . S RORFDA(798.73,"+"_I_","_IENS,.01)=REGIEN
244 . S RORIEN(I)=REGIEN
245 I $D(RORFDA)>1 D Q:RC<0 RC
246 . D UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
247 . S RC=$$DBS^RORERR("RORMSG",-9)
248 ;--- Reload parameters (if necessary)
249 I '$G(NOLP) D Q:RC<0 RC
250 . K RORPARM("LOG") S RC=$$PARAMS^RORLOG01(.REGLST)
251 Q 0
252 ;
253 ;***** INITIALIZES THE LOG SUBSYSTEM
254 ;
255 ; [[.]REGLST] Either a reference to a local array containing names
256 ; of the registries to process (as subscripts) or a
257 ; string that contains a name of the single registry.
258 ;
259 ; Return Values:
260 ; <0 Error code
261 ; 0 Ok
262 ;
263SETUP(REGLST) ;
264 K RORPARM("LOG"),RORLOG
265 S:$D(REGLST)=1 REGLST(REGLST)=""
266 Q $$PARAMS^RORLOG01(.REGLST)
Note: See TracBrowser for help on using the repository browser.