MAGJUPD1 ;WOIFO/JHC - VistARad Update Exam Status ; 10/17/2022
;;3.0;IMAGING;**16,22,18,76,101,120,133,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. |
;; +---------------------------------------------------------------+
;;
; Reference to EN2^RAUTL20 in ICR #3270
; Reference to STUFPHY^RARIC1 #3317
; Reference to UP1^RAUTL1 in ICR #1180
;; ISI IMAGING;**99,101,106**
Q
; Subroutines for RPC's to update Exam Status to "Interpreted", and
; for "Closing" a case that is open on the DX Workstation
;
ERR N ERR S ERR=$$EC^%ZOSV S @MAGGRY@(0)="0^Server Program Error: "_ERR
D @^%ZOSF("ERRTN")
Q:$Q 1 Q
;
STATUS(MAGGRY,PARAMS,DATA) ; rpc: MAGJ RADSTATUSUPDATE
; Update Exam Status to "Interpreted" and/or Close the exam
; Only updates the Status if the current value is "Examined"
; This routine defines variables needed for calling the Radiology
; package routine UP1^RAUTL1, for filing Status updates
;
; PARAMS = UPDFLAG ^ RADFN ^ RADTI ^ RACNI ^ RARPT ^ UPDPSKEY
; UPDFLAG = 1/0 -- 1 to perform update; else no update made
; RARPT = ptr to Rad Exam Report file
; RADFN,RADTI,RACNI = pointers to Rad Patient File for the exam
; UPDPSKEY = 1/0 -- 1 to update Presentation State &/or Key Image data
; = 2 -- update PS data with NO lock in place--Resident workflow, or Sec Key Override
; DATA = optional array containing prezentation state data; see SAVKPS^MAGJUPD2 for description
; MAGGRY = return results in @MAGGRY
;
N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJUPD1"
N RARPT,RADFN,RADTI,RACNI,RAEXT,RACNE,RADTE,RAINT,RAMDV,DIQUIET
N RAONLINE,ZTQUEUED,RAOR,RASN,RASTI,RAPRTSET,LOGDATA,RSL,TIMESTMP
N UPDPSKEY,MAGRET,MAGLST,REPLY,UPDFLAG,RADATA,RIST,MAGPSET,RACNILST,ACNLST
N PSETLST,RASTCAT ; ISI P106
S MAGLST="MAGJUPDATE"
K MAGGRY S MAGGRY=$NA(^TMP($J,MAGLST)) K @MAGGRY ; assign MAGGRY value
S DIQUIET=1 D DT^DICRW
S TIMESTMP=$$NOW^XLFDT()
S UPDFLAG=$P(PARAMS,U),RADFN=$P(PARAMS,U,2),RADTI=$P(PARAMS,U,3),RACNI=$P(PARAMS,U,4),RARPT=$P(PARAMS,U,5),UPDPSKEY=+$P(PARAMS,U,6)
S REPLY="0^4~Closing case with"_$S(UPDFLAG:"",1:" NO")_" Status Update"
S RAPRTSET=0
I RADFN,RADTI,RACNI
E S REPLY="0^4~Request Contains Invalid Case Pointer ("_RARPT_")" G STATUSZ
D GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,0,.MAGRET)
I 'MAGRET S REPLY="0^4~Current Case Not Accessible for Updating" G STATUSZ
; 1 RADFN RADTI RACNI RANME RASSN <--Contents of RADATA,
; 6 RADATE RADTE RACN RAPRC RARPT from GETEXAM
;11 RAST DAYCASE RAELOC RASTP RASTORD
;16 RADTPRT
S RADATA=$G(^TMP($J,"MAGRAEX",1,1))
S RAEXT=$P(RADATA,U,12),RACNE=$P(RAEXT,"-",$L(RAEXT,"-")),RADTE=$P(RADATA,U,7) ; p133: $L for SSAN or old Acn
S RAINT=RADTI_"-"_RACNI
S RASTCAT=$P($G(^TMP($J,"MAGRAEX",1,2)),U,11) ; ISI P106
I UPDPSKEY=2 D G STATUSZ ; P101 update annotations only, if authorized (Resident workflow, or Sec Key Override)
. I +MAGJOB("USER",1),'UPDFLAG,($D(DATA)>9) S REPLY="0^1~Case #"_RAEXT_" Closed; No Status Update; annotation updates performed."
. E S UPDPSKEY=0,REPLY="0^4~Invalid request to update annotations for Case #"_RAEXT_"."
D CLOSE(.RSL,RADFN_U_RADTI_U_RACNI_U_U_1,.LOGDATA) ; unlock the case
; proceed only if case was locked by this user
; if it was not Locked, then do NOT update PS, Key Images
I 'RSL S REPLY=RSL,UPDPSKEY=0 G STATUSZ
I 'UPDFLAG S REPLY="0^1~Case #"_RAEXT_" Closed; No Status Update performed" G STATUSZ
S RIST=$P(RSL,U,2) ; CLOSE reports back the type of radiologist
; now we know this user had locked the case, & wants to do Status update
D EN2^RAUTL20(.MAGPSET) ; get info re rad PrintSet
; Note--above call also sets variable RAPRTSET
;
; IF exam is not "Examined", and not "Cancelled" and past "Waiting"
; then assume it has already been updated via another pathway,
; either as printset member (via code below--see PRTSET note...),
; or from a voice-dictation or terminal session by the radiologist
; For these cases, no warning msg is sent
; Else, update not allowed, so give warning msg
; Note that when the Exam was OPENed, it must have had status "Examined"
I '$D(^RA(72,"AVC","E",$P(RADATA,U,11))) D G STATUSX:(+$P(REPLY,U,2)=1),STATUSZ ; Current Status MUST be "Examined" Category
. I $P(RADATA,U,15)>2&(RASTCAT'="R") D ; assume update has otherwise been done, eg voice dictation or manual entry in Vista ; ISI P106
. . S RACNILST=RACNI,RASTI=$P(RADATA,U,11) ; need for code at tag statusx
. . I RAPRTSET S REPLY="0^1~Printset Exams with Case #"_RAEXT_" have been updated"
. . E S REPLY="0^1~No Update done for Case #"_RAEXT_"--current status is "_$P(RADATA,U,14)
. E S REPLY="0^3~No Update Allowed for Case #"_RAEXT_"--current status is "_$P(RADATA,U,14)
;
; now ready to update exam status
S RAMDV=$P(^RADPT(RADFN,"DT",RADTI,0),U,3)
S RAMDV=$TR(^RA(79,RAMDV,.1),"YyNn","1100")
;
; Update interpreting radiologist field in Rad file
I RIST D I RACNILST="" G STATUSZ
. N SAVRACNI,RTN S RACNILST=""
. ; PRTSET note: if exam is part of Rad Print-Set, then update all exams of printset
. I RAPRTSET D
. . S ACNLST="",SAVRACNI=RACNI,X=0
. . N T ; P133 mod for MAGPSET Data ex.--Old= 256^154^190^4 SSAN= 660-080504-256^154^190^4
. . F I=0:1 S X=$O(MAGPSET(X)) Q:'X S RACNILST=RACNILST_$S(I:U,1:"")_X,T=$P(MAGPSET(X),U) S:RACNE'=$P(T,"-",($L(T,"-"))) ACNLST=ACNLST_", "_$S($L(T,"-")=1:"-",1:"")_T
. E S RACNILST=RACNI
. F I=1:1:$L(RACNILST,U) S RACNI=$P(RACNILST,U,I) I RACNI D I RACNILST="" Q
. . S DA(2)=RADFN,DA(1)=RADTI,DA=RACNI
. . D STUFPHY^RARIC1(DUZ,RIST,.RTN)
. . I 'RTN S REPLY="0^4~Unable to update Interpreting Radiologist: "_RTN_"." S RACNILST=""
. I RAPRTSET S RACNI=SAVRACNI
S RAONLINE=1,ZTQUEUED=1 D UP1^RAUTL1 ; Suppress msgs, do Status update
;<*> K RAONLINE,ZTQUEUED D UP1^RAUTL1 ; <*> Testing Only: ENABLE msgs
I RAOR<0 S REPLY="0^3~Exam Status for Case #"_RAEXT_" CANNOT be updated; current status remains: "_$S($G(RASN)]"":RASN,1:"Unknown")
I G STATUSZ
;
S REPLY="0^1~For Case #"_$S($G(ACNLST)]"":"s ",1:"")_RAEXT_$S(RAPRTSET:ACNLST,1:"")_", Exam Status updated to "_RASN
;
STATUSX ; Newly Interpreted exam:
; Log the Interpreted event; Printset logging includes all printset members
S PSETLST=""
I RAPRTSET S X="" D
. F I=0:1 S X=$O(MAGPSET(X)) Q:'X S PSETLST=PSETLST_$S(I:U,1:"")_$P(MAGPSET(X),U)
D LOG^MAGJUTL3("VR-INT",LOGDATA,PSETLST)
; Update Recent Exams List
G STATUSZ:'$P(^MAG(2006.69,1,0),U,8) ; no bkgnd compile enabled
G STATUSZ:$$MGRREV2^ISIJUTL9 ; ISI -- Rev-2 enabled, Recent compile n/a
L +^XTMP("MAGJ2","RECENT"):5
E G STATUSZ
N INDX F I=1:1:$L(RACNILST,U) S RACNI=$P(RACNILST,U,I) I RACNI D
. S INDX=+$G(^XTMP("MAGJ2","RECENT",0))+1,$P(^(0),U)=INDX,^(INDX)=RADFN_U_RADTI_U_RACNI_U_RASTI
L -^XTMP("MAGJ2","RECENT")
STATUSZ ;
; store PS, Key Image data
I UPDPSKEY,($D(DATA)>9) D
. D SAVKPS^MAGJUPD2(RARPT,UPDPSKEY,.DATA,.X)
. S REPLY=REPLY_$P(X,"~",2,99)
S @MAGGRY@(0)=REPLY
K ^TMP($J,"MAGRAEX"),^("RAE1")
Q
;
CLOSE(RSL,PARAMS,LOGDATA) ; Close/unlock a case
; Input: PARAMS = DFN ^ DTI ^ CNI ^ RPT ^ UPDFLAG
;
; DFN,DTI,CNI,RPT = pointers to Rad File for the exam
; UPDFLAG = 1/0 -- 1 indicates CLOSE was called from subroutine
; STATUS, above (which has already called GETEXAM)
; RSL = return result of the Close
; This subroutine may be called directly (to close a case without
; doing a status update), or is called from tag STATUS, above, when
; also doing a status update
;
N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJUPD1"
N RPT,DFN,DTI,CNI,MAGRET,REPLY,RARPT,UPDFLAG,RIST,DAYCASE,NLOCKS,MYLOCK
S DFN=$P(PARAMS,U),DTI=$P(PARAMS,U,2),CNI=$P(PARAMS,U,3),RPT=$P(PARAMS,U,4),UPDFLAG=$P(PARAMS,U,5)
S LOGDATA=""
I $P($G(^MAG(2006.69,1,0)),U,4)
E S REPLY=$S(UPDFLAG:"0^3~Updates not allowed at this site--no action taken",1:"") G CLOSEZ ; Status Update NOT Enabled
S RIST=+MAGJOB("USER",1) I RIST
E S REPLY=$S(UPDFLAG:"0^3~Update allowed only by a radiologist--no action taken",1:"") G CLOSEZ ; need only unlock a radiologist
I DFN,DTI,CNI
E S REPLY="0^4~Request Contains Invalid Case Pointer ("_RPT_")--no action taken" G CLOSEZ
;
I 'UPDFLAG N RADATA D I 'MAGRET G CLOSEZ
. D GETEXAM2^MAGJUTL1(DFN,DTI,CNI,0,.MAGRET)
. I 'MAGRET S REPLY="0^4~No Current Case accessible to close--no action taken"
. E S RADATA=$G(^TMP($J,"MAGRAEX",1,1))
S RARPT=$P(RADATA,U,10),DAYCASE=$P(RADATA,U,12)
I RARPT,DAYCASE
E S REPLY="0^4~Current Case not accessible to close--no action taken" G CLOSEZ
;
D LOCKACT^MAGJEX1A(RARPT,DAYCASE,101,,.MYLOCK)
S LOGDATA=$P(MYLOCK(1),"|",2)
I 'MYLOCK(1) S X=$P(MYLOCK(1),U,4) D S LOGDATA="" G CLOSEZ
. I UPDFLAG S REPLY="0^1~Case #"_DAYCASE_$S(X]"":" locked by "_X,1:" not locked by "_$P(MAGJOB("USER",1),U,2))_"--No Status update performed"
. E S REPLY="0^1~ " ; case wasn't opened by this R'ist; nothing to do
;
I UPDFLAG S REPLY=1_U_RIST
E S REPLY="0^1~Case #"_DAYCASE_$S(+MYLOCK(1):" unlocked",+MYLOCK(2):" reserve cancelled",1:" closed")_"--No Status Update performed."
CLOSEZ S RSL=REPLY
Q
;
END Q ;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGJUPD1 10131 printed Sep 23, 2025@19:43:14 Page 2
MAGJUPD1 ;WOIFO/JHC - VistARad Update Exam Status ; 10/17/2022
+1 ;;3.0;IMAGING;**16,22,18,76,101,120,133,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 ; Reference to EN2^RAUTL20 in ICR #3270
+18 ; Reference to STUFPHY^RARIC1 #3317
+19 ; Reference to UP1^RAUTL1 in ICR #1180
+20 ;; ISI IMAGING;**99,101,106**
+21 QUIT
+22 ; Subroutines for RPC's to update Exam Status to "Interpreted", and
+23 ; for "Closing" a case that is open on the DX Workstation
+24 ;
ERR NEW ERR
SET ERR=$$EC^%ZOSV
SET @MAGGRY@(0)="0^Server Program Error: "_ERR
+1 DO @^%ZOSF("ERRTN")
+2 if $QUIT
QUIT 1
QUIT
+3 ;
STATUS(MAGGRY,PARAMS,DATA) ; rpc: MAGJ RADSTATUSUPDATE
+1 ; Update Exam Status to "Interpreted" and/or Close the exam
+2 ; Only updates the Status if the current value is "Examined"
+3 ; This routine defines variables needed for calling the Radiology
+4 ; package routine UP1^RAUTL1, for filing Status updates
+5 ;
+6 ; PARAMS = UPDFLAG ^ RADFN ^ RADTI ^ RACNI ^ RARPT ^ UPDPSKEY
+7 ; UPDFLAG = 1/0 -- 1 to perform update; else no update made
+8 ; RARPT = ptr to Rad Exam Report file
+9 ; RADFN,RADTI,RACNI = pointers to Rad Patient File for the exam
+10 ; UPDPSKEY = 1/0 -- 1 to update Presentation State &/or Key Image data
+11 ; = 2 -- update PS data with NO lock in place--Resident workflow, or Sec Key Override
+12 ; DATA = optional array containing prezentation state data; see SAVKPS^MAGJUPD2 for description
+13 ; MAGGRY = return results in @MAGGRY
+14 ;
+15 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR^MAGJUPD1"
+16 NEW RARPT,RADFN,RADTI,RACNI,RAEXT,RACNE,RADTE,RAINT,RAMDV,DIQUIET
+17 NEW RAONLINE,ZTQUEUED,RAOR,RASN,RASTI,RAPRTSET,LOGDATA,RSL,TIMESTMP
+18 NEW UPDPSKEY,MAGRET,MAGLST,REPLY,UPDFLAG,RADATA,RIST,MAGPSET,RACNILST,ACNLST
+19 ; ISI P106
NEW PSETLST,RASTCAT
+20 SET MAGLST="MAGJUPDATE"
+21 ; assign MAGGRY value
KILL MAGGRY
SET MAGGRY=$NAME(^TMP($JOB,MAGLST))
KILL @MAGGRY
+22 SET DIQUIET=1
DO DT^DICRW
+23 SET TIMESTMP=$$NOW^XLFDT()
+24 SET UPDFLAG=$PIECE(PARAMS,U)
SET RADFN=$PIECE(PARAMS,U,2)
SET RADTI=$PIECE(PARAMS,U,3)
SET RACNI=$PIECE(PARAMS,U,4)
SET RARPT=$PIECE(PARAMS,U,5)
SET UPDPSKEY=+$PIECE(PARAMS,U,6)
+25 SET REPLY="0^4~Closing case with"_$SELECT(UPDFLAG:"",1:" NO")_" Status Update"
+26 SET RAPRTSET=0
+27 IF RADFN
IF RADTI
IF RACNI
+28 IF '$TEST
SET REPLY="0^4~Request Contains Invalid Case Pointer ("_RARPT_")"
GOTO STATUSZ
+29 DO GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,0,.MAGRET)
+30 IF 'MAGRET
SET REPLY="0^4~Current Case Not Accessible for Updating"
GOTO STATUSZ
+31 ; 1 RADFN RADTI RACNI RANME RASSN <--Contents of RADATA,
+32 ; 6 RADATE RADTE RACN RAPRC RARPT from GETEXAM
+33 ;11 RAST DAYCASE RAELOC RASTP RASTORD
+34 ;16 RADTPRT
+35 SET RADATA=$GET(^TMP($JOB,"MAGRAEX",1,1))
+36 ; p133: $L for SSAN or old Acn
SET RAEXT=$PIECE(RADATA,U,12)
SET RACNE=$PIECE(RAEXT,"-",$LENGTH(RAEXT,"-"))
SET RADTE=$PIECE(RADATA,U,7)
+37 SET RAINT=RADTI_"-"_RACNI
+38 ; ISI P106
SET RASTCAT=$PIECE($GET(^TMP($JOB,"MAGRAEX",1,2)),U,11)
+39 ; P101 update annotations only, if authorized (Resident workflow, or Sec Key Override)
IF UPDPSKEY=2
Begin DoDot:1
+40 IF +MAGJOB("USER",1)
IF 'UPDFLAG
IF ($DATA(DATA)>9)
SET REPLY="0^1~Case #"_RAEXT_" Closed; No Status Update; annotation updates performed."
+41 IF '$TEST
SET UPDPSKEY=0
SET REPLY="0^4~Invalid request to update annotations for Case #"_RAEXT_"."
End DoDot:1
GOTO STATUSZ
+42 ; unlock the case
DO CLOSE(.RSL,RADFN_U_RADTI_U_RACNI_U_U_1,.LOGDATA)
+43 ; proceed only if case was locked by this user
+44 ; if it was not Locked, then do NOT update PS, Key Images
+45 IF 'RSL
SET REPLY=RSL
SET UPDPSKEY=0
GOTO STATUSZ
+46 IF 'UPDFLAG
SET REPLY="0^1~Case #"_RAEXT_" Closed; No Status Update performed"
GOTO STATUSZ
+47 ; CLOSE reports back the type of radiologist
SET RIST=$PIECE(RSL,U,2)
+48 ; now we know this user had locked the case, & wants to do Status update
+49 ; get info re rad PrintSet
DO EN2^RAUTL20(.MAGPSET)
+50 ; Note--above call also sets variable RAPRTSET
+51 ;
+52 ; IF exam is not "Examined", and not "Cancelled" and past "Waiting"
+53 ; then assume it has already been updated via another pathway,
+54 ; either as printset member (via code below--see PRTSET note...),
+55 ; or from a voice-dictation or terminal session by the radiologist
+56 ; For these cases, no warning msg is sent
+57 ; Else, update not allowed, so give warning msg
+58 ; Note that when the Exam was OPENed, it must have had status "Examined"
+59 ; Current Status MUST be "Examined" Category
IF '$DATA(^RA(72,"AVC","E",$PIECE(RADATA,U,11)))
Begin DoDot:1
+60 ; assume update has otherwise been done, eg voice dictation or manual entry in Vista ; ISI P106
IF $PIECE(RADATA,U,15)>2&(RASTCAT'="R")
Begin DoDot:2
+61 ; need for code at tag statusx
SET RACNILST=RACNI
SET RASTI=$PIECE(RADATA,U,11)
+62 IF RAPRTSET
SET REPLY="0^1~Printset Exams with Case #"_RAEXT_" have been updated"
+63 IF '$TEST
SET REPLY="0^1~No Update done for Case #"_RAEXT_"--current status is "_$PIECE(RADATA,U,14)
End DoDot:2
+64 IF '$TEST
SET REPLY="0^3~No Update Allowed for Case #"_RAEXT_"--current status is "_$PIECE(RADATA,U,14)
End DoDot:1
if (+$PIECE(REPLY,U,2)=1)
GOTO STATUSX
GOTO STATUSZ
+65 ;
+66 ; now ready to update exam status
+67 SET RAMDV=$PIECE(^RADPT(RADFN,"DT",RADTI,0),U,3)
+68 SET RAMDV=$TRANSLATE(^RA(79,RAMDV,.1),"YyNn","1100")
+69 ;
+70 ; Update interpreting radiologist field in Rad file
+71 IF RIST
Begin DoDot:1
+72 NEW SAVRACNI,RTN
SET RACNILST=""
+73 ; PRTSET note: if exam is part of Rad Print-Set, then update all exams of printset
+74 IF RAPRTSET
Begin DoDot:2
+75 SET ACNLST=""
SET SAVRACNI=RACNI
SET X=0
+76 ; P133 mod for MAGPSET Data ex.--Old= 256^154^190^4 SSAN= 660-080504-256^154^190^4
NEW T
+77 FOR I=0:1
SET X=$ORDER(MAGPSET(X))
if 'X
QUIT
SET RACNILST=RACNILST_$SELECT(I:U,1:"")_X
SET T=$PIECE(MAGPSET(X),U)
if RACNE'=$PIECE(T,"-",($LENGTH(T,"-")))
SET ACNLST=ACNLST_", "_$SELECT($LENGTH(T,"-")=1:"-",1:"")_T
End DoDot:2
+78 IF '$TEST
SET RACNILST=RACNI
+79 FOR I=1:1:$LENGTH(RACNILST,U)
SET RACNI=$PIECE(RACNILST,U,I)
IF RACNI
Begin DoDot:2
+80 SET DA(2)=RADFN
SET DA(1)=RADTI
SET DA=RACNI
+81 DO STUFPHY^RARIC1(DUZ,RIST,.RTN)
+82 IF 'RTN
SET REPLY="0^4~Unable to update Interpreting Radiologist: "_RTN_"."
SET RACNILST=""
End DoDot:2
IF RACNILST=""
QUIT
+83 IF RAPRTSET
SET RACNI=SAVRACNI
End DoDot:1
IF RACNILST=""
GOTO STATUSZ
+84 ; Suppress msgs, do Status update
SET RAONLINE=1
SET ZTQUEUED=1
DO UP1^RAUTL1
+85 ;<*> K RAONLINE,ZTQUEUED D UP1^RAUTL1 ; <*> Testing Only: ENABLE msgs
+86 IF RAOR<0
SET REPLY="0^3~Exam Status for Case #"_RAEXT_" CANNOT be updated; current status remains: "_$SELECT($GET(RASN)]"":RASN,1:"Unknown")
+87 IF $TEST
GOTO STATUSZ
+88 ;
+89 SET REPLY="0^1~For Case #"_$SELECT($GET(ACNLST)]"":"s ",1:"")_RAEXT_$SELECT(RAPRTSET:ACNLST,1:"")_", Exam Status updated to "_RASN
+90 ;
STATUSX ; Newly Interpreted exam:
+1 ; Log the Interpreted event; Printset logging includes all printset members
+2 SET PSETLST=""
+3 IF RAPRTSET
SET X=""
Begin DoDot:1
+4 FOR I=0:1
SET X=$ORDER(MAGPSET(X))
if 'X
QUIT
SET PSETLST=PSETLST_$SELECT(I:U,1:"")_$PIECE(MAGPSET(X),U)
End DoDot:1
+5 DO LOG^MAGJUTL3("VR-INT",LOGDATA,PSETLST)
+6 ; Update Recent Exams List
+7 ; no bkgnd compile enabled
if '$PIECE(^MAG(2006.69,1,0),U,8)
GOTO STATUSZ
+8 ; ISI -- Rev-2 enabled, Recent compile n/a
if $$MGRREV2^ISIJUTL9
GOTO STATUSZ
+9 LOCK +^XTMP("MAGJ2","RECENT"):5
+10 IF '$TEST
GOTO STATUSZ
+11 NEW INDX
FOR I=1:1:$LENGTH(RACNILST,U)
SET RACNI=$PIECE(RACNILST,U,I)
IF RACNI
Begin DoDot:1
+12 SET INDX=+$GET(^XTMP("MAGJ2","RECENT",0))+1
SET $PIECE(^(0),U)=INDX
SET ^(INDX)=RADFN_U_RADTI_U_RACNI_U_RASTI
End DoDot:1
+13 LOCK -^XTMP("MAGJ2","RECENT")
STATUSZ ;
+1 ; store PS, Key Image data
+2 IF UPDPSKEY
IF ($DATA(DATA)>9)
Begin DoDot:1
+3 DO SAVKPS^MAGJUPD2(RARPT,UPDPSKEY,.DATA,.X)
+4 SET REPLY=REPLY_$PIECE(X,"~",2,99)
End DoDot:1
+5 SET @MAGGRY@(0)=REPLY
+6 KILL ^TMP($JOB,"MAGRAEX"),^("RAE1")
+7 QUIT
+8 ;
CLOSE(RSL,PARAMS,LOGDATA) ; Close/unlock a case
+1 ; Input: PARAMS = DFN ^ DTI ^ CNI ^ RPT ^ UPDFLAG
+2 ;
+3 ; DFN,DTI,CNI,RPT = pointers to Rad File for the exam
+4 ; UPDFLAG = 1/0 -- 1 indicates CLOSE was called from subroutine
+5 ; STATUS, above (which has already called GETEXAM)
+6 ; RSL = return result of the Close
+7 ; This subroutine may be called directly (to close a case without
+8 ; doing a status update), or is called from tag STATUS, above, when
+9 ; also doing a status update
+10 ;
+11 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR^MAGJUPD1"
+12 NEW RPT,DFN,DTI,CNI,MAGRET,REPLY,RARPT,UPDFLAG,RIST,DAYCASE,NLOCKS,MYLOCK
+13 SET DFN=$PIECE(PARAMS,U)
SET DTI=$PIECE(PARAMS,U,2)
SET CNI=$PIECE(PARAMS,U,3)
SET RPT=$PIECE(PARAMS,U,4)
SET UPDFLAG=$PIECE(PARAMS,U,5)
+14 SET LOGDATA=""
+15 IF $PIECE($GET(^MAG(2006.69,1,0)),U,4)
+16 ; Status Update NOT Enabled
IF '$TEST
SET REPLY=$SELECT(UPDFLAG:"0^3~Updates not allowed at this site--no action taken",1:"")
GOTO CLOSEZ
+17 SET RIST=+MAGJOB("USER",1)
IF RIST
+18 ; need only unlock a radiologist
IF '$TEST
SET REPLY=$SELECT(UPDFLAG:"0^3~Update allowed only by a radiologist--no action taken",1:"")
GOTO CLOSEZ
+19 IF DFN
IF DTI
IF CNI
+20 IF '$TEST
SET REPLY="0^4~Request Contains Invalid Case Pointer ("_RPT_")--no action taken"
GOTO CLOSEZ
+21 ;
+22 IF 'UPDFLAG
NEW RADATA
Begin DoDot:1
+23 DO GETEXAM2^MAGJUTL1(DFN,DTI,CNI,0,.MAGRET)
+24 IF 'MAGRET
SET REPLY="0^4~No Current Case accessible to close--no action taken"
+25 IF '$TEST
SET RADATA=$GET(^TMP($JOB,"MAGRAEX",1,1))
End DoDot:1
IF 'MAGRET
GOTO CLOSEZ
+26 SET RARPT=$PIECE(RADATA,U,10)
SET DAYCASE=$PIECE(RADATA,U,12)
+27 IF RARPT
IF DAYCASE
+28 IF '$TEST
SET REPLY="0^4~Current Case not accessible to close--no action taken"
GOTO CLOSEZ
+29 ;
+30 DO LOCKACT^MAGJEX1A(RARPT,DAYCASE,101,,.MYLOCK)
+31 SET LOGDATA=$PIECE(MYLOCK(1),"|",2)
+32 IF 'MYLOCK(1)
SET X=$PIECE(MYLOCK(1),U,4)
Begin DoDot:1
+33 IF UPDFLAG
SET REPLY="0^1~Case #"_DAYCASE_$SELECT(X]"":" locked by "_X,1:" not locked by "_$PIECE(MAGJOB("USER",1),U,2))_"--No Status update performed"
+34 ; case wasn't opened by this R'ist; nothing to do
IF '$TEST
SET REPLY="0^1~ "
End DoDot:1
SET LOGDATA=""
GOTO CLOSEZ
+35 ;
+36 IF UPDFLAG
SET REPLY=1_U_RIST
+37 IF '$TEST
SET REPLY="0^1~Case #"_DAYCASE_$SELECT(+MYLOCK(1):" unlocked",+MYLOCK(2):" reserve cancelled",1:" closed")_"--No Status Update performed."
CLOSEZ SET RSL=REPLY
+1 QUIT
+2 ;
END ;
QUIT
