- XPDDP1 ;SFISC/RSD - Continue Display a package ;
- ;;8.0;KERNEL;**525**;Jul 10, 1995;Build 16
- ; Per VHA Directive 2004-038, this routine should not be modified.
- PNT(XPDGR) ; Print a package, XPDGR=global root
- ;XPDFL=0 - Build - ^XPD(9.7 global root
- ; 1 - Install - ^XTMP global root
- ; 2 - Packman - ^TMP($J, global root
- N I,J,K,X,XPD,XPDDT,XPDI,XPD0,XPDFL,XPDPG,XPDUL,XPDTYPE,XPDTRACK,XPDTXT
- Q:$G(XPDGR)="" S XPDGR="^"_XPDGR
- Q:'$D(@XPDGR@(0)) S XPD0=^(0)
- D ID ; Package Identification
- D DESCR Q:$D(DIRUT) ; Description
- I XPDTYPE=1 D MULT Q ; Multi-Package
- D PREPOST Q:$D(DIRUT) ; Environment check & Pre/Post Routines
- I XPDTYPE=2 D GLOBAL Q ; Global Package
- D FILES Q:$D(DIRUT) ; Files/DDs
- D COMP Q:$D(DIRUT) ; Build Components
- Q:XPDFL=2 ; Packman message, called from XMP2 - Summarize
- D QUESTS Q:$D(DIRUT) ; Install Questions
- D ALFABETA Q:$D(DIRUT) ; Alpha/Beta Testing
- D NAMESP Q:$D(DIRUT) ; Include/Exclude Namespaces
- D REQDBLD Q:$D(DIRUT) ; Required Builds
- Q
- ID ; Identify the package
- S 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)
- W:$E(IOST,1,2)="C-" @IOF D HDR W !,XPDUL
- W !,"TYPE: ",$$EXTERNAL^DILFD(9.6,2,"",XPDTYPE)
- W ?51,"TRACK NATIONALLY: ",$$EXTERNAL^DILFD(9.6,5,"",XPDTRACK)
- W !,"NATIONAL PACKAGE: ",$P($G(^DIC(9.4,+$P(XPD0,U,2),0),$P(XPD0,U,2)),U)
- W ?49,"ALPHA/BETA TESTING: ",$S($P($G(@XPDGR@("ABPKG")),U)="y":"YES",1:"NO")
- Q
- DESCR ; Show patch description
- W !!,"DESCRIPTION:"
- S XPDI=0
- F S XPDI=$O(@XPDGR@(1,XPDI)) Q:'XPDI S XPDTXT=$G(^(XPDI,0)) D Q:$D(DIRUT)
- . I $L(XPDTXT)'<IOM,$E(XPDTXT,$L(XPDTXT))=" " F S XPDTXT=$E(XPDTXT,1,$L(XPDTXT)-1) Q:$E(XPDTXT,$L(XPDTXT))'=" "
- . F D Q:$L(XPDTXT)<IOM!$D(DIRUT)!(IOM<2) S XPDTXT=$E(XPDTXT,IOM,999)
- . . Q:$$CHK(2)
- . . W !,$S(IOM>1:$E(XPDTXT,1,IOM-1),1:XPDTXT)
- Q
- PREPOST ; Environment check and pre/post routines
- Q:$$CHK(3)
- W !!,"ENVIRONMENT CHECK: ",$G(@XPDGR@("PRE"))
- W ?49,"DELETE ENV ROUTINE: " I $G(@XPDGR@("PRE"))]"" W $S($P($G(@XPDGR@("INID")),U)="y":"Yes",1:"No")
- I 'XPDTYPE D Q:$D(DIRUT)
- . Q:$$CHK(2)
- . W !," PRE-INIT ROUTINE: ",$G(@XPDGR@("INI"))
- . W ?44,"DELETE PRE-INIT ROUTINE: " I $G(@XPDGR@("INI"))]"" W $S($P($G(@XPDGR@("INID")),U,3)="y":"Yes",1:"No")
- Q:$$CHK(2)
- W !,"POST-INIT ROUTINE: ",$G(@XPDGR@("INIT"))
- W ?43,"DELETE POST-INIT ROUTINE: " I $G(@XPDGR@("INIT"))]"" W $S($P($G(@XPDGR@("INID")),U,2)="y":"Yes",1:"No")
- I 'XPDTYPE Q:$$CHK(2) W !,"PRE-TRANSPORT RTN: ",$G(@XPDGR@("PRET"))
- Q
- FILES ; Show files/DDs
- Q:'$O(@XPDGR@(4,0)) ; Quit if no files
- S I=$$CHK(8,1) Q:I I '$P(I,"^",2) D HDR1 W !,XPDUL
- S XPDI=0
- F S XPDI=$O(@XPDGR@(4,XPDI)) Q:'XPDI S XPD=$G(^(XPDI,222)) Q:$$CHK(3,1) D
- . ;file number, file name, partial DD
- . W !!,XPDI,?12,$S('XPDFL:$P($G(^DIC(XPDI,0),"**unknown**"),U),1:$G(^XTMP("XPDI",XPDA,"FIA",XPDI)))
- . ; update DD, send security code, data comes with file
- . 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))
- . ; override site data, resolve pointers, user override
- . 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))
- . I $P(XPD,U,3)="p" D Q:$D(DIRUT)
- . . ; Print partial DD information
- . . N XPDSUB,XPDFLD
- . . Q:$$CHK(2,1)
- . . W !,"Partial DD:"
- . . S (J,XPDSUB)=0
- . . F S J=$O(@XPDGR@(4,"APDD",XPDI,J)) Q:'J D Q:$D(DIRUT)
- . . . I XPDSUB Q:$$CHK(2,1) W !
- . . . W ?12,"subDD: ",J
- . . . S XPDSUB=1,(I,XPDFLD)=0
- . . . F S I=$O(@XPDGR@(4,"APDD",XPDI,J,I)) Q:'I D Q:$D(DIRUT)
- . . . . I XPDFLD Q:$$CHK(2,1) W !
- . . . . W ?30,"fld: ",I S XPDFLD=1
- . I " "'[$G(@XPDGR@(4,XPDI,223)) Q:$$CHK(2,1) W !,?2,"DD SCREEN : ",^(223)
- . I " "'[$G(@XPDGR@(4,XPDI,224)) Q:$$CHK(2,1) W !,?2,"DATA SCREEN: ",^(224)
- Q
- COMP ; Print Build components
- S I=0,XPD=$P(^DD(9.68,.03,0),U,3)
- F S I=$O(@XPDGR@("KRN",I)) Q:'I D Q:$D(DIRUT)
- . Q:'$D(@XPDGR@("KRN",I,"NM","B"))
- . Q:$$CHK(4)
- . W !!,$S($D(^DIC(I,0)):$P(^(0),U),XPDFL:$G(^XTMP("XPDI",XPDA,"FIA",I),"UNKNOWN"),1:"UNKNOWN")_":",?47,"ACTION:"
- . S J=""
- . F S J=$O(@XPDGR@("KRN",I,"NM","B",J)) Q:J="" S X=$O(^(J,0)) D Q:$D(DIRUT)
- . . Q:'X
- . . S X=$G(@XPDGR@("KRN",I,"NM",X,0)) Q:X=""
- . . Q:$$CHK(2)
- . . ;write the entry name and write the action
- . . W !,?3,$P(X,U),?50,$P($P(XPD,";",$P(X,U,3)+1),":",2)
- Q
- QUESTS ; Show Install Questions
- I '$O(@XPDGR@("QUES",0)),'($D(@XPDGR@("QDEF"))#2) Q
- Q:$$CHK(6)
- W !!,"INSTALL QUESTIONS: "
- S I=0
- 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)
- . Q:$$CHK(4)
- . W !!?5,"SUBSCRIPT: ",X
- . W !,"DIR(0)=",J
- . S J=0
- . F S J=$O(@XPDGR@("QUES",I,"A1",J)) Q:'J Q:$$CHK(2) W !,"DIR(""A"",",J,")=",^(J,0)
- . I K]"" Q:$$CHK(2) W !,"DIR(""A"")=",K
- . I $G(@XPDGR@("QUES",I,"B"))]"" Q:$$CHK(2) W !,"DIR(""B"")=",^("B")
- . S J=0
- . F S J=$O(@XPDGR@("QUES",I,"Q1",J)) Q:'J Q:$$CHK(2) W !,"DIR(""?"",",J,")=",^(J,0)
- . I $G(@XPDGR@("QUES",I,"Q"))]"" Q:$$CHK(2) W !,"DIR(""?"")=",^("Q")
- . I $G(@XPDGR@("QUES",I,"QQ"))]"" Q:$$CHK(2) W !,"DIR(""??"")=",^("QQ")
- . I $G(@XPDGR@("QUES",I,"M"))]"" Q:$$CHK(2) W !,"M CODE: ",^("M")
- Q:$D(DIRUT)
- ;Show new Defaults for KIDS questions. p463
- S X=$G(@XPDGR@("QDEF")) Q:X=""
- I '$L($P(X,U,9)),'$L($P(X,U,5)),'$L($P(X,U,11)) Q
- Q:$$CHK(3) W !
- I $L($P(X,U,9)) Q:$$CHK(2) W !," Default Rebuild Menu Trees Upon Completion of Install: ",$P(X,U,9)
- I $L($P(X,U,5)) Q:$$CHK(2) W !," Default INHIBIT LOGONs during the install: ",$P(X,U,5)
- I $L($P(X,U,11)) Q:$$CHK(2) W !," Default DISABLE Scheduled Options, Menu Options, and Protocols: ",$P(X,U,11)
- Q
- ALFABETA ; Alpha/Beta Testing
- S XPD=$G(@XPDGR@("ABPKG")) Q:XPD=""
- Q:$P(XPD,U)'="y"
- Q:$$CHK(4)
- W !!,"ALPHA/BETA TESTING: ",$$EXTERNAL^DILFD(9.6,20,"",$P(XPD,U)),?47,"INSTALLATION MESSAGE: ",$$EXTERNAL^DILFD(9.6,21,"",$P(XPD,U,2))
- W !,"ADDRESS: ",$P(XPD,U,3)
- Q
- NAMESP ; Namespaces
- Q:'$O(@XPDGR@("ABNS",0))
- Q:$$CHK(4)
- W !!,"INCLUDE NAMESPACE:",?47,"EXCLUDE NAMESPACE:"
- S I=0
- F S I=$O(@XPDGR@("ABNS",I)) Q:'I Q:$$CHK(2) W !?3,^(I,0) D Q:$D(DIRUT)
- . N XPDNMSP,XPDLF
- . S (J,XPDLF)=0
- . F S J=$O(@XPDGR@("ABNS",I,1,J)) Q:'J S XPDNMSP=^(J,0) D Q:$D(DIRUT)
- . . I XPDLF Q:$$CHK(2) W !
- . . W ?50,XPDNMSP
- . . S XPDLF=1
- Q
- REQDBLD ; Required Builds
- Q:'$O(@XPDGR@("REQB",0))
- Q:$$CHK(4)
- W !!,"REQUIRED BUILDS:",?47,"ACTION:"
- S XPDI=0
- F S XPDI=$O(@XPDGR@("REQB",XPDI)) Q:'XPDI S XPD=$G(^(XPDI,0)) Q:$$CHK(2) D
- . W !?3,$P(XPD,U),?50,$$EXTERNAL^DILFD(9.611,1,"",$P(XPD,U,2))
- Q
- GLOBAL ; Global Package
- Q:$$CHK(4)
- W !!,"GLOBAL:",?47,"KILL GLOBAL BEFORE INSTALL:"
- S XPDI=0
- F S XPDI=$O(@XPDGR@("GLO",XPDI)) Q:'XPDI S XPD=$G(^(XPDI,0)) Q:$$CHK(2) D
- . W !?3,$P(XPD,U),?50,$$EXTERNAL^DILFD(9.65,1,"",$P(XPD,U,2))
- Q
- MULT ; Multi-Package
- Q:$$CHK(4)
- W !!,"SEQUENCE OF BUILDS:"
- S XPDI=0
- F S XPDI=$O(@XPDGR@(10,XPDI)) Q:'XPDI S XPD=$G(^(XPDI,0)) Q:$$CHK(2) D
- . W !?2,XPDI,?8,$E($P(XPD,U),1,44),?54,$S($P(XPD,U,2)=1:"",1:"Not ")_"Required to Continue"
- Q
- CHK(Y,XPD) ;Y=excess lines XPD=1 print file header, return 1 to exit
- ;return 0 if header was not written, else "0^1"
- Q:$Y<(IOSL-Y) 0
- Q:'$$CONT 1
- S XPD=$G(XPD),XPDPG=XPDPG+1
- W @IOF D HDR,HDR1:XPD
- W !,XPDUL
- Q "0^1"
- ;
- CONT() ; Press Return to continue; ^ to exit.
- Q:$D(DIRUT) 0
- Q:$E(IOST,1,2)'="C-" 1
- N DIR,I,J,K,X,Y
- S DIR(0)="E" D ^DIR
- Q Y
- ;
- HDR ;
- W "PACKAGE: ",$P(XPD0,U)," ",XPDDT,?70,$$RJ^XLFSTR("PAGE "_XPDPG,9)
- Q
- HDR1 ;
- W !!,?43,"UP SEND DATA USER"
- W !,?43,"DATE SEC. COMES SITE RSLV OVER"
- W !,"FILE #",?12,"FILE NAME",?43,"DD CODE W/FILE DATA PTRS RIDE"
- Q
- XPDDP1 ;SFISC/RSD - Continue Display a package ;
- +1 ;;8.0;KERNEL;**525**;Jul 10, 1995;Build 16
- +2 ; Per VHA Directive 2004-038, this routine should not be modified.
- PNT(XPDGR) ; Print a package, XPDGR=global root
- +1 ;XPDFL=0 - Build - ^XPD(9.7 global root
- +2 ; 1 - Install - ^XTMP global root
- +3 ; 2 - Packman - ^TMP($J, global root
- +4 NEW I,J,K,X,XPD,XPDDT,XPDI,XPD0,XPDFL,XPDPG,XPDUL,XPDTYPE,XPDTRACK,XPDTXT
- +5 IF $GET(XPDGR)=""
- QUIT
- SET XPDGR="^"_XPDGR
- +6 IF '$DATA(@XPDGR@(0))
- QUIT
- SET XPD0=^(0)
- +7 ; Package Identification
- DO ID
- +8 ; Description
- DO DESCR
- IF $DATA(DIRUT)
- QUIT
- +9 ; Multi-Package
- IF XPDTYPE=1
- DO MULT
- QUIT
- +10 ; Environment check & Pre/Post Routines
- DO PREPOST
- IF $DATA(DIRUT)
- QUIT
- +11 ; Global Package
- IF XPDTYPE=2
- DO GLOBAL
- QUIT
- +12 ; Files/DDs
- DO FILES
- IF $DATA(DIRUT)
- QUIT
- +13 ; Build Components
- DO COMP
- IF $DATA(DIRUT)
- QUIT
- +14 ; Packman message, called from XMP2 - Summarize
- IF XPDFL=2
- QUIT
- +15 ; Install Questions
- DO QUESTS
- IF $DATA(DIRUT)
- QUIT
- +16 ; Alpha/Beta Testing
- DO ALFABETA
- IF $DATA(DIRUT)
- QUIT
- +17 ; Include/Exclude Namespaces
- DO NAMESP
- IF $DATA(DIRUT)
- QUIT
- +18 ; Required Builds
- DO REQDBLD
- IF $DATA(DIRUT)
- QUIT
- +19 QUIT
- ID ; Identify the package
- +1 SET XPDPG=1
- SET XPDFL=$SELECT($EXTRACT(XPDGR,1,5)="^TMP(":2,1:$EXTRACT(XPDGR,1,5)="^XTMP")
- SET $PIECE(XPDUL,"-",IOM)=""
- SET XPDDT=$$HTE^XLFDT($HOROLOG,"1PM")
- SET XPDTYPE=+$PIECE(XPD0,U,3)
- SET XPDTRACK=$PIECE(XPD0,U,5)
- +2 IF $EXTRACT(IOST,1,2)="C-"
- WRITE @IOF
- DO HDR
- WRITE !,XPDUL
- +3 WRITE !,"TYPE: ",$$EXTERNAL^DILFD(9.6,2,"",XPDTYPE)
- +4 WRITE ?51,"TRACK NATIONALLY: ",$$EXTERNAL^DILFD(9.6,5,"",XPDTRACK)
- +5 WRITE !,"NATIONAL PACKAGE: ",$PIECE($GET(^DIC(9.4,+$PIECE(XPD0,U,2),0),$PIECE(XPD0,U,2)),U)
- +6 WRITE ?49,"ALPHA/BETA TESTING: ",$SELECT($PIECE($GET(@XPDGR@("ABPKG")),U)="y":"YES",1:"NO")
- +7 QUIT
- DESCR ; Show patch description
- +1 WRITE !!,"DESCRIPTION:"
- +2 SET XPDI=0
- +3 FOR
- SET XPDI=$ORDER(@XPDGR@(1,XPDI))
- IF 'XPDI
- QUIT
- SET XPDTXT=$GET(^(XPDI,0))
- Begin DoDot:1
- +4 IF $LENGTH(XPDTXT)'<IOM
- IF $EXTRACT(XPDTXT,$LENGTH(XPDTXT))=" "
- FOR
- SET XPDTXT=$EXTRACT(XPDTXT,1,$LENGTH(XPDTXT)-1)
- IF $EXTRACT(XPDTXT,$LENGTH(XPDTXT))'=" "
- QUIT
- +5 FOR
- Begin DoDot:2
- +6 IF $$CHK(2)
- QUIT
- +7 WRITE !,$SELECT(IOM>1:$EXTRACT(XPDTXT,1,IOM-1),1:XPDTXT)
- End DoDot:2
- IF $LENGTH(XPDTXT)<IOM!$DATA(DIRUT)!(IOM<2)
- QUIT
- SET XPDTXT=$EXTRACT(XPDTXT,IOM,999)
- End DoDot:1
- IF $DATA(DIRUT)
- QUIT
- +8 QUIT
- PREPOST ; Environment check and pre/post routines
- +1 IF $$CHK(3)
- QUIT
- +2 WRITE !!,"ENVIRONMENT CHECK: ",$GET(@XPDGR@("PRE"))
- +3 WRITE ?49,"DELETE ENV ROUTINE: "
- IF $GET(@XPDGR@("PRE"))]""
- WRITE $SELECT($PIECE($GET(@XPDGR@("INID")),U)="y":"Yes",1:"No")
- +4 IF 'XPDTYPE
- Begin DoDot:1
- +5 IF $$CHK(2)
- QUIT
- +6 WRITE !," PRE-INIT ROUTINE: ",$GET(@XPDGR@("INI"))
- +7 WRITE ?44,"DELETE PRE-INIT ROUTINE: "
- IF $GET(@XPDGR@("INI"))]""
- WRITE $SELECT($PIECE($GET(@XPDGR@("INID")),U,3)="y":"Yes",1:"No")
- End DoDot:1
- IF $DATA(DIRUT)
- QUIT
- +8 IF $$CHK(2)
- QUIT
- +9 WRITE !,"POST-INIT ROUTINE: ",$GET(@XPDGR@("INIT"))
- +10 WRITE ?43,"DELETE POST-INIT ROUTINE: "
- IF $GET(@XPDGR@("INIT"))]""
- WRITE $SELECT($PIECE($GET(@XPDGR@("INID")),U,2)="y":"Yes",1:"No")
- +11 IF 'XPDTYPE
- IF $$CHK(2)
- QUIT
- WRITE !,"PRE-TRANSPORT RTN: ",$GET(@XPDGR@("PRET"))
- +12 QUIT
- FILES ; Show files/DDs
- +1 ; Quit if no files
- IF '$ORDER(@XPDGR@(4,0))
- QUIT
- +2 SET I=$$CHK(8,1)
- IF I
- QUIT
- IF '$PIECE(I,"^",2)
- DO HDR1
- WRITE !,XPDUL
- +3 SET XPDI=0
- +4 FOR
- SET XPDI=$ORDER(@XPDGR@(4,XPDI))
- IF 'XPDI
- QUIT
- SET XPD=$GET(^(XPDI,222))
- IF $$CHK(3,1)
- QUIT
- Begin DoDot:1
- +5 ;file number, file name, partial DD
- +6 WRITE !!,XPDI,?12,$SELECT('XPDFL:$PIECE($GET(^DIC(XPDI,0),"**unknown**"),U),1:$GET(^XTMP("XPDI",XPDA,"FIA",XPDI)))
- +7 ; update DD, send security code, data comes with file
- +8 WRITE ?43,$$EXTERNAL^DILFD(9.64,222.1,"",$PIECE(XPD,U)),?49,$$EXTERNAL^DILFD(9.64,222.2,"",$PIECE(XPD,U,2)),?55,$$EXTERNAL^DILFD(9.64,222.7,"",$PIECE(XPD,U,7))
- +9 ; override site data, resolve pointers, user override
- +10 WRITE ?63,$EXTRACT($$EXTERNAL^DILFD(9.64,222.8,"",$PIECE(XPD,U,8)),1,4),?69,$$EXTERNAL^DILFD(9.64,222.5,"",$PIECE(XPD,U,5)),?75,$$EXTERNAL^DILFD(9.64,222.9,"",$PIECE(XPD,U,9))
- +11 IF $PIECE(XPD,U,3)="p"
- Begin DoDot:2
- +12 ; Print partial DD information
- +13 NEW XPDSUB,XPDFLD
- +14 IF $$CHK(2,1)
- QUIT
- +15 WRITE !,"Partial DD:"
- +16 SET (J,XPDSUB)=0
- +17 FOR
- SET J=$ORDER(@XPDGR@(4,"APDD",XPDI,J))
- IF 'J
- QUIT
- Begin DoDot:3
- +18 IF XPDSUB
- IF $$CHK(2,1)
- QUIT
- WRITE !
- +19 WRITE ?12,"subDD: ",J
- +20 SET XPDSUB=1
- SET (I,XPDFLD)=0
- +21 FOR
- SET I=$ORDER(@XPDGR@(4,"APDD",XPDI,J,I))
- IF 'I
- QUIT
- Begin DoDot:4
- +22 IF XPDFLD
- IF $$CHK(2,1)
- QUIT
- WRITE !
- +23 WRITE ?30,"fld: ",I
- SET XPDFLD=1
- End DoDot:4
- IF $DATA(DIRUT)
- QUIT
- End DoDot:3
- IF $DATA(DIRUT)
- QUIT
- End DoDot:2
- IF $DATA(DIRUT)
- QUIT
- +24 IF " "'[$GET(@XPDGR@(4,XPDI,223))
- IF $$CHK(2,1)
- QUIT
- WRITE !,?2,"DD SCREEN : ",^(223)
- +25 IF " "'[$GET(@XPDGR@(4,XPDI,224))
- IF $$CHK(2,1)
- QUIT
- WRITE !,?2,"DATA SCREEN: ",^(224)
- End DoDot:1
- +26 QUIT
- COMP ; Print Build components
- +1 SET I=0
- SET XPD=$PIECE(^DD(9.68,.03,0),U,3)
- +2 FOR
- SET I=$ORDER(@XPDGR@("KRN",I))
- IF 'I
- QUIT
- Begin DoDot:1
- +3 IF '$DATA(@XPDGR@("KRN",I,"NM","B"))
- QUIT
- +4 IF $$CHK(4)
- QUIT
- +5 WRITE !!,$SELECT($DATA(^DIC(I,0)):$PIECE(^(0),U),XPDFL:$GET(^XTMP("XPDI",XPDA,"FIA",I),"UNKNOWN"),1:"UNKNOWN")_":",?47,"ACTION:"
- +6 SET J=""
- +7 FOR
- SET J=$ORDER(@XPDGR@("KRN",I,"NM","B",J))
- IF J=""
- QUIT
- SET X=$ORDER(^(J,0))
- Begin DoDot:2
- +8 IF 'X
- QUIT
- +9 SET X=$GET(@XPDGR@("KRN",I,"NM",X,0))
- IF X=""
- QUIT
- +10 IF $$CHK(2)
- QUIT
- +11 ;write the entry name and write the action
- +12 WRITE !,?3,$PIECE(X,U),?50,$PIECE($PIECE(XPD,";",$PIECE(X,U,3)+1),":",2)
- End DoDot:2
- IF $DATA(DIRUT)
- QUIT
- End DoDot:1
- IF $DATA(DIRUT)
- QUIT
- +13 QUIT
- QUESTS ; Show Install Questions
- +1 IF '$ORDER(@XPDGR@("QUES",0))
- IF '($DATA(@XPDGR@("QDEF"))#2)
- QUIT
- +2 IF $$CHK(6)
- QUIT
- +3 WRITE !!,"INSTALL QUESTIONS: "
- +4 SET I=0
- +5 FOR
- SET I=$ORDER(@XPDGR@("QUES",I))
- IF 'I
- QUIT
- SET X=$PIECE(^(I,0),U)
- SET J=$GET(^(1))
- SET K=$GET(^("A"))
- Begin DoDot:1
- +6 IF $$CHK(4)
- QUIT
- +7 WRITE !!?5,"SUBSCRIPT: ",X
- +8 WRITE !,"DIR(0)=",J
- +9 SET J=0
- +10 FOR
- SET J=$ORDER(@XPDGR@("QUES",I,"A1",J))
- IF 'J
- QUIT
- IF $$CHK(2)
- QUIT
- WRITE !,"DIR(""A"",",J,")=",^(J,0)
- +11 IF K]""
- IF $$CHK(2)
- QUIT
- WRITE !,"DIR(""A"")=",K
- +12 IF $GET(@XPDGR@("QUES",I,"B"))]""
- IF $$CHK(2)
- QUIT
- WRITE !,"DIR(""B"")=",^("B")
- +13 SET J=0
- +14 FOR
- SET J=$ORDER(@XPDGR@("QUES",I,"Q1",J))
- IF 'J
- QUIT
- IF $$CHK(2)
- QUIT
- WRITE !,"DIR(""?"",",J,")=",^(J,0)
- +15 IF $GET(@XPDGR@("QUES",I,"Q"))]""
- IF $$CHK(2)
- QUIT
- WRITE !,"DIR(""?"")=",^("Q")
- +16 IF $GET(@XPDGR@("QUES",I,"QQ"))]""
- IF $$CHK(2)
- QUIT
- WRITE !,"DIR(""??"")=",^("QQ")
- +17 IF $GET(@XPDGR@("QUES",I,"M"))]""
- IF $$CHK(2)
- QUIT
- WRITE !,"M CODE: ",^("M")
- End DoDot:1
- IF $DATA(DIRUT)
- QUIT
- +18 IF $DATA(DIRUT)
- QUIT
- +19 ;Show new Defaults for KIDS questions. p463
- +20 SET X=$GET(@XPDGR@("QDEF"))
- IF X=""
- QUIT
- +21 IF '$LENGTH($PIECE(X,U,9))
- IF '$LENGTH($PIECE(X,U,5))
- IF '$LENGTH($PIECE(X,U,11))
- QUIT
- +22 IF $$CHK(3)
- QUIT
- WRITE !
- +23 IF $LENGTH($PIECE(X,U,9))
- IF $$CHK(2)
- QUIT
- WRITE !," Default Rebuild Menu Trees Upon Completion of Install: ",$PIECE(X,U,9)
- +24 IF $LENGTH($PIECE(X,U,5))
- IF $$CHK(2)
- QUIT
- WRITE !," Default INHIBIT LOGONs during the install: ",$PIECE(X,U,5)
- +25 IF $LENGTH($PIECE(X,U,11))
- IF $$CHK(2)
- QUIT
- WRITE !," Default DISABLE Scheduled Options, Menu Options, and Protocols: ",$PIECE(X,U,11)
- +26 QUIT
- ALFABETA ; Alpha/Beta Testing
- +1 SET XPD=$GET(@XPDGR@("ABPKG"))
- IF XPD=""
- QUIT
- +2 IF $PIECE(XPD,U)'="y"
- QUIT
- +3 IF $$CHK(4)
- QUIT
- +4 WRITE !!,"ALPHA/BETA TESTING: ",$$EXTERNAL^DILFD(9.6,20,"",$PIECE(XPD,U)),?47,"INSTALLATION MESSAGE: ",$$EXTERNAL^DILFD(9.6,21,"",$PIECE(XPD,U,2))
- +5 WRITE !,"ADDRESS: ",$PIECE(XPD,U,3)
- +6 QUIT
- NAMESP ; Namespaces
- +1 IF '$ORDER(@XPDGR@("ABNS",0))
- QUIT
- +2 IF $$CHK(4)
- QUIT
- +3 WRITE !!,"INCLUDE NAMESPACE:",?47,"EXCLUDE NAMESPACE:"
- +4 SET I=0
- +5 FOR
- SET I=$ORDER(@XPDGR@("ABNS",I))
- IF 'I
- QUIT
- IF $$CHK(2)
- QUIT
- WRITE !?3,^(I,0)
- Begin DoDot:1
- +6 NEW XPDNMSP,XPDLF
- +7 SET (J,XPDLF)=0
- +8 FOR
- SET J=$ORDER(@XPDGR@("ABNS",I,1,J))
- IF 'J
- QUIT
- SET XPDNMSP=^(J,0)
- Begin DoDot:2
- +9 IF XPDLF
- IF $$CHK(2)
- QUIT
- WRITE !
- +10 WRITE ?50,XPDNMSP
- +11 SET XPDLF=1
- End DoDot:2
- IF $DATA(DIRUT)
- QUIT
- End DoDot:1
- IF $DATA(DIRUT)
- QUIT
- +12 QUIT
- REQDBLD ; Required Builds
- +1 IF '$ORDER(@XPDGR@("REQB",0))
- QUIT
- +2 IF $$CHK(4)
- QUIT
- +3 WRITE !!,"REQUIRED BUILDS:",?47,"ACTION:"
- +4 SET XPDI=0
- +5 FOR
- SET XPDI=$ORDER(@XPDGR@("REQB",XPDI))
- IF 'XPDI
- QUIT
- SET XPD=$GET(^(XPDI,0))
- IF $$CHK(2)
- QUIT
- Begin DoDot:1
- +6 WRITE !?3,$PIECE(XPD,U),?50,$$EXTERNAL^DILFD(9.611,1,"",$PIECE(XPD,U,2))
- End DoDot:1
- +7 QUIT
- GLOBAL ; Global Package
- +1 IF $$CHK(4)
- QUIT
- +2 WRITE !!,"GLOBAL:",?47,"KILL GLOBAL BEFORE INSTALL:"
- +3 SET XPDI=0
- +4 FOR
- SET XPDI=$ORDER(@XPDGR@("GLO",XPDI))
- IF 'XPDI
- QUIT
- SET XPD=$GET(^(XPDI,0))
- IF $$CHK(2)
- QUIT
- Begin DoDot:1
- +5 WRITE !?3,$PIECE(XPD,U),?50,$$EXTERNAL^DILFD(9.65,1,"",$PIECE(XPD,U,2))
- End DoDot:1
- +6 QUIT
- MULT ; Multi-Package
- +1 IF $$CHK(4)
- QUIT
- +2 WRITE !!,"SEQUENCE OF BUILDS:"
- +3 SET XPDI=0
- +4 FOR
- SET XPDI=$ORDER(@XPDGR@(10,XPDI))
- IF 'XPDI
- QUIT
- SET XPD=$GET(^(XPDI,0))
- IF $$CHK(2)
- QUIT
- Begin DoDot:1
- +5 WRITE !?2,XPDI,?8,$EXTRACT($PIECE(XPD,U),1,44),?54,$SELECT($PIECE(XPD,U,2)=1:"",1:"Not ")_"Required to Continue"
- End DoDot:1
- +6 QUIT
- CHK(Y,XPD) ;Y=excess lines XPD=1 print file header, return 1 to exit
- +1 ;return 0 if header was not written, else "0^1"
- +2 IF $Y<(IOSL-Y)
- QUIT 0
- +3 IF '$$CONT
- QUIT 1
- +4 SET XPD=$GET(XPD)
- SET XPDPG=XPDPG+1
- +5 WRITE @IOF
- DO HDR
- IF XPD
- DO HDR1
- +6 WRITE !,XPDUL
- +7 QUIT "0^1"
- +8 ;
- CONT() ; Press Return to continue; ^ to exit.
- +1 IF $DATA(DIRUT)
- QUIT 0
- +2 IF $EXTRACT(IOST,1,2)'="C-"
- QUIT 1
- +3 NEW DIR,I,J,K,X,Y
- +4 SET DIR(0)="E"
- DO ^DIR
- +5 QUIT Y
- +6 ;
- HDR ;
- +1 WRITE "PACKAGE: ",$PIECE(XPD0,U)," ",XPDDT,?70,$$RJ^XLFSTR("PAGE "_XPDPG,9)
- +2 QUIT
- HDR1 ;
- +1 WRITE !!,?43,"UP SEND DATA USER"
- +2 WRITE !,?43,"DATE SEC. COMES SITE RSLV OVER"
- +3 WRITE !,"FILE #",?12,"FILE NAME",?43,"DD CODE W/FILE DATA PTRS RIDE"
- +4 QUIT
