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/XPDUTL.m@ 1470

Last change on this file since 1470 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 5.2 KB
Line 
1XPDUTL ;SFISC/RSD - KIDS utilities ;03/25/2003 15:00
2 ;;8.0;KERNEL;**21,28,39,81,100,108,137,181,275**;Jul 10, 1995
3 Q
4VERSION(X) ;Get current version from Package file, X=package name or
5 ;package namespace
6 N I
7 S I=$O(^DIC(9.4,"C",X,0)) S:I'>0 I=$O(^DIC(9.4,"B",X,0))
8 Q $P($G(^DIC(9.4,+I,"VERSION")),"^")
9 ;
10VER(X) ;returns version number from Build file, X=build name
11 Q:X["*" $P(X,"*",2)
12 Q $P(X," ",$L(X," "))
13 ;
14STATUS(IEN) ;returns build status from Build File, IEN=Build File IEN
15 I '$D(^XPD(9.7,IEN,0)) Q -1
16 Q $P(^XPD(9.7,IEN,0),U,9)
17 ;
18PKG(X) ;returns package name from Build file, X=build name
19 Q $S(X["*":$P(X,"*"),1:$P(X," ",1,$L(X," ")-1))
20 ;
21LAST(PKG,VER) ;returns last patch applied for a Package, PATCH^DATE
22 ; Patch includes Seq # if Released
23 N PKGIEN,VERIEN,LATEST,PATCH,SUBIEN
24 I $G(VER)="" S VER=$$VERSION^XPDUTL(PKG) Q:'VER -1
25 S PKGIEN=$O(^DIC(9.4,"B",PKG,"")) Q:'PKGIEN -1
26 S VERIEN=$O(^DIC(9.4,PKGIEN,22,"B",VER,"")) Q:'VERIEN -1
27 S LATEST=-1,PATCH=-1,SUBIEN=0
28 F S SUBIEN=$O(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN)) Q:SUBIEN'>0 D
29 . I $P(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)>LATEST S LATEST=$P(^(0),U,2),PATCH=$P(^(0),U)
30 Q PATCH_U_LATEST
31 ;
32PATCH(X) ;return 1 if patch X was installed, X=aaaa*nn.nn*nnn
33 Q:X'?1.4UN1"*"1.2N1"."1.2N.1(1"V",1"T").2N1"*"1.3N 0
34 N %,I,J
35 S I=$O(^DIC(9.4,"C",$P(X,"*"),0)) Q:'I 0
36 S J=$O(^DIC(9.4,I,22,"B",$P(X,"*",2),0)),X=$P(X,"*",3) Q:'J 0
37 ;check if patch is just a number
38 Q:$O(^DIC(9.4,I,22,J,"PAH","B",X,0)) 1
39 S %=$O(^DIC(9.4,I,22,J,"PAH","B",X_" SEQ"))
40 Q (X=+%)
41 ;
42NEWCP(XPD,XPDC,XPDP) ;create new check point, returns 0=error or ien
43 ;XPD=name, XPDC=call back, XPDP=parameters
44 Q:$G(XPD)="" 0
45 N %,XPDI,XPDJ,XPDF,XPDY
46 ;XPDCP="INI"=Pre-init, "INIT"=Post-init
47 S XPDI=$S(XPDCP="INIT":9.716,1:9.713)
48 S %=$$FIND1^DIC(XPDI,","_XPDA_",","X",XPD) Q:% %
49 S XPDF="+1,"_XPDA_",",XPDJ(XPDI,XPDF,.01)=XPD
50 S:$D(XPDC) XPDJ(XPDI,XPDF,2)=XPDC
51 S:$D(XPDP) XPDJ(XPDI,XPDF,3)=XPDP
52 D UPDATE^DIE("","XPDJ","XPDY")
53 Q $G(XPDY(1))
54 ;
55UPCP(XPD,XPDP) ;update check point, returns 0=error or ien
56 ;XPD=name, XPDP=parameters
57 N XPDI,XPDJ,XPDF,XPDY
58 ;XPDCP="INI"=Pre-init, "INIT"=Post-init
59 S XPDI=$S(XPDCP="INIT":9.716,1:9.713),XPDY=$$DICCP($G(XPD))
60 Q:'XPDY 0
61 S XPDF=XPDY_","_XPDA_","
62 S:$D(XPDP) XPDJ(XPDI,XPDF,3)=XPDP
63 D FILE^DIE("","XPDJ")
64 Q XPDY
65 ;
66COMCP(XPD) ;complete check point, returns 0=error or date/time
67 ;XPD=name
68 N XPDD,XPDI,XPDJ,XPDY
69 S XPDI=$S(XPDCP="INIT":9.716,1:9.713),XPDY=$$DICCP($G(XPD))
70 Q:'XPDY 0
71 S XPDD=$$NOW^XLFDT,XPDJ(XPDI,XPDY_","_XPDA_",",1)=XPDD
72 D FILE^DIE("","XPDJ")
73 Q XPDD
74 ;
75VERCP(XPD) ;verify check point, returns 1=completed, 0=not
76 ;-1=doesn't exist
77 ;XPD=name
78 N XPDI,XPDY
79 S XPDI=$S(XPDCP="INIT":9.716,1:9.713),XPDY=$$DICCP($G(XPD))
80 Q:'XPDY -1
81 Q ''$$GET1^DIQ(XPDI,XPDY_","_XPDA_",",1,"I")
82 ;
83PARCP(XPD,XPDF) ;returns parameters of check point
84 ;XPD=name, XPDF="PRE"
85 N XPDI,XPDY
86 I $G(XPDF)="PRE" N XPDCP S XPDCP="INI"
87 S XPDI=$S(XPDCP="INIT":9.716,1:9.713),XPDY=$$DICCP($G(XPD))
88 Q:'XPDY 0
89 Q $$GET1^DIQ(XPDI,XPDY_","_XPDA_",",3,"I")
90 ;
91CURCP(XPDF) ;returns current check point
92 ;XPDF flag - 0=externel, 1=internal
93 Q $S($G(XPDF):XPDCHECK,1:XPDCHECK(0))
94 ;
95WP(X) ;X=global ref
96 N %
97 Q:'$D(@X)
98 F %=1:1 Q:'$D(@X@(%)) W !,@X@(%)
99 Q:'$G(XPDA) D WP^DIE(9.7,XPDA_",",20,"A",X)
100 Q
101MES(X) ;record message, X=message or an array passed by reference
102 N %
103 I $D(X)#2 S %=X K X S X(1)=%
104 ;write message
105 F %=1:1 Q:'$D(X(%)) W !,X(%)
106 Q:'$G(XPDA) D WP^DIE(9.7,XPDA_",",20,"A","X")
107 Q
108BMES(X) ;add blank line before message
109 N %
110 I $D(X)#2 S %=X K X S X(1)=" ",X(2)=%
111 D MES(.X)
112 Q
113RTNUP(X,Y) ;update routine action, X=routine, Y=action
114 ;actions: 1=delete, 2=skip
115 N %
116 ;set action to Y
117 Q:'$G(Y)!'$D(^XTMP("XPDI",$G(XPDA),"RTN",X)) 0 S $P(^(X),U)=+Y
118 Q 1
119 ;get Build ien
120 S Y=$O(^XTMP("XPDI",XPDA,"BLD",0))
121 ;remove checksum when updating action, since action can only be
122 ;delete or skip, not sure if we want to do this
123 S:$P(%,U,2) $P(^XTMP("XPDI",XPDA,"BLD",Y,"KRN",9.8,"NM",$P(%,U,2),0),U,4)=""
124 Q 1
125 ;
126RTNLOG(X) ;Enter/Update routine in the Routine File
127 N Y,FDA,IEN
128 S Y=$O(^DIC(9.8,"B",X,0))
129 I Y'>0 S IEN="?+1,",FDA(9.8,IEN,1)="R"
130 I Y>0 S IEN=(+Y)_","
131 S FDA(9.8,IEN,.01)=X,FDA(9.8,IEN,7.4)=$$NOW^XLFDT
132 D UPDATE^DIE("","FDA","IEN")
133 Q
134 ;
135DICCP(X) ;lookup check point, returns ien or 0
136 Q:$G(X)="" 0
137 ;if they pass ien, fail if can't find
138 I X=+X S Y=X Q:'$D(^XPD(9.7,XPDA,XPDCP,Y,0)) 0
139 E S Y=$$FIND1^DIC(XPDI,","_XPDA_",","X",X)
140 Q Y
141 ;
142PRODE(XPDN,XPD) ;enable/disable protocols, return 1 for success
143 ;XPDN=protocol name, XPD=1-enable, 0-disable
144 Q:$G(XPDN)="" 0
145 S XPD=+$G(XPD)
146 D KIDS^XQOO1($P(XPDSET,U,2),101,XPDN,.XPD)
147 Q $S(XPD<0:0,1:1)
148 ;
149OPTDE(XPDN,XPD) ;enable/disable options, return 1 for success
150 ;XPDN=protocol name, XPD=1-enable, 0-disable
151 Q:$G(XPDN)="" 0
152 S XPD=+$G(XPD)
153 D KIDS^XQOO1($P(XPDSET,U,2),19,XPDN,.XPD)
154 Q $S(XPD<0:0,1:1)
155 ;
156BUILD(XPDN,XPD) ;check if a build exists, return 1 for success
157 ;XPDN=build name, XPD=1-exist, 0-been removed
158 S XPD=$D(XPDT("NM",XPDN))
159 Q XPD
160 ;
161MAILGRP(X) ;Return mail group for package, X=package name or namespace
162 N XD,DIC,DR,DA,DIQ
163 S DA=$O(^DIC(9.4,"C",X,0)) S:DA'>0 DA=$O(^DIC(9.4,"B",X,0)) Q:'DA ""
164 S DIC="^DIC(9.4,",DR=1938,DIQ="XD" D EN^DIQ1
165 Q $S($G(XD(9.4,DA,1938))="":"",1:"G."_XD(9.4,DA,1938))
Note: See TracBrowser for help on using the repository browser.