MAGJLST1 ;WIRMFO/JHC - VistARad RPC calls ; 10/17/2022
;;3.0;IMAGING;**16,22,18,65,76,101,90,120,341**;Dec 21, 2022;Build 28
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | 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. |
;; +---------------------------------------------------------------+
;;
;; ISI IMAGING;**99,101,103,106**
Q
;
; Subroutines for fetching Patient Exam Info
; PTLIST -- list subset of all exams for a patient
; RPC Call: MAGJ PTRADEXAMS
; PTLSTALL -- list ALL exams for a patient
; RPC Call: MAGJ PT ALL EXAMS
; FACLIST -- get Treating Facility List for a patient
; RPC Call: MAGJ GET TREATING LIST
;
Q
ERR N ERR S ERR=$$EC^%ZOSV S ^TMP($J,"RET",0)="0^4~"_ERR
S MAGGRY=$NA(^TMP($J,"RET"))
D @^%ZOSF("ERRTN")
Q:$Q 1 Q
;
PTLSTALL(MAGGRY,DATA) ; List ALL exams for a patient
; MAGGRY - indirect reference to return array of exams for a patient
; DATA -- DFN ^ BEGDT ^ ONESHOT
; --> see PTLIST comments
; RPC is MAGJ PT ALL EXAMS
N PARAM
S PARAM=$P(DATA,U)_"^^^"_$P(DATA,U,2,3)
D PTLIST(.MAGGRY,PARAM)
Q
;
PTLIST(MAGGRY,DATA) ; get list of exams for a patient
;
; MAGGRY - indirect reference to return array of exams for a patient
; DATA -- DFN ^ unused ^ unused ^ BEGDT ^ ONESHOT
; DFN--Required; Patient's DFN
; BEGDT--Optional; Begin date for exam fetch (see below)
; ONESHOT--Optional; Number days back to search, return all records in one fell swoop
; Returns data in ^TMP($J,"MAGRAEX",0:n)
; RPC Call: MAGJ PTRADEXAMS
;
; Client retrieves ALL exams using multiple RPC calls to
; incrementally build the list; this is to provide all the data, but without
; incurring any long pauses to provide the info to the user.
; The algorithm fetches RAD data in one-year chunks, and repeats
; until over 20 exams have been processed, at which point the RPC reply
; is posted, along with the last date processed; this value is then used for
; a subsequent RPC call (BEGDT) to get the next chunk of the record; etc. till all done.
; * ONESHOT overrides the incremental algorithm, returning all desired data in a single call.
;
N CNT,DFN,ISS,PATNAME,DIQUIET,MAGRACNT,MAGRET,REPLY,REMOTE
N DAYCASE,DIV,EXCAT,MAGDT,XX,XX2,WHOLOCK,MODALITY,MYLOCK,PLACE,ENDLOOP
N LIMEXAMS,BEGDT,SAVBEGDT,ENDDT,MORE,RDRIST,PSSN,CPT
N CURPRIO,STATUS,RARPT,KEY,X2,REMOTE2,ONESHOT,LIMDAYS
N IMGCNT,LRFLAG,MSG,ONL,PROCMOD,RASTCAT,RASTORD,STATPRIORITY,SNDREMOT
N ASIGINI,ASIGENA,ASIGDUZ,XX9 ; ISI
N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJLST1"
S DIQUIET=1 D DT^DICRW
S BEGDT=$P(DATA,U,4),ONESHOT=$P(DATA,U,5)
K MAGGRY S DFN=+DATA
S SNDREMOT=+$P($G(^MAG(2006.69,1,0)),U,11)
S ASIGENA=$P($G(^MAG(2006.69,1,"ISI")),U,1)="Y" ; ISI
S MAGRACNT=1,CNT=0 K ^TMP($J,"MAGRAEX"),^("MAGRAEX2")
S REPLY="0^4~Compiling list of Radiology Exams."
I DFN,$D(^DPT(DFN,0)) S PATNAME=$P(^(0),U) D
. D PID^VADPT6 S PSSN=$S(VAERR:"Unknown",1:VA("PID"))
. K VA("PID"),VA("BID"),VAERR
. S ENDLOOP=0,BEGDT=$S(+BEGDT:BEGDT,1:"")
. F D Q:'MORE Q:ENDLOOP S BEGDT=MORE+1
. . I 'BEGDT S BEGDT=DT,X2=0
. . E S X2=-1
. . S LIMDAYS=365,MORE=1
. . I ONESHOT,(ONESHOT>0) S LIMDAYS=+ONESHOT
. . S ENDDT=$$FMADD^XLFDT(BEGDT,X2)
. . S BEGDT=$$FMADD^XLFDT(ENDDT,-LIMDAYS)
. . D GETEXAM3^MAGJUTL1(DFN,BEGDT,ENDDT,.MAGRACNT,.MAGRET,.MORE)
. . S ENDLOOP=(MAGRACNT>20)!+ONESHOT ; For testing only, use >8
. I 'MORE S SAVBEGDT=0
. E S SAVBEGDT=MORE+1 ; adding 1 correctly inits value for subseqent call
. I MAGRACNT>1 D PTLOOP
E S REPLY="0^4~Invalid Radiology Patient"
I MAGRACNT<2 S:(REPLY["Compiling") REPLY="0^2~Radiology Exams for: "_PATNAME
I CNT!(REPLY["2~Radiology Exams") D
. I 'MORE S MSG=""
. E S MORE=$$FMTE^XLFDT(MORE) S MSG="Patient has more exams on file."
. ; show SSN only if the user is a radiologist
. S X=+MAGJOB("USER",1)
. I '(X=12!(X=15)),(PSSN?3N1"-"2N1"-"4N) S PSSN=$E(PATNAME)_$P(PSSN,"-",3)
. S PSSN=" ("_PSSN_")"
. I CNT S REPLY=CNT_"^1~Radiology Exams for: "_PATNAME_PSSN_$S(MSG="":"",1:" -- "_MSG)
. E S REPLY=REPLY_$S(MSG="":"",1:" -- "_MSG)
. S X="^Day/Case~S3~1^Lock~~2^Procedure~~6^Modifier~~25^Image Date/Time~S1~7^Status~~8^# Img~S2~9^Onl~~10^"_$S(SNDREMOT:"RC~~12^",1:"")_"Site~~23^Mod~~15" ; ISI
. S ^TMP($J,"MAGRAEX2",1)=X_$S(ASIGENA:"^Assign~~201",1:"")_"^Interp By~~20^Imaging Loc~~11^CPT~~27" ; ISI Assign
S $P(REPLY,"|",2)=SAVBEGDT
S ^TMP($J,"MAGRAEX2",0)=REPLY
S MAGGRY=$NA(^TMP($J,"MAGRAEX2"))
K ^TMP($J,"RAE1"),^("MAGRAEX")
Q
;
PTLOOP ; loop through exam data & package it for VRAD use
S ISS=0
F S ISS=$O(^TMP($J,"MAGRAEX",ISS)) Q:'ISS S XX=^(ISS,1),XX2=^(2),XX9=$G(^("ISI")) D ; ISI
. S CNT=CNT+1,RARPT=$P(XX,U,10)
. D IMGINFO^MAGJUTL2(RARPT,.Y)
. S IMGCNT=$P(Y,U),ONL=$P(Y,U,2),MAGDT=$P(Y,U,3),REMOTE=$P(Y,U,4),MODALITY=$P(Y,U,5),PLACE=$P(Y,U,6),KEY=$P(Y,U,7)
. S REMOTE2=REMOTE
. S:PLACE PLACE=$P($G(^MAG(2006.1,PLACE,0)),U,9)
. I REMOTE D
. . S T="" F I=1:1:$L(REMOTE,",") S T=T_$S(T="":"",1:",")_$P($G(^MAG(2005.2,$P(REMOTE,",",I),3)),U,5)
. . S REMOTE=T
. S DIV="",X=$P(XX2,U,5) I X'=DUZ(2) S DIV=$$STATN(X)
. I MAGDT="" S MAGDT=$P(XX,U,7)
. S MAGDT=$$FMTE^XLFDT(MAGDT,"5Z")
. S WHOLOCK=RARPT,MYLOCK="",DAYCASE=$P(XX,U,12)
. I WHOLOCK]"" S T=$$CHKLOCK^MAGJLS2B(WHOLOCK,DAYCASE),WHOLOCK=$P(T,U),MYLOCK=$P(T,U,2)
. S RDRIST=$P(XX2,U,3),PROCMOD=$P(XX2,U,8),CPT=$P(XX,U,17),RASTORD=$P(XX,U,15)
. S ASIGINI=$P(XX9,U,1),ASIGDUZ=$P(XX9,U,3) ; ISI
. S Y=U_DAYCASE_U_WHOLOCK_U_$E($P(XX,U,9),1,26)_U_PROCMOD_U_MAGDT_U_$E($P(XX,U,14),1,16)_U_IMGCNT_U_ONL
. I SNDREMOT S Y=Y_U_REMOTE
. S Y=Y_U_PLACE_U_MODALITY_$S(ASIGENA:U_ASIGINI,1:"")_U_RDRIST_U_$E($P(XX,U,13),1,11)_U_CPT ; ISI asigini
. S STATUS=$P(XX,U,11),EXCAT="",CURPRIO=0,RASTCAT=$P(XX2,U,11),LRFLAG=$P(XX2,U,12)
. I ASIGENA D ; ISI <*> Special case, for PtList ONLY! Exam is NOT locked, but assigned to someone else,
. . I ASIGINI]"",(MYLOCK="") I '$$ASIGME^ISIJUTL1(ASIGDUZ) S MYLOCK=0 ; flags client to NOT Allow Dictate option
. I STATUS]"" D
. . S EXCAT=RASTCAT
. . I RASTORD<2!(EXCAT="W")!(EXCAT="R")!('IMGCNT) S CURPRIO=0 ; Cancelled/Waiting/No images: Ignore exam ; ISI P106
. . E I EXCAT="E" S CURPRIO=1 ; Examined="Current" exam
. . E S CURPRIO=2 ; must be a "prior" exam
. . I CURPRIO,'(ONL="Y") S CURPRIO=3 ; images on jukebox
. . I RASTORD=9 S EXCAT="C" ; Complete
. . E I EXCAT="D"!(EXCAT="T") S EXCAT="I" ; just display one value meaning Interpreted
. S STATPRIORITY=0 ; in the Pt list, this is only a placeholder in next line, to sync with svmag2a, etc.
. S ^TMP($J,"MAGRAEX2",ISS)=Y_"^|"_$P(XX,U,1,3)_U_RARPT_"||"_EXCAT_U_WHOLOCK_U_MYLOCK_U_MODALITY_U_CPT_U_CURPRIO_U_RARPT_U_KEY_U_REMOTE2_U_LRFLAG_U_STATPRIORITY
. ; * Note: Keep Pipe-pieces in sync with svmag2a^magjls3 & lstout^magjls2b *
Q
;
STATN(X) ; get station #, else return input value
N T
I X]"" D GETS^DIQ(4,X,99,"E","T") S T=$G(T(4,X_",",99,"E")) I T]"" S X=T
Q X
;
FACLIST(MAGGRY,DATA) ; get Treating Facility List for a patient
; RPC Call: MAGJ GET TREATING LIST
; MAGGRY -- return array--supplied by TFL^VAFCTFU1
; Input: DATA -- Patient DFN
; Returns:
; Array; first entry contains result header with # lines to follow
; and reply message description.
; Entries 2:N (if any exist) contain data for each Treating facility
; up-caret delimited : A ^ B ^ C ^ D ^ E
; A: Institution IEN of the Facility
; B: Institution Name
; C: Current date on record for that institution
; D: ADT/HL7 event reason
; E: FACILITY TYPE
; Note--see TFL^VAFCTFU1 for further details
;
N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJLST1"
S DIQUIET=1 D DT^DICRW
N DFN
K MAGGRY S DFN=+$G(DATA)
S REPLY="0^4~Compiling list of Treating Facilities."
I DFN
E S REPLY="0^4~Invalid Radiology Patient" G FACLISTZ
D TFL^VAFCTFU1(.MAGGRY,DFN) ; ICR 2990
I $D(MAGGRY)<10 S REPLY="0^4~No results available." G FACLISTZ
E I +MAGGRY(1)=-1 S REPLY="0^2~"_$P(MAGGRY(1),U,2) K MAGGRY(1) G FACLISTZ
S REPLY=$O(MAGGRY(""),-1)_U_"1~Treating facilities returned"
FACLISTZ S MAGGRY(0)=REPLY
Q
;
END Q ;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGJLST1 9016 printed Sep 23, 2025@19:43:06 Page 2
MAGJLST1 ;WIRMFO/JHC - VistARad RPC calls ; 10/17/2022
+1 ;;3.0;IMAGING;**16,22,18,65,76,101,90,120,341**;Dec 21, 2022;Build 28
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+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 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 ;; ISI IMAGING;**99,101,103,106**
+18 QUIT
+19 ;
+20 ; Subroutines for fetching Patient Exam Info
+21 ; PTLIST -- list subset of all exams for a patient
+22 ; RPC Call: MAGJ PTRADEXAMS
+23 ; PTLSTALL -- list ALL exams for a patient
+24 ; RPC Call: MAGJ PT ALL EXAMS
+25 ; FACLIST -- get Treating Facility List for a patient
+26 ; RPC Call: MAGJ GET TREATING LIST
+27 ;
+28 QUIT
ERR NEW ERR
SET ERR=$$EC^%ZOSV
SET ^TMP($JOB,"RET",0)="0^4~"_ERR
+1 SET MAGGRY=$NAME(^TMP($JOB,"RET"))
+2 DO @^%ZOSF("ERRTN")
+3 if $QUIT
QUIT 1
QUIT
+4 ;
PTLSTALL(MAGGRY,DATA) ; List ALL exams for a patient
+1 ; MAGGRY - indirect reference to return array of exams for a patient
+2 ; DATA -- DFN ^ BEGDT ^ ONESHOT
+3 ; --> see PTLIST comments
+4 ; RPC is MAGJ PT ALL EXAMS
+5 NEW PARAM
+6 SET PARAM=$PIECE(DATA,U)_"^^^"_$PIECE(DATA,U,2,3)
+7 DO PTLIST(.MAGGRY,PARAM)
+8 QUIT
+9 ;
PTLIST(MAGGRY,DATA) ; get list of exams for a patient
+1 ;
+2 ; MAGGRY - indirect reference to return array of exams for a patient
+3 ; DATA -- DFN ^ unused ^ unused ^ BEGDT ^ ONESHOT
+4 ; DFN--Required; Patient's DFN
+5 ; BEGDT--Optional; Begin date for exam fetch (see below)
+6 ; ONESHOT--Optional; Number days back to search, return all records in one fell swoop
+7 ; Returns data in ^TMP($J,"MAGRAEX",0:n)
+8 ; RPC Call: MAGJ PTRADEXAMS
+9 ;
+10 ; Client retrieves ALL exams using multiple RPC calls to
+11 ; incrementally build the list; this is to provide all the data, but without
+12 ; incurring any long pauses to provide the info to the user.
+13 ; The algorithm fetches RAD data in one-year chunks, and repeats
+14 ; until over 20 exams have been processed, at which point the RPC reply
+15 ; is posted, along with the last date processed; this value is then used for
+16 ; a subsequent RPC call (BEGDT) to get the next chunk of the record; etc. till all done.
+17 ; * ONESHOT overrides the incremental algorithm, returning all desired data in a single call.
+18 ;
+19 NEW CNT,DFN,ISS,PATNAME,DIQUIET,MAGRACNT,MAGRET,REPLY,REMOTE
+20 NEW DAYCASE,DIV,EXCAT,MAGDT,XX,XX2,WHOLOCK,MODALITY,MYLOCK,PLACE,ENDLOOP
+21 NEW LIMEXAMS,BEGDT,SAVBEGDT,ENDDT,MORE,RDRIST,PSSN,CPT
+22 NEW CURPRIO,STATUS,RARPT,KEY,X2,REMOTE2,ONESHOT,LIMDAYS
+23 NEW IMGCNT,LRFLAG,MSG,ONL,PROCMOD,RASTCAT,RASTORD,STATPRIORITY,SNDREMOT
+24 ; ISI
NEW ASIGINI,ASIGENA,ASIGDUZ,XX9
+25 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR^MAGJLST1"
+26 SET DIQUIET=1
DO DT^DICRW
+27 SET BEGDT=$PIECE(DATA,U,4)
SET ONESHOT=$PIECE(DATA,U,5)
+28 KILL MAGGRY
SET DFN=+DATA
+29 SET SNDREMOT=+$PIECE($GET(^MAG(2006.69,1,0)),U,11)
+30 ; ISI
SET ASIGENA=$PIECE($GET(^MAG(2006.69,1,"ISI")),U,1)="Y"
+31 SET MAGRACNT=1
SET CNT=0
KILL ^TMP($JOB,"MAGRAEX"),^("MAGRAEX2")
+32 SET REPLY="0^4~Compiling list of Radiology Exams."
+33 IF DFN
IF $DATA(^DPT(DFN,0))
SET PATNAME=$PIECE(^(0),U)
Begin DoDot:1
+34 DO PID^VADPT6
SET PSSN=$SELECT(VAERR:"Unknown",1:VA("PID"))
+35 KILL VA("PID"),VA("BID"),VAERR
+36 SET ENDLOOP=0
SET BEGDT=$SELECT(+BEGDT:BEGDT,1:"")
+37 FOR
Begin DoDot:2
+38 IF 'BEGDT
SET BEGDT=DT
SET X2=0
+39 IF '$TEST
SET X2=-1
+40 SET LIMDAYS=365
SET MORE=1
+41 IF ONESHOT
IF (ONESHOT>0)
SET LIMDAYS=+ONESHOT
+42 SET ENDDT=$$FMADD^XLFDT(BEGDT,X2)
+43 SET BEGDT=$$FMADD^XLFDT(ENDDT,-LIMDAYS)
+44 DO GETEXAM3^MAGJUTL1(DFN,BEGDT,ENDDT,.MAGRACNT,.MAGRET,.MORE)
+45 ; For testing only, use >8
SET ENDLOOP=(MAGRACNT>20)!+ONESHOT
End DoDot:2
if 'MORE
QUIT
if ENDLOOP
QUIT
SET BEGDT=MORE+1
+46 IF 'MORE
SET SAVBEGDT=0
+47 ; adding 1 correctly inits value for subseqent call
IF '$TEST
SET SAVBEGDT=MORE+1
+48 IF MAGRACNT>1
DO PTLOOP
End DoDot:1
+49 IF '$TEST
SET REPLY="0^4~Invalid Radiology Patient"
+50 IF MAGRACNT<2
if (REPLY["Compiling")
SET REPLY="0^2~Radiology Exams for: "_PATNAME
+51 IF CNT!(REPLY["2~Radiology Exams")
Begin DoDot:1
+52 IF 'MORE
SET MSG=""
+53 IF '$TEST
SET MORE=$$FMTE^XLFDT(MORE)
SET MSG="Patient has more exams on file."
+54 ; show SSN only if the user is a radiologist
+55 SET X=+MAGJOB("USER",1)
+56 IF '(X=12!(X=15))
IF (PSSN?3N1"-"2N1"-"4N)
SET PSSN=$EXTRACT(PATNAME)_$PIECE(PSSN,"-",3)
+57 SET PSSN=" ("_PSSN_")"
+58 IF CNT
SET REPLY=CNT_"^1~Radiology Exams for: "_PATNAME_PSSN_$SELECT(MSG="":"",1:" -- "_MSG)
+59 IF '$TEST
SET REPLY=REPLY_$SELECT(MSG="":"",1:" -- "_MSG)
+60 ; ISI
SET X="^Day/Case~S3~1^Lock~~2^Procedure~~6^Modifier~~25^Image Date/Time~S1~7^Status~~8^# Img~S2~9^Onl~~10^"_$SELECT(SNDREMOT:"RC~~12^",1:"")_"Site~~23^Mod~~15"
+61 ; ISI Assign
SET ^TMP($JOB,"MAGRAEX2",1)=X_$SELECT(ASIGENA:"^Assign~~201",1:"")_"^Interp By~~20^Imaging Loc~~11^CPT~~27"
End DoDot:1
+62 SET $PIECE(REPLY,"|",2)=SAVBEGDT
+63 SET ^TMP($JOB,"MAGRAEX2",0)=REPLY
+64 SET MAGGRY=$NAME(^TMP($JOB,"MAGRAEX2"))
+65 KILL ^TMP($JOB,"RAE1"),^("MAGRAEX")
+66 QUIT
+67 ;
PTLOOP ; loop through exam data & package it for VRAD use
+1 SET ISS=0
+2 ; ISI
FOR
SET ISS=$ORDER(^TMP($JOB,"MAGRAEX",ISS))
if 'ISS
QUIT
SET XX=^(ISS,1)
SET XX2=^(2)
SET XX9=$GET(^("ISI"))
Begin DoDot:1
+3 SET CNT=CNT+1
SET RARPT=$PIECE(XX,U,10)
+4 DO IMGINFO^MAGJUTL2(RARPT,.Y)
+5 SET IMGCNT=$PIECE(Y,U)
SET ONL=$PIECE(Y,U,2)
SET MAGDT=$PIECE(Y,U,3)
SET REMOTE=$PIECE(Y,U,4)
SET MODALITY=$PIECE(Y,U,5)
SET PLACE=$PIECE(Y,U,6)
SET KEY=$PIECE(Y,U,7)
+6 SET REMOTE2=REMOTE
+7 if PLACE
SET PLACE=$PIECE($GET(^MAG(2006.1,PLACE,0)),U,9)
+8 IF REMOTE
Begin DoDot:2
+9 SET T=""
FOR I=1:1:$LENGTH(REMOTE,",")
SET T=T_$SELECT(T="":"",1:",")_$PIECE($GET(^MAG(2005.2,$PIECE(REMOTE,",",I),3)),U,5)
+10 SET REMOTE=T
End DoDot:2
+11 SET DIV=""
SET X=$PIECE(XX2,U,5)
IF X'=DUZ(2)
SET DIV=$$STATN(X)
+12 IF MAGDT=""
SET MAGDT=$PIECE(XX,U,7)
+13 SET MAGDT=$$FMTE^XLFDT(MAGDT,"5Z")
+14 SET WHOLOCK=RARPT
SET MYLOCK=""
SET DAYCASE=$PIECE(XX,U,12)
+15 IF WHOLOCK]""
SET T=$$CHKLOCK^MAGJLS2B(WHOLOCK,DAYCASE)
SET WHOLOCK=$PIECE(T,U)
SET MYLOCK=$PIECE(T,U,2)
+16 SET RDRIST=$PIECE(XX2,U,3)
SET PROCMOD=$PIECE(XX2,U,8)
SET CPT=$PIECE(XX,U,17)
SET RASTORD=$PIECE(XX,U,15)
+17 ; ISI
SET ASIGINI=$PIECE(XX9,U,1)
SET ASIGDUZ=$PIECE(XX9,U,3)
+18 SET Y=U_DAYCASE_U_WHOLOCK_U_$EXTRACT($PIECE(XX,U,9),1,26)_U_PROCMOD_U_MAGDT_U_$EXTRACT($PIECE(XX,U,14),1,16)_U_IMGCNT_U_ONL
+19 IF SNDREMOT
SET Y=Y_U_REMOTE
+20 ; ISI asigini
SET Y=Y_U_PLACE_U_MODALITY_$SELECT(ASIGENA:U_ASIGINI,1:"")_U_RDRIST_U_$EXTRACT($PIECE(XX,U,13),1,11)_U_CPT
+21 SET STATUS=$PIECE(XX,U,11)
SET EXCAT=""
SET CURPRIO=0
SET RASTCAT=$PIECE(XX2,U,11)
SET LRFLAG=$PIECE(XX2,U,12)
+22 ; ISI <*> Special case, for PtList ONLY! Exam is NOT locked, but assigned to someone else,
IF ASIGENA
Begin DoDot:2
+23 ; flags client to NOT Allow Dictate option
IF ASIGINI]""
IF (MYLOCK="")
IF '$$ASIGME^ISIJUTL1(ASIGDUZ)
SET MYLOCK=0
End DoDot:2
+24 IF STATUS]""
Begin DoDot:2
+25 SET EXCAT=RASTCAT
+26 ; Cancelled/Waiting/No images: Ignore exam ; ISI P106
IF RASTORD<2!(EXCAT="W")!(EXCAT="R")!('IMGCNT)
SET CURPRIO=0
+27 ; Examined="Current" exam
IF '$TEST
IF EXCAT="E"
SET CURPRIO=1
+28 ; must be a "prior" exam
IF '$TEST
SET CURPRIO=2
+29 ; images on jukebox
IF CURPRIO
IF '(ONL="Y")
SET CURPRIO=3
+30 ; Complete
IF RASTORD=9
SET EXCAT="C"
+31 ; just display one value meaning Interpreted
IF '$TEST
IF EXCAT="D"!(EXCAT="T")
SET EXCAT="I"
End DoDot:2
+32 ; in the Pt list, this is only a placeholder in next line, to sync with svmag2a, etc.
SET STATPRIORITY=0
+33 SET ^TMP($JOB,"MAGRAEX2",ISS)=Y_"^|"_$PIECE(XX,U,1,3)_U_RARPT_"||"_EXCAT_U_WHOLOCK_U_MYLOCK_U_MODALITY_U_CPT_U_CURPRIO_U_RARPT_U_KEY_U_REMOTE2_U_LRFLAG_U_STATPRIORITY
+34 ; * Note: Keep Pipe-pieces in sync with svmag2a^magjls3 & lstout^magjls2b *
End DoDot:1
+35 QUIT
+36 ;
STATN(X) ; get station #, else return input value
+1 NEW T
+2 IF X]""
DO GETS^DIQ(4,X,99,"E","T")
SET T=$GET(T(4,X_",",99,"E"))
IF T]""
SET X=T
+3 QUIT X
+4 ;
FACLIST(MAGGRY,DATA) ; get Treating Facility List for a patient
+1 ; RPC Call: MAGJ GET TREATING LIST
+2 ; MAGGRY -- return array--supplied by TFL^VAFCTFU1
+3 ; Input: DATA -- Patient DFN
+4 ; Returns:
+5 ; Array; first entry contains result header with # lines to follow
+6 ; and reply message description.
+7 ; Entries 2:N (if any exist) contain data for each Treating facility
+8 ; up-caret delimited : A ^ B ^ C ^ D ^ E
+9 ; A: Institution IEN of the Facility
+10 ; B: Institution Name
+11 ; C: Current date on record for that institution
+12 ; D: ADT/HL7 event reason
+13 ; E: FACILITY TYPE
+14 ; Note--see TFL^VAFCTFU1 for further details
+15 ;
+16 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR^MAGJLST1"
+17 SET DIQUIET=1
DO DT^DICRW
+18 NEW DFN
+19 KILL MAGGRY
SET DFN=+$GET(DATA)
+20 SET REPLY="0^4~Compiling list of Treating Facilities."
+21 IF DFN
+22 IF '$TEST
SET REPLY="0^4~Invalid Radiology Patient"
GOTO FACLISTZ
+23 ; ICR 2990
DO TFL^VAFCTFU1(.MAGGRY,DFN)
+24 IF $DATA(MAGGRY)<10
SET REPLY="0^4~No results available."
GOTO FACLISTZ
+25 IF '$TEST
IF +MAGGRY(1)=-1
SET REPLY="0^2~"_$PIECE(MAGGRY(1),U,2)
KILL MAGGRY(1)
GOTO FACLISTZ
+26 SET REPLY=$ORDER(MAGGRY(""),-1)_U_"1~Treating facilities returned"
FACLISTZ SET MAGGRY(0)=REPLY
+1 QUIT
+2 ;
END ;
QUIT
