167 lines
9.0 KiB
Mathematica
167 lines
9.0 KiB
Mathematica
MAGJEX1A ;WIRMFO/JHC VistARad RPCs, exam locking ; 15 Sep 2004 10:00 AM
|
|
;;3.0;IMAGING;**18,65**;Jul 27, 2006;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. |
|
|
;; +---------------------------------------------------------------+
|
|
;;
|
|
Q
|
|
; Entry Points:
|
|
; CASLOCK--RPC: Lock mgt
|
|
; LOCKACT--Subrtn
|
|
; LOCKOUT--Subrtn
|
|
;
|
|
ERR N ERR S ERR=$$EC^%ZOSV S @MAGGRY@(0)="0^4~"_ERR
|
|
D @^%ZOSF("ERRTN")
|
|
Q:$Q 1 Q
|
|
;
|
|
CASLOCK(MAGGRY,DATA) ; RPC Call: MAGJ RADCASELOCKS
|
|
; MAGGRY holds $NA reference to ^TMP for rpc reply; all ref's to MAGGRY use ss indirection
|
|
; input in DATA: OPEN_FLAG^RADFN^RADTI^RACNI^RARPT
|
|
; OPEN_FLAG = 3: Reserve-to-Lock; 4: Lock-to-Reserve; 5: Lock/Take
|
|
; RADFN^, etc--exam id
|
|
;
|
|
N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJEX1A"
|
|
N RARPT,RADFN,RADTI,RACNI,DIQUIET,CURCASE,REPLY,CT,DATAOUT,MAGLST,XX
|
|
N DAYCASE,LOCKED,RACN,RADTE,MAGS,LOGDATA,RESULT,MYLOCK,GOTLOCK
|
|
S DIQUIET=1 D DT^DICRW
|
|
S CT=0,DATAOUT="",DAYCASE="",MAGLST="MAGJCASELOCK"
|
|
K MAGGRY S MAGGRY=$NA(^TMP($J,MAGLST)) K @MAGGRY ; assign MAGGRY
|
|
S CURCASE=+$P(DATA,U)
|
|
S RADFN=$P(DATA,U,2),RADTI=$P(DATA,U,3),RACNI=$P(DATA,U,4),RARPT=+$P(DATA,U,5)
|
|
I "^3^4^5^"[(U_CURCASE_U)
|
|
E S REPLY="4~Invalid Caselock request ("_DATA_")." G CASLOCKZ
|
|
I RADFN,RADTI,RACNI,RARPT
|
|
E S REPLY="4~Caselock Request contains invalid Case Pointer ("_DATA_")." G CASLOCKZ
|
|
S XX=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
|
|
S RACN=$P(XX,U)
|
|
S RADTE=9999999.9999-RADTI
|
|
S DAYCASE=$E(RADTE,4,7)_$E(RADTE,2,3)_"-"_RACN
|
|
S X=$P(XX,U,3)
|
|
I '$D(^RA(72,"AVC","E",X)) D G CASLOCKZ
|
|
. N STS S STS=X
|
|
. D LOCKACT(RARPT,DAYCASE,100,.RESULT) ; between reserve and now, exam may have been Taken & Updated
|
|
. I +RESULT(1)!+RESULT(2) D LOCKACT(RARPT,DAYCASE,101,.RESULT) ; so, cancel any lock/reserve
|
|
. S REPLY="5~For Case #"_DAYCASE_", current Status is "_$P(^RA(72,STS,0),U)_"; Reserve/Lock change NOT allowed."
|
|
D LOCKACT(RARPT,DAYCASE,CURCASE,.RESULT,.REPLY)
|
|
S GOTLOCK=+RESULT
|
|
D LOCKACT(RARPT,DAYCASE,100,.MYLOCK)
|
|
I GOTLOCK&+MYLOCK(1)&(CURCASE=3!(CURCASE=5)) D ; update Image access log if got the lock
|
|
. S LOGDATA=$P(MYLOCK(2),"|",2) ; was saved when the Reserve occurred
|
|
. I CURCASE=5 S $P(LOGDATA,U,4)=+MAGJOB("REMOTE") ; update "remote" indicator if was TAKEN
|
|
. D LOG^MAGJUTL3("VR-VW",LOGDATA)
|
|
. S $P(^XTMP("MAGJ","LOCK",RARPT,1,DAYCASE),"|",2)=LOGDATA ; save for Interp event
|
|
S DATAOUT=$S(+MYLOCK(1):1,+MYLOCK(2):2,1:0)
|
|
;
|
|
CASLOCKZ ;
|
|
S @MAGGRY@(0)=CT_U_REPLY_"|"_RADFN_U_RADTI_U_RACNI_U_RARPT_"||"_DATAOUT
|
|
Q
|
|
;
|
|
PNAM(X) ; return pt name for input DFN
|
|
I X S X=$G(^DPT(+X,0)) I X]"" S X=$P(X,U)
|
|
E S X="UNKNOWN"
|
|
Q X
|
|
;
|
|
LOCKACT(RARPT,DAYCASE,REQUEST,RESULT,ACTREPLY,LOGDATA) ; determine if desired lock action is feasible
|
|
; Input: RARPT, DAYCASE, REQUEST, LOGDATA
|
|
; REQUESTed Action:
|
|
; 1-Lock; 2-Reserve; 3-ResToLock; 4-LockToRes; 5-TakeLock; 100-Status; 101-UNLOCK
|
|
; Note: 100 & 101 are special for internal use only
|
|
; LOGDATA--pass through for Image Access Log
|
|
; Output: RESULT, ACTREPLY
|
|
; RESULT: ACTION "allowed" = LOCK^RESERVE^ResToInt^IntToRes^Take^_"|"_ImgLst
|
|
; these are truth values; Imglst true =~ return Image File list to client
|
|
; RESULT is ultimately used at tag LOCKOUT
|
|
; ACTREPLY --reply message for client logic/display
|
|
;
|
|
N ACTION,LOCKLEV,MYLOCK
|
|
K RESULT S ACTION="",ACTREPLY="",RESULT="" S LOGDATA=$G(LOGDATA,"")
|
|
I '$P($G(^MAG(2006.69,1,0)),U,4) Q ; Status Updates not enabled
|
|
I REQUEST=100 D LOCKIN^MAGJEX1B(RARPT,.LOCKLEV,.RESULT,"STATUS") G LOCKACTZ ; Lock Status check only
|
|
S ACTION="0^0^0^0^0|0"
|
|
D LOCKIN^MAGJEX1B(RARPT,.LOCKLEV,.MYLOCK)
|
|
I REQUEST=101 D G LOCKACT1 ; Unlock exam
|
|
. M ACTREPLY=MYLOCK ; internal use by MAGJUPD1
|
|
I 'LOCKLEV D G LOCKACT1
|
|
. I REQUEST=1!(REQUEST=2) S $P(ACTION,"|",2)=1,ACTREPLY="5~Exam #"_DAYCASE_" is Locked by "_$P(MYLOCK(1),U,4)_"." ; View/Cancel
|
|
. E S ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#0"
|
|
I LOCKLEV=3 D ; Is or Can be Reserved or Interp by me
|
|
. I MYLOCK(1) D Q ; Already Locked/TAKEN by me
|
|
. . I REQUEST=1 D Q
|
|
. . . I MAGJOB("P32") S $P(ACTION,U)=1,$P(ACTION,U,2)=1,$P(ACTION,"|",2)=1,ACTREPLY="1~#"_DAYCASE_" ("_$$PNAM(RADFN)_") locked for update by "_$P(MAGJOB("USER",1),U,3)
|
|
. . . E S $P(ACTION,U,1)=1,$P(ACTION,U,2)=+MYLOCK(2),ACTREPLY="1~Exam #"_$P(MYLOCK(1),U,6)_" already open/locked--no action taken"
|
|
. . I REQUEST=4 D Q ; Remove Lock, keep Reserve
|
|
. . . S $P(ACTION,U,2)=1,$P(ACTION,U,4)=1,ACTREPLY="1~Exam unlocked, reserved"
|
|
. . E S $P(ACTION,U,1)=1,$P(ACTION,U,2)=+MYLOCK(2),ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#1"
|
|
. E I MYLOCK(2) D Q ; Already Reserved by me
|
|
. . I REQUEST=3 S $P(ACTION,U)=1,$P(ACTION,U,2)=1,$P(ACTION,U,3)=1,ACTREPLY="1~#"_DAYCASE_" ("_$$PNAM(RADFN)_") locked for update (from reserve) by "_$P(MAGJOB("USER",1),U,3)
|
|
. . E I REQUEST=2 S $P(ACTION,U,2)=1,ACTREPLY="1~Exam #"_$P(MYLOCK(2),U,6)_" already reserved--no action taken."
|
|
. . E S $P(ACTION,U,2)=1,ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#2"
|
|
. E D ; Available
|
|
. . I REQUEST=1 S $P(ACTION,U)=1,$P(ACTION,U,2)=1,$P(ACTION,"|",2)=1,ACTREPLY="1~#"_DAYCASE_" ("_$$PNAM(RADFN)_") locked for update by "_$P(MAGJOB("USER",1),U,3)
|
|
. . E I REQUEST=2 S $P(ACTION,U,2)=1,$P(ACTION,"|",2)=1,ACTREPLY="1~Exam #"_DAYCASE_" reserved."
|
|
. . E S ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#3"
|
|
E I LOCKLEV=1 D ; Reserved by other (I can Take, Except View/Take/Cancel)
|
|
. I MYLOCK(1) D Q
|
|
. . I REQUEST=1 D Q
|
|
. . . I MAGJOB("P32") S $P(ACTION,U)=1,$P(ACTION,"|",2)=1,ACTREPLY="1~#"_DAYCASE_" ("_$$PNAM(RADFN)_") locked for update by "_$P(MAGJOB("USER",1),U,3) ; should be impossible
|
|
. . . E S $P(ACTION,U)=1,ACTREPLY="1~Exam #"_$P(MYLOCK(1),U,6)_" already locked; no action taken."
|
|
. . E I REQUEST=2 S $P(ACTION,U,1)=1,ACTREPLY="1~Exam #"_$P(MYLOCK(1),U,6)_" already locked; no action taken."
|
|
. . ; <*> next line Unlocks ME, and preserves Other User's Reserve
|
|
. . E I REQUEST=4 S $P(ACTION,U,4)=1,ACTREPLY="1~Exam unlocked; reserved by "_$P(MYLOCK(2),U,4)_"."
|
|
. . E S $P(ACTION,U)=1,ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#5; Lock retained." ; preserve lock
|
|
. I 'MYLOCK D Q
|
|
. . I REQUEST=1 D Q
|
|
. . . I MAGJOB("P32") S $P(ACTION,"|",2)=1,ACTREPLY="5~Case #"_DAYCASE_" is Reserved by "_$P(MYLOCK(2),U,4)_"."
|
|
. . . E S $P(ACTION,"|",2)=1,ACTREPLY="8~Case #"_DAYCASE_" is Reserved by "_$P(MYLOCK(2),U,4)_"." ; #8=View/Take/Cancel"
|
|
. . E I REQUEST=2 S $P(ACTION,"|",2)=1,ACTREPLY="5~Case #"_DAYCASE_" is Reserved by "_$P(MYLOCK(2),U,4)_"."
|
|
. . E I REQUEST=5 S $P(ACTION,U)=1,$P(ACTION,U,5)=1,ACTREPLY="1~#"_DAYCASE_" ("_$$PNAM(RADFN)_") taken/locked for update by "_$P(MAGJOB("USER",1),U,3)
|
|
. . E S ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#6"
|
|
E I LOCKLEV=2 D ; Locked by another
|
|
. I MYLOCK(2) D Q
|
|
. . S $P(ACTION,U,3)=1,ACTREPLY="5~Case #"_DAYCASE_" is Locked (taken) by "_$P(MYLOCK(1),U,4)_"; reserve cancelled." ; View/Cancel"
|
|
. I 'MYLOCK D Q
|
|
. . I REQUEST=1!(REQUEST=2) S $P(ACTION,"|",2)=1,ACTREPLY="5~Case #"_DAYCASE_" is Locked by "_$P(MYLOCK(1),U,4)_"." ; View/Cancel"
|
|
. . E S ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#8"
|
|
;
|
|
LOCKACT1 D LOCKOUT(RARPT,DAYCASE,LOCKLEV,.MYLOCK,ACTION,.RESULT,LOGDATA)
|
|
;
|
|
LOCKACTZ Q
|
|
;
|
|
;
|
|
LOCKOUT(RARPT,DAYCASE,LOCKLEV,MYLOCK,ACTION,RESULT,LOGDATA) ; Record Locks and Clear Locks, as required
|
|
; Precursors are logic and data from tags LOCKIN^magjex1b and LOCKACT
|
|
S RESULT="" S LOGDATA=$G(LOGDATA,"")
|
|
Q:'LOCKLEV ; nothing to do
|
|
N ILOCK
|
|
F ILOCK=1,2 D ; 1:Lock 2:Reserve
|
|
. I ILOCK=1&(LOCKLEV=1!(LOCKLEV=3))
|
|
. E I ILOCK=2&(LOCKLEV=2!(LOCKLEV=3))
|
|
. E Q
|
|
. I MYLOCK(ILOCK) D ; NEVER change order of the logic below!
|
|
. . I '$P(ACTION,U,ILOCK) D
|
|
. . . K ^XTMP("MAGJ","LOCK",RARPT,ILOCK)
|
|
. . . S $P(RESULT,U,ILOCK)=0
|
|
. . L -^XTMP("MAGJ","LOCK",RARPT,ILOCK) ; reset lock
|
|
. ; index by DayCase manages locks for Printset Exams (>1 DayCase for one RARPT)
|
|
. ; a lock on any printset member exam effectively locks all related exams
|
|
. I +$P(ACTION,U,ILOCK),'MYLOCK(ILOCK) D
|
|
. . S ^XTMP("MAGJ","LOCK",RARPT,ILOCK,DAYCASE)=DUZ_U_$J_U_$H_U_$P(MAGJOB("USER",1),U,2,3)_U_"|"_LOGDATA
|
|
. . S ^XTMP("MAGJ","LOCK",RARPT,ILOCK)=DAYCASE
|
|
. . S $P(RESULT,U,ILOCK)=1
|
|
. I '$P(ACTION,U,ILOCK) L -^XTMP("MAGJ","LOCK",RARPT,ILOCK) ; reset or clear lock
|
|
Q
|
|
;
|
|
END Q ;
|