MAGJEX3 ;WIRMFO/JHC VistaRad RPCs-Get PS & KEY Img data ; 1 Nov 2004 10:05 AM
;;3.0;IMAGING;**18**;Mar 07, 2006
;; +---------------------------------------------------------------+
;; | 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. |
;; +---------------------------------------------------------------+
;;
Q
ERR N ERR S ERR=$$EC^%ZOSV S @MAGGRY@(0)="0^4~"_ERR
D @^%ZOSF("ERRTN")
Q:$Q 1 Q
;
RPCIN(MAGGRY,PARAMS,DATA) ; RPC: MAGJ STUDY_DATA
; Retrieve Key Image and/or Presentation State data for an Exam
; PARAMS--TXID ^ DFN ^ DTI ^ CNI ^ RARPT ^ MAGIEN ^ PSDETAIL
; TXID: Required; designates action to take:
; 1 -- Key Image only
; 2 -- Interp Images only
; 3 -- Key and Interp Images
; 4 -- PS data for input (in DATA): ImgIEN & PS_UID or PS_Indicators
;
; For TXID 1, 2, 3 either RARPT or MAGIEN is required to identify the exam
; PSDETAIL--1/0; 1=Include PS data for above
; RARPT--Rad report pointer; IMGIEN--can be Image or Group IEN
; DATA--required for TXID=4 --array of input DATA: IMGIEN ^ [PSUID] ^ [PSIND]
; If both PSUID and PSIND appear, the PSIND is IGNORED
;
; Results returned in @MAGGRY
;
N $ETRAP,$ESTACK S $ETRAP="D ERR^MAGJEX3"
N REPLY,MAGLST,DIQUIET,TXID,RARPT,MAGIEN,STIEN,IMGIEN,PSUID,PSIND
N PSDETAIL,COUNTS,IMGCT,KEYCT,PSCT,INTCT,STRPT,KEYINT,PSLS,CT
S MAGLST="MAGJRPC" K MAGGRY S MAGGRY=$NA(^TMP($J,MAGLST)) K @MAGGRY
; Note--return data is stored with indirection references to MAGGRY
S DIQUIET=1 D DT^DICRW
S TXID=+PARAMS,STRPT=""
I '(TXID>0&(TXID<5)) S REPLY="0~Invalid transaction (TX="_TXID_") requested by MAGJ STUDYDATA rpc call." G RPCINZ
S RARPT=$P(PARAMS,U,5),MAGIEN=$P(PARAMS,U,6),PSDETAIL=+$P(PARAMS,U,7)
S CT=0,PSCT=0
I TXID<4 D G RPCINZ
. S STIEN=$$STUDYID^MAGJUPD2(MAGIEN,RARPT,1)
. S STRPT=$S(RARPT:RARPT,1:$P($$GETRPT^MAGJUPD2(MAGIEN),U))
. I TXID=3 S KEYINT="KI" ; Key & Interp Images
. E I TXID=1 S KEYINT="K" ; Key Images
. E I TXID=2 S KEYINT="I" ; Interp Images
. D GETDAT("PSLS",STIEN,KEYINT)
. D GETKEY("@MAGGRY",.CT,PSDETAIL,.COUNTS)
. S IMGCT=+COUNTS,KEYCT=+$P(COUNTS,U,2),INTCT=+$P(COUNTS,U,3),PSCT=+$P(COUNTS,U,4)
. I 'KEYCT,'INTCT S REPLY="1~No Key/Interpretation Images defined for exam." Q
. S REPLY=1_"~: "
. S REPLY=REPLY_PSCT_" PS def"_$S(PSCT-1:"s",1:"")_" for "
. S REPLY=REPLY_KEYCT_" Key Image"_$S(KEYCT-1:"s",1:"")_"; "_INTCT_" Interpretation Image"_$S(INTCT-1:"s",1:"")_"; "_IMGCT_" Image"_$S(IMGCT-1:"s",1:"")_" checked."
;
I TXID=4 D ; PS data for input ImgIEN & PS_UID or PS_Inds
. S IDATA="",IMGCT=0
. F S IDATA=$O(DATA(IDATA)) Q:IDATA="" S X=DATA(IDATA) I X]"" D
. . S IMGIEN=$P(X,U),PSUID=$P(X,U,2),PSIND=$P(X,U,3),IMGCT=IMGCT+1,COUNTS=0
. . I PSUID]"" S PSIND="" ; ignore psind if uid is supplied
. . I 'STRPT S STRPT=$P($$GETRPT^MAGJUPD2(IMGIEN),U)
. . E I STRPT'=$P($$GETRPT^MAGJUPD2(IMGIEN),U) Q ; don't intermix diff. studies, but continue
. . I '((PSUID]""!(PSIND]""))&IMGIEN) S REPLY="0~For MAGJ STUDYDATA (TX="_TXID_") invalid params passed to rpc call." Q
. . I PSUID]"" D GETPSID1("@MAGGRY",.CT,IMGIEN,PSUID,.COUNTS)
. . E I PSIND]"" D GETPSID2("@MAGGRY",.CT,IMGIEN,PSIND,.COUNTS)
. . S PSCT=PSCT+COUNTS
. . S REPLY=1_"~: "_PSCT_" PS def"_$S(PSCT-1:"s",1:"")_" for "_IMGCT_" Image"_$S(IMGCT-1:"s",1:"")_" checked."
RPCINZ S @MAGGRY@(0)=CT_U_REPLY
Q
;
GETKEY(RET,CT,PSFLAG,COUNTS) ; Get Key images for study STIEN w/ PS refs
; Results returned by indirection in array @RET, indexed by CT
; if PSFLAG is true, return Pres State data
; COUNTS contains ^-delim list of various counts (see below)
;
N IMGIEN,UID,IMGCT,KEYCT,PSCT,INTCT,TYPE,IMGTRAK,LASTIMG,QREF
S CT=+$G(CT),PSFLAG=+$G(PSFLAG),(IMGCT,KEYCT,PSCT,INTCT)=0
I 'STIEN G GETKEYZ
S QREF="PSLS",LASTIMG=0
F S QREF=$Q(@QREF) Q:QREF="" S X=@QREF D
. S IMGIEN=+X,UID=$P(X,U,2),TYPE=$P(X,U,3)
. I IMGIEN'=LASTIMG D
. . I LASTIMG S CT=CT+1,@RET@(CT)="*END_IMAGE"
. . S CT=CT+1,@RET@(CT)="*IMAGE"
. . S CT=CT+1,@RET@(CT)=IMGIEN_U
. . S LASTIMG=IMGIEN S IMGCT=IMGCT+'$D(IMGTRAK(IMGIEN)),IMGTRAK(IMGIEN)=""
. Q:UID=""
. S CT=CT+1,@RET@(CT)="*PS",PSCT=PSCT+1
. S CT=CT+1,@RET@(CT)=UID_U_$S(TYPE="K":"KEY",TYPE="I":"INTERP",1:TYPE)
. I PSFLAG D GETPSDAT(.RET,.CT,IMGIEN,UID)
. S CT=CT+1,@RET@(CT)="*END_PS"
. I TYPE="K" S KEYCT=KEYCT+1
. I TYPE="I" S INTCT=INTCT+1
I LASTIMG S CT=CT+1,@RET@(CT)="*END_IMAGE"
GETKEYZ S COUNTS=IMGCT_U_KEYCT_U_INTCT_U_PSCT
Q
;
;
GETDAT(RET,STIEN,KEYINT) ; Get data for Key Interp images for study STIEN
; Results returned by indirection in array @RET
N IMGIEN,UID,KIEN,PSIEN,STUDYREF,PSCT,TYPE,SEQNUM
S PSCT=0
I 'STIEN G GETDATZ
S STUDYREF=$NA(^MAG(2005.001,STIEN))
S KIEN=0
F S KIEN=$O(@STUDYREF@(1,KIEN)) Q:'KIEN S IMGIEN=$P($G(^(KIEN,0)),U),PSIEN=0 D
. F S PSIEN=$O(@STUDYREF@(1,KIEN,1,PSIEN)) Q:'PSIEN S X=$G(^(PSIEN,0)) D
. . S UID=$P(X,U),TYPE=$P(X,U,2),SEQNUM=$P(X,U,3),PSCT=PSCT+1
. . I UID]"" S:TYPE="" TYPE="I" S:SEQNUM="" SEQNUM=PSCT+10000
. . E Q
. . I TYPE="K",(KEYINT[TYPE) S @RET@(TYPE,SEQNUM,IMGIEN)=IMGIEN_U_UID_U_TYPE
. . I TYPE="I",(KEYINT[TYPE) S @RET@(TYPE,IMGIEN,SEQNUM)=IMGIEN_U_UID_U_TYPE
GETDATZ Q
;
;
GETPSDAT(RET,CT,IMGIEN,UID) ; Get PS text lines for input IMGIEN & UID
; Results returned by indirection in array @RET, indexed by CT
;
N IMGREF,UIDIEN,IEN
S CT=+$G(CT),UID=$G(UID)
I '(UID]""&IMGIEN) G GETPSDAZ
S IMGREF=$NA(^MAG(2005,IMGIEN))
S UIDIEN=$O(@IMGREF@(210,"B",UID,"")) Q:'UIDIEN S IEN=0 D
. F S IEN=$O(@IMGREF@(210,UIDIEN,1,IEN)) Q:'IEN S CT=CT+1,@RET@(CT)=^(IEN,0)
GETPSDAZ Q
;
GETPSID1(RET,CT,IMGIEN,PSUID,HIT) ; For input IMGIEN & PSUID, return PS data
; Results returned by indirection in array @RET, indexed by CT
; HIT=1 if the image has a PS_UID stored
N X,TYP,IEN
S CT=+$G(CT),HIT=0
I '(PSUID]""&IMGIEN) G GETPSI1Z
S IMGREF=$NA(^MAG(2005,IMGIEN))
S IEN=$O(@IMGREF@(210,"B",PSUID,"")) I 'IEN G GETPSI1Z
S TYP=$P(@IMGREF@(210,IEN,0),U,2)
S CT=CT+1,@RET@(CT)="*IMAGE",HIT=1
S CT=CT+1,@RET@(CT)=IMGIEN_U
S CT=CT+1,@RET@(CT)="*PS"
S CT=CT+1,@RET@(CT)=PSUID_U_$S(TYP="K":"KEY",TYP="I":"INTERP",1:TYP)
D GETPSDAT(.RET,.CT,IMGIEN,PSUID)
S CT=CT+1,@RET@(CT)="*END_PS"
S CT=CT+1,@RET@(CT)="*END_IMAGE"
GETPSI1Z Q
;
GETPSID2(RET,CT,IMGIEN,PSIND,HIT) ; For input IMGIEN & PSIND, return PS data
; Results returned by indirection in array @RET, indexed by CT
; HIT= incremented for each image with a PS stored for input psind
N X,TYP,IEN
S CT=+$G(CT),HIT=0
I '(PSIND]""&IMGIEN) G GETPSI2Z
S IMGREF=$NA(^MAG(2005,IMGIEN)),IEN=0
F S IEN=$O(@IMGREF@(210,IEN)) Q:'IEN S X=^(IEN,0),PSUID=$P(X,U),TYP=$P(X,U,2) I PSIND[TYP D
. I 'HIT D
. . S CT=CT+1,@RET@(CT)="*IMAGE"
. . S CT=CT+1,@RET@(CT)=IMGIEN_U
. S CT=CT+1,@RET@(CT)="*PS"
. S CT=CT+1,@RET@(CT)=PSUID_U_$S(TYP="K":"KEY",TYP="I":"INTERP",1:TYP)
. S HIT=HIT+1
. D GETPSDAT(.RET,.CT,IMGIEN,PSUID)
. S CT=CT+1,@RET@(CT)="*END_PS"
I HIT S CT=CT+1,@RET@(CT)="*END_IMAGE"
GETPSI2Z Q
;
END ;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGJEX3 7876 printed Apr 09, 2024@21:02:58 Page 2
MAGJEX3 ;WIRMFO/JHC VistaRad RPCs-Get PS & KEY Img data ; 1 Nov 2004 10:05 AM
+1 ;;3.0;IMAGING;**18**;Mar 07, 2006
+2 ;; +---------------------------------------------------------------+
+3 ;; | Property of the US Government. |
+4 ;; | No permission to copy or redistribute this software is given. |
+5 ;; | Use of unreleased versions of this software requires the user |
+6 ;; | to execute a written test agreement with the VistA Imaging |
+7 ;; | Development Office of the Department of Veterans Affairs, |
+8 ;; | telephone (301) 734-0100. |
+9 ;; | |
+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 QUIT
ERR NEW ERR
SET ERR=$$EC^%ZOSV
SET @MAGGRY@(0)="0^4~"_ERR
+1 DO @^%ZOSF("ERRTN")
+2 if $QUIT
QUIT 1
QUIT
+3 ;
RPCIN(MAGGRY,PARAMS,DATA) ; RPC: MAGJ STUDY_DATA
+1 ; Retrieve Key Image and/or Presentation State data for an Exam
+2 ; PARAMS--TXID ^ DFN ^ DTI ^ CNI ^ RARPT ^ MAGIEN ^ PSDETAIL
+3 ; TXID: Required; designates action to take:
+4 ; 1 -- Key Image only
+5 ; 2 -- Interp Images only
+6 ; 3 -- Key and Interp Images
+7 ; 4 -- PS data for input (in DATA): ImgIEN & PS_UID or PS_Indicators
+8 ;
+9 ; For TXID 1, 2, 3 either RARPT or MAGIEN is required to identify the exam
+10 ; PSDETAIL--1/0; 1=Include PS data for above
+11 ; RARPT--Rad report pointer; IMGIEN--can be Image or Group IEN
+12 ; DATA--required for TXID=4 --array of input DATA: IMGIEN ^ [PSUID] ^ [PSIND]
+13 ; If both PSUID and PSIND appear, the PSIND is IGNORED
+14 ;
+15 ; Results returned in @MAGGRY
+16 ;
+17 NEW $ETRAP,$ESTACK
SET $ETRAP="D ERR^MAGJEX3"
+18 NEW REPLY,MAGLST,DIQUIET,TXID,RARPT,MAGIEN,STIEN,IMGIEN,PSUID,PSIND
+19 NEW PSDETAIL,COUNTS,IMGCT,KEYCT,PSCT,INTCT,STRPT,KEYINT,PSLS,CT
+20 SET MAGLST="MAGJRPC"
KILL MAGGRY
SET MAGGRY=$NAME(^TMP($JOB,MAGLST))
KILL @MAGGRY
+21 ; Note--return data is stored with indirection references to MAGGRY
+22 SET DIQUIET=1
DO DT^DICRW
+23 SET TXID=+PARAMS
SET STRPT=""
+24 IF '(TXID>0&(TXID<5))
SET REPLY="0~Invalid transaction (TX="_TXID_") requested by MAGJ STUDYDATA rpc call."
GOTO RPCINZ
+25 SET RARPT=$PIECE(PARAMS,U,5)
SET MAGIEN=$PIECE(PARAMS,U,6)
SET PSDETAIL=+$PIECE(PARAMS,U,7)
+26 SET CT=0
SET PSCT=0
+27 IF TXID<4
Begin DoDot:1
+28 SET STIEN=$$STUDYID^MAGJUPD2(MAGIEN,RARPT,1)
+29 SET STRPT=$SELECT(RARPT:RARPT,1:$PIECE($$GETRPT^MAGJUPD2(MAGIEN),U))
+30 ; Key & Interp Images
IF TXID=3
SET KEYINT="KI"
+31 ; Key Images
IF '$TEST
IF TXID=1
SET KEYINT="K"
+32 ; Interp Images
IF '$TEST
IF TXID=2
SET KEYINT="I"
+33 DO GETDAT("PSLS",STIEN,KEYINT)
+34 DO GETKEY("@MAGGRY",.CT,PSDETAIL,.COUNTS)
+35 SET IMGCT=+COUNTS
SET KEYCT=+$PIECE(COUNTS,U,2)
SET INTCT=+$PIECE(COUNTS,U,3)
SET PSCT=+$PIECE(COUNTS,U,4)
+36 IF 'KEYCT
IF 'INTCT
SET REPLY="1~No Key/Interpretation Images defined for exam."
QUIT
+37 SET REPLY=1_"~: "
+38 SET REPLY=REPLY_PSCT_" PS def"_$SELECT(PSCT-1:"s",1:"")_" for "
+39 SET REPLY=REPLY_KEYCT_" Key Image"_$SELECT(KEYCT-1:"s",1:"")_"; "_INTCT_" Interpretation Image"_$SELECT(INTCT-1:"s",1:"")_"; "_IMGCT_" Image"_$SELECT(IMGCT-1:"s",1:"")_" checked."
End DoDot:1
GOTO RPCINZ
+40 ;
+41 ; PS data for input ImgIEN & PS_UID or PS_Inds
IF TXID=4
Begin DoDot:1
+42 SET IDATA=""
SET IMGCT=0
+43 FOR
SET IDATA=$ORDER(DATA(IDATA))
if IDATA=""
QUIT
SET X=DATA(IDATA)
IF X]""
Begin DoDot:2
+44 SET IMGIEN=$PIECE(X,U)
SET PSUID=$PIECE(X,U,2)
SET PSIND=$PIECE(X,U,3)
SET IMGCT=IMGCT+1
SET COUNTS=0
+45 ; ignore psind if uid is supplied
IF PSUID]""
SET PSIND=""
+46 IF 'STRPT
SET STRPT=$PIECE($$GETRPT^MAGJUPD2(IMGIEN),U)
+47 ; don't intermix diff. studies, but continue
IF '$TEST
IF STRPT'=$PIECE($$GETRPT^MAGJUPD2(IMGIEN),U)
QUIT
+48 IF '((PSUID]""!(PSIND]""))&IMGIEN)
SET REPLY="0~For MAGJ STUDYDATA (TX="_TXID_") invalid params passed to rpc call."
QUIT
+49 IF PSUID]""
DO GETPSID1("@MAGGRY",.CT,IMGIEN,PSUID,.COUNTS)
+50 IF '$TEST
IF PSIND]""
DO GETPSID2("@MAGGRY",.CT,IMGIEN,PSIND,.COUNTS)
+51 SET PSCT=PSCT+COUNTS
+52 SET REPLY=1_"~: "_PSCT_" PS def"_$SELECT(PSCT-1:"s",1:"")_" for "_IMGCT_" Image"_$SELECT(IMGCT-1:"s",1:"")_" checked."
End DoDot:2
End DoDot:1
RPCINZ SET @MAGGRY@(0)=CT_U_REPLY
+1 QUIT
+2 ;
GETKEY(RET,CT,PSFLAG,COUNTS) ; Get Key images for study STIEN w/ PS refs
+1 ; Results returned by indirection in array @RET, indexed by CT
+2 ; if PSFLAG is true, return Pres State data
+3 ; COUNTS contains ^-delim list of various counts (see below)
+4 ;
+5 NEW IMGIEN,UID,IMGCT,KEYCT,PSCT,INTCT,TYPE,IMGTRAK,LASTIMG,QREF
+6 SET CT=+$GET(CT)
SET PSFLAG=+$GET(PSFLAG)
SET (IMGCT,KEYCT,PSCT,INTCT)=0
+7 IF 'STIEN
GOTO GETKEYZ
+8 SET QREF="PSLS"
SET LASTIMG=0
+9 FOR
SET QREF=$QUERY(@QREF)
if QREF=""
QUIT
SET X=@QREF
Begin DoDot:1
+10 SET IMGIEN=+X
SET UID=$PIECE(X,U,2)
SET TYPE=$PIECE(X,U,3)
+11 IF IMGIEN'=LASTIMG
Begin DoDot:2
+12 IF LASTIMG
SET CT=CT+1
SET @RET@(CT)="*END_IMAGE"
+13 SET CT=CT+1
SET @RET@(CT)="*IMAGE"
+14 SET CT=CT+1
SET @RET@(CT)=IMGIEN_U
+15 SET LASTIMG=IMGIEN
SET IMGCT=IMGCT+'$DATA(IMGTRAK(IMGIEN))
SET IMGTRAK(IMGIEN)=""
End DoDot:2
+16 if UID=""
QUIT
+17 SET CT=CT+1
SET @RET@(CT)="*PS"
SET PSCT=PSCT+1
+18 SET CT=CT+1
SET @RET@(CT)=UID_U_$SELECT(TYPE="K":"KEY",TYPE="I":"INTERP",1:TYPE)
+19 IF PSFLAG
DO GETPSDAT(.RET,.CT,IMGIEN,UID)
+20 SET CT=CT+1
SET @RET@(CT)="*END_PS"
+21 IF TYPE="K"
SET KEYCT=KEYCT+1
+22 IF TYPE="I"
SET INTCT=INTCT+1
End DoDot:1
+23 IF LASTIMG
SET CT=CT+1
SET @RET@(CT)="*END_IMAGE"
GETKEYZ SET COUNTS=IMGCT_U_KEYCT_U_INTCT_U_PSCT
+1 QUIT
+2 ;
+3 ;
GETDAT(RET,STIEN,KEYINT) ; Get data for Key Interp images for study STIEN
+1 ; Results returned by indirection in array @RET
+2 NEW IMGIEN,UID,KIEN,PSIEN,STUDYREF,PSCT,TYPE,SEQNUM
+3 SET PSCT=0
+4 IF 'STIEN
GOTO GETDATZ
+5 SET STUDYREF=$NAME(^MAG(2005.001,STIEN))
+6 SET KIEN=0
+7 FOR
SET KIEN=$ORDER(@STUDYREF@(1,KIEN))
if 'KIEN
QUIT
SET IMGIEN=$PIECE($GET(^(KIEN,0)),U)
SET PSIEN=0
Begin DoDot:1
+8 FOR
SET PSIEN=$ORDER(@STUDYREF@(1,KIEN,1,PSIEN))
if 'PSIEN
QUIT
SET X=$GET(^(PSIEN,0))
Begin DoDot:2
+9 SET UID=$PIECE(X,U)
SET TYPE=$PIECE(X,U,2)
SET SEQNUM=$PIECE(X,U,3)
SET PSCT=PSCT+1
+10 IF UID]""
if TYPE=""
SET TYPE="I"
if SEQNUM=""
SET SEQNUM=PSCT+10000
+11 IF '$TEST
QUIT
+12 IF TYPE="K"
IF (KEYINT[TYPE)
SET @RET@(TYPE,SEQNUM,IMGIEN)=IMGIEN_U_UID_U_TYPE
+13 IF TYPE="I"
IF (KEYINT[TYPE)
SET @RET@(TYPE,IMGIEN,SEQNUM)=IMGIEN_U_UID_U_TYPE
End DoDot:2
End DoDot:1
GETDATZ QUIT
+1 ;
+2 ;
GETPSDAT(RET,CT,IMGIEN,UID) ; Get PS text lines for input IMGIEN & UID
+1 ; Results returned by indirection in array @RET, indexed by CT
+2 ;
+3 NEW IMGREF,UIDIEN,IEN
+4 SET CT=+$GET(CT)
SET UID=$GET(UID)
+5 IF '(UID]""&IMGIEN)
GOTO GETPSDAZ
+6 SET IMGREF=$NAME(^MAG(2005,IMGIEN))
+7 SET UIDIEN=$ORDER(@IMGREF@(210,"B",UID,""))
if 'UIDIEN
QUIT
SET IEN=0
Begin DoDot:1
+8 FOR
SET IEN=$ORDER(@IMGREF@(210,UIDIEN,1,IEN))
if 'IEN
QUIT
SET CT=CT+1
SET @RET@(CT)=^(IEN,0)
End DoDot:1
GETPSDAZ QUIT
+1 ;
GETPSID1(RET,CT,IMGIEN,PSUID,HIT) ; For input IMGIEN & PSUID, return PS data
+1 ; Results returned by indirection in array @RET, indexed by CT
+2 ; HIT=1 if the image has a PS_UID stored
+3 NEW X,TYP,IEN
+4 SET CT=+$GET(CT)
SET HIT=0
+5 IF '(PSUID]""&IMGIEN)
GOTO GETPSI1Z
+6 SET IMGREF=$NAME(^MAG(2005,IMGIEN))
+7 SET IEN=$ORDER(@IMGREF@(210,"B",PSUID,""))
IF 'IEN
GOTO GETPSI1Z
+8 SET TYP=$PIECE(@IMGREF@(210,IEN,0),U,2)
+9 SET CT=CT+1
SET @RET@(CT)="*IMAGE"
SET HIT=1
+10 SET CT=CT+1
SET @RET@(CT)=IMGIEN_U
+11 SET CT=CT+1
SET @RET@(CT)="*PS"
+12 SET CT=CT+1
SET @RET@(CT)=PSUID_U_$SELECT(TYP="K":"KEY",TYP="I":"INTERP",1:TYP)
+13 DO GETPSDAT(.RET,.CT,IMGIEN,PSUID)
+14 SET CT=CT+1
SET @RET@(CT)="*END_PS"
+15 SET CT=CT+1
SET @RET@(CT)="*END_IMAGE"
GETPSI1Z QUIT
+1 ;
GETPSID2(RET,CT,IMGIEN,PSIND,HIT) ; For input IMGIEN & PSIND, return PS data
+1 ; Results returned by indirection in array @RET, indexed by CT
+2 ; HIT= incremented for each image with a PS stored for input psind
+3 NEW X,TYP,IEN
+4 SET CT=+$GET(CT)
SET HIT=0
+5 IF '(PSIND]""&IMGIEN)
GOTO GETPSI2Z
+6 SET IMGREF=$NAME(^MAG(2005,IMGIEN))
SET IEN=0
+7 FOR
SET IEN=$ORDER(@IMGREF@(210,IEN))
if 'IEN
QUIT
SET X=^(IEN,0)
SET PSUID=$PIECE(X,U)
SET TYP=$PIECE(X,U,2)
IF PSIND[TYP
Begin DoDot:1
+8 IF 'HIT
Begin DoDot:2
+9 SET CT=CT+1
SET @RET@(CT)="*IMAGE"
+10 SET CT=CT+1
SET @RET@(CT)=IMGIEN_U
End DoDot:2
+11 SET CT=CT+1
SET @RET@(CT)="*PS"
+12 SET CT=CT+1
SET @RET@(CT)=PSUID_U_$SELECT(TYP="K":"KEY",TYP="I":"INTERP",1:TYP)
+13 SET HIT=HIT+1
+14 DO GETPSDAT(.RET,.CT,IMGIEN,PSUID)
+15 SET CT=CT+1
SET @RET@(CT)="*END_PS"
End DoDot:1
+16 IF HIT
SET CT=CT+1
SET @RET@(CT)="*END_IMAGE"
GETPSI2Z QUIT
+1 ;
END ;
