source: IHS-VA_UTILITIES-XB/trunk/ZIBGCHAR.m@ 1075

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,
        ;;###