Changeset 623 for WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGJLS2.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGJLS2.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/IMAGING-MAG-ZMAG/MAGJLS2.m
r613 r623 1 MAGJLS2 ;WIRMFO/JHC Rad. Workstation RPC calls ; 29 Jul 2003 9:58 AM 2 ;;3.0;IMAGING;**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 ; ACTIVE -- list exams (Unread, Recent, &/or Pending) for input Imaging Type(s) 21 ; RPC Call: MAGJ RADACTIVEEXAMS 22 ; BKGND -- EP for Bkgnd Compile of UNREAD list 23 ; BKGND2 -- EP for Bkgnd Compile of RECENT list 24 Q 25 BKGERR S ERRCOUNT=$G(ERRCOUNT)+1 H 3 I ERRCOUNT>2 K ZTQUEUED G ^XUSCLEAN ; prevent bkgnd loop 26 ERR1 I $G(LSTNAM)]"" L -^XTMP("MAGJ2","BKGND",LSTNAM,"COMPILE") 27 L -^XTMP("MAGJ2","BKGND2","RUN") 28 ERR N ERR S ERR=$$EC^%ZOSV S ^TMP($J,"RET",0)="0^4~"_ERR 29 S MAGGRY=$NA(^TMP($J,"RET")) 30 D @^%ZOSF("ERRTN") 31 Q:$Q 1 Q 32 ACTIVE(MAGGRY,DATA) ; EP--get Active (Unread/Recent/Pend) Exam Lists 33 ; MAGGRY holds $NA ref to ^TMP where return msg is assembled 34 ; all refs to MAGGRY use SS indirection 35 ; If not use bkgnd, compile in foregnd 36 ; 37 N BKGND,COMPFAIL,MAGLST,LSTPARAM,LSTREQ,LSTID,LSTNUM,LSTNAM,NEWLIST 38 N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJLS2" 39 S X=$P(DATA,U) D PARAMS^MAGJLS2B(X) 40 I 'LSTID S MAGGRY=$NA(^TMP($J,"RET")),@MAGGRY@(0)="0^4~Problem with Exams List Compile--"_DATA_"." Q 41 I MAGJOB("P32"),+$G(MAGJOB("P32STOP")) S MAGGRY=$NA(^TMP($J,"RET")),@MAGGRY@(0)="0^4~VistARad Patch 32 is no longer supported. Contact Imaging support for the current version of the VistARad client software." Q ; <*> 42 I BKGND,LSTREQ="U" D BKREQU Q ; UNREAD in bkgnd 43 I BKGND,LSTREQ="R" D BKREQR Q ; RECENT in bkgnd 44 I BKGND,LSTREQ="A" D BKREQA(DATA) Q ; ALL Active Exams 45 D FOREGND ; other list types, or bkgnd compile not enabled 46 ACTIVEZ Q 47 ; 48 FOREGND ; compile in foregnd 49 I LSTREQ="H" G HISTORY 50 D BLDACTV^MAGJLS3(.MAGLST,LSTPARAM) 51 D LSTOUT^MAGJLS2B(.MAGGRY,LSTID,MAGLST) K @MAGLST 52 Q 53 ; 54 HISTORY ; compile History list 55 D BLDACTV^MAGJLS3(.MAGLST,LSTPARAM) 56 D LSTOUT^MAGJLS2B(.MAGGRY,LSTID,MAGLST) 57 ; copy data from above compile into History file 58 N EXID,HISTIEN,IEN,REC1,REC2,CDAT,TMP,PC 59 I +$G(@MAGLST@(0,1)) D 60 . S IEN="" F S IEN=$O(@MAGLST@(IEN)) Q:(IEN="") S REC1=^(IEN,1),REC2=^(2) D 61 . . I IEN=0 S ^XTMP("MAGJ2","HISTORY",DUZ,DUZ(2),IEN,1)=REC1,^(2)=REC2 Q ; header string 62 . . S HISTIEN=+$P(REC2,"|",3) Q:'HISTIEN S EXID=$P(REC2,"|",2) 63 . . S X=$G(^XTMP("MAGJ2","HISTORY",DUZ,DUZ(2),0,"ADD",HISTIEN)) 64 . . I X]"" D 65 . . . I EXID'=$P(X,"|",2) Q 66 . . . ; copy Client data into list column fields 12-15 in node 2 67 . . . S CDAT=$P(REC2,"|",3),TMP=$P(REC2,"|") 68 . . . F I=1:1:4 S PC=11+I,$P(TMP,U,PC)=$P(CDAT,U,I) 69 . . . S TMP=TMP_U ; pad extra nil piece 70 . . . S $P(REC2,"|")=TMP,$P(REC2,"|",3)=HISTIEN ; preserve IEN in PP3 71 . . . S ^XTMP("MAGJ2","HISTORY",DUZ,DUZ(2),HISTIEN,1)=REC1,^(2)=REC2 72 . . . K ^XTMP("MAGJ2","HISTORY",DUZ,DUZ(2),0,"ADD",HISTIEN) ; Kill input node 73 K @MAGLST 74 Q 75 ; 76 BKREQU ; UNREAD exams from bkgnd 77 L +^XTMP("MAGJ2","BKGND2","RUN"):0 78 E D BKOUT("UNREAD") Q ; bkgnd process IS running 79 ; NOT running, so start it! 80 ; 2nd errtrap is to deal with locks if error occurs 81 N $ETRAP,$ESTACK S $ETRAP="D ERR1^MAGJLS2" 82 N ZTDESC,ZTDTH,ZTIO,ZTRTN 83 S ZTRTN="BKGND^MAGJLS2",ZTDESC="IMAGING VistaRad UNREAD List Compile" 84 S ZTDTH=$H,ZTIO="" D ^%ZTLOAD 85 S X=$$CURLIST(LSTNAM),LSTAGE=$P(X,U,2),LSTNUM=+X 86 I LSTAGE>(DELTA+300) S BKGPROC=2 D ; Foregnd compile if need fresh list 87 . D LSTCOMP(.COMPFAIL) K BKGPROC S X=$$CURLIST(LSTNAM),LSTAGE=$P(X,U,2),LSTNUM=+X 88 L -^XTMP("MAGJ2","BKGND2","RUN") 89 I +$G(COMPFAIL) S MAGGRY=$NA(^TMP($J,"RET")),@MAGGRY@(0)="0^4~Unable to Compile Unread Exams list" 90 E D LSTOUT^MAGJLS2B(.MAGGRY,LSTID,$NA(^XTMP("MAGJ2",LSTNAM,LSTNUM)),LSTAGE) 91 K LSTAGE 92 Q 93 ; 94 BKREQR ; Recent Exams from bkgnd 95 D BKOUT("RECENT") 96 Q 97 ; 98 BKOUT(LSTNM) ; output list from the bkgnd process 99 S X=$$CURLIST(LSTNAM),LSTAGE=$P(X,U,2),LSTNUM=+X 100 I 'LSTNUM S MAGGRY=$NA(^TMP($J,"RET")),@MAGGRY@(0)="0^4~Problem with "_LSTNM_" List Compile program (age="_LSTAGE_" for "_LSTNAM_")"_$S(LSTNAM["9992":"--May need to Schedule RECENT List Compile in TaskMan.",1:"") 101 E D LSTOUT^MAGJLS2B(.MAGGRY,LSTID,$NA(^XTMP("MAGJ2",LSTNAM,LSTNUM)),LSTAGE) 102 K LSTAGE 103 Q 104 ; 105 BKREQA(DATA) ; ALL Active from Bkgnd 106 ; Copy compiles of Unread & Recent to a scratch global, & call lstout 107 N ALLGO,CNT,GETLST,ICNT,REPLY 108 S ALLGO=1,CNT=0 109 F GETLST=9991,9992 D I 'ALLGO S REPLY="Component List "_GETLST_ALLGO Q 110 . D PARAMS^MAGJLS2B(GETLST) I 'LSTID S ALLGO=" not properly defined." Q 111 . S X=$$CURLIST(LSTNAM),LSTAGE=$P(X,U,2),LSTNUM=+X 112 . I 'LSTNUM S ALLGO=" needs more time to compile." Q 113 . F ICNT=1:1:$G(^XTMP("MAGJ2",LSTNAM,LSTNUM,0,1)) S X=^XTMP("MAGJ2",LSTNAM,LSTNUM,ICNT,1),Y=^(2),CNT=CNT+1,^TMP($J,"MAGJ",CNT,1)=X,^(2)=Y 114 I ALLGO D 115 . S ^TMP($J,"MAGJ",0,1)=CNT_U_"1~ALL Active Exams",^(2)="" 116 . D PARAMS^MAGJLS2B($P(DATA,U)) 117 . D LSTOUT^MAGJLS2B(.MAGGRY,LSTID,$NA(^TMP($J,"MAGJ"))) 118 I 'ALLGO S MAGGRY=$NA(^TMP($J,"RET")),@MAGGRY@(0)="0^4~Problem with ALL Exams List Compile "_DATA_". "_REPLY 119 K LSTAGE 120 Q 121 ; 122 BKGND ; EP for background compile of UNREAD exams 123 L +^XTMP("MAGJ2","BKGND2","RUN"):600 ; allow fgnd job to finish compile 124 E Q ; I must already be running! 125 N BKGLSTID S BKGLSTID=9991 G BKGNDA 126 Q 127 BKGND2 ; EP--bkgnd compile RECENT 128 N BKGLSTID S BKGLSTID=9992 G BKGNDA 129 Q 130 BKGNDA S BKGPROC=1,U="^" 131 N $ETRAP,$ESTACK S $ETRAP="D BKGERR^MAGJLS2" 132 D MAGJOBNC^MAGJUTL3 133 D PARAMS^MAGJLS2B(BKGLSTID) 134 BKLOOP ; Loop & compile "master" UNREAD List only 135 S BKLOOP=$G(BKLOOP)+1 136 I BKLOOP>1 D PARAMS^MAGJLS2B(9991) 137 I 'LSTID D G BKGNDZ 138 . S X="0^4~Problem with BACKGROUND Compile of Exams List" 139 . F I=1,2 K ^XTMP("MAGJ2",LSTNAM,I) 140 . F I=1,2 S ^XTMP("MAGJ2",LSTNAM,I,0,1)=X,^(2)="" ; get msg to WS user 141 I 'BKGND G BKGNDZ ; need this to cover for excessive time to compile 142 S X=$$CURLIST(LSTNAM),LSTAGE=$P(X,U,2),LSTNUM=+X 143 I LSTREQ="U",(LSTAGE<DELTA) D I 'BKGND G BKGNDZ ;bkgnd compile off? 144 . N ITEST,TEST,MORE 145 . S TEST=(DELTA-LSTAGE)\5,MORE=(DELTA-LSTAGE)-(5*TEST) 146 . ; while waiting, periodic chk for stop conditions 147 . F ITEST=1:1:TEST H 5 D Q:'BKGND 148 .. S BKGND=+$P($G(^MAG(2006.69,1,0)),U,8) Q:'BKGND 149 .. I $D(ZTQUEUED),$$S^%ZTLOAD S BKGND=0 ; Exit bkgnd via TaskMan Req 150 . H MORE 151 D LSTCOMP() 152 I LSTREQ="R" D NEWINT 153 I LSTREQ="U" D UPDR^MAGJLS2B G BKLOOP ;UNREAD loops; RECENT uses TaskMan 154 BKGNDZ I LSTREQ="U" L -^XTMP("MAGJ2","BKGND2","RUN") 155 N ZTREQ S ZTREQ="@" ; clean up task entry 156 K BKLOOP,DELTA,LSTAGE 157 Q ; Exit bkgnd 158 ; 159 NEWINT ; Add exams newly Interp since Recent Compile started to Recent List 160 ; 1st, get list of candidates: 161 N INDX L +^XTMP("MAGJ2","RECENT"):15 162 E Q 163 S INDX=+$G(^TMP($J,"NEWINT")) ; counter when Recent Compile started 164 I INDX S INDX=INDX-1 F S INDX=$O(^XTMP("MAGJ2","RECENT",INDX)) Q:'INDX S X=^(INDX) I X S ^TMP($J,"NEWINT",0,INDX)=X 165 K ^XTMP("MAGJ2","RECENT") S ^("RECENT",0)=0 166 L -^XTMP("MAGJ2","RECENT") 167 ;if not in Recent Compile, add to index 168 S INDX="" 169 F S INDX=$O(^TMP($J,"NEWINT",0,INDX)) Q:'INDX S X=^(INDX) D 170 . I $D(^TMP($J,"NEWINT",$P(X,U,1,3))) Q ; already there 171 . L +^XTMP("MAGJ2","RECENT"):15 172 . E Q 173 . S I=+$G(^XTMP("MAGJ2","RECENT",0))+1,$P(^(0),U)=I,^(I)=X ;add 174 . L -^XTMP("MAGJ2","RECENT") 175 K ^TMP($J,"NEWINT") 176 Q 177 ; 178 LSTCOMP(COMPFAIL) ; Compile new list; subrtn used by Active and Bkgnd tags 179 S COMPFAIL=0 ; Return T/F for "Executed a List Compile?" 180 L +^XTMP("MAGJ2","BKGND",LSTNAM,"COMPILE"):60 181 E S COMPFAIL=1 G LSTCOMZ 182 S NEWLIST=$S(LSTNUM=1:2,1:1) ; toggle node to use 183 N TS,COMTIM 184 S TS="" F I=2,0 S TS=TS_$S(TS="":"",1:U)_$$HTFM^XLFDT($H+I,0) 185 S ^XTMP("MAGJ2",0)=TS_U_"VistaRad List Compile" 186 S ^XTMP("MAGJ2",0,LSTNAM,NEWLIST)=$H 187 D BLDACTV^MAGJLS3(.MAGGRY,LSTPARAM,$NA(^XTMP("MAGJ2",LSTNAM,NEWLIST))) 188 S COMTIM=$$DELTA($P(^XTMP("MAGJ2",0,LSTNAM,NEWLIST),U)) 189 S ^XTMP("MAGJ2",LSTNAM,NEWLIST)=$H_U_$J_U_COMTIM 190 S ^XTMP("MAGJ2","BKGND",LSTNAM,0)=NEWLIST_U_$H 191 I $G(^XTMP("MAGJ2",0,"TIME")) D 192 . S T1=$P($H,",",2)/3600,T2=$E(100+(T1\1),2,3),T=T2_":"_$E(100+(T1-T2*60),2,3) 193 . S ^XTMP("MAGJ2",0,"TIME",LSTNAM,+$H,T)=COMTIM K T,T1,T2 194 LSTCOMZ L -^XTMP("MAGJ2","BKGND",LSTNAM,"COMPILE") 195 Q ; 196 CURLIST(LSTNAM,WAIT) ; return cur. list & age in secs 197 S WAIT=+$G(WAIT) 198 N X,RET,AGE,TRY,START,EXTRATIM 199 S TRY=0,START=$H,EXTRATIM=$S(LSTREQ="U":600,1:1800) 200 S X=$G(^XTMP("MAGJ2","BKGND",LSTNAM,0)) ; Cur # ^ $H created 201 I X="" S RET="^86400" G CURLISZ ; this lstnam not yet compiled! 202 S AGE=$$DELTA($P(X,U,2)),RET=$P(X,U)_U_AGE 203 I AGE>(DELTA+EXTRATIM) S $P(RET,U)="" ; Something's wrong w/ compile; force error message 204 CURLISZ Q RET 205 ; 206 DELTA(X,Y) ; calc # secs bet 2 $h values; dflt 2nd value = now 207 ; useful limit is one day 208 I $G(Y)="" S Y=$H 209 I +Y=+X 210 E D 211 . I Y-X=1 S $P(Y,",",2)=86400+$P(Y,",",2) ; midnight boundary 212 . E S $P(X,",",2)=0,$P(Y,",",2)=86400 ; > one day 213 Q ($P(Y,",",2)-$P(X,",",2)) 214 ; 215 END ; 1 MAGJLS2 ;WIRMFO/JHC Rad. Workstation RPC calls ; 29 Jul 2003 9:58 AM 2 ;;3.0;IMAGING;**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 ; ACTIVE -- list exams (Unread, Recent, &/or Pending) for input Imaging Type(s) 20 ; RPC Call: MAGJ RADACTIVEEXAMS 21 ; BKGND -- EP for Bkgnd Compile of UNREAD list 22 ; BKGND2 -- EP for Bkgnd Compile of RECENT list 23 Q 24 BKGERR S ERRCOUNT=$G(ERRCOUNT)+1 H 3 I ERRCOUNT>2 K ZTQUEUED G ^XUSCLEAN ; prevent bkgnd loop 25 ERR1 I $G(LSTNAM)]"" L -^XTMP("MAGJ2","BKGND",LSTNAM,"COMPILE") 26 L -^XTMP("MAGJ2","BKGND2","RUN") 27 ERR N ERR S ERR=$$EC^%ZOSV S ^TMP($J,"RET",0)="0^4~"_ERR 28 S MAGGRY=$NA(^TMP($J,"RET")) 29 D @^%ZOSF("ERRTN") 30 Q:$Q 1 Q 31 ACTIVE(MAGGRY,DATA) ; EP--get Active (Unread/Recent/Pend) Exam Lists 32 ; MAGGRY holds $NA ref to ^TMP where return msg is assembled 33 ; all refs to MAGGRY use SS indirection 34 ; If not use bkgnd, compile in foregnd 35 ; 36 N BKGND,COMPFAIL,MAGLST,LSTPARAM,LSTREQ,LSTID,LSTNUM,LSTNAM,NEWLIST 37 N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJLS2" 38 S X=$P(DATA,U) D PARAMS^MAGJLS2B(X) 39 I 'LSTID S MAGGRY=$NA(^TMP($J,"RET")),@MAGGRY@(0)="0^4~Problem with Exams List Compile--"_DATA_"." Q 40 I BKGND,LSTREQ="U" D BKREQU Q ; UNREAD in bkgnd 41 I BKGND,LSTREQ="R" D BKREQR Q ; RECENT in bkgnd 42 I BKGND,LSTREQ="A" D BKREQA(DATA) Q ; ALL Active Exams 43 D FOREGND ; other list types, or bkgnd compile not enabled 44 ACTIVEZ Q 45 ; 46 FOREGND ; compile in foregnd 47 I LSTREQ="H" G HISTORY 48 D BLDACTV^MAGJLS3(.MAGLST,LSTPARAM) 49 D LSTOUT^MAGJLS2B(.MAGGRY,LSTID,MAGLST) K @MAGLST 50 Q 51 ; 52 HISTORY ; compile History list 53 D BLDACTV^MAGJLS3(.MAGLST,LSTPARAM) 54 D LSTOUT^MAGJLS2B(.MAGGRY,LSTID,MAGLST) 55 ; copy data from above compile into History file 56 N EXID,HISTIEN,IEN,REC1,REC2,CDAT,TMP,PC 57 I +$G(@MAGLST@(0,1)) D 58 . S IEN="" F S IEN=$O(@MAGLST@(IEN)) Q:(IEN="") S REC1=^(IEN,1),REC2=^(2) D 59 . . I IEN=0 S ^XTMP("MAGJ2","HISTORY",DUZ,DUZ(2),IEN,1)=REC1,^(2)=REC2 Q ; header string 60 . . S HISTIEN=+$P(REC2,"|",3) Q:'HISTIEN S EXID=$P(REC2,"|",2) 61 . . S X=$G(^XTMP("MAGJ2","HISTORY",DUZ,DUZ(2),0,"ADD",HISTIEN)) 62 . . I X]"" D 63 . . . I EXID'=$P(X,"|",2) Q 64 . . . ; copy Client data into list column fields 12-15 in node 2 65 . . . S CDAT=$P(REC2,"|",3),TMP=$P(REC2,"|") 66 . . . F I=1:1:4 S PC=11+I,$P(TMP,U,PC)=$P(CDAT,U,I) 67 . . . S TMP=TMP_U ; pad extra nil piece 68 . . . S $P(REC2,"|")=TMP,$P(REC2,"|",3)=HISTIEN ; preserve IEN in PP3 69 . . . S ^XTMP("MAGJ2","HISTORY",DUZ,DUZ(2),HISTIEN,1)=REC1,^(2)=REC2 70 . . . K ^XTMP("MAGJ2","HISTORY",DUZ,DUZ(2),0,"ADD",HISTIEN) ; Kill input node 71 K @MAGLST 72 Q 73 ; 74 BKREQU ; UNREAD exams from bkgnd 75 L +^XTMP("MAGJ2","BKGND2","RUN"):0 76 E D BKOUT("UNREAD") Q ; bkgnd process IS running 77 ; NOT running, so start it! 78 ; 2nd errtrap is to deal with locks if error occurs 79 N $ETRAP,$ESTACK S $ETRAP="D ERR1^MAGJLS2" 80 N ZTDESC,ZTDTH,ZTIO,ZTRTN 81 S ZTRTN="BKGND^MAGJLS2",ZTDESC="IMAGING VistaRad UNREAD List Compile" 82 S ZTDTH=$H,ZTIO="" D ^%ZTLOAD 83 S X=$$CURLIST(LSTNAM),LSTAGE=$P(X,U,2),LSTNUM=+X 84 I LSTAGE>(DELTA+300) S BKGPROC=2 D ; Foregnd compile if need fresh list 85 . D LSTCOMP(.COMPFAIL) K BKGPROC S X=$$CURLIST(LSTNAM),LSTAGE=$P(X,U,2),LSTNUM=+X 86 L -^XTMP("MAGJ2","BKGND2","RUN") 87 I +$G(COMPFAIL) S MAGGRY=$NA(^TMP($J,"RET")),@MAGGRY@(0)="0^4~Unable to Compile Unread Exams list" 88 E D LSTOUT^MAGJLS2B(.MAGGRY,LSTID,$NA(^XTMP("MAGJ2",LSTNAM,LSTNUM)),LSTAGE) 89 Q 90 ; 91 BKREQR ; Recent Exams from bkgnd 92 D BKOUT("RECENT") 93 Q 94 ; 95 BKOUT(LSTNM) ; output list from the bkgnd process 96 S X=$$CURLIST(LSTNAM),LSTAGE=$P(X,U,2),LSTNUM=+X 97 I 'LSTNUM S MAGGRY=$NA(^TMP($J,"RET")),@MAGGRY@(0)="0^4~Problem with "_LSTNM_" List Compile program (age="_LSTAGE_" for "_LSTNAM_")"_$S(LSTNAM["9992":"--May need to Schedule RECENT List Compile in TaskMan.",1:"") 98 E D LSTOUT^MAGJLS2B(.MAGGRY,LSTID,$NA(^XTMP("MAGJ2",LSTNAM,LSTNUM)),LSTAGE) 99 Q 100 ; 101 BKREQA(DATA) ; ALL Active from Bkgnd 102 ; Copy compiles of Unread & Recent to a scratch global, & call lstout 103 N ALLGO,CNT,GETLST,ICNT,REPLY 104 S ALLGO=1,CNT=0 105 F GETLST=9991,9992 D I 'ALLGO S REPLY="Component List "_GETLST_ALLGO Q 106 . D PARAMS^MAGJLS2B(GETLST) I 'LSTID S ALLGO=" not properly defined." Q 107 . S X=$$CURLIST(LSTNAM),LSTAGE=$P(X,U,2),LSTNUM=+X 108 . I 'LSTNUM S ALLGO=" needs more time to compile." Q 109 . F ICNT=1:1:$G(^XTMP("MAGJ2",LSTNAM,LSTNUM,0,1)) S X=^XTMP("MAGJ2",LSTNAM,LSTNUM,ICNT,1),Y=^(2),CNT=CNT+1,^TMP($J,"MAGJ",CNT,1)=X,^(2)=Y 110 I ALLGO D 111 . S ^TMP($J,"MAGJ",0,1)=CNT_U_"1~ALL Active Exams",^(2)="" 112 . D PARAMS^MAGJLS2B($P(DATA,U)) 113 . D LSTOUT^MAGJLS2B(.MAGGRY,LSTID,$NA(^TMP($J,"MAGJ"))) 114 I 'ALLGO S MAGGRY=$NA(^TMP($J,"RET")),@MAGGRY@(0)="0^4~Problem with ALL Exams List Compile "_DATA_". "_REPLY 115 Q 116 ; 117 BKGND ; EP for background compile of UNREAD exams 118 L +^XTMP("MAGJ2","BKGND2","RUN"):600 ; allow fgnd job to finish compile 119 E Q ; I must already be running! 120 N BKGLSTID S BKGLSTID=9991 G BKGNDA 121 Q 122 BKGND2 ; EP--bkgnd compile RECENT 123 N BKGLSTID S BKGLSTID=9992 G BKGNDA 124 Q 125 BKGNDA S BKGPROC=1,U="^" 126 N $ETRAP,$ESTACK S $ETRAP="D BKGERR^MAGJLS2" 127 D MAGJOBNC^MAGJUTL3 128 D PARAMS^MAGJLS2B(BKGLSTID) 129 BKLOOP ; Loop & compile "master" UNREAD List only 130 S BKLOOP=$G(BKLOOP)+1 131 I BKLOOP>1 D PARAMS^MAGJLS2B(9991) 132 I 'LSTID D G BKGNDZ 133 . S X="0^4~Problem with BACKGROUND Compile of Exams List" 134 . F I=1,2 K ^XTMP("MAGJ2",LSTNAM,I) 135 . F I=1,2 S ^XTMP("MAGJ2",LSTNAM,I,0,1)=X,^(2)="" ; get msg to WS user 136 I 'BKGND G BKGNDZ ; need this to cover for excessive time to compile 137 S X=$$CURLIST(LSTNAM),LSTAGE=$P(X,U,2),LSTNUM=+X 138 I LSTREQ="U",(LSTAGE<DELTA) D I 'BKGND G BKGNDZ ;bkgnd compile off? 139 . N ITEST,TEST,MORE 140 . S TEST=(DELTA-LSTAGE)\5,MORE=(DELTA-LSTAGE)-(5*TEST) 141 . ; while waiting, periodic chk for stop conditions 142 . F ITEST=1:1:TEST H 5 D Q:'BKGND 143 .. S BKGND=+$P($G(^MAG(2006.69,1,0)),U,8) Q:'BKGND 144 .. I $D(ZTQUEUED),$$S^%ZTLOAD S BKGND=0 ; Exit bkgnd via TaskMan Req 145 . H MORE 146 D LSTCOMP() 147 I LSTREQ="R" D NEWINT 148 I LSTREQ="U" D UPDR G BKLOOP ;UNREAD loops; RECENT uses TaskMan 149 BKGNDZ I LSTREQ="U" L -^XTMP("MAGJ2","BKGND2","RUN") 150 N ZTREQ S ZTREQ="@" ; clean up task entry 151 K BKLOOP,DELTA 152 Q ; Exit bkgnd 153 ; 154 UPDR ; Add Newly Interp exams to Recent 155 D PARAMS^MAGJLS2B(9995) 156 I 'LSTID G UPDRZ 157 S X=$$CURLIST(LSTNAM),LSTAGE=$P(X,U,2),LSTNUM=+X 158 D LSTCOMP() 159 UPDRZ Q ; 160 ; 161 NEWINT ; Exams newly Interp since Recent Compile started 162 ; are added to Recent List (add to "RECENT" index) 163 ; 1st, get list of all potential candidates: 164 N INDX L +^XTMP("MAGJ2","RECENT"):15 165 E Q 166 S INDX=+$G(^TMP($J,"NEWINT")) ; counter when Recent Compile started 167 I INDX S INDX=INDX-1 F S INDX=$O(^XTMP("MAGJ2","RECENT",INDX)) Q:'INDX S X=^(INDX) I X S ^TMP($J,"NEWINT",0,INDX)=X 168 K ^XTMP("MAGJ2","RECENT") S ^("RECENT",0)=0 ; init this index 169 L -^XTMP("MAGJ2","RECENT") 170 ;find those not included in Recent Compile, and add to index 171 S INDX="" 172 F S INDX=$O(^TMP($J,"NEWINT",0,INDX)) Q:'INDX S X=^(INDX) D 173 . I $D(^TMP($J,"NEWINT",$P(X,U,1,3))) Q ; already in the compile 174 . L +^XTMP("MAGJ2","RECENT"):15 175 . E Q 176 . S I=+$G(^XTMP("MAGJ2","RECENT",0))+1,$P(^(0),U)=I,^(I)=X ; add to indx 177 . L -^XTMP("MAGJ2","RECENT") 178 K ^TMP($J,"NEWINT") 179 Q 180 ; 181 LSTCOMP(COMPFAIL) ; Compile new list; subrtn used by Active and Bkgnd tags 182 S COMPFAIL=0 ; Return T/F for "Executed a List Compile?" 183 L +^XTMP("MAGJ2","BKGND",LSTNAM,"COMPILE"):60 ; shouldn't need any time 184 E S COMPFAIL=1 G LSTCOMZ 185 S NEWLIST=$S(LSTNUM=1:2,1:1) ; toggle node to use for new compile 186 N TS,COMTIM 187 S TS="" F I=2,0 S %H=$H+I D YMD^%DTC S TS=TS_$S(TS="":"",1:U)_X 188 S ^XTMP("MAGJ2",0)=TS_U_"VistaRad List Compile" 189 S ^XTMP("MAGJ2",0,LSTNAM,NEWLIST)=$H 190 D BLDACTV^MAGJLS3(.MAGGRY,LSTPARAM,$NA(^XTMP("MAGJ2",LSTNAM,NEWLIST))) 191 S COMTIM=$$DELTA($P(^XTMP("MAGJ2",0,LSTNAM,NEWLIST),U)) 192 S ^XTMP("MAGJ2",LSTNAM,NEWLIST)=$H_U_$J_U_COMTIM 193 S ^XTMP("MAGJ2","BKGND",LSTNAM,0)=NEWLIST_U_$H 194 I $G(^XTMP("MAGJ2",0,"TIME")) D 195 . S T1=$P($H,",",2)/3600,T2=$E(100+(T1\1),2,3),T=T2_":"_$E(100+(T1-T2*60),2,3) 196 . S ^XTMP("MAGJ2",0,"TIME",LSTNAM,+$H,T)=COMTIM K T,T1,T2 197 LSTCOMZ L -^XTMP("MAGJ2","BKGND",LSTNAM,"COMPILE") 198 Q ; 199 ; 200 CURLIST(LSTNAM,WAIT) ; return current list & its age in seconds 201 ; 202 S WAIT=+$G(WAIT) 203 N X,RET,AGE,TRY,START,EXTRATIM 204 S TRY=0,START=$H,EXTRATIM=$S(LSTREQ="U":600,1:1800) 205 S X=$G(^XTMP("MAGJ2","BKGND",LSTNAM,0)) ; Cur # ^ $H created 206 I X="" S RET="^86400" G CURLISZ ; this lstnam not yet compiled! 207 S AGE=$$DELTA($P(X,U,2)),RET=$P(X,U)_U_AGE 208 I AGE>(DELTA+EXTRATIM) S $P(RET,U)="" ; Something's wrong w/ compile; force error message 209 CURLISZ Q RET 210 ; 211 DELTA(X,Y) ; calc # seconds between 2 $h values; default 2nd value = now 212 ; useful limit is one day 213 I $G(Y)="" S Y=$H 214 I +Y=+X 215 E D 216 . I Y-X=1 S $P(Y,",",2)=86400+$P(Y,",",2) ; cross midnight boundary 217 . E S $P(X,",",2)=0,$P(Y,",",2)=86400 ; more than one day 218 Q ($P(Y,",",2)-$P(X,",",2)) 219 ; 220 END ;
Note:
See TracChangeset
for help on using the changeset viewer.
