XTRUTL1 ;ISCSF/RWF - Developer Routine Utilities Build & Install Files ;2/14/07 15:50
;;7.3;TOOLKIT;**20,66,132**;Apr 25, 1995;Build 13
; Per VHA Directive 2004-038, this routine should not be modified.
;
Q ;No entry from the top.
BUILD() ;This will select an entry in the BUILD file.
N BLDA,DIC,X,Y
S DIC="^XPD(9.6,",DIC(0)="AEMQZ" D ^DIC
Q Y
INSTALL() ;This will select an entry in the INSTALL file.
N BLDA,DIC,X,Y
S DIC="^XPD(9.7,",DIC(0)="AEMQZ",DIC("S")="I '$P(^(0),U,9),$D(^XTMP(""XPDI"",Y))"
D ^DIC
Q Y
RTN(IEN,FILE) ;This will build a list of routines from the BUILD or INSTALL (FILE) file.
Q:'$G(IEN) S:'$G(FILE) FILE=9.6
N X,IX,R S U="^"
I FILE=9.6 D Q
. F IX=0:0 S IX=$O(^XPD(9.6,IEN,"KRN",9.8,"NM",IX)) Q:IX'>0 S X=^(IX,0) S:'$P(X,U,3) ^UTILITY($J,$P(X,U))=""
. F IX="INI","INIT","PRE" S X=$G(^XPD(9.6,IEN,IX)) I X]"" S R=$P($S(X[U:$P(X,U,2),1:X),"("),^UTILITY($J,R)=""
. Q
;get routines from Transport Global and merge into ^UTILITY
I FILE=9.7 D Q
. S X=""
. F S X=$O(^XTMP("XPDI",IEN,"RTN",X)) Q:X="" S R=^(X),^UTILITY($J,X)="" D
.. M ^UTILITY($J,1,X,0)=^XTMP("XPDI",IEN,"RTN",X)
.. S ^UTILITY($J,1,X,"RSUM")=$P(R,"^",3),^UTILITY($J,1,X,0,0)=$O(^UTILITY($J,1,X,0,""),-1) ;set RSUM and line count
. Q
Q
;
VER(X) ;returns version number from Build file, X=build name
Q:X["*" $P(X,"*",2)
Q $P(X," ",$L(X," "))
;
PATCH(X) ;returns the patch number from the Build file, X=build name
Q $S(X["*":$P(X,"*",3),1:"")
;
PLCP(PL,N) ;Patch list contains patch number
N PAT S PAT="PL?.E1P1"""_N_"""1P.E"
Q @PAT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTRUTL1 1592 printed Oct 16, 2024@18:42:23 Page 2
XTRUTL1 ;ISCSF/RWF - Developer Routine Utilities Build & Install Files ;2/14/07 15:50
+1 ;;7.3;TOOLKIT;**20,66,132**;Apr 25, 1995;Build 13
+2 ; Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ;No entry from the top.
QUIT
BUILD() ;This will select an entry in the BUILD file.
+1 NEW BLDA,DIC,X,Y
+2 SET DIC="^XPD(9.6,"
SET DIC(0)="AEMQZ"
DO ^DIC
+3 QUIT Y
INSTALL() ;This will select an entry in the INSTALL file.
+1 NEW BLDA,DIC,X,Y
+2 SET DIC="^XPD(9.7,"
SET DIC(0)="AEMQZ"
SET DIC("S")="I '$P(^(0),U,9),$D(^XTMP(""XPDI"",Y))"
+3 DO ^DIC
+4 QUIT Y
RTN(IEN,FILE) ;This will build a list of routines from the BUILD or INSTALL (FILE) file.
+1 if '$GET(IEN)
QUIT
if '$GET(FILE)
SET FILE=9.6
+2 NEW X,IX,R
SET U="^"
+3 IF FILE=9.6
Begin DoDot:1
+4 FOR IX=0:0
SET IX=$ORDER(^XPD(9.6,IEN,"KRN",9.8,"NM",IX))
if IX'>0
QUIT
SET X=^(IX,0)
if '$PIECE(X,U,3)
SET ^UTILITY($JOB,$PIECE(X,U))=""
+5 FOR IX="INI","INIT","PRE"
SET X=$GET(^XPD(9.6,IEN,IX))
IF X]""
SET R=$PIECE($SELECT(X[U:$PIECE(X,U,2),1:X),"(")
SET ^UTILITY($JOB,R)=""
+6 QUIT
End DoDot:1
QUIT
+7 ;get routines from Transport Global and merge into ^UTILITY
+8 IF FILE=9.7
Begin DoDot:1
+9 SET X=""
+10 FOR
SET X=$ORDER(^XTMP("XPDI",IEN,"RTN",X))
if X=""
QUIT
SET R=^(X)
SET ^UTILITY($JOB,X)=""
Begin DoDot:2
+11 MERGE ^UTILITY($JOB,1,X,0)=^XTMP("XPDI",IEN,"RTN",X)
+12 ;set RSUM and line count
SET ^UTILITY($JOB,1,X,"RSUM")=$PIECE(R,"^",3)
SET ^UTILITY($JOB,1,X,0,0)=$ORDER(^UTILITY($JOB,1,X,0,""),-1)
End DoDot:2
+13 QUIT
End DoDot:1
QUIT
+14 QUIT
+15 ;
VER(X) ;returns version number from Build file, X=build name
+1 if X["*"
QUIT $PIECE(X,"*",2)
+2 QUIT $PIECE(X," ",$LENGTH(X," "))
+3 ;
PATCH(X) ;returns the patch number from the Build file, X=build name
+1 QUIT $SELECT(X["*":$PIECE(X,"*",3),1:"")
+2 ;
PLCP(PL,N) ;Patch list contains patch number
+1 NEW PAT
SET PAT="PL?.E1P1"""_N_"""1P.E"
+2 QUIT @PAT
