Changeset 623 for WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUPROD.m

Timestamp:

Dec 4, 2009, 12:11:15 AM (14 years ago)

Author:

George Lilly

Message:

revised back to 6/30/08 version

File:

• WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUPROD.m (modified) (1 diff)

WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XUPROD.m

@@ -1 @@
-XUPROD  ;ISF/RWF - Is this a PROD account. ;8/23/07  16:47
-        ;;8.0;KERNEL;**284,440**;Jul 10, 1995;Build 13
-        ;
-        ;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 S P=$$PROD
-        S DIR(0)="YO",DIR("A")="Is this a Production Account",DIR("B")="No"
-        S DIR("A",1)=""
-        S DIR("A",2)="This is now 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."
-        D ^DIR Q:$D(DIRUT)
-        I Y=1 D SSID($$SID^%ZOSV)
-        E  D SSID("2~TEST~999")
-        S P=$$PROD
-        W:P !!,"This is now a PRODUCTION account.",! W:'P !!,"This is now a TEST account.",!
-        Q
-        ;
-EDIT    ;Edit Logical - Physical fields
-        N DIE,DA,DR
-        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
-        Q
+XUPROD ;ISF/RWF - Is this a PROD account. ;06/17/2004  08:13
+ ;;8.0;KERNEL;**284**;Jul 10, 1995
+ ;
+ ;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 S P=$$PROD
+ S DIR(0)="YO",DIR("A")="Is this a Production Account",DIR("B")="No"
+ S DIR("A",1)="This is now a "_$S(P:"PRODUCTION",1:"TEST")_" account."
+ S DIR("A",2)=" "
+ S DIR("A",3)="Only answer YES if this is the full time Production Account."
+ S DIR("A",4)="Answer No for all other accounts."
+ D ^DIR Q:$D(DIRUT)
+ I Y=1 D SSID($$SID^%ZOSV)
+ E  D SSID("2~TEST~999")
+ S P=$$PROD
+ W:P !!,"This is now a PRODUCTION account.",! W:'P !!,"This is now a TEST account.",!
+ Q