MAGJUTL2 ;WIRMFO/JHC/DAC - VistRad subroutines for RPC calls ; 10/17/2022
;;3.0;IMAGING;**18,65,76,104,120,220,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**
Q
IMGINFO(RARPT,RET) ; Fetch info from Image File for input RARPT:
; Input: RARPT: Rad Report pointer
; RET contents delimited by ^:
; CT = # of images for case
; ONL = Image Storage status (Y=On Magnetic disk, N=Jukebox
; "n/a" for not available, e.g., film only)
; note -- if last image in group is Online, considers ALL online
; MAGDT = Date/Time of Image Capture
; REMOTE = 1/0 to Indicate images were remotely cached
; MODALITY = Modality abbrev
; PLACE = Image storage PLace (ptr to 2006.1 entry)
; KEY = 1/0 ind. Key Images exist for this exam
;
N IRPT,MAGIEN,MAGIEN2,ONLCHK,NETLOC,STIEN
N CT,ONL,MAGDT,REMOTE,MODALITY,PLACE,REMCHK,KEY,TDT
S CT="",ONL="",MAGDT="",RET="",REMOTE="",MODALITY="",PLACE="",KEY=0 ; init return vars
G IMGINFQ:'RARPT G IMGINFQ:'$D(^RARPT(RARPT,2005,0))
S STIEN=$$STUDYID^MAGJUPD2("",RARPT,1)
I STIEN S T=$O(^MAG(2005,STIEN,205,0)) I T S KEY=1
S IRPT=0 F S IRPT=$O(^RARPT(RARPT,2005,IRPT)) Q:'IRPT S MAGIEN=$P(^(IRPT,0),U) D
. Q:'$D(^MAG(2005,MAGIEN,0))
. ; P220 DAC - Modified to return a date with a timestamp
. S TDT=$P($G(^MAG(2005,MAGIEN,100)),U,6) S:(TDT="")!($L(TDT,".")=1) TDT=$P($G(^(2)),U)
. I TDT S MAGDT=$S(MAGDT="":TDT,TDT<MAGDT:TDT,1:MAGDT)
. I $O(^MAG(2005,MAGIEN,1,0)) S CT=CT+$P(^(0),U,4),Y=$P(^(0),U,3),MAGIEN2=$P($G(^(Y,0)),U) S:(MAGIEN2]"") ONLCHK=$$ONLCHK(MAGIEN2),REMCHK=$$REMOTE(MAGIEN2) ; last image in group
. E S CT=CT+1,ONLCHK=$$ONLCHK(MAGIEN),REMCHK=$$REMOTE(MAGIEN)
. S ONL=$S(ONL="":+ONLCHK,+ONL:+ONLCHK,1:0) ; NOT Online if ANY img is 0
. S REMOTE=$S(REMOTE="":REMCHK,+REMOTE:REMCHK,1:0) ; NOT Remote if ANY img is 0
. S X=$P(ONLCHK,U,3)
. I MODALITY="" S MODALITY=X
. E I MODALITY'[X S MODALITY=MODALITY_","_X
. I PLACE="" S PLACE=$P(ONLCHK,U,4)
I MODALITY["," S MODALITY=$$MULTMDL(MODALITY,",")
IMGINFQ S ONL=$S(+ONL:"Y",ONL="":"n/a",1:"N")
S RET=CT_U_ONL_U_MAGDT_U_REMOTE_U_MODALITY_U_PLACE_U_KEY
Q
;
MULTMDL(MDLS,DLM) ; return multiple modality codes in a preferred sequence for HP lookups
; input: MDLS: list of modality codes, delimited by DLM
; return: "normalized" list delimited by DLM
;
; The variable STR contains a list of codes, each paired with a numeric
; priority value--lower number is higher priority. The input MDLS sequence is
; re-sorted according to the priorities; equivalent priorities are resolved
; by alphabetic value; "unknown" input codes are give arbitrary value 6
;
I $L(MDLS,DLM)>1 D
. N I,MD,ORD,STR,T,X
. S STR="1^CT|1^MG|1^RF|1^XA|2^MR|3^CR|4^DX|4^BDUS|4^BI|4^BMD|4^DF|4^DS|4^EC|4^MA|4^NM|4^PT|4^RG|4^ST|4^US|4^XC|5^ECG|5^IO|5^IVUS|5^PX|6^DG|6^TG|6^SC|6^VL|7^ES|7^FID|7^GM|7^HD|7^LS|7^XRAY|8^DOC|8^HC|8^OT|8^REG|8^SC|9^KO|9^PR|9^SEG|9^SR|"
. F I=1:1 S X=$P(STR,"|",I) Q:X="" S MD($P(X,U,2))=+X
. F I=1:1:$L(MDLS,DLM) S T=$P(MDLS,DLM,I) S ORD=$S($D(MD(T)):MD(T),1:6) S MDLS(ORD,T)=T ; assign "6" to any undefined code
. S MDLS="" S X="MDLS(0)" F I=1:1 S X=$Q(@X) Q:X="" S MDLS=MDLS_DLM_@X
. S MDLS=$E(MDLS,2,99)
Q MDLS
;
ONLCHK(MAGIEN,USETGA) ;
; Input: MAGIEN: Image pointer
; USETGA: 1/0 -- if 1, forces return of TGA (not .big) file
;Return: ^-delimited pieces:
; 1 - 1/0 for Full-Res image on Mag. Disk that is Online
; 2 - File type (BIG/FULL)
; 3 - Modality
; 4 - Place
; 5 - DFN
; 6 - File Name IFF this image is stored Off-Line (else null)
; 7 - USETGA * as calculated in the logic below
; 8 - PROCDT = Img Processing DtTime
; 9 - ACQSITE = Acquisition site code
; 10 - STANUM = Station Number where Magnetic Network Loc'n exists
; * USETGA is set to False (0) if a low-resolution image (TGA) is
; requested, but none exists; calling routine would call by ref.
;
N BIG,X,NOD,MAG0,MODALITY,RET,PLACE,DFN,FILNAM,MAG2,PROCDT,ACQSITE,MAG100,STANUM
S USETGA=+$G(USETGA) ; Defaults to Full-Resolution image if not defined
S RET="",MODALITY="",PLACE="",ACQSITE="",STANUM=""
S MAG0=^MAG(2005,MAGIEN,0),BIG=$D(^("FBIG")),NOD=$S(BIG:^("FBIG"),1:MAG0)
S MAG2=^MAG(2005,MAGIEN,2),PROCDT=$P(MAG2,U)
S MAG100=$G(^MAG(2005,MAGIEN,100)),ACQSITE=$P(MAG100,U,3)
I USETGA D
. I 'BIG S USETGA=0 ; reply no low-res image available
. I BIG S NOD=MAG0,BIG=0 ; enable correct logic inside this subroutine
S MODALITY=$P(MAG0,U,8),DFN=$P(MAG0,U,7)
I BIG S X=+$P(NOD,U) ; $p 1 is Magnetic Disk/Volume (.big)
E S X=+$P(NOD,U,3) ; $p 3 is Magnetic Disk/Volume (.tga)
I X D
. I '$D(NETLOC(X)) S NETLOC(X)=+$P(^MAG(2005.2,X,0),U,6)_U_$P(^(0),U,10)_U_$$STANUM(X)
. S RET=+NETLOC(X),PLACE=$P(NETLOC(X),U,2),STANUM=$P(NETLOC(X),U,3) ; NETLOC is global to this subrtn
. S FILNAM=""
E D
. S RET=0,FILNAM=$P(MAG0,U,2)
. S T=$S(BIG:$P(NOD,U,2),1:$P(NOD,U,5))
. I T S PLACE=$P(^MAG(2005.2,T,0),U,10)
S RET=RET_U_$S(BIG:"BIG",1:"FULL")_U_MODALITY_U_PLACE_U_DFN_U_FILNAM_U_USETGA_U_PROCDT_U_ACQSITE_U_STANUM
Q RET
;
REMOTE(MAGIEN) ;Return list of remote Cache Locations
; else, return "" if none
N RET,LOC
S RET=""
I $D(^MAG(2005,MAGIEN,4,"LOC")) S LOC=0 D
. F S LOC=$O(^MAG(2005,MAGIEN,4,"LOC",LOC)) Q:'LOC S RET=RET_$S(RET="":"",1:",")_LOC
Q RET
;
STANUM(NETLOC) ; Return Station Number for input Network Location
N X,STANUM
S STANUM=""
I +$G(NETLOC) D
. S X=$P($G(^MAG(2005.2,NETLOC,0)),"^",10)
. I X S STANUM=$$GETSNUM^MAGDQR21(X)
Q STANUM
;
IMGINF2(RARPT,RET,USETGA) ; Fetch info from Image File for input RARPT:
; Input: RARPT: Rad Report pointer
; RET: see below
; USETGA: 1/0 -- if 1, forces return of TGA (not .big) file
; RET holds array of return values:
; RET = # Images stored for the case
; RET(1:n) = ^-delimited pieces:
; 1 - 1/0 for Full-Res image on Mag. Disk that is Online
; 2 - FULL/BIG
; 3 - Modality
; 4 - Image IEN
; 5 - Station #
; 6 - Routed-to Locations (IENs)
; 7 - PLACE
; 8 - DFN
; 9 - FileName (if OffLine)
; 10 - PS_Indicator -- 1=Image is on Magnetic Disk
;
; * This subroutine may be called by other VistARad routines
;
N BIG,IMG,MAGIEN,MAGIEN2,MAGPTR,NETLOC
K RET S RET=0
S USETGA=+$G(USETGA) ; Defaults to Full-Resolution image if not defined
G IMGINF2Q:'RARPT S IMG=0
F S IMG=$O(^RARPT(RARPT,2005,IMG)) Q:'IMG S MAGIEN=$P(^(IMG,0),U) D
. ; use group multiple structure when present
. Q:'$D(^MAG(2005,MAGIEN,0)) S MAGPTR=0
. I '$O(^MAG(2005,MAGIEN,1,MAGPTR)) D Q
. . S T=$$ONLCHK(MAGIEN,USETGA)
. . S RET=RET+1,RET(RET)=$P(T,U,1,3)_U_MAGIEN_U_$P(T,U,10)_U_$$REMOTE(MAGIEN)_U_$P(T,U,4,7)_U_$$PSIND(MAGIEN)_U_$P(T,U,8)_U_$P(T,U,9)
. E F S MAGPTR=$O(^MAG(2005,MAGIEN,1,MAGPTR)) Q:'MAGPTR S MAGIEN2=$P(^(MAGPTR,0),U) D
. . S T=$$ONLCHK(MAGIEN2,USETGA)
. . S RET=RET+1,RET(RET)=$P(T,U,1,3)_U_MAGIEN2_U_$P(T,U,10)_U_$$REMOTE(MAGIEN2)_U_$P(T,U,4,7)_U_$$PSIND(MAGIEN2)_U_$P(T,U,8)_U_$P(T,U,9)
IMGINF2Q ;
Q
;
PSIND(MAGIEN) ; return Presentation State Indicator(s) for image
; K=Key Image PStype; I=Interpretation PStyp; U=User PStyp
N RSL,IEN,X
S RSL="",IEN=0
I $D(^MAG(2005,MAGIEN,210,IEN)) F S IEN=$O(^MAG(2005,MAGIEN,210,IEN)) Q:'IEN S X=$P(^(IEN,0),U,2) Q:RSL[X S RSL=RSL_$S(RSL="":"",1:",")_X
Q:$Q RSL Q
;
JBFETCH(RARPT,MAGS,USETGA,NOFETCH) ; fetch this case's images from Jukebox, if necessary
; Input: RARPT: Rad Report pointer
; MAGS: see below
; USETGA: 1/0 -- if 1, forces return of TGA (not .big) file
; NOFETCH: 1/0 -- if 1, metadata get only so do NOT issue Jukebox retrieve
; This is a function that returns a string containing:
; # Images fetched from JB ^ Total # Images for Case ^ # Low Res Imgs
; The MAGS array will be returned to the calling
; routine if MAGS is provided as an input parameter
; MAGS is populated by call to IMGINF2.
; IF any images are stored OffLine, then this node is set here:
; MAGS("OFFLN",JBOFFLN)="" JBOFFLN = Platter ID from file 2006.033
;
; * This function may be called by other VistARad routines
;
N MAGIEN,FETCH,IMAG,FILNAM,JBOFFLN,LORESCT
S USETGA=+$G(USETGA) ; Defaults to Full-Resolution image if not defined
S NOFETCH=+$G(NOFETCH)
S FETCH=0,LORESCT=0
D IMGINF2(RARPT,.MAGS,USETGA)
I MAGS F IMAG=1:1:MAGS S X=MAGS(IMAG) D
. I USETGA S LORESCT=LORESCT+$P(X,U,10)
. I '+X D ; Call params below depend on Consolidated Site status
. . S FETCH=FETCH+1
. . Q:NOFETCH ; need the count of images on JB, but not retrieving them
. . S FILNAM=$P(X,U,9)
. . I FILNAM]"",$D(^MAGQUEUE(2006.033,"B",FILNAM)) S T=$O(^(FILNAM,"")) S JBOFFLN=$P($G(^MAGQUEUE(2006.033,T,0)),U,2),MAGS("OFFLN",JBOFFLN)="" Q ; OffLine Image
. . I '$G(MAGJOB("CONSOLIDATED")) S X=$$JBTOHD^MAGBAPI($P(X,U,4)_"^"_$P(X,U,2)) ; pre-consolidation vs
. . E S X=$$JBTOHD^MAGBAPI($P(X,U,4)_"^"_$P(X,U,2),$P(X,U,7))
JBFETCHQ Q FETCH_U_MAGS_U_LORESCT
;
END Q ;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGJUTL2 10037 printed Sep 23, 2025@19:43:17 Page 2
MAGJUTL2 ;WIRMFO/JHC/DAC - VistRad subroutines for RPC calls ; 10/17/2022
+1 ;;3.0;IMAGING;**18,65,76,104,120,220,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**
+18 QUIT
IMGINFO(RARPT,RET) ; Fetch info from Image File for input RARPT:
+1 ; Input: RARPT: Rad Report pointer
+2 ; RET contents delimited by ^:
+3 ; CT = # of images for case
+4 ; ONL = Image Storage status (Y=On Magnetic disk, N=Jukebox
+5 ; "n/a" for not available, e.g., film only)
+6 ; note -- if last image in group is Online, considers ALL online
+7 ; MAGDT = Date/Time of Image Capture
+8 ; REMOTE = 1/0 to Indicate images were remotely cached
+9 ; MODALITY = Modality abbrev
+10 ; PLACE = Image storage PLace (ptr to 2006.1 entry)
+11 ; KEY = 1/0 ind. Key Images exist for this exam
+12 ;
+13 NEW IRPT,MAGIEN,MAGIEN2,ONLCHK,NETLOC,STIEN
+14 NEW CT,ONL,MAGDT,REMOTE,MODALITY,PLACE,REMCHK,KEY,TDT
+15 ; init return vars
SET CT=""
SET ONL=""
SET MAGDT=""
SET RET=""
SET REMOTE=""
SET MODALITY=""
SET PLACE=""
SET KEY=0
+16 if 'RARPT
GOTO IMGINFQ
if '$DATA(^RARPT(RARPT,2005,0))
GOTO IMGINFQ
+17 SET STIEN=$$STUDYID^MAGJUPD2("",RARPT,1)
+18 IF STIEN
SET T=$ORDER(^MAG(2005,STIEN,205,0))
IF T
SET KEY=1
+19 SET IRPT=0
FOR
SET IRPT=$ORDER(^RARPT(RARPT,2005,IRPT))
if 'IRPT
QUIT
SET MAGIEN=$PIECE(^(IRPT,0),U)
Begin DoDot:1
+20 if '$DATA(^MAG(2005,MAGIEN,0))
QUIT
+21 ; P220 DAC - Modified to return a date with a timestamp
+22 SET TDT=$PIECE($GET(^MAG(2005,MAGIEN,100)),U,6)
if (TDT="")!($LENGTH(TDT,".")=1)
SET TDT=$PIECE($GET(^(2)),U)
+23 IF TDT
SET MAGDT=$SELECT(MAGDT="":TDT,TDT<MAGDT:TDT,1:MAGDT)
+24 ; last image in group
IF $ORDER(^MAG(2005,MAGIEN,1,0))
SET CT=CT+$PIECE(^(0),U,4)
SET Y=$PIECE(^(0),U,3)
SET MAGIEN2=$PIECE($GET(^(Y,0)),U)
if (MAGIEN2]"")
SET ONLCHK=$$ONLCHK(MAGIEN2)
SET REMCHK=$$REMOTE(MAGIEN2)
+25 IF '$TEST
SET CT=CT+1
SET ONLCHK=$$ONLCHK(MAGIEN)
SET REMCHK=$$REMOTE(MAGIEN)
+26 ; NOT Online if ANY img is 0
SET ONL=$SELECT(ONL="":+ONLCHK,+ONL:+ONLCHK,1:0)
+27 ; NOT Remote if ANY img is 0
SET REMOTE=$SELECT(REMOTE="":REMCHK,+REMOTE:REMCHK,1:0)
+28 SET X=$PIECE(ONLCHK,U,3)
+29 IF MODALITY=""
SET MODALITY=X
+30 IF '$TEST
IF MODALITY'[X
SET MODALITY=MODALITY_","_X
+31 IF PLACE=""
SET PLACE=$PIECE(ONLCHK,U,4)
End DoDot:1
+32 IF MODALITY[","
SET MODALITY=$$MULTMDL(MODALITY,",")
IMGINFQ SET ONL=$SELECT(+ONL:"Y",ONL="":"n/a",1:"N")
+1 SET RET=CT_U_ONL_U_MAGDT_U_REMOTE_U_MODALITY_U_PLACE_U_KEY
+2 QUIT
+3 ;
MULTMDL(MDLS,DLM) ; return multiple modality codes in a preferred sequence for HP lookups
+1 ; input: MDLS: list of modality codes, delimited by DLM
+2 ; return: "normalized" list delimited by DLM
+3 ;
+4 ; The variable STR contains a list of codes, each paired with a numeric
+5 ; priority value--lower number is higher priority. The input MDLS sequence is
+6 ; re-sorted according to the priorities; equivalent priorities are resolved
+7 ; by alphabetic value; "unknown" input codes are give arbitrary value 6
+8 ;
+9 IF $LENGTH(MDLS,DLM)>1
Begin DoDot:1
+10 NEW I,MD,ORD,STR,T,X
+11 SET STR="1^CT|1^MG|1^RF|1^XA|2^MR|3^CR|4^DX|4^BDUS|4^BI|4^BMD|4^DF|4^DS|4^EC|4^MA|4^NM|4^PT|4^RG|4^ST|4^US|4^XC|5^ECG|5^IO|5^IVUS|5^PX|6^DG|6^TG|6^SC|6^VL|7^ES|7^FID|7^GM|7^HD|7^LS|7^XRAY|8^DOC|8^HC|8^OT|8^REG|8^SC|9^KO|9^PR|9^SEG|9^SR|
"
+12 FOR I=1:1
SET X=$PIECE(STR,"|",I)
if X=""
QUIT
SET MD($PIECE(X,U,2))=+X
+13 ; assign "6" to any undefined code
FOR I=1:1:$LENGTH(MDLS,DLM)
SET T=$PIECE(MDLS,DLM,I)
SET ORD=$SELECT($DATA(MD(T)):MD(T),1:6)
SET MDLS(ORD,T)=T
+14 SET MDLS=""
SET X="MDLS(0)"
FOR I=1:1
SET X=$QUERY(@X)
if X=""
QUIT
SET MDLS=MDLS_DLM_@X
+15 SET MDLS=$EXTRACT(MDLS,2,99)
End DoDot:1
+16 QUIT MDLS
+17 ;
ONLCHK(MAGIEN,USETGA) ;
+1 ; Input: MAGIEN: Image pointer
+2 ; USETGA: 1/0 -- if 1, forces return of TGA (not .big) file
+3 ;Return: ^-delimited pieces:
+4 ; 1 - 1/0 for Full-Res image on Mag. Disk that is Online
+5 ; 2 - File type (BIG/FULL)
+6 ; 3 - Modality
+7 ; 4 - Place
+8 ; 5 - DFN
+9 ; 6 - File Name IFF this image is stored Off-Line (else null)
+10 ; 7 - USETGA * as calculated in the logic below
+11 ; 8 - PROCDT = Img Processing DtTime
+12 ; 9 - ACQSITE = Acquisition site code
+13 ; 10 - STANUM = Station Number where Magnetic Network Loc'n exists
+14 ; * USETGA is set to False (0) if a low-resolution image (TGA) is
+15 ; requested, but none exists; calling routine would call by ref.
+16 ;
+17 NEW BIG,X,NOD,MAG0,MODALITY,RET,PLACE,DFN,FILNAM,MAG2,PROCDT,ACQSITE,MAG100,STANUM
+18 ; Defaults to Full-Resolution image if not defined
SET USETGA=+$GET(USETGA)
+19 SET RET=""
SET MODALITY=""
SET PLACE=""
SET ACQSITE=""
SET STANUM=""
+20 SET MAG0=^MAG(2005,MAGIEN,0)
SET BIG=$DATA(^("FBIG"))
SET NOD=$SELECT(BIG:^("FBIG"),1:MAG0)
+21 SET MAG2=^MAG(2005,MAGIEN,2)
SET PROCDT=$PIECE(MAG2,U)
+22 SET MAG100=$GET(^MAG(2005,MAGIEN,100))
SET ACQSITE=$PIECE(MAG100,U,3)
+23 IF USETGA
Begin DoDot:1
+24 ; reply no low-res image available
IF 'BIG
SET USETGA=0
+25 ; enable correct logic inside this subroutine
IF BIG
SET NOD=MAG0
SET BIG=0
End DoDot:1
+26 SET MODALITY=$PIECE(MAG0,U,8)
SET DFN=$PIECE(MAG0,U,7)
+27 ; $p 1 is Magnetic Disk/Volume (.big)
IF BIG
SET X=+$PIECE(NOD,U)
+28 ; $p 3 is Magnetic Disk/Volume (.tga)
IF '$TEST
SET X=+$PIECE(NOD,U,3)
+29 IF X
Begin DoDot:1
+30 IF '$DATA(NETLOC(X))
SET NETLOC(X)=+$PIECE(^MAG(2005.2,X,0),U,6)_U_$PIECE(^(0),U,10)_U_$$STANUM(X)
+31 ; NETLOC is global to this subrtn
SET RET=+NETLOC(X)
SET PLACE=$PIECE(NETLOC(X),U,2)
SET STANUM=$PIECE(NETLOC(X),U,3)
+32 SET FILNAM=""
End DoDot:1
+33 IF '$TEST
Begin DoDot:1
+34 SET RET=0
SET FILNAM=$PIECE(MAG0,U,2)
+35 SET T=$SELECT(BIG:$PIECE(NOD,U,2),1:$PIECE(NOD,U,5))
+36 IF T
SET PLACE=$PIECE(^MAG(2005.2,T,0),U,10)
End DoDot:1
+37 SET RET=RET_U_$SELECT(BIG:"BIG",1:"FULL")_U_MODALITY_U_PLACE_U_DFN_U_FILNAM_U_USETGA_U_PROCDT_U_ACQSITE_U_STANUM
+38 QUIT RET
+39 ;
REMOTE(MAGIEN) ;Return list of remote Cache Locations
+1 ; else, return "" if none
+2 NEW RET,LOC
+3 SET RET=""
+4 IF $DATA(^MAG(2005,MAGIEN,4,"LOC"))
SET LOC=0
Begin DoDot:1
+5 FOR
SET LOC=$ORDER(^MAG(2005,MAGIEN,4,"LOC",LOC))
if 'LOC
QUIT
SET RET=RET_$SELECT(RET="":"",1:",")_LOC
End DoDot:1
+6 QUIT RET
+7 ;
STANUM(NETLOC) ; Return Station Number for input Network Location
+1 NEW X,STANUM
+2 SET STANUM=""
+3 IF +$GET(NETLOC)
Begin DoDot:1
+4 SET X=$PIECE($GET(^MAG(2005.2,NETLOC,0)),"^",10)
+5 IF X
SET STANUM=$$GETSNUM^MAGDQR21(X)
End DoDot:1
+6 QUIT STANUM
+7 ;
IMGINF2(RARPT,RET,USETGA) ; Fetch info from Image File for input RARPT:
+1 ; Input: RARPT: Rad Report pointer
+2 ; RET: see below
+3 ; USETGA: 1/0 -- if 1, forces return of TGA (not .big) file
+4 ; RET holds array of return values:
+5 ; RET = # Images stored for the case
+6 ; RET(1:n) = ^-delimited pieces:
+7 ; 1 - 1/0 for Full-Res image on Mag. Disk that is Online
+8 ; 2 - FULL/BIG
+9 ; 3 - Modality
+10 ; 4 - Image IEN
+11 ; 5 - Station #
+12 ; 6 - Routed-to Locations (IENs)
+13 ; 7 - PLACE
+14 ; 8 - DFN
+15 ; 9 - FileName (if OffLine)
+16 ; 10 - PS_Indicator -- 1=Image is on Magnetic Disk
+17 ;
+18 ; * This subroutine may be called by other VistARad routines
+19 ;
+20 NEW BIG,IMG,MAGIEN,MAGIEN2,MAGPTR,NETLOC
+21 KILL RET
SET RET=0
+22 ; Defaults to Full-Resolution image if not defined
SET USETGA=+$GET(USETGA)
+23 if 'RARPT
GOTO IMGINF2Q
SET IMG=0
+24 FOR
SET IMG=$ORDER(^RARPT(RARPT,2005,IMG))
if 'IMG
QUIT
SET MAGIEN=$PIECE(^(IMG,0),U)
Begin DoDot:1
+25 ; use group multiple structure when present
+26 if '$DATA(^MAG(2005,MAGIEN,0))
QUIT
SET MAGPTR=0
+27 IF '$ORDER(^MAG(2005,MAGIEN,1,MAGPTR))
Begin DoDot:2
+28 SET T=$$ONLCHK(MAGIEN,USETGA)
+29 SET RET=RET+1
SET RET(RET)=$PIECE(T,U,1,3)_U_MAGIEN_U_$PIECE(T,U,10)_U_$$REMOTE(MAGIEN)_U_$PIECE(T,U,4,7)_U_$$PSIND(MAGIEN)_U_$PIECE(T,U,8)_U_$PIECE(T,U,9)
End DoDot:2
QUIT
+30 IF '$TEST
FOR
SET MAGPTR=$ORDER(^MAG(2005,MAGIEN,1,MAGPTR))
if 'MAGPTR
QUIT
SET MAGIEN2=$PIECE(^(MAGPTR,0),U)
Begin DoDot:2
+31 SET T=$$ONLCHK(MAGIEN2,USETGA)
+32 SET RET=RET+1
SET RET(RET)=$PIECE(T,U,1,3)_U_MAGIEN2_U_$PIECE(T,U,10)_U_$$REMOTE(MAGIEN2)_U_$PIECE(T,U,4,7)_U_$$PSIND(MAGIEN2)_U_$PIECE(T,U,8)_U_$PIECE(T,U,9)
End DoDot:2
End DoDot:1
IMGINF2Q ;
+1 QUIT
+2 ;
PSIND(MAGIEN) ; return Presentation State Indicator(s) for image
+1 ; K=Key Image PStype; I=Interpretation PStyp; U=User PStyp
+2 NEW RSL,IEN,X
+3 SET RSL=""
SET IEN=0
+4 IF $DATA(^MAG(2005,MAGIEN,210,IEN))
FOR
SET IEN=$ORDER(^MAG(2005,MAGIEN,210,IEN))
if 'IEN
QUIT
SET X=$PIECE(^(IEN,0),U,2)
if RSL[X
QUIT
SET RSL=RSL_$SELECT(RSL="":"",1:",")_X
+5 if $QUIT
QUIT RSL
QUIT
+6 ;
JBFETCH(RARPT,MAGS,USETGA,NOFETCH) ; fetch this case's images from Jukebox, if necessary
+1 ; Input: RARPT: Rad Report pointer
+2 ; MAGS: see below
+3 ; USETGA: 1/0 -- if 1, forces return of TGA (not .big) file
+4 ; NOFETCH: 1/0 -- if 1, metadata get only so do NOT issue Jukebox retrieve
+5 ; This is a function that returns a string containing:
+6 ; # Images fetched from JB ^ Total # Images for Case ^ # Low Res Imgs
+7 ; The MAGS array will be returned to the calling
+8 ; routine if MAGS is provided as an input parameter
+9 ; MAGS is populated by call to IMGINF2.
+10 ; IF any images are stored OffLine, then this node is set here:
+11 ; MAGS("OFFLN",JBOFFLN)="" JBOFFLN = Platter ID from file 2006.033
+12 ;
+13 ; * This function may be called by other VistARad routines
+14 ;
+15 NEW MAGIEN,FETCH,IMAG,FILNAM,JBOFFLN,LORESCT
+16 ; Defaults to Full-Resolution image if not defined
SET USETGA=+$GET(USETGA)
+17 SET NOFETCH=+$GET(NOFETCH)
+18 SET FETCH=0
SET LORESCT=0
+19 DO IMGINF2(RARPT,.MAGS,USETGA)
+20 IF MAGS
FOR IMAG=1:1:MAGS
SET X=MAGS(IMAG)
Begin DoDot:1
+21 IF USETGA
SET LORESCT=LORESCT+$PIECE(X,U,10)
+22 ; Call params below depend on Consolidated Site status
IF '+X
Begin DoDot:2
+23 SET FETCH=FETCH+1
+24 ; need the count of images on JB, but not retrieving them
if NOFETCH
QUIT
+25 SET FILNAM=$PIECE(X,U,9)
+26 ; OffLine Image
IF FILNAM]""
IF $DATA(^MAGQUEUE(2006.033,"B",FILNAM))
SET T=$ORDER(^(FILNAM,""))
SET JBOFFLN=$PIECE($GET(^MAGQUEUE(2006.033,T,0)),U,2)
SET MAGS("OFFLN",JBOFFLN)=""
QUIT
+27 ; pre-consolidation vs
IF '$GET(MAGJOB("CONSOLIDATED"))
SET X=$$JBTOHD^MAGBAPI($PIECE(X,U,4)_"^"_$PIECE(X,U,2))
+28 IF '$TEST
SET X=$$JBTOHD^MAGBAPI($PIECE(X,U,4)_"^"_$PIECE(X,U,2),$PIECE(X,U,7))
End DoDot:2
End DoDot:1
JBFETCHQ QUIT FETCH_U_MAGS_U_LORESCT
+1 ;
END ;
QUIT
