MAGDQR06 ;WOIFO/EdM,MLH - Imaging RPCs for Query/Retrieve ; 03 Apr 2012 11:26 AM
;;3.0;IMAGING;**54,66,118,138**;Mar 19, 2002;Build 5380;Sep 03, 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
;
Q0080050(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;R Accession Number
; sensitive/employee?
I SENSEMP D Q ; yes, scrub
. N WRKDT
. S WRKDT=$$DT^XLFDT
. S V(T)=$E(WRKDT,4,7)_$E(WRKDT,2,3)_"-0000"
. Q
; no
S V(T)=$G(^TMP("MAG",$J,"ACCESSION"))
Q
;
Q0200010(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;R Study ID
; sensitive/employee?
I SENSEMP D Q ; yes, scrub
. N I S I=$O(REQ(T,"")) S V(T)=$S(I:$S($G(REQ(T,I))]"":REQ(T,I),1:"0"),1:"0")
. Q
; no
S V(T)=$G(^TMP("MAG",$J,"ACCESSION"))
S V(T)=$P(V(T),"-",$L(V(T),"-")) ; case # or consult # only
Q
;
Q0080062(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O SOP Classes in Study
; --- probably not supported --- ?
; ? ? ?
;;;S:'$$COMPARE^MAGDQR03(T,V(T)) OK=0
Q
;
Q0080090(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Referring Physician's Name
N IMGTYPE
; sensitive/employee?
I SENSEMP D Q ; yes, scrub
. S V(T)="IMAGPROVIDER,SENSITIVE"
. Q
; no
S IMGTYPE=TYPE
D:IMGTYPE="N" FINDTYP(.IMGTYPE,MAGDFN,MAGIEN,.MAGRORD,.MAGINTERP) ; will reset IMGTYPE if successful
D:IMGTYPE="R"
. S X=$P($G(^RADPT(MAGDFN,"DT",MAGRORD,"P",MAGINTERP,0)),"^",14) ; IA # 1172
. S V(T)=$$GET1^DIQ(200,(+X)_",",.01)
. Q
D:IMGTYPE="C"
. N G0
. I MAGIEN="" S V(T)="" Q
. S G0=$$GMRC($G(^TMP("MAG",$J,"ACCESSION")),MAGIEN) I 'G0 S V(T)="" Q
. S V(T)=$$GET1^DIQ(123,G0,10,"E") ; IA # 4110
. Q
; MLH: do not match per WP 3/25/09
;;;S:'$$COMPARE^MAGDQR03(T,V(T)) OK=0
Q
;
Q0081030(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Study Description
; sensitive/employee?
I SENSEMP D Q ; yes, scrub
. N I S I=$O(REQ(T,"")) S:I V(T)=$S($G(REQ(T,I))]"":REQ(T,I),1:"")
. Q
; no
S V(T)=$$STYDESC2^MAGUE001(TYPE,MAGIEN)
S:'$$COMPARE^MAGDQR03(T,V(T)) OK=0
Q
;
Q0080100(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O >Code Value
N IMGTYPE
S IMGTYPE=TYPE
D:IMGTYPE="N" FINDTYP(.IMGTYPE,MAGDFN,MAGIEN,.MAGRORD,.MAGINTERP) ; will reset IMGTYPE if successful
D:IMGTYPE="R"
. S X=$P($G(^RADPT(MAGDFN,"DT",MAGRORD,"P",MAGINTERP,0)),"^",2) ; IA # 1172
. S X=$P($G(^RAMIS(71,+X,0)),"^",9) ; IA # 1174
. S X=$$CPT^ICPTCOD(+X) ; IA # 1995, supported reference
. S V("0008,1030",1,T)=$P(X,"^",2)
. Q
D:IMGTYPE="C"
. N G0
. I MAGIEN="" S V(T)="" Q
. S G0=$$GMRC($G(^TMP("MAG",$J,"ACCESSION")),MAGIEN) I 'G0 S V(T)="" Q
. S V(T)=$$GET1^DIQ(123,G0,4,"I") ; IA # 4110
. Q
Q
;
Q0080104(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O >Code Meaning
N IMGTYPE
S IMGTYPE=TYPE
D:IMGTYPE="N" FINDTYP(.IMGTYPE,MAGDFN,MAGIEN,.MAGRORD,.MAGINTERP) ; will reset IMGTYPE if successful
D:IMGTYPE="R"
. N X
. S X=$P($G(^RADPT(MAGDFN,"DT",MAGRORD,"P",MAGINTERP,0)),"^",2) ; IA # 1172
. S X=$P($G(^RAMIS(71,+X,0)),"^",9) ; IA # 1174
. S X=$$CPT^ICPTCOD(+X) ; IA # 1995, supported reference
. S V("0008,1030",1,T)=$P(X,"^",3)
. Q
D:IMGTYPE="C"
. N G0
. I MAGIEN="" S V(T)="" Q
. S G0=$$GMRC($G(^TMP("MAG",$J,"ACCESSION")),MAGIEN) I 'G0 S V(T)="" Q
. S V(T)=$$GET1^DIQ(123,G0,4,"E") ; IA # 4110
. Q
Q
;
Q0081060(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Name of Physician(s) Reading Study
I SENSEMP D Q ; yes, scrub
. S V(T)="IMAGPROVIDER,SENSITIVE"
. Q
; no
N IMGTYPE
S IMGTYPE=TYPE
D:IMGTYPE="N" FINDTYP(.IMGTYPE,MAGDFN,MAGIEN,.MAGRORD,.MAGINTERP) ; will reset IMGTYPE if successful
D:IMGTYPE="R"
. N X
. S X=$P($G(^RADPT(MAGDFN,"DT",MAGRORD,"P",MAGINTERP,0)),"^",17) ; IA # 1172
. S X=$P($G(^RARPT(+X,0)),"^",9) ; IA # 1171
. S V(T)=$$GET1^DIQ(200,(+X)_",",.01)
. Q
Q:IMGTYPE="C"
; MLH: do not match per WP 3/25/09
;;;S:'$$COMPARE^MAGDQR03(T,V(T)) OK=0
Q
;
Q0081080(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Admitting Diagnosis Description
; ? ? ?
;;;S:'$$COMPARE^MAGDQR03(T,V(T)) OK=0
Q
;
Q01021B0(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Additional Patient History
; sensitive/employee?
I SENSEMP D Q ; yes, scrub
. N I S I=$O(REQ(T,"")) S:I V(T)=$S($G(REQ(T,I))]"":REQ(T,I),1:"")
. Q
; no
N D1,I,T0,X,IMGTYPE
N IMGTYPE
S IMGTYPE=TYPE
D:IMGTYPE="N" FINDTYP(.IMGTYPE,MAGDFN,MAGIEN,.MAGRORD,.MAGINTERP) ; will reset IMGTYPE if successful
Q:IMGTYPE="R"
D:IMGTYPE="C"
. S V(T)="",TIUIX=$$TIUIX(IMGTYPE,MAGIEN)
. D:TIUIX
. . S X=$P($G(^TIU(8925,TIUIX,15)),"^",2) ; Signed By field
. . S:X X=$$GET1^DIQ(200,(+X)_",",.01)
. . S V(T)=X
. . Q
. Q
S:'$$COMPARE^MAGDQR03(T,V(T)) OK=0
Q
;
Q0104000(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Patient Comments
; ? ? ?
; (there is a modality that passes the accession number in this field)
;;;S:'$$COMPARE^MAGDQR03(T,V(T)) OK=0
Q
;
U008010C(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Interpretation Author
N X,IMGTYPE
I SENSEMP D Q ; yes, scrub
. S V(T)="IMAGPROVIDER,SENSITIVE"
. Q
; no
N IMGTYPE
S IMGTYPE=TYPE
D:IMGTYPE="N" FINDTYP(.IMGTYPE,MAGDFN,MAGIEN,.MAGRORD,.MAGINTERP) ; will reset IMGTYPE if successful
D:IMGTYPE="R"
. S X=+$P($G(^RADPT(MAGDFN,"DT",MAGRORD,"P",MAGINTERP,0)),"^",12) ; IA # 1172
. S V(T)=$$GET1^DIQ(200,(+X)_",",.01)
. Q
D:IMGTYPE="C"
. N TIUIX
. S V(T)="",TIUIX=$$TIUIX(IMGTYPE,MAGIEN)
. D:TIUIX
. . S X=$P($G(^TIU(8925,TIUIX,15)),"^",2) ; Signed By field
. . S:X X=$$GET1^DIQ(200,(+X)_",",.01)
. . S V(T)=X
. . Q
. Q
; MLH: do not match per WP 3/25/09
;;;S:'$$COMPARE^MAGDQR03(T,V(T)) OK=0
Q
;
GMRC(ACCNUM,IMAGE) ; Return consult number for image
N X
D ; perform appropriate lookup for old / new database structure
. N G0,T0
. S G0=$$GMRCIEN^MAGDFCNV($G(ACCNUM)) I G0 S X=G0 Q
. S TIUIX=$$TIUIX(TYPE,IMAGE) I 'TIUIX S X=0 Q
. S X=$P($G(^TIU(8925,TIUIX,14)),"^",5) I X'[";GMR(123," S X=0 Q
. S X=0 ; unresolvable IEN
. Q
Q +X
;
TIUIX(TYPE,STUDYIX) ; FUNCTION - find the TIU note index corresponding to a study's procedure
; perform appropriate lookup for old / new database structure
D:TYPE'="N" ; old structure
. N X
. S X=$G(^MAG(2005,STUDYIX,2))
. S:$P(X,"^",6)=8925 TIUIX=+$P(X,"^",7)
. Q
D:TYPE="N" ; new structure
. N PROCIX
. S PROCIX=$P($G(^MAGV(2005.62,STUDYIX,6)),"^",1) Q:'PROCIX
. S:$P($G(^MAGV(2005.61,PROCIX,0)),"^",3)="TIU" TIUIX=$P(^(0),"^",1)
. Q
Q $G(TIUIX)
;
FINDTYP(IMGTYPE,MAGDFN,MAGIEN,MAGRORD,MAGINTERP) ; find type of image on new DB
; if found, will reset IMGTYPE for further processing
N PROCIX,PROCREC,PROCTYP,PROCIDNT
S PROCIX=$$PROCIX^MAGUE005(MAGIEN) Q:'PROCIX
S PROCREC=$G(^MAGV(2005.61,PROCIX,0)) Q:PROCREC=""
S PROCTYP=$P(PROCREC,"^",3),PROCIDNT=$P(PROCREC,"^",1)
I PROCTYP="RAD" D Q
. N ACCARY,I
. S I=$$ACCFIND^RAAPI(PROCIDNT,.ACCARY)
. S I=""
. F S I=$O(ACCARY(I)) Q:'I I $P(ACCARY(I),"^",1)=MAGDFN Q
. I I S MAGRORD=$P(ACCARY(I),"^",2),MAGINTERP=$P(ACCARY(I),"^",3)
. S IMGTYPE="R"
. Q
I PROCTYP="CON" D Q
. S IMGTYPE="C"
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDQR06 8205 printed Oct 16, 2024@18:01:38 Page 2
MAGDQR06 ;WOIFO/EdM,MLH - Imaging RPCs for Query/Retrieve ; 03 Apr 2012 11:26 AM
+1 ;;3.0;IMAGING;**54,66,118,138**;Mar 19, 2002;Build 5380;Sep 03, 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 ;
Q0080050(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;R Accession Number
+1 ; sensitive/employee?
+2 ; yes, scrub
IF SENSEMP
Begin DoDot:1
+3 NEW WRKDT
+4 SET WRKDT=$$DT^XLFDT
+5 SET V(T)=$EXTRACT(WRKDT,4,7)_$EXTRACT(WRKDT,2,3)_"-0000"
+6 QUIT
End DoDot:1
QUIT
+7 ; no
+8 SET V(T)=$GET(^TMP("MAG",$JOB,"ACCESSION"))
+9 QUIT
+10 ;
Q0200010(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;R Study ID
+1 ; sensitive/employee?
+2 ; yes, scrub
IF SENSEMP
Begin DoDot:1
+3 NEW I
SET I=$ORDER(REQ(T,""))
SET V(T)=$SELECT(I:$SELECT($GET(REQ(T,I))]"":REQ(T,I),1:"0"),1:"0")
+4 QUIT
End DoDot:1
QUIT
+5 ; no
+6 SET V(T)=$GET(^TMP("MAG",$JOB,"ACCESSION"))
+7 ; case # or consult # only
SET V(T)=$PIECE(V(T),"-",$LENGTH(V(T),"-"))
+8 QUIT
+9 ;
Q0080062(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O SOP Classes in Study
+1 ; --- probably not supported --- ?
+2 ; ? ? ?
+3 ;;;S:'$$COMPARE^MAGDQR03(T,V(T)) OK=0
+4 QUIT
+5 ;
Q0080090(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Referring Physician's Name
+1 NEW IMGTYPE
+2 ; sensitive/employee?
+3 ; yes, scrub
IF SENSEMP
Begin DoDot:1
+4 SET V(T)="IMAGPROVIDER,SENSITIVE"
+5 QUIT
End DoDot:1
QUIT
+6 ; no
+7 SET IMGTYPE=TYPE
+8 ; will reset IMGTYPE if successful
if IMGTYPE="N"
DO FINDTYP(.IMGTYPE,MAGDFN,MAGIEN,.MAGRORD,.MAGINTERP)
+9 if IMGTYPE="R"
Begin DoDot:1
+10 ; IA # 1172
SET X=$PIECE($GET(^RADPT(MAGDFN,"DT",MAGRORD,"P",MAGINTERP,0)),"^",14)
+11 SET V(T)=$$GET1^DIQ(200,(+X)_",",.01)
+12 QUIT
End DoDot:1
+13 if IMGTYPE="C"
Begin DoDot:1
+14 NEW G0
+15 IF MAGIEN=""
SET V(T)=""
QUIT
+16 SET G0=$$GMRC($GET(^TMP("MAG",$JOB,"ACCESSION")),MAGIEN)
IF 'G0
SET V(T)=""
QUIT
+17 ; IA # 4110
SET V(T)=$$GET1^DIQ(123,G0,10,"E")
+18 QUIT
End DoDot:1
+19 ; MLH: do not match per WP 3/25/09
+20 ;;;S:'$$COMPARE^MAGDQR03(T,V(T)) OK=0
+21 QUIT
+22 ;
Q0081030(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Study Description
+1 ; sensitive/employee?
+2 ; yes, scrub
IF SENSEMP
Begin DoDot:1
+3 NEW I
SET I=$ORDER(REQ(T,""))
if I
SET V(T)=$SELECT($GET(REQ(T,I))]"":REQ(T,I),1:"")
+4 QUIT
End DoDot:1
QUIT
+5 ; no
+6 SET V(T)=$$STYDESC2^MAGUE001(TYPE,MAGIEN)
+7 if '$$COMPARE^MAGDQR03(T,V(T))
SET OK=0
+8 QUIT
+9 ;
Q0080100(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O >Code Value
+1 NEW IMGTYPE
+2 SET IMGTYPE=TYPE
+3 ; will reset IMGTYPE if successful
if IMGTYPE="N"
DO FINDTYP(.IMGTYPE,MAGDFN,MAGIEN,.MAGRORD,.MAGINTERP)
+4 if IMGTYPE="R"
Begin DoDot:1
+5 ; IA # 1172
SET X=$PIECE($GET(^RADPT(MAGDFN,"DT",MAGRORD,"P",MAGINTERP,0)),"^",2)
+6 ; IA # 1174
SET X=$PIECE($GET(^RAMIS(71,+X,0)),"^",9)
+7 ; IA # 1995, supported reference
SET X=$$CPT^ICPTCOD(+X)
+8 SET V("0008,1030",1,T)=$PIECE(X,"^",2)
+9 QUIT
End DoDot:1
+10 if IMGTYPE="C"
Begin DoDot:1
+11 NEW G0
+12 IF MAGIEN=""
SET V(T)=""
QUIT
+13 SET G0=$$GMRC($GET(^TMP("MAG",$JOB,"ACCESSION")),MAGIEN)
IF 'G0
SET V(T)=""
QUIT
+14 ; IA # 4110
SET V(T)=$$GET1^DIQ(123,G0,4,"I")
+15 QUIT
End DoDot:1
+16 QUIT
+17 ;
Q0080104(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O >Code Meaning
+1 NEW IMGTYPE
+2 SET IMGTYPE=TYPE
+3 ; will reset IMGTYPE if successful
if IMGTYPE="N"
DO FINDTYP(.IMGTYPE,MAGDFN,MAGIEN,.MAGRORD,.MAGINTERP)
+4 if IMGTYPE="R"
Begin DoDot:1
+5 NEW X
+6 ; IA # 1172
SET X=$PIECE($GET(^RADPT(MAGDFN,"DT",MAGRORD,"P",MAGINTERP,0)),"^",2)
+7 ; IA # 1174
SET X=$PIECE($GET(^RAMIS(71,+X,0)),"^",9)
+8 ; IA # 1995, supported reference
SET X=$$CPT^ICPTCOD(+X)
+9 SET V("0008,1030",1,T)=$PIECE(X,"^",3)
+10 QUIT
End DoDot:1
+11 if IMGTYPE="C"
Begin DoDot:1
+12 NEW G0
+13 IF MAGIEN=""
SET V(T)=""
QUIT
+14 SET G0=$$GMRC($GET(^TMP("MAG",$JOB,"ACCESSION")),MAGIEN)
IF 'G0
SET V(T)=""
QUIT
+15 ; IA # 4110
SET V(T)=$$GET1^DIQ(123,G0,4,"E")
+16 QUIT
End DoDot:1
+17 QUIT
+18 ;
Q0081060(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Name of Physician(s) Reading Study
+1 ; yes, scrub
IF SENSEMP
Begin DoDot:1
+2 SET V(T)="IMAGPROVIDER,SENSITIVE"
+3 QUIT
End DoDot:1
QUIT
+4 ; no
+5 NEW IMGTYPE
+6 SET IMGTYPE=TYPE
+7 ; will reset IMGTYPE if successful
if IMGTYPE="N"
DO FINDTYP(.IMGTYPE,MAGDFN,MAGIEN,.MAGRORD,.MAGINTERP)
+8 if IMGTYPE="R"
Begin DoDot:1
+9 NEW X
+10 ; IA # 1172
SET X=$PIECE($GET(^RADPT(MAGDFN,"DT",MAGRORD,"P",MAGINTERP,0)),"^",17)
+11 ; IA # 1171
SET X=$PIECE($GET(^RARPT(+X,0)),"^",9)
+12 SET V(T)=$$GET1^DIQ(200,(+X)_",",.01)
+13 QUIT
End DoDot:1
+14 if IMGTYPE="C"
QUIT
+15 ; MLH: do not match per WP 3/25/09
+16 ;;;S:'$$COMPARE^MAGDQR03(T,V(T)) OK=0
+17 QUIT
+18 ;
Q0081080(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Admitting Diagnosis Description
+1 ; ? ? ?
+2 ;;;S:'$$COMPARE^MAGDQR03(T,V(T)) OK=0
+3 QUIT
+4 ;
Q01021B0(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Additional Patient History
+1 ; sensitive/employee?
+2 ; yes, scrub
IF SENSEMP
Begin DoDot:1
+3 NEW I
SET I=$ORDER(REQ(T,""))
if I
SET V(T)=$SELECT($GET(REQ(T,I))]"":REQ(T,I),1:"")
+4 QUIT
End DoDot:1
QUIT
+5 ; no
+6 NEW D1,I,T0,X,IMGTYPE
+7 NEW IMGTYPE
+8 SET IMGTYPE=TYPE
+9 ; will reset IMGTYPE if successful
if IMGTYPE="N"
DO FINDTYP(.IMGTYPE,MAGDFN,MAGIEN,.MAGRORD,.MAGINTERP)
+10 if IMGTYPE="R"
QUIT
+11 if IMGTYPE="C"
Begin DoDot:1
+12 SET V(T)=""
SET TIUIX=$$TIUIX(IMGTYPE,MAGIEN)
+13 if TIUIX
Begin DoDot:2
+14 ; Signed By field
SET X=$PIECE($GET(^TIU(8925,TIUIX,15)),"^",2)
+15 if X
SET X=$$GET1^DIQ(200,(+X)_",",.01)
+16 SET V(T)=X
+17 QUIT
End DoDot:2
+18 QUIT
End DoDot:1
+19 if '$$COMPARE^MAGDQR03(T,V(T))
SET OK=0
+20 QUIT
+21 ;
Q0104000(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Patient Comments
+1 ; ? ? ?
+2 ; (there is a modality that passes the accession number in this field)
+3 ;;;S:'$$COMPARE^MAGDQR03(T,V(T)) OK=0
+4 QUIT
+5 ;
U008010C(TYPE,REQ,V,T,MAGDFN,MAGIEN,MAGRORD,MAGINTERP,SENSEMP,OK) ;O Interpretation Author
+1 NEW X,IMGTYPE
+2 ; yes, scrub
IF SENSEMP
Begin DoDot:1
+3 SET V(T)="IMAGPROVIDER,SENSITIVE"
+4 QUIT
End DoDot:1
QUIT
+5 ; no
+6 NEW IMGTYPE
+7 SET IMGTYPE=TYPE
+8 ; will reset IMGTYPE if successful
if IMGTYPE="N"
DO FINDTYP(.IMGTYPE,MAGDFN,MAGIEN,.MAGRORD,.MAGINTERP)
+9 if IMGTYPE="R"
Begin DoDot:1
+10 ; IA # 1172
SET X=+$PIECE($GET(^RADPT(MAGDFN,"DT",MAGRORD,"P",MAGINTERP,0)),"^",12)
+11 SET V(T)=$$GET1^DIQ(200,(+X)_",",.01)
+12 QUIT
End DoDot:1
+13 if IMGTYPE="C"
Begin DoDot:1
+14 NEW TIUIX
+15 SET V(T)=""
SET TIUIX=$$TIUIX(IMGTYPE,MAGIEN)
+16 if TIUIX
Begin DoDot:2
+17 ; Signed By field
SET X=$PIECE($GET(^TIU(8925,TIUIX,15)),"^",2)
+18 if X
SET X=$$GET1^DIQ(200,(+X)_",",.01)
+19 SET V(T)=X
+20 QUIT
End DoDot:2
+21 QUIT
End DoDot:1
+22 ; MLH: do not match per WP 3/25/09
+23 ;;;S:'$$COMPARE^MAGDQR03(T,V(T)) OK=0
+24 QUIT
+25 ;
GMRC(ACCNUM,IMAGE) ; Return consult number for image
+1 NEW X
+2 ; perform appropriate lookup for old / new database structure
Begin DoDot:1
+3 NEW G0,T0
+4 SET G0=$$GMRCIEN^MAGDFCNV($GET(ACCNUM))
IF G0
SET X=G0
QUIT
+5 SET TIUIX=$$TIUIX(TYPE,IMAGE)
IF 'TIUIX
SET X=0
QUIT
+6 SET X=$PIECE($GET(^TIU(8925,TIUIX,14)),"^",5)
IF X'[";GMR(123,"
SET X=0
QUIT
+7 ; unresolvable IEN
SET X=0
+8 QUIT
End DoDot:1
+9 QUIT +X
+10 ;
TIUIX(TYPE,STUDYIX) ; FUNCTION - find the TIU note index corresponding to a study's procedure
+1 ; perform appropriate lookup for old / new database structure
+2 ; old structure
if TYPE'="N"
Begin DoDot:1
+3 NEW X
+4 SET X=$GET(^MAG(2005,STUDYIX,2))
+5 if $PIECE(X,"^",6)=8925
SET TIUIX=+$PIECE(X,"^",7)
+6 QUIT
End DoDot:1
+7 ; new structure
if TYPE="N"
Begin DoDot:1
+8 NEW PROCIX
+9 SET PROCIX=$PIECE($GET(^MAGV(2005.62,STUDYIX,6)),"^",1)
if 'PROCIX
QUIT
+10 if $PIECE($GET(^MAGV(2005.61,PROCIX,0)),"^",3)="TIU"
SET TIUIX=$PIECE(^(0),"^",1)
+11 QUIT
End DoDot:1
+12 QUIT $GET(TIUIX)
+13 ;
FINDTYP(IMGTYPE,MAGDFN,MAGIEN,MAGRORD,MAGINTERP) ; find type of image on new DB
+1 ; if found, will reset IMGTYPE for further processing
+2 NEW PROCIX,PROCREC,PROCTYP,PROCIDNT
+3 SET PROCIX=$$PROCIX^MAGUE005(MAGIEN)
if 'PROCIX
QUIT
+4 SET PROCREC=$GET(^MAGV(2005.61,PROCIX,0))
if PROCREC=""
QUIT
+5 SET PROCTYP=$PIECE(PROCREC,"^",3)
SET PROCIDNT=$PIECE(PROCREC,"^",1)
+6 IF PROCTYP="RAD"
Begin DoDot:1
+7 NEW ACCARY,I
+8 SET I=$$ACCFIND^RAAPI(PROCIDNT,.ACCARY)
+9 SET I=""
+10 FOR
SET I=$ORDER(ACCARY(I))
if 'I
QUIT
IF $PIECE(ACCARY(I),"^",1)=MAGDFN
QUIT
+11 IF I
SET MAGRORD=$PIECE(ACCARY(I),"^",2)
SET MAGINTERP=$PIECE(ACCARY(I),"^",3)
+12 SET IMGTYPE="R"
+13 QUIT
End DoDot:1
QUIT
+14 IF PROCTYP="CON"
Begin DoDot:1
+15 SET IMGTYPE="C"
+16 QUIT
End DoDot:1
QUIT
+17 QUIT
