1:50 PM  02-APR-2003
XPDIJ* routines
XPDIJ
XPDIJ ;SFISC/RSD - Install Job ;08/04/99  07:54 [ 04/02/2003   8:29 AM ]
 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
 ;;8.0;KERNEL;**2,21,28,41,44,68,81,95,108,124**;Jul 10, 1995
EN ;install all packages
 ;XPDA=ien of first package
 ;this is needed to restore XPDIJ1
 D LNRF("XPDIJ1")
 D LNRF("XPDIQ") ;Needed for patch 108
 N IEN,XPDI,XPD0,XPDSET,XPDABORT,XPDMENU,XPDQUIT,XPDVOL,X,Y,ZTRTN,ZTDTH,ZTIO,ZTDESC,ZTSK
 I $$NEWERR^%ZTER N $ETRAP,$ESTACK S $ETRAP="D ERR^XPDIJ"
 E  S X="ERR^XPDIJ",@^%ZOSF("TRAP")
 Q:'$D(^XPD(9.7,+$G(XPDA),0))  S XPD0=^(0)
 D INIT^XPDID
 ;See if need to Inhibit Logons
 I $$ANSWER^XPDIQ("XPI1") D INHIBIT^XPDIJ1("Y")
 ;disable options & protocols for setname, XPDSET=1/0^setname^out of order msg.
 S Y=$P(XPD0,U,8),XPDSET=+Y_U_$E(Y,2,99)_U_$S($L(Y):$P($G(^XTMP("XQOO",$E(Y,2,99),0)),U),1:"")
 ;hang the number of seconds given in 0;10
 I XPDSET D OFF^XQOO1($P(XPDSET,U,2)) I $P(XPD0,U,10) H ($P(XPD0,U,10)*60)
 S Y=0
 ;XPDABORT can be set in pre or post install to abort install
 F  S Y=$O(^XPD(9.7,"ASP",XPDA,Y)) Q:'Y  S %=$O(^(Y,0)) D:%  Q:$D(XPDABORT)
 .N XPD,XPDA,XPDNM,XPDV,XPDV0,XPDVOL,XPDX,XPDY,Y
 .;Now do the Install
 .S XPDA=%,XPDNM=$P($G(^XPD(9.7,XPDA,0)),U) D IN^XPDIJ1 Q:$D(XPDABORT)
 ;
 ;Now do Master Build Post INIT.
 I '$D(XPDABORT),$D(XPDT("MASTER")) D
 .S XPDBLD=$O(^XTMP("XPDI",XPDA,"BLD",0))
 .D POST^XPDIJ1
 ;ZTREQ tells taskman to delete task
 I $G(ZTSK) S ZTREQ="@" D
 .;remove task # from Install File
 .N XPD S XPD(9.7,XPDA_",",5)="@"
 .D FILE^DIE("","XPD")
 ;quit if install was aborted
 I $D(XPDABORT) D EXIT^XPDID("Install Aborted!!"),^%ZISC Q
 ;put option back in order
 I $P(XPDSET,U,2)]"" D ON^XQOO1($P(XPDSET,U,2)) K ^XTMP("XQOO",$P(XPDSET,U,2))
 ;check if menu rebuild is wanted (only if option has been added)
 I $$ANSWER^XPDIQ("XPO1") D
 .D BMES^XPDUTL(" Call MENU rebuild"),KIDS^XQ81
 .;check if need to queue menu rebuild on other CPUs
 .D:$O(^XPD(9.7,XPDA,"VOL",0))
 ..N XPDU,XPDY,XPDV,XPDV0,ZTUCI,ZTCPU
 ..X ^%ZOSF("UCI") S XPDU=$P(Y,","),XPDY=$P(Y,",",2),XPDV=0
 ..;loop thru VOLUMES SET and don't do current volume set
 ..F  S XPDV=$O(^XPD(9.7,XPDA,"VOL",XPDV)) Q:'XPDV  S XPDV0=$P(^(XPDV,0),U) D:XPDV0'=XPDY
 ...S ZTUCI=XPDU,ZTDTH=$H,ZTIO="",ZTDESC="Install Menu Rebuild",ZTCPU=XPDV0,ZTRTN="KIDS^XQ81" D ^%ZTLOAD
 ;
 ;See if need to reset inhibit logons
 I $$ANSWER^XPDIQ("XPI1") D INHIBIT^XPDIJ1("N")
 ;
 ;clean up globals
 S Y=0
 F  S Y=$O(^XPD(9.7,"ASP",XPDA,Y)) Q:'Y  S XPDI=$O(^(Y,0)) D:XPDI
 . N %,Y,XPD,X
 . ;See if need to delete Env,Pre,Post routines.
 . S %=$O(^XTMP("XPDI",XPDI,"BLD",0)),XPD=$G(^XTMP("XPDI",XPDI,"BLD",%,"INID"))
 . I '$$GET^XUPARAM("XPD NO_EPP_DELETE") F %=1:1:3 I $P(XPD,U,%)="y" D
 . . S X=^XTMP("XPDI",XPDI,$P("PRE^INIT^INI",U,%)) S:X[U X=$P(X,U,2) ;X:X]"" ^%ZOSF("DEL") ;*** TESTING - AEF *** COMMENTED OUT TO PREVENT DELETING ROUTINES
 . ;kill transport global
 . ;K ^XTMP("XPDI",XPDI) ;*** TESTING - AEF *** TO PREVENT KILLING TRANSPORT GLOBAL
 . ;update the status field
 . S XPD(9.7,XPDI_",",.02)=3
 . D FILE^DIE("","XPD")
 D EXIT^XPDID("Install Completed"),^%ZISC
 Q
 ;
