| 1 | XPDT ;SFISC/RSD - Transport a package ;06/21/2006
|
|---|
| 2 | ;;8.0;KERNEL;**2,10,28,41,44,51,58,66,68,85,100,108,393**;Jul 10, 1995;Build 12
|
|---|
| 3 | EN ;build XTMP("XPDT",ien, XPDA=ien,XPDNM=name
|
|---|
| 4 | ;XPDT(seq #)=ien^name^1=use current transport global on system
|
|---|
| 5 | ;XPDT("DA",ien)=seq #
|
|---|
| 6 | ;XPDVER=version number^package name
|
|---|
| 7 | ;XPDGP=flag;global^flag;global^... flag=1 replace global at site
|
|---|
| 8 | N DIR,DIRUT,I,POP,XPD,XPDA,XPDERR,XPDGP,XPDGREF,XPDH,XPDH1,XPDHD,XPDI,XPDNM,XPDSEQ,XPDSIZ,XPDSIZA,XPDT,XPDTP,XPDVER
|
|---|
| 9 | N XPDFMSG,X,Y,Z
|
|---|
| 10 | K ^TMP($J,"XPD")
|
|---|
| 11 | 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
|
|---|
| 12 | W !!,"Enter the Package Names to be transported. The order in which",!,"they are entered will be the order in which they are installed.",!!
|
|---|
| 13 | F S XPDA=$$DIC^XPDE("AEMQZ",XPD) Q:'XPDA D Q:$D(DIRUT)!$D(XPDERR)
|
|---|
| 14 | .S:'XPDT XPD="Another Package Name: "
|
|---|
| 15 | .;XPDI=name^1=use current transport global
|
|---|
| 16 | .S XPDI=$P(Y(0),U)_"^"
|
|---|
| 17 | .I $D(XPDT("DA",XPDA)) W " ",$P(Y(0),U)," already listed",! Q
|
|---|
| 18 | .;if type is Global Package, set DIRUT if there is other packages
|
|---|
| 19 | .I $P(Y(0),U,3)=2 W " GLOBAL PACKAGE" D Q
|
|---|
| 20 | ..;if there is already a package in distribution, abort
|
|---|
| 21 | ..I XPDT S DIRUT=1 W !,"A GLOBAL PACKAGE cannot be sent with any other packages" Q
|
|---|
| 22 | ..I $D(^XTMP("XPDT",XPDA)) W " **Cannot have a pre-existing Transport Global**" S DIRUT=1 Q
|
|---|
| 23 | ..W !?10,"will transport the following globals:",! S X=0,XPDGP=""
|
|---|
| 24 | ..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),!
|
|---|
| 25 | ..;XPDERR is set to quit loop, so no other packages can be added
|
|---|
| 26 | ..S XPDERR=1,XPDT=XPDT+1,XPDT(XPDT)=XPDA_U_XPDI,XPDT("DA",XPDA)=XPDT
|
|---|
| 27 | .Q:$D(XPDERR)
|
|---|
| 28 | .D PCK(XPDA,XPDI)
|
|---|
| 29 | .;multi-package
|
|---|
| 30 | .Q:$P(Y(0),U,3)'=1
|
|---|
| 31 | .W " (Multi-Package)" S X=0
|
|---|
| 32 | .I XPDT>1 S DIRUT=1 W !,"A Master Build must be the first/only package in a transport" Q
|
|---|
| 33 | .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]""
|
|---|
| 34 | ..N XPDA,X
|
|---|
| 35 | ..W !?3,Z S XPDA=$O(^XPD(9.6,"B",Z,0))
|
|---|
| 36 | ..I 'XPDA W " **Can't find definition in Build file**" Q
|
|---|
| 37 | ..I $D(XPDT("DA",XPDA)) W " already listed" Q
|
|---|
| 38 | ..D PCK(XPDA,Z,Z1)
|
|---|
| 39 | .S XPDERR=1 ;XPDERR is set to quit loop, so no other packages can be added
|
|---|
| 40 | .Q
|
|---|
| 41 | G:'XPDT!$D(DIRUT) QUIT K XPDERR
|
|---|
| 42 | W !!,"ORDER PACKAGE",!
|
|---|
| 43 | F XPDT=1:1:XPDT S Y=$P(XPDT(XPDT),U,2) W ?2,XPDT,?7,Y D W !
|
|---|
| 44 | .W:$P(XPDT(XPDT),U,3) " **will use current Transport Global**"
|
|---|
| 45 | S DIR(0)="Y",DIR("A")="OK to continue",DIR("B")="NO",XPDH=""
|
|---|
| 46 | W !! D ^DIR G:$D(DIRUT)!'Y QUIT K DIR
|
|---|
| 47 | I $G(XPDTP),XPDT>1 W !!,"You cannot send multiple Builds through PackMan."
|
|---|
| 48 | S DIR(0)="SAO^HF:Host File"_$S(XPDT=1:";PM:PackMan",1:"")
|
|---|
| 49 | S DIR("A")="Transport through (HF)Host File"_$S(XPDT=1:" or (PM)PackMan: ",1:": ")
|
|---|
| 50 | S DIR("?")="Enter the method of transport for the package(s)."
|
|---|
| 51 | D ^DIR G:$D(DTOUT)!$D(DUOUT) QUIT K DIR
|
|---|
| 52 | I Y="" W !,"No Transport Method selected, will only write Transport Global to ^XTMP." S XPDH=""
|
|---|
| 53 | ;XPDTP = transports using Packman
|
|---|
| 54 | S:Y="PM" XPDTP=1
|
|---|
| 55 | I $D(XPDGP),Y'="HF" W !,"**Global Package can only be sent with a Host File, Transport ABORTED**" Q
|
|---|
| 56 | I Y="HF" D DEV G:POP QUIT
|
|---|
| 57 | W !!
|
|---|
| 58 | F XPDT=1:1:XPDT S XPDA=XPDT(XPDT),XPDNM=$P(XPDA,U,2) D G:$D(XPDERR) ABORT
|
|---|
| 59 | .W !?5,XPDNM,"..." S XPDGREF="^XTMP(""XPDT"","_+XPDA_",""TEMP"")"
|
|---|
| 60 | .;if using current transport global, run pre-transp routine and quit
|
|---|
| 61 | .I $P(XPDA,U,3) S XPDA=+XPDA D PRET Q
|
|---|
| 62 | .;if package file link then set XPDVER=version number^package name
|
|---|
| 63 | .S XPDA=+XPDA,XPDVER=$S($P(^XPD(9.6,XPDA,0),U,2):$$VER^XPDUTL(XPDNM)_U_$$PKG^XPDUTL(XPDNM),1:"")
|
|---|
| 64 | .;Inc the Build number
|
|---|
| 65 | .S $P(^XPD(9.6,XPDA,6.3),U)=$G(^XPD(9.6,XPDA,6.3))+1
|
|---|
| 66 | .K ^XTMP("XPDT",XPDA)
|
|---|
| 67 | .;GLOBAL PACKAGE
|
|---|
| 68 | .I $D(XPDGP) D S XPDT=1 Q
|
|---|
| 69 | ..;can't send global package in packman message
|
|---|
| 70 | ..I $G(XPDTP) S XPDERR=1 Q
|
|---|
| 71 | ..;verify global package
|
|---|
| 72 | ..I '$$GLOPKG^XPDV(XPDA) S XPDERR=1 Q
|
|---|
| 73 | ..;get Environment check and Post Install routines
|
|---|
| 74 | ..F Y="PRE","INIT" I $G(^XPD(9.6,XPDA,Y))]"" S X=^(Y) D
|
|---|
| 75 | ...S ^XTMP("XPDT",XPDA,Y)=X,X=$P(X,U,$L(X,U)),%=$$LOAD^XPDTA(X,"0^")
|
|---|
| 76 | ..D BLD^XPDTC,PRET
|
|---|
| 77 | .F X="DD^XPDTC","KRN^XPDTC","QUES^XPDTC","INT^XPDTC","BLD^XPDTC" D @X Q:$D(XPDERR)
|
|---|
| 78 | .D:'$D(XPDERR) PRET
|
|---|
| 79 | ;XPDTP - call ^XPDTP to build Packman message
|
|---|
| 80 | I $G(XPDTP) S XPDA=+XPDT(XPDT) D ^XPDTP G QUIT
|
|---|
| 81 | I $L(XPDH) D GO G QUIT
|
|---|
| 82 | ;if no device then just create transport global
|
|---|
| 83 | W !! F XPDT=1:1:XPDT W "Transport Global ^XTMP(""XPDT"","_+XPDT(XPDT)_") created for ",$P(XPDT(XPDT),U,2),!
|
|---|
| 84 | Q
|
|---|
| 85 | DEV N FIL,DIR,IOP,X,Y,%ZIS W !
|
|---|
| 86 | D HOME^%ZIS
|
|---|
| 87 | S DIR(0)="F^3:245",DIR("A")="Enter a Host File",DIR("?")="Enter a filename and/or path to output package(s).",POP=0
|
|---|
| 88 | D ^DIR I $D(DTOUT)!$D(DUOUT) S POP=1 Q
|
|---|
| 89 | ;if no file, then quit
|
|---|
| 90 | Q:Y="" S FIL=Y
|
|---|
| 91 | S DIR(0)="F^3:80",DIR("A")="Header Comment",DIR("?")="Enter a comment between 3 and 80 charaters."
|
|---|
| 92 | D ^DIR I $D(DIRUT) S POP=1 Q
|
|---|
| 93 | S XPDH=Y,%ZIS="",%ZIS("HFSNAME")=FIL,%ZIS("HFSMODE")="W",IOP="HFS",(XPDSIZ,XPDSIZA)=0,XPDSEQ=1
|
|---|
| 94 | D ^%ZIS I POP W !!,"**Incorrect Host File name**",!,$C(7) Q
|
|---|
| 95 | ;write date and comment header
|
|---|
| 96 | S XPDHD="KIDS Distribution saved on "_$$HTE^XLFDT($H)
|
|---|
| 97 | U IO W $$SUM(XPDHD),!,$$SUM(XPDH),!
|
|---|
| 98 | S XPDFMSG=1 ;Send mail to forum of routines in HFS.
|
|---|
| 99 | ;U IO(0) is to insure I am writing to the terminal
|
|---|
| 100 | U IO(0) Q
|
|---|
| 101 | ;
|
|---|
| 102 | GO S I=1,Y="",XPDH1="**KIDS**:" U IO
|
|---|
| 103 | ;Global Package, header is different and there is only 1 package
|
|---|
| 104 | I $D(XPDGP) W $$SUM("**KIDS**GLOBALS:"_$P(XPDT(1),U,2)_U_XPDGP),! G GO1
|
|---|
| 105 | ;write header that maintains package list, keep less than 255 char
|
|---|
| 106 | F D W $$SUM(XPDH1_Y),! Q:I=XPDT S Y="",I=I+1,XPDH1="**KIDS**"
|
|---|
| 107 | .F I=I:1 S Y=Y_$P(XPDT(I),U,2)_"^" Q:$L(Y)>200!(I=XPDT)
|
|---|
| 108 | ;after the package list write an extra line feed
|
|---|
| 109 | GO1 W ! S XPDSIZA=XPDSIZA+2
|
|---|
| 110 | N XMSUB,XMY,XMTEXT
|
|---|
| 111 | ;loop thru & write global, don't kill if set to permanent, set in XPDIU
|
|---|
| 112 | F XPDT=1:1:XPDT S XPDA=+XPDT(XPDT),XPDNM=$P(XPDT(XPDT),U,2) D GW,XM K:'$G(^XTMP("XPDT",XPDA)) ^(XPDA)
|
|---|
| 113 | W "**END**",!
|
|---|
| 114 | ;GLOBAL PACKAGE there could only be one package, write globals
|
|---|
| 115 | I $D(XPDGP) D GPW W "**END**",!
|
|---|
| 116 | ;we're done with device, close it
|
|---|
| 117 | W "**END**",! D ^%ZISC
|
|---|
| 118 | W !!,"Package Transported Successfully",!
|
|---|
| 119 | Q
|
|---|
| 120 | GW ;global write
|
|---|
| 121 | N GR,GCK,GL
|
|---|
| 122 | S GCK="^XTMP(""XPDT"","_XPDA,GR=GCK_")",GCK=GCK_",",GL=$L(GCK)
|
|---|
| 123 | ;INSTALL NAME line will mark the begining of global for all lines until
|
|---|
| 124 | ;the next INSTALL NAME
|
|---|
| 125 | W $$SUM("**INSTALL NAME**",1),!,$$SUM(XPDNM),!
|
|---|
| 126 | F Q:$D(DIRUT) S GR=$Q(@GR) Q:GR=""!($E(GR,1,GL)'=GCK) W $$SUM($P(GR,GCK,2),1),!,$$SUM(@GR),!
|
|---|
| 127 | Q
|
|---|
| 128 | XM ;Send HFS checksum message
|
|---|
| 129 | Q:'$G(XPDFMSG)
|
|---|
| 130 | N XMTEXT,C,RN,X,X2
|
|---|
| 131 | K ^TMP($J)
|
|---|
| 132 | S XMSUB="**KIDS** Checksum for "_XPDNM,XMTEXT="^TMP($J)"
|
|---|
| 133 | I $G(^XMB("NETNAME"))["VA.GOV" S XMY("S.A1AE HFS CHKSUM SVR@FORUM.VA.GOV")=""
|
|---|
| 134 | E S X=$$GET^XPAR("PKG","XPD PATCH HFS SERVER",1,"Q") S:$L(X) XMY(X)=""
|
|---|
| 135 | I '$D(XMY) Q ;No one to send it to.
|
|---|
| 136 | S C=1,@XMTEXT@(1,0)="~~1:"_XPDNM
|
|---|
| 137 | I XPDT=1,$O(XPDT(1)) D
|
|---|
| 138 | . S RN=1 F S RN=$O(XPDT(RN)) Q:'RN S C=C+1,@XMTEXT@(C,0)="~~2:"_$P(XPDT(RN),"^",2)
|
|---|
| 139 | S RN="" ;Send full RTN node
|
|---|
| 140 | F S RN=$O(^XTMP("XPDT",XPDA,"RTN",RN)) Q:'$L(RN) S X=^(RN),X2=$G(^(RN,2,0)),C=C+1,@XMTEXT@(C,0)="~~3:"_RN_"^"_X_"^"_$P(X2,";",5)
|
|---|
| 141 | S C=C+1,@XMTEXT@(C,0)="~~8:"_$G(^XMB("NETNAME"))
|
|---|
| 142 | S C=C+1,@XMTEXT@(C,0)="~~9:Save"
|
|---|
| 143 | S XMTEXT="^TMP($J,"
|
|---|
| 144 | D ^XMD
|
|---|
| 145 | Q
|
|---|
| 146 | GPW ;global package write
|
|---|
| 147 | N I,G,GR,GCK,GL
|
|---|
| 148 | W !
|
|---|
| 149 | F I=1:1 S G=$P(XPDGP,U,I) Q:G="" D
|
|---|
| 150 | .S GR="^"_$P(G,";",2),GCK=$S(GR[")":$E(GR,1,$L(GR)-1)_",",1:GR_"("),GL=$L(GCK)
|
|---|
| 151 | .;GLOBAL line will mark the begining of global for all lines until
|
|---|
| 152 | .;the next GLOBAL
|
|---|
| 153 | .W $$SUM("**GLOBAL**",1),!,$$SUM(GR),!
|
|---|
| 154 | .F Q:$D(DIRUT) S GR=$Q(@GR) Q:GR=""!($E(GR,1,GL)'=GCK) W $$SUM($P(GR,GCK,2),1),!,$$SUM(@GR),!
|
|---|
| 155 | Q
|
|---|
| 156 | QUIT F XPDT=1:1:XPDT L -^XPD(9.6,+XPDT(XPDT))
|
|---|
| 157 | Q
|
|---|
| 158 | ABORT W !!,"**TRANSPORT ABORTED**",*7
|
|---|
| 159 | D QUIT
|
|---|
| 160 | F XPDT=1:1:XPDT K ^XTMP("XPDT",+XPDT(XPDT))
|
|---|
| 161 | D ^%ZISC
|
|---|
| 162 | Q
|
|---|
| 163 | ;
|
|---|
| 164 | PCK(XPDA,XPDNM,XPDREQ) ;XPDA=Build ien, XPDNM=Build name, XPDREQ=Required
|
|---|
| 165 | N Y
|
|---|
| 166 | S XPDT=XPDT+1,XPDT(XPDT)=XPDA_U_XPDNM,XPDT("DA",XPDA)=XPDT
|
|---|
| 167 | S:'$G(XPDREQ) XPDREQ=0
|
|---|
| 168 | S $P(XPDT(XPDT),U,4)=XPDREQ
|
|---|
| 169 | Q:'$D(^XTMP("XPDT",XPDA)) S Y=$G(^(XPDA))
|
|---|
| 170 | W " **Transport Global exists**"
|
|---|
| 171 | ;Y=1 if TG is permanet
|
|---|
| 172 | I Y S $P(XPDT(XPDT),U,3)=1 Q
|
|---|
| 173 | ;ask if they want to use TG
|
|---|
| 174 | D ^DIR S $P(XPDT(XPDT),U,3)=Y
|
|---|
| 175 | Q
|
|---|
| 176 | ;
|
|---|
| 177 | SUM(X,Z) ;X=string to write, Z 0=don't check size
|
|---|
| 178 | S XPDSIZA=XPDSIZA+$L(X)+2
|
|---|
| 179 | Q X
|
|---|
| 180 | ;
|
|---|
| 181 | PRET ;Pre-Transport Routine
|
|---|
| 182 | N Y S Y=$G(^XPD(9.6,XPDA,"PRET")) Q:Y=""
|
|---|
| 183 | I '$$RTN^XPDV(Y) W !!,"Pre-Transportation Routine DOESN'T EXIST!!",*7 Q
|
|---|
| 184 | S Y=$S(Y["^":Y,1:"^"_Y) W !,"Running Pre-Transportation Routine ",Y
|
|---|
| 185 | D @Y Q
|
|---|
| 186 | ;
|
|---|
| 187 | ;
|
|---|
| 188 | ;FROM DEV
|
|---|
| 189 | ;if MSM and HFS file is on device A or B, then get size for floppy disk
|
|---|
| 190 | ;XPDSIZ=disk size, XPDSIZA=accummulated size,XPDSEQ=disk sequence number
|
|---|
| 191 | I ^%ZOSF("OS")["MSM",FIL?1(1"A",1"B")1":"1.E D Q:POP
|
|---|
| 192 | .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"
|
|---|
| 193 | .D ^DIR I $D(DIRUT) S POP=1 Q
|
|---|
| 194 | .S XPDSIZ=$S(Y:Y*1024,1:0)
|
|---|
| 195 | ;FROM SUM
|
|---|
| 196 | ;ask for next disk
|
|---|
| 197 | ;this code is for MSM system only
|
|---|
| 198 | I $G(Z),XPDSIZ,XPDSIZ-XPDSIZA<1024 D
|
|---|
| 199 | .;write continue flag at end of this file
|
|---|
| 200 | .W "**CONTINUE**",!,"**END**",!
|
|---|
| 201 | .;should call %ZIS HFS utilities to close and open file
|
|---|
| 202 | .X "C IO" U IO(0)
|
|---|
| 203 | .N DIR,G,GR,GCK,GL,I,X,Y
|
|---|
| 204 | .W !!,"Diskette #",XPDSEQ," is full."
|
|---|
| 205 | .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."
|
|---|
| 206 | .;$D(DIRUT)=the user aborted the distribution
|
|---|
| 207 | .D ^DIR I $D(DIRUT) D ABORT Q
|
|---|
| 208 | .W ! S XPDSEQ=XPDSEQ+1,XPDSIZA=0
|
|---|
| 209 | .;MSM specific code to open HFS
|
|---|
| 210 | .X "O IO:IOPAR" U IO
|
|---|
| 211 | .W $$SUM("Continuation #"_XPDSEQ_" of "_XPDHD),!,$$SUM(XPDH),!,$$SUM("**SEQ**:"_XPDSEQ),!!
|
|---|
| 212 | .S XPDSIZA=XPDSIZA+2
|
|---|
