| 1 | MAGJLS2B ;WIRMFO/JHC VistARad RPC calls ; 29 Jul 2003 9:59 AM
|
|---|
| 2 | ;;3.0;IMAGING;**16,22,18,76**;Jun 22, 2007;Build 19
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;; +---------------------------------------------------------------+
|
|---|
| 5 | ;; | Property of the US Government. |
|
|---|
| 6 | ;; | No permission to copy or redistribute this software is given. |
|
|---|
| 7 | ;; | Use of unreleased versions of this software requires the user |
|
|---|
| 8 | ;; | to execute a written test agreement with the VistA Imaging |
|
|---|
| 9 | ;; | Development Office of the Department of Veterans Affairs, |
|
|---|
| 10 | ;; | telephone (301) 734-0100. |
|
|---|
| 11 | ;; | |
|
|---|
| 12 | ;; | The Food and Drug Administration classifies this software as |
|
|---|
| 13 | ;; | a medical device. As such, it may not be changed in any way. |
|
|---|
| 14 | ;; | Modifications to this software may result in an adulterated |
|
|---|
| 15 | ;; | medical device under 21CFR820, the use of which is considered |
|
|---|
| 16 | ;; | to be a violation of US Federal Statutes. |
|
|---|
| 17 | ;; +---------------------------------------------------------------+
|
|---|
| 18 | ;;
|
|---|
| 19 | Q
|
|---|
| 20 | ;
|
|---|
| 21 | PARAMS(X) ; Init some vars used for Exam Lists
|
|---|
| 22 | N LASTEDIT
|
|---|
| 23 | S LSTID=+$O(^MAG(2006.631,"C",X,""))
|
|---|
| 24 | I 'LSTID S LSTID="Invalid List ID" Q ;
|
|---|
| 25 | S X=^MAG(2006.631,LSTID,0)
|
|---|
| 26 | I '$P(X,U,6) S LSTID="LIST NOT ENABLED" Q ;
|
|---|
| 27 | S LSTTL=$P(X,U),LSTREQ=$P(X,U,3),LSTPARAM=LSTREQ_U_$P(X,U,4),LASTEDIT=$P(X,U,5)
|
|---|
| 28 | S LSTTL=$S(LSTREQ="U":"UNREAD",LSTREQ="R":"RECENT",LSTREQ="A":"ACTIVE",LSTREQ="P":"PENDING",LSTREQ="N":"NEWLY INTERP",LSTREQ="H":"HISTORY",1:"")_" EXAMS: "_LSTTL
|
|---|
| 29 | I $P(LSTPARAM,U,2)="" S $P(LSTPARAM,U,2)="ALL" ; dflt All ImagingTypes
|
|---|
| 30 | S X=$G(^MAG(2006.69,1,0)),BKGND=+$P(X,U,8),DELTA=+$P(X,U,$S(LSTREQ="U":9,1:13))*60
|
|---|
| 31 | I BKGND,'DELTA S DELTA=360 ;dflt Unread List compile cycle time secs
|
|---|
| 32 | S LSTNAM="LS"_LSTID
|
|---|
| 33 | 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
|
|---|
| 34 | Q
|
|---|
| 35 | ;
|
|---|
| 36 | SETVARS(LSTID) ;output control variables
|
|---|
| 37 | D LSTVAR(LSTID),SRTVAR(LSTID),SELVAR(LSTID)
|
|---|
| 38 | Q
|
|---|
| 39 | ;
|
|---|
| 40 | LSTVAR(LSTID) ; build output columns string
|
|---|
| 41 | S MDLVAR=^MAG(2006.631,LSTID,"DEF",1),LSTHDR=^(.5)
|
|---|
| 42 | N I,XX,SC,XOUT,XOUT2
|
|---|
| 43 | S SC=";",XOUT="",XOUT2=""
|
|---|
| 44 | F I=1:1:$L(MDLVAR,U) S XX=$P(MDLVAR,U,I) D
|
|---|
| 45 | . I +XX=12 I '$G(SNDREMOT) Q ; exclude RC ind
|
|---|
| 46 | . I +XX=23 I '$G(SHOWPLAC) Q ; exclude PLACE
|
|---|
| 47 | . S XOUT=XOUT_$S(XOUT="":"",1:U)_XX
|
|---|
| 48 | . S XOUT2=XOUT2_$S(XOUT2="":"",1:U)_$P(LSTHDR,U,I)
|
|---|
| 49 | S MDLVAR=XOUT,LSTHDR=XOUT2
|
|---|
| 50 | Q
|
|---|
| 51 | SRTVAR(LSTID) ; build sort-vars string in SORTSS
|
|---|
| 52 | ; indirection used to ref string at list output (see LSTOUT)
|
|---|
| 53 | S MDSVAR=^MAG(2006.631,LSTID,"DEF",2)
|
|---|
| 54 | N I,XX,XOUT,HAVEONE
|
|---|
| 55 | S SORTSS="",XOUT="",HAVEONE=0
|
|---|
| 56 | F I=1:1:$L(MDSVAR,U) S XX=$P(MDSVAR,U,I) D
|
|---|
| 57 | . I +XX=12 Q:'$G(SNDREMOT) ; exclude RC ind
|
|---|
| 58 | . I +XX=23 I '$G(SHOWPLAC) Q ; exclude PLACE
|
|---|
| 59 | . I 'HAVEONE S HAVEONE=(+XX=1) ; 1 = Case #
|
|---|
| 60 | . S XOUT=XOUT_$S(XOUT="":"",1:U)_XX
|
|---|
| 61 | . S XX=$S(XX?1N.N1"-":"-",1:"")_"MD("_+XX_")"
|
|---|
| 62 | . S SORTSS=SORTSS_","_XX
|
|---|
| 63 | I 'HAVEONE S SORTSS=SORTSS_",MD(1)",XOUT=XOUT_U_1 ; force unique entry each exam
|
|---|
| 64 | I $E(SORTSS)="," S SORTSS=$E(SORTSS,2,999)
|
|---|
| 65 | S MDSVAR=XOUT
|
|---|
| 66 | Q
|
|---|
| 67 | ;
|
|---|
| 68 | SELVAR(LSTID) ; build selection logic executes in DIS array
|
|---|
| 69 | N CX,DC,DCX,DL,DLX,EXP,I,IDL,SELVAR,SELVAR2,SS
|
|---|
| 70 | S SS=0 F S SS=$O(^MAG(2006.631,LSTID,"DEF",3,SS)) Q:'SS S DC(SS)=^(SS)
|
|---|
| 71 | S SS=0 F I=1:1 S SS=$O(^MAG(2006.631,LSTID,"DEF",4,SS)) Q:'SS S DL(I)=^(SS)
|
|---|
| 72 | ; DL(5)="^2^3'^" <DLX CX=3' DC(2)="1^>44" <DCX
|
|---|
| 73 | K DIS,MDCVAR S DIS(0)=0
|
|---|
| 74 | F IDL=1:1 S DLX=$G(DL(IDL)) Q:DLX="" S DIS(0)=DIS(0)+1,DIS(DIS(0))="" D
|
|---|
| 75 | . F I=2:1:$L(DLX,U)-1 S CX=$P(DLX,U,I) S DCX=DC(+CX) D
|
|---|
| 76 | .. S EXP="(MD("_+DCX_")"_$P(DCX,U,2)_")"
|
|---|
| 77 | .. S EXP="I "_$S(CX["'":"'",1:"")_EXP
|
|---|
| 78 | .. S DIS(DIS(0))=DIS(DIS(0))_" "_EXP
|
|---|
| 79 | .. S MDCVAR(+DCX)=""
|
|---|
| 80 | Q
|
|---|
| 81 | ;
|
|---|
| 82 | CHKLOCK(RARPT,DAYCASE) ; return ini of locking user & truth flag for locking user = logon user
|
|---|
| 83 | N RESULT,WHO,MYLOCK,X,XX
|
|---|
| 84 | S (MYLOCK,WHO)=""
|
|---|
| 85 | I RARPT,(DAYCASE]"") D
|
|---|
| 86 | . I $D(^XTMP("MAGJ","LOCK",RARPT)) D
|
|---|
| 87 | . . D LOCKACT^MAGJEX1A(RARPT,DAYCASE,100,.RESULT)
|
|---|
| 88 | . . I $D(RESULT)>1 D
|
|---|
| 89 | . . . S X=RESULT(1),WHO=$P(X,U,5)
|
|---|
| 90 | . . . I WHO]"" S MYLOCK=+X
|
|---|
| 91 | . . . E D
|
|---|
| 92 | . . . . S X=RESULT(2),WHO=$P(X,U,5)
|
|---|
| 93 | . . . . I WHO]"" S WHO=WHO_":R",MYLOCK=+X I MYLOCK S MYLOCK=2
|
|---|
| 94 | S XX=WHO_U_MYLOCK
|
|---|
| 95 | Q:$Q XX Q
|
|---|
| 96 | ;
|
|---|
| 97 | SHOWPLAC(X) ; return list of places to show: all defined places NOT equal to user's logon place
|
|---|
| 98 | N IEN,SHOWPLAC S SHOWPLAC=""
|
|---|
| 99 | 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
|
|---|
| 100 | I SHOWPLAC]"" S SHOWPLAC=1_U_SHOWPLAC_"," ; 1 for true
|
|---|
| 101 | Q SHOWPLAC
|
|---|
| 102 | ;
|
|---|
| 103 | LSTOUT(MAGGRY,LSTID,MAGLST,LSTAGE) ; Build output list, w/ sort & selection
|
|---|
| 104 | ; Input: LSTID=List def'n
|
|---|
| 105 | ; MAGLST=Indirect global ref for input records; all reads use subscript indirection
|
|---|
| 106 | ; the nodes in @MAGLST contain:
|
|---|
| 107 | ;
|
|---|
| 108 | ; Node 1 corresponds to IENs 1:17 from Data Elements dic:
|
|---|
| 109 | ; Acn# ^ Ex LOCK ^ PtName ^ Pt_ID ^ Priority ^ Proc ^ Img Date/Time ^ Status ^ # Images ^ Online?
|
|---|
| 110 | ; Img Loc'n ^ Remote Ind. ^ Images Exist? ^ Img Date/Time-sortable ^ Mdl ^ Status/Internal ^ ImgTypABB
|
|---|
| 111 | ; Node 2-- IEN's 18:28 from Data Elements dic:
|
|---|
| 112 | ; REQLOCAbb ^ REQLOCNm ^ Interp Rad'ists ^ Last4 SSN ^ Division ^ Site ^ Rist Is Me? ^ ProcMod ^ REQLOCTyp ^ CPT
|
|---|
| 113 | ; WARD
|
|---|
| 114 | ; Node 2 then appends 3 pipe-delim pieces that are passed through from list compiler (See svmag2a^magjls3)
|
|---|
| 115 | ;
|
|---|
| 116 | ; Output: MAGGRY=Indirect ref to output file
|
|---|
| 117 | ;
|
|---|
| 118 | N DIS,MDCVAR,SNDREMOT,ILST,IMD,MAGRACNT
|
|---|
| 119 | N RARPT,RAST,RADFN,RACNI,RADTI,T,WHOLOCK,XX,MYLOCK,DAYCASE,MODALITY
|
|---|
| 120 | N OUT,QX,SORT,SORTSS,LSTHDR,MD,MDLVAR,MDSVAR,REMONLY,REMOTCAS,SHOWPLAC,SORTLEN
|
|---|
| 121 | S LSTAGE=$G(LSTAGE)
|
|---|
| 122 | S SHOWPLAC=$$SHOWPLAC("") ; Show any Place (Site Code) that is NOT the Login Place
|
|---|
| 123 | S REMONLY=0
|
|---|
| 124 | S XX=$G(^MAG(2006.69,1,0)),SNDREMOT=+$P(XX,U,11)
|
|---|
| 125 | I $G(MAGJOB("REMOTE")) D ; show remote cache only?
|
|---|
| 126 | . I MAGJOB("P32") S REMONLY=+$P(XX,U,10)
|
|---|
| 127 | . E Q:(LSTREQ="H") S REMONLY=+$G(MAGJOB("REMOTESCREEN")) ; Hist list
|
|---|
| 128 | D SETVARS(LSTID)
|
|---|
| 129 | S MAGRACNT=0
|
|---|
| 130 | S SORT="^TMP("_$J_",""MAGJSORT""",SORTLEN=$L(SORT) K ^TMP($J,"MAGJSORT")
|
|---|
| 131 | K ^TMP($J,"RET") S ^TMP($J,"RET",0)="0^4~Getting Exam List"
|
|---|
| 132 | S X=$G(@MAGLST@(0,1)) I +X<1 D G LSTOUTZ ; No exams to list!
|
|---|
| 133 | . I X="" S ^TMP($J,"RET",0)="0^4~Problem with Exams List Compile"
|
|---|
| 134 | . E S ^TMP($J,"RET",0)=X
|
|---|
| 135 | S ILST=0
|
|---|
| 136 | F S ILST=$O(@MAGLST@(ILST)) Q:'ILST S XX=^(ILST,1),XX2=^(2) K MD D ; contents described above
|
|---|
| 137 | . S XX=XX_U_$P(XX2,"|"),$P(XX2,"|")=""
|
|---|
| 138 | . ; Execute Selection logic
|
|---|
| 139 | . S X=0 F S X=$O(MDCVAR(X)) Q:'X S MD(X)=$P(XX,U,X) ; load needed data
|
|---|
| 140 | . I 1 F I=1:1:$G(DIS(0)) X DIS(I) I Q ; quit if search logic True
|
|---|
| 141 | . E Q ; failed selection criteria--skip
|
|---|
| 142 | . S RAST=$P(XX,U,16)
|
|---|
| 143 | . S T=$P(XX2,"|",2),RADFN=$P(T,U),RADTI=$P(T,U,2),RACNI=$P(T,U,3),RARPT=$P(T,U,4)
|
|---|
| 144 | . I LSTREQ="U",'$D(^RADPT("AS",RAST,RADFN,RADTI,RACNI)) Q ; No longer Unread!
|
|---|
| 145 | . I LSTREQ="U",$G(MAGJOB("CONSOLIDATED")) S RADIV=$P(XX,U,22) I RADIV]"",'$D(MAGJOB("DIVSCRN",RADIV)) Q ; Screen Unread exams for DIVision
|
|---|
| 146 | . S REMOTCAS=$P(XX,U,12)
|
|---|
| 147 | . I REMONLY,'REMOTCAS Q ; don't show if not routed
|
|---|
| 148 | . I REMONLY,REMOTCAS D I 'T Q ; don't show if not the remote reading site
|
|---|
| 149 | . . F I=1:1:$L(REMOTCAS,",")+1 S T=$P(REMOTCAS,",",I) I T,$D(MAGJOB("LOC",T)) Q
|
|---|
| 150 | . ; set up sort values, creating sort index w/ indirect reference to sort global
|
|---|
| 151 | . F I=1:1:$L(MDSVAR,U) S X=+$P(MDSVAR,U,I) S MD(X)=$P(XX,U,X) I MD(X)="" S MD(X)="~"
|
|---|
| 152 | . 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
|
|---|
| 153 | . E S @(SORT_","_SORTSS_")")=ILST_U_RARPT
|
|---|
| 154 | . S MAGRACNT=MAGRACNT+1
|
|---|
| 155 | I 'MAGRACNT S ^TMP($J,"RET",0)="0^2~No Exams Found"
|
|---|
| 156 | E D ; generate output file
|
|---|
| 157 | . S @(SORT_","_-9999999999_")")=0,QX=SORT_")" ; define $Query var.; init beginning w/ dummy entry
|
|---|
| 158 | . ; proceed thru sort index until the string contained in SORT is not present
|
|---|
| 159 | . ; get data w/ indirect refs to the stored data
|
|---|
| 160 | . F ILST=0:1 S QX=$Q(@QX) Q:($E(QX,1,SORTLEN))'=SORT S XX=@MAGLST@(+(@QX),1),XX2=^(2),OUT="" D
|
|---|
| 161 | .. I 'ILST D Q ; Header string
|
|---|
| 162 | ... S T="" I LSTAGE?1N.N S T=LSTAGE\60 S T=" (List age: "_$S(T:T_" min, ",1:"")_(LSTAGE#60)_" sec)"
|
|---|
| 163 | ... I +$P(XX,U,2)=1 S $P(XX,"~",2)=LSTTL_T ; List Title
|
|---|
| 164 | ... S ^TMP($J,"RET",0)=XX
|
|---|
| 165 | .. S XX=XX_U_$P(XX2,"|"),$P(XX2,"|")=""
|
|---|
| 166 | .. S RARPT=$P(@QX,U,2),DAYCASE=$P(XX,U)
|
|---|
| 167 | .. S T=$$CHKLOCK(RARPT,DAYCASE),WHOLOCK=$P(T,U),MYLOCK=$P(T,U,2)
|
|---|
| 168 | .. S $P(XX,U,2)=WHOLOCK
|
|---|
| 169 | .. S MODALITY=$P(XX,U,15)
|
|---|
| 170 | .. F IMD=1:1:$L(MDLVAR,U) S X=$P(MDLVAR,U,IMD),MD=$P(XX,U,+X) D
|
|---|
| 171 | ... I +X=12,(MD]""),SNDREMOT D
|
|---|
| 172 | .... ; if site routes images, disp Remote Cache ind.
|
|---|
| 173 | .... 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)
|
|---|
| 174 | .... S MD=T
|
|---|
| 175 | ... I +X=23,(MD]""),SHOWPLAC D
|
|---|
| 176 | .... I SHOWPLAC'[(","_MD_",") S MD="" ; Don't show user's local place
|
|---|
| 177 | ... I +X=22,(MD]""),$G(MAGJOB("CONSOLIDATED")) D
|
|---|
| 178 | .... I '$D(MAGJOB("DIVSCRN",MD)) S MD="" ; Don't show user's local Div
|
|---|
| 179 | ... I X[";" S T=+$P(X,";",2) I T S MD=$E(MD,1,T) ; truncate output col
|
|---|
| 180 | ... S $P(OUT,U,IMD)=MD
|
|---|
| 181 | .. S $P(OUT,U,IMD+1)="",OUT=U_OUT,OUT=OUT_"|"_$P(XX2,"|",2,9)
|
|---|
| 182 | .. I WHOLOCK]"" S T=$P(OUT,"|",4),$P(T,U,2)=WHOLOCK,$P(T,U,3)=MYLOCK,$P(OUT,"|",4)=T ; pass lock info to Client
|
|---|
| 183 | .. ; * Note: Keep Pipe piece 4, above, in sync with svmag2a^magjls3 *
|
|---|
| 184 | .. S ^TMP($J,"RET",ILST+1)=OUT
|
|---|
| 185 | . S ^TMP($J,"RET",1)=U_LSTHDR
|
|---|
| 186 | . S $P(^TMP($J,"RET",0),U)=MAGRACNT
|
|---|
| 187 | LSTOUTZ K MAGGRY,^TMP($J,"MAGJSORT") S MAGGRY=$NA(^TMP($J,"RET"))
|
|---|
| 188 | Q
|
|---|
| 189 | ;
|
|---|
| 190 | UPDR ; Add Newly Interp exams to Recent; called from magjls2
|
|---|
| 191 | D PARAMS(9995)
|
|---|
| 192 | I LSTID D
|
|---|
| 193 | . S X=$$CURLIST^MAGJLS2(LSTNAM),LSTAGE=$P(X,U,2),LSTNUM=+X
|
|---|
| 194 | . D LSTCOMP^MAGJLS2()
|
|---|
| 195 | UPDRZ Q
|
|---|
| 196 | ;
|
|---|
| 197 | END ;
|
|---|
