source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGQBUT1.m@ 789

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

initial load of WorldVistAEHR

File size: 9.0 KB
Line 
1MAGQBUT1 ;WOIFO/RP; Utilities for Background [ 03/25/2001 11:20 ]
2 ;;3.0;IMAGING;**7,8,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 Q
19BPPS(INPUT,WS,PROCESS) ;INPUT TRANSFORM FOR FILE 2006.8
20 N IEN,FND,WSNAME,WSNAME2,ZNODE,PIECE,MAGX,MAGY,PLACE
21 S U="^"
22 S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
23 Q:'(+$P($G(^MAG(2006.8,WS,0)),U,12)) 0 ;NOT A BACKGROUND PROCESSOR
24 Q:'INPUT 1
25 S WSNAME=$$UPPER^MAGQE4($P($G(^MAG(2006.8,WS,1)),U)) ;Workstation Name
26 Q:$L(WSNAME)<3 0 ;BP WS NOT PROPERLY INSTALLED
27 Q:$O(^MAG(2006.8,"C",PLACE,WSNAME,""))'?1N.N 0
28 F MAGX=12,13,14,15,16,17,20 D Q:MAGY=PROCESS
29 . S MAGY=$$GET1^DID(2006.8,MAGX,"","LABEL")
30 . D:MAGY=PROCESS
31 . . S PIECE=$$GET1^DID(2006.8,MAGX,"","GLOBAL SUBSCRIPT LOCATION")
32 Q:MAGY'=PROCESS 0
33 S PIECE=$P(PIECE,";",2)
34 S IEN=0,WSNAME2="",FND=0
35 F S WSNAME2=$$UPPER^MAGQE4($O(^MAG(2006.8,"C",PLACE,WSNAME2))) Q:WSNAME2="" D Q:FND
36 . Q:WSNAME2=WSNAME
37 . S IEN=$O(^MAG(2006.8,"C",PLACE,WSNAME2,"")) Q:IEN'?1N.N
38 . S ZNODE=$G(^MAG(2006.8,IEN,0))
39 . Q:$P(ZNODE,"^",12)'="1"
40 . S:($P(ZNODE,"^",PIECE)="1") FND="1"
41 Q $S(FND="1":0,1:1)
42RSQUE(RESULT,IEN,QUEUE) ;[MAGQB RSQUE]
43 N PTR,PLACE
44 S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
45 S PTR=$O(^MAGQUEUE(2006.031,"C",PLACE,QUEUE,""))
46 I $P(^MAGQUEUE(2006.031,PTR,0),"^")=QUEUE D
47 . S $P(^MAGQUEUE(2006.031,PTR,0),"^",2)=IEN
48 . ;D RQCNT^MAGQBTM(PLACE)
49 Q
50ICCL(SRVRCNT,NMESS,PLACE) ;UPDATE IMAGING DISTRIBUTION
51 N Y,LOC,INDEX,CNT,IEN,ARRAY,SUB1,SUB2,NAME
52 D NOW^%DTC S Y=% D DD^%DT
53 S LOC=$$KSP^XUPARAM("WHERE")
54 S CNT=1,^TMP($J,"MAGQ",CNT)="SITE: "_LOC
55 S CNT=CNT+1,^TMP($J,"MAGQ",CNT)="DATE: "_Y_" "_$G(^XMB("TIMEZONE"))
56 S CNT=CNT+1,^TMP($J,"MAGQ",CNT)="SENDER: "_$$PLNM^MAGQBUT5(PLACE)_" Imaging Background Processor"
57 S CNT=CNT+1,^TMP($J,"MAGQ",CNT)="Total Cache Free: "_$P(SRVRCNT,U,2)_" gigabytes"
58 S CNT=CNT+1,^TMP($J,"MAGQ",CNT)="Total Cache Available: "_$P(SRVRCNT,U,3)_" gigabytes"
59 I $P(SRVRCNT,U,4) S CNT=CNT+1,^TMP($J,"MAGQ",CNT)="An Automatic Purge process has been Activated."
60 E S CNT=CNT+1,^TMP($J,"MAGQ",CNT)="The Automatic Purge process is NOT configured."
61 S CNT=CNT+1,^TMP($J,"MAGQ",CNT)="The "_$P(SRVRCNT,U)_" Imaging cache servers will"
62 S CNT=CNT+1,^TMP($J,"MAGQ",CNT)="require operator intervention to ensure continued"
63 S CNT=CNT+1,^TMP($J,"MAGQ",CNT)="availability. The following MAG SERVER members"
64 S CNT=CNT+1,^TMP($J,"MAGQ",CNT)="are being notified:"
65 S INDEX=0,IEN=$$FIND1^DIC(3.8,"","MX","MAG SERVER","","","ERR")
66 Q:IEN'?1N.N
67 D GETS^DIQ(3.8,IEN_",","2*;11*;12*","","ARRAY")
68 S (SUB1,SUB2)=""
69 F S SUB1=$O(ARRAY(SUB1)) Q:SUB1="" D
70 . F S SUB2=$O(ARRAY(SUB1,SUB2)) Q:SUB2="" D
71 . . S NAME=$G(ARRAY(SUB1,SUB2,".01")) D:NAME'=""
72 . . . S CNT=CNT+1,^TMP($J,"MAGQ",8+CNT)=NAME
73 S CNT=CNT+1,^TMP($J,"MAGQ",CNT)="The next notifications will occur in:"
74 S CNT=CNT+1,^TMP($J,"MAGQ",CNT)=NMESS
75 D MAILIT
76 S $P(^MAG(2006.1,$$PLACE^MAGBAPI($G(DUZ(2))),3),"^",11)=$$NOW^XLFDT
77 K ARRAY
78 Q
79MAILIT ;Send the report to the Clinical Application Time
80 N XMSUB
81 S XMSUB="Image Cache Critically Low at "_LOC
82MAILSHR ;Shared Mail server code
83 ;If dropping in...must manage XMSUB
84 N XMY,XMTEXT
85 S XMTEXT="^TMP($J,""MAGQ"","
86 S:$G(DUZ) XMY(DUZ)=""
87 S XMY("G.MAG SERVER")=""
88 S:$G(MAGDUZ) XMY(MAGDUZ)=""
89 D ^XMD
90 K ^TMP($J,"MAGQ")
91 Q
92ALLSERV(RESULT) ;
93 ; RPC[MAGQ ALL SERVER]
94 S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
95 N INDX,DATA,CNT,SHARE,CWL,VALUE,TMP,PLACE ;CWL=CURRENT WRITE LOCATION
96 S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
97 S CWL=$$CWL^MAGBAPI(PLACE)
98 I CWL D
99 . S DATA=$G(^MAG(2005.2,CWL,0))
100 . S SHARE=$P(DATA,U,2)
101 . S RESULT(0)=SHARE_U_CWL_U_+$P(DATA,U,5)_U_+$P(DATA,U,3)_U_$P(DATA,U)
102 . Q
103 E S RESULT(0)="-1^The Current Write Location (CWL) could not be set."
104 S INDX=0,U="^",CNT=1
105 K ^TMP("MAGQAS")
106 F S INDX=$O(^MAG(2005.2,INDX)) Q:INDX'?1N.N D
107 . S DATA=$G(^MAG(2005.2,INDX,0))
108 . Q:$P(DATA,U,6,7)'["1^MAG"
109 . Q:$P(DATA,U,2)[":"
110 . Q:($P(DATA,U,10)'=PLACE)
111 . Q:$P(DATA,U,9)="1" ;ROUTING SHARE
112 . S SHARE=$P(DATA,U,2)
113 . Q:$E(SHARE,1,2)'="\\"
114 . I $E(SHARE,$L(SHARE))="\" S SHARE=$E(SHARE,1,$L(SHARE)-1)
115 . S TMP(SHARE)=""
116 . S VALUE=SHARE_U_INDX_U_+$P(DATA,U,5)_U_+$P(DATA,U,3)_U_$P(DATA,U)
117 . I INDX=CWL D Q ;ELSE CONTINUE
118 . . S RESULT(0)=VALUE_U_$G(^TMP("MAGQ","WSUD"))
119 . . S ^TMP("MAGQAS",0)=VALUE ;1ST SHARE=CWL
120 . S RESULT(CNT)=VALUE,CNT=CNT+1
121 . S ^TMP("MAGQAS",CNT-1)=VALUE
122 Q
123ALLSHR(RESULT) ; RPC[MAGQBP ALL SHARES]
124 N TMP,INDX,DATA,CNT,SHARE,CWL,VALUE,PLACE ;CWL=CURRENT WRITE LOCATION
125 S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
126 S (CNT,INDX)=0,U="^"
127 S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
128 S CWL=$$CWL^MAGBAPI(PLACE)
129 F S INDX=$O(^MAG(2005.2,INDX)) Q:INDX'?1N.N D
130 . S DATA=$G(^MAG(2005.2,INDX,0))
131 . Q:$P(DATA,U,6,7)'["1^MAG"
132 . Q:$P(DATA,U,9)="1" ;ROUTING SHARE
133 . Q:$P(DATA,U,2)[":"
134 . Q:($P(DATA,U,10)'=PLACE)
135 . S SHARE=$P(DATA,U,2)
136 . Q:$E(SHARE,1,2)'="\\"
137 . I $E(SHARE,$L(SHARE))="\" S SHARE=$E(SHARE,1,$L(SHARE)-1)
138 . Q:$D(TMP(SHARE))
139 . S TMP(SHARE)=""
140 S INDX=""
141 F S INDX=$O(TMP(INDX)) Q:INDX="" D
142 . S RESULT(CNT)=INDX,CNT=CNT+1
143 K TMP
144 Q
145FSUPDT(RESULT,IEN,SPACE,SIZE) ;
146 ;File Server Update
147 ; RPC[MAGQ FS UPDATE]
148 S X="ERR^MAGQBTM",@^%ZOSF("TRAP")
149 N NODE,X,Y,INDEX,SHNAME,PLACE
150 S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
151 S X=$$NOW^XLFDT S Y=X D DD^%DT S ^TMP("MAGQ","WSUD")=Y
152 S ^TMP("MAGQ","WSUD",XWBTIP)=Y
153 I $G(^MAG(2005.2,IEN,0))="" S RESULT="-1^No Network Location Entry" Q
154 S NODE=^MAG(2005.2,IEN,0)
155 D FSW(IEN,NODE)
156 S INDEX=0,SHNAME=$P(NODE,"^",2)
157 ; NOW UPDATE THE SIZING FIELDS FOR SHARES OF SAME PHYS LOCATION
158 F S INDEX=$O(^MAG(2005.2,"AC",SHNAME,INDEX)) Q:INDEX'?1N.N D
159 . Q:INDEX=IEN
160 . S NODE=^MAG(2005.2,INDEX,0)
161 . D FSW(INDEX,NODE)
162 S RESULT="1^Update Complete"
163 Q
164FSW(INDEX,NODE) ;
165 I (($P(NODE,"^",3)'=(+SIZE))!($P(NODE,"^",5)'=(+SPACE))) D
166 . S $P(NODE,"^",3)=+SIZE,$P(NODE,"^",5)=+SPACE,^MAG(2005.2,INDEX,0)=NODE
167 Q
168QUEUER(QUE,FROM,TO) ;
169 N TYPE,INC,CNT,AR,TMP,PLACE,INST,MAGFILE
170 I $$GET1^DIQ(200,+$G(DUZ),.01)="" D Q
171 . W !,"You must have a valid User ID (DUZ) to use this function!"
172 I "^JBTOHD^PREFET^ABSTRACT^JUKEBOX^GCC^DELETE^EVAL^"'[QUE D Q
173 . W !,"Only JBTOHD, PREFET, ABSTRACT, JUKEBOX, DELETE, EVAL & GCC queues are valid!"
174 . W !,"Input values: ""Queue type"",""From Image IEN"",""To Image IEN"""
175 S CNT=0
176 ;
177 S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
178 ;
179 S INST=$$GET1^DIQ(2006.1,PLACE,.01,"I")
180 F INC=FROM:1:TO D
181 . I ('$D(^MAG(2005,INC,0))&('$D(^MAG(2005.1,INC,0)))) Q
182 . I ($P($G(^MAG(2005,INC,100)),U,3)'=INST)&($P($G(^MAG(2005.1,INC,100)),U,3)'=INST) Q
183 . I ($P($G(^MAG(2005,INC,0)),"^",2)="")&($P($G(^MAG(2005.1,INC,0)),"^",2)="") Q ;No full filename attribute
184 . I (+$P($G(^MAG(2005,INC,1,0)),"^",4)>0)!(+$P($G(^MAG(2005.1,INC,1,0)),"^",4)>0) Q ;GROUP PARENT
185 . I "^DELETE^"[QUE D Q
186 . . S MAGXX=INC D VSTNOCP^MAGFILEB I $P(MAGFILE,U)="-1" W !,"Image # "_INC Q
187 . . S MAGXX=INC D ABSNOCP^MAGFILEB I $P(MAGFILE,U)="-1" W !,"Image # "_INC Q
188 . . S MAGXX=INC D BIGNOCP^MAGFILEB I $P(MAGFILE,U)="-1" W !,"Image # "_INC Q
189 . . D IMAGEDEL^MAGGTID(.MAGFILE,INC,"","TESTING") Q
190 . I "^JBTOHD^PREFET^"[QUE F TYPE="ABSTRACT","FULL","BIG" D
191 . . Q:(TYPE="BIG")&('$D(^MAG(2005,INC,"FBIG"))&'$D(^MAG(2005.1,INC,"FBIG")))
192 . . D MAPI(QUE,INC_"^"_TYPE,.CNT)
193 . E D MAPI(QUE,INC,.CNT)
194 Q
195MPAC(SW,FROM,TO) ;
196 N INDEX
197 I (SW'=1)&(SW'=0) W !,"The first parameter must equal 0 or 1" Q
198 I (FROM<0)!((TO<0)!(TO<FROM)) W !,"The second parameter must be greater than 0 and less than the third!" Q
199 S FROM=FROM-1
200 F S INDEX=$O(^MAG(2005,INDEX)) Q:INDEX'?1N.N Q:INDEX>TO D
201 . I '$D(^MAG(2005,INDEX,0)) Q
202 . I $P($G(^MAG(2005,INDEX,0)),"^",2)="" Q ;No full filename attribute
203 . I +$P($G(^MAG(2005,INDEX,1,0)),"^",4)>0 Q ;GROUP PARENT
204 . I (SW=1)&('$D(^MAG(2005,INDEX,"PACS"))) S ^MAG(2005,INDEX,"PACS")="TEST PACS" Q
205 . I SW=0 K ^MAG(2005,INDEX,"PACS")
206 Q
207MAPI(TYP,PARAM,CNT) ;
208 N PLACE
209 S CNT=CNT+1,PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
210 W !,CNT," TYPE: ",TYP,": ",PARAM_" QUEUE #: ",@("$$"_TYP_"^MAGBAPI(PARAM,PLACE)")
211 Q
212BPQSL(RESULT,TYPE) ;
213 ; RPC[MAGQB QSL]
214 N STATUS,CNT,IEN,CP,PLACE
215 S PLACE=$$PLACE^MAGBAPI(+$G(DUZ(2)))
216 S STATUS="",CNT=0
217 F S STATUS=$O(^MAGQUEUE(2006.03,"D",PLACE,TYPE,STATUS)) Q:STATUS="" D
218 . Q:+STATUS>0
219 . S IEN=$O(^MAGQUEUE(2006.03,"D",PLACE,TYPE,STATUS,""))
220 . S CP=$P(^MAGQUEUE(2006.031,$O(^MAGQUEUE(2006.031,"C",PLACE,TYPE,"")),0),"^",2)
221 . Q:IEN>(CP)
222 . S CNT=CNT+1,RESULT(CNT)=STATUS
223 Q
Note: See TracBrowser for help on using the repository browser.