- 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 Feb 18, 2025@23:08:35 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)