Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGJLS2

MAGJLS2.m

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