XUPROD ;ISF/RWF - Is this a PROD account. ;18/06/20
;;8.0;KERNEL;**284,440,542,717,742**;Jul 10, 1995;Build 1
;;Per VHA Directive 6402, this routine should not be modified.
;
;IA# 4440
PROD(FORCE) ;Return 1 if this is a production account
;A non-zero flag will force a real check
;This call just checks a flag in the KSP, Other code will compair
;with registered ID.
I $$CFG("PRO") Q 1
N LC,SID
S SID=$G(^XTV(8989.3,1,"SID"))
I '$L($P(SID,"^",3))!($P(SID,"^",3)'=$G(DT))!$G(FORCE) D
. D CHECK S SID=$G(^XTV(8989.3,1,"SID"))
Q +$P(SID,"^",1)
;
CHECK ;Check if SID matched stored value, Set field 501
N CSID,SSID,FDA
L +^XTV(8989.3,1,"SID"):2
S CSID=$$SID^%ZOSV,SSID=$P($G(^XTV(8989.3,1,"SID")),"^",2)
S FDA(8989.3,"1,",501)=(CSID=SSID),FDA(8989.3,"1,",503)=$$DT^XLFDT
D FILE^DIE("","FDA")
L -^XTV(8989.3,1,"SID")
Q
;
SSID(SID) ;Set the SID into KSP.
N FDA
S FDA(8989.3,"1,",502)=SID,FDA(8989.3,"1,",503)="@"
L +^XTV(8989.3,1,"SID"):2
D FILE^DIE("","FDA")
L -^XTV(8989.3,1,"SID")
Q
ASK ;Ask user if this is prod.
N DIR,P,P2,T,Y S P=$$PROD
S DIR(0)="YO",DIR("A")="Is this a Production Account",DIR("B")=$S(P:"Yes",1:"No")
S DIR("A",1)=""
S DIR("A",2)="This is currently a "_$S(P:"PRODUCTION",1:"TEST")_" account."
S DIR("A",3)=" "
S DIR("A",4)="Only answer YES if this is the full time Production Account."
S DIR("A",5)="Answer No for all other accounts.",DIR("A",6)=""
D ^DIR S T=Y Q:$D(DIRUT)
K DIR
S DIR(0)="YO"
S DIR("A",1)="",DIR("A",2)="Are you sure you want to change from a "_$S(P:"PRODUCTION",1:"TEST")_" account"
S DIR("A")="to a "_$S(Y:"PRODUCTION",1:"TEST")_" account",DIR("B")="No"
D:P'=Y ^DIR
I Y=1 D SSID($$SID^%ZOSV):T=1,SSID("2~TEST~999"):T=0
S P2=$$PROD
W !!,"This is "_$S(P=P2:"still",1:"now")_" a "_$S(P2:"PRODUCTION",1:"TEST")_" account.",!
Q
;
EDIT ;Edit Logical - Physical fields
N DIE,DA,DR
L +^XTV(8989.3,1,"SID"):$G(DILOCKTM,5) E W !,"Busy, Please try again later.",! Q ;p542
W !!,"This is only valid in a Cache v5.2 client/server configuration."
W !,"This lets you edit the fields that support the"
W !,"LOGICAL to PHYSICAL translation for the System ID.",!!
S DA=1,DIE="^XTV(8989.3,",DR="504;505" D ^DIE
L -^XTV(8989.3,1,"SID")
Q
;
CFG(CFG) ; RETURN BOOLEAN CHECK FOR CONFIGURATION TYPE
;I $G(^|"%SYS"|SYS("ZCFG"))[CFG Q $S(^|"%SYS"|SYS("ZCFG")[("-"_CFG):0,1:1)
N X,Y S X=$$INSTNM("U")
I CFG="PRO" I ($E(X,6)="P")&("PS0^PAD^PRD^PSH"'[$E(X,6,8)) Q 1
I CFG="TST" I ($E(Y,1,3)=195)!($E(X,6)="T")!($L(X)=7&($E(X)="T")) Q:"TAD^TRD"[$E(X,6,8) 0 Q 1
I CFG="BE",$E(X,7,9)="SVR" Q 1
I CFG="FE",$E(X,7,8)="A0"!($E(X,7,8)="TM") Q 1
I CFG="MS" I $E(X,6,9)="SHMS"!($E(X,6,8)="SSM") Q 1
I CFG="LS" I $E(X,7,9)="LDR"!($E(X,6,8)="SSL") Q 1
I CFG="VRO" I $E(X,6,9)="SHDW"!($E(X,6,8)="SS0")!($E(X,6,8)="SS1") Q 1
I CFG="DR" I $E(X,7,9)="SHD"!($E(X,6,8)="PS0")!($E(X,6,8)="DR0") Q 1
I CFG="MDR" I $E(X,6,8)="MDR" Q 1
I CFG="HC" I $E(X,4,5)="HC" Q 1
I CFG="PM" Q $SYSTEM.Mirror.IsPrimary()
I CFG="BM" Q $SYSTEM.Mirror.IsBackup()
I CFG="AM" Q $SYSTEM.Mirror.IsAsyncMember()
I CFG="MM" Q $SYSTEM.Mirror.IsMember() ;Returns 1 for Failover members, 2 for Async members
I CFG="CDW" I 0 Q 1
I CFG="HS" I $SYSTEM.Version.GetMajor()>2016,$SYSTEM.Version.GetISCProduct()=3 Q 1 ; 1 = Cache, 2 = Ensemble, 3 = Healthshare, 4 = Iris
Q 0
;
INSTNM(CASE) ; RETURNS INSTANCE NAME
N XUCASE S XUCASE=$G(CASE,"U") ; PASS L for lowercase, U for UPPERCASE (DEFAULT)
Q $ZCVT(##Class(%SYS.System).GetInstanceName(),XUCASE)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUPROD 3573 printed Dec 13, 2024@02:11:36 Page 2
XUPROD ;ISF/RWF - Is this a PROD account. ;18/06/20
+1 ;;8.0;KERNEL;**284,440,542,717,742**;Jul 10, 1995;Build 1
+2 ;;Per VHA Directive 6402, this routine should not be modified.
+3 ;
+4 ;IA# 4440
PROD(FORCE) ;Return 1 if this is a production account
+1 ;A non-zero flag will force a real check
+2 ;This call just checks a flag in the KSP, Other code will compair
+3 ;with registered ID.
+4 IF $$CFG("PRO")
QUIT 1
+5 NEW LC,SID
+6 SET SID=$GET(^XTV(8989.3,1,"SID"))
+7 IF '$LENGTH($PIECE(SID,"^",3))!($PIECE(SID,"^",3)'=$GET(DT))!$GET(FORCE)
Begin DoDot:1
+8 DO CHECK
SET SID=$GET(^XTV(8989.3,1,"SID"))
End DoDot:1
+9 QUIT +$PIECE(SID,"^",1)
+10 ;
CHECK ;Check if SID matched stored value, Set field 501
+1 NEW CSID,SSID,FDA
+2 LOCK +^XTV(8989.3,1,"SID"):2
+3 SET CSID=$$SID^%ZOSV
SET SSID=$PIECE($GET(^XTV(8989.3,1,"SID")),"^",2)
+4 SET FDA(8989.3,"1,",501)=(CSID=SSID)
SET FDA(8989.3,"1,",503)=$$DT^XLFDT
+5 DO FILE^DIE("","FDA")
+6 LOCK -^XTV(8989.3,1,"SID")
+7 QUIT
+8 ;
SSID(SID) ;Set the SID into KSP.
+1 NEW FDA
+2 SET FDA(8989.3,"1,",502)=SID
SET FDA(8989.3,"1,",503)="@"
+3 LOCK +^XTV(8989.3,1,"SID"):2
+4 DO FILE^DIE("","FDA")
+5 LOCK -^XTV(8989.3,1,"SID")
+6 QUIT
ASK ;Ask user if this is prod.
+1 NEW DIR,P,P2,T,Y
SET P=$$PROD
+2 SET DIR(0)="YO"
SET DIR("A")="Is this a Production Account"
SET DIR("B")=$SELECT(P:"Yes",1:"No")
+3 SET DIR("A",1)=""
+4 SET DIR("A",2)="This is currently a "_$SELECT(P:"PRODUCTION",1:"TEST")_" account."
+5 SET DIR("A",3)=" "
+6 SET DIR("A",4)="Only answer YES if this is the full time Production Account."
+7 SET DIR("A",5)="Answer No for all other accounts."
SET DIR("A",6)=""
+8 DO ^DIR
SET T=Y
if $DATA(DIRUT)
QUIT
+9 KILL DIR
+10 SET DIR(0)="YO"
+11 SET DIR("A",1)=""
SET DIR("A",2)="Are you sure you want to change from a "_$SELECT(P:"PRODUCTION",1:"TEST")_" account"
+12 SET DIR("A")="to a "_$SELECT(Y:"PRODUCTION",1:"TEST")_" account"
SET DIR("B")="No"
+13 if P'=Y
DO ^DIR
+14 IF Y=1
if T=1
DO SSID($$SID^%ZOSV)
if T=0
DO SSID("2~TEST~999")
+15 SET P2=$$PROD
+16 WRITE !!,"This is "_$SELECT(P=P2:"still",1:"now")_" a "_$SELECT(P2:"PRODUCTION",1:"TEST")_" account.",!
+17 QUIT
+18 ;
EDIT ;Edit Logical - Physical fields
+1 NEW DIE,DA,DR
+2 ;p542
LOCK +^XTV(8989.3,1,"SID"):$GET(DILOCKTM,5)
IF '$TEST
WRITE !,"Busy, Please try again later.",!
QUIT
+3 WRITE !!,"This is only valid in a Cache v5.2 client/server configuration."
+4 WRITE !,"This lets you edit the fields that support the"
+5 WRITE !,"LOGICAL to PHYSICAL translation for the System ID.",!!
+6 SET DA=1
SET DIE="^XTV(8989.3,"
SET DR="504;505"
DO ^DIE
+7 LOCK -^XTV(8989.3,1,"SID")
+8 QUIT
+9 ;
CFG(CFG) ; RETURN BOOLEAN CHECK FOR CONFIGURATION TYPE
+1 ;I $G(^|"%SYS"|SYS("ZCFG"))[CFG Q $S(^|"%SYS"|SYS("ZCFG")[("-"_CFG):0,1:1)
+2 NEW X,Y
SET X=$$INSTNM("U")
+3 IF CFG="PRO"
IF ($EXTRACT(X,6)="P")&("PS0^PAD^PRD^PSH"'[$EXTRACT(X,6,8))
QUIT 1
+4 IF CFG="TST"
IF ($EXTRACT(Y,1,3)=195)!($EXTRACT(X,6)="T")!($LENGTH(X)=7&($EXTRACT(X)="T"))
if "TAD^TRD"[$EXTRACT(X,6,8)
QUIT 0
QUIT 1
+5 IF CFG="BE"
IF $EXTRACT(X,7,9)="SVR"
QUIT 1
+6 IF CFG="FE"
IF $EXTRACT(X,7,8)="A0"!($EXTRACT(X,7,8)="TM")
QUIT 1
+7 IF CFG="MS"
IF $EXTRACT(X,6,9)="SHMS"!($EXTRACT(X,6,8)="SSM")
QUIT 1
+8 IF CFG="LS"
IF $EXTRACT(X,7,9)="LDR"!($EXTRACT(X,6,8)="SSL")
QUIT 1
+9 IF CFG="VRO"
IF $EXTRACT(X,6,9)="SHDW"!($EXTRACT(X,6,8)="SS0")!($EXTRACT(X,6,8)="SS1")
QUIT 1
+10 IF CFG="DR"
IF $EXTRACT(X,7,9)="SHD"!($EXTRACT(X,6,8)="PS0")!($EXTRACT(X,6,8)="DR0")
QUIT 1
+11 IF CFG="MDR"
IF $EXTRACT(X,6,8)="MDR"
QUIT 1
+12 IF CFG="HC"
IF $EXTRACT(X,4,5)="HC"
QUIT 1
+13 IF CFG="PM"
QUIT $SYSTEM.Mirror.IsPrimary()
+14 IF CFG="BM"
QUIT $SYSTEM.Mirror.IsBackup()
+15 IF CFG="AM"
QUIT $SYSTEM.Mirror.IsAsyncMember()
+16 ;Returns 1 for Failover members, 2 for Async members
IF CFG="MM"
QUIT $SYSTEM.Mirror.IsMember()
+17 IF CFG="CDW"
IF 0
QUIT 1
+18 ; 1 = Cache, 2 = Ensemble, 3 = Healthshare, 4 = Iris
IF CFG="HS"
IF $SYSTEM.Version.GetMajor()>2016
IF $SYSTEM.Version.GetISCProduct()=3
QUIT 1
+19 QUIT 0
+20 ;
INSTNM(CASE) ; RETURNS INSTANCE NAME
+1 ; PASS L for lowercase, U for UPPERCASE (DEFAULT)
NEW XUCASE
SET XUCASE=$GET(CASE,"U")
+2 QUIT $ZCVT(##Class(%SYS.System).GetInstanceName(),XUCASE)
+3 ;
