source: FOIAVistA/tag/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XPDER.m@ 628

Last change on this file since 628 was 628, checked in by George Lilly, 14 years ago

initial load of FOIAVistA 6/30/08 version

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