| 1 | MAGJUPD1 ;WOIFO/JHC VistARad Update Exam Status ; 29 Jul 2003 10:02 AM
|
|---|
| 2 | ;;3.0;IMAGING;**16,22,18,76**;Jun 22, 2007;Build 19
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;; +---------------------------------------------------------------+
|
|---|
| 5 | ;; | Property of the US Government. |
|
|---|
| 6 | ;; | No permission to copy or redistribute this software is given. |
|
|---|
| 7 | ;; | Use of unreleased versions of this software requires the user |
|
|---|
| 8 | ;; | to execute a written test agreement with the VistA Imaging |
|
|---|
| 9 | ;; | Development Office of the Department of Veterans Affairs, |
|
|---|
| 10 | ;; | telephone (301) 734-0100. |
|
|---|
| 11 | ;; | |
|
|---|
| 12 | ;; | The Food and Drug Administration classifies this software as |
|
|---|
| 13 | ;; | a medical device. As such, it may not be changed in any way. |
|
|---|
| 14 | ;; | Modifications to this software may result in an adulterated |
|
|---|
| 15 | ;; | medical device under 21CFR820, the use of which is considered |
|
|---|
| 16 | ;; | to be a violation of US Federal Statutes. |
|
|---|
| 17 | ;; +---------------------------------------------------------------+
|
|---|
| 18 | ;;
|
|---|
| 19 | Q
|
|---|
| 20 | ; Subroutines for RPC's to update Exam Status to "Interpreted", and
|
|---|
| 21 | ; for "Closing" a case that is open on the DX Workstation
|
|---|
| 22 | ;
|
|---|
| 23 | ERR N ERR S ERR=$$EC^%ZOSV S @MAGGRY@(0)="0^Server Program Error: "_ERR
|
|---|
| 24 | D @^%ZOSF("ERRTN")
|
|---|
| 25 | Q:$Q 1 Q
|
|---|
| 26 | ;
|
|---|
| 27 | STATUS(MAGGRY,PARAMS,DATA) ; rpc: MAGJ RADSTATUSUPDATE
|
|---|
| 28 | ; Update Exam Status to "Interpreted" and/or Close the exam
|
|---|
| 29 | ; Only updates the Status if the current value is "Examined"
|
|---|
| 30 | ; This routine defines variables needed for calling the Radiology
|
|---|
| 31 | ; package routine UP1^RAUTL1, for filing Status updates
|
|---|
| 32 | ;
|
|---|
| 33 | ; PARAMS = UPDFLAG ^ RADFN ^ RADTI ^ RACNI ^ RARPT ^ UPDPSKEY
|
|---|
| 34 | ; UPDFLAG = 1/0 -- 1 to perform update; else no update made
|
|---|
| 35 | ; RARPT = ptr to Rad Exam Report file
|
|---|
| 36 | ; RADFN,RADTI,RACNI = pointers to Rad Patient File for the exam
|
|---|
| 37 | ; UPDPSKEY = 1/0 -- 1 to update Presentation State &/or Key Image data
|
|---|
| 38 | ; MAGGRY = return results in @MAGGRY
|
|---|
| 39 | ;
|
|---|
| 40 | N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJUPD1"
|
|---|
| 41 | N RARPT,RADFN,RADTI,RACNI,RAEXT,RACNE,RADTE,RAINT,RAMDV,DIQUIET
|
|---|
| 42 | N RAONLINE,ZTQUEUED,RAOR,RASN,RASTI,RAPRTSET,LOGDATA,RSL,TIMESTMP
|
|---|
| 43 | N UPDPSKEY,MAGRET,MAGLST,REPLY,UPDFLAG,RADATA,RIST,MAGPSET,RACNILST,ACNLST
|
|---|
| 44 | S MAGLST="MAGJUPDATE"
|
|---|
| 45 | K MAGGRY S MAGGRY=$NA(^TMP($J,MAGLST)) K @MAGGRY ; assign MAGGRY value
|
|---|
| 46 | S DIQUIET=1 D DT^DICRW
|
|---|
| 47 | S TIMESTMP=$$NOW^XLFDT()
|
|---|
| 48 | 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)
|
|---|
| 49 | S REPLY="0^4~Closing case with"_$S(UPDFLAG:"",1:" NO")_" Status Update"
|
|---|
| 50 | S RAPRTSET=0
|
|---|
| 51 | I RADFN,RADTI,RACNI
|
|---|
| 52 | E S REPLY="0^4~Request Contains Invalid Case Pointer ("_RARPT_")" G STATUSZ
|
|---|
| 53 | D GETEXAM2^MAGJUTL1(RADFN,RADTI,RACNI,0,.MAGRET)
|
|---|
| 54 | I 'MAGRET S REPLY="0^4~Current Case Not Accessible for Updating" G STATUSZ
|
|---|
| 55 | ; 1 RADFN RADTI RACNI RANME RASSN <--Contents of RADATA,
|
|---|
| 56 | ; 6 RADATE RADTE RACN RAPRC RARPT from GETEXAM
|
|---|
| 57 | ;11 RAST DAYCASE RAELOC RASTP RASTORD
|
|---|
| 58 | ;16 RADTPRT
|
|---|
| 59 | S RADATA=$G(^TMP($J,"MAGRAEX",1,1))
|
|---|
| 60 | S RAEXT=$P(RADATA,U,12),RACNE=$P(RAEXT,"-",2),RADTE=$P(RADATA,U,7)
|
|---|
| 61 | S RAINT=RADTI_"-"_RACNI
|
|---|
| 62 | D CLOSE(.RSL,RADFN_U_RADTI_U_RACNI_U_U_1,.LOGDATA) ; unlock the case
|
|---|
| 63 | ; proceed only if case was locked by this user
|
|---|
| 64 | ; if it was not Locked, then do NOT update PS, Key Images
|
|---|
| 65 | I 'RSL S REPLY=RSL,UPDPSKEY=0 G STATUSZ
|
|---|
| 66 | I 'UPDFLAG S REPLY="0^1~Case #"_RAEXT_" Closed; No Status Update performed" G STATUSZ
|
|---|
| 67 | S RIST=$P(RSL,U,2) ; CLOSE reports back the type of radiologist
|
|---|
| 68 | ; now we know this user had locked the case, & wants to do Status update
|
|---|
| 69 | D EN2^RAUTL20(.MAGPSET) ; get info re rad PrintSet
|
|---|
| 70 | ;
|
|---|
| 71 | ; IF exam is not "Examined", and not "Cancelled" and past "Waiting"
|
|---|
| 72 | ; then assume it has already been updated via another pathway,
|
|---|
| 73 | ; either as printset member (via code at tag PRTSET, below),
|
|---|
| 74 | ; or from a voice-dictation or terminal session by the radiologist
|
|---|
| 75 | ; For these cases, no warning msg is sent
|
|---|
| 76 | ; Else, update not allowed, so give warning msg
|
|---|
| 77 | ; Note that when the Exam was OPENed, it must have had status "Examined"
|
|---|
| 78 | 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
|
|---|
| 79 | . I $P(RADATA,U,15)>2 D ; assume update has otherwise been done, eg voice dictation or manual entry in Vista
|
|---|
| 80 | .. S RACNILST=RACNI,RASTI=$P(RADATA,U,11) ; need for code at tag statusx
|
|---|
| 81 | .. I RAPRTSET S REPLY="0^1~Printset Exams with Case #"_RAEXT_" have been updated"
|
|---|
| 82 | .. E S REPLY="0^1~No Update done for Case #"_RAEXT_"--current status is "_$P(RADATA,U,14)
|
|---|
| 83 | . E S REPLY="0^3~No Update Allowed for Case #"_RAEXT_"--current status is "_$P(RADATA,U,14)
|
|---|
| 84 | ;
|
|---|
| 85 | ; now ready to update exam status
|
|---|
| 86 | S RAMDV=$P(^RADPT(RADFN,"DT",RADTI,0),U,3)
|
|---|
| 87 | S RAMDV=$TR(^RA(79,RAMDV,.1),"YyNn","1100")
|
|---|
| 88 | ;
|
|---|
| 89 | ; Update interpreting radiologist field in Rad file
|
|---|
| 90 | I RIST D I RACNILST="" G STATUSZ
|
|---|
| 91 | . N SAVRACNI,RTN S RACNILST=""
|
|---|
| 92 | PRTSET . ; if exam is part of Rad Print-Set, then update all exams of printset
|
|---|
| 93 | . I RAPRTSET D
|
|---|
| 94 | .. S ACNLST="",SAVRACNI=RACNI,X=0
|
|---|
| 95 | .. 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)
|
|---|
| 96 | . E S RACNILST=RACNI
|
|---|
| 97 | . F I=1:1:$L(RACNILST,U) S RACNI=$P(RACNILST,U,I) I RACNI D I RACNILST="" Q
|
|---|
| 98 | .. S DA(2)=RADFN,DA(1)=RADTI,DA=RACNI
|
|---|
| 99 | .. D STUFPHY^RARIC1(DUZ,RIST,.RTN)
|
|---|
| 100 | .. I 'RTN S REPLY="0^4~Unable to update Interpreting Radiologist: "_RTN_"." S RACNILST=""
|
|---|
| 101 | . I RAPRTSET S RACNI=SAVRACNI
|
|---|
| 102 | S RAONLINE=1,ZTQUEUED=1 D UP1^RAUTL1 ; Suppress msgs, do Status update
|
|---|
| 103 | ;<*> K RAONLINE,ZTQUEUED D UP1^RAUTL1 ; <*> Testing Only: ENABLE msgs
|
|---|
| 104 | I RAOR<0 S REPLY="0^3~Exam Status for Case #"_RAEXT_" CANNOT be updated; current status remains: "_$S($G(RASN)]"":RASN,1:"Unknown")
|
|---|
| 105 | I G STATUSZ
|
|---|
| 106 | ;
|
|---|
| 107 | S REPLY="0^1~For Case #"_$S($G(ACNLST)]"":"s ",1:"")_RAEXT_$S(RAPRTSET:ACNLST,1:"")_", Exam Status updated to "_RASN
|
|---|
| 108 | ;
|
|---|
| 109 | STATUSX ; Newly Interpreted exam:
|
|---|
| 110 | ; Log the Interpreted event
|
|---|
| 111 | D LOG^MAGJUTL3("VR-INT",LOGDATA)
|
|---|
| 112 | ; Update Recent Exams List
|
|---|
| 113 | G STATUSZ:'$P(^MAG(2006.69,1,0),U,8) ; no bkgnd compile enabled
|
|---|
| 114 | L +^XTMP("MAGJ2","RECENT"):5
|
|---|
| 115 | E G STATUSZ
|
|---|
| 116 | N INDX F I=1:1:$L(RACNILST,U) S RACNI=$P(RACNILST,U,I) I RACNI D
|
|---|
| 117 | . S INDX=+$G(^XTMP("MAGJ2","RECENT",0))+1,$P(^(0),U)=INDX,^(INDX)=RADFN_U_RADTI_U_RACNI_U_RASTI
|
|---|
| 118 | L -^XTMP("MAGJ2","RECENT")
|
|---|
| 119 | STATUSZ ;
|
|---|
| 120 | ; store PS, Key Image data
|
|---|
| 121 | I UPDPSKEY,($D(DATA)>9) D
|
|---|
| 122 | . D SAVKPS^MAGJUPD2(RARPT,UPDPSKEY,.DATA,.X)
|
|---|
| 123 | . S REPLY=REPLY_$P(X,"~",2,99)
|
|---|
| 124 | S @MAGGRY@(0)=REPLY
|
|---|
| 125 | K ^TMP($J,"MAGRAEX"),^("RAE1")
|
|---|
| 126 | Q
|
|---|
| 127 | ;
|
|---|
| 128 | CLOSE(RSL,PARAMS,LOGDATA) ; Close/unlock a case
|
|---|
| 129 | ; Input: PARAMS = DFN ^ DTI ^ CNI ^ RPT ^ UPDFLAG
|
|---|
| 130 | ;
|
|---|
| 131 | ; DFN,DTI,CNI,RPT = pointers to Rad File for the exam
|
|---|
| 132 | ; UPDFLAG = 1/0 -- 1 indicates CLOSE was called from subroutine
|
|---|
| 133 | ; STATUS, above (which has already called GETEXAM)
|
|---|
| 134 | ; RSL = return result of the Close
|
|---|
| 135 | ; This subroutine may be called directly (to close a case without
|
|---|
| 136 | ; doing a status update), or is called from tag STATUS, above, when
|
|---|
| 137 | ; also doing a status update
|
|---|
| 138 | ;
|
|---|
| 139 | N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJUPD1"
|
|---|
| 140 | N RPT,DFN,DTI,CNI,MAGRET,REPLY,RARPT,UPDFLAG,RIST,DAYCASE,NLOCKS,MYLOCK
|
|---|
| 141 | 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)
|
|---|
| 142 | S LOGDATA=""
|
|---|
| 143 | I $P($G(^MAG(2006.69,1,0)),U,4)
|
|---|
| 144 | E S REPLY=$S(UPDFLAG:"0^3~Updates not allowed at this site--no action taken",1:"") G CLOSEZ ; Status Update NOT Enabled
|
|---|
| 145 | S RIST=+MAGJOB("USER",1) I RIST
|
|---|
| 146 | E S REPLY=$S(UPDFLAG:"0^3~Update allowed only by a radiologist--no action taken",1:"") G CLOSEZ ; need only unlock a radiologist
|
|---|
| 147 | I DFN,DTI,CNI
|
|---|
| 148 | E S REPLY="0^4~Request Contains Invalid Case Pointer ("_RPT_")--no action taken" G CLOSEZ
|
|---|
| 149 | ;
|
|---|
| 150 | I 'UPDFLAG N RADATA D I 'MAGRET G CLOSEZ
|
|---|
| 151 | . D GETEXAM2^MAGJUTL1(DFN,DTI,CNI,0,.MAGRET)
|
|---|
| 152 | . I 'MAGRET S REPLY="0^4~No Current Case accessible to close--no action taken"
|
|---|
| 153 | . E S RADATA=$G(^TMP($J,"MAGRAEX",1,1))
|
|---|
| 154 | S RARPT=$P(RADATA,U,10),DAYCASE=$P(RADATA,U,12)
|
|---|
| 155 | I RARPT,DAYCASE
|
|---|
| 156 | E S REPLY="0^4~Current Case not accessible to close--no action taken" G CLOSEZ
|
|---|
| 157 | ;
|
|---|
| 158 | D LOCKACT^MAGJEX1A(RARPT,DAYCASE,101,,.MYLOCK)
|
|---|
| 159 | S LOGDATA=$P(MYLOCK(1),"|",2)
|
|---|
| 160 | I 'MYLOCK(1) S X=$P(MYLOCK(1),U,4) D S LOGDATA="" G CLOSEZ
|
|---|
| 161 | . 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"
|
|---|
| 162 | . E S REPLY="0^1~ " ; case wasn't opened by this R'ist; nothing to do
|
|---|
| 163 | ;
|
|---|
| 164 | I UPDFLAG S REPLY=1_U_RIST
|
|---|
| 165 | E S REPLY="0^1~Case #"_DAYCASE_$S(+MYLOCK(1):" unlocked",+MYLOCK(2):" reserve cancelled",1:" closed")_"--No Status Update performed."
|
|---|
| 166 | CLOSEZ S RSL=REPLY
|
|---|
| 167 | Q
|
|---|
| 168 | ;
|
|---|
| 169 | END Q ;
|
|---|
