source: WorldVistAEHR/trunk/r/CLINICAL_CASE_REGISTRIES-ROR/RORLOG01.m@ 1484

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

initial load of WorldVistAEHR

File size: 3.5 KB
RevLine 
[613]1RORLOG01 ;HCIOFO/SG - LOG FILE MANAGEMENT (UTILITIES) ; 1/17/06 10:09am
2 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
3 ;
4 Q
5 ;
6 ;***** PROCESSES AN ACCESS VIOLATION ALERT
7ACLRTN ;
8 N I,PARAMS,RORBUF
9 ;--- Prepare the parameters
10 S (PARAMS("DUZ"),I)=+$P(XQADATA,U)
11 I I>0 D K RORBUF
12 . S PARAMS("USERNAME")=$$GET1^DIQ(200,I_",",.01,,,"RORBUF")
13 S:$G(PARAMS("USERNAME"))="" PARAMS("USERNAME")="unknown user"
14 S PARAMS("DATETIME")=$$FMTE^XLFDT($P(XQADATA,U,2))
15 ;--- Generate the text of alert
16 D BLD^DIALOG(7980000.015,.PARAMS,,"RORBUF","S")
17 ;--- Display the alert details
18 S I=0 W !
19 F S I=$O(RORBUF(I)) Q:I'>0 W !,RORBUF(I)
20 Q
21 ;
22 ;***** LOADS THE LOG SUBSYSTEM PARAMETERS
23 ;
24 ; .RORLST Reference to a local array containing names
25 ; of the registries to process (as subscripts).
26 ;
27 ; Return Values:
28 ; <0 Error code
29 ; 0 Ok
30 ;
31PARAMS(RORLST) ;
32 N ENABLE,IENS,IR,IRS,RC,RORBUF,RORMSG,RORSB,SCR,TYPE
33 ;--- Load a list of parameters of active registries
34 S SCR="I '$P(^(0),U,7),$D(RORLST($P(^(0),U)))"
35 D LIST^DIC(798.1,,"@;8I","U","*",,,"B",SCR,,"RORBUF","RORMSG")
36 S RC=$$DBS^RORERR("RORMSG",-9) Q:RC<0 RC
37 I '$G(RORBUF("DILIST",0)) S RORPARM("LOG")=1 Q 0
38 ;--- Process the list of log parameters
39 S IR="",RC=0
40 F S IR=$O(RORBUF("DILIST","ID",IR)) Q:IR="" D Q:RC
41 . ;--- Check if the log is enabled
42 . Q:'$G(RORBUF("DILIST","ID",IR,8))
43 . S ENABLE=1
44 . ;--- Load a list of event types to log
45 . S IRS=","_RORBUF("DILIST",2,IR)_"," K RORSB
46 . D LIST^DIC(798.11,IRS,"@;.01I","U","*",,,"B",,,"RORSB","RORMSG")
47 . S RC=$$DBS^RORERR("RORMSG",-9) Q:RC<0
48 . ;--- If there are no event types, log all events
49 . I '$G(RORSB("DILIST",0)) D Q
50 . . K RORPARM("LOG") S RC=1
51 . ;--- Process the list of event types
52 . S IRS=""
53 . F S IRS=$O(RORSB("DILIST","ID",IRS)) Q:IRS="" D
54 . . S TYPE=+$G(RORSB("DILIST","ID",IRS,.01))
55 . . S:TYPE RORPARM("LOG",TYPE)=1
56 S:$G(ENABLE) RORPARM("LOG")=1
57 ;--- If not all types of errors are recorded,
58 ; enable recording of the type "Error"
59 S:$D(RORPARM("LOG"))>1 RORPARM("LOG",6)=1
60 Q $S(RC<0:RC,1:0)
61 ;
62 ;***** PURGES THE OLD LOGS
63 ;
64 ; [DKEEP] Days to keep logs in the file (by default = 31)
65 ;
66 ; Return Values:
67 ; <0 Error code
68 ; 0 Ok
69 ;
70PURGE(DKEEP) ;
71 N HDR,IEN,IR,RC,RORFDA,RORFROM,RORMSG
72 S RORFROM=$$FMADD^XLFDT($$DT^XLFDT,-$G(DKEEP,31))+1
73 S RC=0
74 F D Q:'$P($G(HDR),U,3)!(RC<0)
75 . K RORFDA,RORMSG
76 . ;--- Get the next 10 records
77 . D LIST^DIC(798.7,,"@","BU",10,.RORFROM,,"B",,,"RORFDA","RORMSG")
78 . S RC=$$DBS^RORERR("RORMSG",-9) Q:RC<0
79 . ;--- Stop if no records left
80 . S HDR=$G(RORFDA("DILIST",0)) Q:'HDR
81 . ;--- Prepare the data
82 . S IR=""
83 . F S IR=$O(RORFDA("DILIST",2,IR),-1) Q:IR="" D
84 . . S IEN=RORFDA("DILIST",2,IR)
85 . . ;--- Check if the cross-reference entries are valid
86 . . D XREFCHK(IEN)
87 . . ;--- Delete the log only if it is not referenced
88 . . S:'$D(^RORDATA(798.7,"AREF",IEN)) RORFDA(798.7,IEN_",",.01)="@"
89 . K RORFDA("DILIST")
90 . Q:$D(RORFDA)<10
91 . ;--- Delete the records
92 . D FILE^DIE(,"RORFDA","RORMSG")
93 . S RC=$$DBS^RORERR("RORMSG",-9,,,798.7)
94 Q $S(RC<0:RC,1:0)
95 ;
96 ;***** CHECK IF THE LOG IS REALLY REFERENCED
97 ;
98 ; LOGIEN IEN of the log
99 ;
100XREFCHK(LOGIEN) ;
101 N FIELD,FILE,IENS,NODE,RORMSG,TMP
102 S NODE=$NA(^RORDATA(798.7,"AREF",IEN))
103 S FILE=""
104 F S FILE=$O(@NODE@(FILE)) Q:FILE="" D
105 . S IENS=""
106 . F S IENS=$O(@NODE@(FILE,IENS)) Q:IENS="" D
107 . . S FIELD=""
108 . . F S FIELD=$O(@NODE@(FILE,IENS,FIELD)) Q:FIELD="" D
109 . . . S TMP=+$$GET1^DIQ(FILE,IENS,FIELD,"I",,"RORMSG")
110 . . . K:TMP'=LOGIEN @NODE@(FILE,IENS,FIELD)
111 Q
Note: See TracBrowser for help on using the repository browser.