MAGJEX1A ;WIRMFO/JHC - VistARad RPCs, exam locking ; 10/17/2022
;;3.0;IMAGING;**18,65,101,120,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. |
;; +---------------------------------------------------------------+
;;
;; ISI IMAGING;**99,101**
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,LONGACN
S DIQUIET=1 D DT^DICRW
S CT=0,DATAOUT=0,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),LONGACN=$P(XX,U,31)
S RADTE=9999999.9999-RADTI
S DAYCASE=$E(RADTE,4,7)_$E(RADTE,2,3)_"-"_RACN
I LONGACN]"" S DAYCASE=LONGACN
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,$$PSETLST^MAGJEX1(RADFN,RADTI,RACNI))
. 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
. . . ; ISI remove deprecated logic re p32
. . . 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
. . . ; ISI remove deprecated logic re p32
. . . 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
. . . ; ISI remove deprecated logic re p32
. . . 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 ;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGJEX1A 9130 printed Apr 09, 2024@21:10:38 Page 2
MAGJEX1A ;WIRMFO/JHC - VistARad RPCs, exam locking ; 10/17/2022
+1 ;;3.0;IMAGING;**18,65,101,120,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 ;; ISI IMAGING;**99,101**
+18 QUIT
+19 ; Entry Points:
+20 ; CASLOCK--RPC: Lock mgt
+21 ; LOCKACT--Subrtn
+22 ; LOCKOUT--Subrtn
+23 ;
ERR NEW ERR
SET ERR=$$EC^%ZOSV
SET @MAGGRY@(0)="0^4~"_ERR
+1 DO @^%ZOSF("ERRTN")
+2 if $QUIT
QUIT 1
QUIT
+3 ;
CASLOCK(MAGGRY,DATA) ; RPC Call: MAGJ RADCASELOCKS
+1 ; MAGGRY holds $NA reference to ^TMP for rpc reply; all ref's to MAGGRY use ss indirection
+2 ; input in DATA: OPEN_FLAG^RADFN^RADTI^RACNI^RARPT
+3 ; OPEN_FLAG = 3: Reserve-to-Lock; 4: Lock-to-Reserve; 5: Lock/Take
+4 ; RADFN^, etc--exam id
+5 ;
+6 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR^MAGJEX1A"
+7 NEW RARPT,RADFN,RADTI,RACNI,DIQUIET,CURCASE,REPLY,CT,DATAOUT,MAGLST,XX
+8 NEW DAYCASE,LOCKED,RACN,RADTE,MAGS,LOGDATA,RESULT,MYLOCK,GOTLOCK,LONGACN
+9 SET DIQUIET=1
DO DT^DICRW
+10 SET CT=0
SET DATAOUT=0
SET DAYCASE=""
SET MAGLST="MAGJCASELOCK"
+11 ; assign MAGGRY
KILL MAGGRY
SET MAGGRY=$NAME(^TMP($JOB,MAGLST))
KILL @MAGGRY
+12 SET CURCASE=+$PIECE(DATA,U)
+13 SET RADFN=$PIECE(DATA,U,2)
SET RADTI=$PIECE(DATA,U,3)
SET RACNI=$PIECE(DATA,U,4)
SET RARPT=+$PIECE(DATA,U,5)
+14 IF "^3^4^5^"[(U_CURCASE_U)
+15 IF '$TEST
SET REPLY="4~Invalid Caselock request ("_DATA_")."
GOTO CASLOCKZ
+16 IF RADFN
IF RADTI
IF RACNI
IF RARPT
+17 IF '$TEST
SET REPLY="4~Caselock Request contains invalid Case Pointer ("_DATA_")."
GOTO CASLOCKZ
+18 SET XX=$GET(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
+19 SET RACN=$PIECE(XX,U)
SET LONGACN=$PIECE(XX,U,31)
+20 SET RADTE=9999999.9999-RADTI
+21 SET DAYCASE=$EXTRACT(RADTE,4,7)_$EXTRACT(RADTE,2,3)_"-"_RACN
+22 IF LONGACN]""
SET DAYCASE=LONGACN
+23 SET X=$PIECE(XX,U,3)
+24 IF '$DATA(^RA(72,"AVC","E",X))
Begin DoDot:1
+25 NEW STS
SET STS=X
+26 ; between reserve and now, exam may have been Taken & Updated
DO LOCKACT(RARPT,DAYCASE,100,.RESULT)
+27 ; so, cancel any lock/reserve
IF +RESULT(1)!+RESULT(2)
DO LOCKACT(RARPT,DAYCASE,101,.RESULT)
+28 SET REPLY="5~For Case #"_DAYCASE_", current Status is "_$PIECE(^RA(72,STS,0),U)_"; Reserve/Lock change NOT allowed."
End DoDot:1
GOTO CASLOCKZ
+29 DO LOCKACT(RARPT,DAYCASE,CURCASE,.RESULT,.REPLY)
+30 SET GOTLOCK=+RESULT
+31 DO LOCKACT(RARPT,DAYCASE,100,.MYLOCK)
+32 ; update Image access log if got the lock
IF GOTLOCK&+MYLOCK(1)&(CURCASE=3!(CURCASE=5))
Begin DoDot:1
+33 ; was saved when the Reserve occurred
SET LOGDATA=$PIECE(MYLOCK(2),"|",2)
+34 ; update "remote" indicator if was TAKEN
IF CURCASE=5
SET $PIECE(LOGDATA,U,4)=+MAGJOB("REMOTE")
+35 DO LOG^MAGJUTL3("VR-VW",LOGDATA,$$PSETLST^MAGJEX1(RADFN,RADTI,RACNI))
+36 ; save for Interp event
SET $PIECE(^XTMP("MAGJ","LOCK",RARPT,1,DAYCASE),"|",2)=LOGDATA
End DoDot:1
+37 SET DATAOUT=$SELECT(+MYLOCK(1):1,+MYLOCK(2):2,1:0)
+38 ;
CASLOCKZ ;
+1 SET @MAGGRY@(0)=CT_U_REPLY_"|"_RADFN_U_RADTI_U_RACNI_U_RARPT_"||"_DATAOUT
+2 QUIT
+3 ;
PNAM(X) ; return pt name for input DFN
+1 IF X
SET X=$GET(^DPT(+X,0))
IF X]""
SET X=$PIECE(X,U)
+2 IF '$TEST
SET X="UNKNOWN"
+3 QUIT X
+4 ;
LOCKACT(RARPT,DAYCASE,REQUEST,RESULT,ACTREPLY,LOGDATA) ; determine if desired lock action is feasible
+1 ; Input: RARPT, DAYCASE, REQUEST, LOGDATA
+2 ; REQUESTed Action:
+3 ; 1-Lock; 2-Reserve; 3-ResToLock; 4-LockToRes; 5-TakeLock; 100-Status; 101-UNLOCK
+4 ; Note: 100 & 101 are special for internal use only
+5 ; LOGDATA--pass through for Image Access Log
+6 ; Output: RESULT, ACTREPLY
+7 ; RESULT: ACTION "allowed" = LOCK^RESERVE^ResToInt^IntToRes^Take^_"|"_ImgLst
+8 ; these are truth values; Imglst true =~ return Image File list to client
+9 ; RESULT is ultimately used at tag LOCKOUT
+10 ; ACTREPLY --reply message for client logic/display
+11 ;
+12 NEW ACTION,LOCKLEV,MYLOCK
+13 KILL RESULT
SET ACTION=""
SET ACTREPLY=""
SET RESULT=""
SET LOGDATA=$GET(LOGDATA,"")
+14 ; Status Updates not enabled
IF '$PIECE($GET(^MAG(2006.69,1,0)),U,4)
QUIT
+15 ; Lock Status check only
IF REQUEST=100
DO LOCKIN^MAGJEX1B(RARPT,.LOCKLEV,.RESULT,"STATUS")
GOTO LOCKACTZ
+16 SET ACTION="0^0^0^0^0|0"
+17 DO LOCKIN^MAGJEX1B(RARPT,.LOCKLEV,.MYLOCK)
+18 ; Unlock exam
IF REQUEST=101
Begin DoDot:1
+19 ; internal use by MAGJUPD1
MERGE ACTREPLY=MYLOCK
End DoDot:1
GOTO LOCKACT1
+20 IF 'LOCKLEV
Begin DoDot:1
+21 ; View/Cancel
IF REQUEST=1!(REQUEST=2)
SET $PIECE(ACTION,"|",2)=1
SET ACTREPLY="5~Exam #"_DAYCASE_" is Locked by "_$PIECE(MYLOCK(1),U,4)_"."
+22 IF '$TEST
SET ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#0"
End DoDot:1
GOTO LOCKACT1
+23 ; Is or Can be Reserved or Interp by me
IF LOCKLEV=3
Begin DoDot:1
+24 ; Already Locked/TAKEN by me
IF MYLOCK(1)
Begin DoDot:2
+25 IF REQUEST=1
Begin DoDot:3
+26 ; ISI remove deprecated logic re p32
+27 SET $PIECE(ACTION,U,1)=1
SET $PIECE(ACTION,U,2)=+MYLOCK(2)
SET ACTREPLY="1~Exam #"_$PIECE(MYLOCK(1),U,6)_" already open/locked--no action taken"
End DoDot:3
QUIT
+28 ; Remove Lock, keep Reserve
IF REQUEST=4
Begin DoDot:3
+29 SET $PIECE(ACTION,U,2)=1
SET $PIECE(ACTION,U,4)=1
SET ACTREPLY="1~Exam unlocked, reserved"
End DoDot:3
QUIT
+30 IF '$TEST
SET $PIECE(ACTION,U,1)=1
SET $PIECE(ACTION,U,2)=+MYLOCK(2)
SET ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#1"
End DoDot:2
QUIT
+31 ; Already Reserved by me
IF '$TEST
IF MYLOCK(2)
Begin DoDot:2
+32 IF REQUEST=3
SET $PIECE(ACTION,U)=1
SET $PIECE(ACTION,U,2)=1
SET $PIECE(ACTION,U,3)=1
SET ACTREPLY="1~#"_DAYCASE_" ("_$$PNAM(RADFN)_") locked for update (from reserve) by "_$PIECE(MAGJOB("USER",1),U,3)
+33 IF '$TEST
IF REQUEST=2
SET $PIECE(ACTION,U,2)=1
SET ACTREPLY="1~Exam #"_$PIECE(MYLOCK(2),U,6)_" already reserved--no action taken."
+34 IF '$TEST
SET $PIECE(ACTION,U,2)=1
SET ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#2"
End DoDot:2
QUIT
+35 ; Available
IF '$TEST
Begin DoDot:2
+36 IF REQUEST=1
SET $PIECE(ACTION,U)=1
SET $PIECE(ACTION,U,2)=1
SET $PIECE(ACTION,"|",2)=1
SET ACTREPLY="1~#"_DAYCASE_" ("_$$PNAM(RADFN)_") locked for update by "_$PIECE(MAGJOB("USER",1),U,3)
+37 IF '$TEST
IF REQUEST=2
SET $PIECE(ACTION,U,2)=1
SET $PIECE(ACTION,"|",2)=1
SET ACTREPLY="1~Exam #"_DAYCASE_" reserved."
+38 IF '$TEST
SET ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#3"
End DoDot:2
End DoDot:1
+39 ; Reserved by other (I can Take, Except View/Take/Cancel)
IF '$TEST
IF LOCKLEV=1
Begin DoDot:1
+40 IF MYLOCK(1)
Begin DoDot:2
+41 IF REQUEST=1
Begin DoDot:3
+42 ; ISI remove deprecated logic re p32
+43 SET $PIECE(ACTION,U)=1
SET ACTREPLY="1~Exam #"_$PIECE(MYLOCK(1),U,6)_" already locked; no action taken."
End DoDot:3
QUIT
+44 IF '$TEST
IF REQUEST=2
SET $PIECE(ACTION,U,1)=1
SET ACTREPLY="1~Exam #"_$PIECE(MYLOCK(1),U,6)_" already locked; no action taken."
+45 ; <*> next line Unlocks ME, and preserves Other User's Reserve
+46 IF '$TEST
IF REQUEST=4
SET $PIECE(ACTION,U,4)=1
SET ACTREPLY="1~Exam unlocked; reserved by "_$PIECE(MYLOCK(2),U,4)_"."
+47 ; preserve lock
IF '$TEST
SET $PIECE(ACTION,U)=1
SET ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#5; Lock retained."
End DoDot:2
QUIT
+48 IF 'MYLOCK
Begin DoDot:2
+49 IF REQUEST=1
Begin DoDot:3
+50 ; ISI remove deprecated logic re p32
+51 ; #8=View/Take/Cancel"
SET $PIECE(ACTION,"|",2)=1
SET ACTREPLY="8~Case #"_DAYCASE_" is Reserved by "_$PIECE(MYLOCK(2),U,4)_"."
End DoDot:3
QUIT
+52 IF '$TEST
IF REQUEST=2
SET $PIECE(ACTION,"|",2)=1
SET ACTREPLY="5~Case #"_DAYCASE_" is Reserved by "_$PIECE(MYLOCK(2),U,4)_"."
+53 IF '$TEST
IF REQUEST=5
SET $PIECE(ACTION,U)=1
SET $PIECE(ACTION,U,5)=1
SET ACTREPLY="1~#"_DAYCASE_" ("_$$PNAM(RADFN)_") taken/locked for update by "_$PIECE(MAGJOB("USER",1),U,3)
+54 IF '$TEST
SET ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#6"
End DoDot:2
QUIT
End DoDot:1
+55 ; Locked by another
IF '$TEST
IF LOCKLEV=2
Begin DoDot:1
+56 IF MYLOCK(2)
Begin DoDot:2
+57 ; View/Cancel"
SET $PIECE(ACTION,U,3)=1
SET ACTREPLY="5~Case #"_DAYCASE_" is Locked (taken) by "_$PIECE(MYLOCK(1),U,4)_"; reserve cancelled."
End DoDot:2
QUIT
+58 IF 'MYLOCK
Begin DoDot:2
+59 ; View/Cancel"
IF REQUEST=1!(REQUEST=2)
SET $PIECE(ACTION,"|",2)=1
SET ACTREPLY="5~Case #"_DAYCASE_" is Locked by "_$PIECE(MYLOCK(1),U,4)_"."
+60 IF '$TEST
SET ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#8"
End DoDot:2
QUIT
End DoDot:1
+61 ;
LOCKACT1 DO LOCKOUT(RARPT,DAYCASE,LOCKLEV,.MYLOCK,ACTION,.RESULT,LOGDATA)
+1 ;
LOCKACTZ QUIT
+1 ;
+2 ;
LOCKOUT(RARPT,DAYCASE,LOCKLEV,MYLOCK,ACTION,RESULT,LOGDATA) ; Record Locks and Clear Locks, as required
+1 ; Precursors are logic and data from tags LOCKIN^magjex1b and LOCKACT
+2 SET RESULT=""
SET LOGDATA=$GET(LOGDATA,"")
+3 ; nothing to do
if 'LOCKLEV
QUIT
+4 NEW ILOCK
+5 ; 1:Lock 2:Reserve
FOR ILOCK=1,2
Begin DoDot:1
+6 IF ILOCK=1&(LOCKLEV=1!(LOCKLEV=3))
+7 IF '$TEST
IF ILOCK=2&(LOCKLEV=2!(LOCKLEV=3))
+8 IF '$TEST
QUIT
+9 ; NEVER change order of the logic below!
IF MYLOCK(ILOCK)
Begin DoDot:2
+10 IF '$PIECE(ACTION,U,ILOCK)
Begin DoDot:3
+11 KILL ^XTMP("MAGJ","LOCK",RARPT,ILOCK)
+12 SET $PIECE(RESULT,U,ILOCK)=0
End DoDot:3
+13 ; reset lock
LOCK -^XTMP("MAGJ","LOCK",RARPT,ILOCK)
End DoDot:2
+14 ; index by DayCase manages locks for Printset Exams (>1 DayCase for one RARPT)
+15 ; a lock on any printset member exam effectively locks all related exams
+16 IF +$PIECE(ACTION,U,ILOCK)
IF 'MYLOCK(ILOCK)
Begin DoDot:2
+17 SET ^XTMP("MAGJ","LOCK",RARPT,ILOCK,DAYCASE)=DUZ_U_$JOB_U_$HOROLOG_U_$PIECE(MAGJOB("USER",1),U,2,3)_U_"|"_LOGDATA
+18 SET ^XTMP("MAGJ","LOCK",RARPT,ILOCK)=DAYCASE
+19 SET $PIECE(RESULT,U,ILOCK)=1
End DoDot:2
+20 ; reset or clear lock
IF '$PIECE(ACTION,U,ILOCK)
LOCK -^XTMP("MAGJ","LOCK",RARPT,ILOCK)
End DoDot:1
+21 QUIT
+22 ;
END ;
QUIT
