source: cprs/branches/tmg-cprs/m_files/TMGXPDUT.m@ 1742

Last change on this file since 1742 was 796, checked in by Kevin Toppenberg, 14 years ago

Initial upload

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