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/XPDIGP.m@ 1240

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

initial load of WorldVistAEHR
File size: 3.3 KB
Line 
1XPDIGP ;SFISC/RSD - load Global Distribution ;05/17/2006
2 ;;8.0;KERNEL;**41,422**;Jul 10, 1995;Build 2
3 ;XPDT is undefine if PKG^XPDIL1 aborted, need to close device
4 I '$D(XPDT) D ^%ZISC Q
5 N %,XPD,XPDIST,XPDBLD,XPDNM
6 S XPDA=+XPDT(1),XPDNM=$P(XPDT(1),U,2),XPDBLD=$O(^XTMP("XPDI",XPDA,"BLD",0))
7 ;update Install file, read in the other globals, close device
8 D XPCK,GPI:'$G(XPDQUIT),^%ZISC
9 I $G(XPDQUIT) D ABRTALL^XPDI(1) Q
10 ;run post install routine
11 S XPD=$$INRTN^XPDIL1("INIT") I XPD]"" D
12 .;% = routine name only, remove tag
13 .S %=$P(XPD,U,$L(XPD,U)) Q:'$D(^XTMP("XPDI",XPDA,"RTN",%))
14 .W ! D SAVE^XPDIJ(%),BMES^XPDUTL(" Running Post Install routine "_XPD),@XPD
15 .;update Package file
16 ;XPDIST is flag for site tracking, it is set in PKG^XPDIP
17 S XPDIST=0 D BMES^XPDUTL(" Updating KIDS files... "),PKG^XPDIP
18 ;sends site tracking bulletin
19 I XPDIST S %=$$EN^XPDIST(XPDA) D BMES^XPDUTL(" "_$P("NO ",U,'%)_"Install Message sent to FORUM ")
20 W !! D BMES^XPDUTL(" "_XPDNM_" Installed."),STMP^XPDIJ1(17) W !!
21 K ^XTMP("XPDI",XPDA),XPD
22 ;update the status field
23 S XPD(9.7,XPDA_",",.02)=3 D FILE^DIE("","XPD")
24 Q
25DISP ;display the contents
26 N X,Y,Z
27 W !,"This is a Global Distribution. It contains Global(s) that will",!,"update your system at this time. The following Global(s) will be installed:",!!
28 F Y=1:1 S X=$P(XPDGP,"^",Y) Q:X="" D
29 .S Z=+$P(X,";"),X=$P(X,";",2),XPDT("GP",X)=Z_U_Y
30 .W "^"_X,?12,$P("Overwrite^Replace",U,Z+1),!
31 .;if unsubscripted global and replacing
32 .W:X'["("&Z "**WARNING - Global will be KILLED before install,",!,"Check global protection on ALL systems before continuing.",!
33 W !,"If you continue with the Load, the Global(s) will be",!,"Installed at this time.",!
34 Q
35GPI ;global package input
36 N DIRUT,GP,GR,X,XPDSEQ,Y,Z
37 ;start reading the HFS again, rwf, changed all read timeout from 0 to 1.
38 U IO R X:10,Y:10
39 ;the next read must be the GLOBAL
40 I X'="**GLOBAL**" U IO(0) W !!,"ERROR in HFS file format!" S XPDQUIT=1 Q
41 U IO(0) D BMES^XPDUTL(" "_Y) U IO
42 ;XPDSEQ is the disk sequence number
43 S GP=$P(Y,U,2),GR=$S(Y[")":$E(Y,1,$L(Y)-1)_",",1:Y_"("),XPDSEQ=1
44 K:XPDT("GP",GP) @Y
45 ;X=global ref, Y=global value. DIRUT is when user is prompted for
46 ;next disk in NEXTD and they abort
47 F R X:10,Y:10 Q:X="**END**" D I $D(DIRUT) S XPDQUIT=1 Q
48 .;new global
49 .I X="**GLOBAL**" D Q
50 ..;completes last global check point
51 ..D XPCOM(GP,Y)
52 ..;reset global ref
53 ..S GP=$P(Y,U,2),GR=$S(Y[")":$E(Y,1,$L(Y)-1)_",",1:Y_"(")
54 ..;kill global if flag is set
55 ..K:XPDT("GP",GP) @Y
56 .I X="**CONTINUE**" D NEXTD^XPDIL Q
57 .S @(GR_X)=Y
58 D XPCOM(GP)
59 U IO(0)
60 Q
61 ;
62 ;create Global multiple of Install file
63XPCK N DIR,DIRUT,X,XPD,XPDJ,X,Y,Z
64 S DIR(0)="Y",DIR("A")="Globals will now be installed, OK",DIR("B")="YES",DIR("?")="YES will continue with install, NO will abort install"
65 W ! D ^DIR I $D(DIRUT)!'Y S XPDQUIT=1 Q
66 W ! D BMES^XPDUTL(" Install Started for "_XPDNM_" : "),STMP^XPDIJ1(11),BMES^XPDUTL(" Installing Globals:")
67 S X=""
68 F S X=$O(XPDT("GP",X)) Q:X="" S Z=$P(XPDT("GP",X),U,2),XPD(9.718,"+"_Z_","_XPDA_",",.01)=X,XPDJ(Z)=Z
69 D:$D(XPD)>9 UPDATE^DIE("S","XPD","XPDJ")
70 Q
71 ;
72XPCOM(X,XPDN) ;complete checkpoint for global X,XPDN=next global
73 N GR,GP,XPD,Y,Z
74 U IO(0)
75 S Y=$$NOW^XLFDT,Z=+$P(XPDT("GP",X),U,2),XPD(9.718,Z_","_XPDA_",",1)=Y
76 D MES^XPDUTL(" "_$$FMTE^XLFDT(Y)),FILE^DIE("","XPD")
77 D:$L($G(XPDN)) BMES^XPDUTL(" "_XPDN)
78 U IO
79 Q
Note: See TracBrowser for help on using the repository browser.