- 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 Feb 18, 2025@23:33:14 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 ;