source: FOIAVistA/trunk/r/IMAGING-MAG-ZMAG/MAGDRPC6.m@ 1608

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

initial load of FOIAVistA 6/30/08 version
File size: 6.3 KB
Line 
1MAGDRPC6 ;WOIFO/EdM - Routing RPCs ; 11/08/2004 11:35
2 ;;3.0;IMAGING;**11,30,51**;26-August-2005
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
19 ;
20PURGDONE(OUT,DAYS,LOCATION) ; RPC = MAG DICOM ROUTE PURGE DONE
21 ; Purge Entries from Queue that have been sent successfully
22 N D0,DE,ID,IM,LIM,PR,RT,STS,TP,TX,X
23 I '$G(LOCATION) S OUT="-1,No Location Specified" Q
24 ;
25 S OUT=0
26 F STS="SENT","NOT FOUND" D
27 . S PR="" F S PR=$O(^MAGQUEUE(2006.035,"STS",LOCATION,STS,PR)) Q:PR="" D
28 . . S DE="" F S DE=$O(^MAGQUEUE(2006.035,"STS",LOCATION,STS,PR,DE)) Q:DE="" D
29 . . . S RT=$P($G(^MAG(2005.2,DE,3)),"^",1) S:'RT RT=31
30 . . . S:$G(DAYS)'<1 RT=DAYS
31 . . . S LIM=$H-RT
32 . . . S D0="" F S D0=$O(^MAGQUEUE(2006.035,"STS",LOCATION,STS,PR,DE,D0)) Q:D0="" D
33 . . . . N %H,%T,%Y
34 . . . . S X=$P($G(^MAGQUEUE(2006.035,D0,1)),"^",4)\1 D H^%DTC
35 . . . . Q:%H'<LIM
36 . . . . S X=$G(^MAGQUEUE(2006.035,D0,0)),IM=$P(X,"^",1),TP=$P(X,"^",3),ID=$P(X,"^",6)
37 . . . . K ^MAGQUEUE(2006.035,"STS",LOCATION,STS,PR,DE,D0)
38 . . . . K:ID'="" ^MAGQUEUE(2006.035,"ID",ID,D0)
39 . . . . I IM'="",TP'="" K ^MAGQUEUE(2006.035,"DEST",DE,STS,IM,TP,D0)
40 . . . . K ^MAGQUEUE(2006.035,D0)
41 . . . . S OUT=OUT+1
42 . . . . Q
43 . . . Q
44 . . Q
45 . S DE="" F S DE=$O(^MAGQUEUE(2006.035,"DEST",DE)) Q:DE="" D
46 . . S IM="" F S IM=$O(^MAGQUEUE(2006.035,"DEST",DE,STS,IM)) Q:IM="" D
47 . . . S TP="" F S TP=$O(^MAGQUEUE(2006.035,"DEST",DE,STS,IM,TP)) Q:TP="" D
48 . . . . S D0="" F S D0=$O(^MAGQUEUE(2006.035,"DEST",DE,STS,IM,TP,D0)) Q:D0="" D
49 . . . . . S PR=$P($G(^MAGQUEUE(2006.035,D0,1)),"^",2)
50 . . . . . S ID=$P($G(^MAGQUEUE(2006.035,D0,0)),"^",6)
51 . . . . . K ^MAGQUEUE(2006.035,D0)
52 . . . . . K:ID'="" ^MAGQUEUE(2006.035,"ID",ID,D0)
53 . . . . . K ^MAGQUEUE(2006.035,"DEST",DE,STS,IM,TP,D0)
54 . . . . . K:PR'="" ^MAGQUEUE(2006.035,"STS",LOCATION,STS,PR,DE,D0)
55 . . . . . S OUT=OUT+1
56 . . . . . Q
57 . . . . Q
58 . . . Q
59 . . Q
60 . Q
61 S D0=0 F S D0=$O(^MAGQUEUE(2006.035,D0)) Q:'D0 D
62 . S X=$P($G(^MAGQUEUE(2006.035,D0,1)),"^",1) I X'="SENT",X'="NOT FOUND" Q
63 . S ID=$P($G(^MAGQUEUE(2006.035,D0,0)),"^",6)
64 . K ^MAGQUEUE(2006.035,D0)
65 . K:ID'="" ^MAGQUEUE(2006.035,"ID",ID,D0)
66 . S OUT=OUT+1
67 . Q
68 Q
69 ;
70REQUEUE(OUT,LOCATION) ; RPC = MAG DICOM ROUTE REQUEUE
71 ; ReQueue Files that Failed during transmission
72 N D0,DE,FL,IM,PR,TP,WW,X
73 I '$G(LOCATION) S OUT="-1,No Location Specified" Q
74 ;
75 S WW="WAITING",OUT=0
76 F FL="FAILED","SENDING" D
77 . S PR="" F S PR=$O(^MAGQUEUE(2006.035,"STS",LOCATION,FL,PR)) Q:PR="" D
78 . . S DE="" F S DE=$O(^MAGQUEUE(2006.035,"STS",LOCATION,FL,PR,DE)) Q:DE="" D
79 . . . S D0="" F S D0=$O(^MAGQUEUE(2006.035,"STS",LOCATION,FL,PR,DE,D0)) Q:D0="" D
80 . . . . K ^MAGQUEUE(2006.035,"STS",LOCATION,FL,PR,DE,D0)
81 . . . . I '$D(^MAGQUEUE(2006.035,D0,0)) K ^MAGQUEUE(2006.035,D0) Q
82 . . . . S $P(^MAGQUEUE(2006.035,D0,1),"^",1)=WW
83 . . . . S ^MAGQUEUE(2006.035,"STS",LOCATION,WW,PR,DE,D0)=""
84 . . . . S X=^MAGQUEUE(2006.035,D0,0),IM=$P(X,"^",1),TP=$P(X,"^",3)
85 . . . . I IM'="",TP'="" K ^MAGQUEUE(2006.035,"DEST",DE,FL,IM,TP,D0)
86 . . . . I IM'="",TP'="" S ^MAGQUEUE(2006.035,"DEST",DE,WW,IM,TP,D0)=""
87 . . . . S OUT=OUT+1
88 . . . . Q
89 . . . Q
90 . . Q
91 . Q
92 Q
93 ;
94REMOBSO(OUT,UPTO,LOCATION) ; RPC = MAG DICOM ROUTE REMOVE OBSO
95 ; Purge Unprocessed entries requested before a certain date
96 N D0,DE,ID,IM,N,PRI,RDT,ST,TY
97 I '$G(LOCATION) S OUT="-1,No Location Specified" Q
98 ;
99 S OUT=0
100 S PRI="" F S PRI=$O(^MAGQUEUE(2006.035,"STS",LOCATION,"WAITING",PRI)) Q:PRI="" D
101 . S DE="" F S DE=$O(^MAGQUEUE(2006.035,"STS",LOCATION,"WAITING",PRI,DE)) Q:DE="" D
102 . . S D0="" F S D0=$O(^MAGQUEUE(2006.035,"STS",LOCATION,"WAITING",PRI,DE,D0)) Q:D0="" D Q:'D0
103 . . . S X=$G(^MAGQUEUE(2006.035,D0,0)),IM=$P(X,"^",1),TY=$P(X,"^",3),ID=$P(X,"^",6)
104 . . . S X=$G(^MAGQUEUE(2006.035,D0,1)),ST=$P(X,"^",1),RDT=$P(X,"^",3)
105 . . . I RDT'<UPTO S D0=0 Q
106 . . . I ST'="",IM'="",TY'="" K ^MAGQUEUE(2006.035,"DEST",DE,ST,IM,TY,D0)
107 . . . K ^MAGQUEUE(2006.035,"STS",LOCATION,"WAITING",PRI,DE,D0)
108 . . . K:ID'="" ^MAGQUEUE(2006.035,"ID",ID,D0)
109 . . . K ^MAGQUEUE(2006.035,D0)
110 . . . S OUT=OUT+1
111 . . . Q
112 . . Q
113 . Q
114 Q
115 ;
116EVALLOG(OUT,TASK,MSG,MAX,LOCATION) ; RPC = MAG DICOM ROUTE EVAL LOG
117 N L,N,PLACE,ZTSK
118 ;
119 S PLACE=$$PLACE^MAGDRPC2(LOCATION)
120 S $P(^MAG(2006.1,PLACE,"LASTROUTE"),"^",1)=DT
121 ;
122 I '$D(^XTMP("MAGEVAL",+$G(TASK))) S OUT(1)="-1,No task #"_(+$G(TASK)) Q
123 I $G(MAX)<1 S OUT(1)="-2,MAXIMUM parameter = "_$G(MAX)_" < 1" Q
124 S (L,MSG)=+$G(MSG),N=1
125 F S MSG=$O(^XTMP("MAGEVAL",TASK,MSG)) Q:MSG="" D Q:N'<MAX
126 . S L=MSG,N=N+1,OUT(N)=^XTMP("MAGEVAL",TASK,MSG)
127 . Q
128 S OUT(1)=(N-1)_" "_L
129 Q:N>1
130 S ZTSK=TASK D STAT^%ZTLOAD
131 I $G(ZTSK(2))["Inactive" S OUT(1)="-3,"_ZTSK(2) Q
132 Q
133 ;
134XMIT ; Continuation from MAGDRPC5
135 N FROM,HASH,TO,TTP
136 S (FROM,TO,OUT(7),OUT(8))=-13
137 S TTP=TP S:TP="TEXT" TTP="FULL" ; MAGFILEB does not support type="TEXT"
138 D FILEFIND^MAGDFB(IM,TTP,0,0,.TO,.FROM)
139 S:FROM["~NO NETWORK LOCATION DEFINED" (FROM,TO)="-1~No routable files found for image "_IM
140 I TP="TEXT" S TO=$E(TO,1,$L(TO)-4)_".TXT",FROM=$E(FROM,1,$L(FROM)-4)_".TXT"
141 I (FROM<0)!(TO<0)!(FROM="") D STATUS^MAGDRPC5(X,D0,"SENT",LOCATION) S OUT(1)=2 Q
142 S HASH=$$DIRHASH^MAGFILEB(TO,+DEST) D:HASH'=""
143 . I $E(TO,1)="\",$E(HASH,$L(HASH))="\" S HASH=$E(HASH,1,$L(HASH)-1)
144 . I $E(TO,1)'="\",$E(HASH,$L(HASH))'="\" S HASH=HASH_"\"
145 . S TO=HASH_TO
146 . Q
147 D:DIR'=""
148 . I $E(TO,1)="\",$E(DIR,$L(DIR))="\" S DIR=$E(DIR,1,$L(DIR)-1)
149 . I $E(TO,1)'="\",$E(DIR,$L(DIR))'="\" S DIR=DIR_"\"
150 . S TO=DIR_TO
151 . Q
152 S:$E(TO,1)'="\" TO="\"_TO
153 S OUT(7)=FROM,OUT(8)=TO
154 S OUT(1)=1
155 Q
Note: See TracBrowser for help on using the repository browser.