JRNUTIL	; Extrinsic functs to manipulate journal file records ; STC200 02/23/99  ; Compiled March 6, 2000 19:36:09
	; +--------------------------------------------------------+
	; | Copyright 1986-2000 by InterSystems Corporation,       |
	; | Cambridge, Massachusetts, U.S.A.                       |
	; | All rights reserved.                                   |
	; |                                                        |
	; | Confidential, unpublished property of InterSystems.    |
	; |                                                        |
	; | This media contains an authorized copy or copies       |
	; | of material copyrighted by InterSystems and is the     |
	; | confidential, unpublished property of InterSystems.    |
	; | This copyright notice and any other copyright notices  |
	; | included in machine readable copies must be reproduced |
	; | on all authorized copies.                              |
	; +--------------------------------------------------------+
	;%system.INC ; DAS280 06/29/99 
	;%ST.INC DAS309 11/08/99 
	; %system.inc: compiled for NETWIDENAMESPACE
	; %system.inc: compiled for DDPGROUPS
	; %system.inc: compiled for NETMOREDCPDMN
	; %system.inc: compiled for USECLUSTER
	; %system.inc: compiled for RTNINGBL
	; %system.inc: compiled for DBMSNSP
	;  Return values:
	;
	; Provides extrinsic functions to manipulate journal file records
	; in a non-interactive fashion. One can open/use/close a journal 
	; file, delete a journal file, switch journalling to another file
	; as well as read /delete a record from an open journal file. 
	;
	;
	;*******************************************************************
	; $$GETREC(ADDR,.JRNODE)  : read a record 
	;
	;   Input: -  ADDR, address of the record to be read.
	;          -  JRNODE, a local variable which should be passed by 
	;             reference, so that it returns the information about the
	;             record.
	;   Output:   -13   ( cluster record, not supported )
	;             -11   ( journal file empty )
	;             -12   ( invalid address )
	;             -9    ( journal file not open )
	;              1    ( success )  which in this case:
	;              JRNODE array: 
	;              JRNODE(1,1)= pid/prev/next:type:collation:glo  ;LFT379 added collation
	;                 pid  is the process id.
	;                 prev/next are previous/next adjacent record addrs 
	;                 type is "S", "K", "k", "ZK", "B", "C", "NS, "NK"
	;                      or "ZNK" designating the type of the record.
	;                 glo is the complete global reference name.
	;                              -or- (see note below)
	;              JRNODE(1,1)= pid,remsysid/prev/next:type:collation:glo ;LFT379 added collation
	;                 pid  is the process id on the remote system
	;                 remsysid is the internal unique id of the remote
	;                      system
	;                 prev/next are previous/next adjacent record addrs 
	;                 type is "S", "K", "k", "ZK", "B", "C", "NS, "NK"
	;                      or "ZNK" designating the type of the record.
	;                 glo is the complete global reference name.
	;                         
	;              JRNODE(1,1,1) contains the old value if the global had
	;              a previous value and this record is for a SET or KILL.
	; 
	;              JRNODE(1,1,2) contains the new value if type is "S".
	;
	;              JRNODE(1,1,3) contains the timestamp in $H format
	;
	;              Note re two forms of JRNNODE(1,1):
	;                  journal records are added to the local journal both
	;                  by local processes and by server deamons on behalf
	;                  of remote processes. When a record is generated by
	;                  a local process the remote system id is zero and
	;                  the 1st field of JRNNODE(1,1) is simply the local
	;                  process' pid. When a record is added on behalf of
	;                  a remote job the pid is the pid of the job on the
	;                  remote machine and the remote system id is
	;                  non-zero. To avoid confusion since the pid on the
	;                  remote machine could match a local pid, the remote
	;                  system id is returned in the pid field seperated 
	;                  from the pid with a comma.
	;*******************************************************************
