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