Changeset 623 for WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XPDDP.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XPDDP.m
r613 r623 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 1 XPDDP ;SFISC/RSD - Display a package ;6/21/07 09:44 2 ;;8.0;KERNEL;**21,28,44,68,100,108,229,304,346,463**;Jul 10, 1995;Build 4 3 EN1 ;print from Build file 4 N DIC,D0,XPD,XPDT,XPDST,Y,Z 5 S XPDST=$$LOOK^XPDB1 Q:XPDST<0 6 S XPD("XPDT(")="",Y="LST1^XPDDP",Z="Build File Print" 7 D EN^XUTMDEVQ(Y,Z,.XPD) 8 Q 9 EN2 ;print from Distribution 10 N D0,DIC,POP,XPD,XPDA,XPDNM,XPDT,XPDST,Y,Z,%ZIS 11 S XPDST=$$LOOK^XPDI1("I $D(^XTMP(""XPDI"",Y))",1) 12 S XPD("XPDT(")="",Y="LST2^XPDDP",Z="Transport Global Print",D0=$O(^XTMP("XPDI",XPDST,"BLD",0)) 13 Q:'D0 14 D EN^XUTMDEVQ(Y,Z,.XPD) 15 Q 16 ; 17 LST1 ; 18 K DIRUT N XPDIT S XPDIT=0 19 F S XPDIT=$O(XPDT(XPDIT)) Q:$D(DIRUT)!(XPDIT'>0) D 20 . S D0=+XPDT(XPDIT) D PNT("XPD(9.6,D0)") 21 Q 22 ; 23 LST2 ;Print from XPDT array 24 K DIRUT N XPDIT S XPDIT=0 25 F S XPDIT=$O(XPDT(XPDIT)) Q:$D(DIRUT)!(XPDIT'>0) D 26 . S XPDA=+XPDT(XPDIT),D0=$O(^XTMP("XPDI",XPDA,"BLD",0)) D PNT("XTMP(""XPDI"",XPDA,""BLD"",D0)") 27 Q 28 ; 29 PNT(XPDGR) ;print a package, XPDGR=global root 30 ;XPDFL=0 - Build - ^XPD(9.7 global root, 1 - Install - ^XTMP global root 31 ;2 - Packman ^TMP($J, global root 32 N I,J,K,X,XPD,XPDDT,XPDI,XPD0,XPDFL,XPDPG,XPDUL,XPDTYPE,XPDTRACK,XPDTXT,XPDOUT 33 Q:$G(XPDGR)="" S XPDGR="^"_XPDGR 34 Q:'$D(@XPDGR@(0)) 35 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) 36 W:$E(IOST,1,2)="C-" @IOF D HDR W XPDUL,! 37 W "TYPE: ",$$EXTERNAL^DILFD(9.6,2,"",XPDTYPE) 38 W !,"TRACK NATIONALLY: ",$$EXTERNAL^DILFD(9.6,5,"",XPDTRACK) 39 W !,"NATIONAL PACKAGE: ",$P($G(^DIC(9.4,+$P(XPD0,U,2),0),$P(XPD0,U,2)),U) 40 W !,"ALPHA/BETA TESTING: ",$S($P($G(@XPDGR@("ABPKG")),U)="y":"YES",1:"NO") ; new line added. 41 W !,"DESCRIPTION:" 42 S (XPDI,XPDOUT)=0 43 F S XPDI=$O(@XPDGR@(1,XPDI)) Q:'XPDI S XPDTXT=$G(^(XPDI,0)) D Q:XPDOUT 44 . I $L(XPDTXT)'<IOM,$E(XPDTXT,$L(XPDTXT))=" " F S XPDTXT=$E(XPDTXT,1,$L(XPDTXT)-1) Q:$E(XPDTXT,$L(XPDTXT))'=" " 45 . F D Q:$L(XPDTXT)<IOM!XPDOUT!(IOM<2) S XPDTXT=$E(XPDTXT,IOM,999) 46 . . W $S(IOM>1:$E(XPDTXT,1,IOM-1),1:XPDTXT),! 47 . . S XPDOUT=$$CHK(2) 48 Q:$D(DIRUT) G:XPDTYPE=1 MULT 49 W !,"ENVIRONMENT CHECK : ",$G(@XPDGR@("PRE")) 50 W ?47,"DELETE ENV ROUTINE: ",$S($P($G(@XPDGR@("INID")),U)="y":"Yes",1:"No") 51 W ! 52 I 'XPDTYPE D 53 . W " PRE-INIT ROUTINE : ",$G(@XPDGR@("INI")) 54 . W ?42,"DELETE PRE-INIT ROUTINE: ",$S($P($G(@XPDGR@("INID")),U,3)="y":"Yes",1:"No") 55 . W ! 56 Q:$$CHK(4) W "POST-INIT ROUTINE : ",$G(@XPDGR@("INIT")) 57 W ?41,"DELETE POST-INIT ROUTINE: ",$S($P($G(@XPDGR@("INID")),U,2)="y":"Yes",1:"No") 58 W ! 59 W:'XPDTYPE "PRE-TRANSPORT RTN : ",$G(@XPDGR@("PRET")),! 60 G:XPDTYPE=2 GLOBAL 61 I '$O(@XPDGR@(4,0)) Q:$$CHK(4) G COMP 62 S I=$$CHK(10,1) Q:I I '$P(I,"^",2) W !! D HDR1 W XPDUL,! 63 PNT2 S XPDI=0 F S XPDI=$O(@XPDGR@(4,XPDI)) Q:'XPDI S XPD=$G(^(XPDI,222)) Q:$$CHK(4,1) D 64 .;file number, file name, partial DD 65 .W !,XPDI,?12,$S('XPDFL:$P($G(^DIC(XPDI,0),"**unknown**"),U),1:$G(^XTMP("XPDI",XPDA,"FIA",XPDI))) 66 .W ?41,$$EXTERNAL^DILFD(9.64,222.1,"",$P(XPD,U)),?47,$$EXTERNAL^DILFD(9.64,222.2,"",$P(XPD,U,2)),?53,$$EXTERNAL^DILFD(9.64,222.7,"",$P(XPD,U,7)) 67 .W ?60,$E($$EXTERNAL^DILFD(9.64,222.8,"",$P(XPD,U,8)),1,4),?67,$$EXTERNAL^DILFD(9.64,222.5,"",$P(XPD,U,5)),?73,$$EXTERNAL^DILFD(9.64,222.9,"",$P(XPD,U,9)),! 68 .;print partial DD information 69 .I $P(XPD,U,3)="p" S J=0 D 70 ..W "Partial DD:" 71 ..F S J=$O(@XPDGR@(4,"APDD",XPDI,J)) Q:'J W ?12,"subDD: ",J D Q:$$CHK(4,1) 72 ...I '$O(@XPDGR@(4,"APDD",XPDI,J,0)) W ! Q 73 ...S I=0 F S I=$O(@XPDGR@(4,"APDD",XPDI,J,I)) Q:'I W ?30,"fld: ",I,! 74 .I $D(@XPDGR@(4,XPDI,223)) W ?2,"DD SCREEN : ",^(223),! 75 .I $D(@XPDGR@(4,XPDI,224)) W ?2,"DATA SCREEN: ",^(224),! 76 COMP Q:$D(DIRUT) W ! Q:$$CHK(3) S I=0,XPD=$P(^DD(9.68,.03,0),U,3) 77 ;print build components 78 F S I=$O(@XPDGR@("KRN",I)),K=0,J="" Q:$D(DIRUT)!'I F S J=$O(@XPDGR@("KRN",I,"NM","B",J)) Q:J="" S X=$O(^(J,0)) Q:$$CHK(4) D:X 79 .S X=$G(@XPDGR@("KRN",I,"NM",X,0)) Q:X="" 80 .;K is flag to write type of component 81 .I 'K W !,$S($D(^DIC(I,0)):$P(^(0),U),XPDFL:$G(^XTMP("XPDI",XPDA,"FIA",I),"UNKNOWN"),1:"UNKNOWN")_":",! S K=1 82 .;write the entry name and write the action 83 .W ?3,$P(X,U),?50,$P($P(XPD,";",$P(X,U,3)+1),":",2),! 84 Q:XPDFL=2 85 ;XPDFL=2 this is a Packman message, called from XMP2 - Summarize 86 ;XPDFL=1 this is a Install, the call backs are already Build Components 87 Q:$D(DIRUT) Q:$$CHK(3) 88 I $O(@XPDGR@("QUES",0))!($D(@XPDGR@("QDEF"))#2) W !,"INSTALL QUESTIONS: " S I=0 D 89 .F S I=$O(@XPDGR@("QUES",I)) Q:'I S X=$P(^(I,0),U),J=$G(^(1)),K=$G(^("A")) Q:$$CHK(5) D 90 ..W !?5,"SUBSCRIPT: ",X,!,"DIR(0)=",J W:K]"" !,"DIR(""A"")=",K,! 91 ..F J=1:1 Q:'$D(@XPDGR@("QUES",I,"A1",J,0)) W "DIR(""A"",",J,")=",^(0),! 92 ..I $G(@XPDGR@("QUES",I,"B"))]"" W "DIR(""B"")=",^("B"),! 93 ..I $G(@XPDGR@("QUES",I,"Q"))]"" W "DIR(""?"")=",^("Q"),! 94 ..F J=1:1 Q:'$D(@XPDGR@("QUES",I,"Q1",J,0)) W "DIR(""?"",",J,")=",^(0),! 95 ..I $G(@XPDGR@("QUES",I,"QQ"))]"" W "DIR(""??"")=",^("QQ"),! 96 ..I $G(@XPDGR@("QUES",I,"M"))]"" W "M CODE: ",^("M"),! 97 . Q:$D(DIRUT) Q:$$CHK(3) 98 . ;Show new Defaults for KIDS questions. p463 99 . I $D(@XPDGR@("QDEF"))#2 S X=$G(@XPDGR@("QDEF")) D 100 . . W:$X>1 ! 101 . . I $L($P(X,U,9)) W " Default Rebuild Menu Trees Upon Completion of Install: ",$P(X,U,9),! 102 . . I $L($P(X,U,5)) W " Default INHIBIT LOGONs during the install: ",$P(X,U,5),! 103 . . I $L($P(X,U,11)) W " Default DISABLE Scheduled Options, Menu Options, and Protocols: ",$P(X,U,11) 104 . . Q 105 . Q 106 Q:$D(DIRUT) Q:$$CHK(3) 107 I $L($G(@XPDGR@("ABPKG"))) S XPD=^("ABPKG") D:$P(XPD,U)="y" 108 .W !,"ALPHA/BETA TESTING:",$$EXTERNAL^DILFD(9.6,20,"",$P(XPD,U)),?40,"INSTALLATION MESSAGE: ",$$EXTERNAL^DILFD(9.6,21,"",$P(XPD,U,2)) 109 .W !,"ADDRESS: ",$P(XPD,U,3),!!,"INCLUDE NAMESPACE",?30,"EXCLUDE NAMESPACE" S I=0 110 .F S I=$O(@XPDGR@("ABNS",I)),J=0 Q:'I W !?5,^(I,0) F S J=$O(@XPDGR@("ABNS",I,1,J)) Q:'J W ?35,^(J,0),! Q:$$CHK(3) 111 REQB Q:$D(DIRUT) Q:$$CHK(4) 112 I $O(@XPDGR@("REQB",0)) W !,"REQUIRED BUILDS:",?50,"ACTION:" D 113 .S XPDI=0 F S XPDI=$O(@XPDGR@("REQB",XPDI)) Q:'XPDI S XPD=$G(^(XPDI,0)) Q:$$CHK(4,1) D 114 ..W !?3,$P(XPD,U),?50,$$EXTERNAL^DILFD(9.611,1,"",$P(XPD,U,2)) 115 Q 116 GLOBAL ;globals listing 117 S I=$$CHK(8,1) Q:I I '$P(I,"^",2) W !!,"GLOBAL:",?20,"KILL GLOBAL BEFORE INSTALL:" 118 S XPDI=0 F S XPDI=$O(@XPDGR@("GLO",XPDI)) Q:'XPDI S XPD=$G(^(XPDI,0)) Q:$$CHK(4,1) D 119 .W !?3,$P(XPD,U),?33,$$EXTERNAL^DILFD(9.65,1,"",$P(XPD,U,2)) 120 W ! Q 121 ; 122 MULT ;multiple-package 123 S I=$$CHK(10,1) Q:I I '$P(I,"^",2) W !,"SEQUENCE OF BUILDS:" 124 S XPDI=0 F S XPDI=$O(@XPDGR@(10,XPDI)) Q:'XPDI S XPD=$G(^(XPDI,0)) Q:$$CHK(4,1) D 125 .W !?2,XPDI,?8,$E($P(XPD,U),1,44),?54,$S($P(XPD,U,2)=1:"",1:"Not ")_"Required to Continue" 126 W ! Q 127 ; 128 ;return 0 if header was not written, else "0^1" 129 CHK(Y,XPD) ;Y=excess lines XPD=1 print file header, return 1 to exit 130 Q:$Y<(IOSL-Y) 0 131 I $E(IOST,1,2)="C-" D Q:'Y 1 132 .N DIR,I,J,K,X 133 .S DIR(0)="E" D ^DIR 134 S XPD=$G(XPD),XPDPG=XPDPG+1 135 W @IOF D HDR,HDR1:XPD 136 W XPDUL,! 137 Q "0^1" 138 ; 139 XMP2(X,D0) ;called from ^XMP2 140 N XPDA S XPDA=-1 141 D PNT(X) Q 142 ; 143 HDR W !,"PACKAGE: ",$P(XPD0,U)," ",XPDDT,?70,"PAGE ",XPDPG,! 144 Q 145 HDR1 W ?41,"UP",?47,"SEND",?53,"DATA",?73,"USER",!,?41,"DATE",?47,"SEC.",?53,"COMES",?60,"SITE",?67,"RSLV",?73,"OVER" 146 W !,"FILE #",?12,"NAME",?41,"DD",?47,"CODE",?53,"W/FILE",?60,"DATA",?67,"PTS",?73,"RIDE",! 147 Q
Note:
See TracChangeset
for help on using the changeset viewer.
