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

MAGJLS2B.m

Go to the documentation of this file.
  1. 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
  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**
  1. Q
  1. ;
  1. PARAMS(X) ; Init some vars used for Exam Lists
  1. N LASTEDIT
  1. S LSTID=+$O(^MAG(2006.631,"C",X,""))
  1. I 'LSTID S LSTID="Invalid List ID" Q ;
  1. S X=^MAG(2006.631,LSTID,0)
  1. I '$P(X,U,6) S LSTID="LIST NOT ENABLED" Q ;
  1. S LSTTL=$P(X,U),LSTREQ=$P(X,U,3),LSTPARAM=LSTREQ_U_$P(X,U,4),LASTEDIT=$P(X,U,5)
  1. 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
  1. I $P(LSTPARAM,U,2)="" S $P(LSTPARAM,U,2)="ALL" ; dflt All ImagingTypes
  1. S X=$G(^MAG(2006.69,1,0)),BKGND=+$P(X,U,8),DELTA=+$P(X,U,$S(LSTREQ="U":9,1:13))*60
  1. I BKGND,'DELTA S DELTA=360 ;dflt Unread List compile cycle time secs
  1. S LSTNAM="LS"_LSTID
  1. 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
  1. Q
  1. ;
  1. SETVARS(LSTID) ;output control variables
  1. D LSTVAR(LSTID),SRTVAR(LSTID),SELVAR(LSTID)
  1. Q
  1. ;
  1. LSTVAR(LSTID) ; build output columns string
  1. S MDLVAR=^MAG(2006.631,LSTID,"DEF",1),LSTHDR=^(.5)
  1. N I,XX,SC,XOUT,XOUT2
  1. S SC=";",XOUT="",XOUT2=""
  1. F I=1:1:$L(MDLVAR,U) S XX=$P(MDLVAR,U,I) D
  1. . I +XX=12 I '$G(SNDREMOT) Q ; exclude RC ind
  1. . I +XX=23 I '$G(SHOWPLAC) Q ; exclude PLACE
  1. . I +XX=201!(+XX=202)!(+XX=203) I '$G(ASIGENA) Q ; ISI exclude ASSIGN info?
  1. . S XOUT=XOUT_$S(XOUT="":"",1:U)_XX
  1. . S XOUT2=XOUT2_$S(XOUT2="":"",1:U)_$P(LSTHDR,U,I)
  1. S MDLVAR=XOUT,LSTHDR=XOUT2
  1. Q
  1. SRTVAR(LSTID) ; build sort-vars string in SORTSS
  1. ; indirection used to ref string at list output (see LSTOUT)
  1. S MDSVAR=^MAG(2006.631,LSTID,"DEF",2)
  1. N I,XX,XOUT,HAVEONE
  1. S SORTSS="",XOUT="",HAVEONE=0
  1. F I=1:1:$L(MDSVAR,U) S XX=$P(MDSVAR,U,I) D
  1. . I +XX=12 Q:'$G(SNDREMOT) ; exclude RC ind
  1. . I +XX=23 I '$G(SHOWPLAC) Q ; exclude PLACE
  1. . I +XX=201!(+XX=202)!(+XX=203) I '$G(ASIGENA) Q ; ISI exclude ASSIGN info?
  1. . I 'HAVEONE S HAVEONE=(+XX=1) ; 1 = Case #
  1. . S XOUT=XOUT_$S(XOUT="":"",1:U)_XX
  1. . S XX=$S(XX?1N.N1"-":"-",1:"")_"MD("_+XX_")"
  1. . S SORTSS=SORTSS_","_XX
  1. I 'HAVEONE S SORTSS=SORTSS_",MD(1)",XOUT=XOUT_U_1 ; force unique entry each exam
  1. I $E(SORTSS)="," S SORTSS=$E(SORTSS,2,999)
  1. S MDSVAR=XOUT
  1. Q
  1. ;
  1. SELVAR(LSTID) ; build selection logic executes in DIS array
  1. N CX,DC,DCX,DL,DLX,EXP,I,IDL,SELVAR,SELVAR2,SS
  1. S SS=0 F S SS=$O(^MAG(2006.631,LSTID,"DEF",3,SS)) Q:'SS S DC(SS)=^(SS)
  1. S SS=0 F I=1:1 S SS=$O(^MAG(2006.631,LSTID,"DEF",4,SS)) Q:'SS S DL(I)=^(SS)
  1. ; DL(5)="^2^3'^" <DLX CX=3' DC(2)="1^>44" <DCX
  1. K DIS,MDCVAR S DIS(0)=0
  1. F IDL=1:1 S DLX=$G(DL(IDL)) Q:DLX="" S DIS(0)=DIS(0)+1,DIS(DIS(0))="" D
  1. . F I=2:1:$L(DLX,U)-1 S CX=$P(DLX,U,I) S DCX=DC(+CX) D
  1. . . S EXP="(MD("_+DCX_")"_$P(DCX,U,2)_")"
  1. . . S EXP="I "_$S(CX["'":"'",1:"")_EXP
  1. . . S DIS(DIS(0))=DIS(DIS(0))_" "_EXP
  1. . . S MDCVAR(+DCX)=""
  1. Q
  1. ;
  1. CHKLOCK(RARPT,DAYCASE) ; return ini of locking user & truth flag for locking user = logon user
  1. N RESULT,WHO,MYLOCK,X,XX
  1. S (MYLOCK,WHO)=""
  1. I RARPT,(DAYCASE]"") D
  1. . I $D(^XTMP("MAGJ","LOCK",RARPT)) D
  1. . . D LOCKACT^MAGJEX1A(RARPT,DAYCASE,100,.RESULT)
  1. . . I $D(RESULT)>1 D
  1. . . . S X=RESULT(1),WHO=$P(X,U,5)
  1. . . . I WHO]"" S MYLOCK=+X
  1. . . . E D
  1. . . . . S X=RESULT(2),WHO=$P(X,U,5)
  1. . . . . I WHO]"" S WHO=WHO_":R",MYLOCK=+X I MYLOCK S MYLOCK=2
  1. S XX=WHO_U_MYLOCK
  1. Q:$Q XX Q
  1. ;
  1. SHOWPLAC(X) ; return list of places to show: all defined places NOT equal to user's logon place
  1. N IEN,SHOWPLAC S SHOWPLAC=""
  1. 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
  1. I SHOWPLAC]"" S SHOWPLAC=1_U_SHOWPLAC_"," ; 1 for true
  1. Q SHOWPLAC
  1. ;
  1. LSTOUT(MAGGRY,LSTID,MAGLST,LSTAGE,WRNMSG) ; Build output list, w/ sort & selection
  1. ; Input: LSTID=List def'n
  1. ; MAGLST=Indirect global ref for input records; all reads use subscript indirection
  1. ; the nodes in @MAGLST contain:
  1. ;
  1. ; Node 1 corresponds to IENs 1:17 from Data Elements dic:
  1. ; Acn# ^ Ex LOCK ^ PtName ^ Pt_ID ^ Priority ^ Proc ^ Img Date/Time ^ Status ^ # Images ^ Online?
  1. ; Img Loc'n ^ Remote Ind. ^ Images Exist? ^ Img Date/Time-sortable ^ Mdl ^ Status/Internal ^ ImgTypABB
  1. ; Node 2-- IEN's 18:28 from Data Elements dic:
  1. ; REQLOCAbb ^ REQLOCNm ^ Interp Rad'ists ^ Last4 SSN ^ Division ^ Site ^ Rist Is Me? ^ ProcMod ^ REQLOCTyp ^ CPT
  1. ; WARD
  1. ; Node 2 then appends 3 pipe-delim pieces that are passed through from list compiler (See svmag2a^magjls3)
  1. ;
  1. ; Node "ISI"--IEN's 201,ff from Data Elements dic ; ISI
  1. ;
  1. ; LSTAGE=optional List age from last compile, in seconds
  1. ; WRNMSG=optional message to append to list title, to warn of possible compile problems
  1. ; Output: MAGGRY=Indirect ref to output file
  1. ;
  1. N DIS,MDCVAR,SNDREMOT,ILST,IMD,MAGRACNT
  1. N RARPT,RAST,RADFN,RACNI,RADTI,T,WHOLOCK,XX,MYLOCK,DAYCASE,MODALITY
  1. N OUT,QX,SORT,SORTSS,LSTHDR,MD,MDLVAR,MDSVAR,REMONLY,REMOTCAS
  1. N SHOWPLAC,SORTLEN,STATPRIORITY
  1. N XX2,XX9,ASIGENA,T ; ISI
  1. S LSTAGE=$G(LSTAGE),WRNMSG=$G(WRNMSG)
  1. S SHOWPLAC=$$SHOWPLAC("") ; Show any Place (Site Code) that is NOT the Login Place
  1. S REMONLY=0
  1. S XX=$G(^MAG(2006.69,1,0)),SNDREMOT=+$P(XX,U,11)
  1. I $G(MAGJOB("REMOTE")) D ; show remote cache only?
  1. . ; ISI remove deprecated logic
  1. . Q:(LSTREQ="H") S REMONLY=+$G(MAGJOB("REMOTESCREEN")) ; Hist list ; ISI
  1. S XX=$G(^MAG(2006.69,1,"ISI")),ASIGENA=($P(XX,U,1)="Y") ; ISI
  1. D SETVARS(LSTID)
  1. I LSTREQ="I",$G(DATA01)=9820 D SETVARS^ISIJLS2(.DIS,.MDCVAR,.LSTHDR,.MDLVAR) ; ISI -- Dynamic Query search & columns logic
  1. S MAGRACNT=0
  1. S SORT="^TMP("_$J_",""MAGJSORT""",SORTLEN=$L(SORT) K ^TMP($J,"MAGJSORT")
  1. K ^TMP($J,"RET") S ^TMP($J,"RET",0)="0^4~Getting Exam List"
  1. S X=$G(@MAGLST@(0,1)) I +X<1 D G LSTOUTZ ; No exams to list!
  1. . I X="" S ^TMP($J,"RET",0)="0^4~Problem with Exams List Compile"
  1. . E S ^TMP($J,"RET",0)=X
  1. S ILST=0
  1. F S ILST=$O(@MAGLST@(ILST)) Q:'ILST S XX=^(ILST,1),XX2=^(2),XX9=$G(^("ISI")) K MD D ; contents described above ; ISI
  1. . S XX=XX_U_$P(XX2,"|"),$P(XX2,"|")=""
  1. . 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
  1. . 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
  1. . S RAST=$P(XX,U,16) ; ISI, ditto
  1. . S $P(XX,U,24)=$$RISTISME($P(XX,U,24)) ; calculate value @ list output time
  1. . S $P(XX9,U,3)=$$ASIGME^ISIJUTL1($P(XX9,U,3),DATA01,RAST) ; ISI calc truth value based on ~assign status & to whom
  1. . ; Execute Selection logic
  1. . S X=0 F S X=$O(MDCVAR(X)) Q:'X D ; ISI mod to handle ISI-added fields
  1. . . I X<200 S MD(X)=$P(XX,U,X) ; load needed data
  1. . . E S MD(X)=$P(XX9,U,X-200) ; ISI added fields stored here
  1. . I 1 F I=1:1:$G(DIS(0)) X DIS(I) I Q ; quit if search logic True
  1. . E Q ; failed selection criteria--skip
  1. . I ("UPA"[LSTREQ),'$P(XX9,U,3) Q ; ISI - assigned, do not display to user acc to asigme fn above
  1. . I LSTREQ="U",'$D(^RADPT("AS",RAST,RADFN,RADTI,RACNI)) Q ; No longer Unread!
  1. . S REMOTCAS=$P(XX,U,12)
  1. . I REMONLY,'REMOTCAS Q ; don't show if not routed
  1. . I REMONLY,REMOTCAS D I 'T Q ; don't show if not the remote reading site
  1. . . F I=1:1:$L(REMOTCAS,",")+1 S T=$P(REMOTCAS,",",I) I T,$D(MAGJOB("LOC",T)) Q
  1. . ; set up sort values, creating sort index w/ indirect reference to sort global
  1. . F I=1:1:$L(MDSVAR,U) S X=+$P(MDSVAR,U,I) D ; ISI mod to handle ISI-added fields
  1. . . I X<200 S MD(X)=$P(XX,U,X) I MD(X)="" S MD(X)="~" ; ISI
  1. . . I X>200 S MD(X)=$P(XX9,U,X-200) I MD(X)="" S MD(X)="~" ; ISI range start @201
  1. . 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
  1. . E S @(SORT_","_SORTSS_")")=ILST_U_RARPT
  1. . S MAGRACNT=MAGRACNT+1
  1. I 'MAGRACNT S ^TMP($J,"RET",0)="0^2~No Exams Found"
  1. E D ; generate output file
  1. . S @(SORT_","_-9999999999_")")=0,QX=SORT_")" ; define $Query var.; init beginning w/ dummy entry
  1. . ; proceed thru sort index until the string contained in SORT is not present
  1. . ; get data w/ indirect refs to the stored data
  1. . 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
  1. . . I 'ILST D Q ; Header string
  1. . . . S T="" I LSTAGE?1N.N S T=LSTAGE\60 S T=" (List age: "_$S(T:T_" min, ",1:"")_(LSTAGE#60)_" sec)"
  1. . . . I WRNMSG]"" S T=T_" ** "_WRNMSG_" **"
  1. . . . I +$P(XX,U,2)=1 S $P(XX,"~",2)=LSTTL_T ; List Title
  1. . . . S ^TMP($J,"RET",0)=XX
  1. . . S XX=XX_U_$P(XX2,"|"),$P(XX2,"|")=""
  1. . . S $P(XX,U,24)=$$RISTISME($P(XX,U,24)) ; calculate value @ list output time
  1. . . S $P(XX9,U,3)=$$ASIGME^ISIJUTL1($P(XX9,U,3),DATA01,$P(XX9,U,16)) ; ISI calc value @ output time
  1. . . S RARPT=$P(@QX,U,2),DAYCASE=$P(XX,U)
  1. . . S T=$$CHKLOCK(RARPT,DAYCASE),WHOLOCK=$P(T,U),MYLOCK=$P(T,U,2)
  1. . . S $P(XX,U,2)=WHOLOCK
  1. . . S MODALITY=$P(XX,U,15),STATPRIORITY=0
  1. . . 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
  1. . . . I +X=12,(MD]""),SNDREMOT D
  1. . . . . ; if site routes images, disp Remote Cache ind.
  1. . . . . 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)
  1. . . . . S MD=T
  1. . . . I +X=23,(MD]""),SHOWPLAC D
  1. . . . . I SHOWPLAC'[(","_MD_",") S MD="" ; Don't show user's local place
  1. . . . I +X=22,(MD]""),$G(MAGJOB("CONSOLIDATED")) D
  1. . . . . I '$D(MAGJOB("DIVSCRN",MD)) S MD="" ; Don't show user's local Div
  1. . . . I +X=5,(LSTREQ="U"),(MD]""),("1-Stat^2-Urg"[MD) S STATPRIORITY=1 ; Stat or Urgent Unread exam
  1. . . . I X[";" S T=+$P(X,";",2) I T S MD=$E(MD,1,T) ; truncate output col
  1. . . . S $P(OUT,U,IMD)=MD
  1. . . S $P(OUT,U,IMD+1)="",OUT=U_OUT,OUT=OUT_"|"_$P(XX2,"|",2,9)
  1. . . S T=$P(OUT,"|",4) D S $P(OUT,"|",4)=T
  1. . . . I WHOLOCK]"" S $P(T,U,2)=WHOLOCK,$P(T,U,3)=MYLOCK ; pass lock info to Client
  1. . . . S $P(T,U,11)=STATPRIORITY
  1. . . ; * Note: Keep Pipe piece 4, above, in sync with svmag2a^magjls3 *
  1. . . S ^TMP($J,"RET",ILST+1)=OUT
  1. . S ^TMP($J,"RET",1)=U_LSTHDR
  1. . S $P(^TMP($J,"RET",0),U)=MAGRACNT
  1. LSTOUTZ K MAGGRY,^TMP($J,"MAGJSORT") S MAGGRY=$NA(^TMP($J,"RET"))
  1. Q
  1. ;
  1. RISTISME(X) ; calculate truth value for Interpreting Rist = Logon Rist
  1. ; input zero to 2 DUZ values Rist1~Rist2
  1. ; output Y or N for truth value
  1. N Y S Y="N"
  1. I X]"" D
  1. . N I F I=1,2 I +$P(X,"~",I)=DUZ S Y="Y" Q
  1. Q:$Q Y Q
  1. ;
  1. UPDR ; Add Newly Interp exams to Recent; called from magjls2
  1. D PARAMS(9995)
  1. I LSTID D
  1. . S X=$$CURLIST^MAGJLS2(LSTNAM),LSTAGE=$P(X,U,2),LSTNUM=+X
  1. . D LSTCOMP^MAGJLS2()
  1. UPDRZ Q
  1. ;
  1. END ;