- 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 Jan 18, 2025@03:07:52 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