Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XPDIGP

XPDIGP.m

Go to the documentation of this file. 
  1. 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
  1.  ;;8.0;KERNEL;**41,422**;Jul 10, 1995;Build 2
  1.  ;XPDT is undefine if PKG^XPDIL1 aborted, need to close device
  1.  I '$D(XPDT) D ^%ZISC Q
  1.  N %,XPD,XPDIST,XPDBLD,XPDNM
  1.  S XPDA=+XPDT(1),XPDNM=$P(XPDT(1),U,2),XPDBLD=$O(^XTMP("XPDI",XPDA,"BLD",0))
  1.  ;update Install file, read in the other globals, close device
  1.  D XPCK,GPI:'$G(XPDQUIT),^%ZISC
  1.  I $G(XPDQUIT) D ABRTALL^XPDI(1) Q
  1.  ;run post install routine
  1.  S XPD=$$INRTN^XPDIL1("INIT") I XPD]"" D
  1.  .;% = routine name only, remove tag
  1.  .S %=$P(XPD,U,$L(XPD,U)) Q:'$D(^XTMP("XPDI",XPDA,"RTN",%))
  1.  .W ! D SAVE^XPDIJ(%),BMES^XPDUTL(" Running Post Install routine "_XPD),@XPD
  1.  .;update Package file
  1.  ;XPDIST is flag for site tracking, it is set in PKG^XPDIP
  1.  S XPDIST=0 D BMES^XPDUTL(" Updating KIDS files... "),PKG^XPDIP
  1.  ;sends site tracking bulletin
  1.  I XPDIST S %=$$EN^XPDIST(XPDA) D BMES^XPDUTL(" "_$P("NO ",U,'%)_"Install Message sent to FORUM ")
  1.  W !! D BMES^XPDUTL(" "_XPDNM_" Installed."),STMP^XPDIJ1(17) W !!
  1.  K ^XTMP("XPDI",XPDA),XPD
  1.  ;update the status field
  1.  S XPD(9.7,XPDA_",",.02)=3 D FILE^DIE("","XPD")
  1.  Q
  1. DISP ;display the contents
  1.  N X,Y,Z
  1.  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:",!!
  1.  F Y=1:1 S X=$P(XPDGP,"^",Y) Q:X=""  D
  1.  .S Z=+$P(X,";"),X=$P(X,";",2),XPDT("GP",X)=Z_U_Y
  1.  .W "^"_X,?12,$P("Overwrite^Replace",U,Z+1),!
  1.  .;if unsubscripted global and replacing
  1.  .W:X'["("&Z "**WARNING - Global will be KILLED before install,",!,"Check global protection on ALL systems before continuing.",!
  1.  W !,"If you continue with the Load, the Global(s) will be",!,"Installed at this time.",!
  1.  Q
  1. GPI ;global package input
  1.  N DIRUT,GP,GR,X,XPDSEQ,Y,Z
  1.  ;start reading the HFS again
  1.  ;----- BEGIN IHS MODIFICATION - XU*8.0*1008
  1.  ;The line below is commented out and replaced by new line to remove
  1.  ;the timeouts on the READ to prevent a timing problem in Cache when
  1.  ;reading from a host file.  Original mod by IHS/ITSC/AEF/04/23/03
  1.  ;U IO R X:0,Y:0
  1.  U IO R X,Y
  1.  ;----- END IHS MODIFICATION - XU*8.0*1008
  1.  ;the next read must be the GLOBAL
  1.  I X'="**GLOBAL**" U IO(0) W !!,"ERROR in HFS file format!" S XPDQUIT=1 Q
  1.  U IO(0) D BMES^XPDUTL(" "_Y) U IO
  1.  ;XPDSEQ is the disk sequence number
  1.  S GP=$P(Y,U,2),GR=$S(Y[")":$E(Y,1,$L(Y)-1)_",",1:Y_"("),XPDSEQ=1
  1.  K:XPDT("GP",GP) @Y
  1.  ;X=global ref, Y=global value. DIRUT is when user is prompted for
  1.  ;next disk in NEXTD and they abort
  1.  ;----- BEGIN IHS MODIFICATION - XU*8.0*1008
  1.  ;The line below is commented out and replace by new line to remove
  1.  ;the timeouts on the READ to prevent a timing problem in Cache when
  1.  ;reading from a host file.  Original mod by  IHS/ITSC/AEF/04/23/03
  1.  ;F  R X:0,Y:0 Q:X="**END**"  D  I $D(DIRUT) S XPDQUIT=1 Q
  1.  F  R X,Y Q:X="**END**"  D  I $D(DIRUT) S XPDQUIT=1 Q
  1.  .;----- END IHS MODIFIVATION - XU*8.0*1008
  1.  .;new global
  1.  .I X="**GLOBAL**" D  Q
  1.  ..;completes last global check point
  1.  ..D XPCOM(GP,Y)
  1.  ..;reset global ref
  1.  ..S GP=$P(Y,U,2),GR=$S(Y[")":$E(Y,1,$L(Y)-1)_",",1:Y_"(")
  1.  ..;kill global if flag is set
  1.  ..K:XPDT("GP",GP) @Y
  1.  .I X="**CONTINUE**" D NEXTD^XPDIL Q
  1.  .S @(GR_X)=Y
  1.  D XPCOM(GP)
  1.  U IO(0)
  1.  Q
  1.  ;
  1.  ;create Global multiple of Install file
  1. XPCK N DIR,DIRUT,X,XPD,XPDJ,X,Y,Z
  1.  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"
  1.  W ! D ^DIR I $D(DIRUT)!'Y S XPDQUIT=1 Q
  1.  W ! D BMES^XPDUTL(" Install Started for "_XPDNM_" : "),STMP^XPDIJ1(11),BMES^XPDUTL(" Installing Globals:")
  1.  S X=""
  1.  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
  1.  D:$D(XPD)>9 UPDATE^DIE("S","XPD","XPDJ")
  1.  Q
  1.  ;
  1. XPCOM(X,XPDN) ;complete checkpoint for global X,XPDN=next global
  1.  N GR,GP,XPD,Y,Z
  1.  U IO(0)
  1.  S Y=$$NOW^XLFDT,Z=+$P(XPDT("GP",X),U,2),XPD(9.718,Z_","_XPDA_",",1)=Y
  1.  D MES^XPDUTL("               "_$$FMTE^XLFDT(Y)),FILE^DIE("","XPD")
  1.  D:$L($G(XPDN)) BMES^XPDUTL(" "_XPDN)
  1.  U IO
  1.  Q