MAGDQR21 ;WOIFO/EDM,NST,MLH,JSL,SAF,BT,ZEB - RPCs for Query/Retrieve SetUp ; 07 DEC,2023@1:22 PM
;;3.0;IMAGING;**83,104,123,119,221,348**;Mar 19, 2002;Build 6;Apr 19, 2013
;; 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. |
;; +---------------------------------------------------------------+
;;
Q
;
GET(OUT,DEST,GATEWAY) ; RPC = MAG GET DICOM DEST
N D0,D1,N,OK,X
I $G(DEST)="" D Q
. S N=1
. S X="" F S X=$O(^MAG(2006.587,"B",X)) Q:X="" S N=N+1,OUT(N)="B^"_X
. S X="" F S X=$O(^MAG(2006.587,"D",X)) Q:X="" S N=N+1,OUT(N)="D^"_X
. S OUT(1)=N
. Q
;
S GATEWAY=$G(GATEWAY) S:GATEWAY="--All DICOM Gateways--" GATEWAY=""
S D0=0,OK=0 F S D0=$O(^MAG(2006.587,D0)) Q:'D0 D Q:OK
. S X=$G(^MAG(2006.587,D0,0))
. Q:$P(X,"^",1)'=DEST
. I GATEWAY'="",$P(X,"^",5)'=GATEWAY Q
. S OK=1,N=6
. S OUT(2)="2^"_$P(X,"^",2)
. S OUT(3)="3^"_$P(X,"^",3)
. S OUT(4)="4^"_$P(X,"^",4)
. S OUT(5)="5^"_$P(X,"^",6)
. S OUT(6)="6^"_$P(X,"^",7)
. S D1=0 F S D1=$O(^MAG(2006.587,D0,1,D1)) Q:'D1 D
. . S X=$G(^MAG(2006.587,D0,1,D1,0)) Q:$P(X,"^",1)=""
. . S N=N+1,OUT(N)=X
. . Q
. Q
S OUT(1)=N
Q
;
SET(OUT,DATA,DEST,GATEWAY) ; RPC = MAG SET DICOM DEST
N D0,D1,I,N,P,Q,O1,O5,O7,OK,T,X
I $G(DEST)="" S OUT="-1,No Destination Specified." Q
;
S I="" F S I=$O(DATA(I)) Q:I="" D
. S T=DATA(I) Q:T'["^"
. I +T=2 S P(2)=$P(T,"^",2) Q
. I +T=3 S P(3)=$P(T,"^",2) Q
. I +T=4 S P(4)=$P(T,"^",2) Q
. I +T=5 S P(6)=$P(T,"^",2) Q
. I +T=6 S P(7)=$P(T,"^",2) Q
. S Q($P(T,"^",1))=(+$P(T,"^",2))_"^"_(+$P(T,"^",3))
. Q
;
S OUT=0
S GATEWAY=$G(GATEWAY) S:GATEWAY="--All DICOM Gateways--" GATEWAY=""
S D0=0,OK=0 F S D0=$O(^MAG(2006.587,D0)) Q:'D0 D Q:OK
. S X=$G(^MAG(2006.587,D0,0)),O1=$P(X,"^",1),O5=$P(X,"^",5),O7=$P(X,"^",7)
. Q:O1'=DEST
. I GATEWAY'="",O5'=GATEWAY Q
. S:GATEWAY'="" OK=1 S OUT=OUT+1
. I O1'="",O5'="",O7'="" K ^MAG(2006.587,"C",O1,O7,O5,D0)
. I O5'="",O7'="" K ^MAG(2006.587,"D",O5,O7,D0)
. S I="" F S I=$O(P(I)) Q:I="" S:P(I)'="" $P(X,"^",I)=P(I)
. S:$G(P(7))'="" O7=P(7)
. S ^MAG(2006.587,D0,0)=X
. I O1'="",O5'="",O7'="" S ^MAG(2006.587,"C",O1,O7,O5,D0)=""
. I O5'="",O7'="" S ^MAG(2006.587,"D",O5,O7,D0)=""
. K ^MAG(2006.587,D0,1)
. S D1=0,I="" F S I=$O(Q(I)) Q:I="" D
. . S D1=D1+1,^MAG(2006.587,D0,1,D1,0)=I_"^"_Q(I)
. . S ^MAG(2006.587,D0,1,"B",I,D1)=""
. . Q
. S:D1 ^MAG(2006.587,D0,1,0)="^2006.5871SA^"_D1_"^"_D1
. Q
Q
;
TMPOUT(NAME) ; Return name of the temp
N X
S X=$$RTRNFMT^XWBLIB("GLOBAL ARRAY",1)
S X=$NA(^TMP("MAG",$J,NAME))
K @X
Q X
;
;*zeb *348 add Series Description as optional return
STUDY2(OUT,GROUPS,REQDFN,IMGLESS,FLAGS) ; RPC = MAG DOD GET STUDIES IEN
; CR, 5-28-09
; IMGLESS is a new flag to speed up queries: if=1 (true), just get study-level
; data, if null or zero get everything. This new flag is optional.
; BT, 01-06-12
; FLAGS is "" - Exclude Deleted records (default)
; "D" - Include Deleted records
; "S" - Include Series Description for DICOM Q/R
;
;
N STUDY,INCDEL,INCSERD
;
S REQDFN=$G(REQDFN)
S INCDEL=$G(FLAGS)["D"
;*zeb *348 add study description as optional return
S INCSERD=$G(FLAGS)["S"
S IMGLESS=$G(IMGLESS)
S OUT=$$TMPOUT^MAGDQR21("STUDY")
S @OUT@(1)=1
;
I $G(GROUPS) D CNVGRP^MAGDQR21(.GROUPS)
;
D GETSTUDY^MAGDQR21(.GROUPS,.STUDY,INCDEL) ; read IENS in GROUPS and sort into STUDY by UID,IEN
;
D GENOUT^MAGDQR21(.STUDY,REQDFN,IMGLESS,INCDEL,INCSERD) ; generate OUT based on STUDY
;
;update last counter
S @OUT@(1)=@OUT@(1)-1
Q
;
CNVGRP(GROUPS) ; Add top level GROUPS value to GROUPS array
; GROUPS=10, GROUPS(1)=11, GROUPS(2)=12 becomes GROUPS(1)=11, GROUPS(2)=12, GROUPS(3)=10
N LAST
S LAST=$O(GROUPS(""),-1)+1
S GROUPS(LAST)=GROUPS
Q
;
GETSTUDY(GROUPS,STUDY,INCDEL) ; Read IENS in GROUPS and sort into STUDY by UID,IEN
N I,IEN
S I=""
F S I=$O(GROUPS(I)) Q:I="" D
. S IEN=$G(GROUPS(I))
. Q:'IEN
. I 'INCDEL D SRTUID^MAGDQR21(IEN,.STUDY)
. I INCDEL D SRTUID2^MAGDQR21(IEN,.STUDY)
. Q
Q
;
SRTUID(IEN,STUDY) ; Sort group by UID, IEN
N PARENT,UID
;get parent IEN
S PARENT=$P($G(^MAG(2005,IEN,0)),"^",10)
S:PARENT IEN=PARENT
;IEN now is parent IEN or Individual Image
S UID=$P($G(^MAG(2005,IEN,"PACS")),"^",1) S:UID="" UID="?" ;no pacs
S STUDY(UID,IEN)=""
Q
;
SRTUID2(IEN,STUDY) ; Sort group by UID, IEN (include Deleted Images)
N PARENT,UID,MAGFIL
;get parent IEN
S PARENT=$P($G(^MAG(2005,IEN,0)),"^",10)
S:'PARENT PARENT=$P($G(^MAG(2005.1,IEN,0)),"^",10)
S:PARENT IEN=PARENT
;IEN now is parent IEN or Individual Image
S MAGFIL=$$FILE^MAGGI11(IEN)
S UID=$S(MAGFIL:$P($G(^MAG(MAGFIL,IEN,"PACS")),"^",1),1:"")
S:UID="" UID="?" ;no pacs
S STUDY(UID,IEN)=""
Q
;
;*zeb *348 pass on INCSERD to code that would actually include the series description
GENOUT(STUDY,REQDFN,IMGLESS,INCDEL,INCSERD) ; Generate output in ^TMP based on STUDY array
N UID,IEN
S INCSERD=$G(INCSERD)
;
S UID=""
F S UID=$O(STUDY(UID)) Q:UID="" D
. I UID="?" D Q
. . S IEN=""
. . F S IEN=$O(STUDY(UID,IEN)) Q:IEN="" D STUDY^MAGDQR21("",IEN,REQDFN,IMGLESS,INCDEL,INCSERD)
. . Q
. ;ELSE
. D STUDY^MAGDQR21(UID,"",REQDFN,IMGLESS,INCDEL,INCSERD)
. Q
Q
;
;*zeb *348 pass on INCSERD to code that would actually include the series description
STUDY(UID,IEN,REQDFN,IMGLESS,INCDEL,INCSERD) ; Generate output in ^TMP based on parameters
N STUDY
N SERIESARRAY ; array of series numbers for this study
N TOTIMAGES ; total number of images for all series in this study
N PAT ; array of IENs by patient
N PATCOUNT ; array of patients, use for validation purposes, should contain only one patient
N I0 ;IEN where the patient found
N D0
N STUMO ;Procedure array
N TDCMIMG ; total number of DICOM images
S INCSERD=$G(INCSERD)
;
D WRTOUT^MAGDQR21("NEXT_STUDY|"_UID_"|"_IEN)
;
D:UID'="" GETGPUID^MAGDQR21(UID,.STUDY,INCDEL) ;fill STUDY based on UID
D:IEN GETGPIEN^MAGDQR21(IEN,.STUDY,INCDEL) ;add IEN into STUDY
Q:'$O(STUDY(""))
;
D GETPAT^MAGDQR21(.STUDY,.PAT,.PATCOUNT,.TOTIMAGES,.TDCMIMG,REQDFN,INCDEL) ;get images for patient
Q:'$$VALPAT^MAGDQR21(UID,.PAT,.PATCOUNT,REQDFN) ;validate to make sure all images belonged to one patient
;
S I0=$O(PAT(REQDFN,"")) ;include the first Image when writing out the STUDY section
Q:'$$WRTIEN^MAGDQR21(UID,I0,TOTIMAGES,TDCMIMG,REQDFN)
;
Q:'$$INTEGDFN^MAGDQR21(I0,REQDFN,INCDEL)
;
D WRTOUT^MAGDQR21("STUDY_PAT|"_REQDFN_"|"_$S($T(GETICN^MPIF001)'="":$$GETICN^MPIF001(REQDFN),1:"-1^NO MPI")_"|"_$P($G(^DPT(REQDFN,0)),"^",1))
;
; CR, 5-28-09
; For study-level data stop here without additional checks
Q:IMGLESS=1
;end of check above
;
S D0=""
F S D0=$O(PAT(REQDFN,D0)) Q:D0="" D WRTIMG^MAGDQR20(.SERIESARRAY,D0,REQDFN,.STUMO,INCDEL,INCSERD)
D WRTMOD^MAGDQR21(.STUMO) ; list all modalities
Q
;
GETGPUID(UID,STUDY,INCDEL) ; Given UID, populate STUDY array with Image IEN
N D0
S D0=""
F S D0=$O(^MAG(2005,"P",UID,D0)) Q:D0="" D
. S:'$P($G(^MAG(2005,D0,0)),"^",10) STUDY(D0)=2005 ; add either Group IEN or individual IEN (not child IEN)
. Q
;
I INCDEL D
. S D0=""
. F S D0=$O(^MAG(2005.1,"P",UID,D0)) Q:D0="" D
. . Q:'$$ISDEL^MAGGI11(D0)
. . S:'$P($G(^MAG(2005.1,D0,0)),"^",10) STUDY(D0)=2005.1 ; add either deleted Group IEN or deleted individual IEN (not child IEN)
. . Q
. Q
Q
;
GETGPIEN(IEN,STUDY,INCDEL) ; Add IEN into STUDY (include deleted images)
S:'$P($G(^MAG(2005,IEN,0)),"^",10) STUDY(IEN)=2005 ; add image IEN
;
I INCDEL,$$ISDEL^MAGGI11(IEN) D
. S:'$P($G(^MAG(2005.1,IEN,0)),"^",10) STUDY(IEN)=2005.1 ;add deleted image IEN
. Q
Q
;
GETPAT(STUDY,PAT,PATCOUNT,TOTIMAGES,TDCMIMG,REQDFN,INCDEL) ; Get Total Images count and fill Patient array based on STUDY
;Input:
; STUDY - array of all images
; REQDFN - patient
; INCDEL - include Deleted Images
;Output:
; PAT - array of all images for the patient
; PATCOUNT - array to validate all images should belonged only to one patient
; TOTIMAGES - total images for the patient
; TDCMIMG - total DICOM images
;
N D0,MAGFIL,DFN,ISGRP,CNT
S (TOTIMAGES,TDCMIMG)=0
S D0=""
;
F S D0=$O(STUDY(D0)) Q:D0="" D
. S MAGFIL=STUDY(D0)
. S DFN=+$P($G(^MAG(MAGFIL,D0,0)),"^",7)
. S PATCOUNT(DFN)=""
. S:REQDFN=DFN PAT(DFN,D0)=""
. ;
. ;Add image count to Total Images for the study
. S ISGRP=$$ISGRP^MAGDQR21(D0,INCDEL)
. I 'ISGRP,REQDFN=DFN S TOTIMAGES=TOTIMAGES+1 Q
. I MAGFIL=2005 D
. . S CNT=$$GETGPIM^MAGDQR21(D0,REQDFN,.PATCOUNT)
. . S TOTIMAGES=TOTIMAGES+$P(CNT,"^",1) ; count group images
. . S TDCMIMG=TDCMIMG+$P(CNT,"^",2)
. . Q
. I INCDEL D
. . S CNT=$$GETGPDIM^MAGDQR21(D0,REQDFN,.PATCOUNT)
. . S TOTIMAGES=TOTIMAGES+$P(CNT,"^",1) ; count deleted group images
. . S TDCMIMG=TDCMIMG+$P(CNT,"^",2)
. . Q
. Q
Q
;
ISGRP(D0,INCDEL) ; return 1 if D0 is a group IEN, 0 otherwise
N ISGRP
S ISGRP=1
I 'INCDEL,'$D(^MAG(2005,D0,1)) S ISGRP=0 ; a single image (e.g., photo ID), not a group
I INCDEL,'$D(^MAG(2005,D0,1)),'$D(^MAG(2005.1,D0,1)) S ISGRP=0 ; a single deleted image (e.g., photo ID), not a group
Q ISGRP
;
GETGPIM(D0,REQDFN,PATCOUNT) ; return total images in the group and PATCOUNT array for patient validation
N D1,I0,DFN,IMGCNT,IMGCNTOT,MAGOBJTP
S (IMGCNT,IMGCNTOT)=0
S D1=0 ;go through all images. They should belong to one pt
F S D1=$O(^MAG(2005,D0,1,D1)) Q:'D1 D
. S I0=+$G(^MAG(2005,D0,1,D1,0)) Q:'I0
. S DFN=+$P($G(^MAG(2005,I0,0)),"^",7)
. S PATCOUNT(DFN)="" ;populate PATCOUNT with DFN for validation (DFN might be different in this case it's a corrupted record)
. ; increment image count unless single pt was requested and this isn't that pt
. I REQDFN'=DFN Q
. S IMGCNT=IMGCNT+1
. S MAGOBJTP=$P($G(^MAG(2005,I0,0)),"^",6) ; OBJECT TYPE field (#3)
. S:(MAGOBJTP=100)!(MAGOBJTP=3) IMGCNTOT=IMGCNTOT+1 ; 100 - DICOM IMAGE; 3 - XRAY
. Q
Q IMGCNT_"^"_IMGCNTOT
;
GETGPDIM(D0,REQDFN,PATCOUNT) ; return total images in the group and PATCOUNT array for patient validation
N I0,DFN,IMGCNT,IMGCNTOT,MAGOBJTP
S (IMGCNT,IMGCNTOT)=0
S I0="" ;go through all AUDIT images.
F S I0=$O(^MAG(2005.1,"AGP",D0,I0)) Q:I0="" D
. S DFN=+$P($G(^MAG(2005.1,I0,0)),"^",7)
. S PATCOUNT(DFN)="" ;populate PATCOUNT with DFN for validation (DFN might be different in this case it's a corrupted record)
. ; increment image count unless single pt was requested and this isn't that pt
. I REQDFN'=DFN Q
. S IMGCNT=IMGCNT+1
. S MAGOBJTP=$P($G(^MAG(2005.1,I0,0)),"^",6) ; OBJECT TYPE field (#3)
. S:(MAGOBJTP=100)!(MAGOBJTP=3) IMGCNTOT=IMGCNTOT+1 ; 100 - DICOM IMAGE; 3 - XRAY
. Q
Q IMGCNT_"^"_IMGCNTOT
;
VALPAT(UID,PAT,PATCOUNT,REQDFN) ; Validate - should only have one patient
N CONT,DFN
;
S CONT=1,PATCOUNT=0
S DFN="" F S DFN=$O(PATCOUNT(DFN)) Q:DFN="" S PATCOUNT=PATCOUNT+1
;
I PATCOUNT>1 D
. ; duplicate study instance UID?
. D WRTOUT^MAGDQR21("STUDY_ERR|"_UID_"|"_PATCOUNT_" different patients")
. S CONT=$S('REQDFN:0,'$D(PAT(REQDFN)):0,1:1) ;continue processing with error if patient requested found
. Q
;
Q CONT
;
WRTIEN(UID,I0,TOTIMAGES,TDCMIMG,REQDFN) ; Output STUDY UID and IEN line
N OBJGRP
;
D:UID'="" WRTOUT^MAGDQR21("STUDY_UID|"_UID)
I 'I0 D WRTOUT^MAGDQR21("STUDY_ERR|"_UID_"|Matching study not found for patient "_REQDFN) Q 0
S OBJGRP=$$ONEGROUP^MAGDQR21(I0) ; get the first image IEN for group/image I0
D WRTOUT^MAGDQR21("STUDY_IEN|"_I0_"|"_TOTIMAGES_"|"_OBJGRP_"|"_$$CPTCODE^MAGDQR21(I0)_"|"_$$GETSITE1^MAGDQR21(OBJGRP)_"|"_TDCMIMG)
Q 1
;
INTEGDFN(I0,REQDFN,INCDEL) ; check integrity of study record
;Return 1 if Specified DFN (REQDFN) matches study DFN (VA internal use only!)
; 0 otherwise
N X,CONT,MAGFIL,QINTEG
;
D CHK^MAGGSQI(.X,I0)
S QINTEG='$G(X(0))
D:QINTEG APDOUT^MAGDQR21("|"_$P($G(X(0)),"^",2))
S CONT=1
; override QI check only if image DFN = DFN specified in call
; (VA internal only!)
I QINTEG D
. I 'REQDFN S CONT=0 Q
. S MAGFIL=$$FILE^MAGGI11(I0)
. I MAGFIL="" S CONT=0 Q
. S:$P($G(^MAG(MAGFIL,I0,0)),"^",7)'=REQDFN CONT=0
. Q
;
Q CONT
;
WRTMOD(STUMO) ; Output STUDY_MODALITY line
N M,X
S X="",M=""
F S M=$O(STUMO(M)) Q:M="" S X=X_$S(X'="":",",1:"")_M
D:X'="" WRTOUT^MAGDQR21("STUDY_MODALITY|"_X)
Q
;
ONEGROUP(GROUP) ; Get the first IMAGE_IEN for this group in IMAGE file (#2005)
; or IMAGE AUDIT file (#2005.1)
N D1,IMGIEN,MAGNODE
S MAGNODE=$$NODE^MAGGI11(GROUP)
I MAGNODE="" Q "0^Error 2 - First Image not available; No Data"
I '$D(@MAGNODE@(1)) Q GROUP ; a single image (e.g., photo ID), not a group
S IMGIEN=""
S D1=$O(@MAGNODE@(1,0))
I D1>0 S IMGIEN=+$G(@MAGNODE@(1,D1,0))
I IMGIEN'>0 S IMGIEN=$O(^MAG(2005.1,"AGP",GROUP,""))
I IMGIEN'>0 S IMGIEN="0^Error 1 - First Image not available"
Q IMGIEN
;
WRTOUT(S) ; Write a new line
N CNT
S CNT=^TMP("MAG",$J,"STUDY",1)+1
S ^TMP("MAG",$J,"STUDY",1)=CNT
S ^TMP("MAG",$J,"STUDY",CNT)=S
Q
;
APDOUT(S) ; Append to last line
N CNT
S CNT=^TMP("MAG",$J,"STUDY",1)
S ^TMP("MAG",$J,"STUDY",CNT)=$G(^TMP("MAG",$J,"STUDY",CNT))_S
Q
;
CPTCODE(MAGIEN) ; Returns CPT code by IEN (image pointer) in IMAGE file (#2005)
; or IMAGE AUDIT file (#2005.1)
; MAGIEN = IEN in IMAGE file (#2005) or IMAGE AUDIT file (#2005.1)
N RAIEN,CPTCODE,MAGFILE
S MAGFILE=$$FILE^MAGGI11(MAGIEN)
S RAIEN=+$$GET1^DIQ(MAGFILE,MAGIEN,62,"I") ; Get PACS PROCEDURE field #62
S CPTCODE=$P($G(^RAMIS(71,RAIEN,0)),"^",9) ; IA # 1174 get CPT Code
Q:CPTCODE="" "" ; quit with empty code
S CPTCODE=$$CPT^ICPTCOD(CPTCODE) ; IA # 1995, supported reference
Q $P(CPTCODE,"^",2) ; Return the code
;
GETSITE1(MAGIEN) ; Returns STATION NUMBER where the image is stored
; MAGIEN = IEN in IMAGE file (#2005)
N MAGNODE,TMP,NLOCIEN,PLC
N SITEIEN,SITENUM
I MAGIEN'>0 Q ""
D:'$D(MAGJOB("NETPLC")) NETPLCS^MAGGTU6 ; Initialize MAGJOB("NETPLC")
S MAGNODE=$$NODE^MAGGI11(MAGIEN)
I MAGNODE="" Q ""
S TMP=$G(@MAGNODE@(0))
S NLOCIEN=+$S($P(TMP,U,3):$P(TMP,U,3),1:$P(TMP,U,5)) ; Get IEN in NETWORK LOCATION file (#2005.2)
S PLC=$P($G(MAGJOB("NETPLC",NLOCIEN)),U,1) ; Imaging Site Parameters IEN
Q $$GETSNUM^MAGDQR21(PLC) ; Return STATION NUMBER
;
GETSNUM(MAGPLC) ; Returns STATION NUMBER by Image Site Parameters IEN
; MAGPLC - IEN in IMAGING SITE PARAMETERS file (#2006.1)
I MAGPLC'>0 Q ""
N SITEIEN,SITENUM
S SITEIEN=$P($G(^MAG(2006.1,MAGPLC,0)),U,1) ; Get Station IEN in INSTITUTION file (#4)
Q:SITEIEN="" "" ; if SITE IEN is not defined return blank
S SITENUM=$P($$NS^XUAF4(SITEIEN),U,2) ; IA #2171 Get Station Number
Q SITENUM
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDQR21 15720 printed Oct 16, 2024@18:01:46 Page 2
MAGDQR21 ;WOIFO/EDM,NST,MLH,JSL,SAF,BT,ZEB - RPCs for Query/Retrieve SetUp ; 07 DEC,2023@1:22 PM
+1 ;;3.0;IMAGING;**83,104,123,119,221,348**;Mar 19, 2002;Build 6;Apr 19, 2013
+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 QUIT
+18 ;
GET(OUT,DEST,GATEWAY) ; RPC = MAG GET DICOM DEST
+1 NEW D0,D1,N,OK,X
+2 IF $GET(DEST)=""
Begin DoDot:1
+3 SET N=1
+4 SET X=""
FOR
SET X=$ORDER(^MAG(2006.587,"B",X))
if X=""
QUIT
SET N=N+1
SET OUT(N)="B^"_X
+5 SET X=""
FOR
SET X=$ORDER(^MAG(2006.587,"D",X))
if X=""
QUIT
SET N=N+1
SET OUT(N)="D^"_X
+6 SET OUT(1)=N
+7 QUIT
End DoDot:1
QUIT
+8 ;
+9 SET GATEWAY=$GET(GATEWAY)
if GATEWAY="--All DICOM Gateways--"
SET GATEWAY=""
+10 SET D0=0
SET OK=0
FOR
SET D0=$ORDER(^MAG(2006.587,D0))
if 'D0
QUIT
Begin DoDot:1
+11 SET X=$GET(^MAG(2006.587,D0,0))
+12 if $PIECE(X,"^",1)'=DEST
QUIT
+13 IF GATEWAY'=""
IF $PIECE(X,"^",5)'=GATEWAY
QUIT
+14 SET OK=1
SET N=6
+15 SET OUT(2)="2^"_$PIECE(X,"^",2)
+16 SET OUT(3)="3^"_$PIECE(X,"^",3)
+17 SET OUT(4)="4^"_$PIECE(X,"^",4)
+18 SET OUT(5)="5^"_$PIECE(X,"^",6)
+19 SET OUT(6)="6^"_$PIECE(X,"^",7)
+20 SET D1=0
FOR
SET D1=$ORDER(^MAG(2006.587,D0,1,D1))
if 'D1
QUIT
Begin DoDot:2
+21 SET X=$GET(^MAG(2006.587,D0,1,D1,0))
if $PIECE(X,"^",1)=""
QUIT
+22 SET N=N+1
SET OUT(N)=X
+23 QUIT
End DoDot:2
+24 QUIT
End DoDot:1
if OK
QUIT
+25 SET OUT(1)=N
+26 QUIT
+27 ;
SET(OUT,DATA,DEST,GATEWAY) ; RPC = MAG SET DICOM DEST
+1 NEW D0,D1,I,N,P,Q,O1,O5,O7,OK,T,X
+2 IF $GET(DEST)=""
SET OUT="-1,No Destination Specified."
QUIT
+3 ;
+4 SET I=""
FOR
SET I=$ORDER(DATA(I))
if I=""
QUIT
Begin DoDot:1
+5 SET T=DATA(I)
if T'["^"
QUIT
+6 IF +T=2
SET P(2)=$PIECE(T,"^",2)
QUIT
+7 IF +T=3
SET P(3)=$PIECE(T,"^",2)
QUIT
+8 IF +T=4
SET P(4)=$PIECE(T,"^",2)
QUIT
+9 IF +T=5
SET P(6)=$PIECE(T,"^",2)
QUIT
+10 IF +T=6
SET P(7)=$PIECE(T,"^",2)
QUIT
+11 SET Q($PIECE(T,"^",1))=(+$PIECE(T,"^",2))_"^"_(+$PIECE(T,"^",3))
+12 QUIT
End DoDot:1
+13 ;
+14 SET OUT=0
+15 SET GATEWAY=$GET(GATEWAY)
if GATEWAY="--All DICOM Gateways--"
SET GATEWAY=""
+16 SET D0=0
SET OK=0
FOR
SET D0=$ORDER(^MAG(2006.587,D0))
if 'D0
QUIT
Begin DoDot:1
+17 SET X=$GET(^MAG(2006.587,D0,0))
SET O1=$PIECE(X,"^",1)
SET O5=$PIECE(X,"^",5)
SET O7=$PIECE(X,"^",7)
+18 if O1'=DEST
QUIT
+19 IF GATEWAY'=""
IF O5'=GATEWAY
QUIT
+20 if GATEWAY'=""
SET OK=1
SET OUT=OUT+1
+21 IF O1'=""
IF O5'=""
IF O7'=""
KILL ^MAG(2006.587,"C",O1,O7,O5,D0)
+22 IF O5'=""
IF O7'=""
KILL ^MAG(2006.587,"D",O5,O7,D0)
+23 SET I=""
FOR
SET I=$ORDER(P(I))
if I=""
QUIT
if P(I)'=""
SET $PIECE(X,"^",I)=P(I)
+24 if $GET(P(7))'=""
SET O7=P(7)
+25 SET ^MAG(2006.587,D0,0)=X
+26 IF O1'=""
IF O5'=""
IF O7'=""
SET ^MAG(2006.587,"C",O1,O7,O5,D0)=""
+27 IF O5'=""
IF O7'=""
SET ^MAG(2006.587,"D",O5,O7,D0)=""
+28 KILL ^MAG(2006.587,D0,1)
+29 SET D1=0
SET I=""
FOR
SET I=$ORDER(Q(I))
if I=""
QUIT
Begin DoDot:2
+30 SET D1=D1+1
SET ^MAG(2006.587,D0,1,D1,0)=I_"^"_Q(I)
+31 SET ^MAG(2006.587,D0,1,"B",I,D1)=""
+32 QUIT
End DoDot:2
+33 if D1
SET ^MAG(2006.587,D0,1,0)="^2006.5871SA^"_D1_"^"_D1
+34 QUIT
End DoDot:1
if OK
QUIT
+35 QUIT
+36 ;
TMPOUT(NAME) ; Return name of the temp
+1 NEW X
+2 SET X=$$RTRNFMT^XWBLIB("GLOBAL ARRAY",1)
+3 SET X=$NAME(^TMP("MAG",$JOB,NAME))
+4 KILL @X
+5 QUIT X
+6 ;
+7 ;*zeb *348 add Series Description as optional return
STUDY2(OUT,GROUPS,REQDFN,IMGLESS,FLAGS) ; RPC = MAG DOD GET STUDIES IEN
+1 ; CR, 5-28-09
+2 ; IMGLESS is a new flag to speed up queries: if=1 (true), just get study-level
+3 ; data, if null or zero get everything. This new flag is optional.
+4 ; BT, 01-06-12
+5 ; FLAGS is "" - Exclude Deleted records (default)
+6 ; "D" - Include Deleted records
+7 ; "S" - Include Series Description for DICOM Q/R
+8 ;
+9 ;
+10 NEW STUDY,INCDEL,INCSERD
+11 ;
+12 SET REQDFN=$GET(REQDFN)
+13 SET INCDEL=$GET(FLAGS)["D"
+14 ;*zeb *348 add study description as optional return
+15 SET INCSERD=$GET(FLAGS)["S"
+16 SET IMGLESS=$GET(IMGLESS)
+17 SET OUT=$$TMPOUT^MAGDQR21("STUDY")
+18 SET @OUT@(1)=1
+19 ;
+20 IF $GET(GROUPS)
DO CNVGRP^MAGDQR21(.GROUPS)
+21 ;
+22 ; read IENS in GROUPS and sort into STUDY by UID,IEN
DO GETSTUDY^MAGDQR21(.GROUPS,.STUDY,INCDEL)
+23 ;
+24 ; generate OUT based on STUDY
DO GENOUT^MAGDQR21(.STUDY,REQDFN,IMGLESS,INCDEL,INCSERD)
+25 ;
+26 ;update last counter
+27 SET @OUT@(1)=@OUT@(1)-1
+28 QUIT
+29 ;
CNVGRP(GROUPS) ; Add top level GROUPS value to GROUPS array
+1 ; GROUPS=10, GROUPS(1)=11, GROUPS(2)=12 becomes GROUPS(1)=11, GROUPS(2)=12, GROUPS(3)=10
+2 NEW LAST
+3 SET LAST=$ORDER(GROUPS(""),-1)+1
+4 SET GROUPS(LAST)=GROUPS
+5 QUIT
+6 ;
GETSTUDY(GROUPS,STUDY,INCDEL) ; Read IENS in GROUPS and sort into STUDY by UID,IEN
+1 NEW I,IEN
+2 SET I=""
+3 FOR
SET I=$ORDER(GROUPS(I))
if I=""
QUIT
Begin DoDot:1
+4 SET IEN=$GET(GROUPS(I))
+5 if 'IEN
QUIT
+6 IF 'INCDEL
DO SRTUID^MAGDQR21(IEN,.STUDY)
+7 IF INCDEL
DO SRTUID2^MAGDQR21(IEN,.STUDY)
+8 QUIT
End DoDot:1
+9 QUIT
+10 ;
SRTUID(IEN,STUDY) ; Sort group by UID, IEN
+1 NEW PARENT,UID
+2 ;get parent IEN
+3 SET PARENT=$PIECE($GET(^MAG(2005,IEN,0)),"^",10)
+4 if PARENT
SET IEN=PARENT
+5 ;IEN now is parent IEN or Individual Image
+6 ;no pacs
SET UID=$PIECE($GET(^MAG(2005,IEN,"PACS")),"^",1)
if UID=""
SET UID="?"
+7 SET STUDY(UID,IEN)=""
+8 QUIT
+9 ;
SRTUID2(IEN,STUDY) ; Sort group by UID, IEN (include Deleted Images)
+1 NEW PARENT,UID,MAGFIL
+2 ;get parent IEN
+3 SET PARENT=$PIECE($GET(^MAG(2005,IEN,0)),"^",10)
+4 if 'PARENT
SET PARENT=$PIECE($GET(^MAG(2005.1,IEN,0)),"^",10)
+5 if PARENT
SET IEN=PARENT
+6 ;IEN now is parent IEN or Individual Image
+7 SET MAGFIL=$$FILE^MAGGI11(IEN)
+8 SET UID=$SELECT(MAGFIL:$PIECE($GET(^MAG(MAGFIL,IEN,"PACS")),"^",1),1:"")
+9 ;no pacs
if UID=""
SET UID="?"
+10 SET STUDY(UID,IEN)=""
+11 QUIT
+12 ;
+13 ;*zeb *348 pass on INCSERD to code that would actually include the series description
GENOUT(STUDY,REQDFN,IMGLESS,INCDEL,INCSERD) ; Generate output in ^TMP based on STUDY array
+1 NEW UID,IEN
+2 SET INCSERD=$GET(INCSERD)
+3 ;
+4 SET UID=""
+5 FOR
SET UID=$ORDER(STUDY(UID))
if UID=""
QUIT
Begin DoDot:1
+6 IF UID="?"
Begin DoDot:2
+7 SET IEN=""
+8 FOR
SET IEN=$ORDER(STUDY(UID,IEN))
if IEN=""
QUIT
DO STUDY^MAGDQR21("",IEN,REQDFN,IMGLESS,INCDEL,INCSERD)
+9 QUIT
End DoDot:2
QUIT
+10 ;ELSE
+11 DO STUDY^MAGDQR21(UID,"",REQDFN,IMGLESS,INCDEL,INCSERD)
+12 QUIT
End DoDot:1
+13 QUIT
+14 ;
+15 ;*zeb *348 pass on INCSERD to code that would actually include the series description
STUDY(UID,IEN,REQDFN,IMGLESS,INCDEL,INCSERD) ; Generate output in ^TMP based on parameters
+1 NEW STUDY
+2 ; array of series numbers for this study
NEW SERIESARRAY
+3 ; total number of images for all series in this study
NEW TOTIMAGES
+4 ; array of IENs by patient
NEW PAT
+5 ; array of patients, use for validation purposes, should contain only one patient
NEW PATCOUNT
+6 ;IEN where the patient found
NEW I0
+7 NEW D0
+8 ;Procedure array
NEW STUMO
+9 ; total number of DICOM images
NEW TDCMIMG
+10 SET INCSERD=$GET(INCSERD)
+11 ;
+12 DO WRTOUT^MAGDQR21("NEXT_STUDY|"_UID_"|"_IEN)
+13 ;
+14 ;fill STUDY based on UID
if UID'=""
DO GETGPUID^MAGDQR21(UID,.STUDY,INCDEL)
+15 ;add IEN into STUDY
if IEN
DO GETGPIEN^MAGDQR21(IEN,.STUDY,INCDEL)
+16 if '$ORDER(STUDY(""))
QUIT
+17 ;
+18 ;get images for patient
DO GETPAT^MAGDQR21(.STUDY,.PAT,.PATCOUNT,.TOTIMAGES,.TDCMIMG,REQDFN,INCDEL)
+19 ;validate to make sure all images belonged to one patient
if '$$VALPAT^MAGDQR21(UID,.PAT,.PATCOUNT,REQDFN)
QUIT
+20 ;
+21 ;include the first Image when writing out the STUDY section
SET I0=$ORDER(PAT(REQDFN,""))
+22 if '$$WRTIEN^MAGDQR21(UID,I0,TOTIMAGES,TDCMIMG,REQDFN)
QUIT
+23 ;
+24 if '$$INTEGDFN^MAGDQR21(I0,REQDFN,INCDEL)
QUIT
+25 ;
+26 DO WRTOUT^MAGDQR21("STUDY_PAT|"_REQDFN_"|"_$SELECT($TEXT(GETICN^MPIF001)'="":$$GETICN^MPIF001(REQDFN),1:"-1^NO MPI")_"|"_$PIECE($GET(^DPT(REQDFN,0)),"^",1))
+27 ;
+28 ; CR, 5-28-09
+29 ; For study-level data stop here without additional checks
+30 if IMGLESS=1
QUIT
+31 ;end of check above
+32 ;
+33 SET D0=""
+34 FOR
SET D0=$ORDER(PAT(REQDFN,D0))
if D0=""
QUIT
DO WRTIMG^MAGDQR20(.SERIESARRAY,D0,REQDFN,.STUMO,INCDEL,INCSERD)
+35 ; list all modalities
DO WRTMOD^MAGDQR21(.STUMO)
+36 QUIT
+37 ;
GETGPUID(UID,STUDY,INCDEL) ; Given UID, populate STUDY array with Image IEN
+1 NEW D0
+2 SET D0=""
+3 FOR
SET D0=$ORDER(^MAG(2005,"P",UID,D0))
if D0=""
QUIT
Begin DoDot:1
+4 ; add either Group IEN or individual IEN (not child IEN)
if '$PIECE($GET(^MAG(2005,D0,0)),"^",10)
SET STUDY(D0)=2005
+5 QUIT
End DoDot:1
+6 ;
+7 IF INCDEL
Begin DoDot:1
+8 SET D0=""
+9 FOR
SET D0=$ORDER(^MAG(2005.1,"P",UID,D0))
if D0=""
QUIT
Begin DoDot:2
+10 if '$$ISDEL^MAGGI11(D0)
QUIT
+11 ; add either deleted Group IEN or deleted individual IEN (not child IEN)
if '$PIECE($GET(^MAG(2005.1,D0,0)),"^",10)
SET STUDY(D0)=2005.1
+12 QUIT
End DoDot:2
+13 QUIT
End DoDot:1
+14 QUIT
+15 ;
GETGPIEN(IEN,STUDY,INCDEL) ; Add IEN into STUDY (include deleted images)
+1 ; add image IEN
if '$PIECE($GET(^MAG(2005,IEN,0)),"^",10)
SET STUDY(IEN)=2005
+2 ;
+3 IF INCDEL
IF $$ISDEL^MAGGI11(IEN)
Begin DoDot:1
+4 ;add deleted image IEN
if '$PIECE($GET(^MAG(2005.1,IEN,0)),"^",10)
SET STUDY(IEN)=2005.1
+5 QUIT
End DoDot:1
+6 QUIT
+7 ;
GETPAT(STUDY,PAT,PATCOUNT,TOTIMAGES,TDCMIMG,REQDFN,INCDEL) ; Get Total Images count and fill Patient array based on STUDY
+1 ;Input:
+2 ; STUDY - array of all images
+3 ; REQDFN - patient
+4 ; INCDEL - include Deleted Images
+5 ;Output:
+6 ; PAT - array of all images for the patient
+7 ; PATCOUNT - array to validate all images should belonged only to one patient
+8 ; TOTIMAGES - total images for the patient
+9 ; TDCMIMG - total DICOM images
+10 ;
+11 NEW D0,MAGFIL,DFN,ISGRP,CNT
+12 SET (TOTIMAGES,TDCMIMG)=0
+13 SET D0=""
+14 ;
+15 FOR
SET D0=$ORDER(STUDY(D0))
if D0=""
QUIT
Begin DoDot:1
+16 SET MAGFIL=STUDY(D0)
+17 SET DFN=+$PIECE($GET(^MAG(MAGFIL,D0,0)),"^",7)
+18 SET PATCOUNT(DFN)=""
+19 if REQDFN=DFN
SET PAT(DFN,D0)=""
+20 ;
+21 ;Add image count to Total Images for the study
+22 SET ISGRP=$$ISGRP^MAGDQR21(D0,INCDEL)
+23 IF 'ISGRP
IF REQDFN=DFN
SET TOTIMAGES=TOTIMAGES+1
QUIT
+24 IF MAGFIL=2005
Begin DoDot:2
+25 SET CNT=$$GETGPIM^MAGDQR21(D0,REQDFN,.PATCOUNT)
+26 ; count group images
SET TOTIMAGES=TOTIMAGES+$PIECE(CNT,"^",1)
+27 SET TDCMIMG=TDCMIMG+$PIECE(CNT,"^",2)
+28 QUIT
End DoDot:2
+29 IF INCDEL
Begin DoDot:2
+30 SET CNT=$$GETGPDIM^MAGDQR21(D0,REQDFN,.PATCOUNT)
+31 ; count deleted group images
SET TOTIMAGES=TOTIMAGES+$PIECE(CNT,"^",1)
+32 SET TDCMIMG=TDCMIMG+$PIECE(CNT,"^",2)
+33 QUIT
End DoDot:2
+34 QUIT
End DoDot:1
+35 QUIT
+36 ;
ISGRP(D0,INCDEL) ; return 1 if D0 is a group IEN, 0 otherwise
+1 NEW ISGRP
+2 SET ISGRP=1
+3 ; a single image (e.g., photo ID), not a group
IF 'INCDEL
IF '$DATA(^MAG(2005,D0,1))
SET ISGRP=0
+4 ; a single deleted image (e.g., photo ID), not a group
IF INCDEL
IF '$DATA(^MAG(2005,D0,1))
IF '$DATA(^MAG(2005.1,D0,1))
SET ISGRP=0
+5 QUIT ISGRP
+6 ;
GETGPIM(D0,REQDFN,PATCOUNT) ; return total images in the group and PATCOUNT array for patient validation
+1 NEW D1,I0,DFN,IMGCNT,IMGCNTOT,MAGOBJTP
+2 SET (IMGCNT,IMGCNTOT)=0
+3 ;go through all images. They should belong to one pt
SET D1=0
+4 FOR
SET D1=$ORDER(^MAG(2005,D0,1,D1))
if 'D1
QUIT
Begin DoDot:1
+5 SET I0=+$GET(^MAG(2005,D0,1,D1,0))
if 'I0
QUIT
+6 SET DFN=+$PIECE($GET(^MAG(2005,I0,0)),"^",7)
+7 ;populate PATCOUNT with DFN for validation (DFN might be different in this case it's a corrupted record)
SET PATCOUNT(DFN)=""
+8 ; increment image count unless single pt was requested and this isn't that pt
+9 IF REQDFN'=DFN
QUIT
+10 SET IMGCNT=IMGCNT+1
+11 ; OBJECT TYPE field (#3)
SET MAGOBJTP=$PIECE($GET(^MAG(2005,I0,0)),"^",6)
+12 ; 100 - DICOM IMAGE; 3 - XRAY
if (MAGOBJTP=100)!(MAGOBJTP=3)
SET IMGCNTOT=IMGCNTOT+1
+13 QUIT
End DoDot:1
+14 QUIT IMGCNT_"^"_IMGCNTOT
+15 ;
GETGPDIM(D0,REQDFN,PATCOUNT) ; return total images in the group and PATCOUNT array for patient validation
+1 NEW I0,DFN,IMGCNT,IMGCNTOT,MAGOBJTP
+2 SET (IMGCNT,IMGCNTOT)=0
+3 ;go through all AUDIT images.
SET I0=""
+4 FOR
SET I0=$ORDER(^MAG(2005.1,"AGP",D0,I0))
if I0=""
QUIT
Begin DoDot:1
+5 SET DFN=+$PIECE($GET(^MAG(2005.1,I0,0)),"^",7)
+6 ;populate PATCOUNT with DFN for validation (DFN might be different in this case it's a corrupted record)
SET PATCOUNT(DFN)=""
+7 ; increment image count unless single pt was requested and this isn't that pt
+8 IF REQDFN'=DFN
QUIT
+9 SET IMGCNT=IMGCNT+1
+10 ; OBJECT TYPE field (#3)
SET MAGOBJTP=$PIECE($GET(^MAG(2005.1,I0,0)),"^",6)
+11 ; 100 - DICOM IMAGE; 3 - XRAY
if (MAGOBJTP=100)!(MAGOBJTP=3)
SET IMGCNTOT=IMGCNTOT+1
+12 QUIT
End DoDot:1
+13 QUIT IMGCNT_"^"_IMGCNTOT
+14 ;
VALPAT(UID,PAT,PATCOUNT,REQDFN) ; Validate - should only have one patient
+1 NEW CONT,DFN
+2 ;
+3 SET CONT=1
SET PATCOUNT=0
+4 SET DFN=""
FOR
SET DFN=$ORDER(PATCOUNT(DFN))
if DFN=""
QUIT
SET PATCOUNT=PATCOUNT+1
+5 ;
+6 IF PATCOUNT>1
Begin DoDot:1
+7 ; duplicate study instance UID?
+8 DO WRTOUT^MAGDQR21("STUDY_ERR|"_UID_"|"_PATCOUNT_" different patients")
+9 ;continue processing with error if patient requested found
SET CONT=$SELECT('REQDFN:0,'$DATA(PAT(REQDFN)):0,1:1)
+10 QUIT
End DoDot:1
+11 ;
+12 QUIT CONT
+13 ;
WRTIEN(UID,I0,TOTIMAGES,TDCMIMG,REQDFN) ; Output STUDY UID and IEN line
+1 NEW OBJGRP
+2 ;
+3 if UID'=""
DO WRTOUT^MAGDQR21("STUDY_UID|"_UID)
+4 IF 'I0
DO WRTOUT^MAGDQR21("STUDY_ERR|"_UID_"|Matching study not found for patient "_REQDFN)
QUIT 0
+5 ; get the first image IEN for group/image I0
SET OBJGRP=$$ONEGROUP^MAGDQR21(I0)
+6 DO WRTOUT^MAGDQR21("STUDY_IEN|"_I0_"|"_TOTIMAGES_"|"_OBJGRP_"|"_$$CPTCODE^MAGDQR21(I0)_"|"_$$GETSITE1^MAGDQR21(OBJGRP)_"|"_TDCMIMG)
+7 QUIT 1
+8 ;
INTEGDFN(I0,REQDFN,INCDEL) ; check integrity of study record
+1 ;Return 1 if Specified DFN (REQDFN) matches study DFN (VA internal use only!)
+2 ; 0 otherwise
+3 NEW X,CONT,MAGFIL,QINTEG
+4 ;
+5 DO CHK^MAGGSQI(.X,I0)
+6 SET QINTEG='$GET(X(0))
+7 if QINTEG
DO APDOUT^MAGDQR21("|"_$PIECE($GET(X(0)),"^",2))
+8 SET CONT=1
+9 ; override QI check only if image DFN = DFN specified in call
+10 ; (VA internal only!)
+11 IF QINTEG
Begin DoDot:1
+12 IF 'REQDFN
SET CONT=0
QUIT
+13 SET MAGFIL=$$FILE^MAGGI11(I0)
+14 IF MAGFIL=""
SET CONT=0
QUIT
+15 if $PIECE($GET(^MAG(MAGFIL,I0,0)),"^",7)'=REQDFN
SET CONT=0
+16 QUIT
End DoDot:1
+17 ;
+18 QUIT CONT
+19 ;
WRTMOD(STUMO) ; Output STUDY_MODALITY line
+1 NEW M,X
+2 SET X=""
SET M=""
+3 FOR
SET M=$ORDER(STUMO(M))
if M=""
QUIT
SET X=X_$SELECT(X'="":",",1:"")_M
+4 if X'=""
DO WRTOUT^MAGDQR21("STUDY_MODALITY|"_X)
+5 QUIT
+6 ;
ONEGROUP(GROUP) ; Get the first IMAGE_IEN for this group in IMAGE file (#2005)
+1 ; or IMAGE AUDIT file (#2005.1)
+2 NEW D1,IMGIEN,MAGNODE
+3 SET MAGNODE=$$NODE^MAGGI11(GROUP)
+4 IF MAGNODE=""
QUIT "0^Error 2 - First Image not available; No Data"
+5 ; a single image (e.g., photo ID), not a group
IF '$DATA(@MAGNODE@(1))
QUIT GROUP
+6 SET IMGIEN=""
+7 SET D1=$ORDER(@MAGNODE@(1,0))
+8 IF D1>0
SET IMGIEN=+$GET(@MAGNODE@(1,D1,0))
+9 IF IMGIEN'>0
SET IMGIEN=$ORDER(^MAG(2005.1,"AGP",GROUP,""))
+10 IF IMGIEN'>0
SET IMGIEN="0^Error 1 - First Image not available"
+11 QUIT IMGIEN
+12 ;
WRTOUT(S) ; Write a new line
+1 NEW CNT
+2 SET CNT=^TMP("MAG",$JOB,"STUDY",1)+1
+3 SET ^TMP("MAG",$JOB,"STUDY",1)=CNT
+4 SET ^TMP("MAG",$JOB,"STUDY",CNT)=S
+5 QUIT
+6 ;
APDOUT(S) ; Append to last line
+1 NEW CNT
+2 SET CNT=^TMP("MAG",$JOB,"STUDY",1)
+3 SET ^TMP("MAG",$JOB,"STUDY",CNT)=$GET(^TMP("MAG",$JOB,"STUDY",CNT))_S
+4 QUIT
+5 ;
CPTCODE(MAGIEN) ; Returns CPT code by IEN (image pointer) in IMAGE file (#2005)
+1 ; or IMAGE AUDIT file (#2005.1)
+2 ; MAGIEN = IEN in IMAGE file (#2005) or IMAGE AUDIT file (#2005.1)
+3 NEW RAIEN,CPTCODE,MAGFILE
+4 SET MAGFILE=$$FILE^MAGGI11(MAGIEN)
+5 ; Get PACS PROCEDURE field #62
SET RAIEN=+$$GET1^DIQ(MAGFILE,MAGIEN,62,"I")
+6 ; IA # 1174 get CPT Code
SET CPTCODE=$PIECE($GET(^RAMIS(71,RAIEN,0)),"^",9)
+7 ; quit with empty code
if CPTCODE=""
QUIT ""
+8 ; IA # 1995, supported reference
SET CPTCODE=$$CPT^ICPTCOD(CPTCODE)
+9 ; Return the code
QUIT $PIECE(CPTCODE,"^",2)
+10 ;
GETSITE1(MAGIEN) ; Returns STATION NUMBER where the image is stored
+1 ; MAGIEN = IEN in IMAGE file (#2005)
+2 NEW MAGNODE,TMP,NLOCIEN,PLC
+3 NEW SITEIEN,SITENUM
+4 IF MAGIEN'>0
QUIT ""
+5 ; Initialize MAGJOB("NETPLC")
if '$DATA(MAGJOB("NETPLC"))
DO NETPLCS^MAGGTU6
+6 SET MAGNODE=$$NODE^MAGGI11(MAGIEN)
+7 IF MAGNODE=""
QUIT ""
+8 SET TMP=$GET(@MAGNODE@(0))
+9 ; Get IEN in NETWORK LOCATION file (#2005.2)
SET NLOCIEN=+$SELECT($PIECE(TMP,U,3):$PIECE(TMP,U,3),1:$PIECE(TMP,U,5))
+10 ; Imaging Site Parameters IEN
SET PLC=$PIECE($GET(MAGJOB("NETPLC",NLOCIEN)),U,1)
+11 ; Return STATION NUMBER
QUIT $$GETSNUM^MAGDQR21(PLC)
+12 ;
GETSNUM(MAGPLC) ; Returns STATION NUMBER by Image Site Parameters IEN
+1 ; MAGPLC - IEN in IMAGING SITE PARAMETERS file (#2006.1)
+2 IF MAGPLC'>0
QUIT ""
+3 NEW SITEIEN,SITENUM
+4 ; Get Station IEN in INSTITUTION file (#4)
SET SITEIEN=$PIECE($GET(^MAG(2006.1,MAGPLC,0)),U,1)
+5 ; if SITE IEN is not defined return blank
if SITEIEN=""
QUIT ""
+6 ; IA #2171 Get Station Number
SET SITENUM=$PIECE($$NS^XUAF4(SITEIEN),U,2)
+7 QUIT SITENUM
