MAGJEX1B ;WIRMFO/JHC - Rad. Workstation RPC calls ; 10/17/2022
;;3.0;IMAGING;**16,22,18,65,76,104,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;**101**
Q
; Subroutines for fetch exam images, exam lock/reserve, remove dangling locks
;
IMGLOOP ; get data for all the images
; This subroutine is called from MAGJEX1
; MAGGRY holds $NA reference to ^TMP where Broker return message is assembled;
; all references to MAGGRY use subscript indirection
N DFN,IMGREC,P18ALTP
I '$D(MAGJOB("ALTPATH")) S MAGJOB("ALTPATH")=0 ; facilitates testing
F IMAG=MAGSTRT:1:MAGEND S MAGIEN=$P(MAGS(IMAG),U,4) D
. S DFN=$P(MAGS(IMAG),U,8)
. I DFN=RADFN S MIXEDUP(RADFN)="" ;ok
. E S:'DFN DFN=0 S MIXEDUP=MIXEDUP+2,MIXEDUP(DFN)="" ; database corruption
. S MDL=$P(MAGS(IMAG),U,3)
. I MDL="DR" S MDL="CR" ; for now, hard code cx of non-standard code
. S MAGXX=MAGIEN D
. . I $P(MAGS(IMAG),U,2)["BIG" D BIG^MAGFILEB Q ; ISI remove deprecated logic
. . E D VST^MAGFILEB
. I MAGJOB("ALTPATH") S X=$P(MAGS(IMAG),U,6),P18ALTP="" I X]"" D
. . F I=1:1:$L(X,",") S T=$P(X,",",I) I T S CURPATHS(T)="" I $D(MAGJOB("LOC",T)) S P18ALTP=P18ALTP_$S(P18ALTP="":"",1:",")_T
. S IMGREC="B2^"_MAGIEN_U_MAGFILE2
. S T="",X=$P(MAGS(IMAG),U,11) I X]"" F I="K","I","U" I X[I,$D(PSIND(I)) S T=T_$S(T="":"",1:",")_I ; PS_Indicators
. S IMGREC=IMGREC_U_T_U_$S(MAGJOB("ALTPATH"):P18ALTP,1:"") ; AltPaths for this img
. I '(PROCDT]"") D ; Img Process Date
. . S X=$P(MAGS(IMAG),U,12) I X]"" S T=$S($E(X)=3:20,$E(X)=2:19,1:"") I T S PROCDT=T_$E(X,2,7)
. I '(ACQSITE]"") D ; Acq Site
. . S X=$P(MAGS(IMAG),U,13) I X]"" S ACQSITE=X
. I '(STANUM]"") D ; Station Number
. . S X=$P(MAGS(IMAG),U,5) I X]"" S STANUM=X
. S CT=CT+1,@MAGGRY@(CT+STARTNOD)=IMGREC
. I MODALITY="" S MODALITY=MDL
;
I 'MAGJOB("ALTPATH") S ALTPATH=-1
E D
. S T=0 F S T=$O(CURPATHS(T)) Q:'T I $D(MAGJOB("LOC",T)) Q
. S ALTPATH=$S('T:0,1:1)
. I ALTPATH=$P(MAGJOB("ALTPATH"),U,2) S ALTPATH=-1
. E S $P(MAGJOB("ALTPATH"),U,2)=ALTPATH
IMGLOOPZ Q
;
;
LOCKIN(RARPT,LOCKLEV,MYLOCK,LOCKCHK) ; init lock-related info B4 do any lock actions
; called from UTL3 & EX1A
; if LOCKCHK="STATUS", only return current status
; Input RARPT (required) and LOCKCHK (opt)
; Output: LOCKLEV & MYLOCK array; successful LOCKS left intact, unless LOCKCHK="STATUS"
; M LOCKS det. what Actions are possible by calling program modules
; MYLOCK(1/2)= Lock_is_Mine ^ DUZ ^ $J ^ User Name ^ User Init ^ Case #
; LOCKLEV=0:3--is/not 1-Lockable/2-Reservable/3-Both to user
; MYLOCK=0:3--is/not already 1-Locked/2-Reserved/3-Both by user
;
N CKMINE,CASENO,XX,XY,ILOCK
S LOCKCHK=$G(LOCKCHK)="STATUS"
S LOCKLEV=0 K MYLOCK S MYLOCK=0
L +^XTMP("MAGJ","LOCK",RARPT):0
I S LOCKLEV=3
L +^XTMP("MAGJ","LOCK",RARPT,1):0 ; "1" for Exam "LOCK"
I S:'LOCKLEV LOCKLEV=1
L +^XTMP("MAGJ","LOCK",RARPT,2):0 ; "2" for Exam "RESERVE"
I S LOCKLEV=$S('LOCKLEV:2,1:3)
L -^XTMP("MAGJ","LOCK",RARPT)
S CKMINE=DUZ_U_$J
F ILOCK=1,2 D
. S XX="",XY="",CASENO=$G(^XTMP("MAGJ","LOCK",RARPT,ILOCK))
. I CASENO]"" S XX=$G(^XTMP("MAGJ","LOCK",RARPT,ILOCK,CASENO)),XY=$P(XX,"|",2),XX=$P(XX,"|")
. S X=$P(XX,U,1,2),MYLOCK(ILOCK)=(X=CKMINE)
. S X=$P(XX,U)_U_$P(XX,U,2)_U_$P(XX,U,4)_U_$P(XX,U,5)_U_CASENO_U_"|"_XY
. S MYLOCK(ILOCK)=MYLOCK(ILOCK)_U_X
. I MYLOCK(ILOCK) S MYLOCK=MYLOCK+ILOCK
I LOCKCHK,LOCKLEV D ; reset locks for Lock check
. I LOCKLEV=1!(LOCKLEV=3) L -^XTMP("MAGJ","LOCK",RARPT,1)
. I LOCKLEV=2!(LOCKLEV=3) L -^XTMP("MAGJ","LOCK",RARPT,2)
Q
;
REMLOCK ; Remove dangling exam locks; this is run only at Logon
; If a recorded lock is found that a new job (logon) can M-Lock
; then that is a dangling lock that must be removed
N RARPT,TS,LOCKLEV,MYLOCK,ACTION,DAYCASE,ILOCK,RESULT
S RARPT=""
F S RARPT=$O(^XTMP("MAGJ","LOCK",RARPT)) Q:'RARPT D ; loop thru recorded locks
. D LOCKIN(RARPT,.LOCKLEV,.MYLOCK)
. I 'LOCKLEV Q ;unable to lock--is ok
. S ACTION="",DAYCASE=""
. F ILOCK=1,2 I $D(^XTMP("MAGJ","LOCK",RARPT,ILOCK)) S XX=^(ILOCK) D
. . I DAYCASE="" S DAYCASE=$P(XX,U)
. . I ILOCK=1,(LOCKLEV=1!(LOCKLEV=3)) S $P(ACTION,U,1)=1
. . I ILOCK=2,(LOCKLEV=2!(LOCKLEV=3)) S $P(ACTION,U,2)=1
. I 'ACTION,'+$P(ACTION,U,2),(DAYCASE="") D Q ; should never occur, but
. . I LOCKLEV=1!(LOCKLEV=3) L -^XTMP("MAGJ","LOCK",RARPT,1)
. . I LOCKLEV=2!(LOCKLEV=3) L -^XTMP("MAGJ","LOCK",RARPT,2)
. D LOCKOUT^MAGJEX1A(RARPT,DAYCASE,.LOCKLEV,.MYLOCK,ACTION,.RESULT) ; 1st, lock to me
. K LOCKLEV,MYLOCK D LOCKACT^MAGJEX1A(RARPT,DAYCASE,101,.RESULT) ; then, clear the lock
S TS="" F I=2,0 S TS=TS_$S(TS="":"",1:U)_$$HTFM^XLFDT($H+I,0)
S ^XTMP("MAGJ",0)=TS_U_"VistaRad Locks"
Q
;
;
END ;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGJEX1B 5751 printed Apr 09, 2024@21:00:23 Page 2
MAGJEX1B ;WIRMFO/JHC - Rad. Workstation RPC calls ; 10/17/2022
+1 ;;3.0;IMAGING;**16,22,18,65,76,104,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;**101**
+18 QUIT
+19 ; Subroutines for fetch exam images, exam lock/reserve, remove dangling locks
+20 ;
IMGLOOP ; get data for all the images
+1 ; This subroutine is called from MAGJEX1
+2 ; MAGGRY holds $NA reference to ^TMP where Broker return message is assembled;
+3 ; all references to MAGGRY use subscript indirection
+4 NEW DFN,IMGREC,P18ALTP
+5 ; facilitates testing
IF '$DATA(MAGJOB("ALTPATH"))
SET MAGJOB("ALTPATH")=0
+6 FOR IMAG=MAGSTRT:1:MAGEND
SET MAGIEN=$PIECE(MAGS(IMAG),U,4)
Begin DoDot:1
+7 SET DFN=$PIECE(MAGS(IMAG),U,8)
+8 ;ok
IF DFN=RADFN
SET MIXEDUP(RADFN)=""
+9 ; database corruption
IF '$TEST
if 'DFN
SET DFN=0
SET MIXEDUP=MIXEDUP+2
SET MIXEDUP(DFN)=""
+10 SET MDL=$PIECE(MAGS(IMAG),U,3)
+11 ; for now, hard code cx of non-standard code
IF MDL="DR"
SET MDL="CR"
+12 SET MAGXX=MAGIEN
Begin DoDot:2
+13 ; ISI remove deprecated logic
IF $PIECE(MAGS(IMAG),U,2)["BIG"
DO BIG^MAGFILEB
QUIT
+14 IF '$TEST
DO VST^MAGFILEB
End DoDot:2
+15 IF MAGJOB("ALTPATH")
SET X=$PIECE(MAGS(IMAG),U,6)
SET P18ALTP=""
IF X]""
Begin DoDot:2
+16 FOR I=1:1:$LENGTH(X,",")
SET T=$PIECE(X,",",I)
IF T
SET CURPATHS(T)=""
IF $DATA(MAGJOB("LOC",T))
SET P18ALTP=P18ALTP_$SELECT(P18ALTP="":"",1:",")_T
End DoDot:2
+17 SET IMGREC="B2^"_MAGIEN_U_MAGFILE2
+18 ; PS_Indicators
SET T=""
SET X=$PIECE(MAGS(IMAG),U,11)
IF X]""
FOR I="K","I","U"
IF X[I
IF $DATA(PSIND(I))
SET T=T_$SELECT(T="":"",1:",")_I
+19 ; AltPaths for this img
SET IMGREC=IMGREC_U_T_U_$SELECT(MAGJOB("ALTPATH"):P18ALTP,1:"")
+20 ; Img Process Date
IF '(PROCDT]"")
Begin DoDot:2
+21 SET X=$PIECE(MAGS(IMAG),U,12)
IF X]""
SET T=$SELECT($EXTRACT(X)=3:20,$EXTRACT(X)=2:19,1:"")
IF T
SET PROCDT=T_$EXTRACT(X,2,7)
End DoDot:2
+22 ; Acq Site
IF '(ACQSITE]"")
Begin DoDot:2
+23 SET X=$PIECE(MAGS(IMAG),U,13)
IF X]""
SET ACQSITE=X
End DoDot:2
+24 ; Station Number
IF '(STANUM]"")
Begin DoDot:2
+25 SET X=$PIECE(MAGS(IMAG),U,5)
IF X]""
SET STANUM=X
End DoDot:2
+26 SET CT=CT+1
SET @MAGGRY@(CT+STARTNOD)=IMGREC
+27 IF MODALITY=""
SET MODALITY=MDL
End DoDot:1
+28 ;
+29 IF 'MAGJOB("ALTPATH")
SET ALTPATH=-1
+30 IF '$TEST
Begin DoDot:1
+31 SET T=0
FOR
SET T=$ORDER(CURPATHS(T))
if 'T
QUIT
IF $DATA(MAGJOB("LOC",T))
QUIT
+32 SET ALTPATH=$SELECT('T:0,1:1)
+33 IF ALTPATH=$PIECE(MAGJOB("ALTPATH"),U,2)
SET ALTPATH=-1
+34 IF '$TEST
SET $PIECE(MAGJOB("ALTPATH"),U,2)=ALTPATH
End DoDot:1
IMGLOOPZ QUIT
+1 ;
+2 ;
LOCKIN(RARPT,LOCKLEV,MYLOCK,LOCKCHK) ; init lock-related info B4 do any lock actions
+1 ; called from UTL3 & EX1A
+2 ; if LOCKCHK="STATUS", only return current status
+3 ; Input RARPT (required) and LOCKCHK (opt)
+4 ; Output: LOCKLEV & MYLOCK array; successful LOCKS left intact, unless LOCKCHK="STATUS"
+5 ; M LOCKS det. what Actions are possible by calling program modules
+6 ; MYLOCK(1/2)= Lock_is_Mine ^ DUZ ^ $J ^ User Name ^ User Init ^ Case #
+7 ; LOCKLEV=0:3--is/not 1-Lockable/2-Reservable/3-Both to user
+8 ; MYLOCK=0:3--is/not already 1-Locked/2-Reserved/3-Both by user
+9 ;
+10 NEW CKMINE,CASENO,XX,XY,ILOCK
+11 SET LOCKCHK=$GET(LOCKCHK)="STATUS"
+12 SET LOCKLEV=0
KILL MYLOCK
SET MYLOCK=0
+13 LOCK +^XTMP("MAGJ","LOCK",RARPT):0
+14 IF $TEST
SET LOCKLEV=3
+15 ; "1" for Exam "LOCK"
LOCK +^XTMP("MAGJ","LOCK",RARPT,1):0
+16 IF $TEST
if 'LOCKLEV
SET LOCKLEV=1
+17 ; "2" for Exam "RESERVE"
LOCK +^XTMP("MAGJ","LOCK",RARPT,2):0
+18 IF $TEST
SET LOCKLEV=$SELECT('LOCKLEV:2,1:3)
+19 LOCK -^XTMP("MAGJ","LOCK",RARPT)
+20 SET CKMINE=DUZ_U_$JOB
+21 FOR ILOCK=1,2
Begin DoDot:1
+22 SET XX=""
SET XY=""
SET CASENO=$GET(^XTMP("MAGJ","LOCK",RARPT,ILOCK))
+23 IF CASENO]""
SET XX=$GET(^XTMP("MAGJ","LOCK",RARPT,ILOCK,CASENO))
SET XY=$PIECE(XX,"|",2)
SET XX=$PIECE(XX,"|")
+24 SET X=$PIECE(XX,U,1,2)
SET MYLOCK(ILOCK)=(X=CKMINE)
+25 SET X=$PIECE(XX,U)_U_$PIECE(XX,U,2)_U_$PIECE(XX,U,4)_U_$PIECE(XX,U,5)_U_CASENO_U_"|"_XY
+26 SET MYLOCK(ILOCK)=MYLOCK(ILOCK)_U_X
+27 IF MYLOCK(ILOCK)
SET MYLOCK=MYLOCK+ILOCK
End DoDot:1
+28 ; reset locks for Lock check
IF LOCKCHK
IF LOCKLEV
Begin DoDot:1
+29 IF LOCKLEV=1!(LOCKLEV=3)
LOCK -^XTMP("MAGJ","LOCK",RARPT,1)
+30 IF LOCKLEV=2!(LOCKLEV=3)
LOCK -^XTMP("MAGJ","LOCK",RARPT,2)
End DoDot:1
+31 QUIT
+32 ;
REMLOCK ; Remove dangling exam locks; this is run only at Logon
+1 ; If a recorded lock is found that a new job (logon) can M-Lock
+2 ; then that is a dangling lock that must be removed
+3 NEW RARPT,TS,LOCKLEV,MYLOCK,ACTION,DAYCASE,ILOCK,RESULT
+4 SET RARPT=""
+5 ; loop thru recorded locks
FOR
SET RARPT=$ORDER(^XTMP("MAGJ","LOCK",RARPT))
if 'RARPT
QUIT
Begin DoDot:1
+6 DO LOCKIN(RARPT,.LOCKLEV,.MYLOCK)
+7 ;unable to lock--is ok
IF 'LOCKLEV
QUIT
+8 SET ACTION=""
SET DAYCASE=""
+9 FOR ILOCK=1,2
IF $DATA(^XTMP("MAGJ","LOCK",RARPT,ILOCK))
SET XX=^(ILOCK)
Begin DoDot:2
+10 IF DAYCASE=""
SET DAYCASE=$PIECE(XX,U)
+11 IF ILOCK=1
IF (LOCKLEV=1!(LOCKLEV=3))
SET $PIECE(ACTION,U,1)=1
+12 IF ILOCK=2
IF (LOCKLEV=2!(LOCKLEV=3))
SET $PIECE(ACTION,U,2)=1
End DoDot:2
+13 ; should never occur, but
IF 'ACTION
IF '+$PIECE(ACTION,U,2)
IF (DAYCASE="")
Begin DoDot:2
+14 IF LOCKLEV=1!(LOCKLEV=3)
LOCK -^XTMP("MAGJ","LOCK",RARPT,1)
+15 IF LOCKLEV=2!(LOCKLEV=3)
LOCK -^XTMP("MAGJ","LOCK",RARPT,2)
End DoDot:2
QUIT
+16 ; 1st, lock to me
DO LOCKOUT^MAGJEX1A(RARPT,DAYCASE,.LOCKLEV,.MYLOCK,ACTION,.RESULT)
+17 ; then, clear the lock
KILL LOCKLEV,MYLOCK
DO LOCKACT^MAGJEX1A(RARPT,DAYCASE,101,.RESULT)
End DoDot:1
+18 SET TS=""
FOR I=2,0
SET TS=TS_$SELECT(TS="":"",1:U)_$$HTFM^XLFDT($HOROLOG+I,0)
+19 SET ^XTMP("MAGJ",0)=TS_U_"VistaRad Locks"
+20 QUIT
+21 ;
+22 ;
END ;
