MAGJLS3        ;WIRMFO/JHC Rad. Workstation RPC calls ; 29 Jul 2003  10:00 AM
 ;;3.0;IMAGING;**16,22,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
 ; EPs:
 ; BLDACTV
 ;
BLDACTV(MAGGRY,DATA,MAGLST) ; get subset of Active Exams; called from MAGJLS2
 ;MAGGRY - Indirect Global ref of return array
 ;DATA: Listyp ^ Imaging Types
 ;Listyp = U  -- UNREAD Exams (Status Category=E)
 ;   = R  -- RECENT (Sts Cat's D & T)
 ;   = A  -- ALL Active (Cat's E, D, & T)
 ;   = P  -- PENDING (Cat W)
 ;   = N  -- Newly Interpreted Exams (No Cat.-Internal use only)
 ;ImgTypes = List of Imaging Types to process, or "ALL" for all
 ; MAGLST = $NA ref to return global; references to it use subscript indirection
 ; MAGLST optional: input to specify return global to use
 ; 
 ;* This subrtn can receive U/R/A/P/N (LSTREQ)-- ^_delim list of ImgTypes (IMTYPS)
 N RADFN,RADTI,RACNI,REMX
 N HDR,HDRLST,MAGIMGTY,MAGRACNT,MAGRET,LSTREQ,LISTYP,LISCAT,IMTYPS
 N REPLY,STAT,TYP,SORTMAG,DIQUIET,STATCHK,LASTDT,IMGSONLY,URGORD,REMONLY
 S DIQUIET=1 D DT^DICRW
 I $G(MAGLST)="" S MAGLST=$NA(^TMP($J,"MAGJACTIVE")) ; default loc'n if not passed in
 K ^TMP($J,"MAGRAEX"),@MAGLST
 S LSTREQ=$P(DATA,U),IMTYPS=$P(DATA,U,2,99)
 I LSTREQ="U"!(LSTREQ="R")!(LSTREQ="A")!(LSTREQ="P")!(LSTREQ="N")!(LSTREQ="H")
 E  S REPLY="0^4~Invalid Request (List Type="_LSTREQ_")" G BLDACTVZ
 S MAGRACNT=0
 S X=$G(^MAG(2006.69,1,0)),IMGSONLY=+$P(X,U,7),REMX=+$P(X,U,10) ; show only exams w/ images?
 S REMONLY=0
 I $G(MAGJOB("REMOTE")) D  ; ;show remote cache only?
 . I MAGJOB("P32") S REMONLY=REMX
 . E  Q:(LSTREQ="H")  S REMONLY=+$G(MAGJOB("REMOTESCREEN"))
 S X=$G(^MAG(2006.69,1,1)),URGORD=$P(X,U)
 S:URGORD="" URGORD="S,U,P,R" S URGORD=$TR(URGORD,",") ; "Priority" sort
 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: "
 S LISTYP=$S(LSTREQ="U":"E",LSTREQ="R":"D^T",LSTREQ="A":"E^D^T",LSTREQ="P":"W",LSTREQ="N":"",LSTREQ="H":"",1:"E")
 S REPLY="0^4~Compiling list of Radiology Exams (ACTIVE)."
 I $G(BKGPROC),(LSTREQ="R") K ^TMP($J,"NEWINT") S ^TMP($J,"NEWINT")=+$G(^XTMP("MAGJ2","RECENT",0))
 I LSTREQ="N" D BLDACT2 G BLDACTVZ
 I LSTREQ="H" D HISTBLD^MAGJLS3A G BLDACTVZ
 D BLDACT1
BLDACTVZ ;
 I 'MAGRACNT S:(REPLY["Compiling") REPLY="0^2~No Exams Found"
 E  D
 . I IMTYPS="ALL" S HDR=HDR_" ALL"
 . E  S Y="" F I=0:1 S Y=$O(HDRLST(Y)) Q:Y=""  S HDR=HDR_$S('I:"",1:", ")_Y
 . S REPLY=MAGRACNT_U_"1~"_HDR
 S @MAGLST@(0,1)=REPLY,^(2)=""
 K ^TMP($J,"MAGRAEX"),^("RAE1")
 S MAGGRY=MAGLST
 Q
BLDACT1 ; Compile exams by Status codes
 D BLDSTAT^MAGJLS3A
 F  S LISCAT=$P(LISTYP,U),LISTYP=$P(LISTYP,U,2,9) Q:LISCAT=""  D
 . I IMTYPS="ALL" S TYP="" D  Q
 .. F  S TYP=$O(STAT(LISCAT,TYP)) Q:TYP=""  D IMGTYP(LISCAT,TYP)
 . E  I +IMTYPS D IMGTYLST(LISCAT,IMTYPS) Q
 . E  S REPLY="0^4~Invalid Imaging Type"
 Q
BLDACT2 ; Add recently interpreted exams to the "Recent" compile data
 ; 1st, compile these into their own list
 N CNT,INDX,RAST,STATCHK,RECLIST,REC,X1,X2
 S X=$G(^XTMP("MAGJ2","RECENT",0)),INDX=+$P(X,U,2)
 F  S INDX=$O(^XTMP("MAGJ2","RECENT",INDX)) Q:'INDX  S X=^(INDX) D
 . S RADFN=$P(X,U),RADTI=$P(X,U,2),RACNI=$P(X,U,3),(RAST,STATCHK)=$P(X,U,4)
 . D GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,0,.MAGRET)
 . I MAGRET D SVMAG2A()
 . S $P(^XTMP("MAGJ2","RECENT",0),U,2)=INDX
 ; copy the above records to the "RECENT" curlist
 S RECLIST=+$$CURLIST^MAGJLS2("LS9992")
 I 'RECLIST S RECLIST=+$G(^XTMP("MAGJ2","BKGND","LS9992",0))
 I 'RECLIST Q  ; Recent list not being compiled--skip it!
 F CNT=1:1:MAGRACNT S X1=@MAGLST@(CNT,1),X2=^(2) D  ; MAGLST described at BLDACTV
 . S REC=^XTMP("MAGJ2","LS9992",RECLIST,0,1)+1
 . S ^XTMP("MAGJ2","LS9992",RECLIST,REC,1)=X1,^(2)=X2
 . S $P(^XTMP("MAGJ2","LS9992",RECLIST,0,1),U)=REC
 Q
 ;
SVMAG2A(PIPE3) ;used by subroutine at tag BLDACTV
 ; load return array @MAGLST@(n, ...
 ; Note: ^TMP("MAGRAEX" is set by the subroutine Getexam2^Magjutl1
 ; PIPE3 optional; contains data that is passed through the system; e.g.
 ;   the HISTORY List receives data from the client which is augmented
 ;   and passed back to the client
 ;Set outside this subrtn:STATCHK,RAST,LSTREQ,REMONLY,BKGPROC,MAGRACNT,MAGLST
 ;
 N MAGDT,SORTDT,IMGCNT,ONL,XX,XX2,Y,RARPT,KEY,RASTCAT,Y2
 N REMOTE,MODALITY,DAYCASE,EXCAT,ORD,URG,URG1,PREOP,LASTSSN,CURPRIO,STATUS
 N REMOTE2,LRFLAG
 S PIPE3=$G(PIPE3,"")
 S URG="",PREOP=""   ; <*> Need below until RAO7PC1A returns URG
 S X=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
 S ORD=$P(X,U,11)
 I ORD S Y=$G(^RAO(75.1,ORD,0)),URG=$P(Y,U,6),PREOP=$P(Y,U,12)
 S XX=$G(^TMP($J,"MAGRAEX",1,1)),XX2=$G(^(2))
 I $G(STATCHK),(STATCHK=$P(XX,U,11))
 E  I LSTREQ="H" S RAST=$P(XX,U,11)
 E  Q       ;  index '= stored status
 S 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
 I IMGSONLY,'IMGCNT Q  ;only list exams w/ imgs
 I REMONLY,'REMOTE,'$G(BKGPROC) Q  ; only list remote exams
 S:PLACE PLACE=$P($G(^MAG(2006.1,PLACE,0)),U,9)
 I MAGDT="" S MAGDT=$P(XX,U,7)
 S SORTDT=MAGDT
 S MAGDT=$$FMTE^XLFDT(MAGDT,"5Z")
   ; XX 1 RADFN   RADTI    RACNI   RANME    RASSN  <-- from GETEXAM
   ;    6 RADATE  RADTE    RACN    RAPRC     RARPT
   ;   11 RAST    DAYCASE  RAELOC   RASTP     RASTORD
   ;   16 RADTPRT RACPT    IMTYPABB
   ;XX2 1 REQLOCABB  REQLOCNM  RdRIST  COMPLIC  RAD_DIV
   ;    6 SITE_CODE  RISTISME  PROCMOD  REQLOCT REQWARD
 S:'URG URG=9  ;  request urgency default to Routine
 I URG=9,(PREOP]"") S URG=8  ; dummy val for Pre-Op
 S URG1=$S(URG=1:"Stat",URG=2:"Urg",URG=8:"PreOp",1:"Rout"),X=$E(URG1),URG1=$F(URGORD,X)-1_"-"_URG1
 I PREOP]"",(URG'=8) S URG1=URG1_"/Pre" ; show PreOp & another priority
 S SORTMAG=$S(+IMGCNT:"A",1:"B") ; sort index: has/not images
 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)
 S EXCAT="",CURPRIO=0
 I STATUS]"" D
 . S EXCAT=RASTCAT
 . I RASTORD<2!(EXCAT="W")!('IMGCNT) S CURPRIO=0 ; Cancelled/Waiting/No images: Ignore exam
 . 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 MAGJOB("P32"),'(EXCAT="E") S EXCAT="" Q  ; P32 compat.
 . I RASTORD=9 S EXCAT="C" ; Complete
 . E  I EXCAT="D"!(EXCAT="T") S EXCAT="I" ; just display one value meaning Interpreted
 S LASTSSN=$P($P(XX,U,5),"-",3)
 ; build output string in Y & Y2
 S Y=DAYCASE_U_U_$E($P(XX,U,4),1,30)_U_$E($P(XX,U,4))_LASTSSN
 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
 S Y=Y_U_ONL_U_$E($P(XX,U,13),1,15)_U_REMOTE
 S Y=Y_U_SORTMAG_U_SORTDT_U_MODALITY_U_RAST_U_$$RAIMTYP(RAST)
 S X=$P(XX2,U,7),RISTISME=$S(X:"Y",1:"N")
 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)
 S Y2=Y2_U_"|"_$P(XX,U,1,3)_U_RARPT
 S Y2=Y2_"|"_PIPE3_"|"_EXCAT_"^^^"_MODALITY_U_$P(XX,U,17)_U_CURPRIO_U_RARPT_U_KEY_U_REMOTE2_U_LRFLAG
 ; * Note: Keep Pipe piece 4, above, in sync with lstout^magjls2b & magjlst1 *
 S MAGRACNT=MAGRACNT+1
 S @MAGLST@(MAGRACNT,1)=Y,^(2)=Y2  ; save output for one exam
 I $G(BKGPROC),(LSTREQ="R") S ^TMP($J,"NEWINT",$P(XX,U,1,3))=""
 Q
 ;
RAIMTYP(RAST)   ; return Imaging Type Abbrev for Status Code
 N X S X="" I RAST]"" D
 . S X=$G(RAIMTYP(RAST)) Q:X]""
 . S X=$P($G(^RA(72,RAST,0)),U,7)
 . I X S X=$P($G(^RA(79.2,X,0)),U,3)_"~"_X  ; abb~ien
 . S RAIMTYP(RAST)=X   ; save for future use
 Q X
 ;
