XPDB1 ;SFISC/RSD - Build utilities ;10/15/2008
;;8.0;KERNEL;**108,539**;Jul 10, 1995;Build 11
;Per VHA Directive 2004-038, this routine should not be modified.
Q
LOOK() ;Lookup BUILD, build XPDT from build file
;XPDT(seq #)=ien^name
;XPDT("DA",ien)=seq #
N XPD,XPDA,XPDI,XPDNM,X,Y,Z K XPDT
S XPDT=0
S XPDA=$$DIC^XPDE("AEMQZ",,1) Q:'XPDA 0
S XPDI=$P(Y(0),U)
;if type is Global Package, set DIRUT if there is other packages
I $P(Y(0),U,3)=2 W " GLOBAL PACKAGE"
D PCK(XPDA,XPDI)
G:$P(Y(0),U,3)'=1 LKX
;multi-package
W " (Multi-Package)" S X=0
F S X=$O(^XPD(9.6,XPDA,10,X)) Q:'X S Z=$P($G(^(X,0)),U) D:Z]""
.N XPDA,X
.W !?3,Z S XPDA=$O(^XPD(9.6,"B",Z,0))
.I 'XPDA W " **Can't find definition in Build file**" Q
.I $D(XPDT("DA",XPDA)) W " already listed" Q
.D PCK(XPDA,Z)
LKX Q XPDA
;
PCK(XPDA,XPDNM) ;XPDA=Build ien, XPDNM=Build name
N Y
S XPDT=XPDT+1,XPDT(XPDT)=XPDA_U_XPDNM,XPDT("DA",XPDA)=XPDT
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXPDB1 962 printed Nov 22, 2024@17:13:23 Page 2
XPDB1 ;SFISC/RSD - Build utilities ;10/15/2008
+1 ;;8.0;KERNEL;**108,539**;Jul 10, 1995;Build 11
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
LOOK() ;Lookup BUILD, build XPDT from build file
+1 ;XPDT(seq #)=ien^name
+2 ;XPDT("DA",ien)=seq #
+3 NEW XPD,XPDA,XPDI,XPDNM,X,Y,Z
KILL XPDT
+4 SET XPDT=0
+5 SET XPDA=$$DIC^XPDE("AEMQZ",,1)
if 'XPDA
QUIT 0
+6 SET XPDI=$PIECE(Y(0),U)
+7 ;if type is Global Package, set DIRUT if there is other packages
+8 IF $PIECE(Y(0),U,3)=2
WRITE " GLOBAL PACKAGE"
+9 DO PCK(XPDA,XPDI)
+10 if $PIECE(Y(0),U,3)'=1
GOTO LKX
+11 ;multi-package
+12 WRITE " (Multi-Package)"
SET X=0
+13 FOR
SET X=$ORDER(^XPD(9.6,XPDA,10,X))
if 'X
QUIT
SET Z=$PIECE($GET(^(X,0)),U)
if Z]""
Begin DoDot:1
+14 NEW XPDA,X
+15 WRITE !?3,Z
SET XPDA=$ORDER(^XPD(9.6,"B",Z,0))
+16 IF 'XPDA
WRITE " **Can't find definition in Build file**"
QUIT
+17 IF $DATA(XPDT("DA",XPDA))
WRITE " already listed"
QUIT
+18 DO PCK(XPDA,Z)
End DoDot:1
LKX QUIT XPDA
+1 ;
PCK(XPDA,XPDNM) ;XPDA=Build ien, XPDNM=Build name
+1 NEW Y
+2 SET XPDT=XPDT+1
SET XPDT(XPDT)=XPDA_U_XPDNM
SET XPDT("DA",XPDA)=XPDT
+3 QUIT
+4 ;
