XPDTC ;SFISC/RSD - Transport calls ;10/15/2008
;;8.0;KERNEL;**10,15,21,39,41,44,58,83,92,95,100,108,124,131,463,511,517,559,672,713,750**;Jul 10, 1995;Build 6
;Per VHA Directive 2004-038, this routine should not be modified.
Q
;^XTMP("XPDT",XPDA,data type,file #,
;XPDA=ien of File 9.6, XPDNM=.01 field
DD ;build DD
N DIERR,FILE,FGR,FNAM,Z2,Z3,Z4
S FILE=0,FGR="^XTMP(""XPDT"",XPDA)",FNAM=$NA(^XPD(9.6,XPDA,4,"APDD"))
F S FILE=$O(^XPD(9.6,XPDA,4,FILE)) Q:'FILE D
.S Z2=$G(^XPD(9.6,XPDA,4,FILE,222)),Z3=$G(^(223)),Z4=$G(^(224))
.Q:'$$DATA^XPDV(FILE,Z2)
.D FIA^DIFROMSU(FILE,"",FNAM,FGR,Z2,Z3,Z4,XPDVER),DIERR:$D(DIERR)
Q:'$D(^XTMP("XPDT",XPDA,"FIA"))
;send DD and Data
D DDOUT^DIFROMS("","","",FGR),DIERR:$D(DIERR),DATAOUT^DIFROMS("","","",FGR),DIERR:$D(DIERR)
Q
;XPDERR is checked in XPDT and will abort transport
DIERR ;record error
D MSG^DIALOG("EW",.XPD) S XPDERR=1
Q
KRN ;build Kernel Files
;XPDFILE=file #, XPDOLDA=ien in Build file
N %,%1,%2,DA,EACT,FACT,FGR,XPDFILE,XPDFL,XPDOLDA,XPDI
F XPDFILE=1:1 S Y0=$P($T(FILES+XPDFILE^XPDE),";;",2,99) Q:Y0="" S XPDI(+Y0)=Y0
;XPDI(XPDFILE)=file;order;x-ref;fact;eact;fpre;epre;fpos;epos;fdel
S XPDFILE=0
;check we are sending something and have the executes
F S XPDFILE=$O(^XPD(9.6,XPDA,"KRN",XPDFILE)) Q:'XPDFILE S XPDI=$G(XPDI(XPDFILE)) I $O(^(XPDFILE,"NM",0)),XPDI D Q:$D(XPDERR) D:FACT]"" ACT(FACT)
.S FACT=$P(XPDI,";",4),EACT=$P(XPDI,";",5)
.;need to add code to check if File and data is already being sent in the File
.;mult. If it is, don't bother sending it again. DTL(XPDFILE)
.S XPDOLDA=0,FGR=$$FILE^XPDV(XPDFILE) I FGR="" S XPDERR=1 Q
.K ^TMP($J,"XPD")
.F S XPDOLDA=$O(^XPD(9.6,XPDA,"KRN",XPDFILE,"NM",XPDOLDA)) Q:'XPDOLDA S Y0=$G(^(XPDOLDA,0)) D
..;XPDFL= 0-send,1-delete,2-link,3-merge,4-attach,5-disable
..S XPDFL=$P(Y0,U,3)
..;If deleting at site get an unused DA
..I XPDFL=1 S DA=$O(@FGR@(" "),-1)+1 F DA=DA:1 Q:'$D(^XTMP("XPDT",XPDA,"KRN",XPDFILE,DA))
..;$P(Y0,U,2) is file # for this template, reset Y0 before getting DA
..E S:$P(Y0,U,2) $P(Y0,U)=$P(Y0," FILE #") S DA=$$ENTRY^XPDV(Y0)
..I 'DA S XPDERR=1 Q
..;(-1)=action ^ ien in Build file
..S ^XTMP("XPDT",XPDA,"KRN",XPDFILE,DA,-1)=+XPDFL_"^"_XPDOLDA
..;action 2 - verify children, 4 - verify parent
..I XPDFL=2!(XPDFL=4),'$$MENU^XPDV(XPDFILE,DA,XPDFL) S XPDERR=1 Q
..;if action is 1,4 or 5 then only send .01 field and set checksum to ""
..I XPDFL=1!(XPDFL>3) S ^XTMP("XPDT",XPDA,"KRN",XPDFILE,DA,0)=$P(Y0,U),$P(^XPD(9.6,XPDA,"KRN",XPDFILE,"NM",XPDOLDA,0),U,4)="" Q
..M ^XTMP("XPDT",XPDA,"KRN",XPDFILE,DA)=@FGR@(DA)
..;execute entry build action
..D:EACT]"" ACT(EACT)
.;quit if no entries were saved
.Q:'$O(^XTMP("XPDT",XPDA,"KRN",XPDFILE,0))
.;XPDI=XPDI(XPDFILE), build x-ref of order to install
.S %=$P(^DIC(XPDFILE,0),U),^XTMP("XPDT",XPDA,"ORD",+$P(XPDI,";",2),XPDFILE)=XPDI,^(XPDFILE,0)=%
.Q
Q
QUES ;build from Install Questions multiple
N I,J,K,X,%
S X=""
;the "B" x-ref will give me the order of the questions
F S X=$O(^XPD(9.6,XPDA,"QUES","B",X)) Q:X="" S I=$$QUES^XPDV(X) S:'I XPDERR=1 D:I
.S J=0 F S J=$O(^XPD(9.6,XPDA,"QUES",I,J)) Q:J="" D
..;tranform J to DIR subscripts
..I $L(J)=1!(J="QQ") S ^XTMP("XPDT",XPDA,"QUES",X,$TR(J,"1ABQ","0AB?"))=^(J) Q ;^(J) ref to ^XPD(9.6,XPDA,"QUES",I,J)
..;set the word processing fields into DIR("?",#) structure
..F %=1:1 Q:'$D(^XPD(9.6,XPDA,"QUES",I,J,%,0)) S ^XTMP("XPDT",XPDA,"QUES",X,$TR(J,"AQ10","A?"),%)=^(0)
;send the File questions
S K=$G(^XPD(9.6,XPDA,"QDEF")) ;Developer Defaults for Questions
F I=1:2 S X=$P($T(QUESTION+I),";;",2,99) Q:X="" S Y=$P($T(QUESTION+I+1),";;",2) D
.S ^XTMP("XPDT",XPDA,"QUES",$P(X,";"),0)=$P(X,";",2),^("A")=$P(X,";",3),^("B")=$S($L($P(K,U,I)):$P(K,U,I),1:$P(X,";",4)),^("??")=$P(X,";",5) S:Y]"" ^("M")=Y
Q
INT ;build pre,post,enviroment, and restore routines
N %,I,R,X,Z
F I="PRE","INI","INIT","REST" I $G(^XPD(9.6,XPDA,I))]"" S X=^(I) D
.;remove parameters and seperate routine name from tag^routine
.S ^XTMP("XPDT",XPDA,I)=X,X=$P(X,"("),R=$P(X,U,$L(X,U)) Q:$D(^("RTN",R))
.I '$$RTN^XPDV(X,.Z) W !,"Routine ",X,Z S XPDERR=1 Q
.I I'="REST" S %=$$LOAD^XPDTA(R,"0^") Q
.;Restore routine, save in "REST" node, not stored at install site ;p713
.N DIF,XCNP
.S DIF="^XTMP(""XPDT"",XPDA,""REST"",X,",XCNP=0,X=R
.X ^%ZOSF("LOAD")
.S $P(^XTMP("XPDT",XPDA,"REST",X,2,0),";",7)="Build "_(+^XPD(9.6,XPDA,6.3))
Q
BLD ;build Build file, Package file and Order Parameter file
N %,DIC,X,XPD,XPDI,XPDV,Y
;Update the 'Date Distributed' field
S XPD(9.6,XPDA_",",.02)=$$DT^XLFDT()
D FILE^DIE("","XPD") K XPD
;save version of kernel and fm
S ^XTMP("XPDT",XPDA,"VER")=$$VERSION^XPDUTL("XU")_U_$$VERSION^XPDUTL("VA FILEMAN")
S ^XTMP("XPDT",XPDA,"MBREQ")=$P($G(XPDT(XPDT)),U,4)
M ^XTMP("XPDT",XPDA,"BLD",XPDA)=^XPD(9.6,XPDA)
;check national package file pointer
S XPDI=$P(^XPD(9.6,XPDA,0),U,2)
I XPDI="" W !,"No Package File Link" Q
S $P(^XTMP("XPDT",XPDA,"BLD",XPDA,0),U,2)=$$PT^XPDTA("^DIC(9.4)",XPDI)
;quit if no pointer to package file
I '$D(^DIC(9.4,XPDI)) W !,"Package File Link is corrupted" S XPDERR=1 Q
;update version multiple in package file,XPD=version^date distributed
S XPD=$$VER^XPDUTL(XPDNM)_U_$P(^XTMP("XPDT",XPDA,"BLD",XPDA,0),U,4)
;XPD(1)=root of description field
S:$D(^XTMP("XPDT",XPDA,"BLD",XPDA,1)) XPD(1)=$NA(^(1))
S ^XTMP("XPDT",XPDA,"PKG",XPDI,0)=^DIC(9.4,XPDI,0),^XTMP("XPDT",XPDA,"PKG",XPDI,22,0)="^"_$P(^DD(9.4,22,0),U,2)_"^1^1"
I $E(XPDNM,$L(XPDNM))="b" D BCK G VER ;Backup Build, don't update the Package file ;p750
;XPDNM'["*" is a version release
I XPDNM'["*" D
.S XPDV=$$PKGVER^XPDIP(XPDI,.XPD)
.;Merge is used to set single nodes and merge multiples
.F %=1,5,7,"DEV","VERSION" M ^XTMP("XPDT",XPDA,"PKG",XPDI,%)=^DIC(9.4,XPDI,%)
.;XPDV=ien of Version Multiple
.I $D(^DIC(9.4,XPDI,22,XPDV))'>9 W !!,"**Version multiple in Package file wasn't updated**",!! S XPDERR=1 Q
.;get just the current version multiple and make it the first entry in version multiple
.M ^XTMP("XPDT",XPDA,"PKG",XPDI,22,1)=^DIC(9.4,XPDI,22,XPDV)
.;check if SEND PATCH HISTORY is NO, kill PAH
.I $P(XPDT(XPDT),U,5) K ^XTMP("XPDT",XPDA,"PKG",XPDI,22,1,"PAH")
;this is a patch, %=version number, $P(XPD,U)=patch number
E D
.S %=$P(XPD,U),$P(XPD,U)=$P(XPDNM,"*",3),XPDV=$$PKGPAT^XPDIP(XPDI,%,.XPD)
.S ^XTMP("XPDT",XPDA,"PKG",XPDI,22,1,0)=^DIC(9.4,XPDI,22,+XPDV,0)
.I $D(^DIC(9.4,XPDI,22,+XPDV,"PAH",+$P(XPDV,U,2)))'>9 W !!,"**Patch multiple in Package file wasn't updated**",!! S XPDERR=1 Q
.M ^XTMP("XPDT",XPDA,"PKG",XPDI,22,1,"PAH",1)=^DIC(9.4,XPDI,22,+XPDV,"PAH",+$P(XPDV,U,2))
.;if CURRENT VERSION was updated in $$PKGPAT, save to TG
.I $P(XPDV,U,3) S ^XTMP("XPDT",XPDA,"PKG",XPDI,"VERSION")=$P(XPDV,U,3)
VER ;save the version ien^patch ien on -1 node
S ^XTMP("XPDT",XPDA,"PKG",XPDI,-1)="1^1"
;resolve Primary Help Frame (0;4)
S %=+$P(^DIC(9.4,XPDI,0),U,4) S:% $P(^XTMP("XPDT",XPDA,"PKG",XPDI,0),U,4)=$$PT^XPDTA("^DIC(9.2)",%)
Q
;
BCK ;Create Package file for Backup Build ;p750
S ^XTMP("XPDT",XPDA,"PKG",XPDI,22,1,0)=XPD
I XPDNM["*" D Q ;Patch Application History
.S ^XTMP("XPDT",XPDA,"PKG",XPDI,22,1,"PAH",1,0)=$P(XPDNM,"*",3)_"^"_DT
.M ^XTMP("XPDT",XPDA,"PKG",XPDI,22,1,"PAH",1,1)=@XPD(1)
.Q
;Version Description
M ^XTMP("XPDT",XPDA,"PKG",XPDI,22,1,1)=@XPD(1)
Q
;
ACT(%) ;execute action
;user can count on DA,XPDFILE,XPDFL,XPDNM,XPDOLDA being around
;DA=ien in ^XTMP("XPDT",XPDA,"KRN",XPDFILE,DA)
;XPDOLDA=ien in ^XPD(9.6,XPDA,"KRN",XPDIFLE,"NM",XPDOLDA)
N EACT,FACT,FGR,K0,Y0
S:%'["^" %="^"_%
D @% Q
;
;the following are the default questions for the INSTALL QUESTIONS
;in file 9.6, the format is:
;;field .01;field 1;field 2;field 4;field 7
;;field 10
QUESTION ;package install questions
;;XPF1;Y;Shall I write over your |FLAG| File;YES;^D REP^XPDH
;;D XPF1^XPDIQ
;;XPF2;Y;Want my data |FLAG| yours;YES;^D DTA^XPDH
;;D XPF2^XPDIQ
;;XPI1;YO;Want KIDS to INHIBIT LOGONs during the install;NO;^D INHIBIT^XPDH
;;D XPI1^XPDIQ
;;XPM1;PO^VA(200,:EM;Enter the Coordinator for Mail Group '|FLAG|';;^D MG^XPDH
;;D XPM1^XPDIQ
;;XPO1;Y;Want KIDS to Rebuild Menu Trees Upon Completion of Install;NO;^D MENU^XPDH
;;D XPO1^XPDIQ
;;XPZ1;Y;Want to DISABLE Scheduled Options, Menu Options, and Protocols;NO;^D OPT^XPDH
;;D XPZ1^XPDIQ
;;XPZ2;Y;Want to MOVE routines to other CPUs;NO;^D RTN^XPDH
;;D XPZ2^XPDIQ
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXPDTC 8532 printed Apr 09, 2024@21:13:56 Page 2
XPDTC ;SFISC/RSD - Transport calls ;10/15/2008
+1 ;;8.0;KERNEL;**10,15,21,39,41,44,58,83,92,95,100,108,124,131,463,511,517,559,672,713,750**;Jul 10, 1995;Build 6
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;^XTMP("XPDT",XPDA,data type,file #,
+5 ;XPDA=ien of File 9.6, XPDNM=.01 field
DD ;build DD
+1 NEW DIERR,FILE,FGR,FNAM,Z2,Z3,Z4
+2 SET FILE=0
SET FGR="^XTMP(""XPDT"",XPDA)"
SET FNAM=$NAME(^XPD(9.6,XPDA,4,"APDD"))
+3 FOR
SET FILE=$ORDER(^XPD(9.6,XPDA,4,FILE))
if 'FILE
QUIT
Begin DoDot:1
+4 SET Z2=$GET(^XPD(9.6,XPDA,4,FILE,222))
SET Z3=$GET(^(223))
SET Z4=$GET(^(224))
+5 if '$$DATA^XPDV(FILE,Z2)
QUIT
+6 DO FIA^DIFROMSU(FILE,"",FNAM,FGR,Z2,Z3,Z4,XPDVER)
if $DATA(DIERR)
DO DIERR
End DoDot:1
+7 if '$DATA(^XTMP("XPDT",XPDA,"FIA"))
QUIT
+8 ;send DD and Data
+9 DO DDOUT^DIFROMS("","","",FGR)
if $DATA(DIERR)
DO DIERR
DO DATAOUT^DIFROMS("","","",FGR)
if $DATA(DIERR)
DO DIERR
+10 QUIT
+11 ;XPDERR is checked in XPDT and will abort transport
DIERR ;record error
+1 DO MSG^DIALOG("EW",.XPD)
SET XPDERR=1
+2 QUIT
KRN ;build Kernel Files
+1 ;XPDFILE=file #, XPDOLDA=ien in Build file
+2 NEW %,%1,%2,DA,EACT,FACT,FGR,XPDFILE,XPDFL,XPDOLDA,XPDI
+3 FOR XPDFILE=1:1
SET Y0=$PIECE($TEXT(FILES+XPDFILE^XPDE),";;",2,99)
if Y0=""
QUIT
SET XPDI(+Y0)=Y0
+4 ;XPDI(XPDFILE)=file;order;x-ref;fact;eact;fpre;epre;fpos;epos;fdel
+5 SET XPDFILE=0
+6 ;check we are sending something and have the executes
+7 FOR
SET XPDFILE=$ORDER(^XPD(9.6,XPDA,"KRN",XPDFILE))
if 'XPDFILE
QUIT
SET XPDI=$GET(XPDI(XPDFILE))
IF $ORDER(^(XPDFILE,"NM",0))
IF XPDI
Begin DoDot:1
+8 SET FACT=$PIECE(XPDI,";",4)
SET EACT=$PIECE(XPDI,";",5)
+9 ;need to add code to check if File and data is already being sent in the File
+10 ;mult. If it is, don't bother sending it again. DTL(XPDFILE)
+11 SET XPDOLDA=0
SET FGR=$$FILE^XPDV(XPDFILE)
IF FGR=""
SET XPDERR=1
QUIT
+12 KILL ^TMP($JOB,"XPD")
+13 FOR
SET XPDOLDA=$ORDER(^XPD(9.6,XPDA,"KRN",XPDFILE,"NM",XPDOLDA))
if 'XPDOLDA
QUIT
SET Y0=$GET(^(XPDOLDA,0))
Begin DoDot:2
+14 ;XPDFL= 0-send,1-delete,2-link,3-merge,4-attach,5-disable
+15 SET XPDFL=$PIECE(Y0,U,3)
+16 ;If deleting at site get an unused DA
+17 IF XPDFL=1
SET DA=$ORDER(@FGR@(" "),-1)+1
FOR DA=DA:1
if '$DATA(^XTMP("XPDT",XPDA,"KRN",XPDFILE,DA))
QUIT
+18 ;$P(Y0,U,2) is file # for this template, reset Y0 before getting DA
+19 IF '$TEST
if $PIECE(Y0,U,2)
SET $PIECE(Y0,U)=$PIECE(Y0," FILE #")
SET DA=$$ENTRY^XPDV(Y0)
+20 IF 'DA
SET XPDERR=1
QUIT
+21 ;(-1)=action ^ ien in Build file
+22 SET ^XTMP("XPDT",XPDA,"KRN",XPDFILE,DA,-1)=+XPDFL_"^"_XPDOLDA
+23 ;action 2 - verify children, 4 - verify parent
+24 IF XPDFL=2!(XPDFL=4)
IF '$$MENU^XPDV(XPDFILE,DA,XPDFL)
SET XPDERR=1
QUIT
+25 ;if action is 1,4 or 5 then only send .01 field and set checksum to ""
+26 IF XPDFL=1!(XPDFL>3)
SET ^XTMP("XPDT",XPDA,"KRN",XPDFILE,DA,0)=$PIECE(Y0,U)
SET $PIECE(^XPD(9.6,XPDA,"KRN",XPDFILE,"NM",XPDOLDA,0),U,4)=""
QUIT
+27 MERGE ^XTMP("XPDT",XPDA,"KRN",XPDFILE,DA)=@FGR@(DA)
+28 ;execute entry build action
+29 if EACT]""
DO ACT(EACT)
End DoDot:2
+30 ;quit if no entries were saved
+31 if '$ORDER(^XTMP("XPDT",XPDA,"KRN",XPDFILE,0))
QUIT
+32 ;XPDI=XPDI(XPDFILE), build x-ref of order to install
+33 SET %=$PIECE(^DIC(XPDFILE,0),U)
SET ^XTMP("XPDT",XPDA,"ORD",+$PIECE(XPDI,";",2),XPDFILE)=XPDI
SET ^(XPDFILE,0)=%
+34 QUIT
End DoDot:1
if $DATA(XPDERR)
QUIT
if FACT]""
DO ACT(FACT)
+35 QUIT
QUES ;build from Install Questions multiple
+1 NEW I,J,K,X,%
+2 SET X=""
+3 ;the "B" x-ref will give me the order of the questions
+4 FOR
SET X=$ORDER(^XPD(9.6,XPDA,"QUES","B",X))
if X=""
QUIT
SET I=$$QUES^XPDV(X)
if 'I
SET XPDERR=1
if I
Begin DoDot:1
+5 SET J=0
FOR
SET J=$ORDER(^XPD(9.6,XPDA,"QUES",I,J))
if J=""
QUIT
Begin DoDot:2
+6 ;tranform J to DIR subscripts
+7 ;^(J) ref to ^XPD(9.6,XPDA,"QUES",I,J)
IF $LENGTH(J)=1!(J="QQ")
SET ^XTMP("XPDT",XPDA,"QUES",X,$TRANSLATE(J,"1ABQ","0AB?"))=^(J)
QUIT
+8 ;set the word processing fields into DIR("?",#) structure
+9 FOR %=1:1
if '$DATA(^XPD(9.6,XPDA,"QUES",I,J,%,0))
QUIT
SET ^XTMP("XPDT",XPDA,"QUES",X,$TRANSLATE(J,"AQ10","A?"),%)=^(0)
End DoDot:2
End DoDot:1
+10 ;send the File questions
+11 ;Developer Defaults for Questions
SET K=$GET(^XPD(9.6,XPDA,"QDEF"))
+12 FOR I=1:2
SET X=$PIECE($TEXT(QUESTION+I),";;",2,99)
if X=""
QUIT
SET Y=$PIECE($TEXT(QUESTION+I+1),";;",2)
Begin DoDot:1
+13 SET ^XTMP("XPDT",XPDA,"QUES",$PIECE(X,";"),0)=$PIECE(X,";",2)
SET ^("A")=$PIECE(X,";",3)
SET ^("B")=$SELECT($LENGTH($PIECE(K,U,I)):$PIECE(K,U,I),1:$PIECE(X,";",4))
SET ^("??")=$PIECE(X,";",5)
if Y]""
SET ^("M")=Y
End DoDot:1
+14 QUIT
INT ;build pre,post,enviroment, and restore routines
+1 NEW %,I,R,X,Z
+2 FOR I="PRE","INI","INIT","REST"
IF $GET(^XPD(9.6,XPDA,I))]""
SET X=^(I)
Begin DoDot:1
+3 ;remove parameters and seperate routine name from tag^routine
+4 SET ^XTMP("XPDT",XPDA,I)=X
SET X=$PIECE(X,"(")
SET R=$PIECE(X,U,$LENGTH(X,U))
if $DATA(^("RTN",R))
QUIT
+5 IF '$$RTN^XPDV(X,.Z)
WRITE !,"Routine ",X,Z
SET XPDERR=1
QUIT
+6 IF I'="REST"
SET %=$$LOAD^XPDTA(R,"0^")
QUIT
+7 ;Restore routine, save in "REST" node, not stored at install site ;p713
+8 NEW DIF,XCNP
+9 SET DIF="^XTMP(""XPDT"",XPDA,""REST"",X,"
SET XCNP=0
SET X=R
+10 XECUTE ^%ZOSF("LOAD")
+11 SET $PIECE(^XTMP("XPDT",XPDA,"REST",X,2,0),";",7)="Build "_(+^XPD(9.6,XPDA,6.3))
End DoDot:1
+12 QUIT
BLD ;build Build file, Package file and Order Parameter file
+1 NEW %,DIC,X,XPD,XPDI,XPDV,Y
+2 ;Update the 'Date Distributed' field
+3 SET XPD(9.6,XPDA_",",.02)=$$DT^XLFDT()
+4 DO FILE^DIE("","XPD")
KILL XPD
+5 ;save version of kernel and fm
+6 SET ^XTMP("XPDT",XPDA,"VER")=$$VERSION^XPDUTL("XU")_U_$$VERSION^XPDUTL("VA FILEMAN")
+7 SET ^XTMP("XPDT",XPDA,"MBREQ")=$PIECE($GET(XPDT(XPDT)),U,4)
+8 MERGE ^XTMP("XPDT",XPDA,"BLD",XPDA)=^XPD(9.6,XPDA)
+9 ;check national package file pointer
+10 SET XPDI=$PIECE(^XPD(9.6,XPDA,0),U,2)
+11 IF XPDI=""
WRITE !,"No Package File Link"
QUIT
+12 SET $PIECE(^XTMP("XPDT",XPDA,"BLD",XPDA,0),U,2)=$$PT^XPDTA("^DIC(9.4)",XPDI)
+13 ;quit if no pointer to package file
+14 IF '$DATA(^DIC(9.4,XPDI))
WRITE !,"Package File Link is corrupted"
SET XPDERR=1
QUIT
+15 ;update version multiple in package file,XPD=version^date distributed
+16 SET XPD=$$VER^XPDUTL(XPDNM)_U_$PIECE(^XTMP("XPDT",XPDA,"BLD",XPDA,0),U,4)
+17 ;XPD(1)=root of description field
+18 if $DATA(^XTMP("XPDT",XPDA,"BLD",XPDA,1))
SET XPD(1)=$NAME(^(1))
+19 SET ^XTMP("XPDT",XPDA,"PKG",XPDI,0)=^DIC(9.4,XPDI,0)
SET ^XTMP("XPDT",XPDA,"PKG",XPDI,22,0)="^"_$PIECE(^DD(9.4,22,0),U,2)_"^1^1"
+20 ;Backup Build, don't update the Package file ;p750
IF $EXTRACT(XPDNM,$LENGTH(XPDNM))="b"
DO BCK
GOTO VER
+21 ;XPDNM'["*" is a version release
+22 IF XPDNM'["*"
Begin DoDot:1
+23 SET XPDV=$$PKGVER^XPDIP(XPDI,.XPD)
+24 ;Merge is used to set single nodes and merge multiples
+25 FOR %=1,5,7,"DEV","VERSION"
MERGE ^XTMP("XPDT",XPDA,"PKG",XPDI,%)=^DIC(9.4,XPDI,%)
+26 ;XPDV=ien of Version Multiple
+27 IF $DATA(^DIC(9.4,XPDI,22,XPDV))'>9
WRITE !!,"**Version multiple in Package file wasn't updated**",!!
SET XPDERR=1
QUIT
+28 ;get just the current version multiple and make it the first entry in version multiple
+29 MERGE ^XTMP("XPDT",XPDA,"PKG",XPDI,22,1)=^DIC(9.4,XPDI,22,XPDV)
+30 ;check if SEND PATCH HISTORY is NO, kill PAH
+31 IF $PIECE(XPDT(XPDT),U,5)
KILL ^XTMP("XPDT",XPDA,"PKG",XPDI,22,1,"PAH")
End DoDot:1
+32 ;this is a patch, %=version number, $P(XPD,U)=patch number
+33 IF '$TEST
Begin DoDot:1
+34 SET %=$PIECE(XPD,U)
SET $PIECE(XPD,U)=$PIECE(XPDNM,"*",3)
SET XPDV=$$PKGPAT^XPDIP(XPDI,%,.XPD)
+35 SET ^XTMP("XPDT",XPDA,"PKG",XPDI,22,1,0)=^DIC(9.4,XPDI,22,+XPDV,0)
+36 IF $DATA(^DIC(9.4,XPDI,22,+XPDV,"PAH",+$PIECE(XPDV,U,2)))'>9
WRITE !!,"**Patch multiple in Package file wasn't updated**",!!
SET XPDERR=1
QUIT
+37 MERGE ^XTMP("XPDT",XPDA,"PKG",XPDI,22,1,"PAH",1)=^DIC(9.4,XPDI,22,+XPDV,"PAH",+$PIECE(XPDV,U,2))
+38 ;if CURRENT VERSION was updated in $$PKGPAT, save to TG
+39 IF $PIECE(XPDV,U,3)
SET ^XTMP("XPDT",XPDA,"PKG",XPDI,"VERSION")=$PIECE(XPDV,U,3)
End DoDot:1
VER ;save the version ien^patch ien on -1 node
+1 SET ^XTMP("XPDT",XPDA,"PKG",XPDI,-1)="1^1"
+2 ;resolve Primary Help Frame (0;4)
+3 SET %=+$PIECE(^DIC(9.4,XPDI,0),U,4)
if %
SET $PIECE(^XTMP("XPDT",XPDA,"PKG",XPDI,0),U,4)=$$PT^XPDTA("^DIC(9.2)",%)
+4 QUIT
+5 ;
BCK ;Create Package file for Backup Build ;p750
+1 SET ^XTMP("XPDT",XPDA,"PKG",XPDI,22,1,0)=XPD
+2 ;Patch Application History
IF XPDNM["*"
Begin DoDot:1
+3 SET ^XTMP("XPDT",XPDA,"PKG",XPDI,22,1,"PAH",1,0)=$PIECE(XPDNM,"*",3)_"^"_DT
+4 MERGE ^XTMP("XPDT",XPDA,"PKG",XPDI,22,1,"PAH",1,1)=@XPD(1)
+5 QUIT
End DoDot:1
QUIT
+6 ;Version Description
+7 MERGE ^XTMP("XPDT",XPDA,"PKG",XPDI,22,1,1)=@XPD(1)
+8 QUIT
+9 ;
ACT(%) ;execute action
+1 ;user can count on DA,XPDFILE,XPDFL,XPDNM,XPDOLDA being around
+2 ;DA=ien in ^XTMP("XPDT",XPDA,"KRN",XPDFILE,DA)
+3 ;XPDOLDA=ien in ^XPD(9.6,XPDA,"KRN",XPDIFLE,"NM",XPDOLDA)
+4 NEW EACT,FACT,FGR,K0,Y0
+5 if %'["^"
SET %="^"_%
+6 DO @%
QUIT
+7 ;
+8 ;the following are the default questions for the INSTALL QUESTIONS
+9 ;in file 9.6, the format is:
+10 ;;field .01;field 1;field 2;field 4;field 7
+11 ;;field 10
QUESTION ;package install questions
+1 ;;XPF1;Y;Shall I write over your |FLAG| File;YES;^D REP^XPDH
+2 ;;D XPF1^XPDIQ
+3 ;;XPF2;Y;Want my data |FLAG| yours;YES;^D DTA^XPDH
+4 ;;D XPF2^XPDIQ
+5 ;;XPI1;YO;Want KIDS to INHIBIT LOGONs during the install;NO;^D INHIBIT^XPDH
+6 ;;D XPI1^XPDIQ
+7 ;;XPM1;PO^VA(200,:EM;Enter the Coordinator for Mail Group '|FLAG|';;^D MG^XPDH
+8 ;;D XPM1^XPDIQ
+9 ;;XPO1;Y;Want KIDS to Rebuild Menu Trees Upon Completion of Install;NO;^D MENU^XPDH
+10 ;;D XPO1^XPDIQ
+11 ;;XPZ1;Y;Want to DISABLE Scheduled Options, Menu Options, and Protocols;NO;^D OPT^XPDH
+12 ;;D XPZ1^XPDIQ
+13 ;;XPZ2;Y;Want to MOVE routines to other CPUs;NO;^D RTN^XPDH
+14 ;;D XPZ2^XPDIQ
