| [613] | 1 | MAGJEX1A ;WIRMFO/JHC VistARad RPCs, exam locking ; 15 Sep 2004 10:00 AM
|
|---|
| 2 | ;;3.0;IMAGING;**18,65**;Jul 27, 2006;Build 28
|
|---|
| 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 | ; Entry Points:
|
|---|
| 21 | ; CASLOCK--RPC: Lock mgt
|
|---|
| 22 | ; LOCKACT--Subrtn
|
|---|
| 23 | ; LOCKOUT--Subrtn
|
|---|
| 24 | ;
|
|---|
| 25 | ERR N ERR S ERR=$$EC^%ZOSV S @MAGGRY@(0)="0^4~"_ERR
|
|---|
| 26 | D @^%ZOSF("ERRTN")
|
|---|
| 27 | Q:$Q 1 Q
|
|---|
| 28 | ;
|
|---|
| 29 | CASLOCK(MAGGRY,DATA) ; RPC Call: MAGJ RADCASELOCKS
|
|---|
| 30 | ; MAGGRY holds $NA reference to ^TMP for rpc reply; all ref's to MAGGRY use ss indirection
|
|---|
| 31 | ; input in DATA: OPEN_FLAG^RADFN^RADTI^RACNI^RARPT
|
|---|
| 32 | ; OPEN_FLAG = 3: Reserve-to-Lock; 4: Lock-to-Reserve; 5: Lock/Take
|
|---|
| 33 | ; RADFN^, etc--exam id
|
|---|
| 34 | ;
|
|---|
| 35 | N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJEX1A"
|
|---|
| 36 | N RARPT,RADFN,RADTI,RACNI,DIQUIET,CURCASE,REPLY,CT,DATAOUT,MAGLST,XX
|
|---|
| 37 | N DAYCASE,LOCKED,RACN,RADTE,MAGS,LOGDATA,RESULT,MYLOCK,GOTLOCK
|
|---|
| 38 | S DIQUIET=1 D DT^DICRW
|
|---|
| 39 | S CT=0,DATAOUT="",DAYCASE="",MAGLST="MAGJCASELOCK"
|
|---|
| 40 | K MAGGRY S MAGGRY=$NA(^TMP($J,MAGLST)) K @MAGGRY ; assign MAGGRY
|
|---|
| 41 | S CURCASE=+$P(DATA,U)
|
|---|
| 42 | S RADFN=$P(DATA,U,2),RADTI=$P(DATA,U,3),RACNI=$P(DATA,U,4),RARPT=+$P(DATA,U,5)
|
|---|
| 43 | I "^3^4^5^"[(U_CURCASE_U)
|
|---|
| 44 | E S REPLY="4~Invalid Caselock request ("_DATA_")." G CASLOCKZ
|
|---|
| 45 | I RADFN,RADTI,RACNI,RARPT
|
|---|
| 46 | E S REPLY="4~Caselock Request contains invalid Case Pointer ("_DATA_")." G CASLOCKZ
|
|---|
| 47 | S XX=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
|
|---|
| 48 | S RACN=$P(XX,U)
|
|---|
| 49 | S RADTE=9999999.9999-RADTI
|
|---|
| 50 | S DAYCASE=$E(RADTE,4,7)_$E(RADTE,2,3)_"-"_RACN
|
|---|
| 51 | S X=$P(XX,U,3)
|
|---|
| 52 | I '$D(^RA(72,"AVC","E",X)) D G CASLOCKZ
|
|---|
| 53 | . N STS S STS=X
|
|---|
| 54 | . D LOCKACT(RARPT,DAYCASE,100,.RESULT) ; between reserve and now, exam may have been Taken & Updated
|
|---|
| 55 | . I +RESULT(1)!+RESULT(2) D LOCKACT(RARPT,DAYCASE,101,.RESULT) ; so, cancel any lock/reserve
|
|---|
| 56 | . S REPLY="5~For Case #"_DAYCASE_", current Status is "_$P(^RA(72,STS,0),U)_"; Reserve/Lock change NOT allowed."
|
|---|
| 57 | D LOCKACT(RARPT,DAYCASE,CURCASE,.RESULT,.REPLY)
|
|---|
| 58 | S GOTLOCK=+RESULT
|
|---|
| 59 | D LOCKACT(RARPT,DAYCASE,100,.MYLOCK)
|
|---|
| 60 | I GOTLOCK&+MYLOCK(1)&(CURCASE=3!(CURCASE=5)) D ; update Image access log if got the lock
|
|---|
| 61 | . S LOGDATA=$P(MYLOCK(2),"|",2) ; was saved when the Reserve occurred
|
|---|
| 62 | . I CURCASE=5 S $P(LOGDATA,U,4)=+MAGJOB("REMOTE") ; update "remote" indicator if was TAKEN
|
|---|
| 63 | . D LOG^MAGJUTL3("VR-VW",LOGDATA)
|
|---|
| 64 | . S $P(^XTMP("MAGJ","LOCK",RARPT,1,DAYCASE),"|",2)=LOGDATA ; save for Interp event
|
|---|
| 65 | S DATAOUT=$S(+MYLOCK(1):1,+MYLOCK(2):2,1:0)
|
|---|
| 66 | ;
|
|---|
| 67 | CASLOCKZ ;
|
|---|
| 68 | S @MAGGRY@(0)=CT_U_REPLY_"|"_RADFN_U_RADTI_U_RACNI_U_RARPT_"||"_DATAOUT
|
|---|
| 69 | Q
|
|---|
| 70 | ;
|
|---|
| 71 | PNAM(X) ; return pt name for input DFN
|
|---|
| 72 | I X S X=$G(^DPT(+X,0)) I X]"" S X=$P(X,U)
|
|---|
| 73 | E S X="UNKNOWN"
|
|---|
| 74 | Q X
|
|---|
| 75 | ;
|
|---|
| 76 | LOCKACT(RARPT,DAYCASE,REQUEST,RESULT,ACTREPLY,LOGDATA) ; determine if desired lock action is feasible
|
|---|
| 77 | ; Input: RARPT, DAYCASE, REQUEST, LOGDATA
|
|---|
| 78 | ; REQUESTed Action:
|
|---|
| 79 | ; 1-Lock; 2-Reserve; 3-ResToLock; 4-LockToRes; 5-TakeLock; 100-Status; 101-UNLOCK
|
|---|
| 80 | ; Note: 100 & 101 are special for internal use only
|
|---|
| 81 | ; LOGDATA--pass through for Image Access Log
|
|---|
| 82 | ; Output: RESULT, ACTREPLY
|
|---|
| 83 | ; RESULT: ACTION "allowed" = LOCK^RESERVE^ResToInt^IntToRes^Take^_"|"_ImgLst
|
|---|
| 84 | ; these are truth values; Imglst true =~ return Image File list to client
|
|---|
| 85 | ; RESULT is ultimately used at tag LOCKOUT
|
|---|
| 86 | ; ACTREPLY --reply message for client logic/display
|
|---|
| 87 | ;
|
|---|
| 88 | N ACTION,LOCKLEV,MYLOCK
|
|---|
| 89 | K RESULT S ACTION="",ACTREPLY="",RESULT="" S LOGDATA=$G(LOGDATA,"")
|
|---|
| 90 | I '$P($G(^MAG(2006.69,1,0)),U,4) Q ; Status Updates not enabled
|
|---|
| 91 | I REQUEST=100 D LOCKIN^MAGJEX1B(RARPT,.LOCKLEV,.RESULT,"STATUS") G LOCKACTZ ; Lock Status check only
|
|---|
| 92 | S ACTION="0^0^0^0^0|0"
|
|---|
| 93 | D LOCKIN^MAGJEX1B(RARPT,.LOCKLEV,.MYLOCK)
|
|---|
| 94 | I REQUEST=101 D G LOCKACT1 ; Unlock exam
|
|---|
| 95 | . M ACTREPLY=MYLOCK ; internal use by MAGJUPD1
|
|---|
| 96 | I 'LOCKLEV D G LOCKACT1
|
|---|
| 97 | . I REQUEST=1!(REQUEST=2) S $P(ACTION,"|",2)=1,ACTREPLY="5~Exam #"_DAYCASE_" is Locked by "_$P(MYLOCK(1),U,4)_"." ; View/Cancel
|
|---|
| 98 | . E S ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#0"
|
|---|
| 99 | I LOCKLEV=3 D ; Is or Can be Reserved or Interp by me
|
|---|
| 100 | . I MYLOCK(1) D Q ; Already Locked/TAKEN by me
|
|---|
| 101 | . . I REQUEST=1 D Q
|
|---|
| 102 | . . . 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)
|
|---|
| 103 | . . . 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"
|
|---|
| 104 | . . I REQUEST=4 D Q ; Remove Lock, keep Reserve
|
|---|
| 105 | . . . S $P(ACTION,U,2)=1,$P(ACTION,U,4)=1,ACTREPLY="1~Exam unlocked, reserved"
|
|---|
| 106 | . . E S $P(ACTION,U,1)=1,$P(ACTION,U,2)=+MYLOCK(2),ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#1"
|
|---|
| 107 | . E I MYLOCK(2) D Q ; Already Reserved by me
|
|---|
| 108 | . . 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)
|
|---|
| 109 | . . E I REQUEST=2 S $P(ACTION,U,2)=1,ACTREPLY="1~Exam #"_$P(MYLOCK(2),U,6)_" already reserved--no action taken."
|
|---|
| 110 | . . E S $P(ACTION,U,2)=1,ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#2"
|
|---|
| 111 | . E D ; Available
|
|---|
| 112 | . . 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)
|
|---|
| 113 | . . E I REQUEST=2 S $P(ACTION,U,2)=1,$P(ACTION,"|",2)=1,ACTREPLY="1~Exam #"_DAYCASE_" reserved."
|
|---|
| 114 | . . E S ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#3"
|
|---|
| 115 | E I LOCKLEV=1 D ; Reserved by other (I can Take, Except View/Take/Cancel)
|
|---|
| 116 | . I MYLOCK(1) D Q
|
|---|
| 117 | . . I REQUEST=1 D Q
|
|---|
| 118 | . . . 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
|
|---|
| 119 | . . . E S $P(ACTION,U)=1,ACTREPLY="1~Exam #"_$P(MYLOCK(1),U,6)_" already locked; no action taken."
|
|---|
| 120 | . . E I REQUEST=2 S $P(ACTION,U,1)=1,ACTREPLY="1~Exam #"_$P(MYLOCK(1),U,6)_" already locked; no action taken."
|
|---|
| 121 | . . ; <*> next line Unlocks ME, and preserves Other User's Reserve
|
|---|
| 122 | . . E I REQUEST=4 S $P(ACTION,U,4)=1,ACTREPLY="1~Exam unlocked; reserved by "_$P(MYLOCK(2),U,4)_"."
|
|---|
| 123 | . . E S $P(ACTION,U)=1,ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#5; Lock retained." ; preserve lock
|
|---|
| 124 | . I 'MYLOCK D Q
|
|---|
| 125 | . . I REQUEST=1 D Q
|
|---|
| 126 | . . . I MAGJOB("P32") S $P(ACTION,"|",2)=1,ACTREPLY="5~Case #"_DAYCASE_" is Reserved by "_$P(MYLOCK(2),U,4)_"."
|
|---|
| 127 | . . . E S $P(ACTION,"|",2)=1,ACTREPLY="8~Case #"_DAYCASE_" is Reserved by "_$P(MYLOCK(2),U,4)_"." ; #8=View/Take/Cancel"
|
|---|
| 128 | . . E I REQUEST=2 S $P(ACTION,"|",2)=1,ACTREPLY="5~Case #"_DAYCASE_" is Reserved by "_$P(MYLOCK(2),U,4)_"."
|
|---|
| 129 | . . 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)
|
|---|
| 130 | . . E S ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#6"
|
|---|
| 131 | E I LOCKLEV=2 D ; Locked by another
|
|---|
| 132 | . I MYLOCK(2) D Q
|
|---|
| 133 | . . S $P(ACTION,U,3)=1,ACTREPLY="5~Case #"_DAYCASE_" is Locked (taken) by "_$P(MYLOCK(1),U,4)_"; reserve cancelled." ; View/Cancel"
|
|---|
| 134 | . I 'MYLOCK D Q
|
|---|
| 135 | . . I REQUEST=1!(REQUEST=2) S $P(ACTION,"|",2)=1,ACTREPLY="5~Case #"_DAYCASE_" is Locked by "_$P(MYLOCK(1),U,4)_"." ; View/Cancel"
|
|---|
| 136 | . . E S ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#8"
|
|---|
| 137 | ;
|
|---|
| 138 | LOCKACT1 D LOCKOUT(RARPT,DAYCASE,LOCKLEV,.MYLOCK,ACTION,.RESULT,LOGDATA)
|
|---|
| 139 | ;
|
|---|
| 140 | LOCKACTZ Q
|
|---|
| 141 | ;
|
|---|
| 142 | ;
|
|---|
| 143 | LOCKOUT(RARPT,DAYCASE,LOCKLEV,MYLOCK,ACTION,RESULT,LOGDATA) ; Record Locks and Clear Locks, as required
|
|---|
| 144 | ; Precursors are logic and data from tags LOCKIN^magjex1b and LOCKACT
|
|---|
| 145 | S RESULT="" S LOGDATA=$G(LOGDATA,"")
|
|---|
| 146 | Q:'LOCKLEV ; nothing to do
|
|---|
| 147 | N ILOCK
|
|---|
| 148 | F ILOCK=1,2 D ; 1:Lock 2:Reserve
|
|---|
| 149 | . I ILOCK=1&(LOCKLEV=1!(LOCKLEV=3))
|
|---|
| 150 | . E I ILOCK=2&(LOCKLEV=2!(LOCKLEV=3))
|
|---|
| 151 | . E Q
|
|---|
| 152 | . I MYLOCK(ILOCK) D ; NEVER change order of the logic below!
|
|---|
| 153 | . . I '$P(ACTION,U,ILOCK) D
|
|---|
| 154 | . . . K ^XTMP("MAGJ","LOCK",RARPT,ILOCK)
|
|---|
| 155 | . . . S $P(RESULT,U,ILOCK)=0
|
|---|
| 156 | . . L -^XTMP("MAGJ","LOCK",RARPT,ILOCK) ; reset lock
|
|---|
| 157 | . ; index by DayCase manages locks for Printset Exams (>1 DayCase for one RARPT)
|
|---|
| 158 | . ; a lock on any printset member exam effectively locks all related exams
|
|---|
| 159 | . I +$P(ACTION,U,ILOCK),'MYLOCK(ILOCK) D
|
|---|
| 160 | . . S ^XTMP("MAGJ","LOCK",RARPT,ILOCK,DAYCASE)=DUZ_U_$J_U_$H_U_$P(MAGJOB("USER",1),U,2,3)_U_"|"_LOGDATA
|
|---|
| 161 | . . S ^XTMP("MAGJ","LOCK",RARPT,ILOCK)=DAYCASE
|
|---|
| 162 | . . S $P(RESULT,U,ILOCK)=1
|
|---|
| 163 | . I '$P(ACTION,U,ILOCK) L -^XTMP("MAGJ","LOCK",RARPT,ILOCK) ; reset or clear lock
|
|---|
| 164 | Q
|
|---|
| 165 | ;
|
|---|
| 166 | END Q ;
|
|---|