SAVE(X) ;restore routine X
 N %,DIE,XCM,XCN,XCS
 S DIE="^XTMP(""XPDI"",XPDA,""RTN"",X,",XCN=0
 X ^%ZOSF("SAVE")
 Q
RTN(XPDA) ;restore all routines for package XPDA
 ;^XPD("XPDI",XPDA,"RTN",routine name)=0-install, 1-delete, 2-skip^checksum
 Q:$G(XPDA)=""
 N X,XPDI,XPDJ S XPDI=""
 F  S XPDI=$O(^XTMP("XPDI",XPDA,"RTN",XPDI)) Q:XPDI=""  S XPDJ=^(XPDI) D
 .;if we are doing VT graphic display, set counter
 .I $D(XPDIDVT) S XPDIDCNT=XPDIDCNT+1 D:'(XPDIDCNT#XPDIDMOD) UPDATE^XPDID(XPDIDCNT)
 .I 'XPDJ D SAVE(XPDI) Q
 .;set checksum to null, since routine wasn't loaded
 .I $P(XPDJ,U,2) S $P(^XTMP("XPDI",XPDA,"BLD",XPDBLD,"KRN",9.8,"NM",$P(XPDJ,U,2),0),U,4)=""
 .I $P(XPDJ,U)=1 S X=XPDI X ^%ZOSF("DEL")
 ;if graphic display, update full count
 I $D(XPDIDVT) D UPDATE^XPDID(XPDIDCNT)
 Q
 ;
VOLERR(V,F) ;volume set not updated,V=volume set, F=flag
 N XQA,XQAMSG,XPDMES
 S XPDMES(1)=" ",XPDMES(2)=" ** Job on VOLUME SET "_V_$S(F:" never started **",1:" has been idle for an hour.")
 S XPDMES(3)=" ** "_V_" has NOT been updated! **"
 S XQA(DUZ)="",XQAMSG="VOLUME SET "_V_" NOT updated for Install "_$E($P($G(^XPD(9.7,+$G(XPDA),0)),"^"),1,30)
 D MES^XPDUTL(.XPDMES),SETUP^XQALERT
 Q
 ;come here on error, record error in Install file and cleanup var.
ERR N XPDERROR,XQA,XQAMSG
 S XPDERROR=$$EC^%ZOSV
 ;record error, write message, reset terminal
 D ^%ZTER,BMES^XPDUTL(XPDERROR),EXIT^XPDID()
 S XQA(DUZ)="",XQAMSG="Install "_$E($P($G(^XPD(9.7,+$G(XPDA),0)),"^"),1,30)_" has encountered an Error."
 D SETUP^XQALERT G UNWIND^%ZTER
 ;
