source: 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/XPDCPU.m@ 846

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