source: cprs/branches/tmg-cprs/m_files/TMGXPDIG.m@ 1620

Last change on this file since 1620 was 796, checked in by Kevin Toppenberg, 14 years ago

Initial upload

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