LNRF(RN) ;Load needed routines first
 I $D(^XTMP("XPDI",XPDA,"RTN",RN)) D
 .N DIE,XCM,XCN,XCS,X
 .S DIE="^XTMP(""XPDI"",XPDA,""RTN"",RN,",XCN=0,X=RN
 .X ^%ZOSF("SAVE")
 .S XCN=$$RTNUP^XPDUTL(RN,2)
 Q

XPDIJ1
XPDIJ1 ;SFISC/RSD - Cont. of Install Job ;05/11/2001  09:07 [ 04/02/2003   8:29 AM ]
 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
 ;;8.0;KERNEL;**41,68,108,200**;Jul 10, 1995
IN ;install XPDA
 ;XPDA=ien of file 9.7, XPDNM=package name
 Q:'$D(^XTMP("XPDI",XPDA))!'$D(^XPD(9.7,XPDA,0))
 ;check if already installed
 I $P($G(^XPD(9.7,XPDA,1)),U,3) D BMES^XPDUTL(" "_XPDNM_" Already Installed ") Q
 N DIFROM,XPD,XPD0,XPDBLD,XPDCHECK,XPDCP,XPDI,XPDGREF,XPDIST,XPDIDTOT,XPDIDCNT,XPDIDMOD,XPDRTN
 ;XPDBLD subscript for build entry i.e. ^XTMP("XPDI",XPDA,"BLD",XPDBLD
 S DIFROM=$$VER^XPDUTL(XPDNM),XPDBLD=$O(^XTMP("XPDI",XPDA,"BLD",0)),XPDGREF="^XTMP(""XPDI"","_XPDA_",""TEMP"")"
 D TITLE^XPDID(XPDNM)
 ;the $T is there only for installing patch 41 to prevent a noline error
 ;check that Package file has entry
 I $T(PKGADD^XPDIP)]"" S Y=$$PKGADD^XPDIP
 S XPD0=^XTMP("XPDI",XPDA,"BLD",XPDBLD,0)
 I '$$CHK(11) D
 .D BMES^XPDUTL(" Install Started for "_XPDNM_" : "),STMP(11)
 .;update status, installed by fields and distribution date
 .S XPD(9.7,XPDA_",",.02)=2,XPD(9.7,XPDA_",",9)=DUZ,XPD(9.7,XPDA_",",51)=$P(XPD0,U,4)
 .D FILE^DIE("","XPD")
 E  D BMES^XPDUTL(" Install Restarted for "_XPDNM_" at "_$$HTE^XLFDT($H))
 D BMES^XPDUTL("Build Distribution Date: "_$$FMTE^XLFDT($P(XPD0,U,4)))
 D RTN Q:$D(XPDABORT)
 D PRE Q:$D(XPDABORT)
 D FMDATA Q:$D(XPDABORT)
 D COMP Q:$D(XPDABORT)
 D POST:$G(XPDT("MASTER"))'=XPDA
 Q  ;Finshed
 ;
RTN I '$$CHK(12) D
 .D BMES^XPDUTL(" Installing Routines:"),SETTOT^XPDID(9.8),RTN^XPDIJ(XPDA),STMP(12)
 E  D BMES^XPDUTL(" Routines already installed.")
 Q
 ;
