- XPDER ;SFISC/RSD - Rollup Patches into Build ;09/13/96 09:04 [ 04/02/2003 8:29 AM ]
- ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
- ;;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
- XPDER ;SFISC/RSD - Rollup Patches into Build ;09/13/96 09:04 [ 04/02/2003 8:29 AM ]
- +1 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003
- +2 ;;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
