[628] | 1 | XPDDP ;SFISC/RSD - Display a package ;03/18/2008
|
---|
| 2 | ;;8.0;KERNEL;**21,28,44,68,100,108,229,304,346,463,488**;Jul 10, 1995;Build 6
|
---|
| 3 | ; Per VHA Directive 2004-038, this routine should not be modified.
|
---|
| 4 | ; Options: XPD PRINT BUILD calls EN1
|
---|
| 5 | ; XPD PRINT INSTALL calls EN2
|
---|
| 6 | EN1 ; Print from Build file
|
---|
| 7 | N DIC,D0,XPD,XPDT,XPDST,Y
|
---|
| 8 | S XPDST=$$LOOK^XPDB1 Q:XPDST<0
|
---|
| 9 | S XPD("XPDT(")=""
|
---|
| 10 | D EN^XUTMDEVQ("LST1^XPDDP","Build File Print",.XPD)
|
---|
| 11 | Q
|
---|
| 12 | EN2 ; Print from Distribution
|
---|
| 13 | N D0,DIC,POP,XPD,XPDA,XPDNM,XPDT,XPDST,Y,Z,%ZIS
|
---|
| 14 | S XPDST=$$LOOK^XPDI1("I $D(^XTMP(""XPDI"",Y))",1)
|
---|
| 15 | S D0=$O(^XTMP("XPDI",XPDST,"BLD",0)) Q:'D0
|
---|
| 16 | S XPD("XPDT(")=""
|
---|
| 17 | D EN^XUTMDEVQ("LST2^XPDDP","Transport Global Print",.XPD)
|
---|
| 18 | Q
|
---|
| 19 | LST1 ; Print from Build file
|
---|
| 20 | K DIRUT N XPDIT,XPDCNT S (XPDIT,XPDCNT)=0
|
---|
| 21 | F S XPDIT=$O(XPDT(XPDIT)) Q:$D(DIRUT)!(XPDIT'>0) D Q:$D(DIRUT)
|
---|
| 22 | . I XPDCNT Q:'$$CONT
|
---|
| 23 | . S XPDCNT=XPDCNT+1
|
---|
| 24 | . S D0=+XPDT(XPDIT) D PNT("XPD(9.6,D0)")
|
---|
| 25 | D WAIT
|
---|
| 26 | Q
|
---|
| 27 | LST2 ; Print from XPDT array
|
---|
| 28 | K DIRUT N XPDIT,XPDCNT S (XPDIT,XPDCNT)=0
|
---|
| 29 | F S XPDIT=$O(XPDT(XPDIT)) Q:$D(DIRUT)!(XPDIT'>0) D Q:$D(DIRUT)
|
---|
| 30 | . I XPDCNT Q:'$$CONT
|
---|
| 31 | . S XPDCNT=XPDCNT+1
|
---|
| 32 | . S XPDA=+XPDT(XPDIT),D0=$O(^XTMP("XPDI",XPDA,"BLD",0)) D PNT("XTMP(""XPDI"",XPDA,""BLD"",D0)")
|
---|
| 33 | D WAIT
|
---|
| 34 | Q
|
---|
| 35 | WAIT ; Pause on last page or not? It depends on whether there's enough room
|
---|
| 36 | ; left on the page to display the KIDS menu.
|
---|
| 37 | Q:$E($G(IOST),1,2)'="C-"
|
---|
| 38 | Q:$D(DIRUT)
|
---|
| 39 | ; DUZ("AUTO")=1 means show menu option choices
|
---|
| 40 | I IOSL-$Y<$S($G(DUZ("AUTO")):14,1:3) D WAIT^XMXUTIL
|
---|
| 41 | Q
|
---|
| 42 | PNT(XPDGR) ; Print a package, XPDGR=global root
|
---|
| 43 | ;XPDFL=0 - Build - ^XPD(9.7 global root
|
---|
| 44 | ; 1 - Install - ^XTMP global root
|
---|
| 45 | ; 2 - Packman - ^TMP($J, global root
|
---|
| 46 | N I,J,K,X,XPD,XPDDT,XPDI,XPD0,XPDFL,XPDPG,XPDUL,XPDTYPE,XPDTRACK,XPDTXT
|
---|
| 47 | Q:$G(XPDGR)="" S XPDGR="^"_XPDGR
|
---|
| 48 | Q:'$D(@XPDGR@(0))
|
---|
| 49 | D ID ; Package Identification
|
---|
| 50 | D DESCR Q:$D(DIRUT) ; Description
|
---|
| 51 | I XPDTYPE=1 D MULT Q ; Multi-Package
|
---|
| 52 | D PREPOST Q:$D(DIRUT) ; Environment check & Pre/Post Routines
|
---|
| 53 | I XPDTYPE=2 D GLOBAL Q ; Global Package
|
---|
| 54 | D FILES Q:$D(DIRUT) ; Files/DDs
|
---|
| 55 | D COMP Q:$D(DIRUT) ; Build Components
|
---|
| 56 | Q:XPDFL=2 ; Packman message, called from XMP2 - Summarize
|
---|
| 57 | D QUESTS Q:$D(DIRUT) ; Install Questions
|
---|
| 58 | D ALFABETA Q:$D(DIRUT) ; Alpha/Beta Testing
|
---|
| 59 | D NAMESP Q:$D(DIRUT) ; Include/Exclude Namespaces
|
---|
| 60 | D REQDBLD Q:$D(DIRUT) ; Required Builds
|
---|
| 61 | Q
|
---|
| 62 | ID ; Identify the package
|
---|
| 63 | S XPD0=^(0),XPDPG=1,XPDFL=$S($E(XPDGR,1,5)="^TMP(":2,1:$E(XPDGR,1,5)="^XTMP"),$P(XPDUL,"-",IOM)="",XPDDT=$$HTE^XLFDT($H,"1PM"),XPDTYPE=+$P(XPD0,U,3),XPDTRACK=$P(XPD0,U,5)
|
---|
| 64 | W:$E(IOST,1,2)="C-" @IOF D HDR W !,XPDUL
|
---|
| 65 | W !,"TYPE: ",$$EXTERNAL^DILFD(9.6,2,"",XPDTYPE)
|
---|
| 66 | W ?51,"TRACK NATIONALLY: ",$$EXTERNAL^DILFD(9.6,5,"",XPDTRACK)
|
---|
| 67 | W !,"NATIONAL PACKAGE: ",$P($G(^DIC(9.4,+$P(XPD0,U,2),0),$P(XPD0,U,2)),U)
|
---|
| 68 | W ?49,"ALPHA/BETA TESTING: ",$S($P($G(@XPDGR@("ABPKG")),U)="y":"YES",1:"NO")
|
---|
| 69 | Q
|
---|
| 70 | DESCR ; Show patch description
|
---|
| 71 | W !!,"DESCRIPTION:"
|
---|
| 72 | S XPDI=0
|
---|
| 73 | F S XPDI=$O(@XPDGR@(1,XPDI)) Q:'XPDI S XPDTXT=$G(^(XPDI,0)) D Q:$D(DIRUT)
|
---|
| 74 | . I $L(XPDTXT)'<IOM,$E(XPDTXT,$L(XPDTXT))=" " F S XPDTXT=$E(XPDTXT,1,$L(XPDTXT)-1) Q:$E(XPDTXT,$L(XPDTXT))'=" "
|
---|
| 75 | . F D Q:$L(XPDTXT)<IOM!$D(DIRUT)!(IOM<2) S XPDTXT=$E(XPDTXT,IOM,999)
|
---|
| 76 | . . Q:$$CHK(2)
|
---|
| 77 | . . W !,$S(IOM>1:$E(XPDTXT,1,IOM-1),1:XPDTXT)
|
---|
| 78 | Q
|
---|
| 79 | PREPOST ; Environment check and pre/post routines
|
---|
| 80 | Q:$$CHK(3)
|
---|
| 81 | W !!,"ENVIRONMENT CHECK: ",$G(@XPDGR@("PRE"))
|
---|
| 82 | W ?49,"DELETE ENV ROUTINE: " I $G(@XPDGR@("PRE"))]"" W $S($P($G(@XPDGR@("INID")),U)="y":"Yes",1:"No")
|
---|
| 83 | I 'XPDTYPE D Q:$D(DIRUT)
|
---|
| 84 | . Q:$$CHK(2)
|
---|
| 85 | . W !," PRE-INIT ROUTINE: ",$G(@XPDGR@("INI"))
|
---|
| 86 | . W ?44,"DELETE PRE-INIT ROUTINE: " I $G(@XPDGR@("INI"))]"" W $S($P($G(@XPDGR@("INID")),U,3)="y":"Yes",1:"No")
|
---|
| 87 | Q:$$CHK(2)
|
---|
| 88 | W !,"POST-INIT ROUTINE: ",$G(@XPDGR@("INIT"))
|
---|
| 89 | W ?43,"DELETE POST-INIT ROUTINE: " I $G(@XPDGR@("INIT"))]"" W $S($P($G(@XPDGR@("INID")),U,2)="y":"Yes",1:"No")
|
---|
| 90 | I 'XPDTYPE Q:$$CHK(2) W !,"PRE-TRANSPORT RTN: ",$G(@XPDGR@("PRET"))
|
---|
| 91 | Q
|
---|
| 92 | FILES ; Show files/DDs
|
---|
| 93 | Q:'$O(@XPDGR@(4,0)) ; Quit if no files
|
---|
| 94 | S I=$$CHK(8,1) Q:I I '$P(I,"^",2) D HDR1 W !,XPDUL
|
---|
| 95 | S XPDI=0
|
---|
| 96 | F S XPDI=$O(@XPDGR@(4,XPDI)) Q:'XPDI S XPD=$G(^(XPDI,222)) Q:$$CHK(3,1) D
|
---|
| 97 | . ;file number, file name, partial DD
|
---|
| 98 | . W !!,XPDI,?12,$S('XPDFL:$P($G(^DIC(XPDI,0),"**unknown**"),U),1:$G(^XTMP("XPDI",XPDA,"FIA",XPDI)))
|
---|
| 99 | . ; update DD, send security code, data comes with file
|
---|
| 100 | . W ?43,$$EXTERNAL^DILFD(9.64,222.1,"",$P(XPD,U)),?49,$$EXTERNAL^DILFD(9.64,222.2,"",$P(XPD,U,2)),?55,$$EXTERNAL^DILFD(9.64,222.7,"",$P(XPD,U,7))
|
---|
| 101 | . ; override site data, resolve pointers, user override
|
---|
| 102 | . W ?63,$E($$EXTERNAL^DILFD(9.64,222.8,"",$P(XPD,U,8)),1,4),?69,$$EXTERNAL^DILFD(9.64,222.5,"",$P(XPD,U,5)),?75,$$EXTERNAL^DILFD(9.64,222.9,"",$P(XPD,U,9))
|
---|
| 103 | . I $P(XPD,U,3)="p" D Q:$D(DIRUT)
|
---|
| 104 | . . ; Print partial DD information
|
---|
| 105 | . . N XPDSUB,XPDFLD
|
---|
| 106 | . . Q:$$CHK(2,1)
|
---|
| 107 | . . W !,"Partial DD:"
|
---|
| 108 | . . S (J,XPDSUB)=0
|
---|
| 109 | . . F S J=$O(@XPDGR@(4,"APDD",XPDI,J)) Q:'J D Q:$D(DIRUT)
|
---|
| 110 | . . . I XPDSUB Q:$$CHK(2,1) W !
|
---|
| 111 | . . . W ?12,"subDD: ",J
|
---|
| 112 | . . . S XPDSUB=1,(I,XPDFLD)=0
|
---|
| 113 | . . . F S I=$O(@XPDGR@(4,"APDD",XPDI,J,I)) Q:'I D Q:$D(DIRUT)
|
---|
| 114 | . . . . I XPDFLD Q:$$CHK(2,1) W !
|
---|
| 115 | . . . . W ?30,"fld: ",I S XPDFLD=1
|
---|
| 116 | . I " "'[$G(@XPDGR@(4,XPDI,223)) Q:$$CHK(2,1) W !,?2,"DD SCREEN : ",^(223)
|
---|
| 117 | . I " "'[$G(@XPDGR@(4,XPDI,224)) Q:$$CHK(2,1) W !,?2,"DATA SCREEN: ",^(224)
|
---|
| 118 | Q
|
---|
| 119 | COMP ; Print Build components
|
---|
| 120 | S I=0,XPD=$P(^DD(9.68,.03,0),U,3)
|
---|
| 121 | F S I=$O(@XPDGR@("KRN",I)) Q:'I D Q:$D(DIRUT)
|
---|
| 122 | . Q:'$D(@XPDGR@("KRN",I,"NM","B"))
|
---|
| 123 | . Q:$$CHK(4)
|
---|
| 124 | . W !!,$S($D(^DIC(I,0)):$P(^(0),U),XPDFL:$G(^XTMP("XPDI",XPDA,"FIA",I),"UNKNOWN"),1:"UNKNOWN")_":",?47,"ACTION:"
|
---|
| 125 | . S J=""
|
---|
| 126 | . F S J=$O(@XPDGR@("KRN",I,"NM","B",J)) Q:J="" S X=$O(^(J,0)) D Q:$D(DIRUT)
|
---|
| 127 | . . Q:'X
|
---|
| 128 | . . S X=$G(@XPDGR@("KRN",I,"NM",X,0)) Q:X=""
|
---|
| 129 | . . Q:$$CHK(2)
|
---|
| 130 | . . ;write the entry name and write the action
|
---|
| 131 | . . W !,?3,$P(X,U),?50,$P($P(XPD,";",$P(X,U,3)+1),":",2)
|
---|
| 132 | Q
|
---|
| 133 | QUESTS ; Show Install Questions
|
---|
| 134 | I '$O(@XPDGR@("QUES",0)),'($D(@XPDGR@("QDEF"))#2) Q
|
---|
| 135 | Q:$$CHK(6)
|
---|
| 136 | W !!,"INSTALL QUESTIONS: "
|
---|
| 137 | S I=0
|
---|
| 138 | F S I=$O(@XPDGR@("QUES",I)) Q:'I S X=$P(^(I,0),U),J=$G(^(1)),K=$G(^("A")) D Q:$D(DIRUT)
|
---|
| 139 | . Q:$$CHK(4)
|
---|
| 140 | . W !!?5,"SUBSCRIPT: ",X
|
---|
| 141 | . W !,"DIR(0)=",J
|
---|
| 142 | . S J=0
|
---|
| 143 | . F S J=$O(@XPDGR@("QUES",I,"A1",J)) Q:'J Q:$$CHK(2) W !,"DIR(""A"",",J,")=",^(J,0)
|
---|
| 144 | . I K]"" Q:$$CHK(2) W !,"DIR(""A"")=",K
|
---|
| 145 | . I $G(@XPDGR@("QUES",I,"B"))]"" Q:$$CHK(2) W !,"DIR(""B"")=",^("B")
|
---|
| 146 | . S J=0
|
---|
| 147 | . F S J=$O(@XPDGR@("QUES",I,"Q1",J)) Q:'J Q:$$CHK(2) W !,"DIR(""?"",",J,")=",^(J,0)
|
---|
| 148 | . I $G(@XPDGR@("QUES",I,"Q"))]"" Q:$$CHK(2) W !,"DIR(""?"")=",^("Q")
|
---|
| 149 | . I $G(@XPDGR@("QUES",I,"QQ"))]"" Q:$$CHK(2) W !,"DIR(""??"")=",^("QQ")
|
---|
| 150 | . I $G(@XPDGR@("QUES",I,"M"))]"" Q:$$CHK(2) W !,"M CODE: ",^("M")
|
---|
| 151 | Q:$D(DIRUT)
|
---|
| 152 | ;Show new Defaults for KIDS questions. p463
|
---|
| 153 | S X=$G(@XPDGR@("QDEF")) Q:X=""
|
---|
| 154 | I '$L($P(X,U,9)),'$L($P(X,U,5)),'$L($P(X,U,11)) Q
|
---|
| 155 | Q:$$CHK(3) W !
|
---|
| 156 | I $L($P(X,U,9)) Q:$$CHK(2) W !," Default Rebuild Menu Trees Upon Completion of Install: ",$P(X,U,9)
|
---|
| 157 | I $L($P(X,U,5)) Q:$$CHK(2) W !," Default INHIBIT LOGONs during the install: ",$P(X,U,5)
|
---|
| 158 | I $L($P(X,U,11)) Q:$$CHK(2) W !," Default DISABLE Scheduled Options, Menu Options, and Protocols: ",$P(X,U,11)
|
---|
| 159 | Q
|
---|
| 160 | ALFABETA ; Alpha/Beta Testing
|
---|
| 161 | S XPD=$G(@XPDGR@("ABPKG")) Q:XPD=""
|
---|
| 162 | Q:$P(XPD,U)'="y"
|
---|
| 163 | Q:$$CHK(4)
|
---|
| 164 | W !!,"ALPHA/BETA TESTING: ",$$EXTERNAL^DILFD(9.6,20,"",$P(XPD,U)),?47,"INSTALLATION MESSAGE: ",$$EXTERNAL^DILFD(9.6,21,"",$P(XPD,U,2))
|
---|
| 165 | W !,"ADDRESS: ",$P(XPD,U,3)
|
---|
| 166 | Q
|
---|
| 167 | NAMESP ; Namespaces
|
---|
| 168 | Q:'$O(@XPDGR@("ABNS",0))
|
---|
| 169 | Q:$$CHK(4)
|
---|
| 170 | W !!,"INCLUDE NAMESPACE:",?47,"EXCLUDE NAMESPACE:"
|
---|
| 171 | S I=0
|
---|
| 172 | F S I=$O(@XPDGR@("ABNS",I)) Q:'I Q:$$CHK(2) W !?3,^(I,0) D Q:$D(DIRUT)
|
---|
| 173 | . N XPDNMSP,XPDLF
|
---|
| 174 | . S (J,XPDLF)=0
|
---|
| 175 | . F S J=$O(@XPDGR@("ABNS",I,1,J)) Q:'J S XPDNMSP=^(J,0) D Q:$D(DIRUT)
|
---|
| 176 | . . I XPDLF Q:$$CHK(2) W !
|
---|
| 177 | . . W ?50,XPDNMSP
|
---|
| 178 | . . S XPDLF=1
|
---|
| 179 | Q
|
---|
| 180 | REQDBLD ; Required Builds
|
---|
| 181 | Q:'$O(@XPDGR@("REQB",0))
|
---|
| 182 | Q:$$CHK(4)
|
---|
| 183 | W !!,"REQUIRED BUILDS:",?47,"ACTION:"
|
---|
| 184 | S XPDI=0
|
---|
| 185 | F S XPDI=$O(@XPDGR@("REQB",XPDI)) Q:'XPDI S XPD=$G(^(XPDI,0)) Q:$$CHK(2) D
|
---|
| 186 | . W !?3,$P(XPD,U),?50,$$EXTERNAL^DILFD(9.611,1,"",$P(XPD,U,2))
|
---|
| 187 | Q
|
---|
| 188 | GLOBAL ; Global Package
|
---|
| 189 | Q:$$CHK(4)
|
---|
| 190 | W !!,"GLOBAL:",?47,"KILL GLOBAL BEFORE INSTALL:"
|
---|
| 191 | S XPDI=0
|
---|
| 192 | F S XPDI=$O(@XPDGR@("GLO",XPDI)) Q:'XPDI S XPD=$G(^(XPDI,0)) Q:$$CHK(2) D
|
---|
| 193 | . W !?3,$P(XPD,U),?50,$$EXTERNAL^DILFD(9.65,1,"",$P(XPD,U,2))
|
---|
| 194 | Q
|
---|
| 195 | MULT ; Multi-Package
|
---|
| 196 | Q:$$CHK(4)
|
---|
| 197 | W !!,"SEQUENCE OF BUILDS:"
|
---|
| 198 | S XPDI=0
|
---|
| 199 | F S XPDI=$O(@XPDGR@(10,XPDI)) Q:'XPDI S XPD=$G(^(XPDI,0)) Q:$$CHK(2) D
|
---|
| 200 | . W !?2,XPDI,?8,$E($P(XPD,U),1,44),?54,$S($P(XPD,U,2)=1:"",1:"Not ")_"Required to Continue"
|
---|
| 201 | Q
|
---|
| 202 | CHK(Y,XPD) ;Y=excess lines XPD=1 print file header, return 1 to exit
|
---|
| 203 | ;return 0 if header was not written, else "0^1"
|
---|
| 204 | Q:$Y<(IOSL-Y) 0
|
---|
| 205 | Q:'$$CONT 1
|
---|
| 206 | S XPD=$G(XPD),XPDPG=XPDPG+1
|
---|
| 207 | W @IOF D HDR,HDR1:XPD
|
---|
| 208 | W !,XPDUL
|
---|
| 209 | Q "0^1"
|
---|
| 210 | CONT() ; Press Return to continue; ^ to exit.
|
---|
| 211 | Q:$D(DIRUT) 0
|
---|
| 212 | Q:$E(IOST,1,2)'="C-" 1
|
---|
| 213 | N DIR,I,J,K,X,Y
|
---|
| 214 | S DIR(0)="E" D ^DIR
|
---|
| 215 | Q Y
|
---|
| 216 | XMP2(X,D0) ;called from ^XMP2
|
---|
| 217 | N XPDA S XPDA=-1
|
---|
| 218 | D PNT(X)
|
---|
| 219 | Q
|
---|
| 220 | HDR ;
|
---|
| 221 | W "PACKAGE: ",$P(XPD0,U)," ",XPDDT,?70,$$RJ^XLFSTR("PAGE "_XPDPG,9)
|
---|
| 222 | Q
|
---|
| 223 | HDR1 ;
|
---|
| 224 | W !!,?43,"UP SEND DATA USER"
|
---|
| 225 | W !,?43,"DATE SEC. COMES SITE RSLV OVER"
|
---|
| 226 | W !,"FILE #",?12,"FILE NAME",?43,"DD CODE W/FILE DATA PTRS RIDE"
|
---|
| 227 | Q
|
---|