PRE S XPDCP="INI"
 ;check if pre-install has completed
 I '$$VERCP^XPDUTL("XPD PREINSTALL COMPLETED") D  Q:$D(XPDABORT)
 .;setup XPDQUES array with pre-install questions/answers
 .D QUES^XPDIQ("PRE")
 .;XPDCHECK=ien of current checkpoint, (0)=name of checkpoint
 .;XPDCP="INI"-pre install or "INIT"-post install
 .;loop thru check points starting with INSTALL STARTED
 .S XPDCHECK=1
 .F  S XPDCHECK=$O(^XPD(9.7,XPDA,"INI",XPDCHECK)) Q:'XPDCHECK  S XPD=^(XPDCHECK,0) D  Q:$D(XPDABORT)
 ..;if there is no call back, quit
 ..Q:$G(^XPD(9.7,XPDA,"INI",XPDCHECK,1))=""  S XPDRTN=^(1)
 ..;check if checkpoint has been completed
 ..Q:$P(XPD,U,2)
 ..I XPDCHECK=2 D BMES^XPDUTL(" Running Pre-Install Routine: "_XPDRTN)
 ..;zero the progress bar
 ..I $D(XPDIDVT) S XPDIDTOT=0 D UPDATE^XPDID(0)
 ..D @XPDRTN
 ..;write message and abort if developer wants
 ..I $D(XPDABORT) D BMES^XPDUTL("Install ** ABORTED ** in Pre-Install program") Q
 ..S %=$$COMCP^XPDUTL(XPDCHECK)
 .Q:$D(XPDABORT)
 .;complete pre-init check point
 .S %=$$COMCP^XPDUTL("XPD PREINSTALL COMPLETED")
 E  D BMES^XPDUTL(" Pre-Install already finished.")
 Q
 ;
FMDATA ;build XPDQUES arrays for all of the FM Files
 D QUES^XPDIQ("XPF")
 ;check the last file and see if it's already installed
 S XPD=$G(^(+$O(^XPD(9.7,XPDA,4,"A"),-1),0))
 I '$P(XPD,U,2) D:$D(^XTMP("XPDI",XPDA,"FIA"))
 .D BMES^XPDUTL(" Installing Data Dictionaries: "),SETTOT^XPDID(4),FIA^XPDIK,MES^XPDUTL("               "_$$HTE^XLFDT($H))
 E  D BMES^XPDUTL(" Data Dictionaries already installed.")
 S %=+$O(^XTMP("XPDI",XPDA,"DATA",""),-1),XPD=$G(^XPD(9.7,XPDA,4,%,0))
 I '$P(XPD,U,3) D:%
 .D BMES^XPDUTL(" Installing Data: "),DAT^XPDIK,MES^XPDUTL("               "_$$HTE^XLFDT($H))
 E  D BMES^XPDUTL(" Data already installed.")
 Q
 ;
COMP S (%,XPD)=""
 F  S %=+$O(^XPD(9.7,XPDA,"KRN",%)) Q:'%  S XPD=$G(^(%,0)) Q:'$P(XPD,U,2)
 I '$P(XPD,U,2) D:$D(^XTMP("XPDI",XPDA,"KRN"))
 .D BMES^XPDUTL(" Installing PACKAGE COMPONENTS: "),KRN^XPDIK,MES^XPDUTL("               "_$$HTE^XLFDT($H))
 E  D BMES^XPDUTL(" PACKAGE COMPONENTS already installed.")
 Q
 ;
