| 1 | MAGJLS3 ;WIRMFO/JHC Rad. Workstation RPC calls ; 29 Jul 2003 10:00 AM
|
|---|
| 2 | ;;3.0;IMAGING;**16,22,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 | ; EPs:
|
|---|
| 20 | ; BLDACTV
|
|---|
| 21 | ;
|
|---|
| 22 | BLDACTV(MAGGRY,DATA,MAGLST) ; get subset of Active Exams; called from MAGJLS2
|
|---|
| 23 | ;MAGGRY - Indirect Global ref of return array
|
|---|
| 24 | ;DATA: Listyp ^ Imaging Types
|
|---|
| 25 | ;Listyp = U -- UNREAD Exams (Status Category=E)
|
|---|
| 26 | ; = R -- RECENT (Sts Cat's D & T)
|
|---|
| 27 | ; = A -- ALL Active (Cat's E, D, & T)
|
|---|
| 28 | ; = P -- PENDING (Cat W)
|
|---|
| 29 | ; = N -- Newly Interpreted Exams (No Cat.-Internal use only)
|
|---|
| 30 | ;ImgTypes = List of Imaging Types to process, or "ALL" for all
|
|---|
| 31 | ; MAGLST = $NA ref to return global; references to it use subscript indirection
|
|---|
| 32 | ; MAGLST optional: input to specify return global to use
|
|---|
| 33 | ;
|
|---|
| 34 | ;* This subrtn can receive U/R/A/P/N (LSTREQ)-- ^_delim list of ImgTypes (IMTYPS)
|
|---|
| 35 | N RADFN,RADTI,RACNI,REMX
|
|---|
| 36 | N HDR,HDRLST,MAGIMGTY,MAGRACNT,MAGRET,LSTREQ,LISTYP,LISCAT,IMTYPS
|
|---|
| 37 | N REPLY,STAT,TYP,SORTMAG,DIQUIET,STATCHK,LASTDT,IMGSONLY,URGORD,REMONLY
|
|---|
| 38 | S DIQUIET=1 D DT^DICRW
|
|---|
| 39 | I $G(MAGLST)="" S MAGLST=$NA(^TMP($J,"MAGJACTIVE")) ; default loc'n if not passed in
|
|---|
| 40 | K ^TMP($J,"MAGRAEX"),@MAGLST
|
|---|
| 41 | S LSTREQ=$P(DATA,U),IMTYPS=$P(DATA,U,2,99)
|
|---|
| 42 | I LSTREQ="U"!(LSTREQ="R")!(LSTREQ="A")!(LSTREQ="P")!(LSTREQ="N")!(LSTREQ="H")
|
|---|
| 43 | E S REPLY="0^4~Invalid Request (List Type="_LSTREQ_")" G BLDACTVZ
|
|---|
| 44 | S MAGRACNT=0
|
|---|
| 45 | S X=$G(^MAG(2006.69,1,0)),IMGSONLY=+$P(X,U,7),REMX=+$P(X,U,10) ; show only exams w/ images?
|
|---|
| 46 | S REMONLY=0
|
|---|
| 47 | I $G(MAGJOB("REMOTE")) D ; ;show remote cache only?
|
|---|
| 48 | . I MAGJOB("P32") S REMONLY=REMX
|
|---|
| 49 | . E Q:(LSTREQ="H") S REMONLY=+$G(MAGJOB("REMOTESCREEN"))
|
|---|
| 50 | S X=$G(^MAG(2006.69,1,1)),URGORD=$P(X,U)
|
|---|
| 51 | S:URGORD="" URGORD="S,U,P,R" S URGORD=$TR(URGORD,",") ; "Priority" sort
|
|---|
| 52 | S HDR=$S(LSTREQ="U":"UNREAD",LSTREQ="R":"RECENT",LSTREQ="P":"PENDING",LSTREQ="A":"UNREAD and RECENT",LSTREQ="N":"NEWLY INTERP",LSTREQ="H":"HISTORY",1:"")_" Exams"_" for IMAGING TYPES: "
|
|---|
| 53 | S LISTYP=$S(LSTREQ="U":"E",LSTREQ="R":"D^T",LSTREQ="A":"E^D^T",LSTREQ="P":"W",LSTREQ="N":"",LSTREQ="H":"",1:"E")
|
|---|
| 54 | S REPLY="0^4~Compiling list of Radiology Exams (ACTIVE)."
|
|---|
| 55 | I $G(BKGPROC),(LSTREQ="R") K ^TMP($J,"NEWINT") S ^TMP($J,"NEWINT")=+$G(^XTMP("MAGJ2","RECENT",0))
|
|---|
| 56 | I LSTREQ="N" D BLDACT2 G BLDACTVZ
|
|---|
| 57 | I LSTREQ="H" D HISTBLD^MAGJLS3A G BLDACTVZ
|
|---|
| 58 | D BLDACT1
|
|---|
| 59 | BLDACTVZ ;
|
|---|
| 60 | I 'MAGRACNT S:(REPLY["Compiling") REPLY="0^2~No Exams Found"
|
|---|
| 61 | E D
|
|---|
| 62 | . I IMTYPS="ALL" S HDR=HDR_" ALL"
|
|---|
| 63 | . E S Y="" F I=0:1 S Y=$O(HDRLST(Y)) Q:Y="" S HDR=HDR_$S('I:"",1:", ")_Y
|
|---|
| 64 | . S REPLY=MAGRACNT_U_"1~"_HDR
|
|---|
| 65 | S @MAGLST@(0,1)=REPLY,^(2)=""
|
|---|
| 66 | K ^TMP($J,"MAGRAEX"),^("RAE1")
|
|---|
| 67 | S MAGGRY=MAGLST
|
|---|
| 68 | Q
|
|---|
| 69 | BLDACT1 ; Compile exams by Status codes
|
|---|
| 70 | D BLDSTAT^MAGJLS3A
|
|---|
| 71 | F S LISCAT=$P(LISTYP,U),LISTYP=$P(LISTYP,U,2,9) Q:LISCAT="" D
|
|---|
| 72 | . I IMTYPS="ALL" S TYP="" D Q
|
|---|
| 73 | .. F S TYP=$O(STAT(LISCAT,TYP)) Q:TYP="" D IMGTYP(LISCAT,TYP)
|
|---|
| 74 | . E I +IMTYPS D IMGTYLST(LISCAT,IMTYPS) Q
|
|---|
| 75 | . E S REPLY="0^4~Invalid Imaging Type"
|
|---|
| 76 | Q
|
|---|
| 77 | BLDACT2 ; Add recently interpreted exams to the "Recent" compile data
|
|---|
| 78 | ; 1st, compile these into their own list
|
|---|
| 79 | N CNT,INDX,RAST,STATCHK,RECLIST,REC,X1,X2
|
|---|
| 80 | S X=$G(^XTMP("MAGJ2","RECENT",0)),INDX=+$P(X,U,2)
|
|---|
| 81 | F S INDX=$O(^XTMP("MAGJ2","RECENT",INDX)) Q:'INDX S X=^(INDX) D
|
|---|
| 82 | . S RADFN=$P(X,U),RADTI=$P(X,U,2),RACNI=$P(X,U,3),(RAST,STATCHK)=$P(X,U,4)
|
|---|
| 83 | . D GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,0,.MAGRET)
|
|---|
| 84 | . I MAGRET D SVMAG2A()
|
|---|
| 85 | . S $P(^XTMP("MAGJ2","RECENT",0),U,2)=INDX
|
|---|
| 86 | ; copy the above records to the "RECENT" curlist
|
|---|
| 87 | S RECLIST=+$$CURLIST^MAGJLS2("LS9992")
|
|---|
| 88 | I 'RECLIST S RECLIST=+$G(^XTMP("MAGJ2","BKGND","LS9992",0))
|
|---|
| 89 | I 'RECLIST Q ; Recent list not being compiled--skip it!
|
|---|
| 90 | F CNT=1:1:MAGRACNT S X1=@MAGLST@(CNT,1),X2=^(2) D ; MAGLST described at BLDACTV
|
|---|
| 91 | . S REC=^XTMP("MAGJ2","LS9992",RECLIST,0,1)+1
|
|---|
| 92 | . S ^XTMP("MAGJ2","LS9992",RECLIST,REC,1)=X1,^(2)=X2
|
|---|
| 93 | . S $P(^XTMP("MAGJ2","LS9992",RECLIST,0,1),U)=REC
|
|---|
| 94 | Q
|
|---|
| 95 | ;
|
|---|
| 96 | SVMAG2A(PIPE3) ;used by subroutine at tag BLDACTV
|
|---|
| 97 | ; load return array @MAGLST@(n, ...
|
|---|
| 98 | ; Note: ^TMP("MAGRAEX" is set by the subroutine Getexam2^Magjutl1
|
|---|
| 99 | ; PIPE3 optional; contains data that is passed through the system; e.g.
|
|---|
| 100 | ; the HISTORY List receives data from the client which is augmented
|
|---|
| 101 | ; and passed back to the client
|
|---|
| 102 | ;Set outside this subrtn:STATCHK,RAST,LSTREQ,REMONLY,BKGPROC,MAGRACNT,MAGLST
|
|---|
| 103 | ;
|
|---|
| 104 | N MAGDT,SORTDT,IMGCNT,ONL,XX,XX2,Y,RARPT,KEY,RASTCAT,Y2
|
|---|
| 105 | N REMOTE,MODALITY,DAYCASE,EXCAT,ORD,URG,URG1,PREOP,LASTSSN,CURPRIO,STATUS
|
|---|
| 106 | N REMOTE2,LRFLAG
|
|---|
| 107 | S PIPE3=$G(PIPE3,"")
|
|---|
| 108 | S URG="",PREOP="" ; <*> Need below until RAO7PC1A returns URG
|
|---|
| 109 | S X=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
|
|---|
| 110 | S ORD=$P(X,U,11)
|
|---|
| 111 | I ORD S Y=$G(^RAO(75.1,ORD,0)),URG=$P(Y,U,6),PREOP=$P(Y,U,12)
|
|---|
| 112 | S XX=$G(^TMP($J,"MAGRAEX",1,1)),XX2=$G(^(2))
|
|---|
| 113 | I $G(STATCHK),(STATCHK=$P(XX,U,11))
|
|---|
| 114 | E I LSTREQ="H" S RAST=$P(XX,U,11)
|
|---|
| 115 | E Q ; index '= stored status
|
|---|
| 116 | S RARPT=$P(XX,U,10)
|
|---|
| 117 | D IMGINFO^MAGJUTL2(RARPT,.Y)
|
|---|
| 118 | 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)
|
|---|
| 119 | S REMOTE2=REMOTE
|
|---|
| 120 | I IMGSONLY,'IMGCNT Q ;only list exams w/ imgs
|
|---|
| 121 | I REMONLY,'REMOTE,'$G(BKGPROC) Q ; only list remote exams
|
|---|
| 122 | S:PLACE PLACE=$P($G(^MAG(2006.1,PLACE,0)),U,9)
|
|---|
| 123 | I MAGDT="" S MAGDT=$P(XX,U,7)
|
|---|
| 124 | S SORTDT=MAGDT
|
|---|
| 125 | S MAGDT=$$FMTE^XLFDT(MAGDT,"5Z")
|
|---|
| 126 | ; XX 1 RADFN RADTI RACNI RANME RASSN <-- from GETEXAM
|
|---|
| 127 | ; 6 RADATE RADTE RACN RAPRC RARPT
|
|---|
| 128 | ; 11 RAST DAYCASE RAELOC RASTP RASTORD
|
|---|
| 129 | ; 16 RADTPRT RACPT IMTYPABB
|
|---|
| 130 | ;XX2 1 REQLOCABB REQLOCNM RdRIST COMPLIC RAD_DIV
|
|---|
| 131 | ; 6 SITE_CODE RISTISME PROCMOD REQLOCT REQWARD
|
|---|
| 132 | S:'URG URG=9 ; request urgency default to Routine
|
|---|
| 133 | I URG=9,(PREOP]"") S URG=8 ; dummy val for Pre-Op
|
|---|
| 134 | S URG1=$S(URG=1:"Stat",URG=2:"Urg",URG=8:"PreOp",1:"Rout"),X=$E(URG1),URG1=$F(URGORD,X)-1_"-"_URG1
|
|---|
| 135 | I PREOP]"",(URG'=8) S URG1=URG1_"/Pre" ; show PreOp & another priority
|
|---|
| 136 | S SORTMAG=$S(+IMGCNT:"A",1:"B") ; sort index: has/not images
|
|---|
| 137 | S DAYCASE=$P(XX,U,12),RASTORD=$P(XX,U,15),STATUS=$P(XX,U,11),RASTCAT=$P(XX2,U,11),LRFLAG=$P(XX2,U,12)
|
|---|
| 138 | S EXCAT="",CURPRIO=0
|
|---|
| 139 | I STATUS]"" D
|
|---|
| 140 | . S EXCAT=RASTCAT
|
|---|
| 141 | . I RASTORD<2!(EXCAT="W")!('IMGCNT) S CURPRIO=0 ; Cancelled/Waiting/No images: Ignore exam
|
|---|
| 142 | . E I EXCAT="E" S CURPRIO=1 ; Examined="Current" exam
|
|---|
| 143 | . E S CURPRIO=2 ; must be a "prior" exam
|
|---|
| 144 | . I CURPRIO,'(ONL="Y") S CURPRIO=3 ; images on jukebox
|
|---|
| 145 | . I MAGJOB("P32"),'(EXCAT="E") S EXCAT="" Q ; P32 compat.
|
|---|
| 146 | . I RASTORD=9 S EXCAT="C" ; Complete
|
|---|
| 147 | . E I EXCAT="D"!(EXCAT="T") S EXCAT="I" ; just display one value meaning Interpreted
|
|---|
| 148 | S LASTSSN=$P($P(XX,U,5),"-",3)
|
|---|
| 149 | ; build output string in Y & Y2
|
|---|
| 150 | S Y=DAYCASE_U_U_$E($P(XX,U,4),1,30)_U_$E($P(XX,U,4))_LASTSSN
|
|---|
| 151 | S Y=Y_U_URG1_U_$E($P(XX,U,9),1,30)_U_MAGDT_U_$E($P(XX,U,14),1,10)_U_IMGCNT
|
|---|
| 152 | S Y=Y_U_ONL_U_$E($P(XX,U,13),1,15)_U_REMOTE
|
|---|
| 153 | S Y=Y_U_SORTMAG_U_SORTDT_U_MODALITY_U_RAST_U_$$RAIMTYP(RAST)
|
|---|
| 154 | S X=$P(XX2,U,7),RISTISME=$S(X:"Y",1:"N")
|
|---|
| 155 | S Y2=$P(XX2,U,1,3)_U_LASTSSN_U_$P(XX2,U,5)_U_PLACE_U_RISTISME_U_$P(XX2,U,8,9)_U_$P(XX,U,17)_U_$P(XX2,U,10)
|
|---|
| 156 | S Y2=Y2_U_"|"_$P(XX,U,1,3)_U_RARPT
|
|---|
| 157 | S Y2=Y2_"|"_PIPE3_"|"_EXCAT_"^^^"_MODALITY_U_$P(XX,U,17)_U_CURPRIO_U_RARPT_U_KEY_U_REMOTE2_U_LRFLAG
|
|---|
| 158 | ; * Note: Keep Pipe piece 4, above, in sync with lstout^magjls2b & magjlst1 *
|
|---|
| 159 | S MAGRACNT=MAGRACNT+1
|
|---|
| 160 | S @MAGLST@(MAGRACNT,1)=Y,^(2)=Y2 ; save output for one exam
|
|---|
| 161 | I $G(BKGPROC),(LSTREQ="R") S ^TMP($J,"NEWINT",$P(XX,U,1,3))=""
|
|---|
| 162 | Q
|
|---|
| 163 | ;
|
|---|
| 164 | RAIMTYP(RAST) ; return Imaging Type Abbrev for Status Code
|
|---|
| 165 | N X S X="" I RAST]"" D
|
|---|
| 166 | . S X=$G(RAIMTYP(RAST)) Q:X]""
|
|---|
| 167 | . S X=$P($G(^RA(72,RAST,0)),U,7)
|
|---|
| 168 | . I X S X=$P($G(^RA(79.2,X,0)),U,3)_"~"_X ; abb~ien
|
|---|
| 169 | . S RAIMTYP(RAST)=X ; save for future use
|
|---|
| 170 | Q X
|
|---|
| 171 | ;
|
|---|
| 172 | IMGTYLST(LISCAT,LST) ; get exams for list of image types for input LISCAT
|
|---|
| 173 | N TYP
|
|---|
| 174 | F Q:'(LST?1.N.E) S TYP=+$P(LST,U),LST=$P(LST,U,2,99) D:TYP IMGTYP(LISCAT,TYP)
|
|---|
| 175 | Q
|
|---|
| 176 | ;
|
|---|
| 177 | IMGTYP(LISCAT,IMGTY) ; process statuses for one Image Type for LISCAT
|
|---|
| 178 | I '$D(^RA(79.2,IMGTY,0)) S REPLY="0^4~Invalid Imaging Type" Q
|
|---|
| 179 | N LST
|
|---|
| 180 | I $D(STAT)<10 D BLDSTAT^MAGJLS3A
|
|---|
| 181 | S (STAT,LST)=""
|
|---|
| 182 | S LASTDT=$P(STAT(LISCAT),U)
|
|---|
| 183 | F S STAT=$O(STAT(LISCAT,IMGTY,STAT)) Q:STAT="" S LST=LST_$S(LST="":"",1:U)_STAT,HDRLST(STAT(LISCAT,IMGTY))=""
|
|---|
| 184 | I LST]"" D STATLST(LST)
|
|---|
| 185 | Q
|
|---|
| 186 | ;
|
|---|
| 187 | STATLST(LST) ; get exams for a list of status codes
|
|---|
| 188 | F Q:'(LST?1.N.E) S STAT=+$P(LST,U),LST=$P(LST,U,2,99) D:STAT STAT(STAT)
|
|---|
| 189 | Q
|
|---|
| 190 | ;
|
|---|
| 191 | STAT(RAST) ; get exams for one status code
|
|---|
| 192 | ; uses File #70) "AS" index of active exams
|
|---|
| 193 | ;
|
|---|
| 194 | N RASTP
|
|---|
| 195 | I $D(^RA(72,RAST)) S RASTP=$P(^(RAST,0),U)
|
|---|
| 196 | E S REPLY="0^4~Invalid Exam Status" Q
|
|---|
| 197 | I '$D(^RADPT("AS",RAST)) S REPLY="0^2~No exams on file with Exam Status "_RASTP Q
|
|---|
| 198 | S RADFN=0,STATCHK=RAST
|
|---|
| 199 | F S RADFN=$O(^RADPT("AS",RAST,RADFN)) Q:RADFN'>0 S RADTI=0 D
|
|---|
| 200 | . F S RADTI=$O(^RADPT("AS",RAST,RADFN,RADTI)) Q:RADTI'>0!(RADTI>LASTDT) S RACNI=0 D
|
|---|
| 201 | .. F S RACNI=$O(^RADPT("AS",RAST,RADFN,RADTI,RACNI)) Q:RACNI'>0 D
|
|---|
| 202 | ... D GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,0,.MAGRET)
|
|---|
| 203 | ... Q:'MAGRET ; no exam returned
|
|---|
| 204 | ... D SVMAG2A()
|
|---|
| 205 | Q
|
|---|
| 206 | ;
|
|---|
| 207 | END Q ;
|
|---|
