Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XUPROD

XUPROD.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ;IA# 4440
  1. PROD(FORCE) ;Return 1 if this is a production account
  1. ;A non-zero flag will force a real check
  1. ;This call just checks a flag in the KSP, Other code will compair
  1. ;with registered ID.
  1. N LC,SID
  1. S SID=$G(^XTV(8989.3,1,"SID"))
  1. I '$L($P(SID,"^",3))!($P(SID,"^",3)'=$G(DT))!$G(FORCE) D
  1. . D CHECK S SID=$G(^XTV(8989.3,1,"SID"))
  1. Q +$P(SID,"^",1)
  1. ;
  1. CHECK ;Check if SID matched stored value, Set field 501
  1. N CSID,SSID,FDA
  1. L +^XTV(8989.3,1,"SID"):2
  1. S CSID=$$SID^%ZOSV,SSID=$P($G(^XTV(8989.3,1,"SID")),"^",2)
  1. S FDA(8989.3,"1,",501)=(CSID=SSID),FDA(8989.3,"1,",503)=$$DT^XLFDT
  1. D FILE^DIE("","FDA")
  1. L -^XTV(8989.3,1,"SID")
  1. Q
  1. ;
  1. SSID(SID) ;Set the SID into KSP.
  1. N FDA
  1. S FDA(8989.3,"1,",502)=SID,FDA(8989.3,"1,",503)="@"
  1. L +^XTV(8989.3,1,"SID"):2
  1. D FILE^DIE("","FDA")
  1. L -^XTV(8989.3,1,"SID")
  1. Q
  1. ASK ;Ask user if this is prod.
  1. N DIR,P,P2,T,Y S P=$$PROD
  1. S DIR(0)="YO",DIR("A")="Is this a Production Account",DIR("B")=$S(P:"Yes",1:"No")
  1. S DIR("A",1)=""
  1. S DIR("A",2)="This is currently a "_$S(P:"PRODUCTION",1:"TEST")_" account."
  1. S DIR("A",3)=" "
  1. S DIR("A",4)="Only answer YES if this is the full time Production Account."
  1. S DIR("A",5)="Answer No for all other accounts.",DIR("A",6)=""
  1. D ^DIR S T=Y Q:$D(DIRUT)
  1. K DIR
  1. S DIR(0)="YO"
  1. S DIR("A",1)="",DIR("A",2)="Are you sure you want to change from a "_$S(P:"PRODUCTION",1:"TEST")_" account"
  1. S DIR("A")="to a "_$S(Y:"PRODUCTION",1:"TEST")_" account",DIR("B")="No"
  1. D:P'=Y ^DIR
  1. I Y=1 D SSID($$SID^%ZOSV):T=1,SSID("2~TEST~999"):T=0
  1. S P2=$$PROD
  1. W !!,"This is "_$S(P=P2:"still",1:"now")_" a "_$S(P2:"PRODUCTION",1:"TEST")_" account.",!
  1. Q
  1. ;
  1. EDIT ;Edit Logical - Physical fields
  1. N DIE,DA,DR
  1. L +^XTV(8989.3,1,"SID"):$G(DILOCKTM,5) E W !,"Busy, Please try again later.",! Q ;p542
  1. W !!,"This is only valid in a Cache v5.2 client/server configuration."
  1. W !,"This lets you edit the fields that support the"
  1. W !,"LOGICAL to PHYSICAL translation for the System ID.",!!
  1. S DA=1,DIE="^XTV(8989.3,",DR="504;505" D ^DIE
  1. L -^XTV(8989.3,1,"SID")
  1. Q