IMGTYLST(LISCAT,LST)       ; get exams for list of image types for input LISCAT
 N TYP
 F  Q:'(LST?1.N.E)  S TYP=+$P(LST,U),LST=$P(LST,U,2,99) D:TYP IMGTYP(LISCAT,TYP)
 Q
 ;
IMGTYP(LISCAT,IMGTY)       ; process statuses for one Image Type for LISCAT
 I '$D(^RA(79.2,IMGTY,0)) S REPLY="0^4~Invalid Imaging Type" Q
 N LST
 I $D(STAT)<10 D BLDSTAT^MAGJLS3A
 S (STAT,LST)=""
 S LASTDT=$P(STAT(LISCAT),U)
 F  S STAT=$O(STAT(LISCAT,IMGTY,STAT)) Q:STAT=""  S LST=LST_$S(LST="":"",1:U)_STAT,HDRLST(STAT(LISCAT,IMGTY))=""
 I LST]"" D STATLST(LST)
 Q
 ;
STATLST(LST)       ; get exams for a list of status codes
 F  Q:'(LST?1.N.E)  S STAT=+$P(LST,U),LST=$P(LST,U,2,99) D:STAT STAT(STAT)
 Q
 ;
STAT(RAST)           ; get exams for one status code
 ; uses File #70) "AS" index of active exams
 ;
 N RASTP
 I $D(^RA(72,RAST)) S RASTP=$P(^(RAST,0),U)
 E  S REPLY="0^4~Invalid Exam Status" Q
 I '$D(^RADPT("AS",RAST)) S REPLY="0^2~No exams on file with Exam Status "_RASTP Q
 S RADFN=0,STATCHK=RAST
 F  S RADFN=$O(^RADPT("AS",RAST,RADFN)) Q:RADFN'>0  S RADTI=0 D
 . F  S RADTI=$O(^RADPT("AS",RAST,RADFN,RADTI)) Q:RADTI'>0!(RADTI>LASTDT)  S RACNI=0 D
 .. F  S RACNI=$O(^RADPT("AS",RAST,RADFN,RADTI,RACNI)) Q:RACNI'>0  D
 ... D GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,0,.MAGRET)
 ... Q:'MAGRET  ; no exam returned
 ... D SVMAG2A()
 Q
 ;
END Q  ;