TMGXPDL1 ;TMG/kst/Custom version of XPDIL1 ;09/17/08
         ;;1.0;TMG-LIB;**1**;09/17/08

 ;"Original header....
 ;"XPDIL1  ;SFISC/RSD - cont. of load Distribution Global ;11/14/2002  07:35
 ;"       ;;8.0;KERNEL;**15,17,39,41,44,66,68,76,85,100,108,229**;Jul 10, 1995

PKG(XPDA,Option,Msg)
        ;"Purspose: Check Package file
        ;"Input: Options -- PASS BY REFERENCE.  Entries are required unless marked optional
        ;"              Option("FORCE CONT LOAD")=1 <-- if not given, then load won't continue
        ;"       Msg -- PASS BY REFERENCE, an OUT PARAMETER.
        ;"              Errors are stored in Msg("ERROR",x)=Message
        ;"                                   Msg("ERROR")=count of last error
        ;"              Message are store in Msg(x)=Message
        ;"                                   Msg=count of last message+1

        N XPD,XPDCP,XPDNM,XPDNOQUE,XPDPKG,X,Y,%
        new abort set abort=0
        S XPDNM=$P(XPDT(XPDIT),U,2)
        do AddMsg^TMGPAT2("   "_XPDNM,0,.Msg)

        ;"check KIDS version against sites version, skip if package is Kernel
        I $$PKG^TMGXPDUT(XPDNM)'["KERNEL" D  ;"not interactive routine
        . ;"this is part of a Kernel multi package
        . Q:$O(XPDT("NM","KERNEL"))["KERNEL"
        . S Y=$G(^XTMP("XPDI",XPDA,"VER"))
        . I $$VERSION^TMGXPDUT("XU")<Y do
        . . do AddMsg^TMGPAT2("Need Version "_+Y_" of KERNEL!",1,.Msg)
        . . S XPDQUIT=1
        . I $$VERSION^TMGXPDUT("VA FILEMAN")<$P(Y,U,2) do
        . . do AddMsg^TMGPAT2("Need Version "_+$P(Y,U,2)_" of VA FILEMAN!",1,.Msg)
        . . S XPDQUIT=1
        I $D(XPDQUIT) set abort=1 goto PCKDone

        ;"get national package name
        S %=$O(^XTMP("XPDI",XPDA,"PKG",0))
        set XPDPKG(0)=$G(^(+%,0))
        set 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 Prefix, C x-ref
        . S X=$P(XPDPKG(0),U,2),D="C"
        . D IX^DIC

        ;"add package to Install file
        I XPDPKG>0 do
        . S XPD(9.7,XPDA_",",1)=+XPDPKG
        . D FILE^DIE("","XPD")

        ;"XPDSKPE= does site want to run Environ. Check
        I '$G(XPDSKPE),($$ENV(0,.Msg)=1) goto PCKDone

        ;"global package can't have pre or post inits
        if $D(XPDGP) goto PCKDone

        ;"create pre-init checkpoint
        S XPDCP="INI"
        I '$$NEWCP^TMGXPDUT("XPD PREINSTALL COMPLETED") set abort=1 goto PCKDone
        S %=$$INRTN("INI")

        ;"check for routine, use as call back
        I $L(%),'$$NEWCP^TMGXPDUT("XPD PREINSTALL STARTED",%) set abort=1 goto PCKDone

        ;"create post-init checkpoint
        S XPDCP="INIT"
        I '$$NEWCP^TMGXPDUT("XPD POSTINSTALL COMPLETED") set abort=1 goto PCKDone
        S %=$$INRTN("INIT")

        I $L(%),'$$NEWCP^TMGXPDUT("XPD POSTINSTALL STARTED",%) set abort=1 goto PCKDone
        ;"create fileman and components check points and file rest of data
        do XPCK^XPDIK("FIA")
        do XPCK^XPDIK("KRN")
PCKDone
        if abort=1 do
        . do AddMsg^TMGPAT2("Aborting",1,.Msg)
        . do ABORT^TMGXPDI(XPDA,1,,.Msg)

        Q

INST(XPDNM,Option,Msg)
        ;"Purpose: add to Install file
        ;"Input: XPDNM -- Name to match agains .01 field from file 9.7
        ;"       Options -- PASS BY REFERENCE.  Entries are required unless marked optional
        ;"              Option("FORCE CONT LOAD")=1 <-- if not given, then load won't continue
        ;"                                              when question normally asked of  user.
        ;"       Msg -- PASS BY REFERENCE, an OUT PARAMETER.
        ;"              Errors are stored in Msg("ERROR",x)=Message
        ;"                                   Msg("ERROR")=count of last error
        ;"              Message are store in Msg(x)=Message
        ;"                                   Msg=count of last message+1
        ;"Output:
        ;"Result: 0=error, or IEN in Install File (9.7) of newly added entry

        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)) do
        . new IEN set IEN=$order(^XPD(9.7,"B",XPDNM,"")) ;"//kt added
        . ;"set XPDQUIT=1  ;"//kt added
        . S (SH,Y)=0
        . do AddMsg^TMGPAT2("Build "_XPDNM_" has been loaded before [IEN #"_IEN_" in File INSTALL (9.7)]",0,.Msg)
        . ;"do AddMsg^TMGPAT2("Here is when: ",0,.Msg)
        . F  S Y=$O(^XPD(9.7,"B",XPDNM,Y)) Q:'Y  D
        . . Q:'$D(^XPD(9.7,Y,0))  S %=^(0)
        . . ;"do AddMsg^TMGPAT2("   "_$P(%,U),0,.Msg)
        . . I $P(%,U,9)<3,$D(^XTMP("XPDI",Y)) do  quit
        . . . do AddMsg^TMGPAT2("   **Transport Global already exists**",0,.Msg)
        . . . S XPD=0
        . . S %X=$X
        . . do AddMsg^TMGPAT2("   "_$$EXTERNAL^DILFD(9.7,.02,"",$P(%,U,9)),0,.Msg)
        . . do AddMsg^TMGPAT2("   "_$P(%,U)_" was loaded on "_$$FMTE^XLFDT($P($G(^XPD(9.7,Y,1)),U)),0,.Msg)
        . Q:$D(XPD)  ;"quit if transport global exist
        . set XPD=0 ;"signal quit -- //kt added
        if $D(XPD) set XPDA=XPD goto INSTDone

        ;"Add to Install file, must be new
        S DIC="^XPD(9.7,",DIC(0)="XL",DLAYGO=9.7,X=""""_XPDNM_""""
        D ^DIC
        I Y<0 do  goto INSTDone
        . S SH=0
        . do AddMsg^TMGPAT2("Can't ADD Build "_XPDNM_" to Install File",1,.Msg)
        . ;"do AddMsg^TMGPAT2($piece(Y,"^",2)_" already exists in INSTALLATION file (9.7), IEN=#"_+Y,1,.Msg)
        . set XPDA=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
        set XPDT(XPDIT)=XPDA_U_XPDNM
        set XPDT("DA",XPDA)=XPDIT
        set XPDT("NM",XPDNM)=XPDIT
        S %="XPDIE(9.7,"""_XPDA_","")"
        set @%@(.02)=0          ;"STATUS
        set @%@(2)=$$NOW^XLFDT  ;"DATE LOADED
        set @%@(3)=XPDST        ;"STARTING PACKAGE
        set @%@(4)=XPDIT        ;"INSTALL ORDER
        set @%@(5)=""           ;"QUEUED TASK NUMBER
        set @%@(6)=XPDST("H1")  ;"FILE COMMENT
        new TMGMSG
        D FILE^DIE("","XPDIE","TMGMSG")
        I '$D(SH) do  ;"SH is set when some other part of INST shows the name
        . set Msg(Msg)="   "_XPDNM,Msg=Msg+1
