- 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 Feb 18, 2025@23:33:18 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