MAGJUPD1 ;WOIFO/JHC VistARad Update Exam Status ; 29 Jul 2003  10:02 AM
 ;;3.0;IMAGING;**16,22,18**;Mar 07, 2006
 ;; +---------------------------------------------------------------+
 ;; | 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.                     |
 ;; +---------------------------------------------------------------+
 ;;
 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
 ;   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
 S MAGLST="MAGJUPDATE"
 K MAGGRY S MAGGRY=$NA(^TMP($J,MAGLST)) K @MAGGRY  ; assign MAGGRY value
 S DIQUIET=1 D DT^DICRW
 D NOW^%DTC S TIMESTMP=%
 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,"-",2),RADTE=$P(RADATA,U,7)
 S RAINT=RADTI_"-"_RACNI
 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
 ;
 ; 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 at tag PRTSET, below),
 ;    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 D  ; assume update has otherwise been done, eg voice dictation or manual entry in Vista
 .. 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 . ;  if exam is part of Rad Print-Set, then update all exams of printset
 . I RAPRTSET D
 .. S ACNLST="",SAVRACNI=RACNI,X=0
 .. F I=0:1 S X=$O(MAGPSET(X)) Q:'X  S RACNILST=RACNILST_$S(I:U,1:"")_X S:RACNE'=+MAGPSET(X) ACNLST=ACNLST_", "_"-"_+MAGPSET(X)
 . 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
 D LOG^MAGJUTL3("VR-INT",LOGDATA)
 ; Update Recent Exams List
 G STATUSZ:'$P(^MAG(2006.69,1,0),U,8)  ; no bkgnd compile enabled
 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  ;