XPDER ;SFISC/RSD - Rollup Patches into Build ;09/13/96 09:04
;;8.0;KERNEL;**44**;Jul 10, 1995
EN1 ;rollup patches into new build
N DIR,DIRUT,XPD,XPDA,XPDIT,XPDF,XPDFL,XPDJ,XPDNM,XPDVER,XPDPKG,XPDT,XPDY,X,Y,Z W !
;only find Single packages, not patches, that have a Package file link
S Z="AEMQZ",Z("S")="S %=$G(^(0)) I $P(%,U)'[""*"",$D(^DIC(9.4,+$P(%,U,2),0)),'$P(%,U,3)"
Q:'$$DIC^XPDE(.Z,"Rollup patches into Build: ")
S XPDA=+Y,XPDNM=$P(Y(0),U),XPDPKG=+$P(Y(0),U,2),XPDVER=$$VER^XPDUTL(XPDNM)
;check if package contains patches
S (Y,Z)=0
F S Y=$O(^XPD(9.6,XPDA,10,Y)) Q:'Y S X=^(Y,0) D
.I 'Z W !,"This package already contains the following patches:" S Z=1
.W !?3,X
W !!,"The following patches can be rolled into Package ",XPDNM,!
S X=0 F S X=$O(^XPD(9.6,"C",XPDPKG,X)) Q:'X D
.Q:'$D(^XPD(9.6,X,0)) S Y=$P(^(0),U)
.I $P(Y,"*",2)=XPDVER,'$D(^XPD(9.6,XPDA,10,"B",Y)) S XPDT(X)=Y W ?5,Y,!
I '$D(XPDT) W !!,"No patches exist" D QUIT^XPDE(XPDA) Q
S DIR(0)="Y",DIR("A")="OK to continue",DIR("B")="YES" D ^DIR
I 'Y!$D(DIRUT) D QUIT^XPDE(XPDA) W ! Q
D WAIT^DICD S XPDIT=0
F S XPDIT=$O(XPDT(XPDIT)),(XPDF,XPDFL)=0 Q:'XPDIT D
.;loop through Files
.N DA,DIK
.F W "." S XPDF=$O(^XPD(9.6,XPDIT,4,XPDF)) Q:'XPDF K XPD M XPD(XPDF)=^(XPDF) D
..;if file doesn't exist in original build
..I '$D(^XPD(9.6,XPDA,4,XPDF)) M ^(XPDF)=XPD(XPDF) S XPDFL=1 Q
..S Y=$G(^XPD(9.6,XPDA,4,XPDF,222))
..;if original is a full DD do nothing
..I $P(Y,U,3)="f" K XPD(XPDF) Q
..I $P($G(XPD(XPDF,222)),U,3)="f" K ^XPD(9.6,XPDA,4,XPDF) M ^(XPDF)=XPD(XPDF) S XPDFL=1 Q
..;since it must be a partial, don't need these nodes
..K XPD(XPDF,0),XPD(XPDF,222),XPD(XPDF,223),XPD(XPDF,224)
..S XPDJ=0
..;loop thru incoming partial subDD's
..F S XPDJ=$O(XPD(XPDF,2,XPDJ)) Q:'XPDJ D
...;if original has this subDD and doesn't have any field, then it is taking the entire subDD, so don't care about incoming
...I '$D(^XPD(9.6,XPDA,4,XPDF,2,XPDJ)) M ^(XPDJ)=XPD(XPDF,2,XPDJ) Q
...I '$O(^XPD(9.6,XPDA,4,XPDF,2,XPDJ,1,0)) K XPD(XPDF,2,XPDJ) Q
...S XPDY=0
...F S XPDY=$O(XPD(XPDF,2,XPDJ,1,XPDY)) Q:'XPDY D
....I $D(^XPD(9.6,XPDA,4,XPDF,2,XPDJ,1,XPDY)) K XPD(XPDF,2,XPDJ,1,XPDY) Q
....M ^XPD(9.6,XPDA,4,XPDF,2,XPDJ,1,XPDY)=XPD(XPDF,2,XPDJ,1,XPDY)
...Q:'$O(XPD(XPDF,2,XPDJ,1,0))
...K DA,XPD(XPDF,2,XPDJ)
...S DA(3)=XPDA,DA(2)=XPDF,DA(1)=XPDJ,DIK="^XPD(9.6,"_XPDA_",4,"_XPDF_",2,"_XPDJ_",1," D IXALL^DIK
..Q:'$O(XPD(XPDF,2,0))
..K DA,XPD(XPDF)
..S DA(2)=XPDA,DA(1)=XPDF,DIK="^XPD(9.6,"_XPDA_",4,"_XPDF_",2," D IXALL^DIK
.;XPDFL=1 if we merged data into node 4 at top level
.I XPDFL K DA S DA(1)=XPDA,DIK="^XPD(9.6,"_XPDA_",4," D IXALL^DIK
.;loop through Build Components
.S XPDF=0 F S XPDF=$O(^XPD(9.6,XPDIT,"KRN",XPDF)) Q:'XPDF D
..K XPD S (XPDJ,XPDY)=0 W "."
..F S XPDY=$O(^XPD(9.6,XPDIT,"KRN",XPDF,"NM",XPDY)) Q:XPDY="" S XPDX=$G(^(XPDY,0)) D:$P(XPDX,U)]""
...;quit if components exist in original build
...Q:$D(^XPD(9.6,XPDA,"KRN",XPDF,"NM","B",$P(XPDX,U)))
...S XPDJ=XPDJ+1,Y="+"_XPDJ_","_XPDF_","_XPDA_",",XPD(9.68,Y,.01)=$P(XPDX,U),XPD(9.68,Y,.03)=$P(XPDX,U,3)
..Q:'$D(XPD) D UPDATE^DIE("","XPD")
.;put patch in mulitple
.K XPD S XPD(9.63,"+1,"_XPDA_",",.01)=XPDT(XPDIT)
.D UPDATE^DIE("","XPD")
D QUIT^XPDE(XPDA) W "...Done.",!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXPDER 3326 printed Apr 09, 2024@21:14:35 Page 2
XPDER ;SFISC/RSD - Rollup Patches into Build ;09/13/96 09:04
+1 ;;8.0;KERNEL;**44**;Jul 10, 1995
EN1 ;rollup patches into new build
+1 NEW DIR,DIRUT,XPD,XPDA,XPDIT,XPDF,XPDFL,XPDJ,XPDNM,XPDVER,XPDPKG,XPDT,XPDY,X,Y,Z
WRITE !
+2 ;only find Single packages, not patches, that have a Package file link
+3 SET Z="AEMQZ"
SET Z("S")="S %=$G(^(0)) I $P(%,U)'[""*"",$D(^DIC(9.4,+$P(%,U,2),0)),'$P(%,U,3)"
+4 if '$$DIC^XPDE(.Z,"Rollup patches into Build
QUIT
+5 SET XPDA=+Y
SET XPDNM=$PIECE(Y(0),U)
SET XPDPKG=+$PIECE(Y(0),U,2)
SET XPDVER=$$VER^XPDUTL(XPDNM)
+6 ;check if package contains patches
+7 SET (Y,Z)=0
+8 FOR
SET Y=$ORDER(^XPD(9.6,XPDA,10,Y))
if 'Y
QUIT
SET X=^(Y,0)
Begin DoDot:1
+9 IF 'Z
WRITE !,"This package already contains the following patches:"
SET Z=1
+10 WRITE !?3,X
End DoDot:1
+11 WRITE !!,"The following patches can be rolled into Package ",XPDNM,!
+12 SET X=0
FOR
SET X=$ORDER(^XPD(9.6,"C",XPDPKG,X))
if 'X
QUIT
Begin DoDot:1
+13 if '$DATA(^XPD(9.6,X,0))
QUIT
SET Y=$PIECE(^(0),U)
+14 IF $PIECE(Y,"*",2)=XPDVER
IF '$DATA(^XPD(9.6,XPDA,10,"B",Y))
SET XPDT(X)=Y
WRITE ?5,Y,!
End DoDot:1
+15 IF '$DATA(XPDT)
WRITE !!,"No patches exist"
DO QUIT^XPDE(XPDA)
QUIT
+16 SET DIR(0)="Y"
SET DIR("A")="OK to continue"
SET DIR("B")="YES"
DO ^DIR
+17 IF 'Y!$DATA(DIRUT)
DO QUIT^XPDE(XPDA)
WRITE !
QUIT
+18 DO WAIT^DICD
SET XPDIT=0
+19 FOR
SET XPDIT=$ORDER(XPDT(XPDIT))
SET (XPDF,XPDFL)=0
if 'XPDIT
QUIT
Begin DoDot:1
+20 ;loop through Files
+21 NEW DA,DIK
+22 FOR
WRITE "."
SET XPDF=$ORDER(^XPD(9.6,XPDIT,4,XPDF))
if 'XPDF
QUIT
KILL XPD
MERGE XPD(XPDF)=^(XPDF)
Begin DoDot:2
+23 ;if file doesn't exist in original build
+24 IF '$DATA(^XPD(9.6,XPDA,4,XPDF))
MERGE ^(XPDF)=XPD(XPDF)
SET XPDFL=1
QUIT
+25 SET Y=$GET(^XPD(9.6,XPDA,4,XPDF,222))
+26 ;if original is a full DD do nothing
+27 IF $PIECE(Y,U,3)="f"
KILL XPD(XPDF)
QUIT
+28 IF $PIECE($GET(XPD(XPDF,222)),U,3)="f"
KILL ^XPD(9.6,XPDA,4,XPDF)
MERGE ^(XPDF)=XPD(XPDF)
SET XPDFL=1
QUIT
+29 ;since it must be a partial, don't need these nodes
+30 KILL XPD(XPDF,0),XPD(XPDF,222),XPD(XPDF,223),XPD(XPDF,224)
+31 SET XPDJ=0
+32 ;loop thru incoming partial subDD's
+33 FOR
SET XPDJ=$ORDER(XPD(XPDF,2,XPDJ))
if 'XPDJ
QUIT
Begin DoDot:3
+34 ;if original has this subDD and doesn't have any field, then it is taking the entire subDD, so don't care about incoming
+35 IF '$DATA(^XPD(9.6,XPDA,4,XPDF,2,XPDJ))
MERGE ^(XPDJ)=XPD(XPDF,2,XPDJ)
QUIT
+36 IF '$ORDER(^XPD(9.6,XPDA,4,XPDF,2,XPDJ,1,0))
KILL XPD(XPDF,2,XPDJ)
QUIT
+37 SET XPDY=0
+38 FOR
SET XPDY=$ORDER(XPD(XPDF,2,XPDJ,1,XPDY))
if 'XPDY
QUIT
Begin DoDot:4
+39 IF $DATA(^XPD(9.6,XPDA,4,XPDF,2,XPDJ,1,XPDY))
KILL XPD(XPDF,2,XPDJ,1,XPDY)
QUIT
+40 MERGE ^XPD(9.6,XPDA,4,XPDF,2,XPDJ,1,XPDY)=XPD(XPDF,2,XPDJ,1,XPDY)
End DoDot:4
+41 if '$ORDER(XPD(XPDF,2,XPDJ,1,0))
QUIT
+42 KILL DA,XPD(XPDF,2,XPDJ)
+43 SET DA(3)=XPDA
SET DA(2)=XPDF
SET DA(1)=XPDJ
SET DIK="^XPD(9.6,"_XPDA_",4,"_XPDF_",2,"_XPDJ_",1,"
DO IXALL^DIK
End DoDot:3
+44 if '$ORDER(XPD(XPDF,2,0))
QUIT
+45 KILL DA,XPD(XPDF)
+46 SET DA(2)=XPDA
SET DA(1)=XPDF
SET DIK="^XPD(9.6,"_XPDA_",4,"_XPDF_",2,"
DO IXALL^DIK
End DoDot:2
+47 ;XPDFL=1 if we merged data into node 4 at top level
+48 IF XPDFL
KILL DA
SET DA(1)=XPDA
SET DIK="^XPD(9.6,"_XPDA_",4,"
DO IXALL^DIK
+49 ;loop through Build Components
+50 SET XPDF=0
FOR
SET XPDF=$ORDER(^XPD(9.6,XPDIT,"KRN",XPDF))
if 'XPDF
QUIT
Begin DoDot:2
+51 KILL XPD
SET (XPDJ,XPDY)=0
WRITE "."
+52 FOR
SET XPDY=$ORDER(^XPD(9.6,XPDIT,"KRN",XPDF,"NM",XPDY))
if XPDY=""
QUIT
SET XPDX=$GET(^(XPDY,0))
if $PIECE(XPDX,U)]""
Begin DoDot:3
+53 ;quit if components exist in original build
+54 if $DATA(^XPD(9.6,XPDA,"KRN",XPDF,"NM","B",$PIECE(XPDX,U)))
QUIT
+55 SET XPDJ=XPDJ+1
SET Y="+"_XPDJ_","_XPDF_","_XPDA_","
SET XPD(9.68,Y,.01)=$PIECE(XPDX,U)
SET XPD(9.68,Y,.03)=$PIECE(XPDX,U,3)
End DoDot:3
+56 if '$DATA(XPD)
QUIT
DO UPDATE^DIE("","XPD")
End DoDot:2
+57 ;put patch in mulitple
+58 KILL XPD
SET XPD(9.63,"+1,"_XPDA_",",.01)=XPDT(XPDIT)
+59 DO UPDATE^DIE("","XPD")
End DoDot:1
+60 DO QUIT^XPDE(XPDA)
WRITE "...Done.",!
+61 QUIT
