XPDIGP ;SFISC/RSD - load Global Distribution ;05/17/2006
;;8.0;KERNEL;**1002,1003,1004,1005,1007,1008,1016**;APR 1, 2003;Build 5
;;8.0;KERNEL;**41,422**;Jul 10, 1995;Build 2
;XPDT is undefine if PKG^XPDIL1 aborted, need to close device
I '$D(XPDT) D ^%ZISC Q
N %,XPD,XPDIST,XPDBLD,XPDNM
S XPDA=+XPDT(1),XPDNM=$P(XPDT(1),U,2),XPDBLD=$O(^XTMP("XPDI",XPDA,"BLD",0))
;update Install file, read in the other globals, close device
D XPCK,GPI:'$G(XPDQUIT),^%ZISC
I $G(XPDQUIT) D ABRTALL^XPDI(1) Q
;run post install routine
S XPD=$$INRTN^XPDIL1("INIT") I XPD]"" D
.;% = routine name only, remove tag
.S %=$P(XPD,U,$L(XPD,U)) Q:'$D(^XTMP("XPDI",XPDA,"RTN",%))
.W ! D SAVE^XPDIJ(%),BMES^XPDUTL(" Running Post Install routine "_XPD),@XPD
.;update Package file
;XPDIST is flag for site tracking, it is set in PKG^XPDIP
S XPDIST=0 D BMES^XPDUTL(" Updating KIDS files... "),PKG^XPDIP
;sends site tracking bulletin
I XPDIST S %=$$EN^XPDIST(XPDA) D BMES^XPDUTL(" "_$P("NO ",U,'%)_"Install Message sent to FORUM ")
W !! D BMES^XPDUTL(" "_XPDNM_" Installed."),STMP^XPDIJ1(17) W !!
K ^XTMP("XPDI",XPDA),XPD
;update the status field
S XPD(9.7,XPDA_",",.02)=3 D FILE^DIE("","XPD")
Q
DISP ;display the contents
N X,Y,Z
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:",!!
F Y=1:1 S X=$P(XPDGP,"^",Y) Q:X="" D
.S Z=+$P(X,";"),X=$P(X,";",2),XPDT("GP",X)=Z_U_Y
.W "^"_X,?12,$P("Overwrite^Replace",U,Z+1),!
.;if unsubscripted global and replacing
.W:X'["("&Z "**WARNING - Global will be KILLED before install,",!,"Check global protection on ALL systems before continuing.",!
W !,"If you continue with the Load, the Global(s) will be",!,"Installed at this time.",!
Q
GPI ;global package input
N DIRUT,GP,GR,X,XPDSEQ,Y,Z
;start reading the HFS again
;----- BEGIN IHS MODIFICATION - XU*8.0*1008
;The line below is commented out and replaced by new line to remove
;the timeouts on the READ to prevent a timing problem in Cache when
;reading from a host file. Original mod by IHS/ITSC/AEF/04/23/03
;U IO R X:0,Y:0
U IO R X,Y
;----- END IHS MODIFICATION - XU*8.0*1008
;the next read must be the GLOBAL
I X'="**GLOBAL**" U IO(0) W !!,"ERROR in HFS file format!" S XPDQUIT=1 Q
U IO(0) D BMES^XPDUTL(" "_Y) U IO
;XPDSEQ is the disk sequence number
S GP=$P(Y,U,2),GR=$S(Y[")":$E(Y,1,$L(Y)-1)_",",1:Y_"("),XPDSEQ=1
K:XPDT("GP",GP) @Y
;X=global ref, Y=global value. DIRUT is when user is prompted for
;next disk in NEXTD and they abort
;----- BEGIN IHS MODIFICATION - XU*8.0*1008
;The line below is commented out and replace by new line to remove
;the timeouts on the READ to prevent a timing problem in Cache when
;reading from a host file. Original mod by IHS/ITSC/AEF/04/23/03
;F R X:0,Y:0 Q:X="**END**" D I $D(DIRUT) S XPDQUIT=1 Q
F R X,Y Q:X="**END**" D I $D(DIRUT) S XPDQUIT=1 Q
.;----- END IHS MODIFIVATION - XU*8.0*1008
.;new global
.I X="**GLOBAL**" D Q
..;completes last global check point
..D XPCOM(GP,Y)
..;reset global ref
..S GP=$P(Y,U,2),GR=$S(Y[")":$E(Y,1,$L(Y)-1)_",",1:Y_"(")
..;kill global if flag is set
..K:XPDT("GP",GP) @Y
.I X="**CONTINUE**" D NEXTD^XPDIL Q
.S @(GR_X)=Y
D XPCOM(GP)
U IO(0)
Q
;
;create Global multiple of Install file
XPCK N DIR,DIRUT,X,XPD,XPDJ,X,Y,Z
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"
W ! D ^DIR I $D(DIRUT)!'Y S XPDQUIT=1 Q
W ! D BMES^XPDUTL(" Install Started for "_XPDNM_" : "),STMP^XPDIJ1(11),BMES^XPDUTL(" Installing Globals:")
S X=""
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
D:$D(XPD)>9 UPDATE^DIE("S","XPD","XPDJ")
Q
;
XPCOM(X,XPDN) ;complete checkpoint for global X,XPDN=next global
N GR,GP,XPD,Y,Z
U IO(0)
S Y=$$NOW^XLFDT,Z=+$P(XPDT("GP",X),U,2),XPD(9.718,Z_","_XPDA_",",1)=Y
D MES^XPDUTL(" "_$$FMTE^XLFDT(Y)),FILE^DIE("","XPD")
D:$L($G(XPDN)) BMES^XPDUTL(" "_XPDN)
U IO
Q
XPDIGP ;SFISC/RSD - load Global Distribution ;05/17/2006
+1 ;;8.0;KERNEL;**1002,1003,1004,1005,1007,1008,1016**;APR 1, 2003;Build 5
+2 ;;8.0;KERNEL;**41,422**;Jul 10, 1995;Build 2
+3 ;XPDT is undefine if PKG^XPDIL1 aborted, need to close device
+4 IF '$DATA(XPDT)
DO ^%ZISC
QUIT
+5 NEW %,XPD,XPDIST,XPDBLD,XPDNM
+6 SET XPDA=+XPDT(1)
SET XPDNM=$PIECE(XPDT(1),U,2)
SET XPDBLD=$ORDER(^XTMP("XPDI",XPDA,"BLD",0))
+7 ;update Install file, read in the other globals, close device
+8 DO XPCK
IF '$GET(XPDQUIT)
DO GPI
DO ^%ZISC
+9 IF $GET(XPDQUIT)
DO ABRTALL^XPDI(1)
QUIT
+10 ;run post install routine
+11 SET XPD=$$INRTN^XPDIL1("INIT")
IF XPD]""
Begin DoDot:1
+12 ;% = routine name only, remove tag
+13 SET %=$PIECE(XPD,U,$LENGTH(XPD,U))
IF '$DATA(^XTMP("XPDI",XPDA,"RTN",%))
QUIT
+14 WRITE !
DO SAVE^XPDIJ(%)
DO BMES^XPDUTL(" Running Post Install routine "_XPD)
DO @XPD
+15 ;update Package file
End DoDot:1
+16 ;XPDIST is flag for site tracking, it is set in PKG^XPDIP
+17 SET XPDIST=0
DO BMES^XPDUTL(" Updating KIDS files... ")
DO PKG^XPDIP
+18 ;sends site tracking bulletin
+19 IF XPDIST
SET %=$$EN^XPDIST(XPDA)
DO BMES^XPDUTL(" "_$PIECE("NO ",U,'%)_"Install Message sent to FORUM ")
+20 WRITE !!
DO BMES^XPDUTL(" "_XPDNM_" Installed.")
DO STMP^XPDIJ1(17)
WRITE !!
+21 KILL ^XTMP("XPDI",XPDA),XPD
+22 ;update the status field
+23 SET XPD(9.7,XPDA_",",.02)=3
DO FILE^DIE("","XPD")
+24 QUIT
DISP ;display the contents
+1 NEW X,Y,Z
+2 WRITE !,"This is a Global Distribution. It contains Global(s) that will",!,"update your system at this time. The following Global(s) will be installed:",!!
+3 FOR Y=1:1
SET X=$PIECE(XPDGP,"^",Y)
IF X=""
QUIT
Begin DoDot:1
+4 SET Z=+$PIECE(X,";")
SET X=$PIECE(X,";",2)
SET XPDT("GP",X)=Z_U_Y
+5 WRITE "^"_X,?12,$PIECE("Overwrite^Replace",U,Z+1),!
+6 ;if unsubscripted global and replacing
+7 IF X'["("&Z
WRITE "**WARNING - Global will be KILLED before install,",!,"Check global protection on ALL systems before continuing.",!
End DoDot:1
+8 WRITE !,"If you continue with the Load, the Global(s) will be",!,"Installed at this time.",!
+9 QUIT
GPI ;global package input
+1 NEW DIRUT,GP,GR,X,XPDSEQ,Y,Z
+2 ;start reading the HFS again
+3 ;----- BEGIN IHS MODIFICATION - XU*8.0*1008
+4 ;The line below is commented out and replaced by new line to remove
+5 ;the timeouts on the READ to prevent a timing problem in Cache when
+6 ;reading from a host file. Original mod by IHS/ITSC/AEF/04/23/03
+7 ;U IO R X:0,Y:0
+8 USE IO
READ X,Y
+9 ;----- END IHS MODIFICATION - XU*8.0*1008
+10 ;the next read must be the GLOBAL
+11 IF X'="**GLOBAL**"
USE IO(0)
WRITE !!,"ERROR in HFS file format!"
SET XPDQUIT=1
QUIT
+12 USE IO(0)
DO BMES^XPDUTL(" "_Y)
USE IO
+13 ;XPDSEQ is the disk sequence number
+14 SET GP=$PIECE(Y,U,2)
SET GR=$SELECT(Y[")":$EXTRACT(Y,1,$LENGTH(Y)-1)_",",1:Y_"(")
SET XPDSEQ=1
+15 IF XPDT("GP",GP)
KILL @Y
+16 ;X=global ref, Y=global value. DIRUT is when user is prompted for
+17 ;next disk in NEXTD and they abort
+18 ;----- BEGIN IHS MODIFICATION - XU*8.0*1008
+19 ;The line below is commented out and replace by new line to remove
+20 ;the timeouts on the READ to prevent a timing problem in Cache when
+21 ;reading from a host file. Original mod by IHS/ITSC/AEF/04/23/03
+22 ;F R X:0,Y:0 Q:X="**END**" D I $D(DIRUT) S XPDQUIT=1 Q
+23 FOR
READ X,Y
IF X="**END**"
QUIT
Begin DoDot:1
+24 ;----- END IHS MODIFIVATION - XU*8.0*1008
+25 ;new global
+26 IF X="**GLOBAL**"
Begin DoDot:2
+27 ;completes last global check point
+28 DO XPCOM(GP,Y)
+29 ;reset global ref
+30 SET GP=$PIECE(Y,U,2)
SET GR=$SELECT(Y[")":$EXTRACT(Y,1,$LENGTH(Y)-1)_",",1:Y_"(")
+31 ;kill global if flag is set
+32 IF XPDT("GP",GP)
KILL @Y
End DoDot:2
QUIT
+33 IF X="**CONTINUE**"
DO NEXTD^XPDIL
QUIT
+34 SET @(GR_X)=Y
End DoDot:1
IF $DATA(DIRUT)
SET XPDQUIT=1
QUIT
+35 DO XPCOM(GP)
+36 USE IO(0)
+37 QUIT
+38 ;
+39 ;create Global multiple of Install file
XPCK NEW DIR,DIRUT,X,XPD,XPDJ,X,Y,Z
+1 SET DIR(0)="Y"
SET DIR("A")="Globals will now be installed, OK"
SET DIR("B")="YES"
SET DIR("?")="YES will continue with install, NO will abort install"
+2 WRITE !
DO ^DIR
IF $DATA(DIRUT)!'Y
SET XPDQUIT=1
QUIT
+3 WRITE !
DO BMES^XPDUTL(" Install Started for "_XPDNM_" : ")
DO STMP^XPDIJ1(11)
DO BMES^XPDUTL(" Installing Globals:")
+4 SET X=""
+5 FOR
SET X=$ORDER(XPDT("GP",X))
IF X=""
QUIT
SET Z=$PIECE(XPDT("GP",X),U,2)
SET XPD(9.718,"+"_Z_","_XPDA_",",.01)=X
SET XPDJ(Z)=Z
+6 IF $DATA(XPD)>9
DO UPDATE^DIE("S","XPD","XPDJ")
+7 QUIT
+8 ;
XPCOM(X,XPDN) ;complete checkpoint for global X,XPDN=next global
+1 NEW GR,GP,XPD,Y,Z
+2 USE IO(0)
+3 SET Y=$$NOW^XLFDT
SET Z=+$PIECE(XPDT("GP",X),U,2)
SET XPD(9.718,Z_","_XPDA_",",1)=Y
+4 DO MES^XPDUTL(" "_$$FMTE^XLFDT(Y))
DO FILE^DIE("","XPD")
+5 IF $LENGTH($GET(XPDN))
DO BMES^XPDUTL(" "_XPDN)
+6 USE IO
+7 QUIT
