source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGQBUT4.m@ 701

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

initial load of WorldVistAEHR
File size: 8.9 KB
RevLine 
[613]1MAGQBUT4 ;WOIFO/RMP - BP Utilities ;19 Nov 2001 1:23 PM
2 ;;3.0;IMAGING;**7,8,48,20**;Apr 12, 2006
3 ;; +---------------------------------------------------------------+
4 ;; | Property of the US Government. |
5 ;; | No permission to copy or redistribute this software is given. |
6 ;; | Use of unreleased versions of this software requires the user |
7 ;; | to execute a written test agreement with the VistA Imaging |
8 ;; | Development Office of the Department of Veterans Affairs, |
9 ;; | telephone (301) 734-0100. |
10 ;; | |
11 ;; | The Food and Drug Administration classifies this software as |
12 ;; | a medical device. As such, it may not be changed in any way. |
13 ;; | Modifications to this software may result in an adulterated |
14 ;; | medical device under 21CFR820, the use of which is considered |
15 ;; | to be a violation of US Federal Statutes. |
16 ;; +---------------------------------------------------------------+
17 ;;
18 ;
19 Q
20CONV(ARR,ICT) ;Convert any single node array to FM Style multiple
21 ; The node subscripts of ARR are ignored, and not retained
22 ; i.e. ARR(34)=8
23 ; ARR("BLUE")=9
24 ; ARR("D")=10
25 ; converts to
26 ; ARR(1,0)=8
27 ; ARR(2,0)=9
28 ; ARR(3,0)=10
29 N I,ARO
30 S ICT=0,I=""
31 F S I=$O(ARR(I)) Q:(I="") D
32 . S ICT=ICT+1
33 . S ARO(ICT,0)=ARR(I)
34 K ARR
35 M ARR=ARO
36 Q
37MRGMULT(ARR,RT,RTDSC,CT) ;Merge the FM formatted array into a FM File
38 ; multiple field.
39 ; This isn't for general consumption.
40 ; RT = FILE ROOT, RECORD NUMBER, NODE
41 ; i.e. "^MAG(2006.034,44,1," -> 44 is the IEN of MAG(2006.34
42 ; RTDSC is the 2nd piece of the 0 node of the multiple field.
43 S RT=$E(RT,1,$L(RT)-1)_")"
44 S @RT@(0)=U_RTDSC_U_CT_U_CT ; i.e. ^2006.341A^13^13
45 M @RT=ARR
46 Q
47DDLF(RESULTS,FILE,FIELD,FLAGS,ATTR) ;[MAG FLD ATT]
48 S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
49 K X
50 D FIELD^DID(FILE,FIELD,FLAGS,ATTR,"RESULTS","RESULTS")
51 Q
52DDFA(RESULTS) ;[MAG ATT LST]
53 S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
54 K X
55 D FIELDLST^DID(RESULTS)
56 Q
57DHRPC(RESULTS,FNAME,FLOC) ;[MAG DIRHASH]
58 N TMP
59 S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
60 K X
61 S TMP=$$DIRHASH^MAGFILEB(FNAME,FLOC)
62 S RESULTS=$S(TMP="":U,1:TMP)
63 Q
64GPACHX(PV) ; Get Package File Install History of Imaging
65 N I,LCNT,MSG,PKG
66 S LCNT=0
67 S PV(0)="Version^Install Date"
68 F PKG="IMAGING" D
69 . N J,K,L,VERS,DATE,X,Y,%DT
70 . S J=$O(^DIC(9.4,"B",PKG,"")) Q:'J
71 . S VERS="" F S VERS=$O(^DIC(9.4,J,22,"B",VERS)) Q:VERS="" D
72 . . N MSG,TAR
73 . . S K=$O(^DIC(9.4,J,22,"B",VERS,""))
74 . . D LIST^DIC(9.4901,","_K_","_J_",","@;.01;.02;.03","","","","","","","","TAR","MSG")
75 . . Q:$D(MSG("DIERR"))
76 . . S L=0 F S L=$O(TAR("DILIST","ID",L)) Q:'L D
77 . . . S LCNT=LCNT+1
78 . . . S PV(LCNT)=VERS_"P"_$P(TAR("DILIST","ID",L,".01"),"^",1)
79 . . . S X=$P(TAR("DILIST","ID",L,".02"),"^",1) D ^%DT S DATE=$$FMTE^XLFDT(Y,2)
80 . . . S PV(LCNT)=PV(LCNT)_"^"_$S(DATE["-1":"",1:DATE)
81 . . . Q
82 . . Q
83 . Q
84 Q
85VOK(VER) ; Check for the appropriate BP Queue processor version
86 ; This routine MAGQBUT4 will need to be released with each BP Update
87 ; The variable CVERS will contain the current BP server version
88 ; ;;3.0;IMAGING;**7,13,8**;Jul 26, 2004
89 N VN,I,CVERS,PNUM,SLINE,ALTVER
90 S SLINE=$T(+2),ALTVER=","_$$TRIM($P(SLINE,"**",2))_","
91 S PNUM=$$TRIM($P(SLINE,"**",2)),PNUM=$$TRIM($P(PNUM,",",$L(PNUM,",")))
92 S CVERS=$$TRIM($P(SLINE,";",3))_"P"_PNUM
93 Q $S(CVERS=VER:1,$P(VER,"P",2)["13":1,ALTVER[(","_$P(VER,"P",2)_","):1,1:0)
94 ;
95TRIM(X) ; remove both leading and trailing blanks
96 N I,J
97 F I=1:1:$L(X) Q:$E(X,I)'=" "
98 F J=$L(X):-1:I Q:$E(X,J)'=" "
99 Q $S($E(X,I,J)=" ":"",1:$E(X,I,J))
100 ;
101QCNT(RESULT,PLC,QUE) ; [MAGQ QCNT]
102 S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
103 N CNT,DA,CQ,IA
104 S (NODE,IA)="",RESULT=0
105 S (CNT,IA)=0,DA=""
106 S QP=$S($D(^MAGQUEUE(2006.031,"C",PLC,QUE)):$O(^MAGQUEUE(2006.031,"C",PLC,QUE,"")),1:"")
107 S CQ=$S('QP:0,1:$P($G(^MAGQUEUE(2006.031,QP,0)),U,2))
108 F S DA=$O(^MAGQUEUE(2006.03,"C",PLC,QUE,DA)) Q:'DA S CNT=CNT+1 I CQ<DA S IA=IA+1
109 D QPUP(PLC,QUE,CNT,CQ,IA,QP) Q
110 Q
111 ;
112QPUP(PLC,QUE,CNT,CQ,IA,QP) ;
113 N IEN,DIC,VAL
114 K VAL
115 S VAL(1)=PLC,VAL(2)=QUE
116 S QP=$S(QP:QP,1:$$FIND1^DIC(2006.031,"","QX",.VAL,"C","",""))
117 ;I IEN>0 D Q:IEN
118 ;. S $P(^MAGQUEUE(2006.031,IEN,0),U,5)=CNT Q
119 I 'QP D Q
120 . K DIE,FDA
121 . S FDA(2006.031,"+1,",.01)=QUE
122 . S FDA(2006.031,"+1,",.04)=PLC
123 . S FDA(2006.031,"+1,",1)=CQ
124 . S FDA(2006.031,"+1,",2)=IA
125 . S FDA(2006.031,"+1,",3)=CNT
126 . D UPDATE^DIE("U","FDA","","MAGQUP")
127 . K DIE,FDA
128 E D
129 . K DIE,FDA
130 . S FDA(2006.031,QP_",",.01)=QUE
131 . S FDA(2006.031,QP_",",.04)=PLC
132 . S FDA(2006.031,QP_",",1)=CQ
133 . S FDA(2006.031,QP_",",2)=IA
134 . S FDA(2006.031,QP_",",3)=CNT
135 . D FILE^DIE("","FDA","MAGERR")
136 . K DIE,FDA
137 Q
138 ;
139CPUD ;
140 N PLC,INS,QUE
141 S (INS,PLC)=""
142 F S INS=$O(^MAG(2006.1,"B",INS)) Q:INS="" D
143 . S PLC=$O(^MAG(2006.1,"B",INS,""))
144 . S QUE="" F S QUE=$O(^MAGQUEUE(2006.031,"C",PLC,QUE)) Q:QUE="" D
145 . . D QCNT^MAGQBUT4("",PLC,QUE)
146 . . Q
147 . Q
148 Q
149CNL(GL,IEN,NLC) ; Check Network Location
150 N MAGREF,MAG0,MAG1,PLC
151 S NLC=NLC+1
152 I '$G(IEN) Q ""
153 S MAG0=$G(@(GL_IEN_",0)"))
154 S MAGREF=+$P(MAG0,"^",3) ; get file from raid
155 I MAGREF=0 S MAGREF=+$P(MAG0,"^",5) ; get file from jukebox
156 I 'MAGREF Q ""
157 I '$D(^MAG(2005.2,MAGREF,0)) Q ""
158 S PLC=$P($G(^MAG(2005.2,MAGREF,0)),U,10)
159 Q:'PLC ""
160 S PLC=$P($G(^MAG(2006.1,PLC,0)),U)
161 Q $S('PLC:"",1:PLC)
162CNSP(GL,IEN,NMSP,NSC) ; Check NameSPace
163 N NMSPC,MAG0,FNAM,INSTIEN
164 S NSC=NSC+1
165 S MAG0=$G(@(GL_IEN_",0)"))
166 S FNAM=$P(MAG0,U,2)
167 S NMSPC=$TR($P(FNAM,"."),"0123456789","")
168 Q:NMSPC="" ""
169 S INSTIEN=$S($D(NMSP(NMSPC)):$O(NMSP(NMSPC,"")),1:"")
170 Q INSTIEN
171ACQUD(LIMIT) ;
172 N I,TMP,CNT
173 S (I,CNT)=0
174 F S I=$O(^TMP($J,"CHANGE_IEN",I)) Q:I="" D
175 . S TMP=$G(^TMP($J,"CHANGE_IEN",I))
176 . D DFNIQ^MAGQBPG1("","Original Acquisition Site at IEN: "_$P(TMP,U,3)_" Value: "_$P(TMP,U)_" New value: "_$P(TMP,U,2),0)
177 . S CNT=CNT+1
178 . I (CNT+1)>LIMIT D
179 . . D DFNIQ^MAGQBPG1("Post Install Acquisition Site field Updates","",1)
180 . . S CNT=0
181 . . Q
182 . Q
183 D DFNIQ^MAGQBPG1("Post Install Acquisition Site field Updates","",1)
184 K ^TMP($J,"CHANGE_IEN"),TMP
185 Q
186NMSP(TMPA) ;
187 N IEN,INS,TMP,I,J
188 S INS="" F S INS=$O(^MAG(2006.1,"B",INS)) Q:INS="" S IEN="" D
189 . S IEN=$O(^MAG(2006.1,"B",INS,IEN)) Q:IEN="" D Q
190 . . S TMP=","_$$UPPER^MAGQE4($$INIS^MAGQBPG2(IEN))_"," D Q
191 . . . F I=2:1 S J=$P(TMP,",",I) Q:J="" S TMPA(J,INS)=""
192 . . . Q
193 S J="" F S J=$O(TMPA(J)) Q:J="" S INS=$O(TMPA(J,"")) K:($O(TMPA(J,INS))]"") TMPA(J)
194 Q
195CLRQ ; Clears the Queue file and Queue Pointer files
196 N DA,DIK,FILE,IEN
197 F FILE=2006.03,2006.031 D
198 . S IEN=0 F S IEN=$O(^MAGQUEUE(FILE,IEN)) Q:'IEN D
199 . . S DIK="^MAGQUEUE("_FILE_","
200 . . S DA=IEN,DA(1)=FILE D ^DIK
201 K DIK,DA
202 Q
203 ; We add RPC to MAG WINDOWS Option this way instead of sending Option : MAG WINDOWS
204 ; If we send MAG WINDOWS Option, the last one installed will overwrite others.
205 ; ADDRPC copied from Patch 51, added the call "D MES^XPDUTL(" instead of "W !"
206ADDRPC(RPCNAME,OPTNAME) ;
207 N DA,DIC
208 S DIC="^DIC(19,",DIC(0)="",X=OPTNAME D ^DIC
209 I Y<0 D Q
210 . D MES^XPDUTL("Cannot add RPC: """_RPCNAME_""" to Option: """_OPTNAME_""".")
211 . D MES^XPDUTL("Cannot find Option: """_OPTNAME_""".")
212 . Q
213 I '$D(^XWB(8994,"B",RPCNAME)) D Q
214 . D MES^XPDUTL("Cannot add RPC: """_RPCNAME_""" to Option: """_OPTNAME_""".")
215 . D MES^XPDUTL("Cannot find RPC: """_RPCNAME_""".")
216 . Q
217 S DA(1)=+Y
218 I $D(^DIC(19,+Y,"RPC","B",$O(^XWB(8994,"B",RPCNAME,"")))) D Q
219 . D MES^XPDUTL("Cannot add RPC: """_RPCNAME_""" to Option: """_OPTNAME_""".")
220 . D MES^XPDUTL("RPC: """_RPCNAME_""" is already a member of """_OPTNAME_""".")
221 . Q
222 S DIC=DIC_DA(1)_",""RPC"","
223 S DIC(0)="L" ; LAYGO should be allowed here
224 S X=RPCNAME
225 D ^DIC
226 I Y<0 D Q
227 . D MES^XPDUTL("Cannot add RPC: """_RPCNAME_""" to Option: """_OPTNAME_""".")
228 . D MES^XPDUTL("Cannot find RPC: """_RPCNAME_""".")
229 . Q
230 Q
231INS(XP,DUZ,DATE,IDA) ;
232 N CT,CNT,COM,D,D0,D1,D2,DDATE,DG,DIC,DICR,DIW,MAGMSG,ST,XMID,XMY
233 D GETENV^%ZOSV
234 S CNT=0
235 S CNT=CNT+1,MAGMSG(CNT)="PACKAGE INSTALL"
236 S CNT=CNT+1,MAGMSG(CNT)="SITE: "_$$KSP^XUPARAM("WHERE")
237 S CNT=CNT+1,MAGMSG(CNT)="PACKAGE: "_XP
238 S CNT=CNT+1,MAGMSG(CNT)="Version: "_$$VER^XPDUTL(XP)
239 S ST=$$GET1^DIQ(9.7,IDA,11,"I")
240 S CNT=CNT+1,MAGMSG(CNT)="Start time: "_$$FMTE^XLFDT(ST)
241 S CT=$$GET1^DIQ(9.7,IDA,17,"I") S:+CT'=CT CT=$$NOW^XLFDT
242 S CNT=CNT+1,MAGMSG(CNT)="Completion time: "_$$FMTE^XLFDT(CT)
243 S CNT=CNT+1,MAGMSG(CNT)="Run time: "_$$FMDIFF^XLFDT(CT,ST,3)
244 S CNT=CNT+1,MAGMSG(CNT)="Environment: "_Y
245 S COM=$$GET1^DIQ(9.7,IDA,6,"I")
246 S CNT=CNT+1,MAGMSG(CNT)="FILE COMMENT: "_COM
247 S CNT=CNT+1,MAGMSG(CNT)="DATE: "_DATE
248 S CNT=CNT+1,MAGMSG(CNT)="Installed by: "_$$GET1^DIQ(9.7,IDA,9,"E")
249 S CNT=CNT+1,MAGMSG(CNT)="Install Name: "_$$GET1^DIQ(9.7,IDA,.01,"E")
250 S DDATE=$$GET1^DIQ(9.7,IDA,51,"I")
251 S CNT=CNT+1,MAGMSG(CNT)="Distribution Date: "_$$FMTE^XLFDT(DDATE)
252 S XMSUB=XP_" INSTALLATION"
253 S XMID=$G(DUZ) S:'XMID XMID=.5
254 S XMY(XMID)=""
255 S XMY("G.MAG SERVER")=""
256 S:$G(MAGDUZ) XMY(MAGDUZ)=""
257 S XMSUB=$E(XMSUB,1,63)
258 D SENDMSG^XMXAPI(XMID,XMSUB,"MAGMSG",.XMY,,.XMZ,)
259 I $G(XMERR) M XMERR=^TMP("XMERR",$J) S $EC=",U13-Cannot send MailMan message," K XMERR
260 Q
261 ;
Note: See TracBrowser for help on using the repository browser.