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