RORLOG ;HCIOFO/SG - LOG FILE MANAGEMENT ; 1/17/06 10:10am
;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
;
; RORLOG -------------- CONSTANT & VARIABLES OF THE LOG SUSBSYSTEM
;
; RORLOG("IEN") IEN of the main record in the ROR LOG file
;
; This routine uses the following IAs:
;
; #10060 Read-only (DBS API) access to the NEW PERSON file
;
Q
;
;***** RECORDS THE ACCESS VIOLATION EVENT
;
; MSG Either a negative code of the message or a message
; text that will be recorded in the log.
;
; [REGISTRY] Either a registry name or a registry IEN
; (the log will be associated with this registry)
;
; [ARG2-ARG5] Optional parameters as for $$MSG^RORERR20
;
ACVIOLTN(MSG,REGISTRY,ARG2,ARG3,ARG4,ARG5) ;
N INFO,RORLOG,RORMSG,RORPARM
S REGISTRY=$G(REGISTRY)
;--- Make sure that event recording is enabled
S RORPARM("LOG")=1
;--- Get the registry name
I (+REGISTRY)=REGISTRY D:REGISTRY>0
. S REGISTRY=$P($G(^ROR(798.1,+REGISTRY,0)),U)
;--- Get the text of the message (if a code is provided)
S:(+MSG)=MSG MSG=$$MSG^RORERR20(+MSG,,,.ARG2,.ARG3,.ARG4,.ARG5)
;--- Send an alert to the registry coordinators
D:REGISTRY'=""
. S INFO=$G(DUZ)_U_$$NOW^XLFDT
. D ALERT^RORUTL01(REGISTRY,MSG,"ACLRTN^RORLOG01",INFO)
;--- Create a new log and record the message
I $$OPEN(REGISTRY,6)'<0 D D CLOSE()
. D:$G(DUZ)>0
. . S INFO="Violator: "_$$GET1^DIQ(200,DUZ_",",.01,,,"RORMSG")
. . S INFO=INFO_" (DUZ="_DUZ_")"
. D LOG(6,MSG,,.INFO)
Q
;
;***** CLOSES THE CURRENT LOG
;
; [MESSAGE] Text of the final message
; [COUNTERS] Statistic counters
; ^1: Total number of processed patients
; ^2: Number of patients processed with errors
;
CLOSE(MESSAGE,COUNTERS) ;
Q:$G(RORLOG("IEN"))'>0
N BDT,EDT,IENS,RATE,RORFDA,RORINFO,RORMSG,TMP
S EDT=$$NOW^XLFDT
S IENS=RORLOG("IEN")_","
;--- Prepare statistic data
D:$G(COUNTERS)>0
. S RORINFO(1)="Patients: "_+$P(COUNTERS,U)
. S RORINFO(2)="Errors: "_+$P(COUNTERS,U,2)
. S BDT=$$GET1^DIQ(798.7,IENS,.01,"I",,"RORMSG")
. Q:$G(BDT)'>0
. S TMP=$$FMDIFF^XLFDT(EDT,BDT,2)
. S RATE=$S(TMP>0:$J(COUNTERS/TMP,0,3),1:"")
. S RORINFO(3)="Time (sec): "_TMP
. S:RATE RORINFO(4)="Patients/sec: "_RATE
. ;--- Data for the log header
. S RORFDA(798.7,IENS,6.01)=$P(COUNTERS,U,1)
. S RORFDA(798.7,IENS,6.02)=$P(COUNTERS,U,2)
. S:RATE RORFDA(798.7,IENS,6.03)=RATE
;--- Store data in the header and log the final message
S RORFDA(798.7,IENS,5)=EDT
D FILE^DIE("K","RORFDA","RORMSG")
D:$G(MESSAGE)'="" LOG^RORLOG(,MESSAGE,,.RORINFO)
K RORLOG
Q
;
;***** PUTS MESSAGE IN THE LOG
;
; [TYPE] Type of the event:
; 1 Debug
; 2 Information
; 3 Data quality
; 4 Warning
; 5 Database error
; 6 Error
;
; If value of the parameter is omitted or equals 0, the message
; is logged as "information" (if log is enabled). This mode is
; intended for log headers and separators.
;
; MESSAGE Message text
; [PATIEN] Patient IEN
;
; [[.]RORINFO] Optional additional information (either a string or
; a reference to a local array that contains strings
; prepared for storing in a word processing field)
;
LOG(TYPE,MESSAGE,PATIEN,RORINFO) ;
;--- Do not do anything if log is disabled
Q:'$G(RORPARM("LOG"))
;--- Check if collection of this kind of event is enabled.
; Debug messages could be enabled only explicitly.
I '$G(TYPE) S TYPE=2
E I ($D(RORPARM("LOG"))>1)!(TYPE=1) Q:'$G(RORPARM("LOG",+TYPE))
;---
N CURRIO,DATETIME,I,IENS,RC,RORFDA,RORMSG,TMP
I $D(RORINFO)=1 S TMP=RORINFO K RORINFO S RORINFO(1)=TMP K TMP
S DATETIME=$$NOW^XLFDT
;--- Add a new record to the log (if it has been open)
D:$G(RORLOG("IEN"))>0
. S IENS="+1,"_RORLOG("IEN")_","
. S RORFDA(798.74,IENS,.01)=DATETIME
. S RORFDA(798.74,IENS,1)=+TYPE
. S RORFDA(798.74,IENS,2)=$E(MESSAGE,1,70)
. S:$G(PATIEN) RORFDA(798.74,IENS,3)=+PATIEN
. S:$D(RORINFO)>1 RORFDA(798.74,IENS,4)="RORINFO"
. D UPDATE^DIE(,"RORFDA",,"RORMSG")
;--- Display message (if debug mode 2 is enabled)
I $G(RORPARM("DEBUG"))>1 U $G(IO(0)) D U IO
. W !,$P($$FMTE^XLFDT(DATETIME,"2FS"),"@",2)_" "_$E(MESSAGE,1,70),!
. S I=""
. F S I=$O(RORINFO(I)) Q:I="" D W ?9,TMP,!
. . S TMP=$G(RORINFO(I)) S:TMP="" TMP=$G(RORINFO(I,0))
. W:$G(PATIEN) ?9,"Patient IEN: "_PATIEN,!
Q
;
;***** RETURNS AN IEN OF THE CURRENT LOG
LOGIEN() ;
Q +$G(RORLOG("IEN"))
;
;***** OPENS A NEW LOG
;
; [[.]REGLST] Either name of the registry or reference to a local
; array containing registry names as subscripts and
; optional registry IENs as values
;
; [ACTIVITY] Type of the activity:
; 0 Other (default)
; 1 Registry update
; 2 Data Extract
; 3 Acknowledgement
; 4 Hist. Extraction
; 5 Report
; 6 Access Violation
; 7 ROR TASK
; 8 Registry Setup
;
; [MESSAGE] Text of the first message
;
; [[.]ADDINFO] Optional additional information (either a string or
; a reference to a local array that contains strings
; prepared for storing in a word processing field).
; This text is appended after the list of registries
; associated with the log.
;
; Return Values:
; <0 Error code
; 0 Ok
;
OPEN(REGLST,ACTIVITY,MESSAGE,ADDINFO) ;
Q:'$G(RORPARM("LOG")) 0
N I,IENS,IPTR,RC,REGIEN,REGNAME,RORFDA,RORIEN,RORINFO,RORMSG,TMP
K RORLOG
;=== Prepare the list of registries
I $D(REGLST)=1 S:REGLST'="" REGLST(REGLST)=""
S REGNAME="",(IPTR,RC)=0
F S REGNAME=$O(REGLST(REGNAME)) Q:REGNAME="" D Q:RC<0
. S REGIEN=+$G(REGLST(REGNAME))
. I REGIEN'>0 D I REGIEN'>0 S RC=REGIEN Q
. . S REGIEN=$$REGIEN^RORUTL02(REGNAME)
. S IPTR=IPTR+1,RORINFO(IPTR)=REGNAME
. S RORFDA(798.73,"+"_(IPTR+10)_",+1,",.01)=REGIEN
. S RORIEN(IPTR+10)=REGIEN
Q:RC<0 RC
;=== Create a log header (main record) in the ROR LOG file
S IENS="+1,"
S RORFDA(798.7,IENS,.01)=$$NOW^XLFDT
S:$G(ACTIVITY)>0 RORFDA(798.7,IENS,1)=ACTIVITY
S RORFDA(798.7,IENS,2)=$J
S RORFDA(798.7,IENS,7)=$S($G(DUZ)>0:+DUZ,1:"")
S TMP=$S($D(ZTQUEUED):+$G(ZTSK),1:0)
S RORFDA(798.7,IENS,8)=$S(TMP>0:TMP,1:"")
D UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
S RC=$$DBS^RORERR("RORMSG",-9) Q:RC<0 RC
S RORLOG("IEN")=RORIEN(1)
;=== Add the header message (if any)
D:$G(MESSAGE)'=""
. ;--- Append the additional text to list of registries
. I $D(ADDINFO)=1 D
. . S IPTR=IPTR+1,RORINFO(IPTR)=ADDINFO
. E S I="" D
. . F S I=$O(ADDINFO(I)) Q:I="" D
. . . S TMP=$G(ADDINFO(I)),IPTR=IPTR+1
. . . S RORINFO(IPTR)=$S(TMP'="":TMP,1:$G(ADDINFO(I,0)))
. ;---
. D LOG(,MESSAGE,,.RORINFO)
;=== Success
Q 0
;
;***** REPLACES LIST OF REGISTRIES ASSOCIATED WITH THE CURRENT LOG
;
; [.]REGLST Either name of the registry or a reference to a local
; array containing registry names as subscripts and
; optional registry IENs as values.
;
; [NOLP] If this parameter is defined and non-zero, the log
; subsystem parameters will not be updated according
; to the new list of associated registries.
;
; Return Values:
; <0 Error code
; 0 Ok
;
SETRGLST(REGLST,NOLP) ;
N I,IENS,RC,REGIEN,RILST,RORBUF,RORFDA,RORIEN,RORMSG
S IENS=$$LOGIEN()_","
Q:'$G(RORPARM("LOG"))!(IENS'>0) 0
;--- Compile a list of registry IENs (as subscripts)
S:$D(REGLST)=1 REGLST(REGLST)=""
S I="",RC=0
F S I=$O(REGLST(I)) Q:I="" D Q:RC<0
. S REGIEN=+$G(REGLST(I))
. I REGIEN'>0 D I REGIEN'>0 S RC=REGIEN Q
. . S REGIEN=$$REGIEN^RORUTL02(I)
. S RILST(REGIEN)=""
Q:RC<0 RC
;--- Delete old registries from the multiple of the log record
D LIST^DIC(798.73,","_IENS,"@;.01I","U",,,,"B",,,"RORBUF","RORMSG")
S RC=$$DBS^RORERR("RORMSG",-9) Q:RC<0 RC
S I=""
F S I=$O(RORBUF("DILIST",2,I)) Q:I="" D
. S REGIEN=RORBUF("DILIST","ID",I,.01)
. I $D(RILST(REGIEN)) K RILST(REGIEN) Q
. S RORFDA(798.73,RORBUF("DILIST",2,I)_","_IENS,.01)="@"
I $D(RORFDA)>1 D Q:RC<0 RC
. D FILE^DIE("K","RORFDA","RORMSG")
. S RC=$$DBS^RORERR("RORMSG",-9)
;--- Add new registries to the multiple
S REGIEN=""
F I=1:1 S REGIEN=$O(RILST(REGIEN)) Q:REGIEN="" D
. S RORFDA(798.73,"+"_I_","_IENS,.01)=REGIEN
. S RORIEN(I)=REGIEN
I $D(RORFDA)>1 D Q:RC<0 RC
. D UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
. S RC=$$DBS^RORERR("RORMSG",-9)
;--- Reload parameters (if necessary)
I '$G(NOLP) D Q:RC<0 RC
. K RORPARM("LOG") S RC=$$PARAMS^RORLOG01(.REGLST)
Q 0
;
;***** INITIALIZES THE LOG SUBSYSTEM
;
; [[.]REGLST] Either a reference to a local array containing names
; of the registries to process (as subscripts) or a
; string that contains a name of the single registry.
;
; Return Values:
; <0 Error code
; 0 Ok
;
SETUP(REGLST) ;
K RORPARM("LOG"),RORLOG
S:$D(REGLST)=1 REGLST(REGLST)=""
Q $$PARAMS^RORLOG01(.REGLST)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRORLOG 9461 printed Oct 16, 2024@17:43:03 Page 2
RORLOG ;HCIOFO/SG - LOG FILE MANAGEMENT ; 1/17/06 10:10am
+1 ;;1.5;CLINICAL CASE REGISTRIES;;Feb 17, 2006
+2 ;
+3 ; RORLOG -------------- CONSTANT & VARIABLES OF THE LOG SUSBSYSTEM
+4 ;
+5 ; RORLOG("IEN") IEN of the main record in the ROR LOG file
+6 ;
+7 ; This routine uses the following IAs:
+8 ;
+9 ; #10060 Read-only (DBS API) access to the NEW PERSON file
+10 ;
+11 QUIT
+12 ;
+13 ;***** RECORDS THE ACCESS VIOLATION EVENT
+14 ;
+15 ; MSG Either a negative code of the message or a message
+16 ; text that will be recorded in the log.
+17 ;
+18 ; [REGISTRY] Either a registry name or a registry IEN
+19 ; (the log will be associated with this registry)
+20 ;
+21 ; [ARG2-ARG5] Optional parameters as for $$MSG^RORERR20
+22 ;
ACVIOLTN(MSG,REGISTRY,ARG2,ARG3,ARG4,ARG5) ;
+1 NEW INFO,RORLOG,RORMSG,RORPARM
+2 SET REGISTRY=$GET(REGISTRY)
+3 ;--- Make sure that event recording is enabled
+4 SET RORPARM("LOG")=1
+5 ;--- Get the registry name
+6 IF (+REGISTRY)=REGISTRY
if REGISTRY>0
Begin DoDot:1
+7 SET REGISTRY=$PIECE($GET(^ROR(798.1,+REGISTRY,0)),U)
End DoDot:1
+8 ;--- Get the text of the message (if a code is provided)
+9 if (+MSG)=MSG
SET MSG=$$MSG^RORERR20(+MSG,,,.ARG2,.ARG3,.ARG4,.ARG5)
+10 ;--- Send an alert to the registry coordinators
+11 if REGISTRY'=""
Begin DoDot:1
+12 SET INFO=$GET(DUZ)_U_$$NOW^XLFDT
+13 DO ALERT^RORUTL01(REGISTRY,MSG,"ACLRTN^RORLOG01",INFO)
End DoDot:1
+14 ;--- Create a new log and record the message
+15 IF $$OPEN(REGISTRY,6)'<0
Begin DoDot:1
+16 if $GET(DUZ)>0
Begin DoDot:2
+17 SET INFO="Violator: "_$$GET1^DIQ(200,DUZ_",",.01,,,"RORMSG")
+18 SET INFO=INFO_" (DUZ="_DUZ_")"
End DoDot:2
+19 DO LOG(6,MSG,,.INFO)
End DoDot:1
DO CLOSE()
+20 QUIT
+21 ;
+22 ;***** CLOSES THE CURRENT LOG
+23 ;
+24 ; [MESSAGE] Text of the final message
+25 ; [COUNTERS] Statistic counters
+26 ; ^1: Total number of processed patients
+27 ; ^2: Number of patients processed with errors
+28 ;
CLOSE(MESSAGE,COUNTERS) ;
+1 if $GET(RORLOG("IEN"))'>0
QUIT
+2 NEW BDT,EDT,IENS,RATE,RORFDA,RORINFO,RORMSG,TMP
+3 SET EDT=$$NOW^XLFDT
+4 SET IENS=RORLOG("IEN")_","
+5 ;--- Prepare statistic data
+6 if $GET(COUNTERS)>0
Begin DoDot:1
+7 SET RORINFO(1)="Patients: "_+$PIECE(COUNTERS,U)
+8 SET RORINFO(2)="Errors: "_+$PIECE(COUNTERS,U,2)
+9 SET BDT=$$GET1^DIQ(798.7,IENS,.01,"I",,"RORMSG")
+10 if $GET(BDT)'>0
QUIT
+11 SET TMP=$$FMDIFF^XLFDT(EDT,BDT,2)
+12 SET RATE=$SELECT(TMP>0:$JUSTIFY(COUNTERS/TMP,0,3),1:"")
+13 SET RORINFO(3)="Time (sec): "_TMP
+14 if RATE
SET RORINFO(4)="Patients/sec: "_RATE
+15 ;--- Data for the log header
+16 SET RORFDA(798.7,IENS,6.01)=$PIECE(COUNTERS,U,1)
+17 SET RORFDA(798.7,IENS,6.02)=$PIECE(COUNTERS,U,2)
+18 if RATE
SET RORFDA(798.7,IENS,6.03)=RATE
End DoDot:1
+19 ;--- Store data in the header and log the final message
+20 SET RORFDA(798.7,IENS,5)=EDT
+21 DO FILE^DIE("K","RORFDA","RORMSG")
+22 if $GET(MESSAGE)'=""
DO LOG^RORLOG(,MESSAGE,,.RORINFO)
+23 KILL RORLOG
+24 QUIT
+25 ;
+26 ;***** PUTS MESSAGE IN THE LOG
+27 ;
+28 ; [TYPE] Type of the event:
+29 ; 1 Debug
+30 ; 2 Information
+31 ; 3 Data quality
+32 ; 4 Warning
+33 ; 5 Database error
+34 ; 6 Error
+35 ;
+36 ; If value of the parameter is omitted or equals 0, the message
+37 ; is logged as "information" (if log is enabled). This mode is
+38 ; intended for log headers and separators.
+39 ;
+40 ; MESSAGE Message text
+41 ; [PATIEN] Patient IEN
+42 ;
+43 ; [[.]RORINFO] Optional additional information (either a string or
+44 ; a reference to a local array that contains strings
+45 ; prepared for storing in a word processing field)
+46 ;
LOG(TYPE,MESSAGE,PATIEN,RORINFO) ;
+1 ;--- Do not do anything if log is disabled
+2 if '$GET(RORPARM("LOG"))
QUIT
+3 ;--- Check if collection of this kind of event is enabled.
+4 ; Debug messages could be enabled only explicitly.
+5 IF '$GET(TYPE)
SET TYPE=2
+6 IF '$TEST
IF ($DATA(RORPARM("LOG"))>1)!(TYPE=1)
if '$GET(RORPARM("LOG",+TYPE))
QUIT
+7 ;---
+8 NEW CURRIO,DATETIME,I,IENS,RC,RORFDA,RORMSG,TMP
+9 IF $DATA(RORINFO)=1
SET TMP=RORINFO
KILL RORINFO
SET RORINFO(1)=TMP
KILL TMP
+10 SET DATETIME=$$NOW^XLFDT
+11 ;--- Add a new record to the log (if it has been open)
+12 if $GET(RORLOG("IEN"))>0
Begin DoDot:1
+13 SET IENS="+1,"_RORLOG("IEN")_","
+14 SET RORFDA(798.74,IENS,.01)=DATETIME
+15 SET RORFDA(798.74,IENS,1)=+TYPE
+16 SET RORFDA(798.74,IENS,2)=$EXTRACT(MESSAGE,1,70)
+17 if $GET(PATIEN)
SET RORFDA(798.74,IENS,3)=+PATIEN
+18 if $DATA(RORINFO)>1
SET RORFDA(798.74,IENS,4)="RORINFO"
+19 DO UPDATE^DIE(,"RORFDA",,"RORMSG")
End DoDot:1
+20 ;--- Display message (if debug mode 2 is enabled)
+21 IF $GET(RORPARM("DEBUG"))>1
USE $GET(IO(0))
Begin DoDot:1
+22 WRITE !,$PIECE($$FMTE^XLFDT(DATETIME,"2FS"),"@",2)_" "_$EXTRACT(MESSAGE,1,70),!
+23 SET I=""
+24 FOR
SET I=$ORDER(RORINFO(I))
if I=""
QUIT
Begin DoDot:2
+25 SET TMP=$GET(RORINFO(I))
if TMP=""
SET TMP=$GET(RORINFO(I,0))
End DoDot:2
WRITE ?9,TMP,!
+26 if $GET(PATIEN)
WRITE ?9,"Patient IEN: "_PATIEN,!
End DoDot:1
USE IO
+27 QUIT
+28 ;
+29 ;***** RETURNS AN IEN OF THE CURRENT LOG
LOGIEN() ;
+1 QUIT +$GET(RORLOG("IEN"))
+2 ;
+3 ;***** OPENS A NEW LOG
+4 ;
+5 ; [[.]REGLST] Either name of the registry or reference to a local
+6 ; array containing registry names as subscripts and
+7 ; optional registry IENs as values
+8 ;
+9 ; [ACTIVITY] Type of the activity:
+10 ; 0 Other (default)
+11 ; 1 Registry update
+12 ; 2 Data Extract
+13 ; 3 Acknowledgement
+14 ; 4 Hist. Extraction
+15 ; 5 Report
+16 ; 6 Access Violation
+17 ; 7 ROR TASK
+18 ; 8 Registry Setup
+19 ;
+20 ; [MESSAGE] Text of the first message
+21 ;
+22 ; [[.]ADDINFO] Optional additional information (either a string or
+23 ; a reference to a local array that contains strings
+24 ; prepared for storing in a word processing field).
+25 ; This text is appended after the list of registries
+26 ; associated with the log.
+27 ;
+28 ; Return Values:
+29 ; <0 Error code
+30 ; 0 Ok
+31 ;
OPEN(REGLST,ACTIVITY,MESSAGE,ADDINFO) ;
+1 if '$GET(RORPARM("LOG"))
QUIT 0
+2 NEW I,IENS,IPTR,RC,REGIEN,REGNAME,RORFDA,RORIEN,RORINFO,RORMSG,TMP
+3 KILL RORLOG
+4 ;=== Prepare the list of registries
+5 IF $DATA(REGLST)=1
if REGLST'=""
SET REGLST(REGLST)=""
+6 SET REGNAME=""
SET (IPTR,RC)=0
+7 FOR
SET REGNAME=$ORDER(REGLST(REGNAME))
if REGNAME=""
QUIT
Begin DoDot:1
+8 SET REGIEN=+$GET(REGLST(REGNAME))
+9 IF REGIEN'>0
Begin DoDot:2
+10 SET REGIEN=$$REGIEN^RORUTL02(REGNAME)
End DoDot:2
IF REGIEN'>0
SET RC=REGIEN
QUIT
+11 SET IPTR=IPTR+1
SET RORINFO(IPTR)=REGNAME
+12 SET RORFDA(798.73,"+"_(IPTR+10)_",+1,",.01)=REGIEN
+13 SET RORIEN(IPTR+10)=REGIEN
End DoDot:1
if RC<0
QUIT
+14 if RC<0
QUIT RC
+15 ;=== Create a log header (main record) in the ROR LOG file
+16 SET IENS="+1,"
+17 SET RORFDA(798.7,IENS,.01)=$$NOW^XLFDT
+18 if $GET(ACTIVITY)>0
SET RORFDA(798.7,IENS,1)=ACTIVITY
+19 SET RORFDA(798.7,IENS,2)=$JOB
+20 SET RORFDA(798.7,IENS,7)=$SELECT($GET(DUZ)>0:+DUZ,1:"")
+21 SET TMP=$SELECT($DATA(ZTQUEUED):+$GET(ZTSK),1:0)
+22 SET RORFDA(798.7,IENS,8)=$SELECT(TMP>0:TMP,1:"")
+23 DO UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
+24 SET RC=$$DBS^RORERR("RORMSG",-9)
if RC<0
QUIT RC
+25 SET RORLOG("IEN")=RORIEN(1)
+26 ;=== Add the header message (if any)
+27 if $GET(MESSAGE)'=""
Begin DoDot:1
+28 ;--- Append the additional text to list of registries
+29 IF $DATA(ADDINFO)=1
Begin DoDot:2
+30 SET IPTR=IPTR+1
SET RORINFO(IPTR)=ADDINFO
End DoDot:2
+31 IF '$TEST
SET I=""
Begin DoDot:2
+32 FOR
SET I=$ORDER(ADDINFO(I))
if I=""
QUIT
Begin DoDot:3
+33 SET TMP=$GET(ADDINFO(I))
SET IPTR=IPTR+1
+34 SET RORINFO(IPTR)=$SELECT(TMP'="":TMP,1:$GET(ADDINFO(I,0)))
End DoDot:3
End DoDot:2
+35 ;---
+36 DO LOG(,MESSAGE,,.RORINFO)
End DoDot:1
+37 ;=== Success
+38 QUIT 0
+39 ;
+40 ;***** REPLACES LIST OF REGISTRIES ASSOCIATED WITH THE CURRENT LOG
+41 ;
+42 ; [.]REGLST Either name of the registry or a reference to a local
+43 ; array containing registry names as subscripts and
+44 ; optional registry IENs as values.
+45 ;
+46 ; [NOLP] If this parameter is defined and non-zero, the log
+47 ; subsystem parameters will not be updated according
+48 ; to the new list of associated registries.
+49 ;
+50 ; Return Values:
+51 ; <0 Error code
+52 ; 0 Ok
+53 ;
SETRGLST(REGLST,NOLP) ;
+1 NEW I,IENS,RC,REGIEN,RILST,RORBUF,RORFDA,RORIEN,RORMSG
+2 SET IENS=$$LOGIEN()_","
+3 if '$GET(RORPARM("LOG"))!(IENS'>0)
QUIT 0
+4 ;--- Compile a list of registry IENs (as subscripts)
+5 if $DATA(REGLST)=1
SET REGLST(REGLST)=""
+6 SET I=""
SET RC=0
+7 FOR
SET I=$ORDER(REGLST(I))
if I=""
QUIT
Begin DoDot:1
+8 SET REGIEN=+$GET(REGLST(I))
+9 IF REGIEN'>0
Begin DoDot:2
+10 SET REGIEN=$$REGIEN^RORUTL02(I)
End DoDot:2
IF REGIEN'>0
SET RC=REGIEN
QUIT
+11 SET RILST(REGIEN)=""
End DoDot:1
if RC<0
QUIT
+12 if RC<0
QUIT RC
+13 ;--- Delete old registries from the multiple of the log record
+14 DO LIST^DIC(798.73,","_IENS,"@;.01I","U",,,,"B",,,"RORBUF","RORMSG")
+15 SET RC=$$DBS^RORERR("RORMSG",-9)
if RC<0
QUIT RC
+16 SET I=""
+17 FOR
SET I=$ORDER(RORBUF("DILIST",2,I))
if I=""
QUIT
Begin DoDot:1
+18 SET REGIEN=RORBUF("DILIST","ID",I,.01)
+19 IF $DATA(RILST(REGIEN))
KILL RILST(REGIEN)
QUIT
+20 SET RORFDA(798.73,RORBUF("DILIST",2,I)_","_IENS,.01)="@"
End DoDot:1
+21 IF $DATA(RORFDA)>1
Begin DoDot:1
+22 DO FILE^DIE("K","RORFDA","RORMSG")
+23 SET RC=$$DBS^RORERR("RORMSG",-9)
End DoDot:1
if RC<0
QUIT RC
+24 ;--- Add new registries to the multiple
+25 SET REGIEN=""
+26 FOR I=1:1
SET REGIEN=$ORDER(RILST(REGIEN))
if REGIEN=""
QUIT
Begin DoDot:1
+27 SET RORFDA(798.73,"+"_I_","_IENS,.01)=REGIEN
+28 SET RORIEN(I)=REGIEN
End DoDot:1
+29 IF $DATA(RORFDA)>1
Begin DoDot:1
+30 DO UPDATE^DIE(,"RORFDA","RORIEN","RORMSG")
+31 SET RC=$$DBS^RORERR("RORMSG",-9)
End DoDot:1
if RC<0
QUIT RC
+32 ;--- Reload parameters (if necessary)
+33 IF '$GET(NOLP)
Begin DoDot:1
+34 KILL RORPARM("LOG")
SET RC=$$PARAMS^RORLOG01(.REGLST)
End DoDot:1
if RC<0
QUIT RC
+35 QUIT 0
+36 ;
+37 ;***** INITIALIZES THE LOG SUBSYSTEM
+38 ;
+39 ; [[.]REGLST] Either a reference to a local array containing names
+40 ; of the registries to process (as subscripts) or a
+41 ; string that contains a name of the single registry.
+42 ;
+43 ; Return Values:
+44 ; <0 Error code
+45 ; 0 Ok
+46 ;
SETUP(REGLST) ;
+1 KILL RORPARM("LOG"),RORLOG
+2 if $DATA(REGLST)=1
SET REGLST(REGLST)=""
+3 QUIT $$PARAMS^RORLOG01(.REGLST)
