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/XPDIP.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: 7.0 KB
Line 
1XPDIP ;SFISC/RSD - Install Package & Routine file ;03/08/2006
2 ;;8.0;KERNEL;**15,21,28,30,41,44,51,58,83,92,100,108,137,229,350,393**;Jul 10, 1995;Build 12
3 Q
4PKG ;
5 N %,OLDA,DA,DIK,XPD,XPDFIL,XPDPKG,XPDBLDA,Y
6 ;update variable for graphic display
7 I $D(XPDIDVT) S XPDIDTOT=10,XPDIDMOD=1,XPDIDCNT=0 D:XPDIDVT UPDATE^XPDID(0)
8 ;XPDPKG=ien of Package file, OLDA=old Package ien
9 S Y=$$PKGADD,XPDPKG=$P(Y,U),OLDA=$P(Y,U,2)
10 ;Package file entry not sent, XPDPKG=0
11 G:'XPDPKG PKGEND
12 ;update version multiple
13 S DA=XPDPKG D PKGV
14PKGH I $D(XPDIDVT) S XPDIDCNT=XPDIDCNT+2 D UPDATE^XPDID(XPDIDCNT)
15 S %=$P(^DIC(9.4,XPDPKG,0),U,4)
16 ;repoint Help Frame (0;4)
17 I $L(%),'% S $P(^DIC(9.4,XPDPKG,0),U,4)=$$LK^XPDIA("^DIC(9.2)",%),DIK="^DIC(9.4," D IX1^DIK
18 ;update node 20 for Patient Merge
19 N REC,IEN
20 S REC=0
21 F S REC=$O(^XTMP("XPDI",XPDA,"PKG",OLDA,20,REC)) Q:'REC D
22 . ;;Only install if have a routine defined
23 . K IEN I '$L($P($G(^XTMP("XPDI",XPDA,"PKG",OLDA,20,REC,0)),U,3)) Q
24 . S IEN(9.402,"?+1,"_XPDPKG_",",.01)=$P($G(^XTMP("XPDI",XPDA,"PKG",OLDA,20,REC,0)),U,1)
25 . S IEN(9.402,"?+1,"_XPDPKG_",",3)=$P($G(^XTMP("XPDI",XPDA,"PKG",OLDA,20,REC,0)),U,3)
26 . S IEN(9.402,"?+1,"_XPDPKG_",",4)=$G(^XTMP("XPDI",XPDA,"PKG",OLDA,20,REC,1))
27 . D UPDATE^DIE("","IEN")
28 . Q
29 ;
30PKGEND S XPDBLDA=$$BLD(XPDBLD) Q:'XPDBLDA
31 ;Move the Test/SEQ number from build to Install file.
32 S ^XPD(9.7,XPDA,6)=$G(^XPD(9.6,XPDBLDA,6))
33 ;move Alpha/Beta testing info to Kernel site para file
34 I XPDPKG S %=$G(^XPD(9.6,XPDBLDA,"ABPKG")) D
35 .;Install message and they have an address, set flag in XPDIST
36 .I $P(%,U)="y",$P(%,U,2)="y",$L($P(%,U,3)) S $P(XPDIST,U,2)=$P(%,U,3)
37 .D EN^XQABLOAD(XPDBLDA)
38 Q
39PKGADD() ;check Package file, add if not there
40 ;return new Package file ien^old ien
41 N DA,DIK,XPD,XPDFIL,XPDO,X,Y
42 S DA=+$P(^XPD(9.7,XPDA,0),U,2),XPDO=+$O(^XTMP("XPDI",XPDA,"PKG",0)),X=$P($G(^(XPDO,0)),U)
43 I DA,$D(^DIC(9.4,DA,0)) Q DA_U_XPDO
44 ;quit if there was no package entry sent
45 Q:'XPDO "0^0"
46 S XPDFIL=9.4,Y=$$DIC^XPDIK(9.4,X) Q:'Y "0^0"
47 S DA=+Y
48 ;if new entry in package file, bring in everything
49 I $P(Y,U,3) D
50 .M ^DIC(9.4,DA)=^XTMP("XPDI",XPDA,"PKG",XPDO)
51 .;kill the -1 flag node first
52 .K ^DIC(9.4,DA,-1)
53 .;re-cross ref after adding a new package
54 .S DIK="^DIC(9.4," D IX1^DIK
55 ;add package to file 9.7
56 S XPD(9.7,XPDA_",",1)=DA D FILE^DIE("","XPD")
57 Q DA_U_XPDO
58 ;
59BLD(XPDBLD) ;add Build entry, XPDBLD=Build ien in ^XTMP("XPDI",XPDA,"BLD",
60 N %,DA,DIK,XPDFIL,Y
61 I $D(XPDIDVT) S XPDIDCNT=XPDIDCNT+4 D UPDATE^XPDID(XPDIDCNT)
62 ;XPDBLD=Build ien in ^XTMP, set in XPDIJ
63 S XPDFIL=9.6,Y=$$DIC^XPDIK(9.6,XPDNM) Q:'Y ""
64 S DA=+Y
65 ;Build entry not new, remove old data
66 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)
67 M ^XPD(9.6,DA)=^XTMP("XPDI",XPDA,"BLD",XPDBLD)
68 ;reset Package File Link (0;2)
69 ;XPDIST = national site tracking^A/B install message address
70 S $P(^XPD(9.6,DA,0),U,2)=$S(XPDPKG:XPDPKG,1:"") S:$P(^(0),U,5)="y" XPDIST=1
71 ;re-index cross-ref. on fields .01 and 1
72 S DIK="^XPD(9.6," F Y=.01,1 S DIK(1)=Y D EN1^DIK
73 I $D(XPDIDVT) D UPDATE^XPDID(XPDIDTOT)
74 Q DA
75 ;
76 ;update the version multiple in the package file
77PKGV N %
78 I $D(XPDIDVT) S XPDIDCNT=XPDIDCNT+2 D UPDATE^XPDID(XPDIDCNT)
79 ;%=ien in the Version multiple_U_ien in Patch multiple in ^XTMP
80 S %=$G(^XTMP("XPDI",XPDA,"PKG",OLDA,-1))
81 I XPDNM'["*" D Q
82 .S %=+% Q:'$D(^XTMP("XPDI",XPDA,"PKG",OLDA,22,%,0)) S %=^(0) S:$D(^(1)) %(1)=$NA(^(1))
83 .S $P(%,U,3,4)=DT_U_DUZ,%=$$PKGVER(DA,.%)
84 ;update patch history multiple
85 Q:'$D(^XTMP("XPDI",XPDA,"PKG",OLDA,22,+%,"PAH",+$P(%,U,2),0)) S %=$P(^(0),U) S:$D(^(1)) %(1)=$NA(^(1))
86 ;check File Comment, %=patch number
87 S:^XPD(9.7,XPDA,2)[" SEQ #" %=$P(^(2),"*",3)
88 S $P(%,U,2,3)=$$NOW^XLFDT()_U_DUZ,%=$$PKGPAT(DA,$$VER^XPDUTL(XPDNM),.%)
89 Q
90 ;
91PKGVER(XPDPDA,XPDI) ;update version in package file, XPDPDA=Package file ien, return ien
92 ;XPDI=version^date distr.^date installed^install by
93 ;XPDI(1)=root of description field
94 N I,X,XPD,XPDIEN,XPDJ,XPDV
95 S XPDIEN=","_XPDPDA_",",XPDV=$$MDIC(9.49,XPDIEN,$P(XPDI,U)) Q:'XPDV 0
96 S XPD(9.4,XPDPDA_",",13)=$P(XPDI,U),X="XPD(9.49,"""_XPDV_XPDIEN_""")"
97 F I=1:1:3 S:$P(XPDI,U,I+1)]"" @X@(I)=$P(XPDI,U,I+1)
98 S:$D(XPDI(1)) @X@(41)=XPDI(1)
99 D FILE^DIE("","XPD")
100 Q XPDV
101 ;
102PKGPAT(XPDPDA,XPDV,XPDI) ;update patch history
103 ;INPUT: XPDPDA=Package file ien, XPDV=version
104 ;XPDI=patch^date installed^install by, returns version ien^patch ien
105 N I,X,XPD,XPDP,XPDIEN
106 ;quit if we can't find the version multiple, resets XPDV=ien of version
107 S XPDIEN=","_XPDPDA_",",XPDV=$$MDIC(9.49,XPDIEN,XPDV) Q:'XPDV 0
108 S XPDIEN=","_XPDV_XPDIEN,XPDP=$$MDIC(9.4901,XPDIEN,$P(XPDI,U)) Q:'XPDP 0
109 S X="XPD(9.4901,"""_XPDP_XPDIEN_""")"
110 F I=.02,.03 S:$P(XPDI,U,I*100)]"" @X@(I)=$P(XPDI,U,I*100)
111 S:$D(XPDI(1)) @X@(1)=XPDI(1)
112 D FILE^DIE("","XPD")
113 Q XPDV_U_XPDP
114 ;
115 ;XPDF=subfile #,XPDIEN=ien string, X=input
116MDIC(XPDF,XPDIEN,XPDX) ;
117 N DIERR,XPD,XPDN
118 D FIND^DIC(XPDF,XPDIEN,"","XQf",XPDX,5,"","","","XPD")
119 ;one or more matches, just return first one
120 I $G(XPD(0)) D:XPD(0)>1 Q XPD(1)
121 .N %
122 .S %(1)=$P(^DD(XPDF,.01,0),U)_" "_XPDX_" is Duplicated,",%(2)=" only ien #"_XPD(1)_" was updated."
123 .D MES^XPDUTL(.%)
124 ;add a new entry
125 S XPDN(XPDF,"+1"_XPDIEN,.01)=XPDX K XPD
126 D UPDATE^DIE("","XPDN","XPD")
127 I '$G(XPD(1)) D BMES^XPDUTL(" "_$P(^DD(XPDF,.01,0),U)_" "_XPDX_" **Couldn't Add to file**") Q 0
128 Q XPD(1)
129 ;
130RTN ;move rtns to install file
131 N XPD,XPDC,XPDCR,XPDI,XPDJ,XPDK,XPDL,XPDM,XPDR,XPDRH,X,NOW
132 K ^XPD(9.7,XPDA,"RTN"),^TMP($J)
133 S (XPDC,XPDCR,XPDRH)=0,XPDJ="",NOW=$$NOW^XLFDT()
134 ;get all routines that were loaded, XPDM=action
135 ;actions are 0=load, 1=delete, 2=skip
136 F S XPDJ=$O(^XTMP("XPDI",XPDA,"RTN",XPDJ)) Q:XPDJ="" S XPDM=^(XPDJ) D:'XPDM
137 .;XPD, build array to update ROUTINE multiple in INSTALL file
138 .S XPDC=XPDC+1,^TMP($J,"XPDL",XPDC)=XPDC,^TMP($J,"XPD",9.704,"+"_XPDC_","_XPDA_",",.01)=XPDJ
139 .;XPDR, build array to update ROUTINE file, Set install date
140 .;S:'$D(^DIC(9.8,"B",XPDJ)) XPDCR=XPDCR+1,^TMP($J,"XPDR",9.8,"?+"_XPDCR_",",.01)=XPDJ,^(1)="R"
141 .S XPDCR=XPDCR+1,^TMP($J,"XPDR",9.8,"?+"_XPDCR_",",.01)=XPDJ,^(1)="R",^(7.4)=NOW ;**229
142 ;if we are doing VT graphic display, update only 40%
143 I $D(XPDIDVT) S XPDIDCNT=XPDIDTOT*.4 D UPDATE^XPDID(XPDIDCNT)
144 F XPDK="DIKZ","DIEZ","DIPZ" D
145 .S XPDI=0
146 .;loop thru list of compile template routines
147 .;XTMP("XPDI",XPDA,"DIKZ",ien,routine name)
148 .F S XPDI=$O(^XTMP("XPDI",XPDA,XPDK,XPDI)),XPDJ="" Q:'XPDI D
149 ..I 'XPDRH D BMES^XPDUTL(" The following Routines were created during this install:") S XPDRH=1
150 ..F S XPDJ=$O(^XTMP("XPDI",XPDA,XPDK,XPDI,XPDJ)) Q:XPDJ="" D:'$D(^XTMP("XPDI",XPDA,"RTN",XPDJ))
151 ...S XPDC=XPDC+1,^TMP($J,"XPDL",XPDC)=XPDC,^TMP($J,"XPD",9.704,"+"_XPDC_","_XPDA_",",.01)=XPDJ
152 ...D MES^XPDUTL(" "_XPDJ)
153 ;update routine multiple in Install file with routines and
154 ;compile template routines
155 I $D(^TMP($J,"XPD"))>9 D
156 .D UPDATE^DIE("","^TMP($J,""XPD"")","^TMP($J,""XPDL"")")
157 .;if we are doing VT graphic display, update only 40%
158 .I $D(XPDIDVT) S XPDIDCNT=XPDIDCNT+(XPDIDTOT*.40) D UPDATE^XPDID(XPDIDCNT)
159 ;update Routine file
160 D:$D(^TMP($J,"XPDR"))>9 UPDATE^DIE("","^TMP($J,""XPDR"")")
161 ;if we are doing VT graphic display, update 100%
162 I $D(XPDIDVT) D UPDATE^XPDID(XPDIDTOT)
163 Q
Note: See TracBrowser for help on using the repository browser.