INSTDone
        Q XPDA



ENV(XPDENV,Msg)
        ;"Purpose: Enviroment check & version check
        ;"Input-- XPDENV 0=loading distribution, 1=installing
        ;"       Msg -- PASS BY REFERENCE, an OUT PARAMETER.
        ;"              Errors are stored in Msg("ERROR",x)=Message
        ;"                                   Msg("ERROR")=count of last error
        ;"              Message are store in Msg(x)=Message
        ;"                                   Msg=count of last message+1
        ;"Output: Globally scoped variables set as follows:
        ;"      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
        ;"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
        ;"check version number
        I XPDPKG>0 D  I $G(XPDQUIT) D ABORT^TMGXPDI(XPDA,1,,.Msg) Q 1
        . N DIR,DIRUT,X,Y
        . S %=+$$VER^TMGXPDUT(XPDNM)
        . S Y=+$G(^DIC(9.4,+XPDPKG,"VERSION"))
        . S X=XPDNM["*"
        . ;"If patch, version must be the same
        . I X,%'=Y do
        . . do AddMsg^TMGPAT2("This Patch is for Version "_%_", you are running Version "_Y,1,.Msg)
        . . S XPDQUIT=1
        . ;"if package, version must be greater or equal
        . I 'X,%<Y do
        . . do AddMsg^TMGPAT2("You have a Version greater than mine!",1,.Msg)
        . . S XPDQUIT=1
        . Q:'$G(XPDQUIT)
        . I $G(XPDMBREQ) D  Q
        . . D MES^TMGXPDUT("**ABORT** Required Build "_XPDNM_", did not pass internal KIDS checks!",.Msg)
        . . D ABRTALL^TMGXPDI(1,,.Msg)
        . . D NONE^TMGXPDI
        . . S XPDQUIT=0,XPDDONE=1
        . . Q
        . ;"NEED TO CHANGE BELOW IF GOING TO MAKE NON-INTERACTIVE...
        . 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(.Msg)
        I % S (XPDABORT,XPDREQAB)=% G ABORT
        S %=$G(^XTMP("XPDI",XPDA,"PRE")) D:%]""
        . do AddMsg^TMGPAT2("Will first run the Environment Check Routine, "_%,0,.Msg)
        . D SAVE^XPDIJ(%)
        . new saved
        . do IOCapON^TMGKERNL
        . D @("^"_%)
        . do IOCapOFF^TMGKERNL("saved")
        . if $data(saved) do AddMsg^TMGPAT2(.saved,0,.Msg)


