| [623] | 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 ;
|
|---|
