Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGJLS3

MAGJLS3.m

Go to the documentation of this file.
  1. MAGJLS3 ;WIRMFO/JHC - Rad. Workstation RPC calls ; 10/17/2022
  1. ;;3.0;IMAGING;**16,22,18,101,90,120,341**;Dec 21, 2022;Build 28
  1. ;; Per VHA Directive 2004-038, this routine should not be modified.
  1. ;; +---------------------------------------------------------------+
  1. ;; | Property of the US Government. |
  1. ;; | No permission to copy or redistribute this software is given. |
  1. ;; | Use of unreleased versions of this software requires the user |
  1. ;; | to execute a written test agreement with the VistA Imaging |
  1. ;; | Development Office of the Department of Veterans Affairs, |
  1. ;; | telephone (301) 734-0100. |
  1. ;; | The Food and Drug Administration classifies this software as |
  1. ;; | a medical device. As such, it may not be changed in any way. |
  1. ;; | Modifications to this software may result in an adulterated |
  1. ;; | medical device under 21CFR820, the use of which is considered |
  1. ;; | to be a violation of US Federal Statutes. |
  1. ;; +---------------------------------------------------------------+
  1. ;;
  1. ;; ISI IMAGING;**99,101,106**
  1. Q
  1. ; EPs:
  1. ; BLDACTV
  1. ;
  1. BLDACTV(MAGGRY,DATA,MAGLST) ; get subset of Active Exams; called from MAGJLS2
  1. ;MAGGRY - Indirect Global ref of return array
  1. ;DATA: Listyp ^ Imaging Types
  1. ;Listyp = U -- UNREAD Exams (Status Category=E)
  1. ; = R -- RECENT (Sts Cat's D & T)
  1. ; = A -- ALL Active (Cat's E, D, & T)
  1. ; = P -- PENDING (Cat's W & R) ; ISI P106
  1. ; = N -- Newly Interpreted Exams (No Cat.-Internal use only)
  1. ; = I -- Indexed Exams (No Cat.-Internal use only), = misc indexed lists (Favorites = 1st example) ; ISI
  1. ;ImgTypes = List of Imaging Types to process, or "ALL" for all
  1. ; MAGLST = $NA ref to return global; references to it use subscript indirection
  1. ; MAGLST optional: input to specify return global to use
  1. ;
  1. ;* This subrtn can receive U/R/A/P/N (LSTREQ)-- ^_delim list of ImgTypes (IMTYPS)
  1. ; Also can receive I; no imaging types in particular ; ISI
  1. N RADFN,RADTI,RACNI,REMX
  1. N HDR,HDRLST,MAGIMGTY,MAGRACNT,MAGRET,LSTREQ,LISTYP,LISCAT,IMTYPS
  1. N REPLY,STAT,TYP,SORTMAG,DIQUIET,STATCHK,LASTDT,IMGSONLY,URGORD,REMONLY
  1. S DIQUIET=1 D DT^DICRW
  1. I $G(MAGLST)="" S MAGLST=$NA(^TMP($J,"MAGJACTIVE")) ; default loc'n if not passed in
  1. K ^TMP($J,"MAGRAEX"),@MAGLST
  1. S LSTREQ=$P(DATA,U),IMTYPS=$P(DATA,U,2,99)
  1. I LSTREQ="U"!(LSTREQ="R")!(LSTREQ="A")!(LSTREQ="P")!(LSTREQ="N")!(LSTREQ="H")!(LSTREQ="I") ; ISI
  1. E S REPLY="0^4~Invalid Request (List Type="_LSTREQ_")" G BLDACTVZ
  1. S MAGRACNT=0
  1. S X=$G(^MAG(2006.69,1,0)),IMGSONLY=+$P(X,U,7),REMX=+$P(X,U,10) ; show only exams w/ images?
  1. S REMONLY=0
  1. I $G(MAGJOB("REMOTE")) D ; ;show remote cache only?
  1. . Q:(LSTREQ="H") Q:(LSTREQ="I") S REMONLY=+$G(MAGJOB("REMOTESCREEN")) ; ISI
  1. S X=$G(^MAG(2006.69,1,1)),URGORD=$P(X,U)
  1. S:URGORD="" URGORD="S,U,P,R" S URGORD=$TR(URGORD,",") ; "Priority" sort
  1. S HDR=$S(LSTREQ="U":"UNREAD",LSTREQ="R":"RECENT",LSTREQ="P":"PENDING",LSTREQ="A":"UNREAD and RECENT",LSTREQ="N":"NEWLY INTERP",LSTREQ="H":"HISTORY",LSTREQ="I":"INDEXED",1:"")_" Exams"_" for IMAGING TYPES: " ; ISI
  1. S LISTYP=$S(LSTREQ="U":"E",LSTREQ="R":"D^T",LSTREQ="A":"E^D^T",LSTREQ="P":"W^R",LSTREQ="N":"",LSTREQ="H":"",LSTREQ="I":"",1:"E") ; ISI P99, P106
  1. S REPLY="0^4~Compiling list of Radiology Exams (ACTIVE)."
  1. I $G(BKGPROC),(LSTREQ="R"),'$$MGRREV2^ISIJUTL9 K ^TMP($J,"NEWINT") S ^TMP($J,"NEWINT")=+$G(^XTMP("MAGJ2","RECENT",0)) ; ISI Rev-2?
  1. I LSTREQ="N" D:'$$MGRREV2^ISIJUTL9 BLDACT2 G BLDACTVZ ; ISI -- call only if Rev-2 not enabled
  1. I LSTREQ="H" D HISTBLD^MAGJLS3A G BLDACTVZ
  1. I LSTREQ="I" D INDXBLD^ISIJLS1 G BLDACTVZ ; ISI
  1. D BLDACT1
  1. BLDACTVZ ;
  1. I 'MAGRACNT S:(REPLY["Compiling") REPLY="0^2~No Exams Found"
  1. E D
  1. . I IMTYPS="ALL" S HDR=HDR_" ALL"
  1. . E S Y="" F I=0:1 S Y=$O(HDRLST(Y)) Q:Y="" S HDR=HDR_$S('I:"",1:", ")_Y
  1. . S REPLY=MAGRACNT_U_"1~"_HDR
  1. S @MAGLST@(0,1)=REPLY,^(2)=""
  1. K ^TMP($J,"MAGRAEX"),^("RAE1")
  1. S MAGGRY=MAGLST
  1. Q
  1. BLDACT1 ; Compile exams by Status codes
  1. D BLDSTAT^MAGJLS3A
  1. F S LISCAT=$P(LISTYP,U),LISTYP=$P(LISTYP,U,2,9) Q:LISCAT="" D
  1. . I IMTYPS="ALL" S TYP="" D Q
  1. . . F S TYP=$O(STAT(LISCAT,TYP)) Q:TYP="" D IMGTYP(LISCAT,TYP)
  1. . E I +IMTYPS D IMGTYLST(LISCAT,IMTYPS) Q
  1. . E S REPLY="0^4~Invalid Imaging Type"
  1. Q
  1. BLDACT2 ; Add recently interpreted exams to the "Recent" compile data
  1. ; 1st, compile these into their own list
  1. N CNT,INDX,RAST,STATCHK,RECLIST,REC,X1,X2,XX9
  1. S X=$G(^XTMP("MAGJ2","RECENT",0)),INDX=+$P(X,U,2)
  1. F S INDX=$O(^XTMP("MAGJ2","RECENT",INDX)) Q:'INDX S X=^(INDX) D
  1. . S RADFN=$P(X,U),RADTI=$P(X,U,2),RACNI=$P(X,U,3),(RAST,STATCHK)=$P(X,U,4)
  1. . D GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,0,.MAGRET)
  1. . I MAGRET D SVMAG2A()
  1. . S $P(^XTMP("MAGJ2","RECENT",0),U,2)=INDX
  1. ; copy the above records to the "RECENT" curlist
  1. S RECLIST=+$$CURLIST^MAGJLS2("LS9992")
  1. I 'RECLIST S RECLIST=+$G(^XTMP("MAGJ2","BKGND","LS9992",0))
  1. I 'RECLIST Q ; Recent list not being compiled--skip it!
  1. F CNT=1:1:MAGRACNT S X1=@MAGLST@(CNT,1),X2=^(2),XX9=$G(^("ISI")) D ; MAGLST described at BLDACTV
  1. . S REC=^XTMP("MAGJ2","LS9992",RECLIST,0,1)+1
  1. . S ^XTMP("MAGJ2","LS9992",RECLIST,REC,1)=X1,^(2)=X2,^("ISI")=XX9
  1. . S $P(^XTMP("MAGJ2","LS9992",RECLIST,0,1),U)=REC
  1. Q
  1. ;
  1. SVMAG2A(PIPE3) ;used by subroutine at tag BLDACTV
  1. ; load return array @MAGLST@(n, ...
  1. ; Note: ^TMP("MAGRAEX" is set by the subroutine Getexam2^Magjutl1
  1. ; PIPE3 optional; contains data that is passed through the system; e.g.
  1. ; the HISTORY List receives data from the client which is augmented
  1. ; and passed back to the client
  1. ;Set outside this subrtn:STATCHK,RAST,LSTREQ,REMONLY,BKGPROC,MAGRACNT,MAGLST
  1. ;
  1. N MAGDT,SORTDT,IMGCNT,ONL,XX,XX2,Y,RARPT,KEY,RASTCAT,Y2
  1. N REMOTE,MODALITY,DAYCASE,EXCAT,ORD,URG,URG1,PREOP,LASTSSN,CURPRIO,STATUS
  1. N REMOTE2,LRFLAG,TECH,REGDT,REGDTSRT,PTID,STATPRIORITY
  1. N XX9,PTDOB,PTAGE ; ISI
  1. S PIPE3=$G(PIPE3,"")
  1. S URG="",PREOP="" ; <*> Need below until RAO7PC1A returns URG
  1. S X=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
  1. S ORD=$P(X,U,11)
  1. I ORD S Y=$G(^RAO(75.1,ORD,0)),URG=$P(Y,U,6),PREOP=$P(Y,U,12)
  1. S XX=$G(^TMP($J,"MAGRAEX",1,1)),XX2=$G(^(2)),XX9=$G(^("ISI")) ; ISI added new fields
  1. I $G(STATCHK),(STATCHK=$P(XX,U,11))
  1. E I LSTREQ="H" S RAST=$P(XX,U,11)
  1. E I LSTREQ="I" S RAST=$P(XX,U,11) ; ISI
  1. E Q ; index '= stored status
  1. S RARPT=$P(XX,U,10),STATPRIORITY="" ; STATPRIORITY always null from the compiler (place-holder only)
  1. D IMGINFO^MAGJUTL2(RARPT,.Y)
  1. 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)
  1. S REMOTE2=REMOTE
  1. I IMGSONLY,'IMGCNT,'(LSTREQ="P") Q ;only list exams w/ imgs, except PENDING
  1. I REMONLY,'REMOTE,'$G(BKGPROC) Q ; only list remote exams
  1. S:PLACE PLACE=$P($G(^MAG(2006.1,PLACE,0)),U,9)
  1. I MAGDT="" S MAGDT=$P(XX,U,7)
  1. S SORTDT=MAGDT
  1. S MAGDT=$$FMTE^XLFDT(MAGDT,"5Z")
  1. S REGDTSRT=$P(XX,U,7),REGDT=$$FMTE^XLFDT(REGDTSRT,"5Z")
  1. ; XX 1 RADFN RADTI RACNI RANME RASSN <-- from GETEXAM
  1. ; 6 RADATE RADTE RACN RAPRC RARPT
  1. ; 11 RAST DAYCASE RAELOC RASTP RASTORD
  1. ; 16 RADTPRT RACPT IMTYPABB
  1. ;XX2 1 REQLOCABB REQLOCNM RdRIST COMPLIC RAD_DIV
  1. ; 6 SITE_CODE RISTISME PROCMOD REQLOCT REQWARD
  1. ; 11 RASTCAT LRFLAG TECH
  1. ;XX9 1 Assignee_initials Assign_Note Assignee_duz ; ISI -- begin
  1. ; 4 Favorite_KeyWd1 Favorite_KeyWd2 Favorite_Note
  1. ; 7 Patient_Age Patient_Sex Patient_DOB
  1. S PTDOB=$P(XX9,U,9),PTAGE=""
  1. I PTDOB D DT^DILF(,$P(MAGDT,"@"),.X) S PTAGE=$$AGECALC^ISIJLS2(PTDOB,X)
  1. S $P(XX9,U,7)=PTAGE ; ISI -- end
  1. S:'URG URG=9 ; request urgency default to Routine
  1. I URG=9,(PREOP]"") S URG=8 ; dummy val for Pre-Op
  1. S URG1=$S(URG=1:"Stat",URG=2:"Urg",URG=8:"PreOp",1:"Rout"),X=$E(URG1),URG1=$F(URGORD,X)-1_"-"_URG1
  1. I PREOP]"",(URG'=8) S URG1=URG1_"/Pre" ; show PreOp & another priority
  1. S SORTMAG=$S(+IMGCNT:"A",1:"B") ; sort index: has/not images
  1. 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),TECH=$P(XX2,U,13)
  1. S EXCAT="",CURPRIO=0
  1. I STATUS]"" D
  1. . S EXCAT=RASTCAT
  1. . I RASTORD<2!(EXCAT="W")!(EXCAT="R")!('IMGCNT) S CURPRIO=0 ; Cancelled/Waiting/No images: Ignore exam ; ISI P106
  1. . E I EXCAT="E" S CURPRIO=1 ; Examined="Current" exam
  1. . E S CURPRIO=2 ; must be a "prior" exam
  1. . I CURPRIO,'(ONL="Y") S CURPRIO=3 ; images on jukebox
  1. . I RASTORD=9 S EXCAT="C" ; Complete
  1. . E I EXCAT="D"!(EXCAT="T") S EXCAT="I" ; just display one value meaning Interpreted
  1. ; PTID is Initial w/ last 4 of SSN for VA (Z9999), or MRN for IHS (1.N number)
  1. ; LASTSSN is either last 4 digits of SSN, or last 4 of whatever number came in, or nil
  1. S X=$P(XX,U,5) ; SSN in VA, MRN in IHS
  1. I X?3N1"-"2N1"-"4N S LASTSSN=$P(X,"-",3),PTID=$E($P(XX,U,4))_LASTSSN
  1. E S PTID=X D
  1. . I X?1N.N S X=10000+X,T=$L(X),LASTSSN=$E(X,T-3,T)
  1. . E S LASTSSN=""
  1. ; build output string in Y & Y2
  1. S Y=DAYCASE_U_U_$P(XX,U,4)_U_PTID
  1. S Y=Y_U_URG1_U_$E($P(XX,U,9),1,30)_U_MAGDT_U_$E($P(XX,U,14),1,16)_U_IMGCNT ; ISI P106
  1. S Y=Y_U_ONL_U_$E($P(XX,U,13),1,15)_U_REMOTE
  1. S Y=Y_U_SORTMAG_U_SORTDT_U_MODALITY_U_RAST_U_$$RAIMTYP(RAST)
  1. S RISTISME=$P(XX2,U,7)
  1. 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)
  1. ; add 4 "place holders" for fields that are only in the History list
  1. S Y2=Y2_U_U_U_U
  1. S Y2=Y2_U_TECH_U_REGDT_U_REGDTSRT ; p101 adds 3 new fields
  1. S Y2=Y2_U_"|"_$P(XX,U,1,3)_U_RARPT
  1. S Y2=Y2_"|"_PIPE3_"|"_EXCAT_"^^^"_MODALITY_U_$P(XX,U,17)_U_CURPRIO_U_RARPT_U_KEY_U_REMOTE2_U_LRFLAG_U_STATPRIORITY
  1. ; * Note: Keep Pipe piece 4, above, in sync with lstout^magjls2b & magjlst1 *
  1. S MAGRACNT=MAGRACNT+1
  1. S @MAGLST@(MAGRACNT,1)=Y,^(2)=Y2,^("ISI")=XX9 ; save output for one exam ; ISI
  1. I $G(BKGPROC),(LSTREQ="R"),'$$MGRREV2^ISIJUTL9 S ^TMP($J,"NEWINT",$P(XX,U,1,3))="" ; ISI -- Rev-2?
  1. Q
  1. ;
  1. RAIMTYP(RAST) ; return Imaging Type Abbrev for Status Code
  1. N X S X="" I RAST]"" D
  1. . S X=$G(RAIMTYP(RAST)) Q:X]""
  1. . S X=$P($G(^RA(72,RAST,0)),U,7)
  1. . I X S X=$P($G(^RA(79.2,X,0)),U,3)_"~"_X ; abb~ien
  1. . S RAIMTYP(RAST)=X ; save for future use
  1. Q X
  1. ;
  1. IMGTYLST(LISCAT,LST) ; get exams for list of image types for input LISCAT
  1. N TYP
  1. F Q:'(LST?1.N.E) S TYP=+$P(LST,U),LST=$P(LST,U,2,99) D:TYP IMGTYP(LISCAT,TYP)
  1. Q
  1. ;
  1. IMGTYP(LISCAT,IMGTY) ; process statuses for one Image Type for LISCAT
  1. I '$D(^RA(79.2,IMGTY,0)) S REPLY="0^4~Invalid Imaging Type" Q
  1. N LST
  1. I $D(STAT)<10 D BLDSTAT^MAGJLS3A
  1. S (STAT,LST)=""
  1. S LASTDT=$P(STAT(LISCAT),U)
  1. F S STAT=$O(STAT(LISCAT,IMGTY,STAT)) Q:STAT="" S LST=LST_$S(LST="":"",1:U)_STAT,HDRLST(STAT(LISCAT,IMGTY))=""
  1. I LST]"" D STATLST(LST)
  1. Q
  1. ;
  1. STATLST(LST) ; get exams for a list of status codes
  1. F Q:'(LST?1.N.E) S STAT=+$P(LST,U),LST=$P(LST,U,2,99) D:STAT STAT(STAT)
  1. Q
  1. ;
  1. STAT(RAST) ; get exams for one status code
  1. ; uses File #70) "AS" index of active exams
  1. ;
  1. N RASTP
  1. I $D(^RA(72,RAST)) S RASTP=$P(^(RAST,0),U)
  1. E S REPLY="0^4~Invalid Exam Status" Q
  1. I '$D(^RADPT("AS",RAST)) S REPLY="0^2~No exams on file with Exam Status "_RASTP Q
  1. S RADFN=0,STATCHK=RAST
  1. F S RADFN=$O(^RADPT("AS",RAST,RADFN)) Q:RADFN'>0 S RADTI=0 D
  1. . F S RADTI=$O(^RADPT("AS",RAST,RADFN,RADTI)) Q:RADTI'>0!(RADTI>LASTDT) S RACNI=0 D
  1. . . I '$G(BKGPROC) Q:'$$DIVSCRN(RADFN,RADTI) ; ISI--skip if not in my logon division/assoc div
  1. . . F S RACNI=$O(^RADPT("AS",RAST,RADFN,RADTI,RACNI)) Q:RACNI'>0 D
  1. . . . D GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,0,.MAGRET)
  1. . . . Q:'MAGRET ; no exam returned
  1. . . . D SVMAG2A()
  1. Q
  1. ;
  1. DIVSCRN(RADFN,RADTI) ; ISI begin--adding new function
  1. ; --> Return T/F: exam is of interest for my logon Division?
  1. N PROCEED,RADATA,X
  1. S PROCEED=1
  1. I $G(MAGJOB("CONSOLIDATED")) D ; only matters for Consolidated DB
  1. . S RADATA=$G(^RADPT(RADFN,"DT",RADTI,0)) I RADATA]"" D
  1. . S X=$P(RADATA,U,3) I X]"",'$D(MAGJOB("DIVSCRN",X)) S PROCEED=0
  1. Q:$Q PROCEED Q
  1. ; ISI--end
  1. END Q ;