RORLOG01 ;HCIOFO/SG - LOG FILE MANAGEMENT (UTILITIES) ; 1/17/06 10:09am
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
;
Q
;
;***** PROCESSES AN ACCESS VIOLATION ALERT
ACLRTN ;
N I,PARAMS,RORBUF
;--- Prepare the parameters
S (PARAMS("DUZ"),I)=+$P(XQADATA,U)
I I>0 D K RORBUF
. S PARAMS("USERNAME")=$$GET1^DIQ(200,I_",",.01,,,"RORBUF")
S:$G(PARAMS("USERNAME"))="" PARAMS("USERNAME")="unknown user"
S PARAMS("DATETIME")=$$FMTE^XLFDT($P(XQADATA,U,2))
;--- Generate the text of alert
D BLD^DIALOG(7980000.015,.PARAMS,,"RORBUF","S")
;--- Display the alert details
S I=0 W !
F S I=$O(RORBUF(I)) Q:I'>0 W !,RORBUF(I)
Q
;
;***** LOADS THE LOG SUBSYSTEM PARAMETERS
;
; .RORLST Reference to a local array containing names
; of the registries to process (as subscripts).
;
; Return Values:
; <0 Error code
; 0 Ok
;
PARAMS(RORLST) ;
N ENABLE,IENS,IR,IRS,RC,RORBUF,RORMSG,RORSB,SCR,TYPE
;--- Load a list of parameters of active registries
S SCR="I '$P(^(0),U,7),$D(RORLST($P(^(0),U)))"
D LIST^DIC(798.1,,"@;8I","U","*",,,"B",SCR,,"RORBUF","RORMSG")
S RC=$$DBS^RORERR("RORMSG",-9) Q:RC<0 RC
I '$G(RORBUF("DILIST",0)) S RORPARM("LOG")=1 Q 0
;--- Process the list of log parameters
S IR="",RC=0
F S IR=$O(RORBUF("DILIST","ID",IR)) Q:IR="" D Q:RC
. ;--- Check if the log is enabled
. Q:'$G(RORBUF("DILIST","ID",IR,8))
. S ENABLE=1
. ;--- Load a list of event types to log
. S IRS=","_RORBUF("DILIST",2,IR)_"," K RORSB
. D LIST^DIC(798.11,IRS,"@;.01I","U","*",,,"B",,,"RORSB","RORMSG")
. S RC=$$DBS^RORERR("RORMSG",-9) Q:RC<0
. ;--- If there are no event types, log all events
. I '$G(RORSB("DILIST",0)) D Q
. . K RORPARM("LOG") S RC=1
. ;--- Process the list of event types
. S IRS=""
. F S IRS=$O(RORSB("DILIST","ID",IRS)) Q:IRS="" D
. . S TYPE=+$G(RORSB("DILIST","ID",IRS,.01))
. . S:TYPE RORPARM("LOG",TYPE)=1
S:$G(ENABLE) RORPARM("LOG")=1
;--- If not all types of errors are recorded,
; enable recording of the type "Error"
S:$D(RORPARM("LOG"))>1 RORPARM("LOG",6)=1
Q $S(RC<0:RC,1:0)
;
;***** PURGES THE OLD LOGS
;
; [DKEEP] Days to keep logs in the file (by default = 31)
;
; Return Values:
; <0 Error code
; 0 Ok
;
PURGE(DKEEP) ;
N HDR,IEN,IR,RC,RORFDA,RORFROM,RORMSG
S RORFROM=$$FMADD^XLFDT($$DT^XLFDT,-$G(DKEEP,31))+1
S RC=0
F D Q:'$P($G(HDR),U,3)!(RC<0)
. K RORFDA,RORMSG
. ;--- Get the next 10 records
. D LIST^DIC(798.7,,"@","BU",10,.RORFROM,,"B",,,"RORFDA","RORMSG")
. S RC=$$DBS^RORERR("RORMSG",-9) Q:RC<0
. ;--- Stop if no records left
. S HDR=$G(RORFDA("DILIST",0)) Q:'HDR
. ;--- Prepare the data
. S IR=""
. F S IR=$O(RORFDA("DILIST",2,IR),-1) Q:IR="" D
. . S IEN=RORFDA("DILIST",2,IR)
. . ;--- Check if the cross-reference entries are valid
. . D XREFCHK(IEN)
. . ;--- Delete the log only if it is not referenced
. . S:'$D(^RORDATA(798.7,"AREF",IEN)) RORFDA(798.7,IEN_",",.01)="@"
. K RORFDA("DILIST")
. Q:$D(RORFDA)<10
. ;--- Delete the records
. D FILE^DIE(,"RORFDA","RORMSG")
. S RC=$$DBS^RORERR("RORMSG",-9,,,798.7)
Q $S(RC<0:RC,1:0)
;
;***** CHECK IF THE LOG IS REALLY REFERENCED
;
; LOGIEN IEN of the log
;
XREFCHK(LOGIEN) ;
N FIELD,FILE,IENS,NODE,RORMSG,TMP
S NODE=$NA(^RORDATA(798.7,"AREF",IEN))
S FILE=""
F S FILE=$O(@NODE@(FILE)) Q:FILE="" D
. S IENS=""
. F S IENS=$O(@NODE@(FILE,IENS)) Q:IENS="" D
. . S FIELD=""
. . F S FIELD=$O(@NODE@(FILE,IENS,FIELD)) Q:FIELD="" D
. . . S TMP=+$$GET1^DIQ(FILE,IENS,FIELD,"I",,"RORMSG")
. . . K:TMP'=LOGIEN @NODE@(FILE,IENS,FIELD)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORLOG01 3698 printed Oct 16, 2024@17:43:04 Page 2
RORLOG01 ;HCIOFO/SG - LOG FILE MANAGEMENT (UTILITIES) ; 1/17/06 10:09am
+1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
+2 ;
+3 QUIT
+4 ;
+5 ;***** PROCESSES AN ACCESS VIOLATION ALERT
ACLRTN ;
+1 NEW I,PARAMS,RORBUF
+2 ;--- Prepare the parameters
+3 SET (PARAMS("DUZ"),I)=+$PIECE(XQADATA,U)
+4 IF I>0
Begin DoDot:1
+5 SET PARAMS("USERNAME")=$$GET1^DIQ(200,I_",",.01,,,"RORBUF")
End DoDot:1
KILL RORBUF
+6 if $GET(PARAMS("USERNAME"))=""
SET PARAMS("USERNAME")="unknown user"
+7 SET PARAMS("DATETIME")=$$FMTE^XLFDT($PIECE(XQADATA,U,2))
+8 ;--- Generate the text of alert
+9 DO BLD^DIALOG(7980000.015,.PARAMS,,"RORBUF","S")
+10 ;--- Display the alert details
+11 SET I=0
WRITE !
+12 FOR
SET I=$ORDER(RORBUF(I))
if I'>0
QUIT
WRITE !,RORBUF(I)
+13 QUIT
+14 ;
+15 ;***** LOADS THE LOG SUBSYSTEM PARAMETERS
+16 ;
+17 ; .RORLST Reference to a local array containing names
+18 ; of the registries to process (as subscripts).
+19 ;
+20 ; Return Values:
+21 ; <0 Error code
+22 ; 0 Ok
+23 ;
PARAMS(RORLST) ;
+1 NEW ENABLE,IENS,IR,IRS,RC,RORBUF,RORMSG,RORSB,SCR,TYPE
+2 ;--- Load a list of parameters of active registries
+3 SET SCR="I '$P(^(0),U,7),$D(RORLST($P(^(0),U)))"
+4 DO LIST^DIC(798.1,,"@;8I","U","*",,,"B",SCR,,"RORBUF","RORMSG")
+5 SET RC=$$DBS^RORERR("RORMSG",-9)
if RC<0
QUIT RC
+6 IF '$GET(RORBUF("DILIST",0))
SET RORPARM("LOG")=1
QUIT 0
+7 ;--- Process the list of log parameters
+8 SET IR=""
SET RC=0
+9 FOR
SET IR=$ORDER(RORBUF("DILIST","ID",IR))
if IR=""
QUIT
Begin DoDot:1
+10 ;--- Check if the log is enabled
+11 if '$GET(RORBUF("DILIST","ID",IR,8))
QUIT
+12 SET ENABLE=1
+13 ;--- Load a list of event types to log
+14 SET IRS=","_RORBUF("DILIST",2,IR)_","
KILL RORSB
+15 DO LIST^DIC(798.11,IRS,"@;.01I","U","*",,,"B",,,"RORSB","RORMSG")
+16 SET RC=$$DBS^RORERR("RORMSG",-9)
if RC<0
QUIT
+17 ;--- If there are no event types, log all events
+18 IF '$GET(RORSB("DILIST",0))
Begin DoDot:2
+19 KILL RORPARM("LOG")
SET RC=1
End DoDot:2
QUIT
+20 ;--- Process the list of event types
+21 SET IRS=""
+22 FOR
SET IRS=$ORDER(RORSB("DILIST","ID",IRS))
if IRS=""
QUIT
Begin DoDot:2
+23 SET TYPE=+$GET(RORSB("DILIST","ID",IRS,.01))
+24 if TYPE
SET RORPARM("LOG",TYPE)=1
End DoDot:2
End DoDot:1
if RC
QUIT
+25 if $GET(ENABLE)
SET RORPARM("LOG")=1
+26 ;--- If not all types of errors are recorded,
+27 ; enable recording of the type "Error"
+28 if $DATA(RORPARM("LOG"))>1
SET RORPARM("LOG",6)=1
+29 QUIT $SELECT(RC<0:RC,1:0)
+30 ;
+31 ;***** PURGES THE OLD LOGS
+32 ;
+33 ; [DKEEP] Days to keep logs in the file (by default = 31)
+34 ;
+35 ; Return Values:
+36 ; <0 Error code
+37 ; 0 Ok
+38 ;
PURGE(DKEEP) ;
+1 NEW HDR,IEN,IR,RC,RORFDA,RORFROM,RORMSG
+2 SET RORFROM=$$FMADD^XLFDT($$DT^XLFDT,-$GET(DKEEP,31))+1
+3 SET RC=0
+4 FOR
Begin DoDot:1
+5 KILL RORFDA,RORMSG
+6 ;--- Get the next 10 records
+7 DO LIST^DIC(798.7,,"@","BU",10,.RORFROM,,"B",,,"RORFDA","RORMSG")
+8 SET RC=$$DBS^RORERR("RORMSG",-9)
if RC<0
QUIT
+9 ;--- Stop if no records left
+10 SET HDR=$GET(RORFDA("DILIST",0))
if 'HDR
QUIT
+11 ;--- Prepare the data
+12 SET IR=""
+13 FOR
SET IR=$ORDER(RORFDA("DILIST",2,IR),-1)
if IR=""
QUIT
Begin DoDot:2
+14 SET IEN=RORFDA("DILIST",2,IR)
+15 ;--- Check if the cross-reference entries are valid
+16 DO XREFCHK(IEN)
+17 ;--- Delete the log only if it is not referenced
+18 if '$DATA(^RORDATA(798.7,"AREF",IEN))
SET RORFDA(798.7,IEN_",",.01)="@"
End DoDot:2
+19 KILL RORFDA("DILIST")
+20 if $DATA(RORFDA)<10
QUIT
+21 ;--- Delete the records
+22 DO FILE^DIE(,"RORFDA","RORMSG")
+23 SET RC=$$DBS^RORERR("RORMSG",-9,,,798.7)
End DoDot:1
if '$PIECE($GET(HDR),U,3)!(RC<0)
QUIT
+24 QUIT $SELECT(RC<0:RC,1:0)
+25 ;
+26 ;***** CHECK IF THE LOG IS REALLY REFERENCED
+27 ;
+28 ; LOGIEN IEN of the log
+29 ;
XREFCHK(LOGIEN) ;
+1 NEW FIELD,FILE,IENS,NODE,RORMSG,TMP
+2 SET NODE=$NAME(^RORDATA(798.7,"AREF",IEN))
+3 SET FILE=""
+4 FOR
SET FILE=$ORDER(@NODE@(FILE))
if FILE=""
QUIT
Begin DoDot:1
+5 SET IENS=""
+6 FOR
SET IENS=$ORDER(@NODE@(FILE,IENS))
if IENS=""
QUIT
Begin DoDot:2
+7 SET FIELD=""
+8 FOR
SET FIELD=$ORDER(@NODE@(FILE,IENS,FIELD))
if FIELD=""
QUIT
Begin DoDot:3
+9 SET TMP=+$$GET1^DIQ(FILE,IENS,FIELD,"I",,"RORMSG")
+10 if TMP'=LOGIEN
KILL @NODE@(FILE,IENS,FIELD)
End DoDot:3
End DoDot:2
End DoDot:1
+11 QUIT
