MAGJLS2B ;WIRMFO/JHC - VistARad RPC calls ; 10/17/2022
;;3.0;IMAGING;**16,22,18,76,101,90,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**
Q
;
PARAMS(X) ; Init some vars used for Exam Lists
N LASTEDIT
S LSTID=+$O(^MAG(2006.631,"C",X,""))
I 'LSTID S LSTID="Invalid List ID" Q ;
S X=^MAG(2006.631,LSTID,0)
I '$P(X,U,6) S LSTID="LIST NOT ENABLED" Q ;
S LSTTL=$P(X,U),LSTREQ=$P(X,U,3),LSTPARAM=LSTREQ_U_$P(X,U,4),LASTEDIT=$P(X,U,5)
S LSTTL=$S(LSTREQ="U":"UNREAD",LSTREQ="R":"RECENT",LSTREQ="A":"ACTIVE",LSTREQ="P":"PENDING",LSTREQ="N":"NEWLY INTERP",LSTREQ="H":"HISTORY",LSTREQ="I":"INDEXED",1:"")_" EXAMS: "_LSTTL ; ISI
I $P(LSTPARAM,U,2)="" S $P(LSTPARAM,U,2)="ALL" ; dflt All ImagingTypes
S X=$G(^MAG(2006.69,1,0)),BKGND=+$P(X,U,8),DELTA=+$P(X,U,$S(LSTREQ="U":9,1:13))*60
I BKGND,'DELTA S DELTA=360 ;dflt Unread List compile cycle time secs
S LSTNAM="LS"_LSTID
I BKGND S LSTNAM=$S(LSTREQ="U":"LS9991",LSTREQ="R":"LS9992",LSTREQ="N":"LS9995",LSTREQ="H":"LS9996",1:LSTNAM) ; hard-code for "Master" list Bkgnd compile
Q
;
SETVARS(LSTID) ;output control variables
D LSTVAR(LSTID),SRTVAR(LSTID),SELVAR(LSTID)
Q
;
LSTVAR(LSTID) ; build output columns string
S MDLVAR=^MAG(2006.631,LSTID,"DEF",1),LSTHDR=^(.5)
N I,XX,SC,XOUT,XOUT2
S SC=";",XOUT="",XOUT2=""
F I=1:1:$L(MDLVAR,U) S XX=$P(MDLVAR,U,I) D
. I +XX=12 I '$G(SNDREMOT) Q ; exclude RC ind
. I +XX=23 I '$G(SHOWPLAC) Q ; exclude PLACE
. I +XX=201!(+XX=202)!(+XX=203) I '$G(ASIGENA) Q ; ISI exclude ASSIGN info?
. S XOUT=XOUT_$S(XOUT="":"",1:U)_XX
. S XOUT2=XOUT2_$S(XOUT2="":"",1:U)_$P(LSTHDR,U,I)
S MDLVAR=XOUT,LSTHDR=XOUT2
Q
SRTVAR(LSTID) ; build sort-vars string in SORTSS
; indirection used to ref string at list output (see LSTOUT)
S MDSVAR=^MAG(2006.631,LSTID,"DEF",2)
N I,XX,XOUT,HAVEONE
S SORTSS="",XOUT="",HAVEONE=0
F I=1:1:$L(MDSVAR,U) S XX=$P(MDSVAR,U,I) D
. I +XX=12 Q:'$G(SNDREMOT) ; exclude RC ind
. I +XX=23 I '$G(SHOWPLAC) Q ; exclude PLACE
. I +XX=201!(+XX=202)!(+XX=203) I '$G(ASIGENA) Q ; ISI exclude ASSIGN info?
. I 'HAVEONE S HAVEONE=(+XX=1) ; 1 = Case #
. S XOUT=XOUT_$S(XOUT="":"",1:U)_XX
. S XX=$S(XX?1N.N1"-":"-",1:"")_"MD("_+XX_")"
. S SORTSS=SORTSS_","_XX
I 'HAVEONE S SORTSS=SORTSS_",MD(1)",XOUT=XOUT_U_1 ; force unique entry each exam
I $E(SORTSS)="," S SORTSS=$E(SORTSS,2,999)
S MDSVAR=XOUT
Q
;
SELVAR(LSTID) ; build selection logic executes in DIS array
N CX,DC,DCX,DL,DLX,EXP,I,IDL,SELVAR,SELVAR2,SS
S SS=0 F S SS=$O(^MAG(2006.631,LSTID,"DEF",3,SS)) Q:'SS S DC(SS)=^(SS)
S SS=0 F I=1:1 S SS=$O(^MAG(2006.631,LSTID,"DEF",4,SS)) Q:'SS S DL(I)=^(SS)
; DL(5)="^2^3'^" <DLX CX=3' DC(2)="1^>44" <DCX
K DIS,MDCVAR S DIS(0)=0
F IDL=1:1 S DLX=$G(DL(IDL)) Q:DLX="" S DIS(0)=DIS(0)+1,DIS(DIS(0))="" D
. F I=2:1:$L(DLX,U)-1 S CX=$P(DLX,U,I) S DCX=DC(+CX) D
. . S EXP="(MD("_+DCX_")"_$P(DCX,U,2)_")"
. . S EXP="I "_$S(CX["'":"'",1:"")_EXP
. . S DIS(DIS(0))=DIS(DIS(0))_" "_EXP
. . S MDCVAR(+DCX)=""
Q
;
CHKLOCK(RARPT,DAYCASE) ; return ini of locking user & truth flag for locking user = logon user
N RESULT,WHO,MYLOCK,X,XX
S (MYLOCK,WHO)=""
I RARPT,(DAYCASE]"") D
. I $D(^XTMP("MAGJ","LOCK",RARPT)) D
. . D LOCKACT^MAGJEX1A(RARPT,DAYCASE,100,.RESULT)
. . I $D(RESULT)>1 D
. . . S X=RESULT(1),WHO=$P(X,U,5)
. . . I WHO]"" S MYLOCK=+X
. . . E D
. . . . S X=RESULT(2),WHO=$P(X,U,5)
. . . . I WHO]"" S WHO=WHO_":R",MYLOCK=+X I MYLOCK S MYLOCK=2
S XX=WHO_U_MYLOCK
Q:$Q XX Q
;
SHOWPLAC(X) ; return list of places to show: all defined places NOT equal to user's logon place
N IEN,SHOWPLAC S SHOWPLAC=""
S IEN=0 F S IEN=$O(^MAG(2006.1,IEN)) Q:'IEN I IEN'=+MAGJOB("SITEP") S X=$P(^(IEN,0),U,9) I X]"" S SHOWPLAC=SHOWPLAC_","_X
I SHOWPLAC]"" S SHOWPLAC=1_U_SHOWPLAC_"," ; 1 for true
Q SHOWPLAC
;
LSTOUT(MAGGRY,LSTID,MAGLST,LSTAGE,WRNMSG) ; Build output list, w/ sort & selection
; Input: LSTID=List def'n
; MAGLST=Indirect global ref for input records; all reads use subscript indirection
; the nodes in @MAGLST contain:
;
; Node 1 corresponds to IENs 1:17 from Data Elements dic:
; Acn# ^ Ex LOCK ^ PtName ^ Pt_ID ^ Priority ^ Proc ^ Img Date/Time ^ Status ^ # Images ^ Online?
; Img Loc'n ^ Remote Ind. ^ Images Exist? ^ Img Date/Time-sortable ^ Mdl ^ Status/Internal ^ ImgTypABB
; Node 2-- IEN's 18:28 from Data Elements dic:
; REQLOCAbb ^ REQLOCNm ^ Interp Rad'ists ^ Last4 SSN ^ Division ^ Site ^ Rist Is Me? ^ ProcMod ^ REQLOCTyp ^ CPT
; WARD
; Node 2 then appends 3 pipe-delim pieces that are passed through from list compiler (See svmag2a^magjls3)
;
; Node "ISI"--IEN's 201,ff from Data Elements dic ; ISI
;
; LSTAGE=optional List age from last compile, in seconds
; WRNMSG=optional message to append to list title, to warn of possible compile problems
; Output: MAGGRY=Indirect ref to output file
;
N DIS,MDCVAR,SNDREMOT,ILST,IMD,MAGRACNT
N RARPT,RAST,RADFN,RACNI,RADTI,T,WHOLOCK,XX,MYLOCK,DAYCASE,MODALITY
N OUT,QX,SORT,SORTSS,LSTHDR,MD,MDLVAR,MDSVAR,REMONLY,REMOTCAS
N SHOWPLAC,SORTLEN,STATPRIORITY
N XX2,XX9,ASIGENA,T ; ISI
S LSTAGE=$G(LSTAGE),WRNMSG=$G(WRNMSG)
S SHOWPLAC=$$SHOWPLAC("") ; Show any Place (Site Code) that is NOT the Login Place
S REMONLY=0
S XX=$G(^MAG(2006.69,1,0)),SNDREMOT=+$P(XX,U,11)
I $G(MAGJOB("REMOTE")) D ; show remote cache only?
. ; ISI remove deprecated logic
. Q:(LSTREQ="H") S REMONLY=+$G(MAGJOB("REMOTESCREEN")) ; Hist list ; ISI
S XX=$G(^MAG(2006.69,1,"ISI")),ASIGENA=($P(XX,U,1)="Y") ; ISI
D SETVARS(LSTID)
I LSTREQ="I",$G(DATA01)=9820 D SETVARS^ISIJLS2(.DIS,.MDCVAR,.LSTHDR,.MDLVAR) ; ISI -- Dynamic Query search & columns logic
S MAGRACNT=0
S SORT="^TMP("_$J_",""MAGJSORT""",SORTLEN=$L(SORT) K ^TMP($J,"MAGJSORT")
K ^TMP($J,"RET") S ^TMP($J,"RET",0)="0^4~Getting Exam List"
S X=$G(@MAGLST@(0,1)) I +X<1 D G LSTOUTZ ; No exams to list!
. I X="" S ^TMP($J,"RET",0)="0^4~Problem with Exams List Compile"
. E S ^TMP($J,"RET",0)=X
S ILST=0
F S ILST=$O(@MAGLST@(ILST)) Q:'ILST S XX=^(ILST,1),XX2=^(2),XX9=$G(^("ISI")) K MD D ; contents described above ; ISI
. S XX=XX_U_$P(XX2,"|"),$P(XX2,"|")=""
. I ("UPA"[LSTREQ),$G(MAGJOB("CONSOLIDATED")) S RADIV=$P(XX,U,22) I RADIV]"",'$D(MAGJOB("DIVSCRN",RADIV)) Q ; ISI new line loc'n for Jordan efficiency ; Screen Unread/Pending/Active exams for DIVision
. S T=$P(XX2,"|",2),RADFN=$P(T,U),RADTI=$P(T,U,2),RACNI=$P(T,U,3),RARPT=$P(T,U,4) ; ISI new line loc'n: make Key vars available to all subsequent logic
. S RAST=$P(XX,U,16) ; ISI, ditto
. S $P(XX,U,24)=$$RISTISME($P(XX,U,24)) ; calculate value @ list output time
. S $P(XX9,U,3)=$$ASIGME^ISIJUTL1($P(XX9,U,3),DATA01,RAST) ; ISI calc truth value based on ~assign status & to whom
. ; Execute Selection logic
. S X=0 F S X=$O(MDCVAR(X)) Q:'X D ; ISI mod to handle ISI-added fields
. . I X<200 S MD(X)=$P(XX,U,X) ; load needed data
. . E S MD(X)=$P(XX9,U,X-200) ; ISI added fields stored here
. I 1 F I=1:1:$G(DIS(0)) X DIS(I) I Q ; quit if search logic True
. E Q ; failed selection criteria--skip
. I ("UPA"[LSTREQ),'$P(XX9,U,3) Q ; ISI - assigned, do not display to user acc to asigme fn above
. I LSTREQ="U",'$D(^RADPT("AS",RAST,RADFN,RADTI,RACNI)) Q ; No longer Unread!
. S REMOTCAS=$P(XX,U,12)
. I REMONLY,'REMOTCAS Q ; don't show if not routed
. I REMONLY,REMOTCAS D I 'T Q ; don't show if not the remote reading site
. . F I=1:1:$L(REMOTCAS,",")+1 S T=$P(REMOTCAS,",",I) I T,$D(MAGJOB("LOC",T)) Q
. ; set up sort values, creating sort index w/ indirect reference to sort global
. F I=1:1:$L(MDSVAR,U) S X=+$P(MDSVAR,U,I) D ; ISI mod to handle ISI-added fields
. . I X<200 S MD(X)=$P(XX,U,X) I MD(X)="" S MD(X)="~" ; ISI
. . I X>200 S MD(X)=$P(XX9,U,X-200) I MD(X)="" S MD(X)="~" ; ISI range start @201
. I LSTREQ="H" S @(SORT_",ILST,"_SORTSS_")")=ILST_U_RARPT ; P18 adds ILST so History List can allow mult entries of same exam, in fifo order
. E S @(SORT_","_SORTSS_")")=ILST_U_RARPT
. S MAGRACNT=MAGRACNT+1
I 'MAGRACNT S ^TMP($J,"RET",0)="0^2~No Exams Found"
E D ; generate output file
. S @(SORT_","_-9999999999_")")=0,QX=SORT_")" ; define $Query var.; init beginning w/ dummy entry
. ; proceed thru sort index until the string contained in SORT is not present
. ; get data w/ indirect refs to the stored data
. F ILST=0:1 S QX=$Q(@QX) Q:($E(QX,1,SORTLEN))'=SORT S XX=@MAGLST@(+(@QX),1),XX2=^(2),XX9=$G(^("ISI")),OUT="" D ; ISI
. . I 'ILST D Q ; Header string
. . . S T="" I LSTAGE?1N.N S T=LSTAGE\60 S T=" (List age: "_$S(T:T_" min, ",1:"")_(LSTAGE#60)_" sec)"
. . . I WRNMSG]"" S T=T_" ** "_WRNMSG_" **"
. . . I +$P(XX,U,2)=1 S $P(XX,"~",2)=LSTTL_T ; List Title
. . . S ^TMP($J,"RET",0)=XX
. . S XX=XX_U_$P(XX2,"|"),$P(XX2,"|")=""
. . S $P(XX,U,24)=$$RISTISME($P(XX,U,24)) ; calculate value @ list output time
. . S $P(XX9,U,3)=$$ASIGME^ISIJUTL1($P(XX9,U,3),DATA01,$P(XX9,U,16)) ; ISI calc value @ output time
. . S RARPT=$P(@QX,U,2),DAYCASE=$P(XX,U)
. . S T=$$CHKLOCK(RARPT,DAYCASE),WHOLOCK=$P(T,U),MYLOCK=$P(T,U,2)
. . S $P(XX,U,2)=WHOLOCK
. . S MODALITY=$P(XX,U,15),STATPRIORITY=0
. . F IMD=1:1:$L(MDLVAR,U) S X=$P(MDLVAR,U,IMD),MD=$S(+X<200:$P(XX,U,+X),1:$P(XX9,U,X-200)) D ; ISI
. . . I +X=12,(MD]""),SNDREMOT D
. . . . ; if site routes images, disp Remote Cache ind.
. . . . N I,T S T="" F I=1:1:$L(MD,",") S T=T_$S(T="":"",1:",")_$P($G(^MAG(2005.2,$P(MD,",",I),3)),U,5)
. . . . S MD=T
. . . I +X=23,(MD]""),SHOWPLAC D
. . . . I SHOWPLAC'[(","_MD_",") S MD="" ; Don't show user's local place
. . . I +X=22,(MD]""),$G(MAGJOB("CONSOLIDATED")) D
. . . . I '$D(MAGJOB("DIVSCRN",MD)) S MD="" ; Don't show user's local Div
. . . I +X=5,(LSTREQ="U"),(MD]""),("1-Stat^2-Urg"[MD) S STATPRIORITY=1 ; Stat or Urgent Unread exam
. . . I X[";" S T=+$P(X,";",2) I T S MD=$E(MD,1,T) ; truncate output col
. . . S $P(OUT,U,IMD)=MD
. . S $P(OUT,U,IMD+1)="",OUT=U_OUT,OUT=OUT_"|"_$P(XX2,"|",2,9)
. . S T=$P(OUT,"|",4) D S $P(OUT,"|",4)=T
. . . I WHOLOCK]"" S $P(T,U,2)=WHOLOCK,$P(T,U,3)=MYLOCK ; pass lock info to Client
. . . S $P(T,U,11)=STATPRIORITY
. . ; * Note: Keep Pipe piece 4, above, in sync with svmag2a^magjls3 *
. . S ^TMP($J,"RET",ILST+1)=OUT
. S ^TMP($J,"RET",1)=U_LSTHDR
. S $P(^TMP($J,"RET",0),U)=MAGRACNT
LSTOUTZ K MAGGRY,^TMP($J,"MAGJSORT") S MAGGRY=$NA(^TMP($J,"RET"))
Q
;
RISTISME(X) ; calculate truth value for Interpreting Rist = Logon Rist
; input zero to 2 DUZ values Rist1~Rist2
; output Y or N for truth value
N Y S Y="N"
I X]"" D
. N I F I=1,2 I +$P(X,"~",I)=DUZ S Y="Y" Q
Q:$Q Y Q
;
UPDR ; Add Newly Interp exams to Recent; called from magjls2
D PARAMS(9995)
I LSTID D
. S X=$$CURLIST^MAGJLS2(LSTNAM),LSTAGE=$P(X,U,2),LSTNUM=+X
. D LSTCOMP^MAGJLS2()
UPDRZ Q
;
END ;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGJLS2B 11935 printed Dec 13, 2024@02:06:45 Page 2
MAGJLS2B ;WIRMFO/JHC - VistARad RPC calls ; 10/17/2022
+1 ;;3.0;IMAGING;**16,22,18,76,101,90,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**
+18 QUIT
+19 ;
PARAMS(X) ; Init some vars used for Exam Lists
+1 NEW LASTEDIT
+2 SET LSTID=+$ORDER(^MAG(2006.631,"C",X,""))
+3 ;
IF 'LSTID
SET LSTID="Invalid List ID"
QUIT
+4 SET X=^MAG(2006.631,LSTID,0)
+5 ;
IF '$PIECE(X,U,6)
SET LSTID="LIST NOT ENABLED"
QUIT
+6 SET LSTTL=$PIECE(X,U)
SET LSTREQ=$PIECE(X,U,3)
SET LSTPARAM=LSTREQ_U_$PIECE(X,U,4)
SET LASTEDIT=$PIECE(X,U,5)
+7 ; ISI
SET LSTTL=$SELECT(LSTREQ="U":"UNREAD",LSTREQ="R":"RECENT",LSTREQ="A":"ACTIVE",LSTREQ="P":"PENDING",LSTREQ="N":"NEWLY INTERP",LSTREQ="H":"HISTORY",LSTREQ="I":"INDEXED",1:"")_" EXAMS: "_LSTTL
+8 ; dflt All ImagingTypes
IF $PIECE(LSTPARAM,U,2)=""
SET $PIECE(LSTPARAM,U,2)="ALL"
+9 SET X=$GET(^MAG(2006.69,1,0))
SET BKGND=+$PIECE(X,U,8)
SET DELTA=+$PIECE(X,U,$SELECT(LSTREQ="U":9,1:13))*60
+10 ;dflt Unread List compile cycle time secs
IF BKGND
IF 'DELTA
SET DELTA=360
+11 SET LSTNAM="LS"_LSTID
+12 ; hard-code for "Master" list Bkgnd compile
IF BKGND
SET LSTNAM=$SELECT(LSTREQ="U":"LS9991",LSTREQ="R":"LS9992",LSTREQ="N":"LS9995",LSTREQ="H":"LS9996",1:LSTNAM)
+13 QUIT
+14 ;
SETVARS(LSTID) ;output control variables
+1 DO LSTVAR(LSTID)
DO SRTVAR(LSTID)
DO SELVAR(LSTID)
+2 QUIT
+3 ;
LSTVAR(LSTID) ; build output columns string
+1 SET MDLVAR=^MAG(2006.631,LSTID,"DEF",1)
SET LSTHDR=^(.5)
+2 NEW I,XX,SC,XOUT,XOUT2
+3 SET SC=";"
SET XOUT=""
SET XOUT2=""
+4 FOR I=1:1:$LENGTH(MDLVAR,U)
SET XX=$PIECE(MDLVAR,U,I)
Begin DoDot:1
+5 ; exclude RC ind
IF +XX=12
IF '$GET(SNDREMOT)
QUIT
+6 ; exclude PLACE
IF +XX=23
IF '$GET(SHOWPLAC)
QUIT
+7 ; ISI exclude ASSIGN info?
IF +XX=201!(+XX=202)!(+XX=203)
IF '$GET(ASIGENA)
QUIT
+8 SET XOUT=XOUT_$SELECT(XOUT="":"",1:U)_XX
+9 SET XOUT2=XOUT2_$SELECT(XOUT2="":"",1:U)_$PIECE(LSTHDR,U,I)
End DoDot:1
+10 SET MDLVAR=XOUT
SET LSTHDR=XOUT2
+11 QUIT
SRTVAR(LSTID) ; build sort-vars string in SORTSS
+1 ; indirection used to ref string at list output (see LSTOUT)
+2 SET MDSVAR=^MAG(2006.631,LSTID,"DEF",2)
+3 NEW I,XX,XOUT,HAVEONE
+4 SET SORTSS=""
SET XOUT=""
SET HAVEONE=0
+5 FOR I=1:1:$LENGTH(MDSVAR,U)
SET XX=$PIECE(MDSVAR,U,I)
Begin DoDot:1
+6 ; exclude RC ind
IF +XX=12
if '$GET(SNDREMOT)
QUIT
+7 ; exclude PLACE
IF +XX=23
IF '$GET(SHOWPLAC)
QUIT
+8 ; ISI exclude ASSIGN info?
IF +XX=201!(+XX=202)!(+XX=203)
IF '$GET(ASIGENA)
QUIT
+9 ; 1 = Case #
IF 'HAVEONE
SET HAVEONE=(+XX=1)
+10 SET XOUT=XOUT_$SELECT(XOUT="":"",1:U)_XX
+11 SET XX=$SELECT(XX?1N.N1"-":"-",1:"")_"MD("_+XX_")"
+12 SET SORTSS=SORTSS_","_XX
End DoDot:1
+13 ; force unique entry each exam
IF 'HAVEONE
SET SORTSS=SORTSS_",MD(1)"
SET XOUT=XOUT_U_1
+14 IF $EXTRACT(SORTSS)=","
SET SORTSS=$EXTRACT(SORTSS,2,999)
+15 SET MDSVAR=XOUT
+16 QUIT
+17 ;
SELVAR(LSTID) ; build selection logic executes in DIS array
+1 NEW CX,DC,DCX,DL,DLX,EXP,I,IDL,SELVAR,SELVAR2,SS
+2 SET SS=0
FOR
SET SS=$ORDER(^MAG(2006.631,LSTID,"DEF",3,SS))
if 'SS
QUIT
SET DC(SS)=^(SS)
+3 SET SS=0
FOR I=1:1
SET SS=$ORDER(^MAG(2006.631,LSTID,"DEF",4,SS))
if 'SS
QUIT
SET DL(I)=^(SS)
+4 ; DL(5)="^2^3'^" <DLX CX=3' DC(2)="1^>44" <DCX
+5 KILL DIS,MDCVAR
SET DIS(0)=0
+6 FOR IDL=1:1
SET DLX=$GET(DL(IDL))
if DLX=""
QUIT
SET DIS(0)=DIS(0)+1
SET DIS(DIS(0))=""
Begin DoDot:1
+7 FOR I=2:1:$LENGTH(DLX,U)-1
SET CX=$PIECE(DLX,U,I)
SET DCX=DC(+CX)
Begin DoDot:2
+8 SET EXP="(MD("_+DCX_")"_$PIECE(DCX,U,2)_")"
+9 SET EXP="I "_$SELECT(CX["'":"'",1:"")_EXP
+10 SET DIS(DIS(0))=DIS(DIS(0))_" "_EXP
+11 SET MDCVAR(+DCX)=""
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
CHKLOCK(RARPT,DAYCASE) ; return ini of locking user & truth flag for locking user = logon user
+1 NEW RESULT,WHO,MYLOCK,X,XX
+2 SET (MYLOCK,WHO)=""
+3 IF RARPT
IF (DAYCASE]"")
Begin DoDot:1
+4 IF $DATA(^XTMP("MAGJ","LOCK",RARPT))
Begin DoDot:2
+5 DO LOCKACT^MAGJEX1A(RARPT,DAYCASE,100,.RESULT)
+6 IF $DATA(RESULT)>1
Begin DoDot:3
+7 SET X=RESULT(1)
SET WHO=$PIECE(X,U,5)
+8 IF WHO]""
SET MYLOCK=+X
+9 IF '$TEST
Begin DoDot:4
+10 SET X=RESULT(2)
SET WHO=$PIECE(X,U,5)
+11 IF WHO]""
SET WHO=WHO_":R"
SET MYLOCK=+X
IF MYLOCK
SET MYLOCK=2
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+12 SET XX=WHO_U_MYLOCK
+13 if $QUIT
QUIT XX
QUIT
+14 ;
SHOWPLAC(X) ; return list of places to show: all defined places NOT equal to user's logon place
+1 NEW IEN,SHOWPLAC
SET SHOWPLAC=""
+2 SET IEN=0
FOR
SET IEN=$ORDER(^MAG(2006.1,IEN))
if 'IEN
QUIT
IF IEN'=+MAGJOB("SITEP")
SET X=$PIECE(^(IEN,0),U,9)
IF X]""
SET SHOWPLAC=SHOWPLAC_","_X
+3 ; 1 for true
IF SHOWPLAC]""
SET SHOWPLAC=1_U_SHOWPLAC_","
+4 QUIT SHOWPLAC
+5 ;
LSTOUT(MAGGRY,LSTID,MAGLST,LSTAGE,WRNMSG) ; Build output list, w/ sort & selection
+1 ; Input: LSTID=List def'n
+2 ; MAGLST=Indirect global ref for input records; all reads use subscript indirection
+3 ; the nodes in @MAGLST contain:
+4 ;
+5 ; Node 1 corresponds to IENs 1:17 from Data Elements dic:
+6 ; Acn# ^ Ex LOCK ^ PtName ^ Pt_ID ^ Priority ^ Proc ^ Img Date/Time ^ Status ^ # Images ^ Online?
+7 ; Img Loc'n ^ Remote Ind. ^ Images Exist? ^ Img Date/Time-sortable ^ Mdl ^ Status/Internal ^ ImgTypABB
+8 ; Node 2-- IEN's 18:28 from Data Elements dic:
+9 ; REQLOCAbb ^ REQLOCNm ^ Interp Rad'ists ^ Last4 SSN ^ Division ^ Site ^ Rist Is Me? ^ ProcMod ^ REQLOCTyp ^ CPT
+10 ; WARD
+11 ; Node 2 then appends 3 pipe-delim pieces that are passed through from list compiler (See svmag2a^magjls3)
+12 ;
+13 ; Node "ISI"--IEN's 201,ff from Data Elements dic ; ISI
+14 ;
+15 ; LSTAGE=optional List age from last compile, in seconds
+16 ; WRNMSG=optional message to append to list title, to warn of possible compile problems
+17 ; Output: MAGGRY=Indirect ref to output file
+18 ;
+19 NEW DIS,MDCVAR,SNDREMOT,ILST,IMD,MAGRACNT
+20 NEW RARPT,RAST,RADFN,RACNI,RADTI,T,WHOLOCK,XX,MYLOCK,DAYCASE,MODALITY
+21 NEW OUT,QX,SORT,SORTSS,LSTHDR,MD,MDLVAR,MDSVAR,REMONLY,REMOTCAS
+22 NEW SHOWPLAC,SORTLEN,STATPRIORITY
+23 ; ISI
NEW XX2,XX9,ASIGENA,T
+24 SET LSTAGE=$GET(LSTAGE)
SET WRNMSG=$GET(WRNMSG)
+25 ; Show any Place (Site Code) that is NOT the Login Place
SET SHOWPLAC=$$SHOWPLAC("")
+26 SET REMONLY=0
+27 SET XX=$GET(^MAG(2006.69,1,0))
SET SNDREMOT=+$PIECE(XX,U,11)
+28 ; show remote cache only?
IF $GET(MAGJOB("REMOTE"))
Begin DoDot:1
+29 ; ISI remove deprecated logic
+30 ; Hist list ; ISI
if (LSTREQ="H")
QUIT
SET REMONLY=+$GET(MAGJOB("REMOTESCREEN"))
End DoDot:1
+31 ; ISI
SET XX=$GET(^MAG(2006.69,1,"ISI"))
SET ASIGENA=($PIECE(XX,U,1)="Y")
+32 DO SETVARS(LSTID)
+33 ; ISI -- Dynamic Query search & columns logic
IF LSTREQ="I"
IF $GET(DATA01)=9820
DO SETVARS^ISIJLS2(.DIS,.MDCVAR,.LSTHDR,.MDLVAR)
+34 SET MAGRACNT=0
+35 SET SORT="^TMP("_$JOB_",""MAGJSORT"""
SET SORTLEN=$LENGTH(SORT)
KILL ^TMP($JOB,"MAGJSORT")
+36 KILL ^TMP($JOB,"RET")
SET ^TMP($JOB,"RET",0)="0^4~Getting Exam List"
+37 ; No exams to list!
SET X=$GET(@MAGLST@(0,1))
IF +X<1
Begin DoDot:1
+38 IF X=""
SET ^TMP($JOB,"RET",0)="0^4~Problem with Exams List Compile"
+39 IF '$TEST
SET ^TMP($JOB,"RET",0)=X
End DoDot:1
GOTO LSTOUTZ
+40 SET ILST=0
+41 ; contents described above ; ISI
FOR
SET ILST=$ORDER(@MAGLST@(ILST))
if 'ILST
QUIT
SET XX=^(ILST,1)
SET XX2=^(2)
SET XX9=$GET(^("ISI"))
KILL MD
Begin DoDot:1
+42 SET XX=XX_U_$PIECE(XX2,"|")
SET $PIECE(XX2,"|")=""
+43 ; ISI new line loc'n for Jordan efficiency ; Screen Unread/Pending/Active exams for DIVision
IF ("UPA"[LSTREQ)
IF $GET(MAGJOB("CONSOLIDATED"))
SET RADIV=$PIECE(XX,U,22)
IF RADIV]""
IF '$DATA(MAGJOB("DIVSCRN",RADIV))
QUIT
+44 ; ISI new line loc'n: make Key vars available to all subsequent logic
SET T=$PIECE(XX2,"|",2)
SET RADFN=$PIECE(T,U)
SET RADTI=$PIECE(T,U,2)
SET RACNI=$PIECE(T,U,3)
SET RARPT=$PIECE(T,U,4)
+45 ; ISI, ditto
SET RAST=$PIECE(XX,U,16)
+46 ; calculate value @ list output time
SET $PIECE(XX,U,24)=$$RISTISME($PIECE(XX,U,24))
+47 ; ISI calc truth value based on ~assign status & to whom
SET $PIECE(XX9,U,3)=$$ASIGME^ISIJUTL1($PIECE(XX9,U,3),DATA01,RAST)
+48 ; Execute Selection logic
+49 ; ISI mod to handle ISI-added fields
SET X=0
FOR
SET X=$ORDER(MDCVAR(X))
if 'X
QUIT
Begin DoDot:2
+50 ; load needed data
IF X<200
SET MD(X)=$PIECE(XX,U,X)
+51 ; ISI added fields stored here
IF '$TEST
SET MD(X)=$PIECE(XX9,U,X-200)
End DoDot:2
+52 ; quit if search logic True
IF 1
FOR I=1:1:$GET(DIS(0))
XECUTE DIS(I)
IF $TEST
QUIT
+53 ; failed selection criteria--skip
IF '$TEST
QUIT
+54 ; ISI - assigned, do not display to user acc to asigme fn above
IF ("UPA"[LSTREQ)
IF '$PIECE(XX9,U,3)
QUIT
+55 ; No longer Unread!
IF LSTREQ="U"
IF '$DATA(^RADPT("AS",RAST,RADFN,RADTI,RACNI))
QUIT
+56 SET REMOTCAS=$PIECE(XX,U,12)
+57 ; don't show if not routed
IF REMONLY
IF 'REMOTCAS
QUIT
+58 ; don't show if not the remote reading site
IF REMONLY
IF REMOTCAS
Begin DoDot:2
+59 FOR I=1:1:$LENGTH(REMOTCAS,",")+1
SET T=$PIECE(REMOTCAS,",",I)
IF T
IF $DATA(MAGJOB("LOC",T))
QUIT
End DoDot:2
IF 'T
QUIT
+60 ; set up sort values, creating sort index w/ indirect reference to sort global
+61 ; ISI mod to handle ISI-added fields
FOR I=1:1:$LENGTH(MDSVAR,U)
SET X=+$PIECE(MDSVAR,U,I)
Begin DoDot:2
+62 ; ISI
IF X<200
SET MD(X)=$PIECE(XX,U,X)
IF MD(X)=""
SET MD(X)="~"
+63 ; ISI range start @201
IF X>200
SET MD(X)=$PIECE(XX9,U,X-200)
IF MD(X)=""
SET MD(X)="~"
End DoDot:2
+64 ; P18 adds ILST so History List can allow mult entries of same exam, in fifo order
IF LSTREQ="H"
SET @(SORT_",ILST,"_SORTSS_")")=ILST_U_RARPT
+65 IF '$TEST
SET @(SORT_","_SORTSS_")")=ILST_U_RARPT
+66 SET MAGRACNT=MAGRACNT+1
End DoDot:1
+67 IF 'MAGRACNT
SET ^TMP($JOB,"RET",0)="0^2~No Exams Found"
+68 ; generate output file
IF '$TEST
Begin DoDot:1
+69 ; define $Query var.; init beginning w/ dummy entry
SET @(SORT_","_-9999999999_")")=0
SET QX=SORT_")"
+70 ; proceed thru sort index until the string contained in SORT is not present
+71 ; get data w/ indirect refs to the stored data
+72 ; ISI
FOR ILST=0:1
SET QX=$QUERY(@QX)
if ($EXTRACT(QX,1,SORTLEN))'=SORT
QUIT
SET XX=@MAGLST@(+(@QX),1)
SET XX2=^(2)
SET XX9=$GET(^("ISI"))
SET OUT=""
Begin DoDot:2
+73 ; Header string
IF 'ILST
Begin DoDot:3
+74 SET T=""
IF LSTAGE?1N.N
SET T=LSTAGE\60
SET T=" (List age: "_$SELECT(T:T_" min, ",1:"")_(LSTAGE#60)_" sec)"
+75 IF WRNMSG]""
SET T=T_" ** "_WRNMSG_" **"
+76 ; List Title
IF +$PIECE(XX,U,2)=1
SET $PIECE(XX,"~",2)=LSTTL_T
+77 SET ^TMP($JOB,"RET",0)=XX
End DoDot:3
QUIT
+78 SET XX=XX_U_$PIECE(XX2,"|")
SET $PIECE(XX2,"|")=""
+79 ; calculate value @ list output time
SET $PIECE(XX,U,24)=$$RISTISME($PIECE(XX,U,24))
+80 ; ISI calc value @ output time
SET $PIECE(XX9,U,3)=$$ASIGME^ISIJUTL1($PIECE(XX9,U,3),DATA01,$PIECE(XX9,U,16))
+81 SET RARPT=$PIECE(@QX,U,2)
SET DAYCASE=$PIECE(XX,U)
+82 SET T=$$CHKLOCK(RARPT,DAYCASE)
SET WHOLOCK=$PIECE(T,U)
SET MYLOCK=$PIECE(T,U,2)
+83 SET $PIECE(XX,U,2)=WHOLOCK
+84 SET MODALITY=$PIECE(XX,U,15)
SET STATPRIORITY=0
+85 ; ISI
FOR IMD=1:1:$LENGTH(MDLVAR,U)
SET X=$PIECE(MDLVAR,U,IMD)
SET MD=$SELECT(+X<200:$PIECE(XX,U,+X),1:$PIECE(XX9,U,X-200))
Begin DoDot:3
+86 IF +X=12
IF (MD]"")
IF SNDREMOT
Begin DoDot:4
+87 ; if site routes images, disp Remote Cache ind.
+88 NEW I,T
SET T=""
FOR I=1:1:$LENGTH(MD,",")
SET T=T_$SELECT(T="":"",1:",")_$PIECE($GET(^MAG(2005.2,$PIECE(MD,",",I),3)),U,5)
+89 SET MD=T
End DoDot:4
+90 IF +X=23
IF (MD]"")
IF SHOWPLAC
Begin DoDot:4
+91 ; Don't show user's local place
IF SHOWPLAC'[(","_MD_",")
SET MD=""
End DoDot:4
+92 IF +X=22
IF (MD]"")
IF $GET(MAGJOB("CONSOLIDATED"))
Begin DoDot:4
+93 ; Don't show user's local Div
IF '$DATA(MAGJOB("DIVSCRN",MD))
SET MD=""
End DoDot:4
+94 ; Stat or Urgent Unread exam
IF +X=5
IF (LSTREQ="U")
IF (MD]"")
IF ("1-Stat^2-Urg"[MD)
SET STATPRIORITY=1
+95 ; truncate output col
IF X[";"
SET T=+$PIECE(X,";",2)
IF T
SET MD=$EXTRACT(MD,1,T)
+96 SET $PIECE(OUT,U,IMD)=MD
End DoDot:3
+97 SET $PIECE(OUT,U,IMD+1)=""
SET OUT=U_OUT
SET OUT=OUT_"|"_$PIECE(XX2,"|",2,9)
+98 SET T=$PIECE(OUT,"|",4)
Begin DoDot:3
+99 ; pass lock info to Client
IF WHOLOCK]""
SET $PIECE(T,U,2)=WHOLOCK
SET $PIECE(T,U,3)=MYLOCK
+100 SET $PIECE(T,U,11)=STATPRIORITY
End DoDot:3
SET $PIECE(OUT,"|",4)=T
+101 ; * Note: Keep Pipe piece 4, above, in sync with svmag2a^magjls3 *
+102 SET ^TMP($JOB,"RET",ILST+1)=OUT
End DoDot:2
+103 SET ^TMP($JOB,"RET",1)=U_LSTHDR
+104 SET $PIECE(^TMP($JOB,"RET",0),U)=MAGRACNT
End DoDot:1
LSTOUTZ KILL MAGGRY,^TMP($JOB,"MAGJSORT")
SET MAGGRY=$NAME(^TMP($JOB,"RET"))
+1 QUIT
+2 ;
RISTISME(X) ; calculate truth value for Interpreting Rist = Logon Rist
+1 ; input zero to 2 DUZ values Rist1~Rist2
+2 ; output Y or N for truth value
+3 NEW Y
SET Y="N"
+4 IF X]""
Begin DoDot:1
+5 NEW I
FOR I=1,2
IF +$PIECE(X,"~",I)=DUZ
SET Y="Y"
QUIT
End DoDot:1
+6 if $QUIT
QUIT Y
QUIT
+7 ;
UPDR ; Add Newly Interp exams to Recent; called from magjls2
+1 DO PARAMS(9995)
+2 IF LSTID
Begin DoDot:1
+3 SET X=$$CURLIST^MAGJLS2(LSTNAM)
SET LSTAGE=$PIECE(X,U,2)
SET LSTNUM=+X
+4 DO LSTCOMP^MAGJLS2()
End DoDot:1
UPDRZ QUIT
+1 ;
END ;
