- 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**;Jul 10, 1995;Build 5
- ;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 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 init routines
- N %,I,R,X,Z
- F I="PRE","INI","INIT" 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
- .S %=$$LOAD^XPDTA(R,"0^")
- 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"
- ;add node 20 to XTMP for Patient Merge
- M ^XTMP("XPDT",XPDA,"PKG",XPDI,20)=^DIC(9.4,XPDI,20)
- ;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,20,"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)
- ;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
- ;
- 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
- 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**;Jul 10, 1995;Build 5
- +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 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 init routines
- +1 NEW %,I,R,X,Z
- +2 FOR I="PRE","INI","INIT"
- 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 SET %=$$LOAD^XPDTA(R,"0^")
- End DoDot:1
- +7 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 ;add node 20 to XTMP for Patient Merge
- +21 MERGE ^XTMP("XPDT",XPDA,"PKG",XPDI,20)=^DIC(9.4,XPDI,20)
- +22 ;XPDNM'["*" is a version release
- +23 IF XPDNM'["*"
- Begin DoDot:1
- +24 SET XPDV=$$PKGVER^XPDIP(XPDI,.XPD)
- +25 ;Merge is used to set single nodes and merge multiples
- +26 FOR %=1,5,7,20,"DEV","VERSION"
- MERGE ^XTMP("XPDT",XPDA,"PKG",XPDI,%)=^DIC(9.4,XPDI,%)
- +27 ;XPDV=ien of Version Multiple
- +28 IF $DATA(^DIC(9.4,XPDI,22,XPDV))'>9
- WRITE !!,"**Version multiple in Package file wasn't updated**",!!
- SET XPDERR=1
- QUIT
- +29 ;get just the current version multiple and make it the first entry in version multiple
- +30 MERGE ^XTMP("XPDT",XPDA,"PKG",XPDI,22,1)=^DIC(9.4,XPDI,22,XPDV)
- +31 ;check if SEND PATCH HISTORY is NO, kill PAH
- +32 IF $PIECE(XPDT(XPDT),U,5)
- KILL ^XTMP("XPDT",XPDA,"PKG",XPDI,22,1,"PAH")
- End DoDot:1
- +33 ;this is a patch, %=version number, $P(XPD,U)=patch number
- +34 IF '$TEST
- Begin DoDot:1
- +35 SET %=$PIECE(XPD,U)
- SET $PIECE(XPD,U)=$PIECE(XPDNM,"*",3)
- SET XPDV=$$PKGPAT^XPDIP(XPDI,%,.XPD)
- +36 SET ^XTMP("XPDT",XPDA,"PKG",XPDI,22,1,0)=^DIC(9.4,XPDI,22,+XPDV,0)
- +37 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
- +38 MERGE ^XTMP("XPDT",XPDA,"PKG",XPDI,22,1,"PAH",1)=^DIC(9.4,XPDI,22,+XPDV,"PAH",+$PIECE(XPDV,U,2))
- +39 ;if CURRENT VERSION was updated in $$PKGPAT, save to TG
- +40 IF $PIECE(XPDV,U,3)
- SET ^XTMP("XPDT",XPDA,"PKG",XPDI,"VERSION")=$PIECE(XPDV,U,3)
- End DoDot:1
- +41 ;save the version ien^patch ien on -1 node
- +42 SET ^XTMP("XPDT",XPDA,"PKG",XPDI,-1)="1^1"
- +43 ;resolve Primary Help Frame (0;4)
- +44 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)",%)
- +45 QUIT
- +46 ;
- 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