POST S XPDCP="INIT"
 ;check if post-install has completed
 I '$$VERCP^XPDUTL("XPD POSTINSTALL COMPLETED") D  Q:$D(XPDABORT)
 .;setup XPDQUES array with post-install questions/answers
 .D QUES^XPDIQ("POS")
 .;loop thru check points starting with INSTALL STARTED
 .S XPDCHECK=1
 .F  S XPDCHECK=$O(^XPD(9.7,XPDA,"INIT",XPDCHECK)) Q:'XPDCHECK  S XPD=^(XPDCHECK,0) D  Q:$D(XPDABORT)
 ..;if there is no call back, quit
 ..Q:$G(^XPD(9.7,XPDA,"INIT",XPDCHECK,1))=""  S XPDRTN=^(1)
 ..;quit if checkpoint has completed time
 ..Q:$P(XPD,U,2)
 ..I XPDCHECK=2 D BMES^XPDUTL(" Running Post-Install Routine: "_XPDRTN)
 ..;zero the progress bar
 ..I $D(XPDIDVT) S XPDIDTOT=0 D UPDATE^XPDID(0)
 ..D @XPDRTN
 ..;write message and abort if developer wants
 ..I $D(XPDABORT) D BMES^XPDUTL("Install ** ABORTED ** in Post-Install program") Q
 ..S %=$$COMCP^XPDUTL(XPDCHECK)
 .Q:$D(XPDABORT)
 .;complete post-init check point
 .S %=$$COMCP^XPDUTL("XPD POSTINSTALL COMPLETED")
 E  D BMES^XPDUTL(" Post-Install already finished.")
 ;move routines to install file & Routine file
 D BMES^XPDUTL(" Updating Routine file..."),SETTOT^XPDID(9.8),RTN^XPDIP
 ;XPDIST is flag for site tracking^A/B install message, it is set in PKG^XPDIP
 ;install Package file, OERR parameter multiple, and Build file
 S XPDIST="" D BMES^XPDUTL(" Updating KIDS files..."),PKG^XPDIP
 D BMES^XPDUTL(" "_XPDNM_" Installed. "),STMP(17)
 ;sends install messages local/forum
 S %=$$EN^XPDIST(XPDA,XPDIST) D BMES^XPDUTL(" "_$P("NO ",U,'$P(%,"#",2))_"Install Message sent "_%)
 Q
CHK(X) ;check checkpoints in file 9.7, X=field #, returns 1=completed, 0=not completed
 Q $$GET1^DIQ(9.7,XPDA_",",X,"I")]""
 ;
STMP(X) ;timestamp checkpoints in file 9.7, X=field #
 N XPD,%
 S %=$$NOW^XLFDT,XPD(9.7,XPDA_",",X)=%
 D MES^XPDUTL("               "_$$FMTE^XLFDT(%)),FILE^DIE("","XPD")
 Q
 ;
INHIBIT(SET) ;Set/Clear the Inhibit logon field.
 N VOL,IEN
 F IEN=0:0 S IEN=$O(^%ZIS(14.5,IEN)) Q:IEN'>0  D
 . I $P(^%ZIS(14.5,IEN,0),U,11)=1 S VOL(14.5,IEN_",",1)=SET
 . Q
 D FILE^DIE("","VOL")
 Q

XPDT
XPDT ;SFISC/RSD - Transport a package ;04/01/99  17:10 [ 04/02/2003  1:49 PM ]
 ;;8.0;KERNEL;**1001,1002,1003,1004,1005,1007**;APR 1, 2003
 ;;8.0;KERNEL;**2,10,28,41,44,51,58,66,68,85,100,108**;Jul 10, 1995
EN ;build XTMP("XPDT",ien, XPDA=ien,XPDNM=name
 ;XPDT(seq #)=ien^name^1=use current transport global on system
 ;XPDT("DA",ien)=seq #
 ;XPDVER=version number^package name
 ;XPDGP=flag;global^flag;global^...  flag=1 replace global at site
 N DIR,DIRUT,I,POP,XPD,XPDA,XPDERR,XPDGP,XPDGREF,XPDH,XPDH1,XPDHD,XPDI,XPDNM,XPDSEQ,XPDSIZ,XPDSIZA,XPDT,XPDTP,XPDVER,X,Y,Z
 K ^TMP($J,"XPD")
 S XPD="First Package Name: ",DIR(0)="Y",DIR("A")="   Use this Transport Global",DIR("?")="Yes, will use the current Transport Global on your system. No, will create a new one.",XPDT=0
 W !!,"Enter the Package Names to be transported. The order in which",!,"they are entered will be the order in which they are installed.",!!
 F  S XPDA=$$DIC^XPDE("AEMQZ",XPD) Q:'XPDA  D  Q:$D(DIRUT)!$D(XPDERR)
 .S:'XPDT XPD="Another Package Name: "
 .;XPDI=name^1=use current transport global
 .S XPDI=$P(Y(0),U)_"^"
 .I $D(XPDT("DA",XPDA)) W "   ",$P(Y(0),U)," already listed",! Q
 .;if type is Global Package, set DIRUT if there is other packages
 .I $P(Y(0),U,3)=2 W "   GLOBAL PACKAGE" D  Q
 ..;if there is already a package in distribution, abort
 ..I XPDT S DIRUT=1 W !,"A GLOBAL PACKAGE cannot be sent with any other packages" Q
 ..I $D(^XTMP("XPDT",XPDA)) W "  **Cannot have a pre-existing Transport Global**" S DIRUT=1 Q
 ..W !?10,"will transport the following globals:",! S X=0,XPDGP=""
 ..F  S X=$O(^XPD(9.6,XPDA,"GLO",X)) Q:'X  S Z=$G(^(X,0)) I $P(Z,U)]"" S XPDGP=XPDGP_($P(Z,U,2)="y")_";"_$P(Z,U)_"^" W ?12,$P(Z,U),!
 ..;XPDERR is set to quit loop, so no other packages can be added
 ..S XPDERR=1,XPDT=XPDT+1,XPDT(XPDT)=XPDA_U_XPDI,XPDT("DA",XPDA)=XPDT
 .Q:$D(XPDERR)
 .D PCK(XPDA,XPDI)
 .;multi-package
 .Q:$P(Y(0),U,3)'=1
 .I XPDT>1 S DIRUT=1 W !,"A Master Build must be the first/only package in a transport" Q
 .F  S X=$O(^XPD(9.6,XPDA,10,X)) Q:'X  S Z=$P($G(^(X,0)),U),Z1=$P($G(^(0)),U,2) D:Z]""
 ..N XPDA,X
 ..W !?3,Z S XPDA=$O(^XPD(9.6,"B",Z,0))
 ..I 'XPDA W "  **Can't find definition in Build file**" Q
 ..I $D(XPDT("DA",XPDA)) W "  already listed" Q
 ..D PCK(XPDA,Z,Z1)
 .S XPDERR=1 ;XPDERR is set to quit loop, so no other packages can be added
 .Q
 G:'XPDT!$D(DIRUT) QUIT K XPDERR
 W !!,"ORDER   PACKAGE",!
 F XPDT=1:1:XPDT S Y=$P(XPDT(XPDT),U,2) W ?2,XPDT,?7,Y D  W !
 .W:$P(XPDT(XPDT),U,3) "     **will use current Transport Global**"
 S DIR(0)="Y",DIR("A")="OK to continue",DIR("B")="NO",XPDH=""
 W !! D ^DIR G:$D(DIRUT)!'Y QUIT K DIR
 I $G(XPDTP),XPDT>1 W !!,"You cannot send multiple Builds through PackMan."
 S DIR(0)="SAO^HF:Host File"_$S(XPDT=1:";PM:PackMan",1:"")
 S DIR("A")="Transport through (HF)Host File"_$S(XPDT=1:" or (PM)PackMan: ",1:": ")
 S DIR("?")="Enter the method of transport for the package(s)."
 D ^DIR G:$D(DTOUT)!$D(DUOUT) QUIT K DIR
 I Y="" W !,"No Transport Method selected, will only write Transport Global to ^XTMP." S XPDH=""
 ;XPDTP = transports using Packman
 S:Y="PM" XPDTP=1
 I $D(XPDGP),Y'="HF" W !,"**Global Package can only be sent with a Host File, Transport ABORTED**" Q
 I Y="HF" D DEV G:POP QUIT
 W !!
 F XPDT=1:1:XPDT S XPDA=XPDT(XPDT),XPDNM=$P(XPDA,U,2) D  G:$D(XPDERR) ABORT
 .W !?5,XPDNM,"..." S XPDGREF="^XTMP(""XPDT"","_+XPDA_",""TEMP"")"
 .;if using current transport global, run pre-transp routine and quit
 .I $P(XPDA,U,3) S XPDA=+XPDA D PRET Q
 .;if package file link then set XPDVER=version number^package name
 .S XPDA=+XPDA,XPDVER=$S($P(^XPD(9.6,XPDA,0),U,2):$$VER^XPDUTL(XPDNM)_U_$$PKG^XPDUTL(XPDNM),1:"")
 .K ^XTMP("XPDT",XPDA)
 .;GLOBAL PACKAGE
 .I $D(XPDGP) D  S XPDT=1 Q
 ..;can't send global package in packman message
 ..I $G(XPDTP) S XPDERR=1 Q
 ..;verify global package
 ..I '$$GLOPKG^XPDV(XPDA) S XPDERR=1 Q
 ..;get Environment check and Post Install routines
 ..F Y="PRE","INIT" I $G(^XPD(9.6,XPDA,Y))]"" S X=^(Y) D
 ...S ^XTMP("XPDT",XPDA,Y)=X,X=$P(X,U,$L(X,U)),%=$$LOAD^XPDTA(X,"0^")
 ..D BLD^XPDTC,PRET
 .F X="DD^XPDTC","KRN^XPDTC","QUES^XPDTC","INT^XPDTC","BLD^XPDTC" D @X Q:$D(XPDERR)
 .D:'$D(XPDERR) PRET
 ;XPDTP - call ^XPDTP to build Packman message
 I $G(XPDTP) S XPDA=+XPDT(XPDT) D ^XPDTP G QUIT
 I $L(XPDH) D GO G QUIT
 ;if no device then just create transport global
 W !! F XPDT=1:1:XPDT W "Transport Global ^XTMP(""XPDT"","_+XPDT(XPDT)_") created for ",$P(XPDT(XPDT),U,2),!
 Q
DEV N FIL,DIR,IOP,X,Y,%ZIS W !
 D HOME^%ZIS
 S DIR(0)="F^3:45",DIR("A")="Enter a Host File",DIR("?")="Enter a filename and/or path to output package(s).",POP=0
 D ^DIR I $D(DTOUT)!$D(DUOUT) S POP=1 Q
 ;if no file, then quit
 Q:Y=""  S FIL=Y
 S DIR(0)="F^3:80",DIR("A")="Header Comment",DIR("?")="Enter a comment between 3 and 80 charaters."
 D ^DIR I $D(DIRUT) S POP=1 Q
 S XPDH=Y,%ZIS="",%ZIS("HFSNAME")=FIL,%ZIS("HFSMODE")="W",IOP="HFS",(XPDSIZ,XPDSIZA)=0,XPDSEQ=1
 D ^%ZIS I POP W !!,"**Incorrect Host File name**",!,$C(7) Q
 ;write date and comment header
 S XPDHD="KIDS Distribution saved on "_$$HTE^XLFDT($H)
 U IO W $$SUM(XPDHD),!,$$SUM(XPDH),!
 ;U IO(0) is to insure I am writing to the terminal
 U IO(0) Q
 ;
GO S I=1,Y="",XPDH1="**KIDS**:" U IO
 ;Global Package, header is different and there is only 1 package
 I $D(XPDGP) W $$SUM("**KIDS**GLOBALS:"_$P(XPDT(1),U,2)_U_XPDGP),! G GO1
 ;write header that maintains package list, keep less than 255 char
 F  D  W $$SUM(XPDH1_Y),! Q:I=XPDT  S Y="",I=I+1,XPDH1="**KIDS**"
 .F I=I:1 S Y=Y_$P(XPDT(I),U,2)_"^" Q:$L(Y)>200!(I=XPDT)
 ;after the package list write an extra line feed
GO1 W ! S XPDSIZA=XPDSIZA+2
 ;loop thru & write global, don't kill if set to permanent, set in XPDIU
 F XPDT=1:1:XPDT S XPDA=+XPDT(XPDT),XPDNM=$P(XPDT(XPDT),U,2) D GW K:'$G(^XTMP("XPDT",XPDA)) ^(XPDA)
 W "**END**",!
 ;GLOBAL PACKAGE there could only be one package, write globals
 I $D(XPDGP) D GPW W "**END**",!
 ;we're done with device, close it
 W "**END**",! D ^%ZISC
 W !!,"Package Transported Successfully",!
 Q
GW ;global write
 N GR,GCK,GL
 S GCK="^XTMP(""XPDT"","_XPDA,GR=GCK_")",GCK=GCK_",",GL=$L(GCK)
 ;INSTALL NAME line will mark the begining of global for all lines until
 ;the next INSTALL NAME
 W $$SUM("**INSTALL NAME**",1),!,$$SUM(XPDNM),!
 F  Q:$D(DIRUT)  S GR=$Q(@GR) Q:GR=""!($E(GR,1,GL)'=GCK)  W $$SUM($P(GR,GCK,2),1),!,$$SUM(@GR),!
 Q
GPW ;global package write
 N I,G,GR,GCK,GL
 W !
 F I=1:1 S G=$P(XPDGP,U,I) Q:G=""  D
 .S GR="^"_$P(G,";",2),GCK=$S(GR[")":$E(GR,1,$L(GR)-1)_",",1:GR_"("),GL=$L(GCK)
 .;GLOBAL line will mark the begining of global for all lines until
 .;the next GLOBAL
 .W $$SUM("**GLOBAL**",1),!,$$SUM(GR),!
 .F  Q:$D(DIRUT)  S GR=$Q(@GR) Q:GR=""!($E(GR,1,GL)'=GCK)  W $$SUM($P(GR,GCK,2),1),!,$$SUM(@GR),!
 Q
QUIT F XPDT=1:1:XPDT L -^XPD(9.6,+XPDT(XPDT))
 Q
ABORT W !!,"**TRANSPORT ABORTED**",*7
 D QUIT
 F XPDT=1:1:XPDT K ^XTMP("XPDT",+XPDT(XPDT))
 D ^%ZISC
 Q
 ;
PCK(XPDA,XPDNM,XPDREQ) ;XPDA=Build ien, XPDNM=Build name, XPDREQ=Required
 N Y
 S XPDT=XPDT+1,XPDT(XPDT)=XPDA_U_XPDNM,XPDT("DA",XPDA)=XPDT
 S:'$G(XPDREQ) XPDREQ=0
 S $P(XPDT(XPDT),U,4)=XPDREQ
 Q:'$D(^XTMP("XPDT",XPDA))  S Y=$G(^(XPDA))
 W "     **Transport Global exists**"
 ;Y=1 if TG is permanet
 I Y S $P(XPDT(XPDT),U,3)=1 Q
 ;ask if they want to use TG
 D ^DIR S $P(XPDT(XPDT),U,3)=Y
 Q
 ;
SUM(X,Z) ;X=string to write, Z 0=don't check size
 S XPDSIZA=XPDSIZA+$L(X)+2
 Q X
 ;
PRET ;Pre-Transport Routine
 N Y S Y=$G(^XPD(9.6,XPDA,"PRET")) Q:Y=""
 I '$$RTN^XPDV(Y) W !!,"Pre-Transportation Routine DOESN'T EXIST!!",*7 Q
 S Y=$S(Y["^":Y,1:"^"_Y) W !,"Running Pre-Transportation Routine ",Y
 D @Y Q
 ;
 ;
 ;FROM DEV
 ;if MSM and HFS file is on device A or B, then get size for floppy disk
 ;XPDSIZ=disk size, XPDSIZA=accummulated size,XPDSEQ=disk sequence number
 I ^%ZOSF("OS")["MSM",FIL?1(1"A",1"B")1":"1.E D  Q:POP
 .S DIR(0)="N^0:5000",DIR("A")="Size of Diskette (1K blocks)",DIR("B")=1400,DIR("?")="Enter the number of 1K blocks which each diskette will hold, 0 means unlimited space"
 .D ^DIR I $D(DIRUT) S POP=1 Q
 .S XPDSIZ=$S(Y:Y*1024,1:0)
 ;FROM SUM
 ;ask for next disk
 ;this code is for MSM system only
 I $G(Z),XPDSIZ,XPDSIZ-XPDSIZA<1024 D
 .;write continue flag at end of this file
 .W "**CONTINUE**",!,"**END**",!
 .;should call %ZIS HFS utilities to close and open file
 .C IO U IO(0)
 .N DIR,G,GR,GCK,GL,I,X,Y
 .W !!,"Diskette #",XPDSEQ," is full."
 .S DIR(0)="E",DIR("A")="Insert the next diskette and Press the return key",DIR("?")="The current diskette is full, insert a new diskette to continue."
 .;$D(DIRUT)=the user aborted the distribution
 .D ^DIR I $D(DIRUT) D ABORT Q
 .W ! S XPDSEQ=XPDSEQ+1,XPDSIZA=0
 .;MSM specific code to open HFS
 .O @(""""_IO_""":"_IOPAR) U IO
 .W $$SUM("Continuation #"_XPDSEQ_" of "_XPDHD),!,$$SUM(XPDH),!,$$SUM("**SEQ**:"_XPDSEQ),!!
 .S XPDSIZA=XPDSIZA+2