| 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
|
|---|
