| 1 | XUPROD ;ISF/RWF - Is this a PROD account. ;8/23/07 16:47
|
|---|
| 2 | ;;8.0;KERNEL;**284,440**;Jul 10, 1995;Build 13
|
|---|
| 3 | ;
|
|---|
| 4 | ;IA# 4440
|
|---|
| 5 | PROD(FORCE) ;Return 1 if this is a production account
|
|---|
| 6 | ;A non-zero flag will force a real check
|
|---|
| 7 | ;This call just checks a flag in the KSP, Other code will compair
|
|---|
| 8 | ;with registered ID.
|
|---|
| 9 | N LC,SID
|
|---|
| 10 | S SID=$G(^XTV(8989.3,1,"SID"))
|
|---|
| 11 | I '$L($P(SID,"^",3))!($P(SID,"^",3)'=$G(DT))!$G(FORCE) D
|
|---|
| 12 | . D CHECK S SID=$G(^XTV(8989.3,1,"SID"))
|
|---|
| 13 | Q +$P(SID,"^",1)
|
|---|
| 14 | ;
|
|---|
| 15 | CHECK ;Check if SID matched stored value, Set field 501
|
|---|
| 16 | N CSID,SSID,FDA
|
|---|
| 17 | L +^XTV(8989.3,1,"SID"):2
|
|---|
| 18 | S CSID=$$SID^%ZOSV,SSID=$P($G(^XTV(8989.3,1,"SID")),"^",2)
|
|---|
| 19 | S FDA(8989.3,"1,",501)=(CSID=SSID),FDA(8989.3,"1,",503)=$$DT^XLFDT
|
|---|
| 20 | D FILE^DIE("","FDA")
|
|---|
| 21 | L -^XTV(8989.3,1,"SID")
|
|---|
| 22 | Q
|
|---|
| 23 | ;
|
|---|
| 24 | SSID(SID) ;Set the SID into KSP.
|
|---|
| 25 | N FDA
|
|---|
| 26 | S FDA(8989.3,"1,",502)=SID,FDA(8989.3,"1,",503)="@"
|
|---|
| 27 | L +^XTV(8989.3,1,"SID"):2
|
|---|
| 28 | D FILE^DIE("","FDA")
|
|---|
| 29 | L -^XTV(8989.3,1,"SID")
|
|---|
| 30 | Q
|
|---|
| 31 | ASK ;Ask user if this is prod.
|
|---|
| 32 | N DIR,P S P=$$PROD
|
|---|
| 33 | S DIR(0)="YO",DIR("A")="Is this a Production Account",DIR("B")="No"
|
|---|
| 34 | S DIR("A",1)=""
|
|---|
| 35 | S DIR("A",2)="This is now a "_$S(P:"PRODUCTION",1:"TEST")_" account."
|
|---|
| 36 | S DIR("A",3)=" "
|
|---|
| 37 | S DIR("A",4)="Only answer YES if this is the full time Production Account."
|
|---|
| 38 | S DIR("A",5)="Answer No for all other accounts."
|
|---|
| 39 | D ^DIR Q:$D(DIRUT)
|
|---|
| 40 | I Y=1 D SSID($$SID^%ZOSV)
|
|---|
| 41 | E D SSID("2~TEST~999")
|
|---|
| 42 | S P=$$PROD
|
|---|
| 43 | W:P !!,"This is now a PRODUCTION account.",! W:'P !!,"This is now a TEST account.",!
|
|---|
| 44 | Q
|
|---|
| 45 | ;
|
|---|
| 46 | EDIT ;Edit Logical - Physical fields
|
|---|
| 47 | N DIE,DA,DR
|
|---|
| 48 | W !!,"This is only valid in a Cache v5.2 client/server configuration."
|
|---|
| 49 | W !,"This lets you edit the fields that support the"
|
|---|
| 50 | W !,"LOGICAL to PHYSICAL translation for the System ID.",!!
|
|---|
| 51 | S DA=1,DIE="^XTV(8989.3,",DR="504;505" D ^DIE
|
|---|
| 52 | Q
|
|---|