GETREC(ADDR,JRNODE)	;read a record from a journal file, and put info. in JRNODE
	S $ZT="ERR^"_$ZN
	N TYPE,TRANS,PID,GLO,PREV,NEXT
	N REMSYSID
	;
	I $G(%JFILE)="" Q "-9,Journal file has not been opened"  
	I ADDR=0 S ADDR=$zu(78,17,ADDR) I ADDR<1 Q "-11,Journal file is empty"
	;
	S TYPE=$$GETYPE(ADDR)
	I TYPE="" Q "-12,Record address is not valid"
	I TYPE["N" Q "-13,Record is a cluster record"
	;
	S TRANS=$zu(78,9,ADDR)  ; was it in a transaction
	S PID=$zu(78,10,ADDR)
	S REMSYSID=+$ZU(78,25,ADDR)
	i REMSYSID S PID=PID_","_REMSYSID
	S GLO=$zu(78,13,ADDR)
	S PREV=$zu(78,18,ADDR)
	S NEXT=$zu(78,17,ADDR)
	S COLLATE=$ZU(78,27,ADDR)
	;
	I TYPE="S" S JRNODE(1,1,2)=$zu(78,15,ADDR) ;Get new value
	I TRANS=1,"Kk"[TYPE,$zu(78,14,ADDR)>0 S JRNODE(1,1,1)=$zu(78,16,ADDR)
	I TRANS=1,TYPE="S",$zu(78,14,ADDR)>1 S JRNODE(1,1,1)=$zu(78,16,ADDR)
	S JRNODE(1,1)=PID_"/"_PREV_"/"_NEXT_":"_TYPE_":"_COLLATE_":"_GLO
	S JRNODE(1,1,3)=$zu(78,24,ADDR)
	Q 1
	;********************************************************************
	; $$DELREC(ADDR):  Delete a record from the currently being used file
	;
	;   Input:  - ADDR, is the address of the record to be deleted
	;
	;   Output:   -13  ( cluster record )
	;             -12  ( invalid address )
	;             -11  ( FILE IS EMPTY )
	;             -9   ( file not open / used )
	;              1   ( success )
	;********************************************************************
DELREC(ADDR)	  ; delete a record from a journal file
	S $ZT="ERR^"_$ZN
	N X,TYPE
	;
	I $G(%JFILE)="" Q "-9,Journal file has not been opened"
	I 'ADDR S ADDR=$zu(78,17,ADDR) I ADDR<1 Q "-11,Journal file is empty"
	;
	S TYPE=$$GETYPE(ADDR)
	I TYPE="" Q "-12,Record address is not valid"
	I TYPE["N" Q "-13,Record is a cluster record"  ; Cluster type
	;
	S X=$zu(78,19,ADDR) ;Remove the record
	I X<0 Q "-15,Unsuccessful operation"
	;
	Q 1
	;*********************************************************************
GETYPE(ADDR)	; return record type, string format
	S $ZT="GetErr^"_$ZN
	N TYPE,TYPECODE
	S TYPE=$zu(78,8,ADDR)
	;
	I TYPE=4 Q "B"   ; begin transaction
	I TYPE=5 Q "C"     ; commit transaction
	I TYPE=6 Q "S"       ; set a node
	I TYPE=7 Q "K"       ; kill a node
	I TYPE=8 Q "k"    ; kill of a decendent node
	I TYPE=9 Q "ZK"     ; zkill (kill only this node)
	I TYPE=10 Q "NS"      ; network set
	I TYPE=11 Q "NK"     ; network kill
	I TYPE=12 q "NZK"  ; network zkill
	;
GetErr	Q ""  ; in case of error
	;*********************************************************************
	; $$DELFILE^JRNUTIL(JRNFILE) :  Delete a journal file
	;   
	;   Input:  - name of the journal file to be deleted
	;             if the file is open, it won't be deleted
	;      
	;   Output:    -15  ( unknown error )
	;              -10  ( not a journal file )
	;              -6   ( file locked by another user )
	;               1   ( success )
	;*********************************************************************
DELFILE(JRNFILE)	 ; delete a journal file
	S $ZT="ERR^"_$ZN
	N X,FILE,Y
	i ($zv["VMS") S FILE=$ZU(12,JRNFILE)
	i '($zv["VMS") S FILE=JRNFILE
	;
	S Y=$ZU(78,22,FILE) ;Make sure it's a journal file 
	I Y<1 Q "-10,File is not a journal file"
	;
	S X=$ZU(78,23,FILE) ;Delete the file
	; keep record of DELETE operation in ^SYS("JOURNAL","HISTORY")
	I X=1 D History("DELETE",FILE) Q 1
	;
	I X=-1 Q "-16,File not found or open by another user"  ;File not found or locked by another user
	;
	Q "-15,Unsuccessful operation"
	;**************************************************************
	; Keep record of journal file DELETE, journal SWITCH, journal START,
	; and journal STOP operations in ^SYS("JOURNAL","HISTORY")
	; The constant LifeSpan is set to 30, so that entries older than 30
	; days would get deleted. 
	; TYPE is "START" for journal start, "STOP" for journal stop, 
	; "SWITCH" for journal switch, and "DElETE" for a file delete.
	;
	; delete entries older than 30 days in journal history
History(TYPE,FILE1,FILE2)	; keep record of delete/switch/stop/start journal
	N DATE,DATE1,I,TIME,INTERVAL,INDEX,LASTDATE,LIMIT
	; when we no longer support History, move the code to HISTORY
	d:TYPE="DELETE" MSG^%UTIL(TYPE_": "_FILE1,1,0)
	i ($zv["VMS") d
	. S FILE1=$ZU(12,FILE1)
	. I '$D(FILE2) S FILE2=""
	. E  S FILE2="^"_$ZU(12,FILE2)
	i '($zv["VMS") d
	. I '$D(FILE2) S FILE2=""
	. E  S FILE2="^"_FILE2
	;
	L +^SYS("JOURNAL","HISTORY") ; updates just by one process at a time
	S TIME=$H,DATE=$P(TIME,",",1)
	;
	S LASTDATE=$O(^SYS("JOURNAL","HISTORY"," "),-1)
	I LASTDATE="" S INDEX=1 G STEP2
	S INDEX=$O(^SYS("JOURNAL","HISTORY",LASTDATE," "),-1)+1
STEP2	S ^SYS("JOURNAL","HISTORY",DATE,INDEX)=TIME_"^"_TYPE_"^"_FILE1_FILE2
	L -^SYS("JOURNAL","HISTORY")
	;
	; clean up journal history, remove entries older than 30 days:
	;
	S DATE1=""
	S DATE1=$O(^SYS("JOURNAL","HISTORY",DATE1))
	S LIMIT=DATE-30
	F I=DATE1:1:LIMIT K ^SYS("JOURNAL","HISTORY",I)
	Q
	; update %SYS("JOURNAL","HISTORY")
	; type: "START"/"SWITCH"/"STOP"
	; file: full path of the journal file name
	; curdir/altdir/prefix: (optional) see JRNSTART
	; short: (optional) in the form of yyyymmdd.nnn
	; jrnhist: (optional) update @jrnhist instead of %SYS("JOURNAL","HISTORY")
HISTORY(type,file,curdir,altdir,prefix,short,jrnhist)	
	n date,jrnstat
	d MSG^%UTIL(type_": "_file,1,0)
	s:'$d(short) short=$S($F(file,";"):$E(file,$F(file,";")-12-1,$f(file,";")-2),1:$E(file,$L(file)-11,$L(file)))
	s date=$h
	; journal the update
	s jrnstat=$$CURRENT^%NOJRN()
	i 'jrnstat d ENABLE^%NOJRN 
	i '$$CURRENT^%NOJRN(),$zu(9,"","fail to journal journal history updates")
	s short=short_"J" ;name used in the global
	ts
	s jrnhist=$g(jrnhist,$name(^%SYS("JOURNAL","HISTORY")))
	L +@jrnhist
	s @jrnhist@(short)=date
	i '$d(@jrnhist@(short,"FULLNAME")) d
	. s ^("FULLNAME")=file
	i (type="START")!(type="SWITCH") d  i 1
	. s ^("CURDIR")=curdir
	. s ^("ALTDIR")=altdir
	. i type="START" d
	. . s ^("DATE")=date ;session begin date
	. . s ^("PREFIX")=prefix        
	e  d  ; type="STOP"
	. s $p(^("DATE"),"^",2)=date ;session end date
	L -@jrnhist
	tc
	i 'jrnstat d DISABLE^%NOJRN
	q                                                               ;KLMxxx
	; 
	; clean up old journal history entries (can be run as stand-alone)
	; LIFESPAN = 0: automatic purge is disabled
	; purge entries down to the last STOP'ed journal whose "DATE" subentry
	;   has 2nd field (session end date) beyond LIFESPAN (=30 days), OR 
	;   prior to the last START'ed entry whose "DATE" subentry has 1st field 
	;   (session begin date) beyond LIFESPAN.
PURGE	; purge journal files and history
	n flifespan,hlifespan,f,date
	i '$$okpurge(.flifespan,.hlifespan) q  ;adjust hlifespan if necessary
	s date=$p($h,",")
	; purge journal files first
	i flifespan s f=$$getpurge(date-flifespan+1) d:f'="" FPURGE(f)
	; then purge journal history records, if authorized, using the same date
	; NB: getpurge may return differnt values for file and history even if with same input
	i hlifespan  s f=$$getpurge(date-hlifespan+1,"H") d:f'="" hpurge(f)
	q
okpurge(flifespan,hlifespan)	;flifespan/hlifespan: lifespan of journal file/history
	s flifespan=+$g(^%SYS("JOURNAL","LIFESPAN","FILE"))
	s hlifespan=$s(flifespan>30:flifespan,1:30)
	s ^%SYS("JOURNAL","LIFESPAN")=hlifespan
	q 1
	; input: full name of the a journal file (because we need to call PREVJRN)
FPURGE(f)	;purge the journal files no newer than f
	n purge,ret,pf,i
	s $zt="etFPURGE"
	; First we build a list of files to purge so that we can purge the oldest one first.
	; This is better than purging the latest one first in case we are interrupted.
	s purge=$name(^mtemp($$%msub()))
	f i=1:1 s ret=$$PREVJRN^JRNUTIL2(f,.pf) q:ret'>0  q:pf=""  d
	. s @purge@(i)=f  ;f is guaranteed to be a journal file
	. s f=pf
	; Log possible errors and proceed to delete whatever we deem proper
	n errhead s errhead="Error in purging journal files: "
	i ret>0!(ret=-1) s @purge@(i)=f  ;pf="" or no previous file
	e  d msglog(errhead_$$ERNXPVJRN^JRNUTIL2(ret,f))  
	s i="",ret=1 f  s i=$o(@purge@(i),-1) q:i=""  s ret=$$DELFILE(@purge@(i)) q:ret'>0
	i ret'>0 d msglog("fpurge: DELFILE "_ret_" on "_@purge@(i))
	k @purge
	q
etFPURGE	
	s $zt=""
	i $d(purge) k @purge
	d msglog("fpurge: "_$ze_"; purging may have been stopped prematurely")
	q
	; input: journal file name (long or short)
hpurge(f)	 ;purge journal history records no newer than f
	n jrnstat,x
	s $zt="ethpurge",f=$S($F(f,";"):$E(f,$F(f,";")-12-1,$f(f,";")-2),1:$E(f,$L(f)-11,$L(f)))_"J"  ;append "J" for use in history node
	s jrnstat=$$CURRENT^%NOJRN()
	i 'jrnstat d ENABLE^%NOJRN 
	i '$$CURRENT^%NOJRN() d msglog("hpurge: fail to journal")
	s $zt="ethpurge1"
	L +^%SYS("JOURNAL","HISTORY")
	ts
	s x="" f  s x=$o(^%SYS("JOURNAL","HISTORY",x)) q:x=""  d  q:f']x  
	. k ^%SYS("JOURNAL","HISTORY",x)  
	tc
	L -^%SYS("JOURNAL","HISTORY")
	s $zt="ethpurge1"
	i 'jrnstat d DISABLE^%NOJRN
	q
ethpurge1	
	s $zt=""
	L -^%SYS("JOURNAL","HISTORY")
ethpurge	
	s $zt=""
	d msglog("hpurge: "_$ze)
	i '$g(jrnstat) d DISABLE^%NOJRN
	q
	; input:
	;   limit - a date in $H format
	;   type - for file purge ("F") or history purge ("H")
	; output: full name of a journal file or "" (none to purge)
	;   the journal file is either a JRNSTOP or the one right before a JRNSTART
getpurge(limit,type)	;find the latest journal file older than the limit and a JRNSTART
	n kill,f,d,d1,d2
	n errhead s errhead="Error in getting files to purge: "
	s $zt="etgetpurge",type=$g(type)
	s kill=0,f=$zd(limit,8)_".000J" ;only interested in files created earlier than the "limit" date
	f  s f=$o(^%SYS("JOURNAL","HISTORY",f),-1) q:f=""  d  q:kill
	. s d=$g(^%SYS("JOURNAL","HISTORY",f,"DATE")),d2=+$p(d,"^",2)       
	. i 0<d2,d2<limit s kill=1 d  q  ;a STOP entry
	. . s f=^%SYS("JOURNAL","HISTORY",f,"FULLNAME"),d=$ZU(78,22,f)
	. . i d'=1 d:d=-1 msglog(errhead_f_" is corrupted") s f="" q 
	. i +$p(d,"^") s kill=1 d  q  ;a START entry (timestamp<limit is guaranteed)
	. . i type="H"!(type="h") d  q
	. . . s f=$o(^%SYS("JOURNAL","HISTORY",f),-1) 
	. . . s:f'="" f=^%SYS("JOURNAL","HISTORY",f,"FULLNAME")
	. . s d2=^%SYS("JOURNAL","HISTORY",f,"FULLNAME")
	. . s d=$ZU(78,22,d2)
	. . i d'=1 d:d=-1 msglog(errhead_d2_" is corrupted") s f="" q 
	. . s d=$$PREVJRN^JRNUTIL2(d2,.f) ;f does not have a trailing "J"
	. . i d'>0 d  s f="" ;don't log error if previous file is gone
	. . . i +d'=-1 d msglog(errhead_$$ERNXPVJRN^JRNUTIL2(d,d2))
	q f
etgetpurge	
	s $zt=""
	d msglog("getpurge: "_$ze)
	q ""
SETLIFESPAN(flifespan,glifespan)	
	n oldfls s oldfls=$g(^%SYS("JOURNAL","LIFESPAN","FILE"))
	s:$d(flifespan) ^%SYS("JOURNAL","LIFESPAN","FILE")=flifespan
	s:$d(glifespan) ^%SYS("JOURNAL","LIFESPAN")=glifespan
	q oldfls
	;********************************************************
HISTOUT	;print out the history information
	N POP,SELF,entry,info,date,time,action,file1,file2,DATE
	D OUT^%IS Q:POP  S SELF=(IO=$I)
	S $ZT="HistErr^"_$ZN,$ZE=""
	U IO S ent=0,dt="",DATE=""
	F  S dt=$O(^SYS("JOURNAL","HISTORY",dt)) Q:dt=""  DO  Q:POP
	. F  S ent=$O(^SYS("JOURNAL","HISTORY",dt,ent)) Q:'ent  DO  Q:POP
	. . S info=^SYS("JOURNAL","HISTORY",dt,ent)
	. . S date=$P(info,"^"),time=$P(date,",",2)
	. . S action=$P(info,"^",2)
	. . S file1=$P(info,"^",3)
	. . S file2=$P(info,"^",4)
	. . S date=$ZDATE(date,2,,4),time=$$Time(time)
	. . I DATE'=date DO  S DATE=date ;print header for each new day
	. . . W !!,date,?30," * * * * * * * * * * * * * * * * *",!
	. . W !!?8,$J(time,10)_"  "_action,?40,file1
	. . I file2]"" W !?40,file2
	;
	I DATE="" W !,"No Journal History Exists",!
HistErr	S $ZT="" I $ZE]"" W !,$ZE
	U 0 I '$G(SELF) C IO
	Q
Time(s)	N h,m,a S a=" am",h=s\3600,m=s\60#60 S:h>11 a=" pm",h=h-12 S:'h h=12
	Q ($J(h,2)_":"_$E(100+m,2,3)_a)                 
	;********************************************************************
	; $$OPENJRN^JRNUTIL(JRNFILE)  : Open a journal file
	;   
	;   Input: - name of the file to be opened.
	;
	;            Each process can open multiple files at a time, but each
	;            file can be open by just one process at a time.
	;            A local array %JFILE(file) keeps track of a process's 
	;            open files. When a process opens a file, to prevent other
	;            from opening it, a lock on ^%JOURNAL(file) is made.
	;            When the process closes the file, this lock is removed.
	;
	;   Output:  -8   ( file is the current journal file )
	;            -7   ( cannot open the file )
	;            -6   ( file locked by another user )
	;             1   ( success )
	;********************************************************************
OPENJRN(JRNFILE)	; open a journal file for exclusive access 
	S $ZT="ERR^"_$ZN
	N FILE,FD,Y,CUR
	i ($zv["VMS") S FILE=$ZU(12,JRNFILE)
	i '($zv["VMS") S FILE=JRNFILE
	;
	I $D(%JFILE(FILE)) Q "-14,Journal file is already open"  ;Already opened by caller
	;
	L +^%JOURNAL(FILE):1 I '$T Q "-6,Journal file open by other user"  
	S FD=$zu(78,5,FILE,0)          ;open it
	I FD<0 L -^%JOURNAL(FILE) Q "-7,Unable to open journal file"
	S %JFILE(FILE)=FD    ;Set your local document
	Q 1
	;********************************************************************
	; $$CLOSEJRN^JRNUTIL(JRNFILE) : Close a journal file
	;
	;   Input: - name of the journal file to be closed
	;
	;   Output:  -15   ( unknown error )
	;             -9   ( file has not been opened )
	;              1   ( success )
	;********************************************************************
CLOSEJRN(JRNFILE)	; close a journal file
	S $ZT="ERR^"_$ZN
	N FILE,X,FD
	i ($zv["VMS") S FILE=$ZU(12,JRNFILE)
	i '($zv["VMS") S FILE=JRNFILE
	;
	I '$D(%JFILE(FILE)) Q "-9,Journal file has not been opened"  ; You haven't opened this file
	;
	S FD=%JFILE(FILE) 
	S X=$zu(78,7,FD)
	I X<0 Q "-15,Unsuccessful operation"
	; 
	K %JFILE(FILE)
	L -^%JOURNAL(FILE)
	I $G(%JFILE)=FILE S %JFILE=""
	Q 1
	;********************************************************************
	; $$USEJRN^JRNUTIL(JRNFILE) :  to use an already opened journal file
	;
	;   Input: - name of the file
	;    
	;   Output:  -15    ( unknown error )
	;             -9    ( file has not been opened )
	;              1    ( success )  which in this case:
	;              local variable %JFILE is set to this file name
	;********************************************************************
USEJRN(JRNFILE)	 ;set JRNFILE to be used for next read/delete journal records 
	s $ZT="ERR^"_$ZN
	N FILE,X,FD
	i ($zv["VMS") S FILE=$ZU(12,JRNFILE)
	i '($zv["VMS") S FILE=JRNFILE
	;
	I '$D(%JFILE(FILE)) Q "-9,Journal file has not been opened"    ;Not open
	;
	S FD=%JFILE(FILE)
	S X=$zu(78,6,FD) I X>-1 S %JFILE=FILE Q 1
	Q "-15,Unsuccessful operation"
	;*********************************************************************
	; $$JRNSWCH^JRNUTIL(newdir) :  switch journalling (to a new directory)  
	;   Input: - newdir, new directory into which journal is written
	;            newdir="": switch journalling in the same directory
	;   Output:  -5  ( journalling is not active now )
	;            -3  ( unable to create journal file )
	;            -2  ( JRNSWCH currently in use )
	;            -1  ( cannot cease updates )
	;             1  ( success )
	;*********************************************************************
JRNSWCH(newdir)	; switch journalling to new directory newdir
	S $ZT="ERRSWCH^"_$ZN
	n switched,err,msg s switched=$$INT^JRNSWTCH($g(newdir),"",.err)
	q:switched 1
	s msg=$p(err,",",2,$l(msg,",")),err=$p(err,",")
	q $s(err=-3:"-5,Journaling is not active",err=-2:"-2,JRNSWCH currently in use",err=-4:"-17,Invalid journal directory name",1:msg)        
ERRSWCH	;
	s $zt=""
	q $ze
	;**************************************************************
ERR	S $ZT="" Q $ZE 
	;**************************************************************
NEXTJRN1(fd,mgdir)	
	;mgdir = where to find %SYS("JOURNAL","HISTORY") for this system.
	;        normally omitted except for clustered systems
	s $zt="etNEXTJRN"
	n err,nextfd
	i '$d(mgdir) s mgdir=$ZU(12)
	s err=$$NEXTJRN^JRNUTIL2(fd,.nextfd,1,mgdir)
	i +err>0 q nextfd
	d msglog("NEXTJRN: "_err_","_fd_","_$g(nextfd)_","_mgdir)
	q ""
NEXTJRN0(fd,mgdir)	;
	;mgdir = where to find %SYS("JOURNAL","HISTORY") for this system.
	;        normally omitted except for clustered systems
	s $zt="etNEXTJRN"
	n err,nextfd
	i '$D(mgdir) s mgdir=$ZU(12)
	s err=$$NEXTJRN^JRNUTIL2(fd,.nextfd,0,mgdir)
	i +err>0 q nextfd
	d msglog("NEXTJRN: "_err_","_fd_","_$g(nextfd)_","_mgdir)
	q ""
etNEXTJRN	
	s $zt=""
	d msglog("Error: "_$ze)
	q ""
msglog(msg)	
	i $zj\2#2=0 d MSG^%UTIL(msg,0,1) q
	d MSG^%UTIL(msg,1,1) q
%swstat(sw,detail)	; Return the status of Switch (sw)...
	s sw=+$g(sw),detail=+$g(detail)
	i 'sw q $s(detail:-1_$c(1)_"Illegal Switch",1:-1)
	n bit,i,info,job10
	s info=""
	s $zt="%swerr^"_$zn,$ze=""
	s bit=1 f i=1:1:sw s bit=bit*2
	i $V(0,-2,$ZU(40,0,1))\bit#2=0 q $s(detail:0_$c(1)_"Switch "_sw_" is NOT set.",1:0)
	i sw=10 s job10=$V($ZU(40,2,19),-2,$ZU(40,0,1)),info=" Set by JOB #: "_job10_"  ("_$v(-1,job10)_")"
	q $s(detail:1_$c(1)_"Switch "_sw_" IS set."_info,1:1)
%swerr	  ; Some error occured when doing a Switch 10 Status...
	s $zt=""
	q $s(detail:-1_$c(1)_$ze,1:-1)
%swset(sw,val,detail)	; Set Switch (sw) to (val - {0,1})...
	s sw=+$g(sw),val=+$g(val),detail=+$g(detail)
	i 'sw q $s(detail:-1_$c(1)_"Illegal Switch",1:-1)
	i val'=0,val'=1 q $s(detail:-1_$c(1)_"Illegal Switch Value",1:-1)
	s $zt="%swseter^"_$zn,$ze=""
	n bit,i,job10,old
	s bit=1 f i=1:1:sw s bit=bit*2
	s old=$V(0,-2,$ZU(40,0,1))
	i old\bit#2=val q 1  ; Nothing to do (Value not changed)!!
	v 0:-2:$ZU(40,0,1):old+$s(val:bit,1:-bit)
	i sw=10 s job10=$ZU(40,2,19) v job10:-2:$ZU(40,0,1):val*$job
	i $V(0,-2,$ZU(40,0,1))\bit#2=val q 1
	q 0
%swseter	; Some error occured when Setting Switch (sw) to (val)...
	s $zt=""
	q $s(detail:-1_$c(1)_$ze,1:-1)
	; BITWISE.INC, DPB139 07/09/93
FIXDIR(dir)	;procedure, dir is passed by reference
	Q:dir=""
	i ($zv["VMS") d
	. n x
	. s x=$$ChkDirVALID(dir)
	. i x'="" s dir=x
	i '($zv["VMS") Q:$A(dir,$L(dir))=$A($s(($zv["UNIX"):"/",($zv["VMS"):"]",($zv["Windows"):"\",1:""))
	i '($zv["VMS") s dir=dir_$s(($zv["UNIX"):"/",($zv["VMS"):"]",($zv["Windows"):"\",1:"")
	Q
fixdir(dir)	;function
	Q:dir="" ""
	i ($zv["VMS") d  q dir
	. n x
	. s x=$$ChkDirVALID(dir)
	. i x'="" s dir=x
	Q:$A(dir,$L(dir))=$A($s(($zv["UNIX"):"/",($zv["VMS"):"]",($zv["Windows"):"\",1:"")) dir
	Q dir_$s(($zv["UNIX"):"/",($zv["VMS"):"]",($zv["Windows"):"\",1:"")
basename(f)	;similar to basename on UNIX
	Q $P(f,$s(($zv["UNIX"):"/",($zv["VMS"):"]",($zv["Windows"):"\",1:""),1,$L(f,$s(($zv["UNIX"):"/",($zv["VMS"):"]",($zv["Windows"):"\",1:""))-1)_$s(($zv["UNIX"):"/",($zv["VMS"):"]",($zv["Windows"):"\",1:"")
appdir(d1,d2)	;use $zu(12,d2) to append d2 to canonic dir
	i ($zv["VMS") S $E(d1,$L(d1))="."_d2_"]"
	i '($zv["VMS") S d1=d1_d2
	Q d1
VALIDIR(dir)	;validate directory dir and create it if dir doesn't exist
	new flag
	s flag=1
	g vdir2
validir(dir,flag)	;validate directory dir and optionally create it if it
vdir2	; VALIDIR(dir) comes here with flag set to 1
	quit:$$ChkDirOrSpecEXISTS(dir)'="" 1   ; dir is valid and exists
	quit:$$ChkDirVALID(dir)="" 0    ; dir is not valid
	i flag'=1 q 0  ; flag says don't create, return failure
	new x
	set x=$$mkdir(dir)  ; returns 0 for success, 1 for failure
	q:x=1 0  ; failed to create
	quit:$$ChkDirOrSpecEXISTS(dir)="" 0   ; it doesn't we failed
	q 1  ; success
mkdir(dir)	;create a new directory
	i '($zv["VMS") Q $ZF(-1,"mkdir "_$S($E(dir)=""""!($F(dir," ")=0):dir,1:""""_dir_""""))
	q:$$ChkDirVALID(dir)="" 1  ; dir is invalid, return failure
	n res
	s res=$ZF(-1,"create/directory "_dir)
	q '+($ZBOOLEAN(+(res),+(1),1)) 
jrnshort(jf,short)	;get/set short form of a journal file name
	N (jf,short)
	S len=$L($P(jf,";"))
	Q:$G(short)="" $E(jf,len-11,len) ;"GET" form
	S $E(jf,len-11,len)=short ;"SET" form
	Q jf
GJrnPrefix(jf)	;extract prefix from the journal file name jf
	N (jf)
	S fname=$P(jf,$s(($zv["UNIX"):"/",($zv["VMS"):"]",($zv["Windows"):"\",1:""),$L(jf,$s(($zv["UNIX"):"/",($zv["VMS"):"]",($zv["Windows"):"\",1:"")))       
	i '($zv["VMS") Q $E(fname,1,$L(fname)-12)
	S fname=$P(fname,";")
	Q $E(fname,1,$L(fname)-12)
dirinvalidmsg(dir1,dir2)	
	n valid1,valid2,cnt,msg
	s valid1=$$VALIDIR(dir1),valid2=$$VALIDIR(dir2)
	s cnt=valid1+valid2 ; cnt = 0 if both invalid, 1 if one is valid
	s msg="The following journaling "
	s:cnt msg=msg_"directory is" 
	s:'cnt msg=msg_"directories are"
	s msg=msg_" not valid"_$C(13,10)
	s:'valid1 msg=msg_"     "_dir1_$C(13,10)
	s:'valid2 msg=msg_"     "_dir2_$C(13,10)
	q msg
ChkDirVALID(R)	N N S $ZE="",$ZT="ChkBad",N=$ZU(12,R,1) Q N
ChkDirEXISTS(R)	N N S $ZE="",$ZT="ChkBad",N=$ZU(12,R,2) Q N
ChkDirOrSpecEXISTS(R)	N N S $ZE="",$ZT="ChkBad",N=$ZU(12,R,3) Q N
ChkDir(R)	N N S $ZE="",$ZT="ChkBad",N=$ZU(12,R,2) Q N
ChkBad	S $ZT="" W !,"<"_$P($P($ZE,"<",2),">")_"> error -- invalid directory"
	Q ""
%msub()	Q $I(^mtemp)