XUINEND ;SF-ISC/STAFF - Post Install for KERNEL V8.0 ;04/24/95 10:36
;;8.0;KERNEL;;Jul 10, 1995
;setup checkpoints for KIDS
N %
S %=$$NEWCP^XPDUTL("POST1","SITE^XUINEND"),%=$$NEWCP^XPDUTL("POST2","ALERT^XUINEND")
S %=$$NEWCP^XPDUTL("POST3","ALPHA^XUINEND"),%=$$NEWCP^XPDUTL("POST4","SCHED^XUINEND")
S %=$$NEWCP^XPDUTL("POST5","XUF^XUINEND"),%=$$NEWCP^XPDUTL("POST6","PARAM^XUINEND")
S %=$$NEWCP^XPDUTL("POST7","NPF^XUINEND"),%=$$NEWCP^XPDUTL("POST8","HELP^XUINEND")
Q
SITE N %,DA,DIC,DIK,XUNEW
;See that postmaster has an entry in file 200.
I '$D(^VA(200,.5,0)) D
. S ^DIC(3,.5,0)="POSTMASTER^^^^^^^^^^^^^^^.5",^DIC(16,.5,0)="POSTMASTER",^("A3")=.5
. S ^VA(200,.5,0)="POSTMASTER",DIK="^VA(200,",DA=.5
. D IX1^DIK
. Q
D MES^XPDUTL(" Move KERNEL site parameters.")
I $D(^XTV(8989.3,1,0)),$G(^XTV(8989.3,1,4,0))'[8989 K ^XTV(8989.3,1)
Q:$D(^XTV(8989.3,1))
;S XUNEW="+?1," D TRNMRG^DIT("OX",4.3,8989.3,"1,",.XUNEW)
;Merge and set count
M ^XTV(8989.3,1)=^XMB(1,1) S $P(^XTV(8989.3,0),U,3,4)="1^1"
;kill the Mailman Purge date information
K ^XTV(8989.3,1,.1)
S I=0 F S I=$O(^XTV(8989.3,1,I)) Q:I="" D:$D(^(I,0))
.S J=+$O(^DD(8989.3,"GL",I,0,0))
.Q:'$D(^DD(8989.3,J,0)) S K=$P(^(0),U,2)
.I K,$D(^DD(+K,.01,0)),$P(^(0),U,2)'["W" S $P(^XTV(8989.3,1,I,0),U,2)=K
S $P(%,U,17)=$P($G(^XMB(1,1,"XUS")),U,17),^XMB(1,1,"XUS")=% ;delete all but default inst.
K ^XMB(1,1,"INTRO") ;Remove Intro text
Q
;
ALERT N I,X,Y
D MES^XPDUTL(" Moving ALERTS from file 200 to file 8992 ...")
F I=0:0 S I=$O(^VA(200,I)) Q:I'>0 D
. I $O(^VA(200,I,"XQA",0))>0 D
. . I '$D(^XTV(8992,I)) S X="`"_I D
. . . N I,DIC,DLAYGO
. . . S DIC="^XTV(8992,",DIC(0)="L",DLAYGO=8992 D ^DIC
. . M ^XTV(8992,I,"XQA")=^VA(200,I,"XQA")
. K ^VA(200,I,"XQA")
M ^XTV(8992,"AXQA")=^VA(200,"AXQA") K ^VA(200,"AXQA")
M ^XTV(8992,"AXQAN")=^VA(200,"AXQAN") K ^VA(200,"AXQAN")
S I="" F S I=$O(^XTV(8992,"AXQA",I)) Q:I'>0 K ^(I,0,0)
Q
;
ALPHA N DA,DIK
D MES^XPDUTL(" Delete CPU field from alpha/beta test sites")
I $P($G(^DD(3.5,1.92,0)),"^")="CPU" S DIK="^DD(3.5,",DA=1.92,DA(1)=3.5 D ^DIK ;Delete CPU field from alpha/beta test sites.
Q
;
SCHED D MES^XPDUTL(" Option Scheduling conversion."),^XUINTSK
Q
OPT N D0,DIK
D MES^XPDUTL(" Reindex Entry/Exit Actions in Option file.")
F D0=0:0 S D0=$O(^DIC(19,D0)) Q:D0'>0 I '$D(^(D0,0)) K ^DIC(19,D0)
S DIK="^DIC(19,",DIK(1)="15^1" D ENALL^DIK
K DIK S DIK="^DIC(19,",DIK(1)="20^1" D ENALL^DIK
Q
;
XUF N DIU,DIK,XU1
D MES^XPDUTL(" Check and clean out XUFILE if not running FOF.")
I '$D(^VA(200,"AFOF")) D DISABLE^XUFILE3
Q
;
PARAM N IX
D MES^XPDUTL(" Load PARAM file")
F IX="XUEDIT CHARACTERISTICS","XUNEW USER","XUSER COMPUTER ACCOUNT","XUREACT USER","XUEXISTING USER" I $$GET^XUPARAM(IX,"V")="" D SET^XUPARAM(IX,"")
MES D MES^XPDUTL($C(7)_"TO PROTECT THE SECURITY OF DHCP SYSTEMS, DISTRIBUTION OF THIS")
D MES^XPDUTL("SOFTWARE FOR USE ON ANY OTHER COMPUTER SYSTEM IS PROHIBITED.")
D MES^XPDUTL("ALL REQUESTS FOR COPIES OF THE KERNEL FOR NON-DHCP USE SHOULD")
D MES^XPDUTL("BE REFERRED TO YOUR LOCAL ISC.")
Q
;
NPF ;Re-build the Nickname D X-ref.
N DA,DIK K ^VA(200,"D")
S DIK="^VA(200,",DIK(1)="13^1" D ENALL^DIK
Q
REMOXY ;Remove OLD XYCRT FIELD FROM TERMINAL TYPE FILE.
N DA,DIK
D MES^XPDUTL("Removing trigger from XY CRT field(#5.2) of the TERMINAL TYPE FILE(#3.2)"_$C(7,7))
S DIK="^DD(3.2,5.2,1,",DA=1,DA(1)=5.2,DA(2)=3.2 D ^DIK
K DA,DIK
D MES^XPDUTL("Removing data from the *OLD XY CRT field(#5) of the TERMINAL TYPE file(#3.2)"_$C(7,7))
F DA=0:0 S DA=$O(^%ZIS(2,DA)) Q:DA'>0 I $D(^(DA,1))#2 S $P(^(1),"^",5)=""
K DA
D MES^XPDUTL("Removing the *OLD XY CRT field(#5) from the TERMINAL TYPE file(#3.2)"_$C(7,7))
S DIK="^DD(3.2,",DA=5,DA(1)=3.2 D ^DIK
Q
HELP ;re-index help frame file
N DA,DIK,XPDI S XPDI=0
F S XPDI=$O(^DIC(9.2,XPDI)) Q:'XPDI D
.S DA(1)=XPDI,DIK="^DIC(9.2,"_XPDI_",2,",DIK(1)="1^1"
.D ENALL^DIK
Q
;
A27 ;D MES^XPDUTL("At A27, Calling XUINEACH") D ^XUINEACH ;EACH CPU CODE.
;
;
A23 D MES^XPDUTL($C(7,7)_"Now to edit the Kernel Site Parameters."_$C(7))
I '$D(^XTV(8989.3,1,1,0)) W !,"Please select a name for this site" S DIC="^XTV(8989.3,1,",DIC(0)="AEMQL" D ^DIC I Y<1 W *7,"YOU MUST SELECT ONE" G A23
S DIE="^XTV(8989.3,1,",DA=1,DR="[XU KSP INIT]" D ^DIE
A25 W !,"Now to EDIT selectable terminal types for sign-on"
F IX=0:0 S DIC="^%ZIS(2,",DIC(0)="AEMQ" D ^DIC Q:Y'>0 S DIE=DIC,DA=+Y,DR=.02 D ^DIE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUINEND 4510 printed Nov 22, 2024@17:19:49 Page 2
XUINEND ;SF-ISC/STAFF - Post Install for KERNEL V8.0 ;04/24/95 10:36
+1 ;;8.0;KERNEL;;Jul 10, 1995
+2 ;setup checkpoints for KIDS
+3 NEW %
+4 SET %=$$NEWCP^XPDUTL("POST1","SITE^XUINEND")
SET %=$$NEWCP^XPDUTL("POST2","ALERT^XUINEND")
+5 SET %=$$NEWCP^XPDUTL("POST3","ALPHA^XUINEND")
SET %=$$NEWCP^XPDUTL("POST4","SCHED^XUINEND")
+6 SET %=$$NEWCP^XPDUTL("POST5","XUF^XUINEND")
SET %=$$NEWCP^XPDUTL("POST6","PARAM^XUINEND")
+7 SET %=$$NEWCP^XPDUTL("POST7","NPF^XUINEND")
SET %=$$NEWCP^XPDUTL("POST8","HELP^XUINEND")
+8 QUIT
SITE NEW %,DA,DIC,DIK,XUNEW
+1 ;See that postmaster has an entry in file 200.
+2 IF '$DATA(^VA(200,.5,0))
Begin DoDot:1
+3 SET ^DIC(3,.5,0)="POSTMASTER^^^^^^^^^^^^^^^.5"
SET ^DIC(16,.5,0)="POSTMASTER"
SET ^("A3")=.5
+4 SET ^VA(200,.5,0)="POSTMASTER"
SET DIK="^VA(200,"
SET DA=.5
+5 DO IX1^DIK
+6 QUIT
End DoDot:1
+7 DO MES^XPDUTL(" Move KERNEL site parameters.")
+8 IF $DATA(^XTV(8989.3,1,0))
IF $GET(^XTV(8989.3,1,4,0))'[8989
KILL ^XTV(8989.3,1)
+9 if $DATA(^XTV(8989.3,1))
QUIT
+10 ;S XUNEW="+?1," D TRNMRG^DIT("OX",4.3,8989.3,"1,",.XUNEW)
+11 ;Merge and set count
+12 MERGE ^XTV(8989.3,1)=^XMB(1,1)
SET $PIECE(^XTV(8989.3,0),U,3,4)="1^1"
+13 ;kill the Mailman Purge date information
+14 KILL ^XTV(8989.3,1,.1)
+15 SET I=0
FOR
SET I=$ORDER(^XTV(8989.3,1,I))
if I=""
QUIT
if $DATA(^(I,0))
Begin DoDot:1
+16 SET J=+$ORDER(^DD(8989.3,"GL",I,0,0))
+17 if '$DATA(^DD(8989.3,J,0))
QUIT
SET K=$PIECE(^(0),U,2)
+18 IF K
IF $DATA(^DD(+K,.01,0))
IF $PIECE(^(0),U,2)'["W"
SET $PIECE(^XTV(8989.3,1,I,0),U,2)=K
End DoDot:1
+19 ;delete all but default inst.
SET $PIECE(%,U,17)=$PIECE($GET(^XMB(1,1,"XUS")),U,17)
SET ^XMB(1,1,"XUS")=%
+20 ;Remove Intro text
KILL ^XMB(1,1,"INTRO")
+21 QUIT
+22 ;
ALERT NEW I,X,Y
+1 DO MES^XPDUTL(" Moving ALERTS from file 200 to file 8992 ...")
+2 FOR I=0:0
SET I=$ORDER(^VA(200,I))
if I'>0
QUIT
Begin DoDot:1
+3 IF $ORDER(^VA(200,I,"XQA",0))>0
Begin DoDot:2
+4 IF '$DATA(^XTV(8992,I))
SET X="`"_I
Begin DoDot:3
+5 NEW I,DIC,DLAYGO
+6 SET DIC="^XTV(8992,"
SET DIC(0)="L"
SET DLAYGO=8992
DO ^DIC
End DoDot:3
+7 MERGE ^XTV(8992,I,"XQA")=^VA(200,I,"XQA")
End DoDot:2
+8 KILL ^VA(200,I,"XQA")
End DoDot:1
+9 MERGE ^XTV(8992,"AXQA")=^VA(200,"AXQA")
KILL ^VA(200,"AXQA")
+10 MERGE ^XTV(8992,"AXQAN")=^VA(200,"AXQAN")
KILL ^VA(200,"AXQAN")
+11 SET I=""
FOR
SET I=$ORDER(^XTV(8992,"AXQA",I))
if I'>0
QUIT
KILL ^(I,0,0)
+12 QUIT
+13 ;
ALPHA NEW DA,DIK
+1 DO MES^XPDUTL(" Delete CPU field from alpha/beta test sites")
+2 ;Delete CPU field from alpha/beta test sites.
IF $PIECE($GET(^DD(3.5,1.92,0)),"^")="CPU"
SET DIK="^DD(3.5,"
SET DA=1.92
SET DA(1)=3.5
DO ^DIK
+3 QUIT
+4 ;
SCHED DO MES^XPDUTL(" Option Scheduling conversion.")
DO ^XUINTSK
+1 QUIT
OPT NEW D0,DIK
+1 DO MES^XPDUTL(" Reindex Entry/Exit Actions in Option file.")
+2 FOR D0=0:0
SET D0=$ORDER(^DIC(19,D0))
if D0'>0
QUIT
IF '$DATA(^(D0,0))
KILL ^DIC(19,D0)
+3 SET DIK="^DIC(19,"
SET DIK(1)="15^1"
DO ENALL^DIK
+4 KILL DIK
SET DIK="^DIC(19,"
SET DIK(1)="20^1"
DO ENALL^DIK
+5 QUIT
+6 ;
XUF NEW DIU,DIK,XU1
+1 DO MES^XPDUTL(" Check and clean out XUFILE if not running FOF.")
+2 IF '$DATA(^VA(200,"AFOF"))
DO DISABLE^XUFILE3
+3 QUIT
+4 ;
PARAM NEW IX
+1 DO MES^XPDUTL(" Load PARAM file")
+2 FOR IX="XUEDIT CHARACTERISTICS","XUNEW USER","XUSER COMPUTER ACCOUNT","XUREACT USER","XUEXISTING USER"
IF $$GET^XUPARAM(IX,"V")=""
DO SET^XUPARAM(IX,"")
MES DO MES^XPDUTL($CHAR(7)_"TO PROTECT THE SECURITY OF DHCP SYSTEMS, DISTRIBUTION OF THIS")
+1 DO MES^XPDUTL("SOFTWARE FOR USE ON ANY OTHER COMPUTER SYSTEM IS PROHIBITED.")
+2 DO MES^XPDUTL("ALL REQUESTS FOR COPIES OF THE KERNEL FOR NON-DHCP USE SHOULD")
+3 DO MES^XPDUTL("BE REFERRED TO YOUR LOCAL ISC.")
+4 QUIT
+5 ;
NPF ;Re-build the Nickname D X-ref.
+1 NEW DA,DIK
KILL ^VA(200,"D")
+2 SET DIK="^VA(200,"
SET DIK(1)="13^1"
DO ENALL^DIK
+3 QUIT
REMOXY ;Remove OLD XYCRT FIELD FROM TERMINAL TYPE FILE.
+1 NEW DA,DIK
+2 DO MES^XPDUTL("Removing trigger from XY CRT field(#5.2) of the TERMINAL TYPE FILE(#3.2)"_$CHAR(7,7))
+3 SET DIK="^DD(3.2,5.2,1,"
SET DA=1
SET DA(1)=5.2
SET DA(2)=3.2
DO ^DIK
+4 KILL DA,DIK
+5 DO MES^XPDUTL("Removing data from the *OLD XY CRT field(#5) of the TERMINAL TYPE file(#3.2)"_$CHAR(7,7))
+6 FOR DA=0:0
SET DA=$ORDER(^%ZIS(2,DA))
if DA'>0
QUIT
IF $DATA(^(DA,1))#2
SET $PIECE(^(1),"^",5)=""
+7 KILL DA
+8 DO MES^XPDUTL("Removing the *OLD XY CRT field(#5) from the TERMINAL TYPE file(#3.2)"_$CHAR(7,7))
+9 SET DIK="^DD(3.2,"
SET DA=5
SET DA(1)=3.2
DO ^DIK
+10 QUIT
HELP ;re-index help frame file
+1 NEW DA,DIK,XPDI
SET XPDI=0
+2 FOR
SET XPDI=$ORDER(^DIC(9.2,XPDI))
if 'XPDI
QUIT
Begin DoDot:1
+3 SET DA(1)=XPDI
SET DIK="^DIC(9.2,"_XPDI_",2,"
SET DIK(1)="1^1"
+4 DO ENALL^DIK
End DoDot:1
+5 QUIT
+6 ;
A27 ;D MES^XPDUTL("At A27, Calling XUINEACH") D ^XUINEACH ;EACH CPU CODE.
+1 ;
+2 ;
A23 DO MES^XPDUTL($CHAR(7,7)_"Now to edit the Kernel Site Parameters."_$CHAR(7))
+1 IF '$DATA(^XTV(8989.3,1,1,0))
WRITE !,"Please select a name for this site"
SET DIC="^XTV(8989.3,1,"
SET DIC(0)="AEMQL"
DO ^DIC
IF Y<1
WRITE *7,"YOU MUST SELECT ONE"
GOTO A23
+2 SET DIE="^XTV(8989.3,1,"
SET DA=1
SET DR="[XU KSP INIT]"
DO ^DIE
A25 WRITE !,"Now to EDIT selectable terminal types for sign-on"
+1 FOR IX=0:0
SET DIC="^%ZIS(2,"
SET DIC(0)="AEMQ"
DO ^DIC
if Y'>0
QUIT
SET DIE=DIC
SET DA=+Y
SET DR=.02
DO ^DIE
+2 QUIT
