XPDCPU ;SFISC/RWF,RSD - Code that update each cpu ;09/09/96 08:01
;;8.0;KERNEL;**41,44**;Jul 03, 1995
N DIC,X,XPDA
S DIC("S")="I $P(^(0),U,9)=2,$D(^XPD(9.7,""ASP"",Y,1,Y)),$D(^XTMP(""XPDI"",Y))"
D EN1 Q:'XPDA
S X=$O(^XPD(9.7,XPDA,"VOL","B",^%ZOSF("VOL"),0)) Q:'X
D EN(XPDA,X)
Q
;
MOVE ;move routines to other CPU
N DIC,DIR,DIRUT,X,XPDA,XPDJ,Y
S DIC("S")="I $P(^(0),U,9)=3"
D EN1 Q:'XPDA
S DIR(0)="Y",DIR("A")="Want to move the Routine for this Package to another CPU",DIR("B")="YES",DIR("?")="YES means you want to update the routines on another CPU"
D ^DIR Q:'Y!$D(DIRUT)
K ^XTMP("XPDR",XPDA)
S ^XTMP("XPDR",0)=DT_U_DT,XPDJ=""
F S XPDJ=$O(^XPD(9.7,XPDA,"RTN","B",XPDJ)) Q:XPDJ="" D
.Q:XPDJ="XPDCPU"
.N DIF,XCNP,%N
.S DIF="^XTMP(""XPDR"",XPDA,""RTN"",XPDJ,",XCNP=0,X=XPDJ
.X ^%ZOSF("LOAD")
I $D(^XTMP("XPDR",XPDA)) W !!,"Run INSTALL^XPDCPU on the other CPU to install the Routines.",!
Q
INSTALL ;install routines
N DIC,DIR,DIRUT,X,XPDA,XPDJ,Y
S DIC("S")="I $P(^(0),U,9)=3,$D(^XTMP(""XPDR"",Y))"
D EN1 Q:'XPDA
S DIR(0)="Y",DIR("A")="Want to install the Routine for this Package",DIR("B")="YES",DIR("?")="YES means you want to install the routines on this CPU"
D ^DIR Q:'Y!$D(DIRUT)
S XPDJ=""
F S XPDJ=$O(^XTMP("XPDR",XPDA,"RTN",XPDJ)) Q:XPDJ="" D
.N %,DIE,XCM,XCN,XCS
.S DIE="^XTMP(""XPDR"",XPDA,""RTN"",XPDJ,",XCN=0,X=XPDJ
.X ^%ZOSF("SAVE")
W !!,"Done",!!
Q
;
EN(XPDA,XPDVDA) ;XPDA=ien of INSTALL file, XPDVDA=VOLUME SET ien
L +^XPD(9.7,XPDA,"VOL",XPDVDA):2 E W:IO]"" !,"Can't Lock global, another XPDCPU must be running",! Q
N Y,%,XPDNM
S Y=0,ZTREQ="@"
F S Y=$O(^XPD(9.7,"ASP",XPDA,Y)) Q:'Y S %=$O(^(Y,0)) D:% Q:$D(XPDABORT)
.N XPDA,Y
.S XPDA=%,XPDNM=$P($G(^XPD(9.7,XPDA,0)),U) D EN2
Q
EN1 ;ask for Install
N Y S XPDA=0
I $D(DUZ)_$D(DUZ(0))_$D(U)[0 D DT^DICRW
S DIC(0)="QEAMZ",DIC="^XPD(9.7,"
D ^DIC K DIC Q:Y'>0
S XPDA=+Y
Q
EN2 N X,XPD,XPDBLD,XPDI,ZTUCI,ZTCPU,ZTRTN,ZTDTH,ZTIO,ZTDESC
;must have XTMP & entry in file 9.7
Q:'$D(^XTMP("XPDI",XPDA))!'$D(^XPD(9.7,XPDA,0))
;hang 1 hr or until VOLUME multiple is set, XPDIJ sets VOL multiple
F X=0:1:60 Q:$D(^XPD(9.7,XPDA,"VOL",+$G(XPDVDA),0)) H 60 W:IO]"" "."
I X=60 W:IO]"" !!,"Package ",$P(^XPD(9.7,XPDA,0),U)," never installed",! Q
S XPDBLD=$O(^XTMP("XPDI",XPDA,"BLD",0))
D FILE(2),UPDT
W:IO]"" !,"Loading Routines"
I $D(^XTMP("XPDI",XPDA,"RTN","XPDCPU")) S X=$$RTNUP^XPDUTL("XPDCPU",2)
;make sure routines have been loaded
F X=0:1:240 Q:$P($G(^XPD(9.7,XPDA,1)),U,2) H 15 W:IO]"" "." D UPDT
D UPDT,RTN^XPDIJ(XPDA),UPDT
W:IO]"" !!,"Recompiling Template routines"
F XPD="DIKZ","DIEZ","DIPZ" D
.S XPDI="" Q:'$$CHCK
.F S XPDI=$O(^XTMP("XPDI",XPDA,XPD,XPDI)) Q:'XPDI S X=^(XPDI) D:X]"" @("EN2^"_XPD_"("""_XPDI_""","""","""_X_""")"),UPDT
D UPDT,FILE(1)
Q
CHCK() ;check if the component is installed, return 1 if installed, 0 to abort
N XPDC,Y
I XPD="DIKZ" S XPDC="S Y=$G(^(+$O(^XPD(9.7,XPDA,4,""A""),-1),0))"
E S Y=$S(XPD="DIPZ":.4,1:.402),XPDC="S Y=$G(^XPD(9.7,XPDA,""KRN"","_Y_",0))"
F X XPDC Q:'Y!$P(Y,U,2) H 60 D UPDT W:IO]"" "." I $D(ZTMQUE),$$STOP^%ZTLOAD S Y=0 Q
Q ''Y
FILE(XPDF) ;set NOW into the VOLUME SET multiple, XPDF=field number
N XPD
S XPD(9.703,XPDVDA_","_XPDA_",",XPDF)=$$NOW^XLFDT
D FILE^DIE("","XPD")
Q
UPDT ;update $H into VOLUME SET multiple, field 4
S ^XPD(9.7,XPDA,"VOL",XPDVDA,1)=$H
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXPDCPU 3433 printed Dec 13, 2024@02:03:18 Page 2
XPDCPU ;SFISC/RWF,RSD - Code that update each cpu ;09/09/96 08:01
+1 ;;8.0;KERNEL;**41,44**;Jul 03, 1995
+2 NEW DIC,X,XPDA
+3 SET DIC("S")="I $P(^(0),U,9)=2,$D(^XPD(9.7,""ASP"",Y,1,Y)),$D(^XTMP(""XPDI"",Y))"
+4 DO EN1
if 'XPDA
QUIT
+5 SET X=$ORDER(^XPD(9.7,XPDA,"VOL","B",^%ZOSF("VOL"),0))
if 'X
QUIT
+6 DO EN(XPDA,X)
+7 QUIT
+8 ;
MOVE ;move routines to other CPU
+1 NEW DIC,DIR,DIRUT,X,XPDA,XPDJ,Y
+2 SET DIC("S")="I $P(^(0),U,9)=3"
+3 DO EN1
if 'XPDA
QUIT
+4 SET DIR(0)="Y"
SET DIR("A")="Want to move the Routine for this Package to another CPU"
SET DIR("B")="YES"
SET DIR("?")="YES means you want to update the routines on another CPU"
+5 DO ^DIR
if 'Y!$DATA(DIRUT)
QUIT
+6 KILL ^XTMP("XPDR",XPDA)
+7 SET ^XTMP("XPDR",0)=DT_U_DT
SET XPDJ=""
+8 FOR
SET XPDJ=$ORDER(^XPD(9.7,XPDA,"RTN","B",XPDJ))
if XPDJ=""
QUIT
Begin DoDot:1
+9 if XPDJ="XPDCPU"
QUIT
+10 NEW DIF,XCNP,%N
+11 SET DIF="^XTMP(""XPDR"",XPDA,""RTN"",XPDJ,"
SET XCNP=0
SET X=XPDJ
+12 XECUTE ^%ZOSF("LOAD")
End DoDot:1
+13 IF $DATA(^XTMP("XPDR",XPDA))
WRITE !!,"Run INSTALL^XPDCPU on the other CPU to install the Routines.",!
+14 QUIT
INSTALL ;install routines
+1 NEW DIC,DIR,DIRUT,X,XPDA,XPDJ,Y
+2 SET DIC("S")="I $P(^(0),U,9)=3,$D(^XTMP(""XPDR"",Y))"
+3 DO EN1
if 'XPDA
QUIT
+4 SET DIR(0)="Y"
SET DIR("A")="Want to install the Routine for this Package"
SET DIR("B")="YES"
SET DIR("?")="YES means you want to install the routines on this CPU"
+5 DO ^DIR
if 'Y!$DATA(DIRUT)
QUIT
+6 SET XPDJ=""
+7 FOR
SET XPDJ=$ORDER(^XTMP("XPDR",XPDA,"RTN",XPDJ))
if XPDJ=""
QUIT
Begin DoDot:1
+8 NEW %,DIE,XCM,XCN,XCS
+9 SET DIE="^XTMP(""XPDR"",XPDA,""RTN"",XPDJ,"
SET XCN=0
SET X=XPDJ
+10 XECUTE ^%ZOSF("SAVE")
End DoDot:1
+11 WRITE !!,"Done",!!
+12 QUIT
+13 ;
EN(XPDA,XPDVDA) ;XPDA=ien of INSTALL file, XPDVDA=VOLUME SET ien
+1 LOCK +^XPD(9.7,XPDA,"VOL",XPDVDA):2
IF '$TEST
if IO]""
WRITE !,"Can't Lock global, another XPDCPU must be running",!
QUIT
+2 NEW Y,%,XPDNM
+3 SET Y=0
SET ZTREQ="@"
+4 FOR
SET Y=$ORDER(^XPD(9.7,"ASP",XPDA,Y))
if 'Y
QUIT
SET %=$ORDER(^(Y,0))
if %
Begin DoDot:1
+5 NEW XPDA,Y
+6 SET XPDA=%
SET XPDNM=$PIECE($GET(^XPD(9.7,XPDA,0)),U)
DO EN2
End DoDot:1
if $DATA(XPDABORT)
QUIT
+7 QUIT
EN1 ;ask for Install
+1 NEW Y
SET XPDA=0
+2 IF $DATA(DUZ)_$DATA(DUZ(0))_$DATA(U)[0
DO DT^DICRW
+3 SET DIC(0)="QEAMZ"
SET DIC="^XPD(9.7,"
+4 DO ^DIC
KILL DIC
if Y'>0
QUIT
+5 SET XPDA=+Y
+6 QUIT
EN2 NEW X,XPD,XPDBLD,XPDI,ZTUCI,ZTCPU,ZTRTN,ZTDTH,ZTIO,ZTDESC
+1 ;must have XTMP & entry in file 9.7
+2 if '$DATA(^XTMP("XPDI",XPDA))!'$DATA(^XPD(9.7,XPDA,0))
QUIT
+3 ;hang 1 hr or until VOLUME multiple is set, XPDIJ sets VOL multiple
+4 FOR X=0:1:60
if $DATA(^XPD(9.7,XPDA,"VOL",+$GET(XPDVDA),0))
QUIT
HANG 60
if IO]""
WRITE "."
+5 IF X=60
if IO]""
WRITE !!,"Package ",$PIECE(^XPD(9.7,XPDA,0),U)," never installed",!
QUIT
+6 SET XPDBLD=$ORDER(^XTMP("XPDI",XPDA,"BLD",0))
+7 DO FILE(2)
DO UPDT
+8 if IO]""
WRITE !,"Loading Routines"
+9 IF $DATA(^XTMP("XPDI",XPDA,"RTN","XPDCPU"))
SET X=$$RTNUP^XPDUTL("XPDCPU",2)
+10 ;make sure routines have been loaded
+11 FOR X=0:1:240
if $PIECE($GET(^XPD(9.7,XPDA,1)),U,2)
QUIT
HANG 15
if IO]""
WRITE "."
DO UPDT
+12 DO UPDT
DO RTN^XPDIJ(XPDA)
DO UPDT
+13 if IO]""
WRITE !!,"Recompiling Template routines"
+14 FOR XPD="DIKZ","DIEZ","DIPZ"
Begin DoDot:1
+15 SET XPDI=""
if '$$CHCK
QUIT
+16 FOR
SET XPDI=$ORDER(^XTMP("XPDI",XPDA,XPD,XPDI))
if 'XPDI
QUIT
SET X=^(XPDI)
if X]""
DO @("EN2^"_XPD_"("""_XPDI_""","""","""_X_""")")
DO UPDT
End DoDot:1
+17 DO UPDT
DO FILE(1)
+18 QUIT
CHCK() ;check if the component is installed, return 1 if installed, 0 to abort
+1 NEW XPDC,Y
+2 IF XPD="DIKZ"
SET XPDC="S Y=$G(^(+$O(^XPD(9.7,XPDA,4,""A""),-1),0))"
+3 IF '$TEST
SET Y=$SELECT(XPD="DIPZ":.4,1:.402)
SET XPDC="S Y=$G(^XPD(9.7,XPDA,""KRN"","_Y_",0))"
+4 FOR
XECUTE XPDC
if 'Y!$PIECE(Y,U,2)
QUIT
HANG 60
DO UPDT
if IO]""
WRITE "."
IF $DATA(ZTMQUE)
IF $$STOP^%ZTLOAD
SET Y=0
QUIT
+5 QUIT ''Y
FILE(XPDF) ;set NOW into the VOLUME SET multiple, XPDF=field number
+1 NEW XPD
+2 SET XPD(9.703,XPDVDA_","_XPDA_",",XPDF)=$$NOW^XLFDT
+3 DO FILE^DIE("","XPD")
+4 QUIT
UPDT ;update $H into VOLUME SET multiple, field 4
+1 SET ^XPD(9.7,XPDA,"VOL",XPDVDA,1)=$HOROLOG
+2 QUIT
