ZIBGCHAR	; IHS/ADC/GTH - NONINTERACTIVE MODIFICATIONS OF GLOBAL CHARACTERISTICS ; [ 08/26/2004  12:01 PM ]
	;;4.0;XB;;Jul 20, 2009;Build 2
	; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err.
	; XB*3*5 IHS/ADC/GTH 10-31-97 Prevent errors in return from ^%GCH.
	; XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Cache' mods.
	; XB*3*10 IHS/ITSC/DMJ 8/19/2004 Bad global name.
	;
	; Not all capabilities of the implementation-specific global
	; characteristics routines are reflected in this routine.
	;
	; The argument for each entry point is the unsubscripted
	; name of the global whose characteristics you want to
	; change, with NO leading circumflex.  
	;
	; If the call is successful, 0 is returned.
	;
	; If the call is not successful, a positive integer is
	; returned, and the cause can be retrieved at the ERR()
	; entry point.
	;
	; E.g's: 
	;          S %=$$NOJOURN^ZIBGCHAR("AUTTSITE")
	;          I % W !,$$ERR^ZIBGCHAR(%)
	;
	Q
	;
	;Begin New Code;IHS/SET/GTH XB*3*9 10/29/2002
KILL(ZIBGLOB)	;PEP - Kill global or global referenced at the top level
	NEW QF,X
	I '$L($G(ZIBGLOB)) Q 1
	I ZIBGLOB'["," D  Q QF    ; just one global to kill
	. S QF=$$PROCESS("D","N")
	. I QF Q
	. KILL @("^"_ZIBGLOB)
	. I $$VERSION^%ZOSV(1)["Cache" S X=$ZU(68,28,1) ;disallow kill again
	.Q
	;multiple globals to kill, comma delimited string like "gbl1,gbl2,gbl3"
	F X=1:1:$L(ZIBGLOB,",") S ZIBGLOB(X)=$P(ZIBGLOB,",",X)
	F X=1:1:$L(ZIBGLOB,",") D  Q:QF
	. S QF=$$KILLOK(ZIBGLOB(X))
	. I QF Q
	. KILL @("^"_ZIBGLOB(X)),ZIBGLOB(X)
	.Q
	I $$VERSION^%ZOSV(1)["Cache" S X=$ZU(68,28,1) ;disallow kill again
	Q QF
	;
	;End New Code;IHS/SET/GTH XB*3*9 10/29/2002
KILLOK(ZIBGLOB)	;PEP - Allow kill of global.
	Q $$PROCESS("D","N")
	;
KILLNO(ZIBGLOB)	;PEP - Prevent kill'ing of global.
	Q $$PROCESS("D","Y")
	;
JOURN(ZIBGLOB)	;PEP - Set Journaling to ALWAYS.
	Q $$PROCESS("J","A")
	;
NOJOURN(ZIBGLOB)	;PEP - Set Journaling for global to NEVER.
	Q $$PROCESS("J","N")
	;
UCIJOURN(ZIBGLOB)	;PEP - Journal when UCI is Journaled.
	Q $$PROCESS("J","U")
	;
PROCESS(ZIBFLAG,ZIBVAL)	;
	I '$L($G(ZIBGLOB)) Q 1
	;I '(ZIBGLOB?1.8U) Q 5;IHS/SET/GTH XB*3*9 10/29/2002
	;I '(ZIBGLOB?1.8U!(ZIBGLOB?1"%"1.7U)) Q 5  ;Cache needs to SET % globals;IHS/SET/GTH XB*3*9 10/29/2002 XB*3*10 next line will do the job
	I '$D(@("^"_ZIBGLOB)) Q 2
	; NEW O ; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err.
	; S O=$P(^%ZOSF("OS"),"-",1) ; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err.
	; I '$L($T(@O)) Q 3 ; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err.
	; G @O ; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err.
	; I $P(^%ZOSF("OS"),"^",1)["MSM" G MSM ; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err.
	I $$VERSION^%ZOSV(1)["Cache" Q $$CACHE(ZIBFLAG,ZIBGLOB,ZIBVAL)  ;IHS/SET/GTH XB*3*9 10/29/2002
	I $P(^%ZOSF("OS"),"^",1)'["MSM" Q 3  ; XB*3*5 IHS/ADC/GTH 10-31-97 Prevent errors in return from ^%GCH.
	D MSM
	I '$D(ZTQUEUED) D HOME^%ZIS U IO(0) ; XB*3*5 IHS/ADC/GTH 10-31-97 Prevent errors in return from ^%GCH.
	Q 0  ; XB*3*5 IHS/ADC/GTH 10-31-97 Prevent errors in return from ^%GCH.
	; Q 3  ; XB*3*4 IHS/ADC/GTH 05-22-97 Prevent <INDER> err. ; XB*3*5 IHS/ADC/GTH 10-31-97 Prevent errors in return from ^%GCH.
	;
	;Begin New Code;IHS/SET/GTH XB*3*9 10/29/2002
CACHE(ZIBFLAG,ZIBGLOB,ZIBVAL)	;PEP - allow/prevent kill or enable/disable journaling on Cache
	;TASSC/MFD added subroutine to mimic portions of %GCH that Cache can do
	; -Patterned after CALL subroutine of MSM's %GCH but an extrinsic
	; -Less options than MSM- journaling is either on or off for a global
	;  as there is no Journal entire UCI option
	; -Allowing top-level kill is by process not by global specification
	; -If the call is successful, 0 is returned.
	;
	; ZIBGLOB = global reference, no leading ^
	; ZIBFLAG can be "J" or "D"- J is for journaling on or off, D is for
	;   allowing top kill or not
	; ZIBVAL = for Journaling- E, A or U for enable, D, N or null for disable
	;       for Prev kill- Y to prevent kill, N to allow kill
	;
	I '(ZIBGLOB?1.8AN!(ZIBGLOB?1"%"1.7AN)) Q 5  ; XB*3*10 allow lower case
	I '$D(@("^"_ZIBGLOB)) Q 2
	I ZIBFLAG="D",ZIBVAL="N" NEW X S X=$ZU(68,28,0) Q 0  ;don't prevent top-level kill for the process
	I ZIBFLAG="D",ZIBVAL="Y" NEW X S X=$ZU(68,28,1) Q 0  ;prevent top-level kill for the process
	I ZIBFLAG="J" NEW ZIBRC D
	.S ZIBVAL=$S(ZIBVAL="E":4,ZIBVAL="A":4,ZIBVAL="U":4,ZIBVAL="N":0,ZIBVAL="D":0,ZIBVAL="":0,1:1)
	.I ZIBVAL'=1 S ZIBRC=$$SetJournalType^%DM("",ZIBGLOB,ZIBVAL)
	.Q
	I ZIBRC=1 Q 0  ;Cache returns a 1 if successful
	Q 1  ; any other condition is bad so quit 1
	;
	;End New Code;IHS/SET/GTH XB*3*9 10/29/2002
MSM	; Micronetics Standard MUMPS.
	I '$L($T(CALL^%GCH)) Q 4
	S:$D(ZTQUEUED) CALL="" ; Tell ^%GCH not to talk if errors.
	KILL O
	NEW (ZIBFLAG,ZIBGLOB,ZIBVAL) ; XB*3*5 IHS/ADC/GTH 10-31-97 Prevent errors in return from ^%GCH.
	D CALL^%GCH(ZIBFLAG,ZIBGLOB,ZIBVAL)
	KILL CALL
	; Q 0 ; XB*3*5 IHS/ADC/GTH 10-31-97 Prevent errors in return from ^%GCH.
	Q  ; XB*3*5 IHS/ADC/GTH 10-31-97 Prevent errors in return from ^%GCH.
	;
ERR(Z)	;PEP - Return cause of error.
	Q $P($T(@Z),";;",2)
1	;;NO GLOBAL SPECIFIED IN PARAMETER
2	;;GLOBAL DOES NOT EXIST
3	;;OPERATING SYSTEM NOT SUPPORTED
4	;;WRONG VERSION OF MSM'S ^%GCH
5	;;BAD GLOBAL NAME
	;
	;
TEST	;    
	NEW AZHB,AZHB1
	F AZHBCTR=1:1 S AZHB=$P($T(DATA+AZHBCTR),";",3) Q:AZHB="###"  D T1(AZHB),T2(AZHB)
	Q
	;
T1(AZHB)	;
	W !,"No Journaling For '",AZHB,"'"
	S AZHB1=$$NOJOURN(AZHB)
	W ?28," : ",AZHB1
	I AZHB1 W " : ",$$ERR(AZHB1)
	E  W " : <kool>"
	Q
	;
T2(AZHB)	;
	W !,"No Killing For '",AZHB,"'"
	S AZHB1=$$KILLNO(AZHB)
	W ?28," : ",AZHB1
	I AZHB1 W " : ",$$ERR(AZHB1)
	E  W " : <kool>"
	Q
	;
DATA	;
	;;
	;;FREDDATA
	;;ACHSDATA
	;;AUTTSITE
	;;^AUTTLOC
	;;jen
	;;44
	;;DIC(4,
	;;###