source: FOIAVistA/tag/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@ 1470

Last change on this file since 1470 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.3 KB
Line 
1XPDCPU ;SFISC/RWF,RSD - Code that update each cpu ;09/09/96 08:01
2 ;;8.0;KERNEL;**41,44**;Jul 03, 1995
3 N DIC,X,XPDA
4 S DIC("S")="I $P(^(0),U,9)=2,$D(^XPD(9.7,""ASP"",Y,1,Y)),$D(^XTMP(""XPDI"",Y))"
5 D EN1 Q:'XPDA
6 S X=$O(^XPD(9.7,XPDA,"VOL","B",^%ZOSF("VOL"),0)) Q:'X
7 D EN(XPDA,X)
8 Q
9 ;
10MOVE ;move routines to other CPU
11 N DIC,DIR,DIRUT,X,XPDA,XPDJ,Y
12 S DIC("S")="I $P(^(0),U,9)=3"
13 D EN1 Q:'XPDA
14 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"
15 D ^DIR Q:'Y!$D(DIRUT)
16 K ^XTMP("XPDR",XPDA)
17 S ^XTMP("XPDR",0)=DT_U_DT,XPDJ=""
18 F S XPDJ=$O(^XPD(9.7,XPDA,"RTN","B",XPDJ)) Q:XPDJ="" D
19 .Q:XPDJ="XPDCPU"
20 .N DIF,XCNP,%N
21 .S DIF="^XTMP(""XPDR"",XPDA,""RTN"",XPDJ,",XCNP=0,X=XPDJ
22 .X ^%ZOSF("LOAD")
23 I $D(^XTMP("XPDR",XPDA)) W !!,"Run INSTALL^XPDCPU on the other CPU to install the Routines.",!
24 Q
25INSTALL ;install routines
26 N DIC,DIR,DIRUT,X,XPDA,XPDJ,Y
27 S DIC("S")="I $P(^(0),U,9)=3,$D(^XTMP(""XPDR"",Y))"
28 D EN1 Q:'XPDA
29 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"
30 D ^DIR Q:'Y!$D(DIRUT)
31 S XPDJ=""
32 F S XPDJ=$O(^XTMP("XPDR",XPDA,"RTN",XPDJ)) Q:XPDJ="" D
33 .N %,DIE,XCM,XCN,XCS
34 .S DIE="^XTMP(""XPDR"",XPDA,""RTN"",XPDJ,",XCN=0,X=XPDJ
35 .X ^%ZOSF("SAVE")
36 W !!,"Done",!!
37 Q
38 ;
39EN(XPDA,XPDVDA) ;XPDA=ien of INSTALL file, XPDVDA=VOLUME SET ien
40 L +^XPD(9.7,XPDA,"VOL",XPDVDA):2 E W:IO]"" !,"Can't Lock global, another XPDCPU must be running",! Q
41 N Y,%,XPDNM
42 S Y=0,ZTREQ="@"
43 F S Y=$O(^XPD(9.7,"ASP",XPDA,Y)) Q:'Y S %=$O(^(Y,0)) D:% Q:$D(XPDABORT)
44 .N XPDA,Y
45 .S XPDA=%,XPDNM=$P($G(^XPD(9.7,XPDA,0)),U) D EN2
46 Q
47EN1 ;ask for Install
48 N Y S XPDA=0
49 I $D(DUZ)_$D(DUZ(0))_$D(U)[0 D DT^DICRW
50 S DIC(0)="QEAMZ",DIC="^XPD(9.7,"
51 D ^DIC K DIC Q:Y'>0
52 S XPDA=+Y
53 Q
54EN2 N X,XPD,XPDBLD,XPDI,ZTUCI,ZTCPU,ZTRTN,ZTDTH,ZTIO,ZTDESC
55 ;must have XTMP & entry in file 9.7
56 Q:'$D(^XTMP("XPDI",XPDA))!'$D(^XPD(9.7,XPDA,0))
57 ;hang 1 hr or until VOLUME multiple is set, XPDIJ sets VOL multiple
58 F X=0:1:60 Q:$D(^XPD(9.7,XPDA,"VOL",+$G(XPDVDA),0)) H 60 W:IO]"" "."
59 I X=60 W:IO]"" !!,"Package ",$P(^XPD(9.7,XPDA,0),U)," never installed",! Q
60 S XPDBLD=$O(^XTMP("XPDI",XPDA,"BLD",0))
61 D FILE(2),UPDT
62 W:IO]"" !,"Loading Routines"
63 I $D(^XTMP("XPDI",XPDA,"RTN","XPDCPU")) S X=$$RTNUP^XPDUTL("XPDCPU",2)
64 ;make sure routines have been loaded
65 F X=0:1:240 Q:$P($G(^XPD(9.7,XPDA,1)),U,2) H 15 W:IO]"" "." D UPDT
66 D UPDT,RTN^XPDIJ(XPDA),UPDT
67 W:IO]"" !!,"Recompiling Template routines"
68 F XPD="DIKZ","DIEZ","DIPZ" D
69 .S XPDI="" Q:'$$CHCK
70 .F S XPDI=$O(^XTMP("XPDI",XPDA,XPD,XPDI)) Q:'XPDI S X=^(XPDI) D:X]"" @("EN2^"_XPD_"("""_XPDI_""","""","""_X_""")"),UPDT
71 D UPDT,FILE(1)
72 Q
73CHCK() ;check if the component is installed, return 1 if installed, 0 to abort
74 N XPDC,Y
75 I XPD="DIKZ" S XPDC="S Y=$G(^(+$O(^XPD(9.7,XPDA,4,""A""),-1),0))"
76 E S Y=$S(XPD="DIPZ":.4,1:.402),XPDC="S Y=$G(^XPD(9.7,XPDA,""KRN"","_Y_",0))"
77 F X XPDC Q:'Y!$P(Y,U,2) H 60 D UPDT W:IO]"" "." I $D(ZTMQUE),$$STOP^%ZTLOAD S Y=0 Q
78 Q ''Y
79FILE(XPDF) ;set NOW into the VOLUME SET multiple, XPDF=field number
80 N XPD
81 S XPD(9.703,XPDVDA_","_XPDA_",",XPDF)=$$NOW^XLFDT
82 D FILE^DIE("","XPD")
83 Q
84UPDT ;update $H into VOLUME SET multiple, field 4
85 S ^XPD(9.7,XPDA,"VOL",XPDVDA,1)=$H
86 Q
Note: See TracBrowser for help on using the repository browser.