source: WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGJRT.m@ 1800

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

initial load of WorldVistAEHR
File size: 8.7 KB
Line 
1MAGJRT ;WIRMFO/JHC VistaRad RPC calls for Demand Routing ; 13 Jan 2004 11:00 AM
2 ;;3.0;IMAGING;**9,22,11,18**;Mar 07, 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
19 ; Entry Points:
20 ; RTENA -- Determine whether user has Security Key required to use Demand Routing
21 ; RTREQ -- Build message to create Demand Routing Request form on the W/S
22 ; RTEXAM -- Queue images to route according to input requests
23 ;
24ERR N ERR S ERR=$$EC^%ZOSV S @MAGGRY@(0)="0^4~"_ERR
25 D @^%ZOSF("ERRTN")
26 Q:$Q 1 Q
27 ;
28RTENA(MAGGRY,DATA) ; RPC: MAGJ ROUTE ENABLE
29 ; Enable if: 1) User has applicable security key and, 2) Routing Loc'n has usable entries
30 N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJRT"
31 S MAGGRY="FALSE"
32 I '$D(MAGJOB("KEYS")) D USERKEYS^MAGJUTL3
33 F X="MAGJ DEMAND ROUTE","MAGJ DEMAND ROUTE DICOM" I $D(MAGJOB("KEYS",X)) D Q
34 . N OK,DUM
35 . S OK=0 D RTLOCS1(.DUM,.OK) I +OK!+$P(OK,U,2) S MAGGRY="TRUE"
36 Q
37 ;
38RTREQ(MAGGRY,DATA) ; RPC: MAGJ ROUTE REQUEST
39 ; request to route exams; info returned in MAGGRY
40 ; input in DATA(1:n): RADFN ^ RADTI ^ RACNI ^ RARPT
41 ; - RADFN^RADTI^RACNI input to specify case of interest
42 ; Returns: Exam Info for routable exams in ^TMP($J,"MAGJROUTE",1:N)
43 ; Followed by Prompts for Routing Locations & Priority
44 ; Then error messages, if any
45 ;
46 ; MAGGRY holds $NA reference to ^TMP where Broker return message is assembled;
47 ; all references to MAGGRY use subscript indirection
48 ;
49 N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJRT"
50 N RARPT,RADFN,RADTI,RACNI
51 N DAYCASE,REPLY,CT,MAGS,STARTNOD,DATAOUT,RADATA,MAGSTRT,MAGEND,NEXAM,DIQUIET
52 N IDATA,NOGO
53 S DIQUIET=1 D DT^DICRW
54 S CT=0,NEXAM=0,DATAOUT="",DAYCASE=""
55 S NOGO(0)=0 ; array for reply for exams unable to process
56 S MAGLST="MAGJROUTE",STARTNOD=1
57 K MAGGRY S MAGGRY=$NA(^TMP($J,MAGLST)) K @MAGGRY ; assign MAGGRY value
58 S IDATA=""
59 F S IDATA=$O(DATA(IDATA)) Q:IDATA="" S DATA=DATA(IDATA) D EXDAT("RTGET")
60 I NEXAM D ; have some exams eligible to be routed
61 . S @MAGGRY@(STARTNOD)="^Case #^Patient^Procedure^Image Date/Time^Status^Modality"
62 . S CT=CT+1,@MAGGRY@(CT+STARTNOD)="*END"
63 . S REPLY="1~Route Exams to Selected Locations"
64 . D RTLOCS(.CT) D RTPRIOR(.CT)
65 E D
66 . S REPLY="0~Unable to Route any Exams"
67RTREQZ I NOGO(0) D NOGO("Routed",.CT)
68 S @MAGGRY@(0)=NEXAM_U_REPLY
69 Q
70 ;
71 ;
72EXDAT(GET) ; Put routable exam info in output file, non-routable in NOGO(n)
73 S NOGO=0,RARPT=+$P(DATA,U,4)
74 S RADFN=$P(DATA,U),RADTI=$P(DATA,U,2),RACNI=$P(DATA,U,3),X=0
75 I RADFN,RADTI,RACNI D GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,"",.X)
76 I 'X S NOGO="1~Request has Invalid Case Pointer ("_RADFN_U_RADTI_U_RACNI_U_RARPT_")." G EXDATZ
77 S RADATA=$G(^TMP($J,"MAGRAEX",1,1)) K ^TMP($J,"MAGRAEX")
78 S RARPT=$P(RADATA,U,10),DAYCASE=$P(RADATA,U,12)
79 S DATAOUT="" D @GET
80EXDATZ I NOGO D
81 . S NOGO(0)=NOGO(0)+1,NOGO(NOGO(0))=$P(NOGO,"~",2,99)
82 E D
83 . S DATAOUT=U_DATAOUT_"|"_RADFN_U_RADTI_U_RACNI_U_RARPT_"||"
84 . S NEXAM=NEXAM+1,CT=CT+1,@MAGGRY@(CT+STARTNOD)=DATAOUT
85 Q
86 ;
87RTGET ;GET code for Demand Routing function
88 ; get data for exams (DATAOUT), or reason for error (NOGO)
89 N IMAG,MAGIEN,MDL,MAGS
90 S X=$$JBFETCH^MAGJUTL2(RARPT,.MAGS) ; ? route only if NOT on Jukebox
91 I +X S NOGO="2~Case #"_DAYCASE_"--Images have been requested from Jukebox; try again later." Q
92 I '$P(X,U,2) S NOGO="3~Case #"_DAYCASE_"--No Images exist for exam." Q
93 F IMAG=1:1 S MAGIEN=$P($G(MAGS(IMAG)),U,4) Q:MAGIEN="" D Q:MDL]""
94 . S MDL=$P(MAGS(IMAG),U,3)
95 . I MDL="DR" S MDL="CR" ; for now, hard code cx of non-standard code
96 ; Contents of DATAOUT=
97 ; DAYCASE ^ Pt Name ^ Proc. Name ^ Exam Date/Time ^ Status ^ MDL
98 S DATAOUT=DAYCASE_U_$P(RADATA,U,4)_U_$P(RADATA,U,9)
99 S DATAOUT=DATAOUT_U_$$DTTIM($P(RADATA,U,6))_U_$P(RADATA,U,14)_U_MDL
100 Q
101 ;
102DTTIM(X) ; Format Image Date/Time
103 N T S T=$L(X," "),X=$P(X," ",1,T-1)_"@"_$P(X," ",T)
104 Q X
105 ;
106RTLOCS(CT) ; define prompts for Routing Locations
107 ;DROP-Down List, Default=[Do Not Route], Enable Auto-fill (if>1 exam)
108 N AUTOFILL,T,X,OK,TMP
109 S AUTOFILL=$S($G(NEXAM)>1:"AUTOFILL",1:"")
110 S CT=CT+1,@MAGGRY@(CT+STARTNOD)="*PROMPT"
111 S CT=CT+1,@MAGGRY@(CT+STARTNOD)="DROP^Route To^"_AUTOFILL_"^[Do Not Route]"
112 S T=0
113 S CT=CT+1,@MAGGRY@(CT+STARTNOD)="0^[Do Not Route]"
114 K TMP S TMP=0 D RTLOCS1(.TMP,.OK)
115 F I=1:1:TMP S CT=CT+1,@MAGGRY@(CT+STARTNOD)=TMP(I)
116 S CT=CT+1,@MAGGRY@(CT+STARTNOD)="*END"
117 Q
118 ;
119RTLOCS1(RET,OK) ; return:
120 ; RET = array of loc'ns screened by sec key
121 ; OK = Non-dcm ^ dcm Truth value for user may route respective routing types
122 S RET=0,OK=""
123 I $D(MAGJOB("KEYS","MAGJ DEMAND ROUTE")) D
124 . N T S T=0
125 . F S T=$O(^MAG(2005.2,T)) Q:'T S X=$G(^(T,0)) I X]"" D
126 .. Q:'$P(X,U,9) ; Not a routable location
127 .. Q:'$P(X,U,6) ; OPERATIONAL STATUS not On-Line
128 .. Q:'($P(X,U,7)="MAG") ; Storage Type not Magnetic
129 .. S X=$P(X,U),OK=OK+1
130 .. S RET=RET+1,RET(RET)=T_U_X
131 ; dicom destinations: assume that all are "active"
132 I $D(MAGJOB("KEYS","MAGJ DEMAND ROUTE DICOM")) D
133 . N DCM
134 . D DCMLIST^MAGBRTUT(.DCM,DUZ(2))
135 . I +$G(DCM(1)) S $P(OK,U,2)=+$G(DCM(1))
136 . I F I=2:1:DCM(1)+1 S X=DCM(I),RET=RET+1,RET(RET)=$P(X,U,2)_"DCM"_U_"dcm "_$P(X,U)
137 Q
138 ;
139RTPRIOR(CT) ; define prompts for Routing Priorities
140 ;DROP-Down List, Default=Medium, Enable Auto-fill (if>1 exam)
141 N AUTOFILL
142 S AUTOFILL=$S($G(NEXAM)>1:"AUTOFILL",1:"")
143 S CT=CT+1,@MAGGRY@(CT+STARTNOD)="*PROMPT"
144 S CT=CT+1,@MAGGRY@(CT+STARTNOD)="DROP^Priority^"_AUTOFILL_"^Medium"
145 S CT=CT+1,@MAGGRY@(CT+STARTNOD)="900^STAT"
146 S CT=CT+1,@MAGGRY@(CT+STARTNOD)="750^High"
147 S CT=CT+1,@MAGGRY@(CT+STARTNOD)="500^Medium"
148 S CT=CT+1,@MAGGRY@(CT+STARTNOD)="250^Low"
149 S CT=CT+1,@MAGGRY@(CT+STARTNOD)="*END"
150 Q
151 ;
152NOGO(HDR,CT) ; output error msgs for exams
153 Q:'NOGO(0)
154 S CT=CT+1,@MAGGRY@(CT+STARTNOD)="*ERROR"
155 S CT=CT+1,@MAGGRY@(CT+STARTNOD)=NOGO(0)_" Exams Not Able to be "_HDR
156 F I=1:1:NOGO(0) S CT=CT+1,@MAGGRY@(CT+STARTNOD)=NOGO(I)
157 S CT=CT+1,@MAGGRY@(CT+STARTNOD)="*END"
158 Q
159 ;
160 ; 1 RADFN RADTI RACNI RANME RASSN <-- from GETEXAM
161 ; 6 RADATE RADTE RACN RAPRC RARPT (=RADATA)
162 ; 11 RAST DAYCASE RAELOC RASTP RASTORD
163 ; 16 RADTPRT RACPT
164 ;
165RTEXAM(MAGGRY,DATA) ; RPC: MAGJ ROUTE EXAMS
166 ; queue images to route according to input requests
167 ; input in DATA(1:n), list of exams to route:
168 ; Destination Network Loc'n ^ Priority | RADFN ^ RADTI ^ RACNI ^ RARPT
169 ; Returns: Reply status in ^TMP($J,"MAGJROUTE",1:N)
170 ; Then error messages for each exam if applicable
171 ;
172 ; MAGGRY holds $NA reference to ^TMP where Broker return message is assembled;
173 ; all references to MAGGRY use subscript indirection
174 ;
175 ; MAGS = # Images stored for the case
176 ; MAGS(1:n) = 1/0 ^ FULL/BIG ^ Mod ^ ien ^ Series ^ Routed-to Locations
177 ; (1=Image is on Magnetic Disk)
178 ;
179 N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJRT"
180 N IEXAM,RTLOC,RTPRI,RARPT,IDATA,REPLY,CT,MAGS,STARTNOD,NEXAM,NOGO
181 N IMAG,MAGLST,MAGIEN,RTTYP,DIQUIET
182 S DIQUIET=1 D DT^DICRW
183 K NOGO S NOGO(0)=0 ; array for reply for exams unable to process
184 S MAGLST="MAGJROUTE",CT=0,STARTNOD=0,NEXAM=0
185 K MAGGRY S MAGGRY=$NA(^TMP($J,MAGLST)) K @MAGGRY ; assign MAGGRY value
186 S IDATA=""
187 F S IDATA=$O(DATA(IDATA)) Q:IDATA="" D
188 . S X=DATA(IDATA),DATA=$P(X,"|",2),X=$P(X,"|"),RTLOC=$P(X,U),RTPRI=$P(X,U,2)
189 . S RTTYP=$S(RTLOC=+RTLOC:1,1:2),RTLOC=+RTLOC ; 1=DOS; 2=Dicom
190 . I 'RTLOC Q ; routing cancelled for this exam
191 . S RARPT=$P(DATA,U,4) I 'RARPT D Q
192 . . S NOGO(0)=NOGO(0)+1,NOGO(NOGO(0))="Exam not queued: Missing exam pointer information for exam ("_DATA(IDATA)_")"
193 . S X=$$JBFETCH^MAGJUTL2(RARPT,.MAGS)
194 . F IMAG=1:1 S MAGIEN=$P($G(MAGS(IMAG)),U,4) Q:MAGIEN="" D
195 . . D SEND^MAGBRTUT(MAGIEN,RTLOC,RTPRI,RTTYP)
196 . I IMAG>1 S NEXAM=NEXAM+1
197 . E S NOGO(0)=NOGO(0)+1,NOGO(NOGO(0))="Exam not queued: No images found ("_DATA(IDATA)_")"
198 I NEXAM S REPLY=1_"~"_NEXAM_" Exam"_$S(NEXAM-1:"s",1:"")_" were queued to be routed."
199 E S REPLY="0~Unable to queue any exams for routing."
200RTEXAMZ I NOGO(0) D NOGO("Queued",.CT)
201 S @MAGGRY@(0)=$S(NOGO(0):CT,1:0)_U_REPLY
202 Q
203 ;
204END Q
205 ;
Note: See TracBrowser for help on using the repository browser.