206 lines
8.7 KiB
Mathematica
206 lines
8.7 KiB
Mathematica
MAGJRT ;WIRMFO/JHC VistaRad RPC calls for Demand Routing ; 13 Jan 2004 11:00 AM
|
|
;;3.0;IMAGING;**9,22,11,18**;Mar 07, 2006
|
|
;; +---------------------------------------------------------------+
|
|
;; | Property of the US Government. |
|
|
;; | No permission to copy or redistribute this software is given. |
|
|
;; | Use of unreleased versions of this software requires the user |
|
|
;; | to execute a written test agreement with the VistA Imaging |
|
|
;; | Development Office of the Department of Veterans Affairs, |
|
|
;; | telephone (301) 734-0100. |
|
|
;; | |
|
|
;; | The Food and Drug Administration classifies this software as |
|
|
;; | a medical device. As such, it may not be changed in any way. |
|
|
;; | Modifications to this software may result in an adulterated |
|
|
;; | medical device under 21CFR820, the use of which is considered |
|
|
;; | to be a violation of US Federal Statutes. |
|
|
;; +---------------------------------------------------------------+
|
|
;;
|
|
Q
|
|
; Entry Points:
|
|
; RTENA -- Determine whether user has Security Key required to use Demand Routing
|
|
; RTREQ -- Build message to create Demand Routing Request form on the W/S
|
|
; RTEXAM -- Queue images to route according to input requests
|
|
;
|
|
ERR N ERR S ERR=$$EC^%ZOSV S @MAGGRY@(0)="0^4~"_ERR
|
|
D @^%ZOSF("ERRTN")
|
|
Q:$Q 1 Q
|
|
;
|
|
RTENA(MAGGRY,DATA) ; RPC: MAGJ ROUTE ENABLE
|
|
; Enable if: 1) User has applicable security key and, 2) Routing Loc'n has usable entries
|
|
N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJRT"
|
|
S MAGGRY="FALSE"
|
|
I '$D(MAGJOB("KEYS")) D USERKEYS^MAGJUTL3
|
|
F X="MAGJ DEMAND ROUTE","MAGJ DEMAND ROUTE DICOM" I $D(MAGJOB("KEYS",X)) D Q
|
|
. N OK,DUM
|
|
. S OK=0 D RTLOCS1(.DUM,.OK) I +OK!+$P(OK,U,2) S MAGGRY="TRUE"
|
|
Q
|
|
;
|
|
RTREQ(MAGGRY,DATA) ; RPC: MAGJ ROUTE REQUEST
|
|
; request to route exams; info returned in MAGGRY
|
|
; input in DATA(1:n): RADFN ^ RADTI ^ RACNI ^ RARPT
|
|
; - RADFN^RADTI^RACNI input to specify case of interest
|
|
; Returns: Exam Info for routable exams in ^TMP($J,"MAGJROUTE",1:N)
|
|
; Followed by Prompts for Routing Locations & Priority
|
|
; Then error messages, if any
|
|
;
|
|
; MAGGRY holds $NA reference to ^TMP where Broker return message is assembled;
|
|
; all references to MAGGRY use subscript indirection
|
|
;
|
|
N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJRT"
|
|
N RARPT,RADFN,RADTI,RACNI
|
|
N DAYCASE,REPLY,CT,MAGS,STARTNOD,DATAOUT,RADATA,MAGSTRT,MAGEND,NEXAM,DIQUIET
|
|
N IDATA,NOGO
|
|
S DIQUIET=1 D DT^DICRW
|
|
S CT=0,NEXAM=0,DATAOUT="",DAYCASE=""
|
|
S NOGO(0)=0 ; array for reply for exams unable to process
|
|
S MAGLST="MAGJROUTE",STARTNOD=1
|
|
K MAGGRY S MAGGRY=$NA(^TMP($J,MAGLST)) K @MAGGRY ; assign MAGGRY value
|
|
S IDATA=""
|
|
F S IDATA=$O(DATA(IDATA)) Q:IDATA="" S DATA=DATA(IDATA) D EXDAT("RTGET")
|
|
I NEXAM D ; have some exams eligible to be routed
|
|
. S @MAGGRY@(STARTNOD)="^Case #^Patient^Procedure^Image Date/Time^Status^Modality"
|
|
. S CT=CT+1,@MAGGRY@(CT+STARTNOD)="*END"
|
|
. S REPLY="1~Route Exams to Selected Locations"
|
|
. D RTLOCS(.CT) D RTPRIOR(.CT)
|
|
E D
|
|
. S REPLY="0~Unable to Route any Exams"
|
|
RTREQZ I NOGO(0) D NOGO("Routed",.CT)
|
|
S @MAGGRY@(0)=NEXAM_U_REPLY
|
|
Q
|
|
;
|
|
;
|
|
EXDAT(GET) ; Put routable exam info in output file, non-routable in NOGO(n)
|
|
S NOGO=0,RARPT=+$P(DATA,U,4)
|
|
S RADFN=$P(DATA,U),RADTI=$P(DATA,U,2),RACNI=$P(DATA,U,3),X=0
|
|
I RADFN,RADTI,RACNI D GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,"",.X)
|
|
I 'X S NOGO="1~Request has Invalid Case Pointer ("_RADFN_U_RADTI_U_RACNI_U_RARPT_")." G EXDATZ
|
|
S RADATA=$G(^TMP($J,"MAGRAEX",1,1)) K ^TMP($J,"MAGRAEX")
|
|
S RARPT=$P(RADATA,U,10),DAYCASE=$P(RADATA,U,12)
|
|
S DATAOUT="" D @GET
|
|
EXDATZ I NOGO D
|
|
. S NOGO(0)=NOGO(0)+1,NOGO(NOGO(0))=$P(NOGO,"~",2,99)
|
|
E D
|
|
. S DATAOUT=U_DATAOUT_"|"_RADFN_U_RADTI_U_RACNI_U_RARPT_"||"
|
|
. S NEXAM=NEXAM+1,CT=CT+1,@MAGGRY@(CT+STARTNOD)=DATAOUT
|
|
Q
|
|
;
|
|
RTGET ;GET code for Demand Routing function
|
|
; get data for exams (DATAOUT), or reason for error (NOGO)
|
|
N IMAG,MAGIEN,MDL,MAGS
|
|
S X=$$JBFETCH^MAGJUTL2(RARPT,.MAGS) ; ? route only if NOT on Jukebox
|
|
I +X S NOGO="2~Case #"_DAYCASE_"--Images have been requested from Jukebox; try again later." Q
|
|
I '$P(X,U,2) S NOGO="3~Case #"_DAYCASE_"--No Images exist for exam." Q
|
|
F IMAG=1:1 S MAGIEN=$P($G(MAGS(IMAG)),U,4) Q:MAGIEN="" D Q:MDL]""
|
|
. S MDL=$P(MAGS(IMAG),U,3)
|
|
. I MDL="DR" S MDL="CR" ; for now, hard code cx of non-standard code
|
|
; Contents of DATAOUT=
|
|
; DAYCASE ^ Pt Name ^ Proc. Name ^ Exam Date/Time ^ Status ^ MDL
|
|
S DATAOUT=DAYCASE_U_$P(RADATA,U,4)_U_$P(RADATA,U,9)
|
|
S DATAOUT=DATAOUT_U_$$DTTIM($P(RADATA,U,6))_U_$P(RADATA,U,14)_U_MDL
|
|
Q
|
|
;
|
|
DTTIM(X) ; Format Image Date/Time
|
|
N T S T=$L(X," "),X=$P(X," ",1,T-1)_"@"_$P(X," ",T)
|
|
Q X
|
|
;
|
|
RTLOCS(CT) ; define prompts for Routing Locations
|
|
;DROP-Down List, Default=[Do Not Route], Enable Auto-fill (if>1 exam)
|
|
N AUTOFILL,T,X,OK,TMP
|
|
S AUTOFILL=$S($G(NEXAM)>1:"AUTOFILL",1:"")
|
|
S CT=CT+1,@MAGGRY@(CT+STARTNOD)="*PROMPT"
|
|
S CT=CT+1,@MAGGRY@(CT+STARTNOD)="DROP^Route To^"_AUTOFILL_"^[Do Not Route]"
|
|
S T=0
|
|
S CT=CT+1,@MAGGRY@(CT+STARTNOD)="0^[Do Not Route]"
|
|
K TMP S TMP=0 D RTLOCS1(.TMP,.OK)
|
|
F I=1:1:TMP S CT=CT+1,@MAGGRY@(CT+STARTNOD)=TMP(I)
|
|
S CT=CT+1,@MAGGRY@(CT+STARTNOD)="*END"
|
|
Q
|
|
;
|
|
RTLOCS1(RET,OK) ; return:
|
|
; RET = array of loc'ns screened by sec key
|
|
; OK = Non-dcm ^ dcm Truth value for user may route respective routing types
|
|
S RET=0,OK=""
|
|
I $D(MAGJOB("KEYS","MAGJ DEMAND ROUTE")) D
|
|
. N T S T=0
|
|
. F S T=$O(^MAG(2005.2,T)) Q:'T S X=$G(^(T,0)) I X]"" D
|
|
.. Q:'$P(X,U,9) ; Not a routable location
|
|
.. Q:'$P(X,U,6) ; OPERATIONAL STATUS not On-Line
|
|
.. Q:'($P(X,U,7)="MAG") ; Storage Type not Magnetic
|
|
.. S X=$P(X,U),OK=OK+1
|
|
.. S RET=RET+1,RET(RET)=T_U_X
|
|
; dicom destinations: assume that all are "active"
|
|
I $D(MAGJOB("KEYS","MAGJ DEMAND ROUTE DICOM")) D
|
|
. N DCM
|
|
. D DCMLIST^MAGBRTUT(.DCM,DUZ(2))
|
|
. I +$G(DCM(1)) S $P(OK,U,2)=+$G(DCM(1))
|
|
. 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)
|
|
Q
|
|
;
|
|
RTPRIOR(CT) ; define prompts for Routing Priorities
|
|
;DROP-Down List, Default=Medium, Enable Auto-fill (if>1 exam)
|
|
N AUTOFILL
|
|
S AUTOFILL=$S($G(NEXAM)>1:"AUTOFILL",1:"")
|
|
S CT=CT+1,@MAGGRY@(CT+STARTNOD)="*PROMPT"
|
|
S CT=CT+1,@MAGGRY@(CT+STARTNOD)="DROP^Priority^"_AUTOFILL_"^Medium"
|
|
S CT=CT+1,@MAGGRY@(CT+STARTNOD)="900^STAT"
|
|
S CT=CT+1,@MAGGRY@(CT+STARTNOD)="750^High"
|
|
S CT=CT+1,@MAGGRY@(CT+STARTNOD)="500^Medium"
|
|
S CT=CT+1,@MAGGRY@(CT+STARTNOD)="250^Low"
|
|
S CT=CT+1,@MAGGRY@(CT+STARTNOD)="*END"
|
|
Q
|
|
;
|
|
NOGO(HDR,CT) ; output error msgs for exams
|
|
Q:'NOGO(0)
|
|
S CT=CT+1,@MAGGRY@(CT+STARTNOD)="*ERROR"
|
|
S CT=CT+1,@MAGGRY@(CT+STARTNOD)=NOGO(0)_" Exams Not Able to be "_HDR
|
|
F I=1:1:NOGO(0) S CT=CT+1,@MAGGRY@(CT+STARTNOD)=NOGO(I)
|
|
S CT=CT+1,@MAGGRY@(CT+STARTNOD)="*END"
|
|
Q
|
|
;
|
|
; 1 RADFN RADTI RACNI RANME RASSN <-- from GETEXAM
|
|
; 6 RADATE RADTE RACN RAPRC RARPT (=RADATA)
|
|
; 11 RAST DAYCASE RAELOC RASTP RASTORD
|
|
; 16 RADTPRT RACPT
|
|
;
|
|
RTEXAM(MAGGRY,DATA) ; RPC: MAGJ ROUTE EXAMS
|
|
; queue images to route according to input requests
|
|
; input in DATA(1:n), list of exams to route:
|
|
; Destination Network Loc'n ^ Priority | RADFN ^ RADTI ^ RACNI ^ RARPT
|
|
; Returns: Reply status in ^TMP($J,"MAGJROUTE",1:N)
|
|
; Then error messages for each exam if applicable
|
|
;
|
|
; MAGGRY holds $NA reference to ^TMP where Broker return message is assembled;
|
|
; all references to MAGGRY use subscript indirection
|
|
;
|
|
; MAGS = # Images stored for the case
|
|
; MAGS(1:n) = 1/0 ^ FULL/BIG ^ Mod ^ ien ^ Series ^ Routed-to Locations
|
|
; (1=Image is on Magnetic Disk)
|
|
;
|
|
N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJRT"
|
|
N IEXAM,RTLOC,RTPRI,RARPT,IDATA,REPLY,CT,MAGS,STARTNOD,NEXAM,NOGO
|
|
N IMAG,MAGLST,MAGIEN,RTTYP,DIQUIET
|
|
S DIQUIET=1 D DT^DICRW
|
|
K NOGO S NOGO(0)=0 ; array for reply for exams unable to process
|
|
S MAGLST="MAGJROUTE",CT=0,STARTNOD=0,NEXAM=0
|
|
K MAGGRY S MAGGRY=$NA(^TMP($J,MAGLST)) K @MAGGRY ; assign MAGGRY value
|
|
S IDATA=""
|
|
F S IDATA=$O(DATA(IDATA)) Q:IDATA="" D
|
|
. S X=DATA(IDATA),DATA=$P(X,"|",2),X=$P(X,"|"),RTLOC=$P(X,U),RTPRI=$P(X,U,2)
|
|
. S RTTYP=$S(RTLOC=+RTLOC:1,1:2),RTLOC=+RTLOC ; 1=DOS; 2=Dicom
|
|
. I 'RTLOC Q ; routing cancelled for this exam
|
|
. S RARPT=$P(DATA,U,4) I 'RARPT D Q
|
|
. . S NOGO(0)=NOGO(0)+1,NOGO(NOGO(0))="Exam not queued: Missing exam pointer information for exam ("_DATA(IDATA)_")"
|
|
. S X=$$JBFETCH^MAGJUTL2(RARPT,.MAGS)
|
|
. F IMAG=1:1 S MAGIEN=$P($G(MAGS(IMAG)),U,4) Q:MAGIEN="" D
|
|
. . D SEND^MAGBRTUT(MAGIEN,RTLOC,RTPRI,RTTYP)
|
|
. I IMAG>1 S NEXAM=NEXAM+1
|
|
. E S NOGO(0)=NOGO(0)+1,NOGO(NOGO(0))="Exam not queued: No images found ("_DATA(IDATA)_")"
|
|
I NEXAM S REPLY=1_"~"_NEXAM_" Exam"_$S(NEXAM-1:"s",1:"")_" were queued to be routed."
|
|
E S REPLY="0~Unable to queue any exams for routing."
|
|
RTEXAMZ I NOGO(0) D NOGO("Queued",.CT)
|
|
S @MAGGRY@(0)=$S(NOGO(0):CT,1:0)_U_REPLY
|
|
Q
|
|
;
|
|
END Q
|
|
;
|