| [613] | 1 | MAGQBUT5 ;WOIFO/RMP - BP Utilities ;Oct 21, 2005 1:23 PM
|
|---|
| 2 | ;;3.0;IMAGING;**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 |
|
|---|
| 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 | ;;
|
|---|
| 18 | AI(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
|
|---|
| 50 | PLNM(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)
|
|---|
| 55 | TPMESS(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
|
|---|
| 68 | ;
|
|---|