ABORT   I $G(XPDABORT) D  Q XPDABORT
        . ;"if during load & leave global quit
        . I 'XPDENV,XPDABORT=2 Q
        . D ABRTALL^TMGXPDI(XPDABORT,,.Msg)
        Q:'$D(XPDQUIT) 0
        I $G(XPDQUIT) D ABORT^TMGXPDI(XPDA,XPDQUIT,,.Msg)
        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^TMGXPDI(+XPDT(%),XPDQUIT(XPDI),,.Msg)
        S XPDQUIT=$S($G(XPDQUIT):XPDQUIT,'$O(XPDT(0))!'$D(^XTMP("XPDI",XPDA)):1,1:0)
        Q XPDQUIT
        ;


REQB(Msg)
        ;"Purpose: check for Required Builds
        ;"Input: Msg -- PASS BY REFERENCE, an OUT PARAMETER.
        ;"              Errors are stored in Msg("ERROR",x)=Message
        ;"                                   Msg("ERROR")=count of last error
        ;"              Message are store in Msg(x)=Message
        ;"                                   Msg=count of last message+1
        ;"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  D
        . S XPDX0=^(XPDI,0)
        . S XPDQ=0,XPDX=$P(XPDX0,U),XPDACT=$P(XPDX0,U,2)
        . S X=$$PKG^TMGXPDUT(XPDX)
        . S Y=$$VER^TMGXPDUT(XPDX)
        . S Z=$$VERSION^TMGXPDUT(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^TMGXPDUT(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
        . new s set s=$S(XPDACT:"**INSTALL ABORTED**",1:"**WARNING**")_$S(XPDQ=1:" Patch ",1:" Package ")
        . set s=s_XPDX_" is Required "_$S(XPDACT:"to install",1:"for")_" this package!!"
        . do AddMsg^TMGPAT2(s,1,.Msg)
        Q:'XPDQUIT 0
        ;"Don't do if leave global and loading
        D:'(XPDQUIT=2&'XPDENV) ABORT^TMGXPDI(XPDA,XPDQUIT,,.Msg)
        Q XPDQUIT
        ;

INRTN(X)
        ;"return a routine that can be run
        N Y
        S Y=$G(^XTMP("XPDI",XPDA,X)) Q:Y="" ""
        S Y=$S(Y["^":Y,1:"^"_Y)
        Q Y