| [796] | 1 | TMGXPDIL ;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 |
|
|---|
| 31 | DISP(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 |
|
|---|
| 55 | GPI ;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
|
|---|
| 83 | XPCK 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 | ;
|
|---|
| 92 | XPCOM(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
|
|---|
