XUPROD.m

XUPROD ;ISF/RWF - Is this a PROD account. ;04/12/10  14:04

 ;;8.0;KERNEL;**284,440,542**;Jul 10, 1995;Build 6

 ;

 ;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.

 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

XUPROD    ;ISF/RWF - Is this a PROD account. ;04/12/10  14:04

 +1       ;;8.0;KERNEL;**284,440,542**;Jul 10, 1995;Build 6

 +2       ;

 +3       ;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        NEW LC,SID

 +5        SET SID=$GET(^XTV(8989.3,1,"SID"))

 +6        IF '$LENGTH($PIECE(SID,"^",3))!($PIECE(SID,"^",3)'=$GET(DT))!$GET(FORCE)

               Begin DoDot:1

 +7                DO CHECK

                   SET SID=$GET(^XTV(8989.3,1,"SID"))

               End DoDot:1

 +8        QUIT +$PIECE(SID,"^",1)

 +9       ;

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