XPDCPU.m

XPDCPU ;SFISC/RWF,RSD - Code that update each cpu ;09/09/96  08:01 [ 04/02/2003   8:29 AM ]

 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 ;;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

XPDCPU    ;SFISC/RWF,RSD - Code that update each cpu ;09/09/96  08:01 [ 04/02/2003   8:29 AM ]

 +1       ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 +2       ;;8.0;KERNEL;**41,44**;JUL 03, 1995

 +3        NEW DIC,X,XPDA

 +4        SET DIC("S")="I $P(^(0),U,9)=2,$D(^XPD(9.7,""ASP"",Y,1,Y)),$D(^XTMP(""XPDI"",Y))"

 +5        DO EN1

           IF 'XPDA

               QUIT 

 +6        SET X=$ORDER(^XPD(9.7,XPDA,"VOL","B",^%ZOSF("VOL"),0))

           IF 'X

               QUIT 

 +7        DO EN(XPDA,X)

 +8        QUIT 

 +9       ;

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