XPDB1.m

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 ---XPDB1   962     printed  Apr 09, 2024@21:11:48                                                                                                                                                                                                        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       ;