XPDIP ;SFISC/RSD - Install Package & Routine file ;03/08/2006
;;8.0;KERNEL;**15,21,28,30,41,44,51,58,83,92,100,108,137,229,350,393,517**;Jul 10, 1995;Build 14
;Per VHA Directive 2004-038, this routine should not be modified.
Q
PKG ;
N %,OLDA,DA,DIK,XPD,XPDFIL,XPDPKG,XPDBLDA,Y
;update variable for graphic display
I $D(XPDIDVT) S XPDIDTOT=10,XPDIDMOD=1,XPDIDCNT=0 D:XPDIDVT UPDATE^XPDID(0)
;XPDPKG=ien of Package file, OLDA=old Package ien
S Y=$$PKGADD,XPDPKG=$P(Y,U),OLDA=$P(Y,U,2)
;Package file entry not sent, XPDPKG=0
G:'XPDPKG PKGEND
;update version multiple
S DA=XPDPKG D PKGV
PKGH I $D(XPDIDVT) S XPDIDCNT=XPDIDCNT+2 D UPDATE^XPDID(XPDIDCNT)
S %=$P(^DIC(9.4,XPDPKG,0),U,4)
;repoint Help Frame (0;4)
I $L(%),'% S $P(^DIC(9.4,XPDPKG,0),U,4)=$$LK^XPDIA("^DIC(9.2)",%),DIK="^DIC(9.4," D IX1^DIK
;update node 20 for Patient Merge
N REC,IEN
S REC=0
F S REC=$O(^XTMP("XPDI",XPDA,"PKG",OLDA,20,REC)) Q:'REC D
. ;;Only install if have a routine defined
. K IEN I '$L($P($G(^XTMP("XPDI",XPDA,"PKG",OLDA,20,REC,0)),U,3)) Q
. S IEN(9.402,"?+1,"_XPDPKG_",",.01)=$P($G(^XTMP("XPDI",XPDA,"PKG",OLDA,20,REC,0)),U,1)
. S IEN(9.402,"?+1,"_XPDPKG_",",3)=$P($G(^XTMP("XPDI",XPDA,"PKG",OLDA,20,REC,0)),U,3)
. S IEN(9.402,"?+1,"_XPDPKG_",",4)=$G(^XTMP("XPDI",XPDA,"PKG",OLDA,20,REC,1))
. D UPDATE^DIE("","IEN")
. Q
;
PKGEND S XPDBLDA=$$BLD(XPDBLD) Q:'XPDBLDA
;Move the Test/SEQ number from build to Install file.
S ^XPD(9.7,XPDA,6)=$G(^XPD(9.6,XPDBLDA,6))
;move Alpha/Beta testing info to Kernel site para file
I XPDPKG S %=$G(^XPD(9.6,XPDBLDA,"ABPKG")) D
.;Install message and they have an address, set flag in XPDIST
.I $P(%,U)="y",$P(%,U,2)="y",$L($P(%,U,3)) S $P(XPDIST,U,2)=$P(%,U,3)
.D EN^XQABLOAD(XPDBLDA)
Q
PKGADD() ;check Package file, add if not there
;return new Package file ien^old ien
N DA,DIK,XPD,XPDFIL,XPDO,X,Y
S DA=+$P(^XPD(9.7,XPDA,0),U,2),XPDO=+$O(^XTMP("XPDI",XPDA,"PKG",0)),X=$P($G(^(XPDO,0)),U)
I DA,$D(^DIC(9.4,DA,0)) Q DA_U_XPDO
;quit if there was no package entry sent
Q:'XPDO "0^0"
S XPDFIL=9.4,Y=$$DIC^XPDIK(9.4,X) Q:'Y "0^0"
S DA=+Y
;if new entry in package file, bring in everything
I $P(Y,U,3) D
.M ^DIC(9.4,DA)=^XTMP("XPDI",XPDA,"PKG",XPDO)
.;kill the -1 flag node first
.K ^DIC(9.4,DA,-1)
.;re-cross ref after adding a new package
.S DIK="^DIC(9.4," D IX1^DIK
;add package to file 9.7
S XPD(9.7,XPDA_",",1)=DA D FILE^DIE("","XPD")
Q DA_U_XPDO
;
BLD(XPDBLD) ;add Build entry, XPDBLD=Build ien in ^XTMP("XPDI",XPDA,"BLD",
N %,DA,DIK,XPDFIL,Y
I $D(XPDIDVT) S XPDIDCNT=XPDIDCNT+4 D UPDATE^XPDID(XPDIDCNT)
;XPDBLD=Build ien in ^XTMP, set in XPDIJ
S XPDFIL=9.6,Y=$$DIC^XPDIK(9.6,XPDNM) Q:'Y ""
S DA=+Y
;Build entry not new, remove old data
I '$P(Y,U,3) S %=$P(^XPD(9.6,DA,0),U,2) K ^XPD(9.6,DA) K:% ^XPD(9.6,"C",%,DA)
M ^XPD(9.6,DA)=^XTMP("XPDI",XPDA,"BLD",XPDBLD)
;reset Package File Link (0;2)
;XPDIST = national site tracking^A/B install message address
S $P(^XPD(9.6,DA,0),U,2)=$S(XPDPKG:XPDPKG,1:"") S:$P(^(0),U,5)="y" XPDIST=1
;re-index cross-ref. on fields .01 and 1
S DIK="^XPD(9.6," F Y=.01,1 S DIK(1)=Y D EN1^DIK
I $D(XPDIDVT) D UPDATE^XPDID(XPDIDTOT)
Q DA
;
;update the version multiple in the package file
PKGV N %
I $D(XPDIDVT) S XPDIDCNT=XPDIDCNT+2 D UPDATE^XPDID(XPDIDCNT)
;%=ien in the Version multiple_U_ien in Patch multiple in ^XTMP
S %=$G(^XTMP("XPDI",XPDA,"PKG",OLDA,-1))
I XPDNM'["*" D Q
.S %=+% Q:'$D(^XTMP("XPDI",XPDA,"PKG",OLDA,22,%,0)) S %=^(0) S:$D(^(1)) %(1)=$NA(^(1))
.S $P(%,U,3,4)=DT_U_DUZ,%=$$PKGVER(DA,.%)
;update patch history multiple
Q:'$D(^XTMP("XPDI",XPDA,"PKG",OLDA,22,+%,"PAH",+$P(%,U,2),0)) S %=$P(^(0),U) S:$D(^(1)) %(1)=$NA(^(1))
;check File Comment, %=patch number
S:^XPD(9.7,XPDA,2)[" SEQ #" %=$P(^(2),"*",3)
S $P(%,U,2,3)=$$NOW^XLFDT()_U_DUZ,%=$$PKGPAT(DA,$$VER^XPDUTL(XPDNM),.%)
Q
;
PKGVER(XPDPDA,XPDI) ;update version in package file, XPDPDA=Package file ien, return ien
;XPDI=version^date distr.^date installed^install by
;XPDI(1)=root of description field
N I,X,XPD,XPDIEN,XPDJ,XPDV
S XPDIEN=","_XPDPDA_",",XPDV=$$MDIC(9.49,XPDIEN,$P(XPDI,U)) Q:'XPDV 0
S XPD(9.4,XPDPDA_",",13)=$P(XPDI,U),X="XPD(9.49,"""_XPDV_XPDIEN_""")"
F I=1:1:3 S:$P(XPDI,U,I+1)]"" @X@(I)=$P(XPDI,U,I+1)
S:$D(XPDI(1)) @X@(41)=XPDI(1)
D FILE^DIE("","XPD")
Q XPDV
;
PKGPAT(XPDPDA,XPDV,XPDI) ;update patch history
;INPUT: XPDPDA=Package file ien, XPDV=version
;XPDI=patch^date installed^install by
;RETURNS: version ien^patch ien^[CURRENT VERSION, if it was set]
N I,X,XPD,XPDP,XPDIEN,CURVER
;quit if we can't find the version multiple, resets XPDV=ien of version
S XPDIEN=","_XPDPDA_",",XPDV=$$MDIC(9.49,XPDIEN,XPDV) Q:'XPDV 0
S XPDIEN=","_XPDV_XPDIEN,XPDP=$$MDIC(9.4901,XPDIEN,$P(XPDI,U)) Q:'XPDP 0
S X="XPD(9.4901,"""_XPDP_XPDIEN_""")"
F I=.02,.03 S:$P(XPDI,U,I*100)]"" @X@(I)=$P(XPDI,U,I*100)
S:$D(XPDI(1)) @X@(1)=XPDI(1)
;if no CURRENT VERSION, set it
I $G(^DIC(9.4,XPDPDA,"VERSION"))="" S XPD(9.4,XPDPDA_",",13)=XPDV,CURVER=XPDV
D FILE^DIE("","XPD")
Q XPDV_U_XPDP_U_$G(CURVER)
;
;XPDF=subfile #,XPDIEN=ien string, X=input
MDIC(XPDF,XPDIEN,XPDX) ;
N DIERR,XPD,XPDN
D FIND^DIC(XPDF,XPDIEN,"","XQf",XPDX,5,"","","","XPD")
;one or more matches, just return first one
I $G(XPD(0)) D:XPD(0)>1 Q XPD(1)
.N %
.S %(1)=$P(^DD(XPDF,.01,0),U)_" "_XPDX_" is Duplicated,",%(2)=" only ien #"_XPD(1)_" was updated."
.D MES^XPDUTL(.%)
;add a new entry
S XPDN(XPDF,"+1"_XPDIEN,.01)=XPDX K XPD
D UPDATE^DIE("","XPDN","XPD")
I '$G(XPD(1)) D BMES^XPDUTL(" "_$P(^DD(XPDF,.01,0),U)_" "_XPDX_" **Couldn't Add to file**") Q 0
Q XPD(1)
;
RTN ;move rtns to install file
N XPD,XPDC,XPDCR,XPDI,XPDJ,XPDK,XPDL,XPDM,XPDR,XPDRH,X,NOW
K ^XPD(9.7,XPDA,"RTN"),^TMP($J)
S (XPDC,XPDCR,XPDRH)=0,XPDJ="",NOW=$$NOW^XLFDT()
;get all routines that were loaded, XPDM=action
;actions are 0=load, 1=delete, 2=skip
F S XPDJ=$O(^XTMP("XPDI",XPDA,"RTN",XPDJ)) Q:XPDJ="" S XPDM=^(XPDJ) D:'XPDM
.;XPD, build array to update ROUTINE multiple in INSTALL file
.S XPDC=XPDC+1,^TMP($J,"XPDL",XPDC)=XPDC,^TMP($J,"XPD",9.704,"+"_XPDC_","_XPDA_",",.01)=XPDJ
.;XPDR, build array to update ROUTINE file, Set install date
.;S:'$D(^DIC(9.8,"B",XPDJ)) XPDCR=XPDCR+1,^TMP($J,"XPDR",9.8,"?+"_XPDCR_",",.01)=XPDJ,^(1)="R"
.S XPDCR=XPDCR+1,^TMP($J,"XPDR",9.8,"?+"_XPDCR_",",.01)=XPDJ,^(1)="R",^(7.4)=NOW ;**229
;if we are doing VT graphic display, update only 40%
I $D(XPDIDVT) S XPDIDCNT=XPDIDTOT*.4 D UPDATE^XPDID(XPDIDCNT)
F XPDK="DIKZ","DIEZ","DIPZ" D
.S XPDI=0
.;loop thru list of compile template routines
.;XTMP("XPDI",XPDA,"DIKZ",ien,routine name)
.F S XPDI=$O(^XTMP("XPDI",XPDA,XPDK,XPDI)),XPDJ="" Q:'XPDI D
..I 'XPDRH D BMES^XPDUTL(" The following Routines were created during this install:") S XPDRH=1
..F S XPDJ=$O(^XTMP("XPDI",XPDA,XPDK,XPDI,XPDJ)) Q:XPDJ="" D:'$D(^XTMP("XPDI",XPDA,"RTN",XPDJ))
...S XPDC=XPDC+1,^TMP($J,"XPDL",XPDC)=XPDC,^TMP($J,"XPD",9.704,"+"_XPDC_","_XPDA_",",.01)=XPDJ
...D MES^XPDUTL(" "_XPDJ)
;update routine multiple in Install file with routines and
;compile template routines
I $D(^TMP($J,"XPD"))>9 D
.D UPDATE^DIE("","^TMP($J,""XPD"")","^TMP($J,""XPDL"")")
.;if we are doing VT graphic display, update only 40%
.I $D(XPDIDVT) S XPDIDCNT=XPDIDCNT+(XPDIDTOT*.40) D UPDATE^XPDID(XPDIDCNT)
;update Routine file
D:$D(^TMP($J,"XPDR"))>9 UPDATE^DIE("","^TMP($J,""XPDR"")")
;if we are doing VT graphic display, update 100%
I $D(XPDIDVT) D UPDATE^XPDID(XPDIDTOT)
Q
XPDIP ;SFISC/RSD - Install Package & Routine file ;03/08/2006
+1 ;;8.0;KERNEL;**15,21,28,30,41,44,51,58,83,92,100,108,137,229,350,393,517**;Jul 10, 1995;Build 14
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
PKG ;
+1 NEW %,OLDA,DA,DIK,XPD,XPDFIL,XPDPKG,XPDBLDA,Y
+2 ;update variable for graphic display
+3 IF $DATA(XPDIDVT)
SET XPDIDTOT=10
SET XPDIDMOD=1
SET XPDIDCNT=0
IF XPDIDVT
DO UPDATE^XPDID(0)
+4 ;XPDPKG=ien of Package file, OLDA=old Package ien
+5 SET Y=$$PKGADD
SET XPDPKG=$PIECE(Y,U)
SET OLDA=$PIECE(Y,U,2)
+6 ;Package file entry not sent, XPDPKG=0
+7 IF 'XPDPKG
GOTO PKGEND
+8 ;update version multiple
+9 SET DA=XPDPKG
DO PKGV
PKGH IF $DATA(XPDIDVT)
SET XPDIDCNT=XPDIDCNT+2
DO UPDATE^XPDID(XPDIDCNT)
+1 SET %=$PIECE(^DIC(9.4,XPDPKG,0),U,4)
+2 ;repoint Help Frame (0;4)
+3 IF $LENGTH(%)
IF '%
SET $PIECE(^DIC(9.4,XPDPKG,0),U,4)=$$LK^XPDIA("^DIC(9.2)",%)
SET DIK="^DIC(9.4,"
DO IX1^DIK
+4 ;update node 20 for Patient Merge
+5 NEW REC,IEN
+6 SET REC=0
+7 FOR
SET REC=$ORDER(^XTMP("XPDI",XPDA,"PKG",OLDA,20,REC))
IF 'REC
QUIT
Begin DoDot:1
+8 ;;Only install if have a routine defined
+9 KILL IEN
IF '$LENGTH($PIECE($GET(^XTMP("XPDI",XPDA,"PKG",OLDA,20,REC,0)),U,3))
QUIT
+10 SET IEN(9.402,"?+1,"_XPDPKG_",",.01)=$PIECE($GET(^XTMP("XPDI",XPDA,"PKG",OLDA,20,REC,0)),U,1)
+11 SET IEN(9.402,"?+1,"_XPDPKG_",",3)=$PIECE($GET(^XTMP("XPDI",XPDA,"PKG",OLDA,20,REC,0)),U,3)
+12 SET IEN(9.402,"?+1,"_XPDPKG_",",4)=$GET(^XTMP("XPDI",XPDA,"PKG",OLDA,20,REC,1))
+13 DO UPDATE^DIE("","IEN")
+14 QUIT
End DoDot:1
+15 ;
PKGEND SET XPDBLDA=$$BLD(XPDBLD)
IF 'XPDBLDA
QUIT
+1 ;Move the Test/SEQ number from build to Install file.
+2 SET ^XPD(9.7,XPDA,6)=$GET(^XPD(9.6,XPDBLDA,6))
+3 ;move Alpha/Beta testing info to Kernel site para file
+4 IF XPDPKG
SET %=$GET(^XPD(9.6,XPDBLDA,"ABPKG"))
Begin DoDot:1
+5 ;Install message and they have an address, set flag in XPDIST
+6 IF $PIECE(%,U)="y"
IF $PIECE(%,U,2)="y"
IF $LENGTH($PIECE(%,U,3))
SET $PIECE(XPDIST,U,2)=$PIECE(%,U,3)
+7 DO EN^XQABLOAD(XPDBLDA)
End DoDot:1
+8 QUIT
PKGADD() ;check Package file, add if not there
+1 ;return new Package file ien^old ien
+2 NEW DA,DIK,XPD,XPDFIL,XPDO,X,Y
+3 SET DA=+$PIECE(^XPD(9.7,XPDA,0),U,2)
SET XPDO=+$ORDER(^XTMP("XPDI",XPDA,"PKG",0))
SET X=$PIECE($GET(^(XPDO,0)),U)
+4 IF DA
IF $DATA(^DIC(9.4,DA,0))
QUIT DA_U_XPDO
+5 ;quit if there was no package entry sent
+6 IF 'XPDO
QUIT "0^0"
+7 SET XPDFIL=9.4
SET Y=$$DIC^XPDIK(9.4,X)
IF 'Y
QUIT "0^0"
+8 SET DA=+Y
+9 ;if new entry in package file, bring in everything
+10 IF $PIECE(Y,U,3)
Begin DoDot:1
+11 MERGE ^DIC(9.4,DA)=^XTMP("XPDI",XPDA,"PKG",XPDO)
+12 ;kill the -1 flag node first
+13 KILL ^DIC(9.4,DA,-1)
+14 ;re-cross ref after adding a new package
+15 SET DIK="^DIC(9.4,"
DO IX1^DIK
End DoDot:1
+16 ;add package to file 9.7
+17 SET XPD(9.7,XPDA_",",1)=DA
DO FILE^DIE("","XPD")
+18 QUIT DA_U_XPDO
+19 ;
BLD(XPDBLD) ;add Build entry, XPDBLD=Build ien in ^XTMP("XPDI",XPDA,"BLD",
+1 NEW %,DA,DIK,XPDFIL,Y
+2 IF $DATA(XPDIDVT)
SET XPDIDCNT=XPDIDCNT+4
DO UPDATE^XPDID(XPDIDCNT)
+3 ;XPDBLD=Build ien in ^XTMP, set in XPDIJ
+4 SET XPDFIL=9.6
SET Y=$$DIC^XPDIK(9.6,XPDNM)
IF 'Y
QUIT ""
+5 SET DA=+Y
+6 ;Build entry not new, remove old data
+7 IF '$PIECE(Y,U,3)
SET %=$PIECE(^XPD(9.6,DA,0),U,2)
KILL ^XPD(9.6,DA)
IF %
KILL ^XPD(9.6,"C",%,DA)
+8 MERGE ^XPD(9.6,DA)=^XTMP("XPDI",XPDA,"BLD",XPDBLD)
+9 ;reset Package File Link (0;2)
+10 ;XPDIST = national site tracking^A/B install message address
+11 SET $PIECE(^XPD(9.6,DA,0),U,2)=$SELECT(XPDPKG:XPDPKG,1:"")
IF $PIECE(^(0),U,5)="y"
SET XPDIST=1
+12 ;re-index cross-ref. on fields .01 and 1
+13 SET DIK="^XPD(9.6,"
FOR Y=.01,1
SET DIK(1)=Y
DO EN1^DIK
+14 IF $DATA(XPDIDVT)
DO UPDATE^XPDID(XPDIDTOT)
+15 QUIT DA
+16 ;
+17 ;update the version multiple in the package file
PKGV NEW %
+1 IF $DATA(XPDIDVT)
SET XPDIDCNT=XPDIDCNT+2
DO UPDATE^XPDID(XPDIDCNT)
+2 ;%=ien in the Version multiple_U_ien in Patch multiple in ^XTMP
+3 SET %=$GET(^XTMP("XPDI",XPDA,"PKG",OLDA,-1))
+4 IF XPDNM'["*"
Begin DoDot:1
+5 SET %=+%
IF '$DATA(^XTMP("XPDI",XPDA,"PKG",OLDA,22,%,0))
QUIT
SET %=^(0)
IF $DATA(^(1))
SET %(1)=$NAME(^(1))
+6 SET $PIECE(%,U,3,4)=DT_U_DUZ
SET %=$$PKGVER(DA,.%)
End DoDot:1
QUIT
+7 ;update patch history multiple
+8 IF '$DATA(^XTMP("XPDI",XPDA,"PKG",OLDA,22,+%,"PAH",+$PIECE(%,U,2),0))
QUIT
SET %=$PIECE(^(0),U)
IF $DATA(^(1))
SET %(1)=$NAME(^(1))
+9 ;check File Comment, %=patch number
+10 IF ^XPD(9.7,XPDA,2)[" SEQ #"
SET %=$PIECE(^(2),"*",3)
+11 SET $PIECE(%,U,2,3)=$$NOW^XLFDT()_U_DUZ
SET %=$$PKGPAT(DA,$$VER^XPDUTL(XPDNM),.%)
+12 QUIT
+13 ;
PKGVER(XPDPDA,XPDI) ;update version in package file, XPDPDA=Package file ien, return ien
+1 ;XPDI=version^date distr.^date installed^install by
+2 ;XPDI(1)=root of description field
+3 NEW I,X,XPD,XPDIEN,XPDJ,XPDV
+4 SET XPDIEN=","_XPDPDA_","
SET XPDV=$$MDIC(9.49,XPDIEN,$PIECE(XPDI,U))
IF 'XPDV
QUIT 0
+5 SET XPD(9.4,XPDPDA_",",13)=$PIECE(XPDI,U)
SET X="XPD(9.49,"""_XPDV_XPDIEN_""")"
+6 FOR I=1:1:3
IF $PIECE(XPDI,U,I+1)]""
SET @X@(I)=$PIECE(XPDI,U,I+1)
+7 IF $DATA(XPDI(1))
SET @X@(41)=XPDI(1)
+8 DO FILE^DIE("","XPD")
+9 QUIT XPDV
+10 ;
PKGPAT(XPDPDA,XPDV,XPDI) ;update patch history
+1 ;INPUT: XPDPDA=Package file ien, XPDV=version
+2 ;XPDI=patch^date installed^install by
+3 ;RETURNS: version ien^patch ien^[CURRENT VERSION, if it was set]
+4 NEW I,X,XPD,XPDP,XPDIEN,CURVER
+5 ;quit if we can't find the version multiple, resets XPDV=ien of version
+6 SET XPDIEN=","_XPDPDA_","
SET XPDV=$$MDIC(9.49,XPDIEN,XPDV)
IF 'XPDV
QUIT 0
+7 SET XPDIEN=","_XPDV_XPDIEN
SET XPDP=$$MDIC(9.4901,XPDIEN,$PIECE(XPDI,U))
IF 'XPDP
QUIT 0
+8 SET X="XPD(9.4901,"""_XPDP_XPDIEN_""")"
+9 FOR I=.02,.03
IF $PIECE(XPDI,U,I*100)]""
SET @X@(I)=$PIECE(XPDI,U,I*100)
+10 IF $DATA(XPDI(1))
SET @X@(1)=XPDI(1)
+11 ;if no CURRENT VERSION, set it
+12 IF $GET(^DIC(9.4,XPDPDA,"VERSION"))=""
SET XPD(9.4,XPDPDA_",",13)=XPDV
SET CURVER=XPDV
+13 DO FILE^DIE("","XPD")
+14 QUIT XPDV_U_XPDP_U_$GET(CURVER)
+15 ;
+16 ;XPDF=subfile #,XPDIEN=ien string, X=input
MDIC(XPDF,XPDIEN,XPDX) ;
+1 NEW DIERR,XPD,XPDN
+2 DO FIND^DIC(XPDF,XPDIEN,"","XQf",XPDX,5,"","","","XPD")
+3 ;one or more matches, just return first one
+4 IF $GET(XPD(0))
IF XPD(0)>1
Begin DoDot:1
+5 NEW %
+6 SET %(1)=$PIECE(^DD(XPDF,.01,0),U)_" "_XPDX_" is Duplicated,"
SET %(2)=" only ien #"_XPD(1)_" was updated."
+7 DO MES^XPDUTL(.%)
End DoDot:1
QUIT XPD(1)
+8 ;add a new entry
+9 SET XPDN(XPDF,"+1"_XPDIEN,.01)=XPDX
KILL XPD
+10 DO UPDATE^DIE("","XPDN","XPD")
+11 IF '$GET(XPD(1))
DO BMES^XPDUTL(" "_$PIECE(^DD(XPDF,.01,0),U)_" "_XPDX_" **Couldn't Add to file**")
QUIT 0
+12 QUIT XPD(1)
+13 ;
RTN ;move rtns to install file
+1 NEW XPD,XPDC,XPDCR,XPDI,XPDJ,XPDK,XPDL,XPDM,XPDR,XPDRH,X,NOW
+2 KILL ^XPD(9.7,XPDA,"RTN"),^TMP($JOB)
+3 SET (XPDC,XPDCR,XPDRH)=0
SET XPDJ=""
SET NOW=$$NOW^XLFDT()
+4 ;get all routines that were loaded, XPDM=action
+5 ;actions are 0=load, 1=delete, 2=skip
+6 FOR
SET XPDJ=$ORDER(^XTMP("XPDI",XPDA,"RTN",XPDJ))
IF XPDJ=""
QUIT
SET XPDM=^(XPDJ)
IF 'XPDM
Begin DoDot:1
+7 ;XPD, build array to update ROUTINE multiple in INSTALL file
+8 SET XPDC=XPDC+1
SET ^TMP($JOB,"XPDL",XPDC)=XPDC
SET ^TMP($JOB,"XPD",9.704,"+"_XPDC_","_XPDA_",",.01)=XPDJ
+9 ;XPDR, build array to update ROUTINE file, Set install date
+10 ;S:'$D(^DIC(9.8,"B",XPDJ)) XPDCR=XPDCR+1,^TMP($J,"XPDR",9.8,"?+"_XPDCR_",",.01)=XPDJ,^(1)="R"
+11 ;**229
SET XPDCR=XPDCR+1
SET ^TMP($JOB,"XPDR",9.8,"?+"_XPDCR_",",.01)=XPDJ
SET ^(1)="R"
SET ^(7.4)=NOW
End DoDot:1
+12 ;if we are doing VT graphic display, update only 40%
+13 IF $DATA(XPDIDVT)
SET XPDIDCNT=XPDIDTOT*.4
DO UPDATE^XPDID(XPDIDCNT)
+14 FOR XPDK="DIKZ","DIEZ","DIPZ"
Begin DoDot:1
+15 SET XPDI=0
+16 ;loop thru list of compile template routines
+17 ;XTMP("XPDI",XPDA,"DIKZ",ien,routine name)
+18 FOR
SET XPDI=$ORDER(^XTMP("XPDI",XPDA,XPDK,XPDI))
SET XPDJ=""
IF 'XPDI
QUIT
Begin DoDot:2
+19 IF 'XPDRH
DO BMES^XPDUTL(" The following Routines were created during this install:")
SET XPDRH=1
+20 FOR
SET XPDJ=$ORDER(^XTMP("XPDI",XPDA,XPDK,XPDI,XPDJ))
IF XPDJ=""
QUIT
IF '$DATA(^XTMP("XPDI",XPDA,"RTN",XPDJ))
Begin DoDot:3
+21 SET XPDC=XPDC+1
SET ^TMP($JOB,"XPDL",XPDC)=XPDC
SET ^TMP($JOB,"XPD",9.704,"+"_XPDC_","_XPDA_",",.01)=XPDJ
+22 DO MES^XPDUTL(" "_XPDJ)
End DoDot:3
End DoDot:2
End DoDot:1
+23 ;update routine multiple in Install file with routines and
+24 ;compile template routines
+25 IF $DATA(^TMP($JOB,"XPD"))>9
Begin DoDot:1
+26 DO UPDATE^DIE("","^TMP($J,""XPD"")","^TMP($J,""XPDL"")")
+27 ;if we are doing VT graphic display, update only 40%
+28 IF $DATA(XPDIDVT)
SET XPDIDCNT=XPDIDCNT+(XPDIDTOT*.40)
DO UPDATE^XPDID(XPDIDCNT)
End DoDot:1
+29 ;update Routine file
+30 IF $DATA(^TMP($JOB,"XPDR"))>9
DO UPDATE^DIE("","^TMP($J,""XPDR"")")
+31 ;if we are doing VT graphic display, update 100%
+32 IF $DATA(XPDIDVT)
DO UPDATE^XPDID(XPDIDTOT)
+33 QUIT
