- 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