Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: MAGJEX1A

MAGJEX1A.m

Go to the documentation of this file.
  1. MAGJEX1A ;WIRMFO/JHC - VistARad RPCs, exam locking ; 10/17/2022
  1. ;;3.0;IMAGING;**18,65,101,120,341**;Dec 21, 2022;Build 28
  1. ;; Per VHA Directive 2004-038, this routine should not be modified.
  1. ;; +---------------------------------------------------------------+
  1. ;; | Property of the US Government. |
  1. ;; | No permission to copy or redistribute this software is given. |
  1. ;; | Use of unreleased versions of this software requires the user |
  1. ;; | to execute a written test agreement with the VistA Imaging |
  1. ;; | Development Office of the Department of Veterans Affairs, |
  1. ;; | telephone (301) 734-0100. |
  1. ;; | The Food and Drug Administration classifies this software as |
  1. ;; | a medical device. As such, it may not be changed in any way. |
  1. ;; | Modifications to this software may result in an adulterated |
  1. ;; | medical device under 21CFR820, the use of which is considered |
  1. ;; | to be a violation of US Federal Statutes. |
  1. ;; +---------------------------------------------------------------+
  1. ;;
  1. ;; ISI IMAGING;**99,101**
  1. Q
  1. ; Entry Points:
  1. ; CASLOCK--RPC: Lock mgt
  1. ; LOCKACT--Subrtn
  1. ; LOCKOUT--Subrtn
  1. ;
  1. ERR N ERR S ERR=$$EC^%ZOSV S @MAGGRY@(0)="0^4~"_ERR
  1. D @^%ZOSF("ERRTN")
  1. Q:$Q 1 Q
  1. ;
  1. 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
  1. ; input in DATA: OPEN_FLAG^RADFN^RADTI^RACNI^RARPT
  1. ; OPEN_FLAG = 3: Reserve-to-Lock; 4: Lock-to-Reserve; 5: Lock/Take
  1. ; RADFN^, etc--exam id
  1. ;
  1. N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJEX1A"
  1. N RARPT,RADFN,RADTI,RACNI,DIQUIET,CURCASE,REPLY,CT,DATAOUT,MAGLST,XX
  1. N DAYCASE,LOCKED,RACN,RADTE,MAGS,LOGDATA,RESULT,MYLOCK,GOTLOCK,LONGACN
  1. S DIQUIET=1 D DT^DICRW
  1. S CT=0,DATAOUT=0,DAYCASE="",MAGLST="MAGJCASELOCK"
  1. K MAGGRY S MAGGRY=$NA(^TMP($J,MAGLST)) K @MAGGRY ; assign MAGGRY
  1. S CURCASE=+$P(DATA,U)
  1. S RADFN=$P(DATA,U,2),RADTI=$P(DATA,U,3),RACNI=$P(DATA,U,4),RARPT=+$P(DATA,U,5)
  1. I "^3^4^5^"[(U_CURCASE_U)
  1. E S REPLY="4~Invalid Caselock request ("_DATA_")." G CASLOCKZ
  1. I RADFN,RADTI,RACNI,RARPT
  1. E S REPLY="4~Caselock Request contains invalid Case Pointer ("_DATA_")." G CASLOCKZ
  1. S XX=$G(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0))
  1. S RACN=$P(XX,U),LONGACN=$P(XX,U,31)
  1. S RADTE=9999999.9999-RADTI
  1. S DAYCASE=$E(RADTE,4,7)_$E(RADTE,2,3)_"-"_RACN
  1. I LONGACN]"" S DAYCASE=LONGACN
  1. S X=$P(XX,U,3)
  1. I '$D(^RA(72,"AVC","E",X)) D G CASLOCKZ
  1. . N STS S STS=X
  1. . D LOCKACT(RARPT,DAYCASE,100,.RESULT) ; between reserve and now, exam may have been Taken & Updated
  1. . I +RESULT(1)!+RESULT(2) D LOCKACT(RARPT,DAYCASE,101,.RESULT) ; so, cancel any lock/reserve
  1. . S REPLY="5~For Case #"_DAYCASE_", current Status is "_$P(^RA(72,STS,0),U)_"; Reserve/Lock change NOT allowed."
  1. D LOCKACT(RARPT,DAYCASE,CURCASE,.RESULT,.REPLY)
  1. S GOTLOCK=+RESULT
  1. D LOCKACT(RARPT,DAYCASE,100,.MYLOCK)
  1. I GOTLOCK&+MYLOCK(1)&(CURCASE=3!(CURCASE=5)) D ; update Image access log if got the lock
  1. . S LOGDATA=$P(MYLOCK(2),"|",2) ; was saved when the Reserve occurred
  1. . I CURCASE=5 S $P(LOGDATA,U,4)=+MAGJOB("REMOTE") ; update "remote" indicator if was TAKEN
  1. . D LOG^MAGJUTL3("VR-VW",LOGDATA,$$PSETLST^MAGJEX1(RADFN,RADTI,RACNI))
  1. . S $P(^XTMP("MAGJ","LOCK",RARPT,1,DAYCASE),"|",2)=LOGDATA ; save for Interp event
  1. S DATAOUT=$S(+MYLOCK(1):1,+MYLOCK(2):2,1:0)
  1. ;
  1. CASLOCKZ ;
  1. S @MAGGRY@(0)=CT_U_REPLY_"|"_RADFN_U_RADTI_U_RACNI_U_RARPT_"||"_DATAOUT
  1. Q
  1. ;
  1. PNAM(X) ; return pt name for input DFN
  1. I X S X=$G(^DPT(+X,0)) I X]"" S X=$P(X,U)
  1. E S X="UNKNOWN"
  1. Q X
  1. ;
  1. LOCKACT(RARPT,DAYCASE,REQUEST,RESULT,ACTREPLY,LOGDATA) ; determine if desired lock action is feasible
  1. ; Input: RARPT, DAYCASE, REQUEST, LOGDATA
  1. ; REQUESTed Action:
  1. ; 1-Lock; 2-Reserve; 3-ResToLock; 4-LockToRes; 5-TakeLock; 100-Status; 101-UNLOCK
  1. ; Note: 100 & 101 are special for internal use only
  1. ; LOGDATA--pass through for Image Access Log
  1. ; Output: RESULT, ACTREPLY
  1. ; RESULT: ACTION "allowed" = LOCK^RESERVE^ResToInt^IntToRes^Take^_"|"_ImgLst
  1. ; these are truth values; Imglst true =~ return Image File list to client
  1. ; RESULT is ultimately used at tag LOCKOUT
  1. ; ACTREPLY --reply message for client logic/display
  1. ;
  1. N ACTION,LOCKLEV,MYLOCK
  1. K RESULT S ACTION="",ACTREPLY="",RESULT="" S LOGDATA=$G(LOGDATA,"")
  1. I '$P($G(^MAG(2006.69,1,0)),U,4) Q ; Status Updates not enabled
  1. I REQUEST=100 D LOCKIN^MAGJEX1B(RARPT,.LOCKLEV,.RESULT,"STATUS") G LOCKACTZ ; Lock Status check only
  1. S ACTION="0^0^0^0^0|0"
  1. D LOCKIN^MAGJEX1B(RARPT,.LOCKLEV,.MYLOCK)
  1. I REQUEST=101 D G LOCKACT1 ; Unlock exam
  1. . M ACTREPLY=MYLOCK ; internal use by MAGJUPD1
  1. I 'LOCKLEV D G LOCKACT1
  1. . I REQUEST=1!(REQUEST=2) S $P(ACTION,"|",2)=1,ACTREPLY="5~Exam #"_DAYCASE_" is Locked by "_$P(MYLOCK(1),U,4)_"." ; View/Cancel
  1. . E S ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#0"
  1. I LOCKLEV=3 D ; Is or Can be Reserved or Interp by me
  1. . I MYLOCK(1) D Q ; Already Locked/TAKEN by me
  1. . . I REQUEST=1 D Q
  1. . . . ; ISI remove deprecated logic re p32
  1. . . . 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"
  1. . . I REQUEST=4 D Q ; Remove Lock, keep Reserve
  1. . . . S $P(ACTION,U,2)=1,$P(ACTION,U,4)=1,ACTREPLY="1~Exam unlocked, reserved"
  1. . . E S $P(ACTION,U,1)=1,$P(ACTION,U,2)=+MYLOCK(2),ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#1"
  1. . E I MYLOCK(2) D Q ; Already Reserved by me
  1. . . 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)
  1. . . E I REQUEST=2 S $P(ACTION,U,2)=1,ACTREPLY="1~Exam #"_$P(MYLOCK(2),U,6)_" already reserved--no action taken."
  1. . . E S $P(ACTION,U,2)=1,ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#2"
  1. . E D ; Available
  1. . . 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)
  1. . . E I REQUEST=2 S $P(ACTION,U,2)=1,$P(ACTION,"|",2)=1,ACTREPLY="1~Exam #"_DAYCASE_" reserved."
  1. . . E S ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#3"
  1. E I LOCKLEV=1 D ; Reserved by other (I can Take, Except View/Take/Cancel)
  1. . I MYLOCK(1) D Q
  1. . . I REQUEST=1 D Q
  1. . . . ; ISI remove deprecated logic re p32
  1. . . . S $P(ACTION,U)=1,ACTREPLY="1~Exam #"_$P(MYLOCK(1),U,6)_" already locked; no action taken."
  1. . . E I REQUEST=2 S $P(ACTION,U,1)=1,ACTREPLY="1~Exam #"_$P(MYLOCK(1),U,6)_" already locked; no action taken."
  1. . . ; <*> next line Unlocks ME, and preserves Other User's Reserve
  1. . . E I REQUEST=4 S $P(ACTION,U,4)=1,ACTREPLY="1~Exam unlocked; reserved by "_$P(MYLOCK(2),U,4)_"."
  1. . . E S $P(ACTION,U)=1,ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#5; Lock retained." ; preserve lock
  1. . I 'MYLOCK D Q
  1. . . I REQUEST=1 D Q
  1. . . . ; ISI remove deprecated logic re p32
  1. . . . S $P(ACTION,"|",2)=1,ACTREPLY="8~Case #"_DAYCASE_" is Reserved by "_$P(MYLOCK(2),U,4)_"." ; #8=View/Take/Cancel"
  1. . . E I REQUEST=2 S $P(ACTION,"|",2)=1,ACTREPLY="5~Case #"_DAYCASE_" is Reserved by "_$P(MYLOCK(2),U,4)_"."
  1. . . 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)
  1. . . E S ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#6"
  1. E I LOCKLEV=2 D ; Locked by another
  1. . I MYLOCK(2) D Q
  1. . . S $P(ACTION,U,3)=1,ACTREPLY="5~Case #"_DAYCASE_" is Locked (taken) by "_$P(MYLOCK(1),U,4)_"; reserve cancelled." ; View/Cancel"
  1. . I 'MYLOCK D Q
  1. . . I REQUEST=1!(REQUEST=2) S $P(ACTION,"|",2)=1,ACTREPLY="5~Case #"_DAYCASE_" is Locked by "_$P(MYLOCK(1),U,4)_"." ; View/Cancel"
  1. . . E S ACTREPLY="3~Invalid exam lock request ("_REQUEST_")--#8"
  1. ;
  1. LOCKACT1 D LOCKOUT(RARPT,DAYCASE,LOCKLEV,.MYLOCK,ACTION,.RESULT,LOGDATA)
  1. ;
  1. LOCKACTZ Q
  1. ;
  1. ;
  1. 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
  1. S RESULT="" S LOGDATA=$G(LOGDATA,"")
  1. Q:'LOCKLEV ; nothing to do
  1. N ILOCK
  1. F ILOCK=1,2 D ; 1:Lock 2:Reserve
  1. . I ILOCK=1&(LOCKLEV=1!(LOCKLEV=3))
  1. . E I ILOCK=2&(LOCKLEV=2!(LOCKLEV=3))
  1. . E Q
  1. . I MYLOCK(ILOCK) D ; NEVER change order of the logic below!
  1. . . I '$P(ACTION,U,ILOCK) D
  1. . . . K ^XTMP("MAGJ","LOCK",RARPT,ILOCK)
  1. . . . S $P(RESULT,U,ILOCK)=0
  1. . . L -^XTMP("MAGJ","LOCK",RARPT,ILOCK) ; reset lock
  1. . ; index by DayCase manages locks for Printset Exams (>1 DayCase for one RARPT)
  1. . ; a lock on any printset member exam effectively locks all related exams
  1. . I +$P(ACTION,U,ILOCK),'MYLOCK(ILOCK) D
  1. . . S ^XTMP("MAGJ","LOCK",RARPT,ILOCK,DAYCASE)=DUZ_U_$J_U_$H_U_$P(MAGJOB("USER",1),U,2,3)_U_"|"_LOGDATA
  1. . . S ^XTMP("MAGJ","LOCK",RARPT,ILOCK)=DAYCASE
  1. . . S $P(RESULT,U,ILOCK)=1
  1. . I '$P(ACTION,U,ILOCK) L -^XTMP("MAGJ","LOCK",RARPT,ILOCK) ; reset or clear lock
  1. Q
  1. ;
  1. END Q ;