MAGJLS2 ;WIRMFO/JHC - Rad. Workstation RPC calls ; 10/17/2022
;;3.0;IMAGING;**22,18,76,101,90,341**;Dec 21, 2022;Build 28
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
;; ISI IMAGING;**99,100,101**
Q
; ACTIVE -- list exams (Unread, Recent, &/or Pending) for input Imaging Type(s)
; RPC Call: MAGJ RADACTIVEEXAMS
; BKGND -- EP for Bkgnd Compile of UNREAD list
; BKGND2 -- EP for Bkgnd Compile of RECENT list
Q
BKGERR S ERRCOUNT=$G(ERRCOUNT)+1 H 3 I ERRCOUNT>2 K ZTQUEUED G ^XUSCLEAN ; prevent bkgnd loop
ERR1 I $G(LSTNAM)]"" L -^XTMP("MAGJ2","BKGND",LSTNAM,"COMPILE")
L -^XTMP("MAGJ2","BKGND2","RUN")
ERR N ERR S ERR=$$EC^%ZOSV S ^TMP($J,"RET",0)="0^4~"_ERR
S MAGGRY=$NA(^TMP($J,"RET"))
D @^%ZOSF("ERRTN")
Q:$Q 1 Q
;
ACTIVE(MAGGRY,DATA) ; EP--get Active (Unread/Recent/Pend) Exam Lists
; MAGGRY holds $NA ref to ^TMP where return msg is assembled
; all refs to MAGGRY use SS indirection
; If not use bkgnd, compile in foregnd
;
N BKGND,COMPFAIL,DATA01,LSTID,LSTNAM,LSTNUM,LSTPARAM,LSTREQ,MAGLST
N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJLS2"
S DATA01=$P(DATA,U) D PARAMS^MAGJLS2B(DATA01)
I 'LSTID S MAGGRY=$NA(^TMP($J,"RET")) D Q
. ;
. ; Initialize to the error condition.
. S @MAGGRY@(0)="0^4~Problem with Exams List Compile--"_DATA_"."
. ;
. ;--- next line--hard-coded 99999 value from client and here for logon initial Manager screen (MAG*3.0*101).
. D:DATA01=99999
. . S @MAGGRY@(0)="0^1~ * * * Use PATIENT LOOKUP button, or select Exam List tab of interest. * * *"
. ;
. ;--- next line--hard-coded 99998 value from client and here for VIX EXAMID LOOKUP (MAG*3.0*90).
. D:DATA01=99998
. . ;
. . ;--- Validate additional DATA pieces for this context.
. . N V,X,XX S V=-1
. . ;
. . ;--- Are RADPT, RACNI, and RDFN numbers?
. . F X=2,4,5 Q:'V S XX=$P(DATA,U,X) S:XX=""!(XX'?1N.N) V=0
. . ;
. . ;--- Is RADTM in FileMan format?
. . I V<0 S XX=$P(DATA,U,3) S:XX=""!(XX'?7N1"."1.6N) V=0
. . ;
. . ;--- Set return array for VIX.
. . D:V<0
. . . S @MAGGRY@(0)="1^1~FOR VIX EXAMID LOOKUP"
. . . S @MAGGRY@(1)="^VIX LOOKUP"
. . . S @MAGGRY@(2)="^EXAMID^|"_$P(DATA,U,2,5)_"||"
; ISI remove deprecated logic
I $P($G(^MAG(2006.69,1,"ISI")),U,4)="Y" D LSTSTATU^ISIJUTL9(LSTID) ; ISI collect list usage stats
I BKGND,LSTREQ="U" D BKREQU Q ; UNREAD in bkgnd
I BKGND,LSTREQ="R" D:'$$MGRREV2^ISIJUTL9 BKREQR D:$$MGRREV2^ISIJUTL9 FOREGND Q ; RECENT in bkgnd ISI--Rev-2
I BKGND,LSTREQ="A" D BKREQA(DATA) Q ; ALL Active Exams
;
;--- Process other list types, or bkgnd compile not enabled.
D FOREGND
ACTIVEZ Q
;
FOREGND ; compile in foregnd
I LSTREQ="H" G HISTORY
D BLDACTV^MAGJLS3(.MAGLST,LSTPARAM)
I LSTREQ="I",($G(DATA01)=9820) N WRNMSG D ; ISI--detect abort of Dynamic Query compile
. I $D(^XTMP("MAGJ2","ISIQUERY",DUZ,MAGJOB("SESSION"),"ABORT")) S WRNMSG=^("ABORT") ; ISI
D LSTOUT^MAGJLS2B(.MAGGRY,LSTID,MAGLST,,$G(WRNMSG)) K @MAGLST ; ISI
; ISI begin -- below is for Dynamic Query feature only
I LSTREQ="I",($G(DATA01)=9820) D ; copy query result to temp storage for session re-use
. K ^XTMP("MAGJ2","ISIQUERY",DUZ,MAGJOB("SESSION"),"RSL"),^("RSLSTAT")
. N I,X,X2 S I=+$G(@MAGGRY@(0)) I I>0 D
. . F I=2:1:I+1 S X=$G(@MAGGRY@(I)) I X]"" D
. . . S X2=$P(X,"|",2),X=$P($P(X,"|",4),U) S:X="" X="~"
. . . S ^XTMP("MAGJ2","ISIQUERY",DUZ,MAGJOB("SESSION"),"RSL",I)=X2
. . . S ^(X)=$G(^XTMP("MAGJ2","ISIQUERY",DUZ,MAGJOB("SESSION"),"RSLSTAT",X))+1 ; for Query statistics
. . D QRYLOG^ISIJLS2 ; log query stats
; ISI end
Q
;
HISTORY ; compile History list
D BLDACTV^MAGJLS3(.MAGLST,LSTPARAM)
D LSTOUT^MAGJLS2B(.MAGGRY,LSTID,MAGLST)
; copy data from above compile into History file
N EXID,HISTIEN,IEN,REC1,REC2,CDAT,TMP,PC
I +$G(@MAGLST@(0,1)) D
. S IEN="" F S IEN=$O(@MAGLST@(IEN)) Q:(IEN="") S REC1=^(IEN,1),REC2=^(2) D
. . I IEN=0 S ^XTMP("MAGJ2","HISTORY",DUZ,DUZ(2),IEN,1)=REC1,^(2)=REC2 Q ; header string
. . S HISTIEN=+$P(REC2,"|",3) Q:'HISTIEN S EXID=$P(REC2,"|",2)
. . S X=$G(^XTMP("MAGJ2","HISTORY",DUZ,DUZ(2),0,"ADD",HISTIEN))
. . I X]"" D
. . . I EXID'=$P(X,"|",2) Q
. . . ; copy Client data into list column fields 12-15 in node 2
. . . S CDAT=$P(REC2,"|",3),TMP=$P(REC2,"|")
. . . F I=1:1:4 S PC=11+I,$P(TMP,U,PC)=$P(CDAT,U,I)
. . . S TMP=TMP_U ; pad extra nil piece
. . . S $P(REC2,"|")=TMP,$P(REC2,"|",3)=HISTIEN ; preserve IEN in PP3
. . . S ^XTMP("MAGJ2","HISTORY",DUZ,DUZ(2),HISTIEN,1)=REC1,^(2)=REC2
. . . K ^XTMP("MAGJ2","HISTORY",DUZ,DUZ(2),0,"ADD",HISTIEN) ; Kill input node
K @MAGLST
Q
;
BKREQU ; UNREAD exams from bkgnd
L +^XTMP("MAGJ2","BKGND2","RUN"):0
E D BKOUT("UNREAD") Q ; bkgnd process IS running
; NOT running, so start it!
; 2nd errtrap is to deal with locks if error occurs
N $ETRAP,$ESTACK S $ETRAP="D ERR1^MAGJLS2"
N ZTDESC,ZTDTH,ZTIO,ZTRTN
S ZTRTN="BKGND^MAGJLS2",ZTDESC="IMAGING ISI Rad UNREAD List Compile"
S ZTDTH=$H,ZTIO="" D ^%ZTLOAD
S X=$$CURLIST(LSTNAM),LSTAGE=$P(X,U,2),LSTNUM=$S(+X:+X,1:+$P(X,U,3))
; CURLIST sub's check for excessive time n/a here
I LSTAGE>(DELTA+300) S BKGPROC=2 D ; Foregnd compile if need fresh list
. D LSTCOMP(.COMPFAIL) K BKGPROC
. S X=$$CURLIST(LSTNAM),LSTAGE=$P(X,U,2),LSTNUM=+X
L -^XTMP("MAGJ2","BKGND2","RUN")
I +$G(COMPFAIL)!'LSTNUM S MAGGRY=$NA(^TMP($J,"RET")),@MAGGRY@(0)="0^4~Unable to Compile Unread Exams list ("_$S(+LSTNUM:"COMPFAIL",1:"LSTNUM")_" in MAGJLS2)."
E D LSTOUT^MAGJLS2B(.MAGGRY,LSTID,$NA(^XTMP("MAGJ2",LSTNAM,LSTNUM)),LSTAGE)
K LSTAGE
Q
;
BKREQR ; Recent Exams from bkgnd
D BKOUT("RECENT")
Q
;
BKOUT(LSTNM) ; output list from the bkgnd process
N MSG S MSG=""
; if CURLIST returns a value in Piece 3, then the Compile is probably not current
; so get a message out with the list
S X=$$CURLIST(LSTNAM),LSTAGE=$P(X,U,2),LSTNUM=+X
I 'LSTNUM D
. I +$P(X,U,3) S LSTNUM=+$P(X,U,3) S MSG="Compile program for "_LSTNM_" may not be current (age="_LSTAGE_" for "_LSTNAM_")"_$S(LSTNAM["9992":"--May need to Schedule RECENT List Compile in TaskMan.",1:"")
I LSTNUM D LSTOUT^MAGJLS2B(.MAGGRY,LSTID,$NA(^XTMP("MAGJ2",LSTNAM,LSTNUM)),LSTAGE,MSG)
E 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:"")
K LSTAGE
Q
;
; ISI -- Rev-2 modify this subroutine to compile Recent part in foreground
; Conditional on Rev-2 being enabled (else, use original logic)
BKREQA(DATA) ; ALL Active from Bkgnd
; Copy compiles of Unread & Recent to a scratch global, & call lstout
N ALLGO,CNT,GETLST,ICNT,REPLY,MSG
S ALLGO=1,CNT=0,MSG=""
F GETLST=9991,9992 D I 'ALLGO S REPLY="Component List "_GETLST_ALLGO Q
. D PARAMS^MAGJLS2B(GETLST) I 'LSTID S ALLGO=" not properly defined." Q
. ; ISI -- begin changes
. I GETLST=9991!(GETLST=9992&'$$MGRREV2^ISIJUTL9) D ; Rev-2 NOT enabled, Recent part from background
. . S X=$$CURLIST(LSTNAM),LSTAGE=$P(X,U,2),LSTNUM=+X
. . I 'LSTNUM D
. . . I +$P(X,U,3) S LSTNUM=+$P(X,U,3)
. . . I LSTNUM S MSG=MSG_$S(MSG="":"Compile program for ",1:"; ")_"component "_LSTNAM_" may not be current (age="_LSTAGE_" for "_GETLST_")"
. . I 'LSTNUM S ALLGO=" needs more time to compile." Q
. . F ICNT=1:1:$G(^XTMP("MAGJ2",LSTNAM,LSTNUM,0,1)) S X=^XTMP("MAGJ2",LSTNAM,LSTNUM,ICNT,1),Y=^(2),Z=$G(^("ISI")),CNT=CNT+1,^TMP($J,"MAGJ",CNT,1)=X,^(2)=Y,^("ISI")=Z
. I GETLST=9992,$$MGRREV2^ISIJUTL9 D ; Rev-2 enabled, compile Recent part in foreground
. . D BLDACTV^MAGJLS3(.MAGLST,LSTPARAM)
. . F ICNT=1:1:$G(@MAGLST@(0,1)) S X=@MAGLST@(ICNT,1),Y=^(2),Z=$G(^("ISI")),CNT=CNT+1,^TMP($J,"MAGJ",CNT,1)=X,^(2)=Y,^("ISI")=Z
; ISI -- end of changes
I ALLGO D
. S ^TMP($J,"MAGJ",0,1)=CNT_U_"1~ALL Active Exams",^(2)=""
. D PARAMS^MAGJLS2B($P(DATA,U))
. D LSTOUT^MAGJLS2B(.MAGGRY,LSTID,$NA(^TMP($J,"MAGJ")),,MSG)
I 'ALLGO S MAGGRY=$NA(^TMP($J,"RET")),@MAGGRY@(0)="0^4~Problem with ALL Exams List Compile "_DATA_". "_REPLY
K LSTAGE
Q
;
BKGND ; EP for background compile of UNREAD exams
L +^XTMP("MAGJ2","BKGND2","RUN"):1200 ; allow fgnd job to finish compile
E Q ; I must already be running!
N BKGLSTID S BKGLSTID=9991 G BKGNDA
Q
BKGND2 ; EP--bkgnd compile RECENT
Q:$$MGRREV2^ISIJUTL9 ; ISI -- Rev-2 enabled, no more background compile
N BKGLSTID S BKGLSTID=9992 G BKGNDA
Q
BKGNDA S BKGPROC=1,U="^"
N $ETRAP,$ESTACK S $ETRAP="D BKGERR^MAGJLS2"
D MAGJOBNC^MAGJUTL3
D PARAMS^MAGJLS2B(BKGLSTID)
BKLOOP ; Loop & compile "master" UNREAD List only
S BKLOOP=$G(BKLOOP)+1
I BKLOOP>1 D PARAMS^MAGJLS2B(9991)
I 'LSTID D G BKGNDZ
. S X="0^4~Problem with BACKGROUND Compile of Exams List"
. F I=1,2 K ^XTMP("MAGJ2",LSTNAM,I)
. F I=1,2 S ^XTMP("MAGJ2",LSTNAM,I,0,1)=X,^(2)="" ; get msg to WS user
I 'BKGND G BKGNDZ ; need this to cover for excessive time to compile
S X=$$CURLIST(LSTNAM),LSTAGE=$P(X,U,2),LSTNUM=+X
I 'LSTNUM,+$P(X,U,3) S LSTNUM=+$P(X,U,3)
; above prevents compiling over top of the active list LSTNUM=1 if compiles are excessively long
I LSTREQ="U",(LSTAGE<DELTA) D I 'BKGND G BKGNDZ ;bkgnd compile off?
. N ITEST,TEST
. S TEST=(DELTA-LSTAGE)\5
. ; while waiting, periodic chk for stop conditions
. F ITEST=1:1:TEST H 5 D Q:'BKGND
. . S BKGND=+$P($G(^MAG(2006.69,1,0)),U,8) Q:'BKGND
. . I $D(ZTQUEUED),$$S^%ZTLOAD S BKGND=0 ; Exit bkgnd via TaskMan Req
. H 3
D LSTCOMP()
I LSTREQ="R" D NEWINT:'$$MGRREV2^ISIJUTL9 ; ISI -- Rev-2 eliminates this
I LSTREQ="U" D:'$$MGRREV2^ISIJUTL9 UPDR^MAGJLS2B G BKLOOP ;UNREAD loops; RECENT uses TaskMan ; ISI -- Rev-2 ditto
BKGNDZ I LSTREQ="U" L -^XTMP("MAGJ2","BKGND2","RUN")
N ZTREQ S ZTREQ="@" ; clean up task entry
K BKLOOP,DELTA,LSTAGE
Q ; Exit bkgnd
;
NEWINT ; Add exams newly Interp since Recent Compile started to Recent List
; 1st, get list of candidates:
N INDX L +^XTMP("MAGJ2","RECENT"):15
E Q
S INDX=+$G(^TMP($J,"NEWINT")) ; counter when Recent Compile started
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
K ^XTMP("MAGJ2","RECENT") S ^("RECENT",0)=0
L -^XTMP("MAGJ2","RECENT")
;if not in Recent Compile, add to index
S INDX=""
F S INDX=$O(^TMP($J,"NEWINT",0,INDX)) Q:'INDX S X=^(INDX) D
. I $D(^TMP($J,"NEWINT",$P(X,U,1,3))) Q ; already there
. L +^XTMP("MAGJ2","RECENT"):15
. E Q
. S I=+$G(^XTMP("MAGJ2","RECENT",0))+1,$P(^(0),U)=I,^(I)=X ;add
. L -^XTMP("MAGJ2","RECENT")
K ^TMP($J,"NEWINT")
Q
;
LSTCOMP(COMPFAIL) ; Compile new list; subrtn used by Active and Bkgnd tags
S COMPFAIL=0 ; Return T/F for "Executed a List Compile?"
L +^XTMP("MAGJ2","BKGND",LSTNAM,"COMPILE"):60
E S COMPFAIL=1 G LSTCOMZ
;
N COMTIM,NEWLIST,TS
S NEWLIST=$S(LSTNUM=1:2,1:1) ; toggle node to use
S TS="" F I=2,0 S TS=TS_$S(TS="":"",1:U)_$$HTFM^XLFDT($H+I,0)
S ^XTMP("MAGJ2",0)=TS_U_"ISI Rad List Compile"
S ^XTMP("MAGJ2",0,LSTNAM,NEWLIST)=$H
D BLDACTV^MAGJLS3(.MAGGRY,LSTPARAM,$NA(^XTMP("MAGJ2",LSTNAM,NEWLIST)))
S COMTIM=$$DELTA($P(^XTMP("MAGJ2",0,LSTNAM,NEWLIST),U))
S ^XTMP("MAGJ2",LSTNAM,NEWLIST)=$H_U_$J_U_COMTIM
S ^XTMP("MAGJ2","BKGND",LSTNAM,0)=NEWLIST_U_$H
I $G(^XTMP("MAGJ2",0,"TIME")) D
. S T1=$P($H,",",2)/3600,T2=$E(100+(T1\1),2,3),T=T2_":"_$E(100+(T1-T2*60),2,3)
. S ^XTMP("MAGJ2",0,"TIME",LSTNAM,+$H,T)=COMTIM K T,T1,T2
LSTCOMZ L -^XTMP("MAGJ2","BKGND",LSTNAM,"COMPILE")
Q ;
CURLIST(LSTNAM,WAIT) ; return cur. list & age in secs
; RET = Current_List_Num ^ age ^ Problem_Current_List_Num
; Current_List_Num -- Nil means brand new; value means this is most current
; piece 3 populated if excessive time has elapsed, indicating potential problem
S WAIT=+$G(WAIT)
N X,RET,AGE,TRY,START,EXTRATIM
S TRY=0,START=$H,EXTRATIM=$S(LSTREQ="U":600,1:1800)
S X=$G(^XTMP("MAGJ2","BKGND",LSTNAM,0)) ; Cur # ^ $H created
I X="" S RET="^86400^0" G CURLISZ ; this lstnam not yet compiled!
S AGE=$$DELTA($P(X,U,2)),RET=$P(X,U)_U_AGE
I AGE>(DELTA+EXTRATIM) S X=$P(RET,U),$P(RET,U,3)=X,$P(RET,U)="" ; last compile was "long" ago; return indicator of this
CURLISZ Q RET
;
DELTA(X,Y) ; calc # secs bet 2 $h values; dflt 2nd value = now
; useful limit is one day
I $G(Y)="" S Y=$H
I +Y=+X
E D
. I Y-X=1 S $P(Y,",",2)=86400+$P(Y,",",2) ; midnight boundary
. E S $P(X,",",2)=0,$P(Y,",",2)=86400 ; > one day
Q ($P(Y,",",2)-$P(X,",",2))
;
END ;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGJLS2 13477 printed Dec 13, 2024@02:06:44 Page 2
MAGJLS2 ;WIRMFO/JHC - Rad. Workstation RPC calls ; 10/17/2022
+1 ;;3.0;IMAGING;**22,18,76,101,90,341**;Dec 21, 2022;Build 28
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+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 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 ;; ISI IMAGING;**99,100,101**
+18 QUIT
+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 QUIT
BKGERR ; prevent bkgnd loop
SET ERRCOUNT=$GET(ERRCOUNT)+1
HANG 3
IF ERRCOUNT>2
KILL ZTQUEUED
GOTO ^XUSCLEAN
ERR1 IF $GET(LSTNAM)]""
LOCK -^XTMP("MAGJ2","BKGND",LSTNAM,"COMPILE")
+1 LOCK -^XTMP("MAGJ2","BKGND2","RUN")
ERR NEW ERR
SET ERR=$$EC^%ZOSV
SET ^TMP($JOB,"RET",0)="0^4~"_ERR
+1 SET MAGGRY=$NAME(^TMP($JOB,"RET"))
+2 DO @^%ZOSF("ERRTN")
+3 if $QUIT
QUIT 1
QUIT
+4 ;
ACTIVE(MAGGRY,DATA) ; EP--get Active (Unread/Recent/Pend) Exam Lists
+1 ; MAGGRY holds $NA ref to ^TMP where return msg is assembled
+2 ; all refs to MAGGRY use SS indirection
+3 ; If not use bkgnd, compile in foregnd
+4 ;
+5 NEW BKGND,COMPFAIL,DATA01,LSTID,LSTNAM,LSTNUM,LSTPARAM,LSTREQ,MAGLST
+6 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR^MAGJLS2"
+7 SET DATA01=$PIECE(DATA,U)
DO PARAMS^MAGJLS2B(DATA01)
+8 IF 'LSTID
SET MAGGRY=$NAME(^TMP($JOB,"RET"))
Begin DoDot:1
+9 ;
+10 ; Initialize to the error condition.
+11 SET @MAGGRY@(0)="0^4~Problem with Exams List Compile--"_DATA_"."
+12 ;
+13 ;--- next line--hard-coded 99999 value from client and here for logon initial Manager screen (MAG*3.0*101).
+14 if DATA01=99999
Begin DoDot:2
+15 SET @MAGGRY@(0)="0^1~ * * * Use PATIENT LOOKUP button, or select Exam List tab of interest. * * *"
End DoDot:2
+16 ;
+17 ;--- next line--hard-coded 99998 value from client and here for VIX EXAMID LOOKUP (MAG*3.0*90).
+18 if DATA01=99998
Begin DoDot:2
+19 ;
+20 ;--- Validate additional DATA pieces for this context.
+21 NEW V,X,XX
SET V=-1
+22 ;
+23 ;--- Are RADPT, RACNI, and RDFN numbers?
+24 FOR X=2,4,5
if 'V
QUIT
SET XX=$PIECE(DATA,U,X)
if XX=""!(XX'?1N.N)
SET V=0
+25 ;
+26 ;--- Is RADTM in FileMan format?
+27 IF V<0
SET XX=$PIECE(DATA,U,3)
if XX=""!(XX'?7N1"."1.6N)
SET V=0
+28 ;
+29 ;--- Set return array for VIX.
+30 if V<0
Begin DoDot:3
+31 SET @MAGGRY@(0)="1^1~FOR VIX EXAMID LOOKUP"
+32 SET @MAGGRY@(1)="^VIX LOOKUP"
+33 SET @MAGGRY@(2)="^EXAMID^|"_$PIECE(DATA,U,2,5)_"||"
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+34 ; ISI remove deprecated logic
+35 ; ISI collect list usage stats
IF $PIECE($GET(^MAG(2006.69,1,"ISI")),U,4)="Y"
DO LSTSTATU^ISIJUTL9(LSTID)
+36 ; UNREAD in bkgnd
IF BKGND
IF LSTREQ="U"
DO BKREQU
QUIT
+37 ; RECENT in bkgnd ISI--Rev-2
IF BKGND
IF LSTREQ="R"
if '$$MGRREV2^ISIJUTL9
DO BKREQR
if $$MGRREV2^ISIJUTL9
DO FOREGND
QUIT
+38 ; ALL Active Exams
IF BKGND
IF LSTREQ="A"
DO BKREQA(DATA)
QUIT
+39 ;
+40 ;--- Process other list types, or bkgnd compile not enabled.
+41 DO FOREGND
ACTIVEZ QUIT
+1 ;
FOREGND ; compile in foregnd
+1 IF LSTREQ="H"
GOTO HISTORY
+2 DO BLDACTV^MAGJLS3(.MAGLST,LSTPARAM)
+3 ; ISI--detect abort of Dynamic Query compile
IF LSTREQ="I"
IF ($GET(DATA01)=9820)
NEW WRNMSG
Begin DoDot:1
+4 ; ISI
IF $DATA(^XTMP("MAGJ2","ISIQUERY",DUZ,MAGJOB("SESSION"),"ABORT"))
SET WRNMSG=^("ABORT")
End DoDot:1
+5 ; ISI
DO LSTOUT^MAGJLS2B(.MAGGRY,LSTID,MAGLST,,$GET(WRNMSG))
KILL @MAGLST
+6 ; ISI begin -- below is for Dynamic Query feature only
+7 ; copy query result to temp storage for session re-use
IF LSTREQ="I"
IF ($GET(DATA01)=9820)
Begin DoDot:1
+8 KILL ^XTMP("MAGJ2","ISIQUERY",DUZ,MAGJOB("SESSION"),"RSL"),^("RSLSTAT")
+9 NEW I,X,X2
SET I=+$GET(@MAGGRY@(0))
IF I>0
Begin DoDot:2
+10 FOR I=2:1:I+1
SET X=$GET(@MAGGRY@(I))
IF X]""
Begin DoDot:3
+11 SET X2=$PIECE(X,"|",2)
SET X=$PIECE($PIECE(X,"|",4),U)
if X=""
SET X="~"
+12 SET ^XTMP("MAGJ2","ISIQUERY",DUZ,MAGJOB("SESSION"),"RSL",I)=X2
+13 ; for Query statistics
SET ^(X)=$GET(^XTMP("MAGJ2","ISIQUERY",DUZ,MAGJOB("SESSION"),"RSLSTAT",X))+1
End DoDot:3
+14 ; log query stats
DO QRYLOG^ISIJLS2
End DoDot:2
End DoDot:1
+15 ; ISI end
+16 QUIT
+17 ;
HISTORY ; compile History list
+1 DO BLDACTV^MAGJLS3(.MAGLST,LSTPARAM)
+2 DO LSTOUT^MAGJLS2B(.MAGGRY,LSTID,MAGLST)
+3 ; copy data from above compile into History file
+4 NEW EXID,HISTIEN,IEN,REC1,REC2,CDAT,TMP,PC
+5 IF +$GET(@MAGLST@(0,1))
Begin DoDot:1
+6 SET IEN=""
FOR
SET IEN=$ORDER(@MAGLST@(IEN))
if (IEN="")
QUIT
SET REC1=^(IEN,1)
SET REC2=^(2)
Begin DoDot:2
+7 ; header string
IF IEN=0
SET ^XTMP("MAGJ2","HISTORY",DUZ,DUZ(2),IEN,1)=REC1
SET ^(2)=REC2
QUIT
+8 SET HISTIEN=+$PIECE(REC2,"|",3)
if 'HISTIEN
QUIT
SET EXID=$PIECE(REC2,"|",2)
+9 SET X=$GET(^XTMP("MAGJ2","HISTORY",DUZ,DUZ(2),0,"ADD",HISTIEN))
+10 IF X]""
Begin DoDot:3
+11 IF EXID'=$PIECE(X,"|",2)
QUIT
+12 ; copy Client data into list column fields 12-15 in node 2
+13 SET CDAT=$PIECE(REC2,"|",3)
SET TMP=$PIECE(REC2,"|")
+14 FOR I=1:1:4
SET PC=11+I
SET $PIECE(TMP,U,PC)=$PIECE(CDAT,U,I)
+15 ; pad extra nil piece
SET TMP=TMP_U
+16 ; preserve IEN in PP3
SET $PIECE(REC2,"|")=TMP
SET $PIECE(REC2,"|",3)=HISTIEN
+17 SET ^XTMP("MAGJ2","HISTORY",DUZ,DUZ(2),HISTIEN,1)=REC1
SET ^(2)=REC2
+18 ; Kill input node
KILL ^XTMP("MAGJ2","HISTORY",DUZ,DUZ(2),0,"ADD",HISTIEN)
End DoDot:3
End DoDot:2
End DoDot:1
+19 KILL @MAGLST
+20 QUIT
+21 ;
BKREQU ; UNREAD exams from bkgnd
+1 LOCK +^XTMP("MAGJ2","BKGND2","RUN"):0
+2 ; bkgnd process IS running
IF '$TEST
DO BKOUT("UNREAD")
QUIT
+3 ; NOT running, so start it!
+4 ; 2nd errtrap is to deal with locks if error occurs
+5 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR1^MAGJLS2"
+6 NEW ZTDESC,ZTDTH,ZTIO,ZTRTN
+7 SET ZTRTN="BKGND^MAGJLS2"
SET ZTDESC="IMAGING ISI Rad UNREAD List Compile"
+8 SET ZTDTH=$HOROLOG
SET ZTIO=""
DO ^%ZTLOAD
+9 SET X=$$CURLIST(LSTNAM)
SET LSTAGE=$PIECE(X,U,2)
SET LSTNUM=$SELECT(+X:+X,1:+$PIECE(X,U,3))
+10 ; CURLIST sub's check for excessive time n/a here
+11 ; Foregnd compile if need fresh list
IF LSTAGE>(DELTA+300)
SET BKGPROC=2
Begin DoDot:1
+12 DO LSTCOMP(.COMPFAIL)
KILL BKGPROC
+13 SET X=$$CURLIST(LSTNAM)
SET LSTAGE=$PIECE(X,U,2)
SET LSTNUM=+X
End DoDot:1
+14 LOCK -^XTMP("MAGJ2","BKGND2","RUN")
+15 IF +$GET(COMPFAIL)!'LSTNUM
SET MAGGRY=$NAME(^TMP($JOB,"RET"))
SET @MAGGRY@(0)="0^4~Unable to Compile Unread Exams list ("_$SELECT(+LSTNUM:"COMPFAIL",1:"LSTNUM")_" in MAGJLS2)."
+16 IF '$TEST
DO LSTOUT^MAGJLS2B(.MAGGRY,LSTID,$NAME(^XTMP("MAGJ2",LSTNAM,LSTNUM)),LSTAGE)
+17 KILL LSTAGE
+18 QUIT
+19 ;
BKREQR ; Recent Exams from bkgnd
+1 DO BKOUT("RECENT")
+2 QUIT
+3 ;
BKOUT(LSTNM) ; output list from the bkgnd process
+1 NEW MSG
SET MSG=""
+2 ; if CURLIST returns a value in Piece 3, then the Compile is probably not current
+3 ; so get a message out with the list
+4 SET X=$$CURLIST(LSTNAM)
SET LSTAGE=$PIECE(X,U,2)
SET LSTNUM=+X
+5 IF 'LSTNUM
Begin DoDot:1
+6 IF +$PIECE(X,U,3)
SET LSTNUM=+$PIECE(X,U,3)
SET MSG="Compile program for "_LSTNM_" may not be current (age="_LSTAGE_" for "_LSTNAM_")"_$SELECT(LSTNAM["9992":"--May need to Schedule RECENT List Compile in TaskMan.",1:"")
End DoDot:1
+7 IF LSTNUM
DO LSTOUT^MAGJLS2B(.MAGGRY,LSTID,$NAME(^XTMP("MAGJ2",LSTNAM,LSTNUM)),LSTAGE,MSG)
+8 IF '$TEST
IF 'LSTNUM
SET MAGGRY=$NAME(^TMP($JOB,"RET"))
SET @MAGGRY@(0)="0^4~Problem with "_LSTNM_" List Compile program (age="_LSTAGE_" for "_LSTNAM_")"_$SELECT(LSTNAM["9992":"--May need to Schedule RECENT List Compile in TaskMan.",1:"")
+9 KILL LSTAGE
+10 QUIT
+11 ;
+12 ; ISI -- Rev-2 modify this subroutine to compile Recent part in foreground
+13 ; Conditional on Rev-2 being enabled (else, use original logic)
BKREQA(DATA) ; ALL Active from Bkgnd
+1 ; Copy compiles of Unread & Recent to a scratch global, & call lstout
+2 NEW ALLGO,CNT,GETLST,ICNT,REPLY,MSG
+3 SET ALLGO=1
SET CNT=0
SET MSG=""
+4 FOR GETLST=9991,9992
Begin DoDot:1
+5 DO PARAMS^MAGJLS2B(GETLST)
IF 'LSTID
SET ALLGO=" not properly defined."
QUIT
+6 ; ISI -- begin changes
+7 ; Rev-2 NOT enabled, Recent part from background
IF GETLST=9991!(GETLST=9992&'$$MGRREV2^ISIJUTL9)
Begin DoDot:2
+8 SET X=$$CURLIST(LSTNAM)
SET LSTAGE=$PIECE(X,U,2)
SET LSTNUM=+X
+9 IF 'LSTNUM
Begin DoDot:3
+10 IF +$PIECE(X,U,3)
SET LSTNUM=+$PIECE(X,U,3)
+11 IF LSTNUM
SET MSG=MSG_$SELECT(MSG="":"Compile program for ",1:"; ")_"component "_LSTNAM_" may not be current (age="_LSTAGE_" for "_GETLST_")"
End DoDot:3
+12 IF 'LSTNUM
SET ALLGO=" needs more time to compile."
QUIT
+13 FOR ICNT=1:1:$GET(^XTMP("MAGJ2",LSTNAM,LSTNUM,0,1))
SET X=^XTMP("MAGJ2",LSTNAM,LSTNUM,ICNT,1)
SET Y=^(2)
SET Z=$GET(^("ISI"))
SET CNT=CNT+1
SET ^TMP($JOB,"MAGJ",CNT,1)=X
SET ^(2)=Y
SET ^("ISI")=Z
End DoDot:2
+14 ; Rev-2 enabled, compile Recent part in foreground
IF GETLST=9992
IF $$MGRREV2^ISIJUTL9
Begin DoDot:2
+15 DO BLDACTV^MAGJLS3(.MAGLST,LSTPARAM)
+16 FOR ICNT=1:1:$GET(@MAGLST@(0,1))
SET X=@MAGLST@(ICNT,1)
SET Y=^(2)
SET Z=$GET(^("ISI"))
SET CNT=CNT+1
SET ^TMP($JOB,"MAGJ",CNT,1)=X
SET ^(2)=Y
SET ^("ISI")=Z
End DoDot:2
End DoDot:1
IF 'ALLGO
SET REPLY="Component List "_GETLST_ALLGO
QUIT
+17 ; ISI -- end of changes
+18 IF ALLGO
Begin DoDot:1
+19 SET ^TMP($JOB,"MAGJ",0,1)=CNT_U_"1~ALL Active Exams"
SET ^(2)=""
+20 DO PARAMS^MAGJLS2B($PIECE(DATA,U))
+21 DO LSTOUT^MAGJLS2B(.MAGGRY,LSTID,$NAME(^TMP($JOB,"MAGJ")),,MSG)
End DoDot:1
+22 IF 'ALLGO
SET MAGGRY=$NAME(^TMP($JOB,"RET"))
SET @MAGGRY@(0)="0^4~Problem with ALL Exams List Compile "_DATA_". "_REPLY
+23 KILL LSTAGE
+24 QUIT
+25 ;
BKGND ; EP for background compile of UNREAD exams
+1 ; allow fgnd job to finish compile
LOCK +^XTMP("MAGJ2","BKGND2","RUN"):1200
+2 ; I must already be running!
IF '$TEST
QUIT
+3 NEW BKGLSTID
SET BKGLSTID=9991
GOTO BKGNDA
+4 QUIT
BKGND2 ; EP--bkgnd compile RECENT
+1 ; ISI -- Rev-2 enabled, no more background compile
if $$MGRREV2^ISIJUTL9
QUIT
+2 NEW BKGLSTID
SET BKGLSTID=9992
GOTO BKGNDA
+3 QUIT
BKGNDA SET BKGPROC=1
SET U="^"
+1 NEW $ETRAP,$ESTACK
SET $ETRAP="D BKGERR^MAGJLS2"
+2 DO MAGJOBNC^MAGJUTL3
+3 DO PARAMS^MAGJLS2B(BKGLSTID)
BKLOOP ; Loop & compile "master" UNREAD List only
+1 SET BKLOOP=$GET(BKLOOP)+1
+2 IF BKLOOP>1
DO PARAMS^MAGJLS2B(9991)
+3 IF 'LSTID
Begin DoDot:1
+4 SET X="0^4~Problem with BACKGROUND Compile of Exams List"
+5 FOR I=1,2
KILL ^XTMP("MAGJ2",LSTNAM,I)
+6 ; get msg to WS user
FOR I=1,2
SET ^XTMP("MAGJ2",LSTNAM,I,0,1)=X
SET ^(2)=""
End DoDot:1
GOTO BKGNDZ
+7 ; need this to cover for excessive time to compile
IF 'BKGND
GOTO BKGNDZ
+8 SET X=$$CURLIST(LSTNAM)
SET LSTAGE=$PIECE(X,U,2)
SET LSTNUM=+X
+9 IF 'LSTNUM
IF +$PIECE(X,U,3)
SET LSTNUM=+$PIECE(X,U,3)
+10 ; above prevents compiling over top of the active list LSTNUM=1 if compiles are excessively long
+11 ;bkgnd compile off?
IF LSTREQ="U"
IF (LSTAGE<DELTA)
Begin DoDot:1
+12 NEW ITEST,TEST
+13 SET TEST=(DELTA-LSTAGE)\5
+14 ; while waiting, periodic chk for stop conditions
+15 FOR ITEST=1:1:TEST
HANG 5
Begin DoDot:2
+16 SET BKGND=+$PIECE($GET(^MAG(2006.69,1,0)),U,8)
if 'BKGND
QUIT
+17 ; Exit bkgnd via TaskMan Req
IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD
SET BKGND=0
End DoDot:2
if 'BKGND
QUIT
+18 HANG 3
End DoDot:1
IF 'BKGND
GOTO BKGNDZ
+19 DO LSTCOMP()
+20 ; ISI -- Rev-2 eliminates this
IF LSTREQ="R"
if '$$MGRREV2^ISIJUTL9
DO NEWINT
+21 ;UNREAD loops; RECENT uses TaskMan ; ISI -- Rev-2 ditto
IF LSTREQ="U"
if '$$MGRREV2^ISIJUTL9
DO UPDR^MAGJLS2B
GOTO BKLOOP
BKGNDZ IF LSTREQ="U"
LOCK -^XTMP("MAGJ2","BKGND2","RUN")
+1 ; clean up task entry
NEW ZTREQ
SET ZTREQ="@"
+2 KILL BKLOOP,DELTA,LSTAGE
+3 ; Exit bkgnd
QUIT
+4 ;
NEWINT ; Add exams newly Interp since Recent Compile started to Recent List
+1 ; 1st, get list of candidates:
+2 NEW INDX
LOCK +^XTMP("MAGJ2","RECENT"):15
+3 IF '$TEST
QUIT
+4 ; counter when Recent Compile started
SET INDX=+$GET(^TMP($JOB,"NEWINT"))
+5 IF INDX
SET INDX=INDX-1
FOR
SET INDX=$ORDER(^XTMP("MAGJ2","RECENT",INDX))
if 'INDX
QUIT
SET X=^(INDX)
IF X
SET ^TMP($JOB,"NEWINT",0,INDX)=X
+6 KILL ^XTMP("MAGJ2","RECENT")
SET ^("RECENT",0)=0
+7 LOCK -^XTMP("MAGJ2","RECENT")
+8 ;if not in Recent Compile, add to index
+9 SET INDX=""
+10 FOR
SET INDX=$ORDER(^TMP($JOB,"NEWINT",0,INDX))
if 'INDX
QUIT
SET X=^(INDX)
Begin DoDot:1
+11 ; already there
IF $DATA(^TMP($JOB,"NEWINT",$PIECE(X,U,1,3)))
QUIT
+12 LOCK +^XTMP("MAGJ2","RECENT"):15
+13 IF '$TEST
QUIT
+14 ;add
SET I=+$GET(^XTMP("MAGJ2","RECENT",0))+1
SET $PIECE(^(0),U)=I
SET ^(I)=X
+15 LOCK -^XTMP("MAGJ2","RECENT")
End DoDot:1
+16 KILL ^TMP($JOB,"NEWINT")
+17 QUIT
+18 ;
LSTCOMP(COMPFAIL) ; Compile new list; subrtn used by Active and Bkgnd tags
+1 ; Return T/F for "Executed a List Compile?"
SET COMPFAIL=0
+2 LOCK +^XTMP("MAGJ2","BKGND",LSTNAM,"COMPILE"):60
+3 IF '$TEST
SET COMPFAIL=1
GOTO LSTCOMZ
+4 ;
+5 NEW COMTIM,NEWLIST,TS
+6 ; toggle node to use
SET NEWLIST=$SELECT(LSTNUM=1:2,1:1)
+7 SET TS=""
FOR I=2,0
SET TS=TS_$SELECT(TS="":"",1:U)_$$HTFM^XLFDT($HOROLOG+I,0)
+8 SET ^XTMP("MAGJ2",0)=TS_U_"ISI Rad List Compile"
+9 SET ^XTMP("MAGJ2",0,LSTNAM,NEWLIST)=$HOROLOG
+10 DO BLDACTV^MAGJLS3(.MAGGRY,LSTPARAM,$NAME(^XTMP("MAGJ2",LSTNAM,NEWLIST)))
+11 SET COMTIM=$$DELTA($PIECE(^XTMP("MAGJ2",0,LSTNAM,NEWLIST),U))
+12 SET ^XTMP("MAGJ2",LSTNAM,NEWLIST)=$HOROLOG_U_$JOB_U_COMTIM
+13 SET ^XTMP("MAGJ2","BKGND",LSTNAM,0)=NEWLIST_U_$HOROLOG
+14 IF $GET(^XTMP("MAGJ2",0,"TIME"))
Begin DoDot:1
+15 SET T1=$PIECE($HOROLOG,",",2)/3600
SET T2=$EXTRACT(100+(T1\1),2,3)
SET T=T2_":"_$EXTRACT(100+(T1-T2*60),2,3)
+16 SET ^XTMP("MAGJ2",0,"TIME",LSTNAM,+$HOROLOG,T)=COMTIM
KILL T,T1,T2
End DoDot:1
LSTCOMZ LOCK -^XTMP("MAGJ2","BKGND",LSTNAM,"COMPILE")
+1 ;
QUIT
CURLIST(LSTNAM,WAIT) ; return cur. list & age in secs
+1 ; RET = Current_List_Num ^ age ^ Problem_Current_List_Num
+2 ; Current_List_Num -- Nil means brand new; value means this is most current
+3 ; piece 3 populated if excessive time has elapsed, indicating potential problem
+4 SET WAIT=+$GET(WAIT)
+5 NEW X,RET,AGE,TRY,START,EXTRATIM
+6 SET TRY=0
SET START=$HOROLOG
SET EXTRATIM=$SELECT(LSTREQ="U":600,1:1800)
+7 ; Cur # ^ $H created
SET X=$GET(^XTMP("MAGJ2","BKGND",LSTNAM,0))
+8 ; this lstnam not yet compiled!
IF X=""
SET RET="^86400^0"
GOTO CURLISZ
+9 SET AGE=$$DELTA($PIECE(X,U,2))
SET RET=$PIECE(X,U)_U_AGE
+10 ; last compile was "long" ago; return indicator of this
IF AGE>(DELTA+EXTRATIM)
SET X=$PIECE(RET,U)
SET $PIECE(RET,U,3)=X
SET $PIECE(RET,U)=""
CURLISZ QUIT RET
+1 ;
DELTA(X,Y) ; calc # secs bet 2 $h values; dflt 2nd value = now
+1 ; useful limit is one day
+2 IF $GET(Y)=""
SET Y=$HOROLOG
+3 IF +Y=+X
+4 IF '$TEST
Begin DoDot:1
+5 ; midnight boundary
IF Y-X=1
SET $PIECE(Y,",",2)=86400+$PIECE(Y,",",2)
+6 ; > one day
IF '$TEST
SET $PIECE(X,",",2)=0
SET $PIECE(Y,",",2)=86400
End DoDot:1
+7 QUIT ($PIECE(Y,",",2)-$PIECE(X,",",2))
+8 ;
END ;
