source: FOIAVistA/trunk/r/IMAGING-MAG-ZMAG/MAGQBUT5.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.6 KB
Line 
1MAGQBUT5 ;WOIFO/RMP - BP Utilities ;Oct 21, 2005 1:23 PM
2 ;;3.0;IMAGING;**20,81**;May 17, 2007
3 ;; Per VHA Directive 2004-038, this routine should not be modified.
4 ;; +---------------------------------------------------------------+
5 ;; | Property of the US Government. |
6 ;; | No permission to copy or redistribute this software is given. |
7 ;; | Use of unreleased versions of this software requires the user |
8 ;; | to execute a written test agreement with the VistA Imaging |
9 ;; | Development Office of the Department of Veterans Affairs, |
10 ;; | telephone (301) 734-0100. |
11 ;; | The Food and Drug Administration classifies this software as |
12 ;; | a medical device. As such, it may not be changed |
13 ;; | in any way. Modifications to this software may result in an |
14 ;; | adulterated medical device under 21CFR820, the use of which |
15 ;; | is considered to be a violation of US Federal Statutes. |
16 ;; +---------------------------------------------------------------+
17 ;;
18AI(RESULT) ; List of Associated Institution candidates;
19 N INDEX,INST,J,K,L,OUT
20 S K=0
21 S RESULT(K)=""
22 S K=K+1
23 D LIST^DIC(40.8,,".01;.07I",,,,,,,,"OUT")
24 S RESULT(K)="The following Medical Center Divisions have Imaging Site Parameters defined on",K=K+1
25 S RESULT(K)="your system:" D
26 . S INDEX=0,K=K+1 F S INDEX=INDEX+1 Q:'$D(OUT("DILIST","ID",INDEX)) D
27 . . S INST=OUT("DILIST","ID",INDEX,.07),J=0 F S J=$O(^MAG(2006.1,J)) Q:'J I $P(^MAG(2006.1,J,0),U)=INST D Q
28 . . . S RESULT(K)=OUT("DILIST","ID",INDEX,.01)_" "_INST,K=K+1 Q
29 . . Q
30 . Q
31 I INDEX=1 S RESULT(K)="None",K=K+1
32 S RESULT(K)="The following Medical Center Divisions have 'Associated Institutions' defined on",K=K+1
33 S RESULT(K)="your system:" D
34 . S INDEX="",K=K+1,L=K F S INDEX=$O(^MAG(2006.1,"B",INDEX)) Q:'INDEX D
35 . . Q:$P($G(^MAG(2006.1,$O(^MAG(2006.1,"B",INDEX,"")),0)),U)=INDEX
36 . . S RESULT(K)=$P($G(^DIC(4,INDEX,0)),U)_" "_INDEX,K=K+1 Q
37 . Q
38 I K=L S RESULT(K)="None",K=K+1
39 S RESULT(K)="The following Medical Center Divisions have NO Imaging parameter affiliations",K=K+1
40 S RESULT(K)="defined on your system:" D
41 . S INDEX=0,K=K+1,L=K F S INDEX=INDEX+1 Q:'$D(OUT("DILIST","ID",INDEX)) D
42 . . S INST=OUT("DILIST","ID",INDEX,.07) Q:$D(^MAG(2006.1,"B",INST)) D
43 . . . S RESULT(K)=OUT("DILIST","ID",INDEX,.01)_" "_INST,K=K+1 Q
44 . . Q
45 . Q
46 I K=L S RESULT(K)="None",K=K+1
47 K OUT
48 D CLEAN^DILF
49 Q
50PLNM(PLACE) ; Returns the Institution name of the Place
51 N INST
52 Q:'PLACE " "
53 S INST=$P($G(^MAG(2006.1,PLACE,0)),U)
54 Q $P($G(^DIC(4,INST,0)),U)
55TPMESS(PLACE) ;Trigger a purge message
56 N Y,LOC,CNT,XMSUB
57 D NOW^%DTC S Y=% D DD^%DT
58 S LOC=$$KSP^XUPARAM("WHERE")
59 S CNT=1,^TMP($J,"MAGQ",CNT)="SITE: "_LOC
60 S CNT=CNT+1,^TMP($J,"MAGQ",CNT)="DATE: "_Y_" "_$G(^XMB("TIMEZONE"))
61 S CNT=CNT+1,^TMP($J,"MAGQ",CNT)="SENDER: "_$$PLNM^MAGQBUT5(PLACE)_" Imaging Background Processor"
62 S CNT=CNT+1,^TMP($J,"MAGQ",CNT)="An automatic purge event has been initiated"
63 S CNT=CNT+1,^TMP($J,"MAGQ",CNT)="in order to maintain adequate image storage"
64 S CNT=CNT+1,^TMP($J,"MAGQ",CNT)="no operator intervention is required."
65 S XMSUB="Vista Imaging BP Queue processor - Autopurge"
66 D MAILSHR^MAGQBUT1
67 Q
68RMRPC(NAME) ; Removing an RPC in order to revise
69 N MW,RPC,MWE,DIERR
70 S MW=$$FIND1^DIC(19,"","X","MAG WINDOWS","","","")
71 D CLEAN^DILF
72 Q:'MW
73 S RPC=$$FIND1^DIC(8994,"","X",NAME,"","","")
74 D CLEAN^DILF
75 Q:'RPC
76 S MWE=$$FIND1^DIC(19.05,","_MW_",","X",NAME,"","","")
77 D CLEAN^DILF
78 Q:'MWE
79 S DA=MWE,DA(1)=MW,DIK="^DIC(19,"_DA(1)_",""RPC"","
80 D ^DIK
81 K DA,DIK
82 S DA=RPC,DIK="^XWB(8994,"
83 D ^DIK
84 K DA,DIK
85 Q
86 ;
Note: See TracBrowser for help on using the repository browser.