- 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 Feb 18, 2025@23:33:13 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 ;