| [628] | 1 | MAGJLST1 ;WIRMFO/JHC VistARad RPC calls ; 29 Jul 2003 10:01 AM
|
|---|
| [636] | 2 | ;;3.0;IMAGING;**16,22,18,65**;Jul 27, 2006;Build 28
|
|---|
| [628] | 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;; +---------------------------------------------------------------+
|
|---|
| 5 | ;; | Property of the US Government. |
|
|---|
| 6 | ;; | No permission to copy or redistribute this software is given. |
|
|---|
| 7 | ;; | Use of unreleased versions of this software requires the user |
|
|---|
| 8 | ;; | to execute a written test agreement with the VistA Imaging |
|
|---|
| 9 | ;; | Development Office of the Department of Veterans Affairs, |
|
|---|
| 10 | ;; | telephone (301) 734-0100. |
|
|---|
| 11 | ;; | |
|
|---|
| 12 | ;; | The Food and Drug Administration classifies this software as |
|
|---|
| 13 | ;; | a medical device. As such, it may not be changed in any way. |
|
|---|
| 14 | ;; | Modifications to this software may result in an adulterated |
|
|---|
| 15 | ;; | medical device under 21CFR820, the use of which is considered |
|
|---|
| 16 | ;; | to be a violation of US Federal Statutes. |
|
|---|
| 17 | ;; +---------------------------------------------------------------+
|
|---|
| 18 | ;;
|
|---|
| 19 | Q
|
|---|
| 20 | ;
|
|---|
| 21 | ; Subroutines for fetching Exam Info for Radiology Workstation
|
|---|
| 22 | ; Exam listings:
|
|---|
| 23 | ; PTLIST -- list subset of all exams for a patient
|
|---|
| 24 | ; RPC Call: MAGJ PTRADEXAMS
|
|---|
| 25 | ; PTLSTALL -- list ALL exams for a patient
|
|---|
| 26 | ; RPC Call: MAGJ PT ALL EXAMS
|
|---|
| 27 | ;
|
|---|
| 28 | Q
|
|---|
| 29 | ERR N ERR S ERR=$$EC^%ZOSV S ^TMP($J,"RET",0)="0^4~"_ERR
|
|---|
| 30 | S MAGGRY=$NA(^TMP($J,"RET"))
|
|---|
| 31 | D @^%ZOSF("ERRTN")
|
|---|
| 32 | Q:$Q 1 Q
|
|---|
| 33 | ;
|
|---|
| 34 | PTLSTALL(MAGGRY,DATA) ; List ALL exams for a patient
|
|---|
| 35 | ; RPC is MAGJ PT ALL EXAMS
|
|---|
| 36 | N PARAM
|
|---|
| 37 | I MAGJOB("P32") S PARAM="^99^999"
|
|---|
| 38 | E S PARAM="^^^"_$P(DATA,U,2,3)
|
|---|
| 39 | D PTLIST(.MAGGRY,$P(DATA,U)_PARAM)
|
|---|
| 40 | Q
|
|---|
| 41 | ;
|
|---|
| 42 | PTLIST(MAGGRY,DATA) ; get list of exams for a patient
|
|---|
| 43 | ;
|
|---|
| 44 | ; MAGGRY - indirect reference to return array of exams for a patient
|
|---|
| [636] | 45 | ; DATA - DFN ^ LIMYEARS ^ LIMEXAMS ^ BEGDT
|
|---|
| [628] | 46 | ; DFN--Patient's DFN
|
|---|
| [636] | 47 | ; LIMYRS--Restrict exams up to # Years back
|
|---|
| [628] | 48 | ; LIMEXAMS--Restrict exams up to # of exams
|
|---|
| 49 | ; BEGDT--Begin date for exam fetch (Patch 18 addition--see below)
|
|---|
| 50 | ; Returns data in ^TMP($J,"MAGRAEX",0:n)
|
|---|
| 51 | ; RPC Call: MAGJ PTRADEXAMS
|
|---|
| 52 | ;
|
|---|
| 53 | ; Patch 18 eliminates "Patient Exams" / "All Patient Exams" distinction.
|
|---|
| 54 | ; It always retrieves ALL exams, but uses multiple RPC calls, so the client
|
|---|
| 55 | ; incrementally builds the list; this is to provide all the data, but without
|
|---|
| 56 | ; incurring any long pauses to provide the info to the user.
|
|---|
| 57 | ; Below, the P18 code fetches RAD data in one-year chunks, and repeats
|
|---|
| 58 | ; until over 20 exams have been processed, at which point the RPC reply
|
|---|
| 59 | ; is posted, along with the last date processed; this value is then used for
|
|---|
| 60 | ; a subsequent RPC call to get the next chunk of the record; etc. till all done.
|
|---|
| 61 | ; The P32 code is re-organized, and now exits only for LIMEXAMS (ignore LimYears)
|
|---|
| 62 | ;
|
|---|
| 63 | N CNT,DFN,ISS,PATNAME,DIQUIET,MAGRACNT,MAGRET,REPLY,REMOTE,SNDREMOT
|
|---|
| 64 | N DAYCASE,DIV,EXCAT,MAGDT,XX,XX2,WHOLOCK,MODALITY,MYLOCK,PLACE,ENDLOOP
|
|---|
| [636] | 65 | N LIMYRS,LIMEXAMS,BEGDT,SAVBEGDT,ENDDT,MORE,SHOWPLAC,RDRIST,PSSN,CPT,PARAM
|
|---|
| 66 | N CURPRIO,STATUS,RARPT,KEY,X1,X2,REMOTE2,ONESHOT,LIMDAYS
|
|---|
| [628] | 67 | N IMGCNT,LRFLAG,MSG,ONL,PROCMOD,RASTCAT,RASTORD
|
|---|
| 68 | N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJLST1"
|
|---|
| 69 | S DIQUIET=1 D DT^DICRW
|
|---|
| 70 | S PARAM=$G(^MAG(2006.69,1,0))
|
|---|
| 71 | S SNDREMOT=+$P(PARAM,U,11) ; Site routes images remotely?
|
|---|
| 72 | I MAGJOB("P32") D
|
|---|
| 73 | . S LIMEXAMS=+$P(PARAM,U,15)
|
|---|
| 74 | . S:'LIMEXAMS LIMEXAMS=999 ; default to show ALL Exams
|
|---|
| 75 | . I $P(DATA,U,3) S LIMEXAMS=+$P(DATA,U,3)
|
|---|
| 76 | . I LIMEXAMS<20 S LIMEXAMS=20
|
|---|
| 77 | . S BEGDT=""
|
|---|
| 78 | E S BEGDT=$P(DATA,U,4),ONESHOT=$P(DATA,U,5) ; P65 chg
|
|---|
| 79 | K MAGGRY S DFN=+DATA
|
|---|
| [636] | 80 | ;<*>
|
|---|
| 81 | ; I DUZ=131 G MANYTST^ZMAGJTST ; <*> TEST ONLY !!! 37=RadRes
|
|---|
| 82 | ;<*>
|
|---|
| [628] | 83 | S SHOWPLAC=$$SHOWPLAC^MAGJLS2B("")
|
|---|
| 84 | S MAGRACNT=1,CNT=0 K ^TMP($J,"MAGRAEX"),^("MAGRAEX2")
|
|---|
| 85 | S REPLY="0^4~Compiling list of Radiology Exams."
|
|---|
| 86 | I DFN,$D(^DPT(DFN,0)) S PATNAME=$P(^(0),U),PSSN=$P(^(0),U,9) D
|
|---|
| 87 | . S ENDLOOP=0,BEGDT=$S(+BEGDT:BEGDT,1:"")
|
|---|
| [636] | 88 | . F D Q:'MORE Q:ENDLOOP
|
|---|
| [628] | 89 | . . I 'BEGDT S BEGDT=DT,X2=0
|
|---|
| 90 | . . E S X2=-1
|
|---|
| [636] | 91 | . . S LIMDAYS=365
|
|---|
| 92 | . . I 'MAGJOB("P32"),ONESHOT,(ONESHOT>0) S LIMDAYS=+ONESHOT
|
|---|
| 93 | . . S X1=BEGDT D C^%DTC S (ENDDT,X1)=X,X2=-LIMDAYS D C^%DTC S BEGDT=X K %,%H,%T
|
|---|
| [628] | 94 | . . D GETEXAM3^MAGJUTL1(DFN,BEGDT,ENDDT,.MAGRACNT,.MAGRET,.MORE)
|
|---|
| 95 | . . I MAGJOB("P32") S ENDLOOP=(MAGRACNT>LIMEXAMS)
|
|---|
| 96 | . . E S ENDLOOP=(MAGRACNT>20)!+ONESHOT ; For testing only, use >8
|
|---|
| 97 | . I 'MORE S SAVBEGDT=0
|
|---|
| 98 | . E S SAVBEGDT=MORE+1 ; adding 1 correctly inits value for subseqent call
|
|---|
| 99 | . I MAGRACNT>1 D PTLOOP
|
|---|
| 100 | E S REPLY="0^4~Invalid Radiology Patient"
|
|---|
| 101 | I MAGRACNT<2 S:(REPLY["Compiling") REPLY="0^2~No Exams Found for "_PATNAME
|
|---|
| 102 | I CNT!(REPLY["No Exams Found") D
|
|---|
| 103 | . I 'MORE S MSG="ALL exams are listed."
|
|---|
| 104 | . E S MORE=$$FMTE^XLFDT(MORE) S MSG="Patient has more exams on file."
|
|---|
| 105 | . ; show SSN only if the user is a radiologist
|
|---|
| 106 | . S X=+MAGJOB("USER",1) I '(X=12!(X=15)) S PSSN=""
|
|---|
| 107 | . E S PSSN=" ("_$E(PSSN,1,3)_"-"_$E(PSSN,4,5)_"-"_$E(PSSN,6,9)_")"
|
|---|
| 108 | . I CNT S REPLY=CNT_"^1~Radiology Exams for: "_PATNAME_PSSN_" -- "_MSG
|
|---|
| 109 | . E S REPLY=REPLY_" -- "_MSG
|
|---|
| 110 | . S ^TMP($J,"MAGRAEX2",1)="^Day/Case~S3~1^Lock~~2^Procedure~~6^Modifier~~25^Image Date/Time~S1~7^Status~~8^# Img~S2~9^Onl~~10"_$S($G(SNDREMOT):"^RC~~12",1:"")_$S(SHOWPLAC:"^Site~~23",1:"")_"^Mod~~15^Interp By~~20^Imaging Loc~~11^CPT~~27"
|
|---|
| 111 | I 'MAGJOB("P32") S $P(REPLY,"|",2)=SAVBEGDT
|
|---|
| 112 | S ^TMP($J,"MAGRAEX2",0)=REPLY
|
|---|
| 113 | S MAGGRY=$NA(^TMP($J,"MAGRAEX2"))
|
|---|
| 114 | K ^TMP($J,"RAE1"),^("MAGRAEX")
|
|---|
| 115 | Q
|
|---|
| 116 | ;
|
|---|
| 117 | PTLOOP ; loop through exam data & package it for VRAD use
|
|---|
| 118 | S ISS=0
|
|---|
| 119 | F S ISS=$O(^TMP($J,"MAGRAEX",ISS)) Q:'ISS S XX=^(ISS,1),XX2=^(2) D
|
|---|
| 120 | . S CNT=CNT+1,RARPT=$P(XX,U,10)
|
|---|
| 121 | . D IMGINFO^MAGJUTL2(RARPT,.Y)
|
|---|
| 122 | . 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)
|
|---|
| 123 | . S REMOTE2=REMOTE
|
|---|
| 124 | . S:PLACE PLACE=$P($G(^MAG(2006.1,PLACE,0)),U,9)
|
|---|
| 125 | . I PLACE]"",SHOWPLAC D
|
|---|
| 126 | .. I SHOWPLAC'[(","_PLACE_",") S PLACE="" ; don't show user's logon pl ; <*> chg for p18?
|
|---|
| 127 | . I SNDREMOT,REMOTE D
|
|---|
| 128 | .. 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)
|
|---|
| 129 | .. S REMOTE=T
|
|---|
| 130 | . S DIV="",X=$P(XX2,U,5) I X'=DUZ(2) S DIV=$$STATN(X)
|
|---|
| 131 | . I MAGDT="" S MAGDT=$P(XX,U,7)
|
|---|
| 132 | . S MAGDT=$$FMTE^XLFDT(MAGDT,"5Z")
|
|---|
| 133 | . S WHOLOCK=RARPT,MYLOCK="",DAYCASE=$P(XX,U,12)
|
|---|
| 134 | . I WHOLOCK]"" S T=$$CHKLOCK^MAGJLS2B(WHOLOCK,DAYCASE),WHOLOCK=$P(T,U),MYLOCK=$P(T,U,2)
|
|---|
| 135 | . S RDRIST=$P(XX2,U,3),PROCMOD=$P(XX2,U,8),CPT=$P(XX,U,17),RASTORD=$P(XX,U,15)
|
|---|
| 136 | . 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
|
|---|
| 137 | . I $G(SNDREMOT) S Y=Y_U_REMOTE
|
|---|
| 138 | . S Y=Y_$S(SHOWPLAC:U_PLACE,1:"")_U_MODALITY_U_RDRIST_U_$E($P(XX,U,13),1,11)_U_CPT
|
|---|
| 139 | . S STATUS=$P(XX,U,11),EXCAT="",CURPRIO=0,RASTCAT=$P(XX2,U,11),LRFLAG=$P(XX2,U,12)
|
|---|
| 140 | . I STATUS]"" D
|
|---|
| 141 | . . S EXCAT=RASTCAT
|
|---|
| 142 | . . I RASTORD<2!(EXCAT="W")!('IMGCNT) S CURPRIO=0 ; Cancelled/Waiting/No images: Ignore exam
|
|---|
| 143 | . . E I EXCAT="E" S CURPRIO=1 ; Examined="Current" exam
|
|---|
| 144 | . . E S CURPRIO=2 ; must be a "prior" exam
|
|---|
| 145 | . . I CURPRIO,'(ONL="Y") S CURPRIO=3 ; images on jukebox
|
|---|
| 146 | . . I MAGJOB("P32"),'(EXCAT="E") S EXCAT="" Q ; P32 compat.
|
|---|
| 147 | . . I RASTORD=9 S EXCAT="C" ; Complete
|
|---|
| 148 | . . E I EXCAT="D"!(EXCAT="T") S EXCAT="I" ; just display one value meaning Interpreted
|
|---|
| 149 | . 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
|
|---|
| 150 | . ; * Note: Keep Pipe-pieces in sync with svmag2a^magjls3 & lstout^magjls2b *
|
|---|
| 151 | Q
|
|---|
| 152 | ;
|
|---|
| 153 | STATN(X) ; get station #, else return input value
|
|---|
| 154 | N T
|
|---|
| 155 | I X]"" D GETS^DIQ(4,X,99,"E","T") S T=$G(T(4,X_",",99,"E")) I T]"" S X=T
|
|---|
| 156 | Q X
|
|---|
| 157 | ;
|
|---|
| 158 | END Q ;
|
|---|
