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

XPDIL1.m

Go to the documentation of this file.
  1. XPDIL1 ;SFISC/RSD - cont. of load Distribution Global ;05/05/2008
  1. ;;8.0;KERNEL;**15,17,39,41,44,66,68,76,85,100,108,229,525,755**;Jul 10, 1995;Build 6
  1. ; Per VHA Directive 2004-038, this routine should not be modified.
  1. ;
  1. PKG(XPDA) ;check Package file
  1. N XPD,XPDCP,XPDNM,XPDNOQUE,XPDPKG,X,Y,%
  1. S XPDNM=$P(XPDT(XPDIT),U,2) W !?3,XPDNM
  1. ;check KIDS version against sites version, skip if package is Kernel
  1. I $$PKG^XPDUTL(XPDNM)'["KERNEL" D I $D(XPDQUIT) D ABORT^XPDI(XPDA,1) Q
  1. .;this is part of a Kernel multi package
  1. .Q:$O(XPDT("NM","KERNEL"))["KERNEL"
  1. .S Y=$G(^XTMP("XPDI",XPDA,"VER"))
  1. .I $$VERSION^XPDUTL("XU")<Y W !!,"But I need Version ",+Y," of KERNEL!" S XPDQUIT=1
  1. .I $$VERSION^XPDUTL("VA FILEMAN")<$P(Y,U,2) W !,"But I Need Version ",+$P(Y,U,2)," of VA FILEMAN!" S XPDQUIT=1
  1. ;"BLD" must exists ;p755
  1. I '$O(^XTMP("XPDI",XPDA,"BLD",0)) W !,"Transport Build is corrupted!",! D ABORT^XPDI(XPDA,1) Q
  1. ;get national package name
  1. S %=$O(^XTMP("XPDI",XPDA,"PKG",0)),XPDPKG(0)=$G(^(+%,0)),XPDPKG=%
  1. ;XPDPKG=new ien^old ien
  1. I XPDPKG D S XPDPKG=+Y_U_XPDPKG
  1. .N D,DIC
  1. .S DIC="^DIC(9.4,",DIC(0)="X",X=$P(XPDPKG(0),U)
  1. .D ^DIC Q:Y>0
  1. .;if lookup fails try C & C2 x-ref
  1. .S X=$P(XPDPKG(0),U,2),DIC(0)="MX",D="C^C2" D MIX^DIC1
  1. ;add package to Install file
  1. I XPDPKG>0 S XPD(9.7,XPDA_",",1)=+XPDPKG D FILE^DIE("","XPD")
  1. ;XPDSKPE= does site want to run Environ. Check
  1. I '$G(XPDSKPE) Q:$$ENV(0)=1
  1. ;global package can't have pre or post inits
  1. Q:$D(XPDGP)
  1. ;create pre-init checkpoint
  1. S XPDCP="INI" I '$$NEWCP^XPDUTL("XPD PREINSTALL COMPLETED") D ABORT^XPDI(XPDA,1) Q
  1. S %=$$INRTN("INI")
  1. ;check for routine, use as call back
  1. I $L(%),'$$NEWCP^XPDUTL("XPD PREINSTALL STARTED",%) D ABORT^XPDI(XPDA,1) Q
  1. ;create post-init checkpoint
  1. S XPDCP="INIT" I '$$NEWCP^XPDUTL("XPD POSTINSTALL COMPLETED") D ABORT^XPDI(XPDA,1) Q
  1. S %=$$INRTN("INIT")
  1. I $L(%),'$$NEWCP^XPDUTL("XPD POSTINSTALL STARTED",%) D ABORT^XPDI(XPDA,1) Q
  1. ;create fileman and components check points and file rest of data
  1. D XPCK^XPDIK("FIA"),XPCK^XPDIK("KRN")
  1. Q
  1. INST(XPDNM) ;add to Install file
  1. N %X,DIC,DIR,DIRUT,DLAYGO,X,XPD,XPDA,XPDIE,XPDDIQ,Y,SH
  1. ;check if Build was already installed
  1. ;XPD=0 abort install, else XPD=ien in Install file
  1. I $D(^XPD(9.7,"B",XPDNM)) S (SH,Y)=0 D Q:$D(XPD) XPD
  1. . W !,"Build ",XPDNM," has been loaded before, here is when: "
  1. . F S Y=$O(^XPD(9.7,"B",XPDNM,Y)) Q:'Y D
  1. .. Q:'$D(^XPD(9.7,Y,0)) S %=^(0)
  1. .. W !?6,$P(%,U)," "
  1. .. I $P(%,U,9)<3,$D(^XTMP("XPDI",Y)) W "**Transport Global already exists**",*7 S XPD=0 Q
  1. .. S %X=$X W $$EXTERNAL^DILFD(9.7,.02,"",$P(%,U,9)),!?%X,"was loaded on ",$$FMTE^XLFDT($P($G(^XPD(9.7,Y,1)),U))
  1. . ;quit if transport global exist
  1. . Q:$D(XPD)
  1. . S DIR(0)="Y",DIR("A")="OK to continue with Load",DIR("B")="NO"
  1. . D ^DIR W ! I $D(DIRUT)!'Y S XPD=0 Q
  1. S DIC="^XPD(9.7,",DIC(0)="XL",DLAYGO=9.7,X=""""_XPDNM_""""
  1. ;add to Install file, must be new
  1. D ^DIC
  1. I Y<0 S SH=0 W !,"Can't add Build ",XPDNM," to Install File" Q 0
  1. ;set starting package to Y, if it is not already defined
  1. S:'XPDST XPDST=+Y
  1. ;XPDT array keeps track of all packages in this distribution
  1. S XPDA=+Y,XPDT(XPDIT)=XPDA_U_XPDNM,(XPDT("DA",XPDA),XPDT("NM",XPDNM))=XPDIT
  1. S %="XPDIE(9.7,"""_XPDA_","")",@%@(.02)=0,@%@(2)=$$NOW^XLFDT,@%@(3)=XPDST,@%@(4)=XPDIT,@%@(5)="",@%@(6)=XPDST("H1")
  1. D FILE^DIE("","XPDIE")
  1. I '$D(SH) W !?3,XPDNM ;SH is set when some other part of INST shows the name
  1. Q XPDA
  1. ;
  1. ;XPDQUIT quit current package install, 1=kill global, 2=leave global
  1. ;XPDQUIT(package) quit package install, 1=kill, 2=leave
  1. ;XPDABORT quit the entire distribution, 1=kill, 2=leave
  1. ;XPDENV 0=loading distribution, 1=installing
  1. ENV(XPDENV) ;environment check & version check
  1. ;returns 0=ok, 1=rejected kill global, 2=rejected leave global
  1. N %,DIR,XPDI,XPDQUIT,XPDABORT,XPDDONE,XPDGREF,XPDMBREQ
  1. M X=DUZ N DUZ M DUZ=X S DUZ(0)="@" ;See that ENV check has full FM priv.
  1. S XPDGREF="^XTMP(""XPDI"","_XPDA_",""TEMP"")"
  1. S XPDMBREQ=$G(^XTMP("XPDI",XPDA,"MBREQ"))
  1. S $P(^XPD(9.7,XPDA,0),U,7)=XPDMBREQ
  1. ;"BLD" must exists ;p755
  1. I '$O(^XTMP("XPDI",XPDA,"BLD",0)) W !,"Transport Build is corrupted!" D ABORT^XPDI(XPDA,1) Q 1
  1. ;check version number
  1. I XPDPKG>0 D I $G(XPDQUIT) D ABORT^XPDI(XPDA,1) Q 1
  1. .N DIR,DIRUT,X,Y
  1. .S %=+$$VER^XPDUTL(XPDNM),Y=+$G(^DIC(9.4,+XPDPKG,"VERSION")),X=XPDNM["*"
  1. .;if patch, version must be the same
  1. .I X,%'=Y W !,"This Patch is for Version ",%,", you are running Version ",Y,! S XPDQUIT=1
  1. .;if package, version must be greater or equal
  1. .I 'X,%<Y W !,"You have a Version greater than mine!",! S XPDQUIT=1
  1. .Q:'$G(XPDQUIT)
  1. .I $G(XPDMBREQ) D S XPDQUIT=0,XPDDONE=1 Q
  1. . . D MES^XPDUTL("**ABORT** Required Build "_XPDNM_", did not pass internal KIDS checks!"),ABRTALL^XPDI(1),NONE^XPDI
  1. . . Q
  1. .S DIR(0)="Y",DIR("A")="Want to continue installing this build",DIR("B")="NO"
  1. .D ^DIR I Y K XPDQUIT
  1. .Q
  1. Q:$G(XPDDONE) 1
  1. S %=$$REQB I % S (XPDABORT,XPDREQAB)=% G ABORT
  1. S %=$G(^XTMP("XPDI",XPDA,"PRE")) D:%]""
  1. .W !,"Will first run the Environment Check Routine, ",%,!
  1. .D SAVE^XPDIJ(%),@("^"_%)
  1. ABORT I $G(XPDABORT) D Q XPDABORT
  1. .;if during load & leave global quit
  1. .I 'XPDENV,XPDABORT=2 Q
  1. .D ABRTALL^XPDI(XPDABORT)
  1. Q:'$D(XPDQUIT) 0
  1. I $G(XPDQUIT) D ABORT^XPDI(XPDA,XPDQUIT)
  1. S XPDI=""
  1. ;don't do if loading & leave global, need to keep XPDT(array)
  1. F S XPDI=$O(XPDQUIT(XPDI)) Q:XPDI="" D:'(XPDQUIT(XPDI)=2&'XPDENV)
  1. .S %=$G(XPDT("NM",XPDI)) D:% ABORT^XPDI(+XPDT(%),XPDQUIT(XPDI))
  1. S XPDQUIT=$S($G(XPDQUIT):XPDQUIT,'$O(XPDT(0))!'$D(^XTMP("XPDI",XPDA)):1,1:0)
  1. Q XPDQUIT
  1. ;
  1. REQB() ;check for Required Builds
  1. ;returns 0=ok, 1=failed kill global, 2=failed leave global
  1. N XPDACT,XPDBLD,XPDI,XPDQ,XPDQUIT,XPDX,XPDX0,X,Y
  1. S XPDBLD=$O(^XTMP("XPDI",XPDA,"BLD",0)),XPDQUIT=0,XPDI=0
  1. Q:'$D(^XTMP("XPDI",XPDA,"BLD",XPDBLD,"REQB")) 0
  1. F S XPDI=$O(^XTMP("XPDI",XPDA,"BLD",XPDBLD,"REQB",XPDI)) Q:'XPDI S XPDX0=^(XPDI,0) D
  1. .S XPDQ=0,XPDX=$P(XPDX0,U),XPDACT=$P(XPDX0,U,2),X=$$PKG^XPDUTL(XPDX),Y=$$VER^XPDUTL(XPDX),Z=$$VERSION^XPDUTL(X)
  1. .;quit if current version is greater than what we are checking for
  1. .Q:Z>Y
  1. .I XPDX'["*" S:Z<Y XPDQ=2
  1. .E S:'$$PATCH^XPDUTL(XPDX) XPDQ=1
  1. .;quit if patch is already on system
  1. .Q:'XPDQ
  1. .;quit if patch is sequenced prior within this build
  1. .I $D(XPDT("NM",XPDX)),(XPDT("NM",XPDX)<XPDT("NM",XPDNM)) S XPDQ=0 Q
  1. .S XPDQUIT=$S(XPDACT>XPDQUIT:XPDACT,1:XPDQUIT)
  1. .;XPDACT=0 warning, =1 abort & kill global, =2 abort
  1. .W !!,$S(XPDACT:"**INSTALL ABORTED**",1:"**WARNING**")_$S(XPDQ=1:" Patch ",1:" Package ")_XPDX_" is Required "_$S(XPDACT:"to install",1:"for")_" this package!!",!
  1. Q:'XPDQUIT 0
  1. ;don't do if leave global and loading
  1. D:'(XPDQUIT=2&'XPDENV) ABORT^XPDI(XPDA,XPDQUIT)
  1. Q XPDQUIT
  1. ;
  1. ;return a routine that can be run
  1. INRTN(X) N Y
  1. S Y=$G(^XTMP("XPDI",XPDA,X)) Q:Y="" ""
  1. S Y=$S(Y["^":Y,1:"^"_Y)
  1. Q Y